Listing of file='B327055' on disk='vmedia/bsc_3271_rel_1.14.04.wvd.zip'
# Sector 96, program filename = 'B327055' 0010 REM B327055 06/17/83 Off-Look at list data 0030 DIM D,D1,I,A1$(16)16,J$2 : DIM R0$83,R0$(3)83,R1$(15)16,R2$(20)12,R3$(32)8,R9$16,R3$8,S2$ : S2$=S$ 0130 SELECT CI 001,INPUT 001,LIST 005(80),CO 005(80),PRINT 005(80) 0140 PRINT HEX(03020402000E);" Look at what list information? " : PRINT HEX(020400000F) : C9=0 : FOR A=1TO 16 : STR(C9$(A),3,2)=HEX(0000) : NEXT A : SELECT PRINT 000 : GOSUB 740 : SELECT PRINT 005 : C9=1 0190 INIT(0A)D8$ : STR(D8$,1,1)=HEX(01) : Z$=" " : DIM E$64 : A=1 : RESTORE 2 : READ E$ : PRINT "TO OPERATE -- Press S.F. KEY or DIGIT corresponding to name," : PRINT "or position # via RETURN, SPACE or BACKSPACE and key RUN" : D=5 : D1=2 : GOSUB 630 : ON IGOTO 280 0260 % ' ## ########################################################## 0270 GOSUB 360 0280 E$=A1$(A) : W$=" " : B$=STR(E$,9,1) : ON VAL(B$)-96GOSUB 1230,1800,740,4000 : PRINT AT(23,0);BOX(1,65);" # Key '0 to return to START other to main menu";AT(23,1); : KEYIN C$,,330 : GOTO 140 0330 IF C$>HEX(00)THEN 140 0340 DEFFN'0 : IF C9<>1THEN 130 : W$=" " : COM CLEAR B$ : LOAD DC T#0,N$(1) 0350 DEFFN'10 : PRINT HEX(03);"HARD COPY OF LISTING" : H=1 : SELECT PRINT 215(80) : PRINT HEX(0D0C0E);"3270 Print Queue examination" : GOSUB 740 : GOSUB 960 : IF C=0THEN PRINT "Nothing found" : GOSUB 1800 : SELECT PRINT 005 : PRINT "DONE" : H=0 : RETURN 0360 DIM A$(1)13 : A$(1)=HEX(080D2082313233343536373839) : A=1 : GOTO 530 0400 KEYIN C$,,570 : MAT SEARCHA$(),=C$TO A$ : C=VAL(STR(A$,2,1)) : IF C=0THEN 400 : PRINT STR(D8$,1,A+D-1);BOX(-1,-65);TAB(D1+1) : ON CGOTO 520,500,500,600 : AND (C$,0F) : GOTO 570 0500 A=A+1 : IF A<=ITHEN 530 : A=1 : GOTO 530 0520 A=A-1 : IF A>0THEN 530 : A=I 0530 PRINT STR(D8$,1,A+D-1);BOX(1,65);TAB(D1);"#";HEX(08); : SELECT PRINT 005 : GOTO 400 0570 IF C$=HEX(00)THEN 340 : C=VAL(C$) : IF C>ITHEN 530 : PRINT STR(D8$,1,A+D-1);BOX(-1,-65);TAB(D1+1) : A=C 0600 PRINT STR(D8$,1,A+D-1);BOX(1,7);TAB(D1);"*"; : RETURN 0630 I=0 : RESTORE : PRINT 0640 READ E$ : IF E$=" "THEN RETURN : A1$(I+1)=E$ : A$=STR(E$,10) : I=I+1 : PRINTUSING 260,I,A$ : GOTO 640 : DATA "aaaaaaaaafor the queue list from a specific SPOOLER file" : DATA "bbbbbbbbbfor all reports from a specific SPOOLER file" : DATA "cccccccccfor a summary list of the PRINT QUEUE file by printer" 0705 DATA "dddddddddto back-up the spooler and report name files" : DATA " " : $IF OFF /001,725 : KEYIN C$ 0721 IF H=1THEN RETURN : PRINT "<< pause key anything to continue >>";HEX(0C) : KEYIN C$,,722 0722 IF H=1THEN RETURN : PRINT TAB(80);HEX(0C) : IF C$<>HEX(00)THEN RETURN : RETURN CLEAR : GOTO 130 0725 RETURN 0740 PRINT HEX(03);"Information in file '3270*PQ' -- the PRINT QUEUE file f rom Terminal =";#TERM : DATA LOAD DC OPEN T#0,"3270*PQ" : MAT REDIM R0$(3)80 : DATA LOAD DC #0,R0$() : MAT COPY R0$()TO R1$() : A=0 0805 IF A>14THEN 808 : A=A+1 : R9$=R1$(A) : IF R9$=" "THEN 805 : PRINT A; : GOSUB 950 : GOTO 805 0808 PRINT : A=0 0810 IF C9=0THEN 815 : GOSUB 721 0815 IF A>14THEN RETURN : A=A+1 : R9$=R1$(A) : PRINT : IF R9$=" "THEN 815 : PRINT HEX(020402000E828282);A; : GOSUB 950 : PRINT HEX(020400000F) : DATA LOAD DC #0,R0$() : MAT COPY R0$()TO R2$() : C=0 0890 C=C+1 : IF C>20THEN 810 : R2$=R2$(C) : IF STR(R2$,1,1)=" "THEN 810 : A$=" " : MAT SEARCHC9$()<5,250>,=STR(R2$,3,8)TO J$ : IF J$=HEX(0000)THEN 930 : IF C9>0THEN 920 : ADDC(STR(C9$(),VAL(J$,2)+2,2),STR(R2$,1,2)) 0920 A$="queue available" : STR(C9$(),VAL(J$,2)+1,1)="Q" 0930 PRINTUSING "## items from Spooler file ######## via terminal ## ######## ################";VAL(STR(R2$,1),2),STR(R2$,3,8),VAL(STR(R2$,11)),A$ : GOTO 890 0950 PRINTUSING "Queue list for terminal # print address ### model = ##### ";STR(R9$,16,1),STR(R9$,4,3),STR(R9$,8,5); : IF STR(R9$,8,3)<>"CRT"THEN PRINT "form = ";STR(R9$,14,2);HEX(22); : PRINT : RETURN 0960 GOSUB 1960 : PRINT HEX(03);"Information in file ";S0$;" -- the REPORT NAME file fro m Terminal =";#TERM : DSKIP #2,1S : B,C=0 : GOSUB 1030 : GOSUB 1030 : GOSUB 1030 : GOSUB 1030 : RETURN 1030 GOSUB 722 : DATA LOAD DC #2,R0$() : PRINT : IF STR(R0$(),1,2)=HEX(2020)THEN RETURN : C=C+1 : MAT COPY R0$()TO R3$() : A=1 : R3$=R3$(1) : IF STR(R3$,1,1)<HEX(06)THEN IF VAL(STR(R3$,8))-48=#TERMTHEN B=B+1 : HEXUNPACKSTR(R3$,1,1)TO A$ : PRINTUSING " Printer addr = ## Model ##### Form length= ## lines";A $,STR(R3$,2,5),VAL(STR(R3$,7)); 1085 IF STR(R3$,1,1)<HEX(06)THEN PRINT " Terminal = ";STR(R3$,8,1); : PRINT 1100 A=A+1 : R3$=R3$(A) : IF STR(R3$,1,2)=HEX(2020)THEN 1170 : C$=STR(R3$,8) : IF C$=HEX(40)OR C$=HEX(C0)THEN C$="Y" : ELSE C$=" " : IF STR(R3$,8,1)>HEX(40)THEN 1150 : PRINTUSING "Request ## Report No. ## Pages #### - ##### # copies # ";A-1,VAL(STR(R3$,1),2),VAL(STR(R3$,3),2),VAL(STR(R3$,5),2),VAL(STR(R3$,7 ,1)),C$ : GOTO 1100 1150 PRINTUSING "Request ## Stream No. ## Blocks ##### - ##### # copies # ";A-1,VAL(STR(R3$,1),2),VAL(STR(R3$,3),2),VAL(STR(R3$,5),2),VAL(STR(R3$,7 ,1)),C$ : GOTO 1100 1170 GOSUB 721 : RETURN 1230 PRINT STR(D8$,1,A+D-1);BOX(-1,-7) : C9=2 : I=0 : PRINT AT(4,0,18*80) 1250 I=I+1 : IF C9$(I)=" "THEN 1290 : IF STR(C9$(I),1,1)="3"THEN 1290 : IF STR(C9$(I),2,1)="Q"THEN 1280 : PRINTUSING " ' ## has no list for Spool file ######## on ###";I,STR(C9$ (I),5,8),STR(C9$(I),14,3) : GOTO 1250 1280 PRINTUSING " ' ## for queue for Spooler file ######## on ### ### items ";I,STR(C9$(I),5,8),STR(C9$(I),14,3),VAL(STR(C9$(I),3),2) : GOTO 1250 1290 I=I-1 : GOSUB 360 : D1$=STR(C9$(A),14) : S$,S0$=STR(C9$(A),5,8) : OR (STR(S0$,8,1),80) : GOSUB 960 : IF C=0THEN 1390 : IF B=0THEN 1400 : PRINT : PRINT AT(22,0);BOX(2,75);" Key '7 to BEGIN list Key '9 to DEL ETE list" : PRINT " # Key '0 to return to START Key other to return to main menu ";AT(23,1); 1330 KEYIN C$,,1340 : RETURN CLEAR : GOTO 140 1340 IF C$=HEX(00)THEN 1420 : IF C$=HEX(07)THEN 1350 : IF C$=HEX(09)THEN 1442 : GOTO 1330 1350 PRINT AT(23,0,80);" Load to list data queued up from terminal ";#TERM;AT (0,0) : A$="2..."&STR(S$,1,8)&"'"&D1$ : B$="P" : LOAD DC T#0,"B327040" 1390 PRINT AT(11,31);"No items are found" 1400 PRINT AT(23,0);BOX(1,75);" # Key '0 to return to START '9 to DELETE item other to main menu";AT(23,1); : KEYIN C$,,1440 1420 RETURN CLEAR : GOTO 140 1440 IF C$=HEX(00)THEN 1420 : IF C$=HEX(09)THEN 1460 : GOTO 1330 1442 PRINT HEX(03);" DELETING list queues from REPORT NAME file ";S0$ : GOSUB 1960 : INIT(00)R0$() : DATA SAVE DC #2,R0$() : INIT(20)R0$() : FOR A=1TO 4 : DATA SAVE DC #2,R0$() : NEXT A 1460 PRINT : PRINT "Delete refs to spooler ";S$ : A1=1 : GOSUB 1490 : GOTO 1420 : PRINT : PRINT "Deleting item from file" : A1=2 : GOSUB 1490 : GOTO 1420 1490 DATA LOAD DC OPEN T#0,"3270*PQ" : MAT REDIM R0$(3)80 : DSKIP #0,1S : FOR B=1TO 18 : DATA LOAD DC #0,R0$() : C$=" " : ON A1GOSUB 1590,1630 : IF C$=" "THEN 1550 : MAT COPY R2$()TO R0$() : DBACKSPACE #0,1S : DATA SAVE DC #0,R0$() 1550 NEXT B : RETURN 1590 MAT COPY R0$()TO R2$() : C=0 1600 C=C+1 : IF C>20THEN RETURN : R2$=R2$(C) : IF STR(R2$,3,8)<>S$THEN 1600 : FOR A=CTO 19 : R2$(A)=R2$(A+1) : NEXT A : R2$(20)=" " : C$="U" : GOTO 1600 1630 MAT COPY R0$()TO R2$() : C=0 1640 C=C+1 : IF C>20THEN RETURN : R2$=R2$(C) : IF STR(R2$,3,8)<>S$THEN 1640 : FOR A=CTO 19 : R2$(A)=R2$(A+1) : NEXT A : R2$(20)=" " : C$=" " : GOTO 1630 1800 PRINT HEX(03);"Reports contained in Spooler file = ";S0$ : GOSUB 1960 : DSKIP #2,5S : A=1 1830 DATA LOAD DC #2,R0$() : FOR B=1TO 3 : R0$=R0$(B) : IF R0$=" "THEN 1850 : PRINT A;R0$ : A=A+1 : GOSUB 722 : NEXT B : GOTO 1830 1850 PRINT "Done" : RETURN 1960 MAT REDIM R0$(3)83 : SELECT #2<D1$> : DATA LOAD DC OPEN T#2,S0$ : ERRORPRINT AT(22,0,80);HEX(07);S0$;" Not available on ";D1$ 1980 RETURN 3010 DEFFN'12 3020 PRINT HEX(03);"MODIFY FILES" : C$=" " : INPUT "Key S for Spooler P for 3270*PQ",C$ : IF C$="P"THEN 3050 : IF C$="S"THEN 3290 : GOTO 3020 3050 DATA LOAD DC OPEN T#0,"3270*PQ" : MAT REDIM R0$(3)80 : DATA LOAD DC #0,R0$() : MAT REDIM R1$(15)16 : R1$(),R3$()=R0$() : PRINT "Sector 1 -- Printer addresses" : FOR A=1TO 15 : PRINT A;TAB(5);STR(R1$(A),4,13);" ";STR(R1$(A),16);" "; : IF R1$(A)=" "THEN PRINT " spaces" : ELSE HEXPRINT R1$(A) : NEXT A : INPUT A : S=1 3130 S=S+1 : PRINT "make any changes to R1$() then key s.f. '26" 3140 PRINT "Sector =";S; : INPUT " or ",S : IF S<1THEN 3140 : IF S<17THEN 3150 : PRINT "DONE" : RETURN 3150 DBACKSPACE #0,BEG : DSKIP #0,S-1S : PRINT "Sector ";S;"-- Printer queue data for ";STR(R3$(),(S*16)-29,10);ST R(R3$(),(S*16)-16,1) : DATA LOAD DC #0,R0$() : MAT REDIM R1$(20)12 : R1$()=R0$() : PRINT "Sector ";S;" Queue data" : FOR A=1TO 20 : PRINT A;TAB(5);STR(R1$(A),3,8);" "; : IF R1$(A)=" "THEN PRINT " spaces" : ELSE HEXPRINT R1$(A) : NEXT A : GOTO 3130 3230 DEFFN'26 : PRINT HEX(03);"Modify 3270*PQ file with " : HEXPRINT R1$() : INPUT "key return to modify disk",A : MAT COPY R1$()TO R0$() : DBACKSPACE #0,1S : DATA SAVE DC #0,R0$() : RETURN 3260 DEFFN'27 : PRINT HEX(03);"Modify REPORTNAME file ";S0$;" with " : HEXPRINT R1$() : INPUT "key return to modify disk",A : MAT COPY R1$()TO R0$() : DBACKSPACE #3,1S : DATA SAVE DC #3,R0$() : RETURN 3290 SELECT #3<D1$> : DATA LOAD DC OPEN T#3,S0$ : PRINT "Sector 1 -- Pointers" : S=1 : MAT REDIM R0$(3)83 : DATA LOAD DC #3,R0$() : HEXPRINT R0$() : GOTO 3370 3330 MAT REDIM R0$(3)83 : DATA LOAD DC #3,R0$() : MAT REDIM R1$(30)8 : MAT COPY R0$()TO R1$() : IF S>5THEN 3420 : PRINT 1;TAB(5);HEXOF(R1$(1));" ";STR(R1$(1),2,5);" ";STR(R1$(1),8,1) : FOR A=2TO 18 : PRINT A;TAB(5); : IF R1$(A)=" "THEN PRINT " spaces" : ELSE HEXPRINT R1$(A) : NEXT A 3370 PRINT "make any changes to R1$() then key s.f. '27" 3380 PRINT "Sector =";S;" on report name file ";S0$ : INPUT A : S=S+1 : PRINT "Sector ";S;" queue items" : GOTO 3330 3420 FOR A=1TO 3 : IF POS(R0$(A)<" ")=0THEN PRINT R0$(A) : ELSE HEXPRINT R0$(A) : NEXT A : PRINT "Data resides in R0$()" : GOTO 3380 4000 PRINT HEX(03);"Back-up Spooler file and report name disks" : PRINT S$;" = SPOOLER FILE NAME" : PRINT S0$;" = REPORT NAME FILE" : PRINT : PRINT "Input will be on disk ";D1$;" which is referenced by D1$ and #2" 4030 D2$="350" : INPUT "Write to what surface eg.350",D2$ : IF D1$<>D2$THEN 4060 : PRINT "input and output addresses must differ" : GOTO 4030 4060 SELECT #3<D2$> : PRINT : PRINT "1). move files onto scratch area." : PRINT "2). move files over files of same name." : PRINT "3). move files over files of different name." : PRINT "4). move files over files of different name then rename." : PRINT "5). move files onto scratch area, then rename." 4115 PRINT "6). rename files" 4120 INPUT "key value 1 - 6",A : IF A<1OR A>6THEN 4120 : F$=" " : C1=A : ON C1GOTO 4160,4160 4150 INPUT "destination name ",F$ : IF F$=" "THEN 4150 4160 A$=S0$ : PRINT "REPORT NAME FILE ";S0$ : OR (STR(F$,8,1),80) : ON C1GOSUB 4250,4270,4290,4310,4330,4332 : A$=S$ : PRINT "SPOOLER FILE ";S$ : AND (STR(F$,8,1),7F) : ON C1GOSUB 4250,4270,4290,4310,4330,4350 : PRINT : PRINT "Complete" : RETURN 4250 MOVE T#2,A$TO T#3, : RETURN 4270 SCRATCH T#3,A$ : MOVE T#2,A$TO T#3,(A$) : RETURN 4290 SCRATCH T#3,F$ : MOVE T#2,A$TO T#3,(F$) : RETURN 4310 GOSUB 4290 : GOSUB 4350 : RETURN 4330 GOSUB 4250 : GOSUB 4350 : RETURN 4332 INPUT "change name on what disk surface",D2$ : SELECT #3<D2$> 4350 LIMITS T#3,A$,A,B,C : SCRATCH T#3,A$ : DATA SAVE DC OPEN T#3,A$,F$ : DSKIP #3,(C-2)S : DATA SAVE DC #3,END : RETURN