image of READY prompt

Wang2200.org

Listing of file='B3270WP' on disk='vmedia/bsc_3271_rel_1.14.04.wvd.zip'

# Sector 872, program filename = 'B3270WP'
0010 REM B3270WP  Spooler Catalog Utility 03/23/82
0020 LOAD T#0,"32WPCAT"4000,9999BEG 40
0022 DIM U1$(16)16,U2$(16)4,V0$(1)1
0040 DIM K1$20,A2$(16)20,R1$1,N3$
   : DIM A1$5,X$1,X0$1,X1$3,D2$3,L$2,D$(50)4
0080 D$()="310 320 330 340 350 360 370 B10 B20 B30 B40 B50 B60 B70 D10 D11 D12
      D13 D14 D15 D20 D21 D22 D23 D24 D25 D30 D31 D32 D33 D34 D35 D50 D51 D52
     D53 D54 D55 D60 D61 D62 D63 D64 D65 D70 D71 D72 D73 D74 D75"
   : GOSUB '246(1)
   : I0=LEN(STR(U1$()))/LEN(STR(U1$(1)))-1
   : I1=1
0335 I9=0
   : A1$=HEX(0204)
   : GOSUB 343
   : GOTO 350
0343 U1$(),U2$()=" "
   : GOSUB '236(I0,I9+1)
   : IF R1$=HEX(00)THEN 346
   : GOSUB 1650
0346 MAT SEARCHU1$(),="                "TO L$STEP LEN(STR(U1$(1)))
   : I=(VAL(L$,2)-1)/16
   : I9=I9+I
   : IF I<>0THEN 343
   : RETURN
0350 DEFFN'0
   : RETURN CLEAR ALL
0360 I,J=0
   : N3$=" "
   : GOSUB '50
   : GOSUB '35("HNA")
0370 I=MOD(I-2*POS(HEX(08)=X$),5)+1
0380 PRINT AT(3+J,14);" ";AT(3+I,14);HEX(8B)
   : J=I
   : IF I9=0THEN 451
0400 KEYIN X$
   : ON POS(HEX(0D20080082)=X$)GOTO 370,370,370,440,430
   : RESTORE LINE620,MOD(I,5)+1
0420 I=MOD(I,5)+1
   : READ X0$
   : ERRORGOTO 400
0425 IF X0$=" "THEN 400
   : IF X0$=X$AND J<>ITHEN 380
   : GOTO 420
0430 IF I<>4THEN IF I9=0THEN 451
   : GOSUB '35("NNA")
   : ON IGOSUB 455,880,1160,1300,1480
   : GOTO 360
0440 LOAD DC T#0,N$(1)
0451 GOSUB '35("BNA")
   : GOSUB '39(12,25,55,"No Spool Files in System")
   : GOTO 400
0455 I1=1
0460 GOSUB 1810
   : GOSUB '35("NRA")
   : GOSUB '60("Active Spooled Files")
   : PRINT AT(23,0);"Key N for NEXT Screen, P for PREVIOUS Screen, or '0 to EN
     D Viewing";
0510 KEYIN X$
   : ON POS(HEX(4E5000)=X$)+1GOTO 510,511,513,520
0511 IF I1+I0>I9THEN 512
   : I1=I1+I0
   : GOTO 460
0512 PRINT HEX(07);
   : GOSUB '39(0,55,25,"No NEXT Screen")
   : GOTO 510
0513 IF I1=1THEN 514
   : I1=I1-I0
   : GOTO 460
0514 PRINT HEX(07);
   : GOSUB '39(0,55,25,"No PREVIOUS Screen")
   : GOTO 510
0520 RETURN
0530 DEFFN'50
   : I=0
   : RESTORE LINE620
   : GOSUB '35("H\CED")
   : PRINT HEX(0E0603);AT(0,24);"Spooled Files Catalogue Utility";HEX(0F)
   : GOSUB '35("HND")
0580 READ A$
   : IF A$=" "THEN 680
   : I=I+1
   : PRINT AT(I+3,16);HEX(0E);STR(A$,,7);HEX(0F);STR(A$,8,LEN(A$)-7)
   : GOTO 580
0620 DATA "LIST   All entries in 'WPSYSTEM' file"
   : DATA "CHANGE Spool File Address"
   : DATA "DETACH Spool File from System -- (remove from list)"
   : DATA "ATTACH Spool File to System   -- (ADD to list)"
   : DATA "DELETE Spool File from System -- (DETACH & Scratch)"
   : DATA " "
0680 PRINT HEX(0E);AT(20,0);"OPERATING INSTRUCTIONS :";HEX(0F);" Select desire
     d Function";AT(21,25);"by Pressing the ";HEX(0E);"RETURN";HEX(0F);", ";HE
     X(0E);"BACKSPACE";HEX(0F);" or ";HEX(0E);"SPACE";HEX(0F);" Key.";AT(22,25
     );"Key ";HEX(0E);"RUN";HEX(0F);" to Activate Selected Function or"
0690 PRINT AT(23,25);HEX(0E);"SF Key '0";HEX(0F);" to Restore Previous Screen.
     ";
   : GOSUB '35("  D")
   : RETURN
0710 DEFFN'60(A$)
   : IF U1$(I0)<>" "THEN J0=I0
   : ELSE GOTO 730
   : GOTO 740
0730 MAT SEARCHU1$(),="               "TO L$STEP LEN(STR(U1$(1)))
   : J0=(VAL(L$,2)-1)/16
   : IF J0=0THEN RETURN
0740 GOSUB '35("H\CEA")
   : PRINT HEX(03);AT(0,40-LEN(A$)/2);A$
0760 %   ##)  #########  ############ ####################
0770 %   \CE\EF\AE  \C6\E9\EC\E5\A0\CE\E1\ED\E5  \C4\E9\F3\EB\A0\C1\E4\E4\F2\E
     5\F3\F3 \D3\F4\E1\F4\F5\F3
0780 GOSUB '35("HNA")
   : PRINT HEX(0E);AT(3,0)
   : PRINTUSING 770
   : GOSUB '35("NNA")
   : FOR J=1TO J0
   : PRINT AT(4+J,0)
   : PRINTUSING 760,J,U1$(J),STR(U2$(J),,3),A2$(J)
   : NEXT J
   : GOSUB '35("NNA")
   : RETURN
0860 DEFFN'35(STR(A1$,3))
   : STR(A1$,,2)=HEX(0204)
   : $TRAN(STR(A1$,3),HEX(004E02480442025204CE0BD20E410F440020))R
   : PRINT A1$;
   : RETURN
0880 GOSUB 1810
0890 A$="Change Spool File Address"
   : GOSUB '60("CHANGE Spool File Address")
   : GOSUB '37("Change Address of")
   : IF I2=0THEN RETURN
   : ELSE GOTO 980
0930 DEFFN'37(A$)
   : PRINT AT(22,0);A$;" Which Spool File (indicate number) ?";
0950 PRINT AT(22,37+LEN(A$));
   : I2=0
   : X1$=" "
   : LINPUT ?X1$
   : CONVERT X1$TO I2
   : ERRORGOTO 950
0960 IF I2<1OR I2>I0OR INT(I2)<>I2OR U1$(I2)=" "THEN 950
   : RETURN
0980 D2$=U2$(I2)
   : GOSUB '35("H\CEA")
   : PRINT HEX(030E);AT(0,24);"Change Spool File Address";HEX(0F)
   : A$="New Disk Address"
   : GOSUB 1020
   : GOTO 1040
1020 GOSUB '35("HNA")
   : PRINT HEX(0F);AT(5,0);"Spool File = ";HEX(0E);U1$(I2);HEX(0F);AT(7,0);A$;
     " = ";HEX(0E);STR(U2$(I2),,3);HEX(0F)
   : RETURN
1040 GOSUB 1130
1050 PRINT HEX(0E);AT(7,LEN(A$)+2);
   : LINPUT ?D2$
   : GOSUB 1140
   : IF A=0THEN PRINT HEX(07)
   : ELSE GOTO 1080
   : GOTO 1050
1080 GOSUB '36(14,"New Disk Address")
1090 KEYIN X$
   : ON POS(HEX(414500)=X$)+1GOTO 1090,1100,890
   : RETURN
1100 IF STR(D2$,,3)=STR(U2$(I2),,3)THEN 890
   : GOSUB '238(U1$(I2),D2$)
   : IF R1$<>HEX(00)THEN STOP #
   : GOTO 880
1130 PRINT AT(14,0,80*6);"Valid Disk Addresses :";AT(16,0);D$()
   : RETURN
1140 A=0
   : IF D2$=" "THEN RETURN
   : MAT SEARCHD$(),=STR(D2$)TO L$STEP 4
   : IF L$<>HEX(0000)THEN A=1
   : RETURN
1160 GOSUB 1810
   : A$="Detach Spool File from System"
   : GOSUB '60("DETACH Spool File From System")
   : GOSUB '37("Logically Detach ")
   : IF I2=0THEN RETURN
   : GOSUB '35("H\CEA")
   : PRINT HEX(030E);AT(0,24);"Detach Spool File from System";HEX(0F)
   : A$="Disk Address"
   : GOSUB 1020
   : GOSUB '36(14,"Detachment Choice")
1250 KEYIN X$
   : ON POS(HEX(414500)=X$)+1GOTO 1250,1260,1160
   : RETURN
1260 GOSUB '234(U1$(I2))
   : IF R1$<>HEX(00)THEN STOP #
   : ELSE GOSUB 343
   : GOTO 1160
1300 A$="Attach Spool File to System"
   : GOSUB '35("H\CEA")
   : PRINT HEX(030E);AT(0,24);A$;HEX(0F)
   : I2=1
   : U1$(I2),U2$(I2)=" "
   : A$="Disk Address"
   : GOSUB 1020
   : GOSUB '35("HNA")
1340 PRINT HEX(0E);AT(5,13);
   : LINPUT ?-STR(N3$,,8)
   : IF N3$=" "THEN 1340
   : GOSUB 1130
1360 PRINT HEX(0E);AT(7,LEN(A$)+2);
   : LINPUT ?-D2$
   : GOSUB 1140
   : IF A=0THEN 1360
   : GOSUB '36(14,"Attachment Choices")
1390 KEYIN X$
   : ON POS(HEX(414500)=X$)+1GOTO 1390,1400,1300
   : RETURN
1400 GOSUB '35("HNA")
   : PRINT HEX(0E)
   : GOSUB '39(L,0,80*(23-L),"ATTACHING ")
   : GOSUB '39(L,C0,0,"Spool File")
   : PRINT HEX(0E)
   : GOSUB '39(L,C0,0,N3$)
   : GOSUB '39(L,C0,0," at Disk Address")
   : PRINT HEX(0E)
   : GOSUB '39(L,C0,0,D2$)
   : GOSUB '239(N3$,D2$)
1410 IF R1$=HEX(00)THEN 1415
   : GOSUB '39(L,0,80,"Attachment")
   : GOSUB '35("BNA")
   : PRINT HEX(0E)
   : GOSUB '39(L,C0,0,"UNSUCCESSFUL")
   : GOSUB 1650
   : GOSUB '39(L,C0,0,A$)
   : GOTO 1430
1415 GOSUB 343
   : GOSUB '39(L,0,80,"Attachment")
   : PRINT HEX(0E)
   : GOSUB '39(L,C0,0,"SUCCESSFUL")
1430 GOSUB '39(L+2,0,0,"KEY OPTIONS :")
   : A=C0
   : GOSUB '39(L+2,A,0,"A to Attach Another")
   : GOSUB '39(L+3,A,0,"'0 to Return to Utility Menu")
1440 KEYIN X$
   : ON POS(HEX(4100)=X$)+1GOTO 1440,1450
   : RETURN
1450 GOSUB '35("  D")
   : N3$,D2$=" "
   : GOTO 1300
1480 GOSUB 1810
   : A$="Delete Spool File from System"
   : GOSUB '60("DELETE Spool File from System")
   : GOSUB '37("Delete ")
   : IF I2=0THEN RETURN
   : GOSUB '35("HNA")
   : PRINT HEX(030E);AT(0,24);"Delete Spool File from System";HEX(0F)
   : A$="Disk Address"
   : GOSUB 1020
   : GOSUB '36(14,"Deletion Choice")
1570 KEYIN X$
   : ON POS(HEX(414500)=X$)+1GOTO 1570,1580,1480
   : RETURN
1580 GOSUB '35("HNA")
   : PRINT HEX(0E)
   : GOSUB '39(L,0,80*(23-L),"DELETING")
   : GOSUB '39(L,C0,0,"Spool File")
   : PRINT HEX(0E)
   : S0$=U1$(I2)
   : D2$=U2$(I2)
   : GOSUB '39(L,C0,0,S0$)
   : GOSUB '39(L,C0,0," at Disk Address")
   : PRINT HEX(0E)
   : GOSUB '39(L,C0,0,D2$)
   : GOSUB '237(U1$(I2))
1595 GOSUB '39(L,0,80,"Deletion")
   : IF R1$=HEX(00)THEN 1600
   : GOSUB '35("BNA")
   : PRINT HEX(0E)
   : GOSUB '39(L,C0,0,"UNSUCCESSFUL")
   : GOSUB 1650
   : GOSUB '39(L,C0,0,A$)
   : GOTO 1620
1600 K1$=" "
   : SELECT #2<D2$>
   : GOSUB 2210
   : IF K1$<>" "THEN RETURN
   : SCRATCH T#2,S0$
   : RETURN
   : GOSUB 343
   : PRINT HEX(0E)
   : GOSUB '39(L,C0,0,"SUCCESSFUL")
1620 GOSUB '39(L+2,0,0,"KEY OPTIONS :")
   : A=C0
   : GOSUB '39(L+2,A,0,"D to Delete Another")
   : GOSUB '39(L+3,A,0,"'0 to Return to Utility Menu")
1630 KEYIN X$
   : ON POS(HEX(4400)=X$)+1GOTO 1630,1480
   : RETURN
1640 DEFFN'39(R0,C0,E0,A$)
   : PRINT AT(R0,C0,E0);A$;HEX(0F)
   : C0=C0+LEN(A$)+2
   : RETURN
1650 RESTORE LINE1650,POS(HEX(010203040506070809102022232425262728505152535455
     565758595A5B5C5D5E5F60616263)=R1$)
   : READ A$
   : PRINT HEX(07)
   : RETURN
   : DATA "Volume Full","File or Volume already exists","File or Volume does n
     ot exist"
1670 DATA "No Free Device Slots","Incorrect Password","Open access type error"
     ,"File not Open"
   : DATA "Illegal File ID","Not enough room in File","File Mess Up"
   : DATA "EOF Reached - Unexpected","Destination VAU not Valid","Buffer Varia
     bles not Valid","No VAUs in File"
1700 DATA "Source & VAU # Inconsistent","Volume init parameter inconsistent","
     Byte parameter error in replace"
   : DATA "EOF reached - Expected"
   : DATA "Disk File not Open","Disk File Full","Disk File not in Catalog"
1730 DATA "Disk File Already Cataloged","Disk File not Scratched","Catalog Ind
     ex Full","Catalog End Error","No End-of-File","Wrong Record Type Read","S
     ector Address beyond End-of-File"
1740 DATA "Disk Hardware Error","Disk Hardware Error","Timeout Error","Disk Fo
     rmat Error","Format Key Engaged","Disk Device Error","Data Error","LRC Er
     ror","Illegal Sector Address or Platter not Mounted","Read-After-Write Er
     ror"
1750 DEFFN'36(L,A$)
   : GOSUB '35("HNA")
   : PRINT HEX(060E);AT(L,0,80*(23-L));"KEY OPTIONS :";HEX(0F);AT(L,14);"A to
     ";HEX(0E);"ACCEPT ";HEX(0F);A$;AT(L+1,14);"E to ";HEX(0E);"EDIT ";HEX(0F)
     ;A$;AT(L+2,14);"'0  to ";HEX(0E);"ABORT ";HEX(0F);"Function"
   : GOSUB '35("NNA")
   : RETURN
1810 U1$(),A2$(),U2$()=" "
   : GOSUB '236(I0,I1)
   : FOR I=1TO I0
   : Z3$=U2$(I)
   : K1$=" "
   : IF Z3$=" "THEN 1840
   : GOSUB '200(Z3$,D$())
   : ON X4GOSUB 2060,2070,2080,2085
1840 A2$(I)=K1$
   : NEXT I
   : RETURN
2060 K1$="disk not in table"
   : RETURN
2070 K1$="disk not configured"
   : RETURN
2080 K1$="disk is unavailable"
   : RETURN
2085 K1$="disk not in list"
   : RETURN
2090 DEFFN'200(Z3$,D$())
   : X4=0
   : MAT SEARCHD$(),=STR(Z3$,1,3)TO X7$STEP 4
   : IF VAL(X7$,2)=0THEN 2190
   : SELECT #2<Z3$>
   : $OPEN 2180,#2
   : ERRORX4=2
   : RETURN
2110 $CLOSE#2
   : Z$=" "
   : HEXPACKZ$FROMSTR(Z3$,2,1)
   : $GIO(731002000301122270A040008600,Z$)
   : ERRORX=ERR
   : X4=3
   : RETURN
2150 IF STR(Z$,8,1)=HEX(00)THEN 2160
   : X4=3
   : RETURN
2160 LIMITS T#2,U1$(I),A,B,C,D
   : ERRORD=1
   : K1$="Access error ="
   : CONVERT ERRTO STR(K1$,16,2),(##)
   : RETURN
2170 K1$="Yes"
   : IF D=2THEN 2200
   : K1$="File not found"
   : RETURN
2180 X4=2
   : RETURN
2190 X4=4
   : RETURN
2200 IF C<200OR B-A+1-C<>0THEN 2300
   : S0$=U1$(I)
2210 OR (STR(S0$,8,1),80)
   : LIMITS T#2,S0$,A,B1,C,D
   : IF D=2THEN RETURN
   : K1$="No report names file"
   : RETURN
2300 K1$="Improper file found"
   : RETURN