Listing of file='IDS2PBX1' on disk='vmedia/701-2717B.wvd.zip'
# Sector 868, program filename = 'IDS2PBX1'
1000 REM "IDS2PBX1" - Release 2.1 - REPORT/BATCH EXECUTION - SELECT/SORT PART
1
1030 IF F6$(17)<"^"THEN SELECT @PART"IDS2SUBM"
: GOSUB '32("IDS2sR11")
: IF E$(1)="\F2"THEN GOSUB '45(1,"report")
: ELSE GOSUB '45(1,"batch")
: GOSUB '37(2)
: GOSUB '37(3)
: GOSUB '33("IDS2sR13")
: F5$,E8$=STR(E$(),78,8)
: MAT SEARCHE1$(),=STR(F5$,,8)TO F9$STEP 56
: Q,V,C1=INT((VAL(F9$,2)+55)/56)
: IF Q>0THEN 1060
: GOSUB '38(14,E8$)
: GOTO 1780
1060 E6$()=ALL(FF)
1145 P=1
: E$=STR(E$(),1307,80)
: E4$()=STR(E$(),1387,80)
: N=VAL(STR(E1$(V),22))
: A=N+VAL(STR(E1$(V),23))
: FOR J=1TO 5
: F5$=STR(E1$(V),25+3*J,3)
: IF STR(F5$,,3)=HEX(000000)THEN 1200
: Y=VAL(STR(F5$,3))
: IF STR(F5$,,2)>HEX(8000)THEN GOSUB 1205
: ELSE GOSUB 1250
: P=P+Y
1200 NEXT J
: GOTO 1255
1205 IF STR(E$,P,Y)<>" "AND STR(E4$(),P,Y)<>" "THEN 1230
: IF STR(E4$(),P,Y)<>" "THEN 1220
: GOSUB 1235
: RETURN
1220 STR(E$(),P,Y)=STR(E4$(),P)
: GOSUB 1240
: RETURN
1230 STR(E$,P,Y)=STR(E$(),1386+P)
: STR(E4$(),P,Y)=STR(E$(),1306+P)
: RETURN
1235 STR(E$,P,Y)=ALL(FF)
: IF A>=PTHEN STR(E$,P,Y)=ALL(5A)
: IF N>=PTHEN STR(E$,P,Y)=ALL(39)
1240 E6$=STR(E$(),1597+6*J)AND HEX(01)
: STR(E4$(),P,Y)=ALL(00)
: IF N<PAND A<PTHEN RETURN
: STR(E4$(),P,Y)=" "
: IF A>=PTHEN STR(E4$(),P+VAL(E6$)*(Y-1),1)="A"
: IF N>=PTHEN STR(E4$(),P+VAL(E6$)*(Y-1),1)="0"
: RETURN
1250 IF STR(E4$(),P,Y)<>" "THEN RETURN
: STR(E4$(),P,Y)=ALL(FF)
: IF A>=PTHEN STR(E4$(),P,Y)=ALL(5A)
: IF N>=PTHEN STR(E4$(),P,Y)=ALL(39)
: RETURN
1255 GOSUB '51(STR(E4$(),,80))
: STR(F$(),129)=STR(E4$(),,VAL(STR(E1$(V),24)))
: GOSUB '51(STR(E$,,80))
: STR(F$(),,128)=STR(E4$(),,VAL(STR(E1$(V),24)))
: GOSUB '47
: IF LEN(E6$())>=8*BTHEN 1300
: GOSUB '35("Sort array too small. Modify buffer size in START program.")
: GOTO 1780
1300 C0,C4,C5=0
: X=6
: C8=INT(1983/E)
: PRINT AT(13,13);"Key range selected";
: FOR N=0TO B-1
: E$=F$()
: GOSUB '52
: C7=VAL(STR(E0$(),6),2)
: C5=C5+C7
: IF C7=0OR F9$=HEX(0000)THEN 1465
: STR(E6$(),N*8+1,2)=BIN(G,2)
: STR(E6$(),N*8+3,2)=BIN(VAL(F9$,2)+VAL(STR(E3$(),3))-1,2)
: Q=C7+VAL(E0$())
: H=U+8*INT(Q/C8)
: Q=E*MOD(Q,C8)+10
1400 MAT SEARCHE0$()<10,E*(1+VAL(E0$()))>,>STR(F$(),129,L)TO F9$STEP E
: IF F9$=HEX(0000)THEN 1445
: H=U+8*INT(VAL(F9$,2)/E)
: IF H>GTHEN GOSUB '50(H,W,E9$)
: MAT SEARCHE3$()<VAL(STR(E3$(),3))>,>STR(F$(),129,L)TO F9$STEP E
: Q=VAL(F9$,2)-E+VAL(STR(E3$(),3))-1
: IF Q>9THEN 1445
: H=H-8
: Q=10+E*(C8-1)
1445 C9=1+(Q-VAL(STR(E6$(),8*N+3),2))/E+C8*(H-G)/8
: STR(E6$(),8*N+5,4)=BIN(H,2)&BIN(Q,2)
: IF C9=0THEN STR(E6$(),8*N+1,8)=ALL(FF)
: IF C9>C4THEN C4=C9
: C0=C0+C9
1465 PRINT AT(13,31);C0;
: $CLOSE#D
: NEXT N
: PRINT "record";
: IF C0<>1THEN PRINT "s";
: PRINT " out of";C5;HEX(082E)
: F6$(11)="N"
: IF C5>0THEN 1800
1750 GOSUB '35("No records found in the file. Please cancel (FN'31).")
: GOSUB '34(250)
: IF Q<>31THEN 1750
1780 COM CLEAR F()
: GOSUB '40(R3$(1))
1800 IF C0>0THEN 1890
1810 E$="No records found within range. Touch FN'"
: IF E$(774)="Y"THEN E$=E$&"0 for new range spec, FN'"
: E$=E$&"31 to cancel"
: GOSUB '63(E$,STR(E$,17),"!")
: GOSUB '34(250)
: IF Q=31THEN 1780
: IF Q=0AND E$(774)="Y"THEN LOAD T#2,"IDS2PR26"1000,1994
: GOTO 1810
1890 PACK(########)STR(E$(),1729,12)FROMC0,C1,C4
: Q=C4
1910 LOAD T#2,"IDS2PBX2"1000,1994
: GOTO 1910
1990 DEFFN'68
: RETURN
1994 %
3699 ON ERRORE1$,E2$GOTO 3700
3700 DEFFN'31
: E$="IDS2PBX1"
: IF E5$<"Y"THEN LOAD T#2,"IDS2PER1"1000,
: STOP "ERROR"