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