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"