image of READY prompt

Wang2200.org

Listing of file='IDS2PR26' on disk='vmedia/701-2716B.wvd.zip'

# Sector 340, program filename = 'IDS2PR26'
1000 REM "IDS2PR26" - Release 2.1 - MODIFY/DEFAULT RECORD RANGE CRITERIA
1010 IF F6$(17)<"^"THEN SELECT @PART"IDS2SUBM"
   : F6$(53)="N"
1040 GOSUB '32("IDS2sR18")
   : IF E$(856)="X"THEN 1049
   : PRINT AT(21,0);BOX(1,79);" FN '00    Allow User Modification of RANGE Def
     ault Values at Execution ?"
   : GOTO 1050
1045 IF E$(856)="X"THEN STR(E2$(20),7,1)=AND HEX(3F)
1049 STR(E2$(20),7,1)=AND HEX(3F)
1050 GOSUB '36
   : IF E$(1)=HEX(F2)THEN GOSUB '45(11,"Report")
   : GOSUB '45(19,E$)
   : C9=1307
   : FOR I=1TO VAL(E$(1600))
   : GOSUB '45(13+I,STR(E$(),987+I*20,20))
   : GOSUB '71(STR(E$(),1596+I*6,6),I*2-1,25)
   : GOSUB '71(F5$,J0+1,25)
   : STR(E2$(J0-1),2,2)=ADDBIN(C9*16,2)
   : STR(E2$(J0),2,2)=STR(E2$(J0-1),2,2)ADDHEX(0500)
   : C9=C9+VAL(STR(F5$,3))
1200 STR(E2$(I*2-1),5,1),STR(E2$(I*2),5,1)=OR HEX(01)
   : GOSUB '37(I*2-1)
   : GOSUB '37(I*2)
   : NEXT I
   : GOTO 1310
1270 FOR F=1TO VAL(E$(1600))*2
   : GOSUB '34(F)
   : IF F=2THEN GOSUB 1292
   : NEXT F
   : GOTO 1310
1292 E$=STR(E$(),16*VAL(STR(E2$(1),2))+INT(VAL(STR(E2$(1),3))/16),VAL(E2$(1)))
   : IF STR(E2$(1),6)<HEX(40)THEN 1293
   : IF E$<=STR(E$(),16*VAL(STR(E2$(2),2))+INT(VAL(STR(E2$(2),3))/16),VAL(E2$(
     2)))THEN RETURN
   : GOTO 1296
1293 IF E$=" "THEN P=0
   : ELSE CONVERT E$TO P
   : ERRORGOTO 1298
1294 E$=STR(E$(),16*VAL(STR(E2$(2),2))+INT(VAL(STR(E2$(2),3))/16),VAL(E2$(1)))
   : IF E$=" "THEN Q=0
   : ELSE CONVERT E$TO Q
   : ERRORGOTO 1298
1295 IF P<=QTHEN RETURN
1296 GOSUB '35("Maximum must be greater than minimum")
1297 F=0
   : RETURN
1298 GOSUB '35("Enter numeric values only")
   : GOTO 1297
1310 E$="EXEC=Accept, EDIT=Modify,"
   : IF E$(856)<>"X"THEN E$=E$&" '0=User mod,"
   : IF STR(E$(),1307,160)<>" "THEN E$=E$&" '9=Delete spec,"
   : IF E$(856)=" "THEN E$=E$&" '16=Desc,"
   : E$=E$&" '31=Cancel"
   : GOSUB '63(STR(E$,,16),STR(E$,17)," ")
   : GOSUB '34(250)
   : IF E$(856)=" "AND Q=16THEN LOAD T#2,"IDS2PR24"1000,1994
1360 IF Q=9THEN 1510
   : IF Q=31THEN 1480
   : IF Q=33THEN 1270
   : IF Q=32THEN 1422
   : IF Q<>0OR E$(856)="X"THEN 1400
   : IF E$(774)="Y"THEN GOSUB '45(20,"N")
   : ELSE GOSUB '45(20,"Y")
   : GOTO 1310
1400 PRINT HEX(07)
   : GOTO 1310
1422 IF E$(856)="X"THEN F6$(53)="Y"
   : GOSUB 1580
   : IF E$(856)="X"AND E$(775)="Y"OR E$(856)=" "THEN LOAD T#2,"IDS2PR27"1000,1
     994
   : IF E$(856)="X"AND E$(776)="Y"THEN LOAD T#2,"IDS2PR20"1000,1994
   : IF E$(856)="R"THEN LOAD T#2,"IDS2PR05"1000
   : LOAD T#2,"IDS2PBX1"1000,1994
1480 IF STR(R3$(),,4)<>"IDS2"THEN F6$(53)="Y"
   : IF E$(856)="X"THEN COM CLEAR F()
   : GOSUB '40(STR(R3$(),,8))
1510 PRINT HEX(07)
   : IF STR(E$(),1307,160)=" "THEN 1310
   : F6$(11)="N"
   : GOSUB '63("Press SF'9 to DE","LETE Specification, SF'31 to CANCEL Delete"
     ," ")
   : GOSUB '34(250)
   : F6$(11)="Y"
   : IF Q=31THEN 1310
   : STR(E$(),1307,160)=" "
   : GOSUB 1580
   : GOTO 1040
1580 IF E$(856)="X"THEN RETURN
   : MAT REDIM E$(24)83
   : DATA SAVE DA T#3,(E4)E$()
   : MAT REDIM E$(E8)1
   : RETURN
1640 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(16*INT(MOD(VAL(STR(F5$,2)),16)/2))
   : RETURN
1990 ON XGOTO 1990,1994
1994 %
3699 ON ERRORE1$,E2$GOTO 3700
3700 DEFFN'31
   : E$="IDS2PR26"
   : IF E5$<"Y"THEN LOAD T#2,"IDS2PER1"1000,
   : STOP "ERROR"