Listing of file='KFAM3707' on disk='vmedia/701-2427C.wvd.zip'
# Sector 617, program filename = 'KFAM3707'
0010 REM KFAM3707, RELEASE 5-1, (11/07/79) - COPYRIGHT WANG LABS. INC.
0022 SELECT @PART"KFAM"
: ERRORLOAD T"KFAM232S"10,0BEG 24
0024 %THIS MUST BE LINE 24
0130 GOTO 4330
4330 DIM X$64,E0$(4)64,B4$2,B$2,B9$2,T(8)
4380 LOAD DA T#3,(B6$)4400,4453
4400 DIM A0$(4)64,I0$(4)64
4454 SELECT @PART"KFAM"
: ERRORGOTO 4460
4460 GOSUB 6850
: PRINT "REORGANIZE -- PART 1 ( STATION ";S2;")"
4530 B$=B3$
: B1=1
: C1=0
: INIT(FF)B4$
: GOSUB '235(1,0)
: IF Q$=" "THEN 4690
: IF Q$="N"THEN 5190
: GOSUB '70("FINDFIRST ERROR")
4640 GOSUB '237(1,0)
: IF Q$=" "THEN 4690
: IF Q$="E"THEN 5160
: GOSUB '70("FINDNEXT ERROR")
4690 B9$=T4$
: C1=C1+1
: IF B2$<"M"THEN 4820
: ADDC(B9$,B1$)
: FOR X=1TO C9
: IF B$>=M3$THEN 6650
: DATA LOAD BA T#1,(B9$,B9$)A0$()
: DATA SAVE BA T$#3,(B$,B$)A0$()
: NEXT X
: GOTO 4640
4820 IF B9$=B4$THEN 4870
: ADDC(B9$,B1$)
4860 DATA LOAD BA T#1,(B9$,B9$)A0$()
4870 IF B2$="A"THEN 4980
: X=M6+(Q-1)*B
: Y=M6+(B1-1)*B
: MAT COPY A0$()<X,B>TO I0$()<Y,B>
: GOTO 5000
4980 X=0
5000 B4$=T4$
: B1=B1+1
: IF B1<=B0THEN 4640
: GOSUB 5070
: GOTO 4640
5070 IF B$>=M3$THEN 6650
5100 DATA SAVE BA T$#3,(B$,B$)I0$()
5120 B1=1
: RETURN
5160 IF B1=1THEN 5190
: GOSUB 5070
5190 GOSUB 6850
: PRINT "REORGANIZE -- PART 2 ( STATION ";S2;")"
: IF O6$=" "THEN Q3$=F3$
: N=VAL(V6$)
: Q2$=BIN(N-1,2)XOR ALL(FF)
: V5=0
: V2$,T2$=HEX(0001)
: V3$=F4$
: V0$=B0$
: T1=4
: T2=3
: T0=1
: T$(3)=STR(Q3$)&V8$&STR(T$(3))
: T$(1)=ALL(5A)
: STR(T$(1),17)=ALL(FF)
: T8=0
: INIT(FF)T0$()
: INIT(00)STR(T0$(1),1,B5),T7$
5340 T9$,T2$(1)=T2$
: GOSUB 5410
: T(1)=1
: IF Q$="N"THEN 6360
: GOTO 5490
5384 V9$=ADDCV0$
: DATA LOAD DA T#T1,(V9$)T9$,T0$()
: RETURN
5410 V9$=T9$ADDCV0$
: DATA SAVE DA T$#T1,(V9$)T9$,T0$()
: RETURN
5470 V5=V5+1
: IF V5<=B0THEN 5564
5490 ADDC(Q2$,V6$)
: B9$=B3$ADDCQ2$ADDCB7$
: DATA LOAD BA T#3,(B9$)E0$()
: V5=1
5564 T3$=STR(Q2$)&BIN(V5)
: T4$=T3$
: X=B3+(V5-1)*I
: IF O8$="D"THEN T1$=STR(E0$(),X,B5-3)&T3$
: ELSE T1$=STR(E0$(),X,B5)
: IF O8$<>"D"AND T1$<=T7$THEN GOSUB '70("SEQUENCE ERROR")
: IF O8$="D"AND STR(T1$,,T4-3)<STR(T7$,,T4-3)THEN GOSUB '70("SEQUENCE ERROR
")
: T7$=T1$
: IF VAL(T7$)=255THEN 6620
: T3=1
: IF T9$=T2$(1)THEN 5760
: V9$=T2$(1)
: GOSUB 5384
5760 T=T(T3)+T5
: IF T<193THEN 6090
: INIT(FF)T0$()
: STR(T0$(),,T4)=T1$
: STR(T0$(),T4+1,3)=T3$
: ADDC(V2$,01)
: IF V2$>V3$THEN 6630
: T9$,T2$(T3),T3$=V2$
: T(T3)=1
: GOSUB 5410
: T3=T3+1
: IF T3>T0THEN 5960
: V9$=T2$(T3)
: GOSUB 5384
: GOTO 5760
5960 T0=T0+1
: IF T0>8THEN 6640
: INIT(FF)T0$()
: INIT(00)STR(T0$(1),1,T5)
: STR(T0$(1),T4+1,2)=STR(T2$,1,2)
: ADDC(V2$,01)
: IF V2$>V3$THEN 6630
: T9$,T2$,T2$(T3)=V2$
: T(T3)=1
: GOTO 5760
6090 $PACK(F=V4$)T0$()<T>FROMT1$,T3$
: T(T3)=T
: GOSUB 5410
6220 T8=T8+1
: IF T8<C1THEN 5470
: Y=VAL(STR(T4$,3))+1
: IF Y>B0THEN 6360
: V9$=STR(T4$,,2)ADDCB3$
: DATA LOAD BA T#3,(V9$)E0$()
: FOR Y=YTO B0
: STR(E0$(),B3+(Y-1)*I,1)=HEX(FF)
: NEXT Y
: DATA SAVE BA T$#3,(V9$)E0$()
6360 O2=3
6370 LOAD DC T"KFAM3907"
6620 GOSUB '71("INVALID KEY, HEX VALUE =")
6630 GOSUB '70("OUTPUT KEY FILE SPACE EXCEEDED")
6640 GOSUB '70("8 LEVELS OF INDEX EXCEEDED")
6650 GOSUB '70("OUTPUT USER FILE SPACE EXCEEDED")
6710 DEFFN'70(X$)
: GOSUB 6850
: PRINT X$
: E=1
: RETURN CLEAR
6738 DEFFN'31
: GOTO 6370
6760 DEFFN'71(X$)
: RETURN CLEAR
6770 GOSUB 6850
: PRINT X$
: HEXPRINT STR(T1$,1,T4)
: PRINT "KEY RETURN(EXEC) TO SKIP RECORD"
: INPUT X$
: GOSUB 6850
: GOTO 6220
6850 PRINT AT(0,0,320);
: RETURN