Listing of file='IDS2PF14' on disk='vmedia/701-2715B.wvd.zip'
# Sector 181, program filename = 'IDS2PF14' 1000 REM "IDS2PF14" - DATA FILE EDITOR - FILE INITIALIZATION MODULE 1015 IF F6$(17)<"^"THEN SELECT @PART"IDS2SUBM" : DIM C(8),C1(8),D(8),J(8) : IF E$="Y"THEN D9=1 : ELSE D9=0 : MAT REDIM E3$(9)83,E0$(31)8 : E0$()=E3$() : IF F6$(53)="Y"AND STR(F4$,4,8)<>"IDS2PCST"THEN 1023 : DIM J$8 : J$="IDS2fsXX" : A=(R0-#PART)/16+1 : IF A>0THEN CONVERT ATO STR(J$,7,2),(##) : DATA LOAD DC OPEN T#2,J$ 1022 DATA LOAD DC #2,E3$() : E$=STR(E3$(),#PART*45-17,45) : GOTO 1100 1023 LIMITS T#4,STR(F4$,4,8),A,J,J,J : DATA LOAD BA T#4,(A+2)STR(E3$(),,256) : E$=STR(E3$(),92,45) : GOTO 1100 1100 FOR F9=1TO 31 : IF E0$(F9)=" "THEN 3130 : ELSE F1$=E0$(F9)OR ALL(20) : SELECT PRINT 405 : IF D9=1THEN PRINT HEX(060F);AT(22,9);BOX(1,60);" Now initializing file Processing is % complete"; : IF D9=1THEN PRINT HEX(06020402000E);AT(22,32,8);E0$(F9);AT(22,56); : D1=-1 : GOSUB '39(F1$,5) : IF Q=2THEN 1170 1162 F0$="Control file "&F1$&" does not exist" : GOSUB '35(E$) : GOTO 3130 1170 MAT REDIM E3$(6)83 : DATA LOAD DA T#P,(A)E3$() : MAT J=ZER : MAT D=ZER : C1=VAL(STR(E3$(),403)) : C2=VAL(STR(E3$(),404)) : C3=VAL(STR(E3$(),416)) : C4=VAL(STR(E3$(),417)) : C5=VAL(STR(E3$(),418)) : C6=VAL(STR(E3$(),419)) : C7=VAL(STR(E3$(),440),2) : C8=VAL(STR(E3$(),435),2) : D3=100/C7/C8 : C9=VAL(STR(E3$(),437))/8 : J1=VAL(STR(E3$(),442)) : J2=VAL(STR(E3$(),443)) 1206 STR(E3$(),251,3)=STR(E3$(),105) : FOR I=1TO C2 : MAT SEARCHE$,=STR(E3$(),I*3+248,3)TO J$STEP 3 : D(I)=INT((VAL(J$,2)+2)/3) : LIMITS T#D(I),E0$(F9),C(I),B,C,D : IF C(I)>0AND C<=B-C(I)+1THEN 1216 1215 GOSUB '35("File has not been allocated -- please cancel") : F6$(11)="N" : GOSUB '34(250) : IF Q<>31THEN 1215 : GOTO 3130 1216 DATA LOAD BA T#D(I),(B)STR(E4$(),,256) : STR(E4$(),10,11)="Release 2.1" : DATA SAVE BA T#D(I),(B)STR(E4$(),,256) : C=C-2 : IF I=1THEN J4=C/VAL(STR(E3$(),435),2) : IF I=1THEN C=C-C9*8*C8 : J(I)=MIN(C/C8/J1*J2,C7) : IF I>1THEN J(I)=MIN(J(I)+J(I-1),C7) : NEXT I : MAT REDIM E2$(E9)1 : IF C1=1OR C1>4THEN 1300 : UNPACK(####)STR(E3$(),405,6)TO A,B,C : J3=A+1-B-C 1236 E2$()=HEX(FF) : IF B+C>0THEN STR(E2$(),2,B+3*C)=ALL(00) : IF C1=4THEN 1300 : STR(E2$(),1+INT(249*J1/J2))=STR(E2$(),1) : MAT REDIM E2$(J1*3)83 1300 N=0 : MAT C1=C : MAT REDIM E3$(24)83 : E4$()=ALL(FF) : FOR I=0TO C8-1 : C1(1)=C(1)+I*J4+C9*8 : R=0 : B=0 : V=1 : E3$()=BIN(C9-1)&HEX(01)&BIN(10+C9*C6)&BIN(C6*MIN(C7-1+C9,INT(1983/C6)-1)+ 10,2)&HEX(00000000)&ALL(FF) : IF C1<2OR C1>3THEN 1500 : FOR K=1TO C9 : Y=0 : X=MIN(C7-1,K*INT(1983/C6)-C9-1) 1371 Y=Y+1 : IF X>=J(Y)THEN 1371 : IF Y>1THEN X=X+2097152*(Y-1)-J(Y-1) : X=X+I*J(Y) : IF Y>1THEN X=X-I*J(Y-1) : F3$=BIN(MOD(X,65536),2)&BIN(INT(X/65536)) : ON C2GOTO 1425 : FOR L=2TO C2 : IF X>=J(L-1)AND X<J(L)THEN STR(F3$,3,1)=STR(F3$,3,1)OR BIN((L-1)*32) : NEXT L 1425 IF C1=2OR C1=3THEN STR(E4$(),C3+1)=F3$ : IF C1=4THEN STR(E4$(),C3+1)=E2$() : STR(E3$(),10+(K-1)*C6,C6)=E4$() : NEXT K 1500 P=VAL(STR(E3$(),3)) 2000 R=R+1 : ON C1GOTO 2065,,,2060 : IF C1>4THEN 2065 : IF R>J(V)THEN V=V+1 : X=N+I*(J(V)-J(C2)) : IF V>1THEN X=X-(I+1)*J(V-1) : F3$=BIN(MOD(X,65536),2)&BIN((V-1)*32+INT(X/65536)) : STR(E4$(),C3+1)=F3$ 2060 STR(E3$(),P,C6)=E4$() 2065 P=P+C6 : N=N+1 : IF C1=1OR C1>3THEN 3000 : IF R3$(1)="IDS2PU89"THEN 3000 : IF R=C7OR MOD(R,J2)=0THEN DATA SAVE DA T#D(V),(C1(V),C1(V))E2$() 3000 D2=ROUND((N*D3,0) : IF D1=D2OR D9=0THEN 3010 : D1=D2 : PRINTUSING 3120,D1,HEX(08080808); 3010 IF P+C6<=1993AND R<C7THEN 2000 : DATA SAVE DA T#D(1),(C(1)+I*J4+B)E3$() : B=B+8 : IF R=C7THEN 3110 : E3$()=BIN(C9-(B+8)/8)&HEX(000A)&BIN(10+C6*(MIN(INT(1983/C6),C7-R)-1),2)&H EX(00000000)&ALL(FF) : P=10 : GOTO 2000 3110 NEXT I,F9 3120 %###%#### 3130 MAT REDIM E2$(250)9,E3$(249)8,E0$(249)1 : SELECT PRINT 005 : P=4 : IF STR(R3$(1),,4)="IDS2"THEN P=2 : LOAD T#P,R3$(1)1000, 3699 ON ERRORE1$,E2$GOTO 3700 3700 DEFFN'31 : E$="IDS2PF14" : IF E5$<"Y"THEN LOAD T#2,"IDS2PER1"1000, : STOP "ERROR"