Listing of file='B327045' on disk='vmedia/bsc_3271_rel_1.14.04.wvd.zip'
# Sector 1072, program filename = 'B327045'
0010 REM B327045 12/22/82 Off-Delete
: GOTO 17
: ON AGOTO 20
0017 COM V0$(25)80,V1$(24)82
: COM A8,A9,B1,B1$5,B2,B2$5,B9,D$3,I,K1,M$2,Q,R,R8,R9,S1,T8,T9,Z,Z4,Z5,Z7,Z
9
0020 COM R$18,R$(30)40,R0$83,R0$(3)83,R1$1,R3$(3)83,R4$3,R8$1,R8$(50)4,R9$(50)
40,Q$(120)3,Q8$100,Q8$(50)2,S1$1,S1$(3)80,T,Z6$1
: T=0
0230 SELECT @PART"3270UNIV"
0240 PRINT HEX(03);"3270";
: IF E0$(5)="A"THEN PRINT " Active";
: PRINT " Spooler File Off-line Delete Utility ('0 = Exit)"
: PRINT
: PRINT "Reading REPORT name file"
: IF T=6THEN 280
: T=6
: GOSUB 370
0280 GOSUB 1270
: GOTO 280
0300 DEFFN'0
: IF K1=4THEN GOSUB 315
: C$="C"
: B=0
: K1=0
0310 PRINT HEX(06);AT(T,0,4*80);" Type A or C"
: PRINT " A = Abort - Exit delete utility"
: PRINT " C = Continue in delete utility - Return to prompt 1";
: PRINT AT(T,0)
: LINPUT -C$
: ON POS("AC"=C$)+1GOTO 310,330,1310
: STOP
0315 R1$="1"
: GOSUB 950
: RETURN
0330 PRINT HEX(03);"Terminating DELETE and returning to START"
: PRINT
: GOSUB 370
: $CLOSE
: IF STR(@P$(5),24,6)<>"Delete"THEN 340
: STR(@P$(5),24,9)="Active"
: FOR A=1TO 4
: IF STR(@D$(8+A),2,1)=HEX(20)THEN BIN(STR(@A$,20+A,1))=#TERM+48
: NEXT A
0340 RETURN CLEAR ALL
: COM CLEAR B$
: LOAD DC T#0,N$(1)
0370 DATA LOAD DC OPEN T#2,S0$
: DSKIP #2,1S
: GOSUB 430
: GOSUB 500
: R9=A
: RETURN
0430 INIT(20)Q$()
: Q=0
: FOR A=1TO 4
: MAT REDIM R0$(3)83
: DATA LOAD DC #2,R0$()
: IF R0$(1)<>" "THEN GOSUB 460
: NEXT A
: RETURN
0460 MAT REDIM R0$(30)8
: FOR B=2TO 29
: R$=R0$(B)
: IF R$<>" "THEN GOSUB 480
: NEXT B
: RETURN
0480 Q=Q+1
: R$=R0$(B)
: C$=STR(R$,8)
: Q$(Q)=C$&STR(R$,1)
: IF C$<HEX(80)THEN RETURN
: AND (C$,STR(R$,2))
: Q$(Q)=C$&STR(R$,3)
: RETURN
0500 MAT REDIM R0$(3)83
: A,C=0
: INIT(" ")R$()
0510 DATA LOAD DC #2,R0$()
: IF END THEN 550
: B=1
0520 A$=R0$(B)
: IF A$=" "THEN 550
: C$=STR(A$,24,1)
: IF C$=" "THEN C=C+1
: A=A+1
: STR(R$(),A*3-2,3)=C$&BIN(A,2)
: B=B+1
: IF B<4THEN 520
: GOTO 510
0550 PRINT C;" Reports have to be removed from file"
: IF C=0THEN RETURN
: A9=A
: A8=C
: A=1
: PRINT "Remove ";A8;" items from list of ";A9
: FOR B=1TO A9
: C$,A$=STR(R$(),B*3-2,3)
: IF C$=" "THEN 630
: STR(R$(),A*3-2,3)=STR(R$(),B*3-2,3)
: A=A+1
0630 NEXT B
: STR(R$(),A*3-2)=" "
: DBACKSPACE #2,BEG
: DSKIP #2,1S
: GOSUB 770
: GOSUB 900
: GOTO 370
0770 IF Q>0THEN 790
: DSKIP #2,4S
: RETURN
0790 FOR A=1TO 4
: MAT REDIM R0$(3)83
: DATA LOAD DC #2,R0$()
: IF R0$()<>" "THEN GOSUB 810
: NEXT A
: RETURN
0810 MAT REDIM R0$(30)8
: FOR B=2TO 29
: R$=R0$(B)
: IF R$<>" "THEN GOSUB 860
: NEXT B
: DBACKSPACE #2,1S
: MAT REDIM R0$(3)83
: DATA SAVE DC #2,R0$()
: RETURN
0860 C$=STR(R$,8)
: AND (C$,80)
: IF C$=HEX(80)THEN RETURN
: A=0
0880 A=A+1
: IF A>A9THEN RETURN
: IF STR(R$(),A*3-1,2)<>STR(R$,1,2)THEN 880
: STR(R0$(B),1,2)=BIN(A,2)
: RETURN
0900 MAT REDIM R0$(3)83
: INIT(" ")R3$()
: DBACKSPACE #2,BEG
: DSKIP #2,5S
: SELECT #3<D1$>
: DATA LOAD DC OPEN T#3,S0$
: DSKIP #3,5S
: B=0
0905 DATA LOAD DC #2,R0$()
: IF END THEN 925
: A=0
0910 A=A+1
: IF STR(R0$(A),24,1)=" "THEN 920
: B=B+1
: IF B<4THEN 915
: DATA SAVE DC #3,R3$()
: INIT(" ")R3$()
: B=1
0915 R3$(B)=R0$(A)
0920 IF A<3THEN 910
: GOTO 905
0925 DATA SAVE DC #3,R3$()
: INIT(" ")R3$()
: FOR A=1TO A8STEP 3
: DATA SAVE DC #3,R3$()
: NEXT A
: RETURN
0950 A=0
: DATA LOAD DC OPEN T#2,S0$
0960 DSKIP #2,5S
: T8=A
: T9=R9
: R=0
: IF T9>22THEN T9=22
: IF K1=4THEN 985
: PRINT AT(T+4,0,13*80);
0985 PRINT AT(T+4,0);
: GOSUB 1210
0990 DATA LOAD DC #2,R0$()
: IF END THEN 1030
: IF R0$(1)=" "THEN 1030
: GOSUB 1060
: IF R0$(2)=" "THEN 1030
: GOSUB 1060
: IF R0$(3)=" "THEN 1030
: GOSUB 1060
: IF R<T9THEN 990
1030 Z7=R
: RETURN
1060 A$=R0$(MOD(A,3)+1)
: A=A+1
: IF STR(A$,24,1)=" "THEN RETURN
: C$=" "
: IF R1$<>"2"THEN 1150
: IF STR(A$,24,1)<>S1$THEN RETURN
: D$=HEX(40)&BIN(A,2)
: MAT SEARCHQ$()<1,Q*3>,=D$TO M$STEP 3
: IF M$<>HEX(0000)THEN 1105
: D$=HEX(00)&BIN(A,2)
: MAT SEARCHQ$()<1,Q*3>,=D$TO M$STEP 3
: IF M$=HEX(0000)THEN 1130
1105 C$="Q"
: IF B9>0THEN 1130
: CONVERT STR(A$,26,3)TO B9
: CONVERT B9-1TO B2$,(###)
1120 % ### ################## # # ### - ### !
1130 INIT(00)W$
: PRINTUSING TO W$,1120,A,STR(A$,1,18),STR(A$,24,1),C$,STR(A$,26,3),STR(A$,
30,3);
: GOTO 1205
1150 D$=HEX(40)&BIN(A,2)
: MAT SEARCHQ$()<1,Q*3>,=D$TO M$STEP 3
: IF M$=HEX(0000)THEN 1160
: C$="D"
: S1$="Q"
: GOTO 1200
1160 S1$=" "
: D$=HEX(00)&BIN(A,2)
: MAT SEARCHQ$()<1,Q*3>,=D$TO M$STEP 3
: IF M$>HEX(0000)THEN S1$="Q"
: IF S1$<>" "THEN 1200
: C$=STR(A$,20,1)
1190 % ### ################## # # # !
1200 INIT(00)W$
: PRINTUSING TO W$,1190,A,STR(A$,1,18),STR(A$,24),S1$,C$;
1205 R=R+1
: IF STR(A$,30,3)="000"THEN STR(W$,3,1)="*"
: R$(R)=STR(W$,3)
: RETURN
1210 IF R1$<>"2"THEN 1240
: PRINT " No. Report name Stream Blocks !";
: PRINT " No. Report name Stream Blocks !"
: RETURN
1240 PRINT " No. Report name Stream List Del? ";
: PRINT " No. Report name Stream List Del? "
: RETURN
1270 R1$="?"
: R$(),D$,C$=" "
: R8,R=0
: SELECT PRINT 005
: PRINT HEX(03);"3270";
: IF E0$(5)="A"THEN PRINT " Active";
: PRINT " Spooler File Off-line Delete Utility ('0 = Exit)"
: PRINT
: PRINTUSING 1290,D1$,"Spooler disk address",R1$,"Delete mode"
: PRINTUSING 1290,S$,"Spooler file name"
: PRINT R9;TAB(10);"= No. reports available"
1290 % ######## = ##################### ###### = ######################
#
1300 GOSUB 950
1310 PRINT AT(T,0);BOX(3,79)
1330 PRINT AT(T,1,3*80);" Key delete mode Scroll list '11=Up '12
=Down '13=Top"
: PRINT " 1 = REPORT mode - Delete by report name regardless of stream "
: PRINT " 2 = STREAM mode - Delete by block number within a single stream"
: C$,R1$="?"
: R4$=" "
1350 PRINT AT(2,50,23);"Delete mode"
: PRINT AT(3,48,30);" "
: PRINT AT(3,41,3);R4$
: PRINT AT(4,41,38);" "
: PRINT AT(10,1);STR(R$(),1,12*80);HEX(010D)
: PRINT AT(2,41);
: K1=0
: GOTO 2680
1360 IF C$<"1"OR C$>"2"THEN 1350
: R1$=C$
: ON VAL(R1$)-48GOTO 1380,2080
: GOTO 1350
1380 PRINT AT(2,57);"by REPORT"
: IF R8=0THEN GOSUB 1710
1425 R$,R4$="?"
: R8$="N"
: PRINT AT(T,1,80);R4$;TAB(5);"Key report number '0 = Exit delete utilit
y or Continue at prompt 1";
: PRINT AT(3,48,30);"= Report number"
: IF K1=0THEN PRINT AT(T+1,1,80);" "
: IF R8=0THEN 1431
: PRINT AT(T+2,1,80);" Key space RETURN to execute or to resume or reset
list"
: GOTO 1440
1431 PRINT AT(T+2,1,80);" Key space RETURN to return to prompt 1"
1440 PRINT AT(3,40);
: LINPUT ?-R4$
: IF R4$=" "THEN 1620
: IF R4$="?"THEN 1440
: CONVERT R4$TO A
: ERRORGOTO 1440
1450 IF A<1OR A>R9THEN 1535
: DBACKSPACE #2,BEG
: DSKIP #2,INT((A+2)/3)+4S
: DATA LOAD DC #2,R0$()
: CONVERT ATO R4$,(###)
: IF A<1000THEN STR(R4$,1,POS(R4$<>30)-1)=" "
: C$=" "
: D$=HEX(00)&BIN(A,2)
: MAT SEARCHQ$()<1,Q*3>,=D$TO M$STEP 3
: IF M$>HEX(0000)THEN C$="Q"
: D$=HEX(40)&BIN(A,2)
: MAT SEARCHQ$()<1,Q*3>,=D$TO M$STEP 3
: IF M$>HEX(0000)THEN C$="Q"
1470 R$,R0$=R0$(MOD(A-1,3)+1)
: PRINT AT(4,41,38);"Name = ";STR(R$,1,18);" ";C$
: B=0
1490 B=B+1
: IF B>24THEN 1560
: A$=R$(B)
: IF STR(A$,2,3)<>R4$THEN 1490
: IF C$=" "THEN 1500
: PRINT AT(T+1,1,80);" *** Unable to delete - Requested report is queued
for listing"
: K1=1
: GOTO 1425
1500 IF STR(A$,26,1)=" "THEN 1530
1510 PRINT AT(T,1,3*80);"Add to delete list? '0 = Exit delete utility or
Continue at prompt 1"
: PRINT HEX(06);
: PRINT AT(T+1,2,2);" Type 1=Yes 2=No";
: IF STR(A$,1,1)=" "THEN 1520
: PRINT " 3=Remove report from file"
: C$="?"
: PRINT AT(T+1,2);
: K1=2
: GOTO 2680
1518 IF K1=3THEN 1525
: ON VAL(C$)-48GOTO 1550,1580,1550
: GOTO 1510
1520 C$="?"
: PRINT AT(T+1,2,2);
: K1=3
: GOTO 2680
1525 ON VAL(C$)-48GOTO 1550,1580
: GOTO 1510
1530 PRINT AT(T+1,1,80);" *** Named report is already deleted"
: K1=1
: GOTO 1425
1535 PRINT AT(T+1,1,80);" *** Report number must be 1 -";R9
: K1=1
: GOTO 1425
1550 B$=STR(R$(B),37)
: IF B$=C$THEN 1600
: IF B$=" "OR B$="D"THEN R8=R8+1
: STR(R$(B),37,1)=C$
: R8$(R8)=STR(R$(B),26,1)&STR(R$(B),2,4)
: R9$(R8)=R$(B)
: PRINT AT(10,1);STR(R$(),1,12*80);HEX(010D)
: GOTO 1600
1560 PRINT AT(T+1,1,80);" *** Report requested is not in this display."
: K1=1
: GOTO 1425
1580 IF STR(R$(B),37,1)=" "THEN 1600
: STR(R$(B),37,1)=" "
: IF R8<>0THEN R8=R8-1
: PRINT AT(10,1);STR(R$(),1,12*80);HEX(010D)
: A=0
1590 A=A+1
: IF STR(R8$(A),2,3)<>STR(R$(B),2,3)THEN 1590
: FOR B=ATO R8
: R8$(B)=R8$(B+1)
: R9$(B)=R9$(B+1)
: NEXT B
: INIT(FF)R8$(B+1)
: INIT(20)R9$(B+1)
1600 PRINT AT(T+1,0,2*80);AT(5,0);R8;TAB(10);"= No. reports queued to delete"
: GOTO 1425
1620 IF R8<>0THEN 1630
: K1=0
: GOTO 1330
1630 PRINT AT(11,1,12*80);AT(10,1)
: FOR A=1TO R8
: PRINT R9$(A);
: NEXT A
1650 PRINT AT(T,1,3*80);"Ready to execute? '0 = Exit delete utility or Cont
inue at prompt 1"
: PRINT HEX(06);
: PRINT AT(T+2,1);" Type 1=Yes 2=No, reset list 3=No, resume list"
1660 C$="?"
: PRINT AT(T+2,0);
: LINPUT ?-C$
: ON VAL(C$)-48GOTO 1690,1270,1670
: GOTO 1650
1670 PRINT AT(10,1);STR(R$(),1,12*80);HEX(010D)
: GOTO 1425
1690 IF R>0THEN 3150
: PRINT AT(T+2,5);"No reports to delete"
: GOTO 1660
1710 INIT(FF)R8$()
: FOR A=1TO R
: A$=R$(A)
: IF STR(A$,37,1)<>"D"THEN 1720
: IF STR(A$,31,1)="Q"THEN 1720
: STR(A$,37,1)="1"
: R8=R8+1
: R8$(R8)=STR(A$,26,1)&STR(A$,2,3)
1720 NEXT A
: RETURN
2080 PRINT AT(2,57);"by STREAM"
: S1$="?"
: PRINT AT(3,48,30);"= Print stream"
: PRINT AT(T,1,3*80);S1$;TAB(5);"Key print stream -- Streams available ar
e: 1 or 2 or 3 or 4"
: FOR A=1TO 4
: PRINTUSING " # = Strm ## blocks received = ##### ";A," ";B2$(A);
: NEXT A
2130 INIT(20)R$()
: R=0
: PRINT AT(3,41,2);
: C$=" "
: K1=4
: GOTO 2680
2135 S1$=C$
: IF S1$=" "THEN 1270
: IF S1$="?"THEN 2130
: IF S1$<"1"OR S1$>"4"THEN 2250
: B1$="00001"
: R8$="N"
: S1=VAL(S1$)-48
: B2$=B2$(S1)
: PRINT AT(T,1,3*80)
: IF B2$="00000"THEN 2285
: PRINT AT(11,0,12*80)
: R,B9=0
: GOSUB 950
: PRINT AT(10,1);STR(R$(),1,12*80);HEX(010D)
: B1=1
: CONVERT B2$TO B9
: IF B9=0THEN B9=B2(S1)
2190 PRINT AT(4,48,30);"= ending block"
: PRINT AT(4,40);
: LINPUT -B2$
: CONVERT B2$TO B2
: ERRORGOTO 2270
2200 IF B2=0THEN 2080
: IF B2<1OR INT(B2)<>B2OR B1>B2OR B2>B9THEN 2270
: R$=S1$
: STR(R$,2)=B1$
: STR(R$,7)=B2$
: R=1
2230 PRINT AT(T,1,3*80);"Ready to execute? '0 = Exit delete utility or Cont
inue at prompt 1"
: PRINT HEX(06);
: PRINT AT(T+2,1);" Type 1=Yes 2=No, reset list 3=No, resume list"
2240 C$="?"
: K1=0
: PRINT AT(T+2,0);
: LINPUT ?-C$
: ON VAL(C$)-48GOTO 2290,1270,2080
: GOTO 2230
2250 PRINT AT(T+1,1,80);" *** Stream number must be 1 or 2 or 3 or 4"
: GOTO 2130
2270 PRINT AT(T+2,1,80);"Block number must be numeric value ";B1;" -";B9;" or
else 0"
: GOTO 2190
: PRINT AT(T+1,1,80);" *** Unable to delete - stream ";S1$;" is queued f
or printing"
: GOTO 2130
2285 PRINT AT(T+1,1,80);" *** Unable to delete - there is no data in stream
";S1$
: GOTO 2130
2290 IF R>0THEN 3150
: PRINT AT(T+2,5);"No reports to delete"
: GOTO 2240
2675 IF B$=HEX(08)THEN B$=" "
: C$=B$
2680 SELECT PRINT 005
: IF C$=" "THEN C$="?"
: PRINT C$;HEX(0805);
: KEYIN B$,,2700
: IF B$<>HEX(0D)THEN 2675
: ON K1+1GOTO 1360,1360,1518,1518,2135
: STOP #
2700 ON VAL(B$)-10GOSUB 2720,2730,2750
: IF VAL(B$)=13THEN 1330
: IF VAL(B$)=0THEN 300
: IF VAL(B$)<>0AND VAL(B$)>13OR VAL(B$)<11THEN 2675
: K1=0
: GOTO 1310
2720 GOSUB 3050
: GOSUB 3080
: GOSUB 2770
: RETURN
2730 GOSUB 3050
: GOSUB 3060
: GOSUB 2770
: RETURN
2750 A=0
: DBACKSPACE #2,BEG
: GOSUB 960
: RETURN
2770 R=0
: Z=10
: DBACKSPACE #2,BEG
: DSKIP #2,5S
: T9=R9
: PRINT AT(T+4,0,13*80);
: GOSUB 1210
: IF T8=0THEN 2800
: Z9=T8/3
: IF Z9<1THEN 2800
: DSKIP #2,Z9S
2800 DATA LOAD DC #2,R0$()
: IF END THEN 2850
: IF R0$(1)=" "THEN 2850
: GOSUB 2890
: IF Z>21.5THEN RETURN
: IF R0$(2)=" "THEN 2850
: GOSUB 2890
: IF Z>21.5THEN 3120
: IF R0$(3)=" "THEN 2850
: GOSUB 2890
: IF Z>21.5THEN 3130
: IF T8<R9THEN 2800
2850 IF T8=R9AND Z6$="1"THEN 2860
: IF Z>21.5THEN 2860
: DBACKSPACE #2,BEG
: DSKIP #2,5S
: T8=0
: GOTO 2800
2860 IF Z4<R9THEN GOSUB 2870
: Z7=T8
: RETURN
2870 IF (MOD(T8,3))=2THEN T8=T8-2
: IF (MOD(T8,3))=1THEN T8=T8-1
: RETURN
2890 A$=R0$(MOD(T8,3)+1)
: T8=T8+1
: IF STR(A$,24,1)=" "THEN RETURN
: C$=" "
: IF R1$<>"2"THEN 2980
: IF STR(A$,24,1)<>S1$THEN RETURN
: D$=HEX(40)&BIN(T8,2)
: MAT SEARCHQ$()<1,Q*3>,=D$TO M$STEP 3
: IF M$=HEX(0000)THEN 2930
: GOTO 2935
2930 D$=HEX(00)&BIN(T8,2)
: MAT SEARCHQ$()<1,Q*3>,=D$TO M$STEP 3
: IF M$=HEX(0000)THEN 2960
2935 C$="Q"
: IF B9>0THEN 2960
: CONVERT STR(A$,26,3)TO B9
: CONVERT B9-1TO B2$,(###)
2950 % ### ################## # # ### - ### !
2960 INIT(00)W$
: R=R+1
: IF STR(A$,30,3)="000"THEN STR(W$,3,1)="*"
: R$(R)=STR(W$,3)
: PRINTUSING TO W$,2950,T8,STR(A$,1,18),STR(A$,24,1),C$,STR(A$,26,3),STR(A$
,30,3);
: Z=Z+.5
: IF Z<22THEN RETURN
: GOTO 2860
2980 D$=HEX(40)&BIN(T8,2)
: MAT SEARCHQ$()<1,Q*3>,=D$TO M$STEP 3
: IF M$=HEX(0000)THEN 2990
: C$="D"
: S1$="Q"
: GOTO 3030
2990 S1$=" "
: D$=HEX(00)&BIN(T8,2)
: MAT SEARCHQ$()<1,Q*3>,=D$TO M$STEP 3
: IF M$>HEX(0000)THEN S1$="Q"
: IF S1$<>" "THEN 3030
: C$=STR(A$,20,1)
3020 % ### ################## # # # !
3030 INIT(00)W$
: PRINTUSING TO W$,3020,T8,STR(A$,1,18),STR(A$,24),S1$,C$;
: R=R+1
: IF STR(A$,30,3)="000"THEN STR(W$,3,1)="*"
: R$(R)=STR(W$,3)
: Z=Z+.5
: IF Z<22THEN RETURN
: GOTO 2860
3050 Z6$="0"
: Z4=24
: IF Z4>R9THEN Z4=R9
: RETURN
3060 IF Z7=R9THEN 3070
: T8=Z7
: RETURN
3070 Z6$="1"
: T8=0
: RETURN
3080 Z5=Z7-(Z4-1)
: IF Z5<0THEN GOSUB 3090
: IF Z5=1AND Z7=R9THEN Z6$="1"
: T8=Z5-(Z4-1)-1
: IF T8<0THEN GOSUB 3100
: T8=T8-1
: IF T8=0THEN Z6$="1"
: RETURN
3090 Z5=R9+Z5
: IF (MOD(Z5,3))=0THEN Z5=Z5+1
: IF (MOD(Z5,3))=2THEN Z5=Z5+2
: RETURN
3100 T8=R9+T8
: ON (MOD(T8,3))+1GOTO 3120,,3130
: RETURN
3120 T8=T8+1
: RETURN
3130 T8=T8+2
: RETURN
3150 PRINT AT(T,0,3*80);AT(T+1,32);"D E L E T I N G"
: A$="32WPRECM32WPRECI"
: LOAD DC T#0,<2>A$240,3130BEG 3160
3160 IF R1$="1"THEN GOSUB 3490
: IF R1$="2"THEN GOSUB 3210
: A$="B327045"
: LOAD DC T#0,<1>A$4000,9999BEG 3180
3180 GOTO 230
3210 B1=1
: B2=B2+1
: GOSUB 3900
: PRINT AT(11,0)
: A=0
3220 A=A+1
: A$=R$(A)
: IF A$=" "THEN 3290
: CONVERT STR(A$,30,3)TO B1
: IF B1>=B2THEN 3290
: STR(A$,6,27)="<< removed data >> 0 xxx"
: R$(A)=A$
: GOTO 3220
3290 R=A-1
: FOR C=1TO R
: PRINT R$(C);
: NEXT C
: A=0
: DBACKSPACE #2,BEG
: DSKIP #2,5S
3320 B=0
: DATA LOAD DC #2,R0$()
: IF END THEN 3410
: FOR I=1TO 3
: A=A+1
: IF STR(R0$(I),24,1)<>S1$THEN 3380
: A$=R0$(I)
: B=1
: CONVERT STR(A$,26,3)TO C
: IF C>=B2THEN 3360
: R0$(I)="<< removed data >> 0 xxx "&STR(A$,30,3)
: GOTO 3380
3360 C=C-B2+1
: CONVERT CTO STR(A$,26,3),(###)
: STR(R0$(I),1,39)=A$
3380 NEXT I
: IF B=0THEN 3400
: DBACKSPACE #2,1S
: DATA SAVE DC #2,R0$()
3400 IF A<R9THEN 3320
3410 R8=0
: RETURN
3490 PRINT AT(T,1,75);"Deleting ";R8;"Reports"
: MAT SORTR8$()TO Q8$,Q8$()
: PRINT AT(11,1,11*80);AT(10,1)
: FOR A=1TO R8
: A$=R8$(VAL(Q8$(A),2))
: B=0
3540 B=B+1
: IF STR(R$(B),2,3)<>STR(A$,2,3)THEN 3540
: PRINT R$(B);
: NEXT A
: A9=0
: FOR D=1TO R8
: A$=R8$(VAL(Q8$(D),2))
: B=0
3560 B=B+1
: IF STR(R$(B),2,3)<>STR(A$,2,3)THEN 3560
: A$=R$(B)
: S1$=STR(A$,26)
: S1=VAL(S1$)-48
: STR(R$(B),6,27)="<< removed data >> 0 xxx"
: GOSUB 3650
: IF C>0THEN 3605
: C=B2(S1)-A8
3605 A9=A9+C
: B1=A8
: B2=B1+C
: PRINT AT(T,40);A9;" vaus total"
: GOSUB 3900
: NEXT D
: R8=0
: RETURN
3650 CONVERT STR(A$,2,3)TO A
: DBACKSPACE #2,BEG
: DSKIP #2,INT((A+2)/3)+4S
: DATA LOAD DC #2,R0$()
: IF END THEN 3830
: B=MOD(A-1,3)+1
: A$=R0$(B)
: CONVERT STR(A$,26,3)TO A8
: CONVERT STR(A$,30,3)TO C
: R0$(B)="<< removed data >> 0 xxx "&STR(A$,30,3)
: IF B=3THEN 3810
: FOR I=BTO 3
: GOTO 3740
3720 DATA LOAD DC #2,R0$()
: IF END THEN 3830
: B=0
: FOR I=1TO 3
: A=A+1
3740 IF STR(R0$(I),24,1)<>S1$THEN 3800
: A$=R0$(I)
: B=1
: IF C>0THEN 3750
: CONVERT STR(A$,26,3)TO C
: C=C-A8
3750 CONVERT STR(A$,26,3)TO B1
: CONVERT B1-CTO STR(A$,26,3),(###)
: STR(R0$(I),1,39)=A$
3800 NEXT I
3810 IF B=0THEN 3820
: DBACKSPACE #2,1S
: DATA SAVE DC #2,R0$()
3820 IF A<R9THEN 3720
3830 RETURN
3900 I=B2-B1
: PRINT HEX(06);AT(T+2,30);I;"blocks ";B1;" to ";B2-1
: GOSUB '223(D0(S1),B1,I)
: ON POS(HEX(002524)=R1$)GOTO 3990,3940,3970
: PRINT "WP ERROR R1$=(";HEXOF(R1$);")"
: STOP #
3940 STOP "P$=HEX(25) "#
3970 RETURN CLEAR
: PRINT HEX(0607);AT(T+2,0,5*80);"No ";
: IF I>1THEN PRINT "more";
: PRINT " Data in Spooled Print Stream";S1$
3980 C$=" "
: LINPUT ?-C$
: GOTO 3980
3990 B2(S1)=V0
: CONVERT V0TO B2$(S1),(#####)
: RETURN