image of READY prompt

Wang2200.org

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