image of READY prompt

Wang2200.org

Listing of file='IDS2PS95' on disk='vmedia/701-2715B.wvd.zip'

# Sector 412, program filename = 'IDS2PS95'
1000 REM "IDS2PS95" - Release 2.1 - SCREEN/REPORT DELETE FIELD & EDITS ROUTINE
1010 E6$=F6$(17)AND HEX(02)
   : IF E6$=HEX(00)THEN LOAD T#2,"IDS2SUB8"3701,3899BEG 1020
1020 IF F6$(17)<"^"THEN SELECT @PART"IDS2SUBM"
   : DIM J7$19,C4$6,C5$1,C0$(8)49
   : IF STR(F$(),,8)="RENAME"THEN C4$="RENAME"
   : ELSE C4$="DELETE"
   : IF C4$<>"RENAME"THEN 1080
   : J6=VAL(STR(F$(),9))
1080 C5$=STR(R3$(1),6)
   : GOSUB '60(E1$(2),J6$)
   : GOSUB '62(E1$(2),1,0)
   : IF Q=0OR STR(F$(),7,8)<>STR(J6$,,8)THEN 1590
   : GOSUB '32("IDS2sS66")
   : PRINT AT(16,32);BOX(0,-14)
   : IF C5$="S"THEN E$="SCREEN"
   : ELSE E$="REPORT"
   : E$=E$&" MASK "&STR(J6$,,8)
   : GOSUB '45(1,E$)
   : GOSUB '39("IDS2sS66",3)
   : MAT REDIM E$(24)83
   : DATA LOAD DA T#P,(A)E$()
   : MAT REDIM E$(E8)1
1210 E$=STR(E$(),10,24)&ALL(00)
   : FOR I=1TO 32
   : ROTATEC(STR(E$,I),-2)
   : NEXT I
   : ADD(E$,20)
   : GOSUB '45(2,E$)
   : STR(E$(),82)=J6$
   : GOSUB '37(4)
   : GOSUB '37(5)
   : J7$=J6$
1260 F6$(14)="N"
   : IF C4$<>"RENAME"AND J6=0THEN 1290
   : E$="Y"
   : GOSUB '45(3,E$)
   : F0$="Deleting old edits that were copied to new field name"
   : GOSUB '53(F0$)
   : GOTO 1300
1290 GOSUB '34(3)
1300 ON POS("YyNn"=E$)GOTO 1320,1320,1590,1590
   : GOSUB '35(" Illegal value, must be either Y, y, N, or n")
   : GOTO 1260
1320 GOSUB '60(E1$(2),J6$)
   : GOSUB '62(E1$(2),1,0)
   : IF Q=0THEN 1540
   : IF Q>0THEN 1380
   : F0$=" The current"
   : IF C5$="S"THEN F0$=F0$&" edit"
   : ELSE F0$=F0$&" operation"
   : F0$=F0$&" is in use by terminal #"
   : CONVERT ABS(Q)TO STR(F0$,41),(###)
   : GOSUB '35(F0$)
   : GOSUB '34(250)
   : GOTO 1320
1380 IF STR(F$(),7,16)<>J6$THEN 1540
   : IF STR(F$(),3,1)=STR(J7$,17,1)AND STR(F$(),1,1)=STR(J7$,18,1)THEN 1480
   : RESTORE VAL(STR(F$(),1,1))-47
   : READ E$
   : STR(E$(),99,49)=E$
   : GOSUB '37(7)
   : CONVERT VAL(STR(F$(),3,1))-31TO STR(E$,,3),(###)
   : STR(E$(),2073)=STR(E$,2,2)
   : GOSUB '37(6)
   : STR(J7$,17,1)=STR(F$(),3,1)
   : STR(J7$,18,1)=STR(F$(),1,1)
1480 J7$=STR(F$(),7,16)&STR(F$(),3,1)&STR(F$(),1,2)
   : GOSUB '41(E1$(2),J7$,.5)
   : IF Q=0THEN 1540
   : F$()=" "
   : GOSUB '42(E1$(2),0)
   : J1=1
   : GOTO 1320
1540 IF J1=1THEN 1580
   : F0$=" There were no edits found for this"
   : IF C5$="S"THEN F0$=F0$&" screen and field name"
   : ELSE F0$=F0$&" report and operation name"
   : GOSUB '35(F0$)
   : IF C4$<>"RENAME"THEN GOSUB '34(250)
   : GOTO 1590
1580 E$=" All the edits for this"
   : IF C5$="S"THEN E$=E$&" field"
   : ELSE E$=E$&" operation"
   : E$=E$&" have been deleted"
   : GOSUB '53(E$)
   : IF C4$<>"RENAME"THEN GOSUB '34(250)
1590 IF C5$="R"THEN 1630
   : MAT REDIM E$(24)83,F$(27)83,E2$(27)83,E3$(24)83
   : DATA LOAD DA T#3,(E4+25)E$()
   : DATA LOAD DA T#3,(E4+33)F$()
   : DATA LOAD DA T#3,(E4+42)E2$()
   : DATA LOAD DA T#3,(E4+51)E3$()
   : MAT REDIM E$(E8)1,F$(E9)1,E2$(250)9,E3$(249)8
   : IF C4$="RENAME"THEN GOSUB 1640
   : IF C4$<>"RENAME"THEN 1610
   : C=D3
   : R=D4
   : GOTO 1620
1610 R=C1
   : C=C2
1620 R3$(1)="IDS2MS01"
   : COM CLEAR J6$
   : LOAD T#2,"IDS2PS03"1000,
1630 MAT REDIM E$(24)83,F$(27)83
   : DATA LOAD DA T#3,(E4)E$()
   : DATA LOAD DA T#3,(E4+25)F$()
   : MAT REDIM E$(E8)1,F$(E9)1
   : COM CLEAR J6$
   : LOAD T#2,"IDS2PR13"1000,
1640 CONVERT STR(E$(),52,3)TO I
   : ERRORI=0
1650 J5=I+J5-J4
   : IF J5>0THEN STR(E2$(D6),6,1)=OR HEX(08)
   : STR(E2$(D6),7,1)=AND HEX(40)
   : STR(E2$(D6),7,1)=OR BIN(J5-SGN(J5))
   : RETURN
1680 DATA "No-op - Perform Pass/Fails Only","Set Field(s)=Field(s)/Constant(s)
     ","Read a record from a data file","Perform Logical Testing Operations","
     Math Calculation Specifications"
1690 DATA "Range Test Specifications","Table look-up or Look-up & Replace","Us
     er-supplied Process Specification"
   : ON ERRORE1$,E2$GOTO 3700
3700 DEFFN'31
   : E$="IDS2PS95"
   : IF E5$<"Y"THEN LOAD T#2,"IDS2PER1"1000,
   : STOP "ERROR"