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"