image of READY prompt

Wang2200.org

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"