Listing of file='KFAM3204' on disk='vmedia/701-2086B.wvd.zip'
# Sector 403, program filename = 'KFAM3204'
4000 REM KFAM3204,VER.03/02/76
4310 DIM S$8,R2$(8)2,R7$30,R4$3
: DIM R8$2,K$30,R$2,R5$2,R9$2
4380 LOAD DA T#4,(R6$,R6$)4400,4459
4400 DIM A0$(4)64,E0$(4)64,I0$(4)64
4460 PRINT HEX(030A0A0A0A)
: PRINT "REORGANIZE KFAM FILE (KFAM3204)"
4530 GOSUB '235(1,0)
: IF Q$<>" "THEN 7130
: GOSUB 5790
: R$=HEX(0000)
: R1=1
4600 GOSUB 5700
: IF R2$>"C"THEN 5410
4650 R9$=R4$
: ADDC(R9$,R1$)
4720 Z=1
4770 Z=2
4810 R9$=R4$
: ADDC(R9$,R1$)
4890 GOSUB '66
: IF STR(K$,1,1)=HEX(FF)THEN 5100
: GOSUB '232(1,0,K$)
: IF Q$="N"THEN 5100
: IF Q$<>" "THEN 7130
: IF STR(T4$,1,2)<>R$THEN 5100
: IF Q<>R1THEN 5100
: STR(T3$(1),T4+1,3)=STR(R4$,1,3)
: MAT COPY T3$()<1,T5>TO T0$()<T,T5>
: GOSUB 7970
5100 R5$=R4$
: GOSUB 5890
: GOSUB '237(1,0)
: IF Q$="E"THEN 5350
: IF Q$<>" "THEN 7130
: GOSUB 5790
: IF R2$>"C"THEN 5300
: R1=R1+1
: IF R1>R0THEN 5270
: IF R5$=R$THEN 4600
: GOTO 4650
5270 GOSUB 5620
: R1=1
5300 ADDC(R$,V6$)
: GOTO 4600
5350 GOSUB 5620
: GOTO 6740
5410 IF R$=STR(R4$,1,2)THEN 5100
: R8$=R$
: ADDC(R8$,R1$)
: R9$=R4$
: ADDC(R9$,R1$)
: FOR X=1TO S9
: DATA LOAD BA T#2,(R9$,R9$)E0$()
: DATA SAVE BA T$#2,(R8$,R8$)E0$()
: NEXT X
: R9$=R4$
: ADDC(R9$,R1$)
5590 GOTO 4890
5620 R9$=R$
: ADDC(R9$,R1$)
5670 RETURN
5700 R9$=R$
: ADDC(R9$,R1$)
5760 RETURN
5790 S$=T$
: MAT COPY T2$()TO R2$()
: R4$=T4$
: R7$=T7$
: R2=Q
: RETURN
5890 T$=S$
: MAT COPY R2$()TO T2$()
: T4$=R4$
: T7$=R7$
: RETURN
6200 DEFFN'65
: S8=3+(R1-1)*R
: S2=3+(R2-1)*R
: IF Z=2THEN 6430
: MAT COPY E0$()<S2,R>TO I0$()<S8,R>
: RETURN
6430 MAT COPY A0$()<S8,R>TO E0$()<S2,R>
: RETURN
6520 DEFFN'66
: IF R2$="A"THEN 6670
: S8=R3+(R1-1)*R
6580 MAT COPY A0$()<S8,R5>TO T3$()
6590 K$=STR(T3$(1),1,R5)
: RETURN
6670 K$=STR(A0$(R1),R3,R5)
6680 RETURN
6740 Q2$=HEX(0000)
: BIN(STR(Q2$,2))=S9-1
: XOR (Q2$,FF)
: FOR X=1TO 4
: V5$(X)=V8$
: NEXT X
: V2$=HEX(0001)
: T2$=HEX(0001)
: T0=1
: T=1
: T$=HEX(01)
: INIT(5A)T8$()
: INIT(00)T7$
: INIT(FF)T0$()
: INIT(00)STR(T0$(1),1,R5)
: T2$(1),T9$=T2$
: GOSUB 7970
: R1=R0
6910 R$=Q2$
: C1=0
6960 C1=C1+1
: R1=R1+1
: IF R1<=R0THEN 7090
: ADDC(R$,V6$)
: IF R$<=Q3$THEN 7060
: GOSUB '70("LAST KEY NOT FOUND")
7060 GOSUB 5700
: R1=1
7090 GOSUB '66
: IF K$>T7$THEN 7150
7130 GOSUB '70("SEQUENCE ERROR")
7150 T7$=K$
: T6$=K$
: IF T6$<HEX(FF)THEN 7200
: GOSUB '70("INVALID KEY")
7200 IF VAL(STR(T$,1))+T5<193THEN 7380
: Q2=1
: FOR T3=T0TO 1STEP -1
: IF VAL(STR(T$,T3))+T5<193THEN 7270
: Q2=Q2+1
: GOTO 7280
7270 Q2=0
7280 NEXT T3
: IF Q2<9THEN 7330
7310 GOSUB '70("KEY FILE SPACE EXCEEDED")
7330 V9$=V2$
: BIN(T6$)=Q2
: ADDC(V9$,T6$)
: IF V3$<V9$THEN 7310
7380 V9$=T2$(1)
: IF V9$=T9$THEN 7450
: GOSUB 545
7450 T3$=R$
: BIN(STR(T3$,3))=R1
: T4$=T3$
: T3=1
7500 T=VAL(STR(T$,T3))+T5
: IF T<193THEN 7800
: INIT(FF)T0$()
: STR(T0$(1),1,T4)=K$
: STR(T0$(1),T4+1,3)=T3$
: ADDC(V2$,01)
: T9$,T2$(T3),T3$=V2$
: STR(T$,T3,1)=HEX(01)
: GOSUB 7970
: T3=T3+1
: IF T3>T0THEN 7690
: V9$=T2$(T3)
: GOSUB 545
: GOTO 7500
7690 T0=T0+1
: INIT(FF)T0$()
: INIT(00)STR(T0$(1),1,T5)
: STR(T0$(1),T4+1,2)=T2$
: ADDC(V2$,01)
: T9$,T2$,T2$(T3)=V2$
: STR(T$,T3,1)=HEX(01)
: GOTO 7500
7800 T3$(1)=K$
: STR(T3$(1),T4+1,3)=T3$
: BIN(STR(T$,T3))=T
: MAT COPY T3$()TO T0$()<T,T5>
: GOSUB 7970
: IF K$<>R7$THEN 6960
: Q2$,V2$(V0)=R$
: BIN(V5$(V0))=R1
: GOSUB '239(1)
: V9$=HEX(A0FD)
: T1$=HEX(A002A002A001A001A008A001A002)
7888 $PACK(F=T1$)T0$()FROMV9$,Q2$,V5$(),V8$,V1$,V6$,V2$()
: DATA SAVE BA T$#2,(S7,X)T0$()
: PRINT "RECORD COUNT ";C1
: PRINT HEX(0A)
: PRINT "END OF PROGRAM"
: GOTO 8820
7970 V9$=T9$
: ADDC(V9$,V0$)
: DATA SAVE DA T$#T1,(V9$,V9$)T9$,T0$()
: RETURN
8050 DEFFN'210(T6)
8060 IF M$="X"THEN 8260
: ON D1GOTO 8080,8100,8120,8140,8160,8180,8200
8080 SELECT #1390
: RETURN
8100 SELECT #13A0
: RETURN
8120 SELECT #13B0
: RETURN
8140 SELECT #13D0
: RETURN
8160 SELECT #1B90
: RETURN
8180 SELECT #1BA0
: RETURN
8200 SELECT #1BB0
: RETURN
8240 DEFFN'211(T6)
: GOTO 8060
8260 ON D1GOTO 8270,8290,8310,8330,8350,8370,8390
8270 SELECT #1310
: RETURN
8290 SELECT #1320
: RETURN
8310 SELECT #1330
: RETURN
8330 SELECT #1350
: RETURN
8350 SELECT #1B10
: RETURN
8370 SELECT #1B20
: RETURN
8390 SELECT #1B30
: RETURN
8430 ON D2GOTO 8440,8460,8480,8500,8520,8540,8560
8440 SELECT #2310
: RETURN
8460 SELECT #2320
: RETURN
8480 SELECT #2330
: RETURN
8500 SELECT #2350
: RETURN
8520 SELECT #2B10
: RETURN
8540 SELECT #2B20
: RETURN
8560 SELECT #2B30
: RETURN
8600 ON D4GOTO 8610,8630,8650,8670,8690,8710,8730
8610 SELECT #4310
: RETURN
8630 SELECT #4320
: RETURN
8650 SELECT #4330
: RETURN
8670 SELECT #4350
: RETURN
8690 SELECT #4B10
: RETURN
8710 SELECT #4B20
: RETURN
8730 SELECT #4B30
: RETURN
8770 DEFFN'70(Q6$)
: PRINT "RESTORE BOTH USER FILE AND KEY FILE FROM BACKUP"
: PRINT "COPIES BEFORE ATTEMPTING TO RE-RUN THIS PROGRAM"
: PRINT HEX(0A)
: PRINT Q6$
8820 GOSUB 8260
: $IF ON #1,8840
8840 GOSUB 8430
: $IF ON #2,8860
8860 GOSUB 8600
: $IF ON #4,8880
8880 STOP
: COM CLEAR D1
: LOAD DC T#0,"START065"