image of READY prompt

Wang2200.org

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"