Listing of file='IDS2PBX4' on disk='vmedia/701-2717B.wvd.zip'
# Sector 726, program filename = 'IDS2PBX4' 1000 REM "IDS2PBX4" 1010 COM D$(B)E,D0,C1,W9 : IF F6$(17)<"^"THEN SELECT @PART"IDS2SUBM" 1028 D$()=ALL(FF) : F6$(53)="R" 1034 F5$=STR(E$(),1486,5) : E$="ABCDE" : E$=STR(E$,,VAL(STR(E$(),151))-48) : IF F5$=STR(E$,,LEN(F5$))THEN J0,J3=1 : ELSE J0,J3=0 1050 IF POS(STR(E$(),449,80)>31)>0OR STR(E$(),1468,18)<>" "THEN J3=0 1066 UNPACK(########)STR(E$(),1729,8)TO E0,C0 : E0=100/E0 : F3=-1 : F4,F6=0 : D0=LEN(STR(E1$()))/56 1094 MAT REDIM E$(21)83 : DATA SAVE DA T#2,(Z)E$() : MAT REDIM E$(E8)1,E3$(24)83,F$(E9)1 1104 V=C0 : GOSUB '47 : C1=L : C2=P : C3=E : C4=B : C5=S : C6=D : E1=T 1124 V=D0 : GOSUB '47 : D1=L : D2,E2=P : D3=E : D4=B : D5=S : D6=D 1144 LIMITS T#D,STR(E1$(V),,8),F7,J9,E2,E2 : J9=J9-8 1152 J4=C1+C2 : J5=J4+4 : J6=D3+4 : J7=LEN(D$())-J6+1 : C7,D7=0 : E3,H=0 : E2=C1+C2+4 : E7=INT(249/E2) 1182 MAT REDIM E0$(E7)E2 : E$()=" " : J8=INT(1991/D3) : E2$()=ALL(FF) : D9=D5/8-1 : STR(E2$(),1992)=BIN(D9) : D8,F2=0 : E4=0 : E0$()=ALL(FF) : FOR C7=1TO 8*C4+1STEP 8 : IF POS(STR(E6$(),C7,8)<FF)=0THEN 1238 : FOR E3=VAL(STR(E6$(),C7),2)TO VAL(STR(E6$(),C7+4),2)STEP 8 : W=D : D=C6 : IF W<>C6OR H<>E3THEN GOSUB '72(E3,24) 1214 IF E3=VAL(STR(E6$(),C7),2)THEN S=VAL(STR(E6$(),C7+2),2) : ELSE S=10 : IF E3=VAL(STR(E6$(),C7+4),2)THEN W=VAL(STR(E6$(),C7+6),2) : ELSE W=VAL(STR(E3$(),4),2) : FOR C8=STO WSTEP C3 : E4=E4+1 : E0$(E4)=STR(E3$(),C8,J4)&BIN(E3,2)&BIN(C8,2) : IF E4=E7THEN GOSUB 1246 : NEXT C8,E3 : IF E4>0THEN GOSUB 1246 : IF D9=0THEN 1238 : FOR I=VAL(STR(E2$(),1992))TO 0STEP -1 : GOSUB 1725 : NEXT I 1238 NEXT C7 : IF F2>0THEN GOSUB 1725 1240 MAT REDIM E$(21)83 : DATA LOAD DA T#2,(Z)E$() : MAT REDIM E$(E8)1,E3$(24)83,F$(E9)1 : IF F6>0THEN LOAD T#2,"IDS2PBX5"1000,1994 : GOTO 1820 1246 IF E4=0THEN RETURN : J1=D : J2=H : FOR F1=1TO E4 : E6=0 : ON J3GOTO 1605 : ON E1GOTO 1270,,,1270 : E4$()=E0$() : GOSUB '67(C0,STR(E0$(F1),C1+1),-1) : E0$()=E4$() : IF D<>J1OR U<>J2THEN GOSUB '72(U,3*B) : GOTO 1280 1270 C=VAL(STR(E0$(F1),C1+3),2)-1 : IF E1=4THEN C=C+C1+1 : D=C6 : H=E3 : IF D<>J1OR H<>J2THEN GOSUB '72(H,24) 1280 T=E1 : GOSUB '66(C0,C+1) : STR(E$(),,VAL(STR(E1$(V),13),2))=F$() : STR(E2$(),1993)=E0$() 1600 E0$()=STR(E2$(),1993) 1605 MAT REDIM E0$(E7)E2 : ON E6GOTO 1660 : F6=F6+1 : ON J0GOTO 1640 : V=D0 : GOSUB '51(E$) : STR(E4$(),D1+1)=STR(E0$(F1),C1+1) : GOTO 1645 1640 IF E1=1OR E1=4THEN E4$()=E0$(F1) : ELSE E4$()=STR(E0$(F1),,D1)&STR(E0$(F1),C1+1) 1645 IF E1=4OR E1=1THEN STR(E4$(),D1+1)=E0$(F1) : IF F2=J8THEN GOSUB 1725 1660 F4=F4+1 : X=ROUND((F4*E0,0) : IF X=F3THEN 1686 : F3=X : PRINT HEX(06);AT(18,15); : PRINTUSING "Selection and/or sorting process is ###% complete",X 1686 ON E6GOTO 1700 : STR(E2$(),F2*D3+1,D3)=STR(E4$(),,D3-1)&HEX(00) : F2=F2+1 1700 NEXT F1 : IF D=J1AND H=J2THEN 1705 : D=J1 : GOSUB '72(J2,24) 1705 E4=0 : E0$()=ALL(FF) : RETURN 1725 MAT REDIM E2$(J8)D3,E$(J8)2,E3$(J8)2 : MAT SORTE2$()TO E3$(),E$() : MAT REDIM E3$(J8)D3 : MAT MOVE E2$(),E$()TO E3$() : MAT REDIM E$(E8)1,E2$(250)9,E3$(24)83 : IF F7+8>=J9THEN STR(E3$(),1992)=HEX(00) : ELSE STR(E3$(),1992)=STR(E2$(),1992) : DATA SAVE DA T#D6,(F7,F7)E3$() : IF VAL(STR(E2$(),1992))<D9THEN 1785 : MAT SEARCHD$(),>=STR(E3$(),,D3)TO F9$STEP J6 1770 F5=VAL(F9$,2) : MAT COPY -D$()<F5,J7-F5>TO -D$()<F5+J6,J7-F5> : STR(D$(),F5,J6)=STR(E3$(),,D3)&BIN(F7-8,2)&BIN(D3+1,2) 1785 E$()=" " : F2,H,D=0 : STR(E2$(),,1991)=ALL(FF) : IF VAL(STR(E2$(),1992))=0THEN STR(E2$(),1992,1)=BIN(D9) : ELSE STR(E2$(),1992,1)=ADDHEX(FF) : IF F7<J9OR X=100THEN RETURN 1820 IF F6>1THEN GOSUB '35("Sort file full. EXEC to process records found, FN '31 to Cancel") : ELSE GOSUB '35("No records found meeting selection criteria. Please canc el") : E2$(250)=HEX(010000B89F904000) : F6$(11)="N" : GOSUB '34(250) : IF Q=32THEN 1240 : IF Q<>31THEN 1820 : COM CLEAR F() : $CLOSE#1 1842 SELECT #1<STR(F4$,,3)> : HEXPACKE8$(7)FROMSTR(F4$,2,2) : MAT REDIM E$(E8)1,F$(E9)1,E0$(249)1,E4$(16)16,E2$(250)9 : F5$="IDS2PX##" : CONVERT R0TO STR(F5$,7,2),(##) : SCRATCH T#2,F5$ : SAVE DC T#2,()F5$1000,1000 : GOSUB '40(R3$(1)) 1850 DEFFN'72(H,W) : E4$()=E0$() : GOSUB '50(H,W,E9$) : MAT REDIM E0$(E7)E2 : E0$()=E4$() : RETURN : GOTO 1600 1990 % 1994 GOTO 1994 : GOTO 1605 3699 ON ERRORE1$,E2$GOTO 3700 3700 DEFFN'31 : E$="IDS2PBX4" : IF E5$<"Y"THEN LOAD T#2,"IDS2PER1"1000, : STOP "ERROR"