Listing of file='IDS2PRX4' on disk='vmedia/701-2725B.wvd.zip'
# Sector 81, program filename = 'IDS2PRX4'
1000 REM "IDS2PRX4"
1030 DIM D1$3
: D1$="X"
: IF C2=0THEN PRINT HEX(03)
: F6=0
: IF F6$(17)<"^"THEN SELECT @PART"IDS2SUBM"
: E4=E4+1
: J8=1
: J9=99
: IF E0>0THEN GOSUB '55(E0,E4)
: GOSUB '76("HP")
: GOSUB '76("HR")
: FOR I=9TO 0STEP -1
: D$="H"&BIN(I+48)
: IF STR(C1$,I+2,1)="Y"THEN GOSUB 1620
: NEXT I
1130 IF STR(C2$,,1)="Y"THEN GOSUB '76("D")
: F6$(33)="N"
: J8,J9=1
: MAT REDIM E3$(24)83
1170 DATA LOAD DA T#D0,(STR(D$(),C6))E3$()
: B=VAL(STR(D$(),C6+2),2)
: IF B+C6<1993THEN 1190
: IF VAL(STR(E3$(),1992))=0THEN 1188
: STR(D$(),C6,4)=BIN(VAL(STR(D$(),C6),2)+8,2)&HEX(0001)
: GOTO 1170
1188 E4$()=ALL(FF)
: GOTO 1200
1190 E4$()=STR(E3$(),B,C6-1)&STR(D$(),C6,2)&BIN(B+C6-1,2)
1200 D$()=STR(D$(),C7+1)&ALL(FF)
: MAT SEARCHD$(),>=STR(E4$(),,C7)TO F9$STEP C7
: Q=VAL(F9$,2)
: MAT COPY -D$()<Q,C9-Q>TO -D$()<Q+C7,C9-Q>
: STR(D$(),Q,C7)=E4$()
: MAT REDIM F$(E9)1
: E$=ALL(FF)
: IF STR(D$(),,C6-1)<STR(E$,,C6-1)THEN 1320
: F6$(2)="N"
: J8=12
: GOTO 1540
1320 E$=STR(D$(),C4)
: J=SGN(D5)
: T=VAL(STR(E1$(C8),12))
: IF D6=2THEN GOSUB '67(C8,E$,0)
: ELSE GOSUB '59(C8,J,E$,0)
: IF Q>0AND D5>0THEN F6$(18)="Y"
: ELSE F6$(18)="N"
: X=5
: GOSUB '79
: STR(E$(),,E0(2))=STR(F$(),,E0(2))
1520 GOSUB 1600
: J9=J8
: IF J8=1AND STR(C$,,1)<HEX(FF)THEN 1985
: ON J8GOTO 1130
1540 J7=J7+1
: IF J7>J8THEN 1570
: IF STR(C$,J7,1)<HEX(FF)THEN 1985
1550 D$="F"&BIN(J7+46)
: $TRAN(D$,"R:")R
: IF STR(C2$,J7,1)>" "THEN GOSUB 1620
: D1$=" "
: IF STR(C2$,J7,1)="T"THEN GOSUB 1850
: GOTO 1540
1570 IF F6$(2)="N"THEN 1585
: J7=1
: IF STR(C1$,,1)<HEX(FF)THEN 1985
1575 FOR I=J8TO 2STEP -1
: D$="H"&BIN(I+46)
: IF STR(C1$,I,1)>" "THEN GOSUB 1620
: NEXT I
: J7=1
: GOTO 1130
1585 IF STR(C2$,13)>" "THEN GOSUB '76("FP")
: IF C2=0THEN GOSUB 1962
1590 COM CLEAR F()
: $CLOSE#1
: SELECT #1<STR(F4$,,3)>
: HEXPACKE8$(7)FROMSTR(F4$,2,2)
: MAT REDIM E4$(16)16
: GOSUB '40(R3$(1))
: GOSUB 1600
: GOTO 1130
1600 DEFFN'71
: FOR I=1TO F0
: CONVERT STR(E$(),VAL(STR(E2$(I),2),2)/16,VAL(E2$(I)))TO F(I)
: ERRORF(I)=0
1605 NEXT I
: RETURN
1620 DEFFN'76(D$)
: IF D$="HP"THEN F6$(33)="Y"
: IF D$="FP"THEN 1980
1625 F0$=ALL(0A)
: Z=0
1635 MAT REDIM F$(128)2,E4$(128)2
: MAT SEARCHC1$(),=D$TO F$()STEP 9
: Z=Z+1
: IF F$(Z)=HEX(0000)THEN 1945
: X=INT(VAL(F$(Z),2)/9)+1
: E$=C1$(X)
: IF STR(E$,3,1)>" "AND STR(E$,4,1)<>F6$(VAL(STR(E$,3))-47)THEN 1635
: A=1
: IF C2=1THEN UNPACK(##)STR(E$,6)TO A
: B=INT(A/10)
: IF B=0THEN 1665
: E0$()=BIN(B+1)&STR(F0$,,B)
: E8$(6)=HEX(00)
: GOSUB 1950
: E$=C1$(X)
: E8$(6)=" "
1665 IF STR(E$,7,1)=HEX(FF)THEN E0$()=" "&STR(E2$(),VAL(STR(E$,8),2),F5)
: IF STR(E$,7,1)=HEX(FF)THEN 1690
: DATA LOAD BA T#F4,(VAL(STR(E$,8),2))E4$()
: E0$()=" "&STR(E4$(),VAL(STR(E$,7)),F5)
: AND (E0$(),7F)
1690 A=1
: IF C2=1THEN UNPACK(##)STR(E$,6)TO A
: B=INT(A/10)
: A=MOD(A,10)
: STR(E0$(),,1)=BIN(LEN(E0$()))
: IF F6+B+1+A>F2AND C2=1AND F2>0THEN A=MAX(0,F2-F6-B-1)
: E6$=BIN(X)
: MAT SEARCHE2$()<8,F3>,=STR(E$,5,1)TO E4$()STEP 9
: Y=0
1730 Y=Y+1
: IF E4$(Y)=HEX(0000)THEN 1820
: Q=(VAL(E4$(Y),2)+8)/9
: C=VAL(STR(E2$(Q),5))
: L=VAL(E2$(Q))
: R=VAL(STR(E2$(Q),9))
: G=INT(VAL(STR(E2$(Q),7))/8)
: IF G<=J9THEN 1790
: STR(E0$(),C+1,R)=" "
: GOTO 1730
1790 IF Q>F0THEN STR(E0$(),C+1,R)=STR(E$(),VAL(STR(E2$(Q),2),2)/16,R)
: IF MOD(VAL(STR(E2$(Q),7)),2)=1THEN STR(E$(),VAL(STR(E2$(Q),2),2)/16,L)="
"
: IF Q>F0THEN 1730
: E$=HEX(0000)&STR(E0$(),C+1,R)
: PRINTUSING TO E$,STR(E$,3),F(Q)
: STR(E0$(),C+1,R)=STR(E$,3)
: IF MOD(VAL(STR(E2$(Q),7)),2)=1THEN F(Q)=0
: GOTO 1730
1818 IF VAL(E6$)=31AND F6$(11)="Y"THEN 1590
: GOTO 1835
1820 IF C2=0THEN E0$(1)=BIN(MIN(81,VAL(E0$())))
: GOSUB 1950
: IF A=0THEN 1821
: E8$(6)=HEX(00)
: E0$()=BIN(A+1)&STR(F0$,,A)
: GOSUB 1950
1821 E8$(6)=" "
: F6=F6+B+A+C2
: F7=F7+1
: IF F7=21AND C2=0THEN GOSUB 1962
: KEYIN E6$,1835,1818
1835 IF D$="FP"OR F6+B<F2OR F2=0THEN 1635
: D1$=STR(D$,,2)&BIN(Z)
1850 D$="FP"
: J6=1
: IF STR(C2$,13,1)="Y"THEN 1620
1865 IF C2=0THEN 1890
: IF F6>=F2AND F2<>66THEN 1885
1870 F6=F6+1
: E0$()=HEX(020A)
: E8$(6)=HEX(00)
: GOSUB 1950
: E8$(6)=" "
: IF F2<>66THEN 1865
: IF F6<66THEN 1870
: ELSE GOTO 1890
1885 IF C2<>1OR F2=66THEN 1890
: E0$()=HEX(020C)
: E8$(6)=HEX(00)
: GOSUB 1950
: E8$(6)=" "
1890 F6=0
: E4=E4+1
: IF E0>0THEN GOSUB '55(E0,E4)
: J6=2
: D$="HP"
: IF STR(C1$,13,1)="Y"THEN 1620
1915 J6=0
: IF D1$=" "THEN 1945
: D$=D1$
: Z=VAL(STR(D1$,3))
: J9=99
: GOTO 1635
1945 MAT REDIM F$(E9)1
: ON J6GOTO 1865,1915
: RETURN
1950 E6$=" "
: GOSUB '49(0)
: IF E8$(5)=HEX(1F)OR E6$=HEX(1F)THEN 1590
: RETURN
1960 DEFFN'68
: F(F)=A
: RETURN
1962 PRINT AT(23,0);"Touch EXECUTE to continue"
: KEYIN E6$
: IF E6$=HEX(0D)OR E6$=HEX(82)THEN 1970
: IF E6$=HEX(1F)AND F6$(11)="Y"THEN 1590
: PRINT HEX(07);
: GOTO 1962
1970 PRINT HEX(03)
: F7=0
: RETURN
1975 J7=J5
: GOTO 1625
1980 J5=J7
: J7=13
1985 F=0
1990 F=F+1
: IF F<=F1THEN 1994
: IF J7=13THEN 1975
: ON J8GOTO 1130
: ON J7GOTO 1575
: GOTO 1550
: GOTO 1990
: GOTO 1520
1993 %
1994 %
3699 ON ERRORE1$,E2$GOTO 3700
3700 DEFFN'31
: E$="IDS2PRX4"
: IF E5$<"Y"THEN LOAD T#2,"IDS2PER1"1000,
: STOP "ERROR"