Listing of file='IDS2PR27' on disk='vmedia/701-2716B.wvd.zip'
# Sector 355, program filename = 'IDS2PR27'
1000 REM "IDS2PR27" - Release 2.1 - MODIFY/DEFAULT RECORD SELECTION CRITERIA
1009 IF F6$(17)<"^"THEN SELECT @PART"IDS2SUBM"
: F6$(53)="N"
1036 GOSUB '32("IDS2sR17")
: IF E$(1601)=HEX(0F)THEN 1053
: FOR I=VAL(E$(1601))+1TO 15
: PRINT AT(I+4,55,4);
: NEXT I
: IF E$(856)="X"THEN 1052
: PRINT AT(21,0);BOX(1,51);" FN'0 Is LOGIC User Modifiable at Execution ?
"
: GOTO 1053
1052 STR(E2$(37),7,1)=AND HEX(3F)
1053 GOSUB '36
: IF E$(1)=HEX(F2)THEN GOSUB '45(35,"Report")
: GOSUB '45(36,E$)
: FOR F=1TO 17STEP 3
: GOSUB '43(F)
: IF E$<>" "THEN GOSUB 1612
: NEXT F
: GOTO 1180
1135 FOR F=1TO 17
: GOSUB '34(F)
: F6$(12)="Y"
: ON FGOSUB 1612,,1792,1612,,1828,1612,,1792,1612,,1828,1612,,1792,1612
: NEXT F
1180 E$="EXEC=Accept, EDIT=Modify,"
: IF E$(856)<>"X"THEN E$=E$&" '0=User mod,"
: IF STR(E$(),1486,18)<>" "THEN E$=E$&" '9=Delete spec,"
: IF E$(856)="X"AND E$(774)="Y"OR E$(856)=" "THEN E$=E$&" '16=Range,"
: E$=E$&" '31=Cancel"
: GOSUB '63(STR(E$,,16),STR(E$,17)," ")
: GOSUB '34(250)
1208 IF Q>0OR E$(856)="X"THEN 1225
: GOSUB '43(37)
: IF E$="N"THEN GOSUB '45(37,"Y")
: ELSE GOSUB '45(37,"N")
: GOTO 1180
1225 IF Q=9THEN 1342
: IF Q=33THEN 1135
: IF Q=32THEN 1306
: IF Q=31THEN 1279
: IF Q<>16THEN 1252
: IF E$(856)="X"AND E$(774)="Y"OR E$(856)=" "THEN LOAD T#2,"IDS2PR26"1000,1
994
1252 PRINT HEX(07)
: GOTO 1180
1279 IF STR(R3$(),,4)<>"IDS2"THEN F6$(53)="Y"
: IF E$(856)="X"THEN COM CLEAR F()
: GOSUB '40(STR(R3$(),,8))
1306 IF E$(856)="X"THEN F6$(53)="Y"
: GOSUB 1405
: IF E$(856)="X"AND E$(776)="Y"OR E$(856)=" "THEN LOAD T#2,"IDS2PR20"1000,1
994
: IF E$(856)="L"THEN LOAD T#2,"IDS2PR05"1000
: LOAD T#2,"IDS2PBX1"1000,1994
1342 PRINT HEX(07)
: IF STR(E$(),1468,18)=" "THEN 1180
: F6$(11)="N"
: GOSUB '63("Press SF'9 to DE","LETE Specification, SF'31 to CANCEL Delete"
," ")
: GOSUB '34(250)
: F6$(12)="Y"
: IF Q=31THEN 1180
: STR(E$(),777,60),STR(E$(),1468,18)=" "
: GOSUB 1405
: GOTO 1036
1405 IF E$(856)="X"THEN RETURN
: MAT REDIM E$(24)83
: DATA SAVE DA T#3,(E4)E$()
: MAT REDIM E$(E8)1
: RETURN
1459 DEFFN'71(F5$,J0,J1)
: E2$(J0)=AND HEX(00FFF0F8FE00C00000)
: IF VAL(STR(F5$,3))>J1THEN STR(F5$,3,1)=BIN(J1)
: STR(E2$(J0),,1)=STR(F5$,3,1)
: IF MOD(VAL(STR(F5$,2)),2)=1THEN STR(E2$(J0),3,1)=OR HEX(02)
: IF MOD(VAL(STR(F5$,6)),16)>=8THEN STR(E2$(J0),3,1)=OR HEX(01)
: STR(E2$(J0),4,1)=OR BIN(MOD(VAL(STR(F5$,6)),8))
: STR(E2$(J0),6,1)=BIN(INT(MOD(VAL(STR(F5$,2)),16)/2)*16)
: RETURN
1612 IF POS(" VABCDEFGHIJKLMNO"=E$)>VAL(E$(1601))+2THEN 1970
: IF E$=" "THEN 1864
: IF E$="V"THEN 1711
: IF POS("ABCDEFGHIJKLMNO"=E$)>VAL(E$(1601))OR E$>"O"OR E$<"A"THEN 1970
: GOSUB '71(HEX(000E14000000),F+1,20)
: J0=MOD(INT(VAL(E$(1597+POS("ABCDEFGHIJKLMNO"=E$)*6))/2),8)
: GOSUB '43(17+POS("ABCDEFGHIJKLMNO"=E$))
: GOSUB '45(F+1,E$)
1684 STR(E2$(F+1),5,1)=AND HEX(FE)
: IF F=1OR F=7OR F=13THEN RETURN
: GOSUB '43(F-3)
: J1=MOD(INT(VAL(E$(1597+POS("ABCDEFGHIJKLMNO"=E$)*6))/2),8)
: IF SGN(J0-3.5)=SGN(J1-3.5)THEN RETURN
: GOSUB '35("Both Identifiers within a test must be either Numeric or Alpha
")
: GOTO 1970
1711 IF F=1OR F=7OR F=13THEN 1970
: GOSUB '43(F-3)
: Q=POS("ABCDEFGHIJKLMNO"=E$)
: GOSUB '71(STR(E$(),1596+Q*6,6),F+1,20)
: STR(E2$(F+1),5,1)=OR HEX(01)
: PRINT AT(INT(VAL(STR(E2$(F+1),4))/8),INT(VAL(STR(E2$(F+1),5))/2),20)
: GOSUB '37(F+1)
: RETURN
1792 MAT SEARCH"< <== > >=<>",=STR(E$,,2)TO F9$STEP 2
: IF F9$=HEX(0000)THEN 1970
: RETURN
1828 IF E$=" "THEN 1864
: IF E$<>"OR"AND E$<>"AND"THEN 1970
: RETURN
1864 FOR F=FTO 17
: GOSUB '45(F," ")
: NEXT F
: F=F0
: RETURN
1970 PRINT HEX(07)
: F=F-1
: F6$(12)="N"
1990 RETURN
: GOTO 1990
1994 %
3699 ON ERRORE1$,E2$GOTO 3700
3700 DEFFN'31
: E$="IDS2PR27"
: IF E5$<"Y"THEN LOAD T#2,"IDS2PER1"1000,
: STOP "ERROR"