image of READY prompt

Wang2200.org

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"