Listing of file='IDS2PS86' on disk='vmedia/701-2715B.wvd.zip'
# Sector 314, program filename = 'IDS2PS86'
1000 REM "IDS2PS86" - Release 2.1 - SPECIAL EDIT FILE MAINTENANCE
1020 E6$=F6$(17)AND HEX(02)
: IF E6$=HEX(00)THEN LOAD T#2,"IDS2SUB8"3701,3899BEG 1030
1030 IF F6$(17)<"^"THEN SELECT @PART"IDS2SUBM"
: IF C9$(1)=" "THEN 1315
: IF STR(C9$(),,8)=HEX(FFFFFFFFFFFFFFFF)AND STR(C8$(),,8)=HEX(FFFFFFFFFFFFF
FFF)THEN 1315
: IF STR(C9$(1),,8)=HEX(FFFFFFFFFFFFFFFF)THEN J3$=STR(C8$(1),,17)&ALL(00)
: ELSE J3$=C9$(1)&ALL(00)
: GOSUB '45(3,STR(J3$,,8))
: GOSUB '45(4,STR(J3$,9,8))
: GOSUB '55(5,VAL(STR(J3$,17))-31)
: GOTO 1520
1315 C9$(),C8$(),E$,E$()=" "
1320 F=2
1330 F=F+1
: GOSUB '34(F)
: ON F-2GOTO 1380,1430,1480
: IF F<6THEN 1320
: J3$=STR(C9$(1),,17)&ALL(00)
: GOTO 1520
1380 STR(C9$(1),,8)=E$
: IF E$=" "THEN F=F+2
: GOTO 1330
1430 STR(C9$(1),9,8)=E$
: IF E$=" "THEN F=F+1
: GOTO 1330
1480 IF E$=" "THEN I=0
: ELSE I=Q
: STR(C9$(1),17)=BIN(I+31)
: GOTO 1330
1520 F6$(14)="N"
: GOSUB '60(E1$(2),J3$)
: C8$(1)=STR(E6$(),,19)
: GOSUB '62(E1$(2),1,0)
: F6$(14)="Y"
: IF Q<>0THEN 1680
: F0$="End of edit file"
: GOSUB '35(F0$)
: GOTO 1320
1680 J5=1
: GOSUB 2650
: IF STR(C9$(1),,8)=HEX(FFFFFFFFFFFFFFFF)THEN J3$=C8$(1)
: ELSE J3$=C9$(1)
: GOSUB '45(3,STR(J3$,,8))
: GOSUB '45(4,STR(J3$,9,8))
: GOSUB '55(5,VAL(STR(J3$,17))-31)
1770 FOR J2=J8TO J9
: IF STR(C9$(J2),,8)=HEX(FFFFFFFFFFFFFFFF)THEN E$=STR(C8$(J2),,17)&ALL(00)
: ELSE E$=STR(C9$(J2),,17)&ALL(00)
: STR(E$,17,1)=ADDHEX(01)
1800 F6$(14)="N"
: GOSUB '60(E1$(2),E$)
: C8$(J2+1)=STR(E6$(),,19)
: GOSUB '62(E1$(2),1,0)
: F6$(14)="Y"
: IF Q<>0THEN 1940
: C9$(J2+1)=ALL(FF)
: GOTO 1970
1940 IF STR(F$(),7,16)<>STR(C9$(J2),,16)OR STR(F$(),3,1)<>STR(C9$(J2),17,1)THE
N 1960
: STR(E$,17,1)=ADDHEX(01)
: GOTO 1800
1960 J5=J2+1
: GOSUB 2650
1970 NEXT J2
: GOSUB 2370
: F0$="Please Select Appropriate SF Key"
2000 GOSUB '53(F0$)
: F$(14)="N"
: GOSUB '34(250)
: F$(14)="Y"
: ON POS(HEX(0007090B0C0F20)=E6$)GOTO 1320,2070,2120,2200,2270,2160,2200
: GOTO 2000
2070 C9$(1),J3$=ALL(00)
: J8=1
: J9=4
: GOTO 1520
2120 J0$="Deleted"
: J1$="IDS2sS69"
: GOTO 2180
2160 J0$="Expanded"
: J1$="IDS2sS70"
2180 LOAD T#2,"IDS2PS88"1000,3700
2200 PRINT "Scrolling screen";HEX(06);
: IF STR(C8$(5),,8)<>HEX(FFFFFFFFFFFFFFFF)THEN 2220
: F0$="END OF FILE"
: GOTO 2000
2220 C9$(1)=C9$(5)
: C8$(1)=C8$(5)
: J8=1
: J9=4
: GOTO 1770
2270 PRINT "Scrolling screen";HEX(06);
: IF STR(C8$(5),,8)<>HEX(FFFFFFFFFFFFFFFF)THEN 2290
: F0$="END OF FILE"
: GOTO 2000
2290 FOR I=1TO 4
: C9$(I)=C9$(I+1)
: C8$(I)=C8$(I+1)
: NEXT I
: J8,J9=4
: GOTO 1770
2370 FOR J2=1TO 4
: IF STR(C8$(J2),,8)<>HEX(FFFFFFFFFFFFFFFF)THEN 2450
: FOR J3=5TO 17STEP 4
: GOSUB '45(J3+J2," ")
: NEXT J3
: GOSUB '45(25+J2," ")
: GOTO 2600
2450 IF STR(C9$(J2),,8)=HEX(FFFFFFFFFFFFFFFF)THEN J3$=C8$(J2)
: ELSE J3$=C9$(J2)
: GOSUB '45(5+J2,STR(J3$,,8))
: GOSUB '45(9+J2,STR(J3$,9,8))
: GOSUB '55(13+J2,VAL(STR(J3$,17))-31)
: IF STR(C9$(J2),,8)=HEX(FFFFFFFFFFFFFFFF)THEN 2540
: E$=" "
: GOTO 2560
2540 RESTORE VAL(STR(C8$(J2),20))
: READ E$
2560 GOSUB '45(25+J2,E$)
: IF VAL(STR(J3$,18,1))-47>8OR VAL(STR(J3$,18,1))-47<1THEN RESTORE 09
: ELSE RESTORE VAL(STR(J3$,18,1))-47
: READ E$
: GOSUB '45(17+J2,E$)
2600 NEXT J2
: RETURN
2620 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"
2630 DATA "Range Test Specifications","Table look-up or Look-up & Replace","Us
er-supplied Process Specification","Invalid Edit Specification","Error: R
ecord Is Blank And Should Be Deleted","Error: Key Does Not Reflect Data R
ecord Information"
2650 J4$=HEX(00)
: IF STR(F$(),7,8)<>STR(C8$(J5),,8)THEN J4$=OR HEX(10)
: IF STR(F$(),15,8)<>STR(C8$(J5),9,8)THEN J4$=OR HEX(08)
: IF STR(F$(),3,1)<>STR(C8$(J5),17,1)THEN J4$=OR HEX(04)
: IF STR(F$(),,1)<>STR(C8$(J5),18,1)THEN J4$=OR HEX(02)
: IF STR(F$(),2,1)<>STR(C8$(J5),19,1)THEN J4$=OR HEX(01)
: IF J4$<>HEX(00)THEN 2840
: STR(C9$(J5),,16)=STR(F$(),7)
2800 STR(C9$(J5),17)=STR(F$(),3)
: STR(C9$(J5),18)=STR(F$(),1)
: GOTO 2860
2840 C9$(J5)=ALL(FF)
: IF J4$=HEX(1F)THEN STR(C8$(J5),20,1)=BIN(10)
: ELSE STR(C8$(J5),20,1)=BIN(11)
2860 RETURN
3699 ON ERRORE1$,E2$GOTO 3700
3700 DEFFN'31
: E$="IDS2PS86"
: IF E5$<"Y"THEN LOAD T#2,"IDS2PER1"1000,
: STOP "ERROR"