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