Listing of file='KFAM4003' on disk='vmedia/701-2049C.wvd.zip'
# Sector 261, program filename = 'KFAM4003'
0010 REM KFAM4003,VER.02/18/76
0012 COM Q6$64
5270 DIM X$64,A$(4)64
: DIM Q2$2,Q3$2,V5$1,V8$1,V0$2,V1$8,V2$2,V3$2,V6$1,T2$2,T4$3
: DIM T5$30,T7$30,T2$(8)2,T(8),T8$1
: DIM U1$8,K1$8,X1$2
5420 PRINT HEX(03)
5430 GOSUB '243("ENTER USER FILE NAME (SSSSFJNN)",8)
: U1$=Q6$
: IF STR(U1$,5,1)="F"THEN 5490
: GOSUB '50("FILE NAME MUST HAVE F IN POSITION 5")
: GOTO 5430
5490 IF STR(U1$,6,1)<"0"THEN 5520
: IF STR(U1$,6,1)>"9"THEN 5520
: GOTO 5550
5520 GOSUB '50("FILE NAME MUST HAVE NUMBER IN POSITION 6")
: GOTO 5430
5550 PRINT HEX(03)
: GOSUB '125("ENTER THE NO. OF THE USER FILE DEVICE ADDRESS")
: D1=X
: ON D1-1GOTO 5613,5615,5617,5619,5621,5623
: SELECT #1310
: GOTO 5660
5613 SELECT #1320
: GOTO 5660
5615 SELECT #1330
: GOTO 5660
5617 SELECT #1350
: GOTO 5660
5619 SELECT #1B10
: GOTO 5660
5621 SELECT #1B20
: GOTO 5660
5623 SELECT #1B30
5660 PRINT HEX(03)
: GOSUB '125("ENTER THE NO. OF THE KEY FILE DEVICE ADDRESS")
: D2=X
: ON D2-1GOTO 5723,5725,5727,5729,5731,5733
: SELECT #2310
: GOTO 5780
5723 SELECT #2320
: GOTO 5780
5725 SELECT #2330
: GOTO 5780
5727 SELECT #2350
: GOTO 5780
5729 SELECT #2B10
: GOTO 5780
5731 SELECT #2B20
: GOTO 5780
5733 SELECT #2B30
5780 PRINT HEX(03)
5782 GOSUB '245("ENTER NUMBER OF KEY FILE",1,0)
: IF Q9>0THEN 5794
: GOSUB '50("INVALID")
: GOTO 5782
5794 K1$=U1$
: STR(K1$,5,1)="K"
: CONVERT Q9TO STR(K1$,6,1),(#)
: LIMITS T#1,U1$,U1,U2,U3
: LIMITS T#2,K1$,K1,K2,K3
: DATA LOAD DC OPEN T#2,K1$
: DATA LOAD DC #2,Q2$,Q3$,V5$,V8$,V0$,V1$,V2$,V3$,V6$,T2$,T0,T1,T2,V8,T4$,T
5$,T7$,T2$(),T(),T8$
5910 U6,U7=VAL(Q3$)*256+VAL(STR(Q3$,2))+1
: K6,K7=VAL(V3$)*256+VAL(STR(V3$,2))+1
: U4=VAL(Q2$)*256+VAL(STR(Q2$,2))+VAL(V6$)
: U5=U2-U1-1
: K4=VAL(V2$)*256+VAL(STR(V2$,2))+1
: IF Q2$<HEX(FF00)THEN 5960
: STOP "RUN KFAM2003 FIRST"
5960 K5=K2-K1-1
: GOSUB '248(6,0,0)
: PRINT TAB(10);"LENGTH LOW LIMIT HIGH LIMIT NEW LENGTH"
: PRINT "USER FILE ";
: PRINTUSING 6010,U6,U4,U5
6010 %##### ##### #####
6020 PRINT "KEY FILE ";
: PRINTUSING 6010,K6,K4,K5
6060 GOSUB '243("DO YOU WISH TO REALLOCATE UF SPACE? (Y OR N)",1)
: IF Q6$=" "THEN 6120
: IF Q6$="Y"THEN 6120
: IF Q6$="N"THEN 6210
: GOSUB '50("ANSWER Y OR N")
: GOTO 6060
6120 GOSUB '248(0,0,4)
6130 GOSUB '245("INPUT NEW UF SECTOR ALLOCATION",5,0)
: U6=Q9
: IF U6<U4THEN 6180
: IF U6>U5THEN 6180
: GOTO 6210
6180 GOSUB '50("INVALID - OUT OF BOUNDS")
: GOTO 6130
6210 GOSUB '248(7,49,0)
: PRINTUSING 6420,U6
: GOSUB '248(0,0,4)
6250 GOSUB '243("DO YOU WISH TO REALLOCATE SPACE FOR KF? (Y OR N)",1)
: IF Q6$=" "THEN 6310
: IF Q6$="Y"THEN 6310
: IF Q6$="N"THEN 6400
: GOSUB '50("ANSWER Y OR N")
: GOTO 6250
6310 GOSUB '248(0,0,4)
6320 GOSUB '245("ENTER NEW KF SECTOR ALLOCATION",5,0)
: K6=Q9
: IF K6<K4THEN 6370
: IF K6>K5THEN 6370
: GOTO 6400
6370 IF K4>K5THEN 6385
: GOSUB '50("INVALID - OUT OF BOUNDS")
: GOTO 6320
6385 GOSUB '248(0,0,4)
: STOP "COPY AND LENGTHEN KF FIRST"
6400 GOSUB '248(8,49,0)
: PRINTUSING 6420,K6
6420 %#####
6450 IF U6=U7THEN 6620
: U8=U1+U7
: DATA LOAD BA T#1,(U8,X)A$()
: DATA LOAD DC OPEN T#1,U1$
: DSKIP #1,END
: DATA SAVE DC $#1,U1$
: IF U6>U7THEN 6540
: Y=U7-U6+1
: DBACKSPACE #1,YS
: GOTO 6580
6540 Y=U6-U7-1
: IF Y=0THEN 6580
: DSKIP #1,YS
6580 DATA SAVE DC $#1,END
: U8=U1+U6
: DATA SAVE BA T$#1,(U8,U8)A$()
: DATA SAVE DC CLOSE#1
: GOSUB '51(U6-1)
: Q3$=X1$
6620 IF K6=K7THEN 6790
: DSKIP #2,END
: DATA SAVE DC $#2,K1$
: IF K6>K7THEN 6710
: Y=K7-K6+1
: DBACKSPACE #2,YS
: GOTO 6750
6710 Y=K6-K7-1
: IF Y=0THEN 6750
: DSKIP #2,YS
6750 DATA SAVE DC $#2,END
: DATA SAVE DC CLOSE#2
: GOSUB '51(K6-1)
: V3$=X1$
6790 DATA LOAD DC OPEN T#2,K1$
: DATA SAVE DC $#2,Q2$,Q3$,V5$,V8$,V0$,V1$,V2$,V3$,V6$,T2$,T0,T1,T2,V8,T4$,
T5$,T7$,T2$(),T(),T8$
: GOSUB '248(0,0,4)
6840 GOSUB '243("DO YOU WISH TO DO ANOTHER FILE? (Y OR N)",1)
: IF Q6$=" "THEN 5420
: IF Q6$="Y"THEN 5420
: IF Q6$="N"THEN 6910
: GOSUB '50("ANSWER Y OR N")
: GOTO 6840
6910 GOSUB '248(0,0,4)
: COM CLEAR Q6$
: LOAD DC T#0,"START050"
6950 DEFFN'50(Q6$)
: PRINT HEX(010A0A0A)
: PRINT Q6$
: RETURN
7010 DEFFN'51(X)
: Y=INT(X/256)
: BIN(X1$)=Y
: BIN(STR(X1$,2))=X-256*Y
: RETURN
7100 DEFFN'125(X$)
: GOSUB '248(5,0,5)
: PRINT ,"1. 310 5. B10"
: PRINT ,"2. 320 6. B20"
: PRINT ,"3. 330 7. B30"
: PRINT ,"4. 350"
7160 GOSUB '245(X$,1,0)
: X=Q9
: IF X<1THEN 7220
: IF X>7THEN 7220
: GOSUB '248(5,0,5)
: RETURN
7220 PRINT HEX(010A0A0A)
: PRINT "INVALID DEVICE ADDRESS"
: GOTO 7160
8710 Q6=3
: GOTO 9289
8975 DEFFN'242(W0,Q6$)
: IF W0<=0THEN 9405
: IF W0=1THEN 8990
: STR(Q6$,2)=STR(Q6$,1,W0-1)
8990 PRINT Q6$;
: RETURN
9010 DEFFN'243(Q6$,Q0)
: GOSUB 9200
9022 SELECT CO 205
: Q6$=" "
: INPUT Q6$
: IF Q0=0THEN 9231
: IF LEN(Q6$)<=Q0THEN 9231
: GOSUB 9150
9032 DEFFN'244(Q0)
: GOSUB 9220
: GOSUB 9210
: GOTO 9022
9038 DEFFN'245(Q6$,Q2,Q3)
: Q0=ABS(Q2)+Q3+1
: GOSUB 9200
9044 GOSUB '242(ABS(Q2)+2,HEX(09))
: PRINT "/"
: GOSUB 9220
: SELECT CO 205
: Q9,W0=-1E-99
: INPUT Q9
: IF W0=Q9THEN 9058
: IF Q9>=0THEN 9070
: IF Q2<=0THEN 9070
9058 GOSUB 9150
9060 DEFFN'246(Q2,Q3)
: Q0=ABS(Q2)+Q3+1
: GOSUB 9220
: GOSUB 9210
: GOTO 9044
9070 IF ABS(Q9)>=10^ABS(Q2)THEN 9058
: W0=ABS(Q9*10^Q3)
: IF INT(W0)<>W0THEN 9058
: GOTO 8710
9150 GOSUB 8710
: PRINT "RE-ENTER"
: RETURN
9200 GOSUB 9405
: PRINT HEX(010A);STR(Q6$,1);
9210 GOSUB 9405
: GOSUB '242(Q0+2,"-")
: PRINT TAB(64)
9220 PRINT HEX(010A0A)
: RETURN
9231 PRINT HEX(0A);TAB(64)
: GOTO 9405
: Q6=0
9289 Q7=0
: Q8=1
9290 DEFFN'248(Q6,Q7,Q8)
: GOSUB 9405
: IF Q8<1THEN 9350
: GOSUB 9350
: SELECT PRINT 205
: Q6$=" "
: PRINT STR(Q6$,Q7+1)
: IF Q8<2THEN 9350
: FOR W0=2TO Q8
: PRINT HEX(0A);STR(Q6$,1)
: NEXT W0
9350 PRINT HEX(01)
: GOSUB '242(Q7,HEX(09))
: GOSUB '242(Q6,HEX(0A))
9405 SELECT PRINT 005(64),CO 005
: RETURN