image of READY prompt

Wang2200.org

Listing of file='IDS2PR52' on disk='vmedia/701-2716B.wvd.zip'

# Sector 573, program filename = 'IDS2PR52'
1000 REM "IDS2PR52" - Release 2.1 - ARCHIVE REPORTS
1005 E6$=F6$(17)AND HEX(02)
   : IF E6$=HEX(00)THEN LOAD T#2,"IDS2SUB8"3701,3899BEG 1010
1010 IF F6$(17)<"^"THEN SELECT @PART"IDS2SUBM"
   : DIM F2$(32)8,J3$4
   : IF C5$="R"THEN J3$=HEX(8201D3F2)
   : ELSE J3$=HEX(8201D3E2)
   : GOSUB '43(1)
   : J1=Q
   : GOSUB '43(5)
   : E1$=E$
   : GOSUB '43(6)
   : E2$=E$
   : DATA LOAD BA T#3,(0)F2$()
   : J2=VAL(STR(F2$(),2))-1
   : FOR I=0TO J2
   : PRINT HEX(06020402000E);AT(19,15);"Scanning disk catalog for files in sec
     tor";I;
1050 DATA LOAD BA T#3,(I)F2$()
   : FOR J3=2TO 32STEP 2
   : IF VAL(F2$(J3))=0THEN 2500
   : IF STR(F2$(J3-1),,2)<>HEX(1080)THEN 2500
   : IF VER(F2$(J3),"IDS2wS##")=8THEN 2500
   : IF F2$(J3)<E1$THEN 2500
   : IF E2$<>" "AND F2$(J3)>E2$THEN 2500
   : E$=F2$(J3)OR ALL(20)
   : LIMITS T#3,E$,A,B,C,D
   : IF D=0OR E$=F2$(J3)THEN 2500
   : IF C>135THEN 1229
   : DATA LOAD BA T#3,(A)E4$()
   : IF STR(E4$(),,4)<>J3$THEN 2500
1160 IF E$(29)<>" "AND E$(29)<>STR(E4$(),65,1)THEN 2500
   : IF J1$<>" "AND J1$<>STR(E4$(),66,3)THEN 2500
   : IF J2$<>" "AND J2$<>STR(E4$(),69,4)THEN 2500
   : IF STR(E$(),37,3)<>" "AND STR(E$(),37,3)<>STR(E4$(),62,3)THEN 2500
   : IF STR(E4$(),74,3)<>" "AND STR(E4$(),74,3)<>R4$THEN 2500
   : F8=A
   : MAT REDIM F$(18)83
   : DATA LOAD DA T#3,(F8)F$()
   : E$=STR(F$(),18,32)
1220 MAT REDIM F$(E9)1
   : PRINT AT(19,0,80);"Processing file: ";HEX(22);STR(F2$(J3),,8);HEX(22);"
       Description: ";HEX(22);STR(E$,,32);HEX(22)
   : E1=0
   : CONVERT STR(F$(),152,3)TO J
   : CONVERT STR(F$(),155,2)TO N
   : CONVERT STR(F$(),157,3)TO O
   : CONVERT STR(F$(),845,3)TO M
   : Z=ABS(INT(-9*J/249))
   : J=ABS(INT(-8*J/249))
   : O=MAX(1,ABS(INT(-9*O/249)))
1228 M=INT(256/(M+5))
   : N=MAX(1,ABS(INT(-N/M)))
   : IF C5$="B"THEN N=0
   : E3,E4=8+Z+J+O+N
   : IF E3<=B-F8+1THEN 1230
1229 F0$="Error in control file for report "&F2$(J3)&" EXEC to bypass"
   : GOSUB '35(F0$)
   : F6$(11)="N"
   : GOSUB '34(250)
   : IF Q=31THEN 1575
   : GOTO 2500
1230 GOSUB '60(E1$(2),F2$(J3))
1240 PRINT AT(20,63);
   : PRINTUSING 1250,E1
1250 %#### edit records
1260 F6$(14)="N"
   : GOSUB '62(E1$(2),1,0)
   : F6$(14)="Y"
   : IF Q=0OR STR(F$(),7,8)<>STR(F2$(J3),,8)THEN 1500
   : STR(E2$(),E1*2+250,2)=STR(F3$,,2)
   : E1=E1+1
   : E3=E3+1
   : GOTO 1240
1500 IF J1>2THEN 2110
   : LIMITS T#D1,F2$(J3),A,B,C,D
   : IF D=2AND B-A+1>=E3THEN 2000
   : IF D=0THEN 1800
   : E$="Output file is too small - EXEC=Create new file, FN'0=Bypass file, FN
     '31=Cancel"
   : GOSUB '63(STR(E$,,16),STR(E$,17),"!")
   : GOSUB '34(250)
   : IF Q<>31THEN 1580
1575 F6$(14)="Y"
   : COM CLEAR D1
   : LOAD T#2,R3$(1)1000,
1580 IF Q=0THEN 2410
   : SCRATCH T#D1,F2$(J3)
   : LIMITS T#D1,F2$(J3),A,B,C,D
   : IF B-A+1>=E3THEN 1690
   : F5$="JUNK"
   : Z=-1
1630 Z=Z+1
   : CONVERT ZTO STR(F5$,5,4),(####)
   : LIMITS T#D1,F5$,A,B,C,D
   : IF D<>0THEN 1630
   : DATA SAVE DC OPEN T#D1,(F2$(J3))F5$
   : DATA SAVE DC #D1,END
   : SCRATCH T#D1,F5$
   : GOTO 1500
1690 DATA SAVE DC OPEN T#D1,(F2$(J3)),F2$(J3)
   : DSKIP #D1,E3-2S
   : DATA SAVE DC #D1,END
   : GOTO 1500
1800 DATA SAVE DC OPEN T#D1,(E3)F2$(J3)
   : ERRORF6$(14)="Y"
   : GOSUB '63("Not enough room ","on archive disk - mount new disk or select
     FN '31 to cancel","!")
   : GOSUB '34(250)
   : IF Q<>31THEN 1800
   : COM CLEAR D1
   : LOAD T#2,R3$(1)1000,
1810 DSKIP #D1,E3-2S
   : DATA SAVE DC #D1,END
   : GOTO 1500
2000 LIMITS T#D1,F2$(J3),C2,B,C,D
   : GOSUB 3020
   : E$=F2$(J3)OR ALL(20)
   : LIMITS T#3,E$,F8,J7,C1,Z
   : COPY T#3,(F8,F8+E4-2)TO T#D1,(C2)
   : MAT REDIM F$(256)1
   : DATA LOAD BA T#D1,(C2)F$()
   : STR(F$(),4,1)=AND HEX(DF)
   : DATA SAVE BA T#D1,(C2)F$()
   : MAT REDIM F$(E9)1
   : C2=C2+E4-2
   : F$()=" "
2040 IF E1=0OR J1>2THEN 2090
   : FOR J8=1TO E1
   : GOSUB 3000
   : MAT REDIM F$(E9)1
   : PRINT AT(20,0);
   : PRINTUSING 2400,"Archiving",J8,STR(F$(),14)
   : STR(F$(),,1)=" "
   : MAT REDIM E4$(3)83
   : E4$()=F$()
   : DATA SAVE DA T#D1,(C2,C2)E4$()
   : MAT REDIM E4$(16)16,F$(E9)1
   : NEXT J8
2090 DATA SAVE DA T#D1,(C2)END
2110 IF E1=0OR J1=2THEN 2150
   : FOR J8=1TO E1
   : GOSUB 3000
   : PRINT AT(20,0);
   : PRINTUSING 2400,"Deleting",J8,STR(F$(),14)
   : E6$=STR(F$(),3)AND HEX(3F)ADDHEX(20)
   : HEXUNPACKSTR(F$(),2,1)TO F9$
   : $TRAN(F9$," 0$1+2,3-4.5061728394A5B6C7D8E9F")R
   : E$=STR(F$(),6,16)&E6$&F9$
2120 GOSUB '41("IDS2fs00",E$,0.5)
   : IF Q>0THEN 2130
   : IF Q=0THEN GOSUB '38(15," ")
   : ELSE GOSUB '35("Record is in use")
   : GOTO 2140
2130 F$()=" "
   : GOSUB '42("IDS2fs00",0)
2140 NEXT J8
2150 GOSUB 3010
   : IF J1=5THEN SCRATCH T#3,F2$(J3)
   : IF E1$<E2$OR E2$=" "THEN 2410
   : J3=32
   : I=J2
2400 %######### edit number #####     Operation =  "########"
2410 PRINT AT(19,0,80);AT(20,0,80)
2500 NEXT J3,I
   : F6$(14)="Y"
   : LOAD T#2,"IDS2PS51"1000,
3000 T=0
   : GOSUB '67(2,STR(E2$(),J8*2+248,2),0)
   : MAT REDIM F$(3)83
   : DATA LOAD DA T#2,(U)F$()
   : MAT REDIM F$(E9)1
   : RETURN
3010 X=VAL(STR(E1$(2),48),2)*VAL(STR(E1$(2),43),2)
   : Y=0
   : FOR J8=0TO VAL(STR(E1$(2),43),2)-1
   : DATA LOAD BA T#2,(VAL(STR(E1$(2),55),2)+J8*VAL(STR(E1$(2),46),2))E4$()
   : Y=Y+VAL(STR(E4$(),9),2)
   : NEXT J8
   : GOSUB '55(3,Y*100/X)
   : GOSUB '55(4,X-Y)
   : RETURN
3020 MAT REDIM E4$(256)1
   : E4$()=HEX(A0)&BIN(E3,2)&ALL(00)
   : IF B>0THEN DATA SAVE BA T#D1,(B)E4$()
   : RETURN
3699 ON ERRORE1$,E2$GOTO 3700
3700 DEFFN'31
   : E$="IDS2PR52"
   : IF E5$<"Y"THEN LOAD T#2,"IDS2PER1"1000,
   : STOP "ERROR"