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