Listing of file='KFAM3003' on disk='vmedia/701-2049C.wvd.zip'
# Sector 213, program filename = 'KFAM3003' 0001 REM KFAM3003,VER.09/26/75 0002 GOTO 3072 0005 COM R,R0,R3,R5,R7,R1$2,R2$1,R6$2,S9,C$40,N,R0$3 0012 COM Q6$64 3072 LOAD DC T#0,"KFAM0003"3072,3072 4000 GOTO 4800 4800 DIM C$40,Y$1,U1$8,U0$3,K1$8,K0$3,R3$8,F0$3,X1$2,X$64 : DIM D$(4)64 4900 PRINT HEX(03) : GOSUB '243("ARE THERE BACKUP COPIES OF USER FILE AND KEY FILE? (Y OR N)", 1) : IF Q6$="Y"THEN 5010 : PRINT "ANY ERROR DURING THE RUNNING OF KFAM3203 WILL" : PRINT "DESTROY BOTH FILES." : PRINT HEX(0A) 4960 PRINT "MAKE COPIES OF THE DISK PLATTER(S) CONTAINING" : PRINT "THE USER FILE AND THE KEY FILE BEFORE RUNNING" : PRINT "THIS PROGRAM." : STOP : GOTO 4900 5010 GOSUB '243("ENTER USER FILE NAME (SSSSFJNN)",8) : U1$=Q6$ : IF STR(U1$,5,1)<>"F"THEN 5060 : IF STR(U1$,6,1)<"0"THEN 5060 : IF STR(U1$,6,1)<="9"THEN 5090 5060 GOSUB '50("NOT KFAM FILE NAME") : GOTO 5010 5090 GOSUB '125("ENTER THE NO. OF THE USER FILE DEVICE ADDRESS") : D2=X : ON D2-1GOTO 5143,5145,5147,5149,5151,5153 : SELECT #2310 : GOTO 5190 5143 SELECT #2320 : GOTO 5190 5145 SELECT #2330 : GOTO 5190 5147 SELECT #2350 : GOTO 5190 5149 SELECT #2B10 : GOTO 5190 5151 SELECT #2B20 : GOTO 5190 5153 SELECT #2B30 5190 GOSUB '245("ENTER KEY FILE NUMBER (NORMAL=1)",1,0) : K9=Q9 : IF K9>0THEN 5240 : GOSUB '50("INVALID") : GOTO 5190 5240 K1$=U1$ : STR(K1$,5,1)="K" : CONVERT K9TO STR(K1$,6,1),(#) : GOSUB '125("ENTER THE NO. OF THE KEY FILE DEVICE ADDRESS") : D1=X : ON D1-1GOTO 5333,5335,5337,5339,5341,5343 : SELECT #1310 : GOTO 5510 5333 SELECT #1320 : GOTO 5510 5335 SELECT #1330 : GOTO 5510 5337 SELECT #1350 : GOTO 5510 5339 SELECT #1B10 : GOTO 5510 5341 SELECT #1B20 : GOTO 5510 5343 SELECT #1B30 5510 GOSUB '243("ENTER WORK FILE NAME",8) : R3$=Q6$ : GOSUB '125("ENTER THE NO. OF THE WORK FILE DEVICE ADDRESS") : D4=X : ON D4-1GOTO 5583,5585,5587,5589,5591,5593 : SELECT #4310 : GOTO 5630 5583 SELECT #4320 : GOTO 5630 5585 SELECT #4330 : GOTO 5630 5587 SELECT #4350 : GOTO 5630 5589 SELECT #4B10 : GOTO 5630 5591 SELECT #4B20 : GOTO 5630 5593 SELECT #4B30 5630 IF R3$<>" "THEN 5730 : DATA LOAD BA T#4,(0,X)D$() : R6$=STR(D$(1),5,2) : AND (STR(R6$,1,1),7F) : X1$=R6$ : ADDC(X1$,0E) : DATA SAVE BA T$#4,(X1$,X1$)D$() : GOTO 5870 5730 GOSUB '243("IS WORK FILE CATALOGUED? (Y OR N)",1) : IF Q6$="Y"THEN 5780 : DATA SAVE DC OPEN T$#4,15,R3$ 5780 LIMITS T#4,R3$,X,Y,Z : Z=INT(X/256) : BIN(R6$)=Z : BIN(STR(R6$,2))=X-256*Z : IF Y-X>13THEN 5870 : GOSUB '50("WORK FILE TOO SMALL") : GOTO 5510 5870 GOSUB '230(1,1,2,K9,U1$) : IF Q$=" "THEN 5910 : STOP "ERROR OPENING FILES" 5910 LIMITS T#2,U1$,X,Y,Z : Z=INT(X/256) : BIN(R1$)=Z : BIN(STR(R1$,2))=X-256*Z : R=VAL(STR(V1$,2)) : R0=VAL(V8$) : R5=VAL(STR(V1$,5)) : R3=VAL(STR(V1$,3))*256+VAL(STR(V1$,4))+1 : R2$=V1$ : S9=VAL(V6$) : IF S9>40THEN 6170 : IF R2$="A"THEN 6410 : INIT(C0)C$ : N=S9 6070 R7=1 : IF R2$<>"M"THEN 6120 : R7=INT((R3-1)/256)+1 : R3=R3-256*(R7-1) 6120 LOAD DC T#0,"KFAM3103"4000,9990 6170 STOP "MORE THAN 40 SECTORS PER RECORD" 6290 DEFFN'50(Q6$) : PRINT HEX(010A0A0A) : PRINT Q6$ : RETURN 6350 DEFFN'51(Q6$) : PRINT HEX(01) : PRINT Q6$ : STOP 6410 GOSUB '235(1) : X1$=T4$ : ADDC(X1$,R1$) : DATA LOAD BA T#2,(X1$,X1$)D$() : IF STR(D$(1),1,2)=HEX(8101)THEN 6440 6430 GOSUB '51("INVALID RECORD FORMAT") 6440 N=0 : P=3 : C=0 6470 X=INT((P-1)/64) : Y=P-64*X : X=X+1 : Y$=STR(D$(X),Y,1) : IF Y$=HEX(FD)THEN 6680 : IF Y$=HEX(08)THEN 6550 : IF Y$<HEX(81)THEN 6430 : IF Y$>HEX(C0)THEN 6430 6550 IF C=0THEN 6580 : IF Y$=STR(C$,N,1)THEN 6610 6570 GOSUB '51("NOT BLOCKED AS SPECIFIED") 6580 N=N+1 : IF N>38THEN 6430 : STR(C$,N,1)=Y$ 6610 C=C+1 : AND (Y$,7F) : P=P+1+VAL(Y$) : IF C<R0THEN 6470 : C=0 : GOTO 6470 6680 IF C>0THEN 6570 : X=(P-3)/R0 : IF X=RTHEN 6720 : GOSUB '51("RECORD LENGTH NOT SPECIFIED CORRECTLY") 6720 IF N=0THEN 6430 : P=3 : N1=0 6770 N1=N1+1 : IF N1>NTHEN 6870 : Y$=STR(C$,N1,1) : AND (Y$,7F) : Y=VAL(Y$)+1 : IF P+Y>=R3THEN 6860 : P=P+Y : GOTO 6770 6860 IF R3+R5<=P+YTHEN 6880 6870 GOSUB '51("KEY FIELD OUT OF BOUNDS") 6880 IF STR(C$,N1,1)>HEX(80)THEN 6910 : GOSUB '51("NUMERIC KEY INVALID") 6910 R3=R3-P : R7=N1 : GOTO 6120 6980 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" 7040 GOSUB '245(X$,1,0) : X=Q9 : IF X<1THEN 7100 : IF X>7THEN 7100 : GOSUB '248(5,0,5) : RETURN 7100 PRINT HEX(010A0A0A) : PRINT "INVALID DEVICE ADDRESS" : GOTO 7040 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 Q0>1THEN 9025 : IF Q6$="Y"THEN 9025 : IF Q6$<>"N"THEN 9027 9025 IF LEN(Q6$)<=Q0THEN 9231 9027 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