Listing of file='IDS2PR20' on disk='vmedia/701-2716B.wvd.zip'
# Sector 274, program filename = 'IDS2PR20'
1000 REM "IDS2PR20" - Release 2.1 - REPORT & BATCH - SORT SPECIFICATIONS
1010 IF F6$(17)<"^"THEN SELECT @PART"IDS2SUBM"
: GOSUB '32("IDS2sR16")
: IF E$(856)="X"THEN 1018
: PRINT AT(16,0);BOX(5,50);AT(16,16);BOX(5,32);AT(16,18);BOX(5,28);AT(16,20
);BOX(5,24);AT(16,22);BOX(5,20);AT(16,24);BOX(5,16);AT(16,26);BOX(5,12);A
T(16,28);BOX(5,8);AT(16,30);BOX(5,4);AT(16,32);BOX(5,0)
1014 PRINT AT(16,1);"Combinations";AT(17,1);"Matching Avail.";AT(18,1);"Alt. K
ey Files";AT(19,1);"Use provides";AT(20,1);"FASTER sorts"
: PRINT AT(22,0);BOX(1,50);" FN'0 SORT Spec. User Modifiable at Execution
?"
: FOR I=19TO 103
: STR(E2$(I),7,1)=STR(E2$(I),7,1)AND HEX(3F)OR HEX(40)
: NEXT I
: GOTO 1020
1018 FOR I=19TO 103
: STR(E2$(I),7,1)=AND HEX(3F)
: NEXT I
: STR(E2$(115),7,1)=AND HEX(3F)
1020 IF E$(1601)=HEX(0F)THEN 1030
: FOR I=VAL(E$(1601))+1TO 15
: PRINT AT(I+5,55,4);
: NEXT I
1030 E$="Report"
: IF E$(1)="\E2"THEN E$="Batch"
: GOSUB '45(1,E$)
: GOSUB '45(114,E$)
: FOR I=2TO 18
: GOSUB '37(I)
: NEXT I
: MAT REDIM E3$(6)83
: F5$=STR(E$(),78)OR ALL(20)
1100 GOSUB '39(F5$,5)
: DATA LOAD DA T#P,(A)E3$()
: IF STR(E3$(),2,8)=STR(E3$(),82,8)THEN 1120
: F5$=STR(E3$(),82,8)OR ALL(20)
: GOTO 1100
1120 E0$()=STR(F5$,,8)&STR(E3$(),275,128)
: OR (E0$(),20)
: E$(1491)=HEX(00)
: F7$=" "
: FOR I=1TO VAL(E$(1600))
: STR(F7$,I)=BIN(I+64)
: NEXT I
: FOR I=0TO 16
: IF I=0THEN 1210
: F5$=STR(E0$(),I*8+1)
: IF F5$=" "THEN Q=0
: ELSE Q=5
: IF Q=5THEN GOSUB '39(F5$,Q)
: IF Q=2THEN DATA LOAD DA T#P,(A)E3$()
: ELSE E3$()=" "
1210 F5$=" "
: FOR J=0TO 4
: E$=STR(E3$(),J*17+108,8)
: IF E$=" "THEN 1300
: MAT SEARCHE$()<887,120>,=STR(E$,,8)TO F9$STEP 8
: IF F9$=HEX(0000)THEN 1300
: X=INT(VAL(F9$,2)/8)+1
: IF E$(X+871)<>"1"THEN 1300
: IF J=0OR POS(STR(F5$,,J)=20)=0THEN STR(F5$,J+1)=BIN(X+64)
1300 NEXT J
: STR(E$(),I*5+1495,5)=F5$
: IF F5$=" "THEN 1315
: FOR J=I*5+19TO I*5+23
: IF E$(856)<>"X"AND F5$=F7$THEN STR(E2$(J),7,1)=STR(E2$(J),7,1)AND HEX(3F)
OR HEX(80)
: GOSUB '37(J)
: NEXT J
1315 IF F5$<>" "THEN ADD(E$(1491),01)
: NEXT I
: IF STR(E$(),1486,5)=" "THEN STR(E$(),1486,5)=F7$
1350 FOR I=0TO 4
: GOSUB '77(I)
: NEXT I
: MAT REDIM E3$(249)8
: E0$()=HEX(01)
: GOSUB '37(115)
1380 GOSUB 1690
1381 IF E$(856)<>"X"THEN PRINT HEX(0F);AT(22,54);BOX(1,25);" '12/'13 for faste
r sorts"
: E$="EXEC=Accept, EDIT=Modify,"
: IF E$(856)<>"X"THEN E$=E$&" '0=User mod,"
: IF E$(856)="X"AND E$(774)="Y"OR E$(856)=" "THEN E$=E$&" '16=Range,"
: IF E$(856)="X"AND E$(775)="Y"OR E$(856)=" "THEN E$=E$&" '17=Select,"
1386 E$=E$&" '31=Cancel"
: GOSUB '63(STR(E$,,16),STR(E$,17)," ")
: GOSUB '34(250)
: IF Q=31THEN 1403
: IF Q>0OR E$(856)="X"THEN 1408
: GOSUB '43(115)
: IF E$="N"THEN GOSUB '45(115,"Y")
: ELSE GOSUB '45(115,"N")
: GOTO 1381
1403 IF E$(856)="X"THEN COM CLEAR F()
: GOSUB '40(STR(R3$(),,8))
1408 IF Q<>16THEN 1409
: IF E$(856)="X"AND E$(774)="Y"OR E$(856)=" "THEN LOAD T#2,"IDS2PR26"1000,1
994
1409 IF Q<>17THEN 1410
: IF E$(856)="X"AND E$(775)="Y"OR E$(856)=" "THEN LOAD T#2,"IDS2PR27"1000,1
994
1410 IF E$(856)<>"X"THEN IF Q=12OR Q=13OR X=76OR X=77THEN 1440
: ON Q-30GOTO 1600,1580,1470
: PRINT HEX(07)
: GOTO 1381
1440 X=VAL(E$(1492))
: IF Q=12OR Q=76THEN X=MIN(X+1,VAL(E$(1491)))
: ELSE X=MAX(X-1,1)
: STR(E$(),1486,5)=STR(E$(),X*5+1490)
: GOTO 1350
1470 IF E$(856)<>"X"THEN PRINT AT(22,55,26);BOX(-1,-25);BOX(0,25);
: F=103
1480 F=F+1
1490 GOSUB '34(F)
: IF F<104THEN 1480
: ON MOD(F,2)+1GOTO 1510,1480
1510 IF E$=" "AND F>104THEN 1570
: IF E$>="A"AND E$<="O"THEN 1530
1520 GOSUB '35("Key letter must be one of those listed with description")
: GOTO 1490
1530 X=VAL(E$)-65
: IF STR(E$(),887+X*8,8)=" "THEN 1520
: GOSUB '77(F/2-52)
: GOSUB 1690
: IF F<112THEN 1480
: GOTO 1380
1570 FOR I=F+1TO 113
: GOSUB '45(I," ")
: NEXT I
: GOTO 1380
1580 IF R3$(1)<>"IDS2PR05"THEN LOAD T#2,"IDS2PBX1"1000,1994
: MAT REDIM E$(24)83
: DATA SAVE DA T#3,(E4)E$()
1600 LOAD T#2,R3$(1)1000,
1610 STOP "END IT"
1620 DEFFN'77(I)
: E6$=E$(1486+I)
: X=VAL(E6$)-65
: IF I>0AND POS(STR(E$(),1486,I)=20)>0OR STR(E$(),X*8+887,8)=" "THEN E6$="
"
: GOSUB '45(I*2+104,E6$)
: IF E6$>" "THEN GOSUB '45(I*2+105,STR(E$(),X*20+1007,20))
: ELSE GOSUB '45(I*2+105," ")
: RETURN
1690 PRINT AT(21,0,40)
: E$=STR(E$(),1486,5)
: MAT SEARCHE$()<1495,75>,=E$TO F9$STEP 5
: X=INT((VAL(F9$,2)+4)/5)
: E$(1492)=BIN(X)
: IF X>0AND STR(E$(),1486,5)<>" "AND E$(856)<>"X"THEN PRINT AT(21,15+X*2);"
^"
: RETURN
1760 IF E$(856)="X"THEN RETURN
: MAT REDIM E$(24)83
: DATA SAVE DA T#3,(E4)E$()
: MAT REDIM E$(E8)1
: RETURN
1990 ON XGOTO 1990,1994
1994 %
3699 ON ERRORE1$,E2$GOTO 3700
3700 DEFFN'31
: E$="IDS2PR20"
: IF E5$<"Y"THEN LOAD T#2,"IDS2PER1"1000,
: STOP "ERROR"