Listing of file='IDS2PS88' on disk='vmedia/701-2715B.wvd.zip'
# Sector 341, program filename = 'IDS2PS88'
1000 REM "IDS2PS88" - Release 2.1 - SPECIAL EDIT FILE MAINTENANCE
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"
: IF R3$(1)<>"IDS2PS88"THEN 1070
: GOSUB '32("IDS2sS68")
1070 DIM J9$8
: J9$=ALL(FF)
: J8=1
: J9=4
: R3$(1)="IDS2PS93"
: E$()=" "
: PRINT AT(3,2);BOX(-1,-75);AT(5,11);BOX(-3,-57);
: GOSUB '32(J1$)
: E$="Supplementary Utilities"
: STR(E$(),2034,24)=E$
: GOSUB '45(1,E$)
: GOSUB '39(J1$,3)
: MAT REDIM E$(24)83
: DATA LOAD DA T#P,(A)E$()
: MAT REDIM E$(E8)1
: J8=1
: J9=4
1240 GOSUB 2070
: 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$(),2000,24)=E$
: GOSUB '45(22,"=>")
: C9=1
1290 GOSUB '53("Please Select Appropriate SF Key")
: GOSUB '34(250)
: F0$=HEX(1F05060B0C09)
: IF J0$="Expanded"THEN STR(F0$,6)=HEX(0F20)
: ON POS(F0$=E6$)GOTO 1390,1410,1470,1900,1970,1530,1530
: PRINT HEX(07)
: GOTO 1290
1390 LOAD T#2,"IDS2PS93"1000,3799
1410 GOSUB '45(C9+21," ")
: IF STR(C9$(),,8)=J9$AND STR(C8$(),,8)=J9$THEN 1290
1420 C9=MOD(C9,4)+1
: IF STR(C8$(C9),,8)=J9$THEN 1420
: GOSUB '45(C9+21,"=>")
: GOTO 1290
1470 GOSUB '45(C9+21," ")
: IF STR(C9$(),,8)=J9$AND STR(C8$(),,8)=J9$THEN 1290
1480 C9=MOD(C9-1,4)
: IF C9=0THEN C9=4
: IF STR(C8$(C9),,8)=J9$THEN 1480
: GOSUB '45(C9+21,"=>")
: GOTO 1290
1530 IF J0$="Deleted"THEN 1620
: I=VAL(STR(C9$(C9),18))-47
: IF I<0OR I>7THEN 1580
: IF STR(C9$(C9),,8)<>J9$THEN 1570
1570 IF VAL(STR(J3$,18,1))-47<9OR VAL(STR(J3$,18,1))-47>0THEN LOAD T#2,"IDS2PS
90"1000,3799
1580 F0$="Record can not be expanded, EXEC to cancel"
1590 GOSUB '35(F0$)
: GOSUB '34(250)
: IF Q=32THEN 1290
: GOTO 1590
1620 GOSUB '53("To verify deletion, Press SF'9")
: GOSUB '34(250)
: IF E6$<>HEX(09)THEN 1290
: GOSUB '53("Deleting Edit")
: F6$(14)="N"
: J4=0
: IF STR(C9$(C9),,8)<>J9$THEN 1730
: E$,C9$(C9)=STR(C8$(C9),,19)
: J4=1
: GOTO 1800
1730 GOSUB '60(E1$(2),STR(C9$(C9),,17))
: IF STR(C8$(C9),,17)=STR(E6$(),,17)THEN C8$(C9)=STR(E6$(),,19)
: ELSE C8$(C9)=" "
: GOSUB '62(E1$(2),1,0)
: F6$(14)="Y"
: IF F$()=" "AND C8$(C9)<>" "AND Q<>0THEN E$=STR(C8$(C9),,19)
: ELSE GOTO 1780
: J4=1
: GOTO 1800
1780 IF Q=0OR STR(F$(),7,16)<>STR(C9$(C9),,16)OR STR(F$(),3,1)<>STR(C9$(C9),17
,1)THEN 1840
: E$=STR(F$(),7,16)
: STR(E$,17)=STR(F$(),3)
: STR(E$,18)=STR(F$(),,2)
1800 GOSUB '41(E1$(2),E$,.5)
: F6$(14)="Y"
: IF Q=0THEN 1840
: IF Q<0THEN 1850
1820 F$()=" "
: F6$(14)="Y"
: IF J4=0THEN GOSUB '42(E1$(2),0)
: ELSE GOSUB '59(2,1,E$,3)
: J1=1
: GOSUB '53("Edit Deleted")
: GOTO 1730
1840 FOR L=C9TO 4
: C9$(L)=C9$(L+1)
: C8$(L)=C8$(L+1)
: NEXT L
: J8,J9=4
: MAT SEARCHC9$(),=J9$TO F9$STEP 18
: IF F9$=HEX(0000)THEN 2590
: STR(C8$(),INT(VAL(F9$,2)/18)+1+VAL(STR(F9$,2))),STR(C9$(),VAL(F9$,2))=ALL
(FF)
: GOSUB 2070
: GOTO 1290
1850 E$="Edit is in use by station ##. FN'31 to cancel, EXEC to wait"
: CONVERT ABS(Q)TO STR(E$,27,2),(##)
: GOSUB '35(E$)
: GOSUB '34(250)
: IF Q=32THEN 1820
: IF Q=31THEN 1390
: GOTO 1850
1900 PRINT "Scrolling screen"
: IF STR(C8$(5),,8)<>J9$THEN 1920
: F0$="END OF FILE"
: GOTO 1240
1920 C9$(1)=C9$(5)
: C8$(1)=C8$(5)
: J8=1
: J9=4
: GOTO 2590
1970 PRINT "Scrolling screen"
: IF STR(C8$(5),,8)<>J9$THEN 1990
: F0$="END OF FILE"
: GOTO 1240
1990 FOR I=1TO 4
: C9$(I)=C9$(I+1)
: C8$(I)=C8$(I+1)
: NEXT I
: J8,J9=4
: GOTO 2590
2070 FOR J2=1TO 4
: IF STR(C8$(J2),,8)<>J9$THEN 2150
: FOR J3=5TO 17STEP 4
: GOSUB '45(J3+J2," ")
: NEXT J3
: GOSUB '45(25+J2," ")
: GOTO 2300
2150 IF STR(C9$(J2),,8)=J9$THEN J3$=C8$(J2)
: ELSE J3$=C9$(J2)
: GOSUB '45(5+J2,STR(J3$,,8))
: GOSUB '45(9+J2,STR(J3$,9,8))
: CONVERT VAL(STR(J3$,17))-31TO E$,(###)
: ROTATEC(E$,8)
: GOSUB '55(13+J2,VAL(STR(J3$,17))-31)
: IF STR(C9$(J2),,8)=J9$THEN 2240
: E$=" "
: GOTO 2260
2240 RESTORE VAL(STR(C8$(J2),20))
: READ E$
2260 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$)
2300 NEXT J2
: RETURN
2320 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","
Perform Math Calculations"
2330 DATA "Range Test Specifications","Table look-up/replace","User-supplied p
rocess","Invalid Edit Specification","Error: Record Is Blank And Should B
e Deleted","Error: Key Does Not Reflect Data Record Information"
2340 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 2540
2490 STR(C9$(J5),,16)=STR(F$(),7)
: STR(C9$(J5),17)=STR(F$(),3)
: STR(C9$(J5),18)=STR(F$(),1)
: GOTO 2560
2540 C9$(J5)=ALL(FF)
: IF J4$=HEX(1F)THEN STR(C8$(J5),20,1)=BIN(10)
: ELSE STR(C8$(J5),20,1)=BIN(11)
2560 RETURN
2590 FOR J2=J8TO J9
: IF STR(C9$(J2),,8)=J9$THEN E$=STR(C8$(J2),,17)&ALL(00)
: ELSE E$=STR(C9$(J2),,17)&ALL(00)
: STR(E$,17,1)=ADDHEX(01)
2620 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 2760
: C9$(J2+1)=ALL(FF)
: GOTO 2790
2760 IF STR(F$(),7,16)<>STR(C9$(J2),,16)OR STR(F$(),3,1)<>STR(C9$(J2),17,1)THE
N 2780
: STR(E$,17,1)=ADDHEX(01)
: GOTO 2620
2780 J5=J2+1
: GOSUB 2340
2790 NEXT J2
: GOSUB 2070
: GOTO 1290
3699 ON ERRORE1$,E2$GOTO 3700
3700 DEFFN'31
: E$="IDS2PS88"
: IF E5$<"Y"THEN LOAD T#2,"IDS2PER1"1000,
: STOP "ERROR"