Listing of file='KFAM3503' on disk='vmedia/701-2049C.wvd.zip'
# Sector 535, program filename = 'KFAM3503'
0001 REM KFAM3503,VER.04/14/76
0002 GOTO 3072
0005 COM N1$8,P1$3,N2,N2$8,P2$3,N3$8,P3$3,O3$1,S3
: COM O6$1,N4,N4$8,P4$3,O4$1,S4,N5$8,P5$3
: COM M6,M1$2,U1,U2,U3,M3$2,U4,O5$1,R0$2,U3$2,U4$2
0008 COM R,R0,R3,R5,R7$1,R1$2,R2$1,R3$2,R6$2,S9,C$40,N,I
3072 LOAD DC T#0,"KFAM0103"3072,3072
4000 DIM Z$8,Z1$8,I$(32)8,H$2,Y$1,X1$2,X$64,D$(4)64
: N1$,P1$,P2$,N3$,P3$,O6$,P4$,N4$,N5$,P5$=" "
: N2,N4=1
: O3$,O4$="C"
: S3,S4=0
: M6=3
4850 GOSUB 7770
: PRINT "REORGANIZE -- SET UP"
: GOSUB '102(N1$)
: GOSUB '40(N1$,1)
: IF X>0THEN 4920
: GOSUB '99(N1$,P1$)
4920 LIMITS T#1,N1$,A,C,X
: GOSUB '43(A)
: R1$=X1$
: U1=C+1-A
: GOSUB '43(C-1)
: M1$=X1$
: GOSUB '103(N1$,N2)
: N2$=Z$
: GOSUB '40(N2$,2)
: IF X>0THEN 5070
: GOSUB '99(N2$,P2$)
5070 LIMITS T#2,N2$,A,C,X
: U2=C+1-A
: IF P3$<>P1$THEN 5170
: IF N3$<>N1$THEN 5170
: GOSUB '101("INPUT AND OUTPUT USER FILE MAY NOT BE THE SAME FILE")
5170 IF O6$="C"THEN 5200
: GOSUB '102(N3$)
5200 GOSUB '40(N3$,3)
: IF X>0THEN 5450
: IF O3$="N"THEN 5270
: IF O3$="C"THEN 5270
: GOSUB '99(N3$,P3$)
5270 U3=S3
: IF U3>0THEN 5300
: U3=U1
5300 IF U3>9THEN 5320
: U3=10
5320 IF U3<=ATHEN 5390
: GOSUB 7770
: PRINTUSING 5360,N3$,P3$
5360 %INSUFFICIENT SPACE FOR FILE ######## ON DEVICE ########
5370 STOP
5390 DATA SAVE DC OPEN T$#3,U3,N3$
: DSKIP #3,U3-2S
: DATA SAVE DC $#3,END
: DATA SAVE DC CLOSE#3
: GOTO 5530
5450 IF O3$="Y"THEN 5530
: IF O3$="C"THEN 5530
: GOSUB 7770
: PRINTUSING 5500,N3$,P3$
5500 %FILE ######## ALREADY CATALOGUED ON DEVICE ########
5510 STOP
5530 LIMITS T#3,N3$,A,C,X
: GOSUB '43(A)
: R6$,R3$=X1$
: U3=C+1-A
: GOSUB '43(C-1)
: M3$=X1$
: GOSUB '43(U3-3)
: U3$=X1$
: IF N4$<>" "THEN 5700
: Z$=N1$
: IF O6$="C"THEN 5670
: Z$=N3$
5670 GOSUB '103(Z$,N4)
: N4$=Z$
5700 GOSUB '40(N4$,4)
: IF X>0THEN 5960
: IF O4$="N"THEN 5770
: IF O4$="C"THEN 5770
: GOSUB '99(N4$,P4$)
5770 U4=S4
: IF S4>0THEN 5840
: U4=U2
: IF O6$="C"THEN 5840
: U4=INT((U3/U1)*(U2-5))+5
5840 IF U4<=ATHEN 5900
: GOSUB 7770
: PRINTUSING 5360,N4$,P4$
: STOP
5900 DATA SAVE DC OPEN T$#4,U4,N4$
: DSKIP #4,U4-2S
: DATA SAVE DC $#4,END
: DATA SAVE DC CLOSE#4
: GOTO 6030
5960 IF O4$="Y"THEN 6030
: IF O4$="C"THEN 6030
: GOSUB 7770
: PRINTUSING 5500,N4$,P4$
: STOP
6030 LIMITS T#4,N4$,A,C,X
: GOSUB '43(A)
: R0$=X1$
: U4=C+1-A
: GOSUB '43(U4-3)
: U4$=X1$
: O5$=" "
: IF N5$=" "THEN 6170
: GOSUB '40(N5$,5)
: IF X=0THEN 6170
: O5$="X"
6170 GOSUB '230(1,2,1,N2,N1$)
: IF Q$=" "THEN 6210
: GOSUB '101("ERROR OPENING FILES")
6210 R=VAL(STR(V1$,2))
: R0=VAL(V8$)
: R5=VAL(STR(V1$,5))
: R3=VAL(STR(V1$,4))+1
: R7$=STR(V1$,3)
: R2$=V1$
: S9=VAL(V6$)
: IF R2$="A"THEN 6390
: I=R
6350 LOAD DC T#0,"KFAM3603"4000,9990
6390 GOSUB '235(1)
: IF Q$="N"THEN 6990
: X1$=T4$
: ADDC(X1$,R1$)
: DATA LOAD BA T#1,(X1$,X1$)D$()
: IF STR(D$(1),1,2)=HEX(8101)THEN 6460
6450 GOSUB '101("INVALID RECORD FORMAT")
6460 N=0
: P=3
: C=0
6500 X=INT((P-1)/64)
: Y=P-64*X
: X=X+1
: Y$=STR(D$(X),Y,1)
: IF Y$=HEX(FD)THEN 6710
: IF Y$=HEX(08)THEN 6580
: IF Y$<HEX(81)THEN 6450
: IF Y$>HEX(C0)THEN 6450
6580 IF C=0THEN 6610
: IF Y$=STR(C$,N,1)THEN 6640
6600 GOSUB '101("NOT BLOCKED AS SPECIFIED")
6610 N=N+1
: IF N>38THEN 6450
: STR(C$,N,1)=Y$
6640 C=C+1
: AND (Y$,7F)
: P=P+1+VAL(Y$)
: IF C<R0THEN 6500
: C=0
: GOTO 6500
6710 IF C>0THEN 6600
: X=(P-3)/R0
: IF X=RTHEN 6760
: GOSUB '101("RECORD LENGTH NOT SPECIFIED CORRECTLY")
6760 IF N=0THEN 6450
: P=3
: N1=0
6820 N1=N1+1
: IF N1>NTHEN 6930
: Y$=STR(C$,N1,1)
: AND (Y$,7F)
: Y=VAL(Y$)+1
: IF P+Y>=R3THEN 6920
: P=P+Y
: GOTO 6820
6920 IF R3+R5<=P+YTHEN 6940
6930 GOSUB '101("KEY FIELD OUT OF BOUNDS")
6940 IF STR(C$,N1,1)>HEX(80)THEN 6970
: GOSUB '101("NUMERIC KEY INVALID")
6970 I=Y
: GOTO 6350
6990 GOSUB '101("NULL FILE")
7040 DEFFN'40(Z1$,Z)
: DATA LOAD BA T#Z,(0,X)I$()
: X1$=STR(I$(1),1,2)
: GOSUB '41
: C=X
: X1$=STR(I$(1),3,2)
: GOSUB '41
: Y=X
: X1$=STR(I$(1),5,2)
: GOSUB '41
: A=X-Y
: Z$=Z1$
: XOR (STR(Z$,2),Z$)
: Y$=STR(Z$,8,1)
: H$=HEX(0000)
: ADDC(H$,Y$)
: ADDC(H$,Y$)
7230 ADDC(H$,Y$)
: ADD(STR(H$,1,1),STR(H$,2,1))
: H=VAL(H$)
: H=H-INT(H/C)*C
: DATA LOAD BA T#Z,(H,X)I$()
: GOSUB '42
: IF X>0THEN 7390
: IF Y=0THEN 7390
: H=0
7330 DATA LOAD BA T#Z,(H,X)I$()
: GOSUB '42
: IF X>0THEN 7390
: H=H+1
: IF H<CTHEN 7330
7390 RETURN
7420 DEFFN'41
: AND (STR(X1$,1,1),7F)
: X=VAL(X1$)*256+VAL(STR(X1$,2))
: RETURN
7480 DEFFN'42
: Y=0
: X=2
: IF H>0THEN 7530
: X=4
7530 IF STR(I$(X-1),1,1)=HEX(10)THEN 7570
: IF STR(I$(X-1),1,1)=HEX(11)THEN 7570
: IF STR(I$(X-1),1,1)=HEX(00)THEN 7620
: GOTO 7580
7570 IF I$(X)=Z1$THEN 7640
7580 X=X+2
: IF X<34THEN 7530
: Y=1
7620 X=0
7640 RETURN
7690 DEFFN'43(X)
: Y=INT(X/256)
: X=X-256*Y
: BIN(X1$)=Y
: BIN(STR(X1$,2))=X
: RETURN
7770 PRINT HEX(01)
: FOR X=1TO 4
: PRINT TAB(64)
: NEXT X
: PRINT HEX(01)
: RETURN
7850 DEFFN'99(Z$,Z1$)
: RETURN CLEAR
7870 GOSUB 7770
: PRINTUSING 7890,Z$,Z1$
7890 %FILE ######## NOT FOUND ON DEVICE ########
7900 STOP
: GOTO 7870
7940 DEFFN'101(X$)
7950 GOSUB 7770
: PRINT X$
: STOP
: GOTO 7950
8010 DEFFN'102(Z$)
: IF STR(Z$,5,1)<>"F"THEN 8060
: IF STR(Z$,6,1)<"0"THEN 8060
: IF STR(Z$,6,1)>"9"THEN 8060
: RETURN
8060 GOSUB 7770
: PRINT Z$;" NOT KFAM FILE NAME"
: STOP
: GOTO 8060
8140 DEFFN'103(Z$,Z)
: IF Z<1THEN 8210
: IF Z>9THEN 8210
: IF Z<>INT(Z)THEN 8210
: STR(Z$,5,1)="K"
: CONVERT ZTO STR(Z$,6,1),(#)
: RETURN
8210 GOSUB 7770
: PRINT "INVALID KEY FILE NUMBER ";Z
: STOP
: GOTO 8210