Listing of file='IDS2PS53' on disk='vmedia/701-2715B.wvd.zip'
# Sector 233, program filename = 'IDS2PS53'
1000 REM "IDS2PS53" - Release 2.1 - RETRIEVE ARCHIVED SCREEN
1010 IF F6$(17)<"^"THEN SELECT @PART"IDS2SUBM"
: DIM F2$(32)8
: F6$(14)="N"
: GOSUB '43(1)
: J1=Q
: GOSUB '43(5)
: E1$=E$
: GOSUB '43(6)
: E2$=E$
: DATA LOAD BA T#D1,(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;
: DATA LOAD BA T#D1,(I)F2$()
: FOR J3=2TO 32STEP 2
1060 IF VAL(F2$(J3))=0OR STR(F2$(J3-1),1,2)<>HEX(1000)OR VER(F2$(J3),"IDS2wS##
")=8THEN 2670
: IF F2$(J3)<E1$THEN 2670
: IF E2$<>" "AND F2$(J3)>E2$THEN 2670
: X=VAL(STR(F2$(J3-1),3),2)
: DATA LOAD BA T#D1,(X)E4$()
: IF STR(E4$(),,4)<>HEX(8201D3E1)AND STR(E4$(),,4)<>HEX(8201D3F3)THEN 2670
: IF E$(29)<>" "AND E$(29)<>STR(E4$(),45,1)THEN 2670
1110 IF J1$<>" "AND J1$<>STR(E4$(),46,3)THEN 2670
: IF J2$<>" "AND J2$<>STR(E4$(),49,4)THEN 2670
: IF STR(E$(),37,3)<>" "AND STR(E$(),37,3)<>STR(E4$(),148,3)THEN 2670
: IF STR(E4$(),54,3)<>" "AND STR(E4$(),54,3)<>R4$THEN 2670
1210 F8=VAL(STR(F2$(J3-1),3),2)
: MAT REDIM F$(24)83
: DATA LOAD DA T#D1,(F8)F$()
: MAT REDIM F$(E9)1
: E$=STR(F$(),10,24)&ALL(00)
: FOR K=1TO 32
: ROTATEC(STR(E$,K),-2)
: NEXT K
: ADD(E$,20)
: F$(1)=HEX(F3)
1220 PRINT AT(19,0,80);"Processing file: ";HEX(22);STR(F2$(J3),1,8);HEX(22);"
Description: ";HEX(22);STR(E$,1,32);HEX(22)
: E1=0
: E3=10+(VAL(F$(137))+VAL(F$(138)))/3
: LIMITS T#D1,F2$(J3),F8,B,C,D
: E4=F8+E3-2
1240 PRINT AT(20,63);
: PRINTUSING 1250,E1
1250 %#### edit records
1260 IF E4-F8>=C-2THEN 1500
: E4$()=" "
: MAT REDIM E4$(3)83
: DATA LOAD DA T#D1,(E4)E4$()
: IF END THEN 1500
: E1=E1+1
: E4=E4+1
: GOTO 1240
1500 MAT REDIM E4$(16)16
1510 E$=F2$(J3)
: LIMITS T#3,E$,A,B,C,D
: IF D=2AND B-A+1>=E3THEN 2510
: IF D=0THEN 2000
: E$="File is a"
: IF D<0THEN E$=E$&" scratched"
: IF ABS(D)=2THEN E$=E$&" data"
: ELSE E$=E$&" program"
: E$=E$&" file - EXEC=Overwrite, FN'0=Bypass, FN'31=Cancel"
: GOSUB '63(STR(E$,1,16),STR(E$,17),"!")
: GOSUB '34(250)
1580 IF Q<>31THEN 1590
: F6$(14)="Y"
: COM CLEAR D1
: LOAD T#2,R3$(1)1000,
1590 IF Q=0THEN 2660
: E$=F2$(J3)
: SCRATCH T#3,E$
: LIMITS T#3,E$,A,B,C,D
: IF B-A+1>=E3THEN 1700
: F5$="JUNK"
: Z=-1
1640 Z=Z+1
: CONVERT ZTO STR(F5$,5,4),(####)
: LIMITS T#3,F5$,A,B,C,D
: IF D<>0THEN 1640
: DATA SAVE DC OPEN T#3,(E$)F5$
: DATA SAVE DC #3,END
: SCRATCH T#3,F5$
: GOTO 1510
1700 DATA SAVE DC OPEN T#3,(E$),E$
: DSKIP #3,E3S
: DATA SAVE DC #3,END
: GOTO 1510
2000 J=27
: DATA SAVE DC OPEN T#3,(J)E$
: ERRORF6$(14)="Y"
: GOSUB '35("Not enough room on screen disk")
: COM CLEAR D1
: LOAD T#2,R3$(1)1000,
2010 DSKIP #3,E3-2S
: DATA SAVE DC #3,END
: GOTO 1510
2510 LIMITS T#3,E$,C2,Z,Z,Z
: LIMITS T#D1,F2$(J3),F8,J7,C1,Z
: COPY T#D1,(F8,F8+E3-3)TO T#3,(C2)
: E4=F8+E3-2
: MAT REDIM F$(256)1
: DATA LOAD BA T#3,(C2)F$()
: IF STR(F$(),1,4)=HEX(8201D3E1)OR STR(F$(),1,4)=HEX(8201D3F3)THEN 2540
: GOSUB '35("Error in archived file -- bypassing")
: GOTO 2670
2540 STR(F$(),4,1)=HEX(F3)
: DATA SAVE BA T#3,(C2)F$()
: IF E1=0THEN 2640
: V=2
: GOSUB '47
: FOR J8=1TO E1
: MAT REDIM F$(E9)1
: F$()=" "
: IF E4-F8>=C1-2THEN 2640
: MAT REDIM F$(3)83
: DATA LOAD DA T#D1,(E4,E4)F$()
: MAT REDIM F$(E9)1
: PRINT AT(20,0);
: PRINTUSING 2600,J8,STR(F$(),14)
2600 %Retrieving edit number ##### Field name = "########"
2610 GOSUB '66(2,0)
: STR(E$(),999)=F$()
: F6$(14)="N"
: E$=STR(F$(),7,16)&STR(F$(),3,1)&STR(F$(),,2)
: GOSUB '41(E1$(2),E$,.5)
: F$()=STR(E$(),999)
: GOSUB '42(E1$(2),0)
: F6$(14)="Y"
: NEXT J8
2640 GOSUB 2690
: IF E1$<E2$OR E2$=" "THEN 2660
: J3=32
: I=J2
2660 PRINT AT(19,0,80);AT(20,0,80)
2670 NEXT J3,I
: F6$(14)="Y"
: LOAD T#2,"IDS2PS51"1000,
2690 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
3699 ON ERRORE1$,E2$GOTO 3700
3700 DEFFN'31
: E$="IDS2PS53"
: IF E5$<"Y"THEN LOAD T#2,"IDS2PER1"1000,
: STOP "ERROR"