Listing of file='KFAM217U' on disk='vmedia/701-2427C.wvd.zip'
# Sector 489, program filename = 'KFAM217U'
0010 REM KFAM217U, RELEASE 5-1, (11/07/79) - COPYRIGHT WANG LABS. INC.
0022 IF H=4THEN LOAD T"KFAM234S"10,0BEG 24
0024 % THIS MUST BE LINE 24
0025 COM E4$3,D,D$(4)64,D3,D4,B,P2$2
0130 GOTO 4000
4000 LOAD T"ISS.254S"10,0BEG 4005
4005 IF H<>4THEN SELECT @PART"KFAM"
: IF F9$=" "THEN 4200
4020 PRINT AT(1,0,S0);"MOUNT PLATTERS AT THE INDICATED ADDRESSES"
: GOSUB '254
: DATA LOAD BA T#1,(0)R9$()
: ERRORGOTO 4020
4035 DATA LOAD BA T#2,(0)R9$()
: ERRORGOTO 4020
4200 DIM C$40,Y$1,F2$2,V1$8
: DIM B$1,K$30,K2$30,K3$30
: IF F9=9THEN 4280
: V1$=STR(T$(2),18)
: $UNPACK(F=H1$)T$(2)TO T0,T2$,P2$,V2$,T8,V6$,V3$,Q3$,V8$
: IF K2$<HEX(FF)THEN Z=E2-A2-1
: ELSE Z=C2-2
: Z=(INT(Z/VAL(V6$))-1)*VAL(V6$)
: E4$=BIN(Z,2)&V8$
4280 F2$=BIN(A2,2)
: D=0
: D3=A3
: D4=2
: PRINT HEX(0306)
: PRINT AT(7,0)
: IF F9=2THEN PRINT "BUILD KEY FILE";
: ELSE PRINT "RECOVER KEY FILE";
: PRINT " ( STATION #";S2;")"
: PRINT
: PRINT "USER FILE ";F1$;TAB(30);"DEVICE = ";F0$
: PRINT "KEY FILE ";K1$;TAB(30);"DEVICE = ";K0$
4345 %SECTOR ##### RECORD NUMBER ######
4350 %KEY ################################
4365 L,I=VAL(STR(V1$,2))
: B=VAL(V8$)
: B$=V1$
: K0=VAL(STR(V1$,4))+1
: K3$,K$=" "
: IF E4$>HEX(FF)THEN 4810
: IF B$="A"THEN 5000
4415 IF I1$="W"THEN 4430
: DATA LOAD BA T#2,(E2-1)R9$()
: T$(3)=STR(R9$(),99)
4430 FOR X=1TO 16
: V9$=STR(T$(3),3*X-2,2)ADDCF2$
: Y=VAL(STR(T$(3),3*X))+1
: IF Y>BTHEN 4485
: DATA LOAD BA T#2,(V9$)R9$()
: FOR Y=YTO B
: STR(R9$(),K0+(Y-1)*I,1)=HEX(FF)
: NEXT Y
: DATA SAVE BA T$#2,(V9$)R9$()
4485 NEXT X
: V5=B
4510 P1=P1+I
: V5=V5+1
: IF V5<=BTHEN 4575
4530 P2$,Q2$=P2$ADDCV6$
: V9$=F2$ADDCP2$ADDCSTR(V1$,3,1)
4550 DATA LOAD BA T#2,(V9$)R9$()
: ERRORGOTO 5280
4560 V5=1
: P1=K0
4575 T4$=STR(P2$)&BIN(V5)
: IF D$="DUPLICATE"THEN K$=STR(R9$(),P1,T4-3)&T4$
: ELSE K$=STR(R9$(),P1,T4)
: IF VAL(K$)<255THEN 4695
: K$="DELETED"
: GOSUB 4625
: GOTO 4790
4625 PRINT AT(4,0);
: PRINTUSING 4345,VAL(P2$,2),V5
4635 X=POS(K$<20)
: IF X=0THEN 4655
: STR(K$,X,1)="-"
: GOTO 4635
4655 X=POS(K$>7A)
: IF X=0THEN 4675
: STR(K$,X,1)="-"
: GOTO 4655
4675 PRINTUSING 4350,K$
: RETURN
4695 GOSUB '234(1,0,K$,0)
: IF Q$="X"THEN 4885
: IF Q$="S"THEN 4890
: GOSUB 4625
: IF Q$<>"D"THEN 4755
: T4$=T3$
: GOSUB '44(0)
: GOTO 4790
4755 IF K$=K2$THEN 4810
: V8=.004+.98*V8
: IF K$>K3$THEN 4780
: V8=V8+.012
4780 K3$=K$
4790 IF T4$<E4$THEN 4510
: IF K2$>HEX(FF)OR F9=9THEN 4810
: GOSUB '51("LAST KEY NOT FOUND")
4810 IF F9=2AND I1$="W"THEN O2=2
4815 IF D>0THEN GOSUB '44(2)
: $PACK(F=H1$)T$(2)FROMT0,T2$,P2$,V2$,T8
: STR(T$(3),,3)=STR(P2$)&BIN(V5)
: DATA SAVE DA T$#1,(V0$)0,T$()
4840 IF D>0THEN 4855
: COM CLEAR E4$
: LOAD T"KFAM997U"
: ERRORGOTO 4860
4855 LOAD T"KFAM227U"
: ERRORGOTO 4860
4860 PRINT AT(1,0,S0);"MOUNT ISS DISK"
: GOSUB '254
: GOTO 4840
4885 GOSUB '51("INVALID POINTER")
4890 GOSUB '51("NO SPACE")
4905 DEFFN'50(Q6$)
: PRINT AT(3,0,S0);
: PRINT Q6$
: RETURN
4935 DEFFN'51(Q6$)
: RETURN CLEAR
4945 PRINT HEX(01)
: PRINT Q6$
: E=1
: GOTO 4810
4975 DEFFN'31
: E=2
: GOTO 4815
5000 DATA LOAD BA T#2,(F2$)R9$()
: IF STR(R9$(),1,2)=HEX(8101)THEN 5015
5010 GOSUB '51("INVALID RECORD FORMAT")
5015 N=0
: P=3
: C=0
5035 Y$=STR(R9$(),P)
: IF Y$=HEX(FD)THEN 5125
: IF Y$=HEX(08)THEN 5060
: IF Y$<HEX(81)THEN 5010
: IF Y$>HEX(FC)THEN 5010
5060 IF C=0THEN 5075
: IF Y$=STR(C$,N,1)THEN 5090
5070 GOSUB '51("NOT BLOCKED AS SPECIFIED")
5075 N=N+1
: IF N>38THEN 5010
: STR(C$,N,1)=Y$
5090 C=C+1
: AND (Y$,7F)
: P=P+1+VAL(Y$)
: IF C<BTHEN 5035
: C=0
: GOTO 5035
5125 IF C>0THEN 5070
: X=(P-3)/B
: IF X=LTHEN 5150
: GOSUB '51("RECORD LENGTH NOT SPECIFIED CORRECTLY")
5150 IF N=0THEN 5010
: P=3
: N1=0
5180 N1=N1+1
: IF N1>NTHEN 5235
: Y$=STR(C$,N1,1)
: AND (Y$,7F)
: Y=VAL(Y$)+1
: IF P+Y>=K0THEN 5230
: P=P+Y
: GOTO 5180
5230 IF K0+T4<=P+YTHEN 5240
5235 GOSUB '51("KEY FIELD OUT OF BOUNDS")
5240 IF STR(C$,N1,1)>HEX(80)THEN 5255
: GOSUB '51("NUMERIC KEY INVALID")
5255 K0=(P-3)*B+3+K0-P
: I=Y
: GOTO 4415
5280 GOSUB '44(1)
: IF P2$<STR(E4$,1,2)THEN 4530
: GOTO 4810
5320 DEFFN'44(Z)
: Q6$=BIN(Z)&STR(P2$)&BIN(V5)&K$
: X=4
: ON ZGOTO 5345,5365
: X=LEN(Q6$)
5345 D=D+1
: IF D4+X<255THEN 5390
: IF D3>E3-2THEN 5410
5365 BIN(D$())=D4
: DATA SAVE BA T$#0,(D3,D3)D$()
: D4=2
: IF Z=2THEN RETURN
5390 STR(D$(),D4)=BIN(X+1)&STR(Q6$,,X)
: D4=D4+X+1
: RETURN
5410 RETURN CLEAR
5415 GOSUB '51("WORK FILE FULL")
: STOP