Listing of file='IDS2PP31' on disk='vmedia/701-2724B.wvd.zip'
# Sector 771, program filename = 'IDS2PP31' 1000 REM IDS2PP31 1010 IF F6$(17)<"^"THEN SELECT @PART"IDS2SUBM" : GOSUB '39(STR(C8$,,8),3) : MAT REDIM E$(24)83 : DATA LOAD DA T#P,(A)E$() : MAT REDIM E$(E8)1 : IF E$(137)=HEX(00)THEN 1050 : MAT REDIM E2$(VAL(E$(137)))83 : DATA LOAD DA T#P,(A+8)E2$() : MAT REDIM E2$(250)9 1050 C6$=HEX(3700) : F8$()=HEX(9F)&"F6$(17)<"&HEX(225E22B1A5)&"@PART"&HEX(22)&"IDS2SUBM"&HEX(2 2) : GOSUB 2465 : GOSUB 2470 : DATA LOAD BA T#3,(E3+1)F8$() : E0$()=F8$() : F9$=C6$DAC HEX(01) : IF STR(E0$(),109,1)<"1"THEN 1130 : F8$()=HEX(9F)&"R8$>=F6$"&HEX(B1FF)&STR(F9$,,2)&HEX(3A9A)&"'38(26,E8$):"&H EX(9A)&"'40(R3$())" : GOSUB 2470 1130 F9$=C6$DAC HEX(01) : IF STR(E0$(),117,3)=" "THEN 1160 : F8$()=HEX(9F)&"R4$=F3$"&HEX(B1FF)&STR(F9$,,2)&HEX(3A9A)&"'38(26,E8$):"&HE X(9A)&"'40(R3$())" : GOSUB 2470 1160 IF STR(E0$(),127,8)=" "THEN 1200 : F8$()=HEX(A0F5)&"21,11);BOX(1,57);"&HEX(22)&" Please enter the applicatio n module's password "&HEX(22) : GOSUB 2470 : F8$()="F0=1" : GOSUB 2480 : F8$()="E2$()="&HEX(D2)&"080000A87970)&"&HEX(E1)&"(00)" : GOSUB 2480 1180 F9$=C6$DAC HEX(01) : F8$()=HEX(9A)&"'34(1):"&HEX(9F)&"E$=E7$"&HEX(B1FF)&STR(F9$,,2)&HEX(3A9A)& "'38(27,E8$):"&HEX(9CFF)&C6$ : GOSUB 2470 1200 $TRAN(E$()<153,>,HEX(2722))R : IF E$(134)<HEX(80)THEN S=1 : ELSE S=0 : IF S=1THEN $TRAN(E$()<153,>,HEX(0920))R : F8$()=HEX(A5A0303035) : GOSUB 2470 : F8$()=HEX(A0D2)&"060F0"&BIN(49+2*S)&");" : IF MOD(VAL(E$(134)),4)>1AND POS(STR(E$(),153,80)>09)>0THEN F8$()=F8$()&"@ E1$(2);" : GOSUB 2470 : F8$()=HEX(A0) : FOR I=153TO 1913STEP 80 1290 E$=STR(E$(),I,80)&ALL(09) : Q=POS(-E$>09) : IF Q>0THEN 1330 : IF F8$()=HEX(A0)THEN F8$()=HEX(A0D23041293B) : ELSE STR(F8$(),POS(F8$()=29))="0A);" : NEXT I : F8$()=F8$()&HEX(F5)&"23,0,80);" : GOSUB 2480 : GOTO 1390 1330 IF STR(E$,,80)=" "AND S=0THEN 1340 : F8$()=F8$()&HEX(22)&STR(E$,,Q)&HEX(22) : GOTO 1350 1340 Q=POS(-STR(E$,,80)<>20) : IF Q>0THEN F8$()=F8$()&HEX(22)&STR(E$,,Q)&HEX(223B) : F8$()=F8$()&HEX(CD)&"80);" 1350 IF I=153AND Q>0AND MOD(VAL(E$(134)),4)>1THEN F8$()=F8$()&HEX(3BD2304629) : GOSUB 2480 : F8$()=HEX(A0) : NEXT I : F8$()=HEX(A0F5)&"23,0,80);" : GOSUB 2480 1390 FOR I=VAL(E$(137))*83-3TO VAL(E$(137))*83+1-4*VAL(E$(136))STEP -4 : HEXUNPACKSTR(E2$(),I,4)TO F5$ : E$=HEX(F5) : IF STR(F5$,,1)="0"THEN E$=E$&STR(F5$,2,1) : ELSE E$=E$&STR(F5$,,2) : E$=E$&"," : IF STR(F5$,3,1)="0"THEN E$=E$&STR(F5$,4,1) : ELSE E$=E$&STR(F5$,3,2) : E$=E$&");BOX(" 1430 IF STR(F5$,5,1)="0"THEN E$=E$&STR(F5$,6,1) : ELSE E$=E$&STR(F5$,5,2) : E$=E$&"," : IF STR(F5$,7,1)="0"THEN E$=E$&STR(F5$,8,1) : ELSE E$=E$&STR(F5$,7,2) : E$=E$&");" : IF POS(E4$()=FE)+LEN(E$)<257THEN 1460 : F8$()=HEX(A0)&E$ : GOSUB 2480 : GOTO 1470 1460 STR(E4$(),POS(E4$()=FE)-3)=E$&HEX(0D0000FE) 1470 NEXT I : F0=VAL(E$(135)) : E$=" " : F3$="###" : CONVERT F0TO E$,(STR(F3$,,1+INT(LGT(F0)))) : ERRORE$="0" 1510 F8$()="F=0" : GOSUB 2480 : F8$()="F0="&E$ : GOSUB 2480 : F8$()=HEX(A8D693)&"E2$(250)9" : GOSUB 2480 : IF F0=0THEN 1630 : Q=F0*9+1 : P=1 1560 IF P>1THEN B=INT((236-INT(LGT(P)))/2) : ELSE B=INT((247-POS(E4$()=FE))/2) : IF B<1THEN B=120 : B=MIN(B,Q-P) : E$=" " : CONVERT PTO E$,(####) : FOR I=1TO 3 : IF STR(E$,,1)="0"THEN E$=STR(E$,2) : NEXT I : IF P=1THEN F8$()="E2$(" : ELSE F8$()=HEX(D3)&"E2$(),"&E$ : F8$()=F8$()&")="&HEX(D2) : HEXUNPACKSTR(E2$(),P,B)TO STR(F8$(),LEN(F8$())+1) : F8$()=F8$()&")" : GOSUB 2480 1600 P=P+B : IF P<QTHEN 1560 : IF F0=249THEN 1610 : F8$()="E2$()=E2$()&"&HEX(E1)&"(00)" : GOSUB 2480 1610 F8$()="E2$(250)="&HEX(D2)&"010000B89F904000)" : GOSUB 2480 : IF E$(134)>HEX(7F)THEN 1630 : F8$()="E0$=E9$(1)" : GOSUB 2480 1630 IF E$(134)<HEX(80)OR F0>0THEN 1640 : F8$()="F2$=E9$(1)" : GOSUB 2480 1640 IF MOD(VAL(E$(134)),32)>15THEN E$="Y" : ELSE E$="N" : IF MOD(VAL(E$(134)),128)>63THEN E$=E$&"Y" : ELSE E$=E$&"N" : IF MOD(VAL(E$(134)),64)>31THEN E$=E$&"Y" : ELSE E$=E$&"N" : F8$()=HEX(D3)&"F6$(),11,3)="&HEX(22)&E$&HEX(22) : GOSUB 2480 : IF MOD(VAL(E$(134)),16)<8THEN 1700 : F8$()="E$()="&HEX(222022) : GOSUB 2480 1700 F8$()="E2$="&HEX(D2) : FOR I=1TO 8 : CONVERT STR(E$(),I*2+60,2)TO Q : ERRORQ=32 1710 E6$=BIN(Q) : HEXUNPACKE6$TO STR(F8$(),I*2+4) : NEXT I : F8$()=F8$()&")" : GOSUB 2480 : F8$()="E1$="&HEX(22)&STR(E$(),34,8) : IF STR(F8$(),LEN(F8$()))=HEX(22)THEN F8$()=F8$()&HEX(2022) : ELSE F8$()=F8$()&HEX(22) : GOSUB 2480 : IF MOD(VAL(E$(134)),8)<4THEN 1730 : F8$()="E8$(3)="&HEX(225922) : GOSUB 2480 : F8$()=HEX(9A)&"'36" : GOSUB 2480 1730 DATA LOAD BA T#3,(E3+3)F8$() : MAT SEARCHF8$(),=":U="TO F9$ : CONVERT STR(F8$(),VAL(F9$,2)+3,1)TO Q : ERRORQ=4 1750 IF Q<1OR Q>3THEN 1830 : F8$()="F6$(54)=F6$(17)"&HEX(8AD2)&"03)" : GOSUB 2480 : ON QGOTO 1790,1800,1810 1790 F8$()="E6$=F6$(54):F6$(54)="&HEX(8BD2)&"01):"&HEX(9F)&"E6$="&HEX(D2)&"02) "&HEX(8B)&"E6$="&HEX(D2)&"00)"&HEX(B1A15423322C22)&"IDS2SUB7"&HEX(22FF370 12CFF)&STR(C6$,,2)&HEX(B3FF3700) : GOSUB 2470 : GOTO 1830 1800 F8$()="E6$=F6$(54):F6$(54)="&HEX(8BD2)&"02):"&HEX(9F)&"E6$="&HEX(D2)&"01) "&HEX(8B)&"E6$="&HEX(D2)&"00)"&HEX(B1A15423322C22)&"IDS2SUB8"&HEX(22FF370 12CFF)&STR(C6$,,2)&HEX(B3FF3700) : GOSUB 2470 : GOTO 1830 1810 F8$()="E6$=F6$(54):F6$(54)="&HEX(8BD2)&"03):"&HEX(9F)&"E6$="&HEX(D2303029 B1)&"E$="&HEX(22)&"IDS2SUB7IDS2SUB8"&HEX(223A9F)&"E6$="&HEX(D2303129B1)&" E$="&HEX(22)&"IDS2SUB8"&HEX(223A9F)&"E6$="&HEX(D2303229B1)&"E$="&HEX(22)& "IDS2SUB7"&HEX(223A9F) 1820 F8$()=F8$()&"E6$<"&HEX(D2)&"03)"&HEX(B1A1)&"T#2,<"&HEX(D5)&"E$)>E$"&HEX(F F37012CFF)&STR(C6$,,2)&HEX(B3FF3700) : GOSUB 2470 1830 F8$()=HEX(9CFF1032) : GOSUB 2470 : DATA SAVE BA T#3,(Z-1)E4$() : GOSUB '63("Copying program ","from work file to program file"," ") 2020 F5$=E9$(POS(" P R B"=STR(R3$(1),6,1))) : LIMITS T#4,F5$,A,B,C,D : Y=D : IF Y<>0THEN 2070 : S=E4-E3+1 : SAVE T#4,(S-1)F5$1000,1000 : ERRORGOSUB '38(132," ") : F6$(11)="N" : GOSUB '34(250) : GOTO 2300 2070 IF Y=2THEN SCRATCH T#4,F5$ : A=ABS(A) : B=ABS(B) : IF B-A>=E4-E3THEN 2160 : E7$="JUNK" : X=0 2110 X=X+1 : CONVERT XTO STR(E7$,5),(####) : LIMITS T#4,E7$,A,B,C,D : IF D<>0THEN 2110 : SCRATCH T#4,F5$ : SAVE T#4,(F5$)E7$1000,1000 : SCRATCH T#4,E7$ : GOTO 2020 2160 FOR I=0TO E4-E3-1 : DATA LOAD BA T#3,(E3+I)E4$() 2180 MAT SEARCHE4$(),="F6$(0"TO F9$ : X=VAL(F9$,2) : IF X=0OR I<3THEN 2210 : STR(E4$(),X+3)=STR(E4$(),X+4)&HEX(00) : GOTO 2180 2210 MAT SEARCHE4$(),="F6$="TO F9$ : X=VAL(F9$,2) : IF X=0OR I<3THEN 2250 : IF STR(E4$(),X+4,1)="P"THEN STR(E4$(),X,3)="H=1" : ELSE STR(E4$(),X,3)="H=0" : STR(E4$(),X+3)=STR(E4$(),X+6)&ALL(00) : GOTO 2210 2250 IF E2(1)=1THEN OR (STR(E4$(),,1),10) : DATA SAVE BA T#4,(A+I)E4$() : NEXT I : E4$()=HEX(20)&BIN(E4-E3+1,2)&ALL(00) : DATA SAVE BA T#4,(B)STR(E4$(),1,256) 2300 IF POS("RB"=STR(R3$(1),6,1))>0AND R3$(1)<>"IDS2CRXX"THEN COM CLEAR F1() : ELSE COM CLEAR E3 : LOAD T#2,R3$(1)1000, 2465 DATA LOAD BA T#3,(Z-1)E4$() 2466 IF POS(E4$()=FE)<YTHEN RETURN : STR(E4$(),,1)=HEX(00) : $TRAN(E4$(),HEX(FDFE))R : DATA SAVE BA T#3,(Z-1)E4$() : E4$()=HEX(20FE) : E4,Z=Z+1 : RETURN 2470 Y=250-LEN(F8$()) : GOSUB 2466 : STR(E4$(),POS(E4$()=FE))=HEX(FF)&STR(C6$,,2)&F8$()&HEX(0D0000FE) : C6$=DAC HEX(01) : RETURN 2480 Y=POS(E4$()=FE) : IF Y+LEN(F8$())>255THEN 2470 : STR(E4$(),Y-3)=":"&F8$()&HEX(0D0000FE) : RETURN