Listing of file='IDS2PUM2' on disk='vmedia/701-2715B.wvd.zip'
# Sector 746, program filename = 'IDS2PUM2'
1000 REM 'IDS2PUM2' STAND-ALONE MAINTENANCE PROGRAM FOR CPU ID FILE
1010 IF F6$(17)<"^"THEN SELECT @PART"IDS2SUBM"
: DIM F0(6)
: R0=0
: LIMITS T#2,"IDS2f001",A,B,C,D
: IF D>0THEN 1050
: DATA SAVE DC OPEN T#2,(3)"IDS2f001"
: MAT F0=ZER
: J0=1
: F0(1)=#ID
: R0=#PART
: DATA LOAD DC OPEN T#2,"IDS2f001"
: DATA SAVE DC #2,J0,F0()
: DATA SAVE DC #2,END
: GOSUB 1250
: GOTO 1090
1050 DATA LOAD DC OPEN T#2,"IDS2f001"
: DATA LOAD DC #2,J0,F0()
: GOSUB 1250
: FOR I=1TO J0
: IF F0(I)<>#IDTHEN 1080
: R0=(I-1)*16+#PART
: GOTO 1090
1080 NEXT I
1085 PRINT HEX(07);
1090 F0$=" "
: IF R0=0THEN F0$=" FN' 00 = Add,"
: F0$=F0$&" 'EDIT' = Change,"
: IF J0>1THEN F0$=F0$&" FN' 09 = Delete,"
: F0$=F0$&" 'EXEC' = End."
: GOSUB '53(F0$)
: GOSUB '34(8)
: IF Q=33THEN 1120
: IF Q=0AND R0=0THEN 1110
: IF Q=9AND J0>1THEN 1160
: IF Q=32THEN 1200
: IF Q=31THEN LOAD T#2,R3$(1)1000,
: GOTO 1085
1110 J0=J0+1
: F0(J0)=#ID
: R0=(J0-1)*16+#PART
: DBACKSPACE #2,BEG
: DATA SAVE DC #2,J0,F0()
: DATA SAVE DC #2,END
: GOSUB 1260
: GOTO 1090
1115 PRINT HEX(07);
1120 F0$="Please enter number for CPU to swap with (FN' 01 to FN' ##)"&ALL(20)
: CONVERT J0TO STR(F0$,POS(F0$=23),2),(##)
: GOSUB '53(F0$)
: GOSUB '34(8)
: IF Q=31THEN 1090
: IF Q<1OR Q>J0THEN 1115
: F=Q
: J1=(R0-#PART)/16+1
: IF F=J1THEN 1140
: F0(J1)=F0(F)
1140 F0(F)=#ID
: R0=(F-1)*16+#PART
: DBACKSPACE #2,BEG
: DATA SAVE DC #2,J0,F0()
: DATA SAVE DC #2,END
: GOSUB 1260
: GOTO 1090
1150 PRINT HEX(07);
1160 F0$="Please enter number for CPU to delete (FN' 01 to FN' ##)"&ALL(20)
: CONVERT J0TO STR(F0$,POS(F0$=23),2),(##)
: GOSUB '53(F0$)
: GOSUB '34(8)
: IF Q=31THEN 1090
: IF Q<1OR Q>J0THEN 1150
: F=Q
1170 IF F0(F)=#IDTHEN 1150
: FOR I=FTO J0
: F0(I)=F0(I+1)
: NEXT I
: J0=J0-1
: R0=0
: FOR I=J0TO 1STEP -1
: IF F0(I)=#IDTHEN R0=(I-1)*16+#PART
: NEXT I
: DBACKSPACE #2,BEG
: DATA SAVE DC #2,J0,F0()
: DATA SAVE DC #2,END
: GOSUB 1260
: GOTO 1090
1200 DIM J$8
: J$="IDS2fsxx"
: IF R0>=#PARTTHEN CONVERT (R0-#PART)/16+1TO STR(J$,7,2),(##)
: ELSE STOP "Illegal station specification"
: LIMITS T#2,J$,A,B,C,D
: IF D>0AND B-A>=165THEN 1240
: IF D=0THEN 1230
: DIM J1$8
: J1=0
: J1$="JUNKxxxx"
1220 J1=J1+1
: CONVERT J1TO STR(J1$,5,4),(####)
: LIMITS T#2,J1$,A,B,C,D
: IF D<>0THEN 1220
: SCRATCH T#2,J$
: SAVE DC T#2,(J$)J1$1000,1000
: SCRATCH T#2,J1$
1230 DATA SAVE DC OPEN T#2,(166)J$
: DATA LOAD DC OPEN T#2,J$
: MAT REDIM E3$(9)83
: E3$()=" "
: DATA SAVE DC #2,E3$()
: DSKIP #2,161S
: DATA SAVE DC #2,END
: LIMITS T#2,J$,A,B,C,D
: FOR I=A+3TO A+163
: DATA SAVE BA T#2,(I)STR(E3$(),,256)
: NEXT I
: STR(E3$(),,8)=ALL(30)
: DATA SAVE BA T#2,(A+3)STR(E3$(),,256)
1240 LOAD DC T#2,R3$(1)1000,
1250 GOSUB '32("IDS2sUM1")
1260 FOR I=1TO J0
: GOSUB '55(I,F0(I))
: NEXT I
: IF J0=6THEN 1290
: FOR I=J0+1TO 6
: GOSUB '45(I,"NOT USED")
: NEXT I
: GOSUB '55(7,#ID)
1290 RETURN
2000 DEFFN'127"J5$=";HEX(22);"IDS2PUM2";HEX(22);":SCRATCH T J5$ :SAVE DC T ()
J5$1000, ";HEX(0D)
: ON ERRORE1$,E2$GOTO 3700
3700 DEFFN'31
: E$="IDS2PUM2"
: IF E5$<"Y"THEN LOAD T#2,"IDS2PER1"1000,
: STOP "ERROR"