image of READY prompt

Wang2200.org

Listing of file='KFAM3504' on disk='vmedia/701-2086B.wvd.zip'

# Sector 330, program filename = 'KFAM3504'
0001 REM KFAM3504,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,"KFAM0104"3072,3072
3094 GOTO 4000
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$,"X")
   : IF Q$=" "THEN 6210
   : IF Q$<>"C"THEN 6190
   : GOSUB '101("ACCESS NOT EXCLUSIVE")
6190 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,"KFAM3604"4000,9990
6390 GOSUB '235(1,0)
   : 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