cwstatfu ; ;[ 04/24/95  9:16 AM ]
 ;
 Set Q="K"
 Do ^cA604
 Write @F11,@F1
 Set ToKLNr=9998
 If $D(^KK1(ToKLNr)) Do  Quit:R'="J"
 .Set FP=2201
 .Write @F,"Klant "_ToKLNr_" bestaat reeds,",!,"wenst u deze te verwijderen ""J[] = verwijderen"" ? "
 .Read R Quit:R'="J"
 .Set KlantInd=^KK1(ToKLNr)
 .Kill ^KK1(ToKLNr),^KKL(KlantInd),^KSTKL(ToKLNr),^KLPUTZ("N",ToKLNr) ;,^KLPUTZ("S",ToKLNr)
 For  Set KLNr=$$SELECT^KLANT6() Quit:'KLNr  Do
 .For I=0:1 Quit:'$D(^KKL(^KK1(KLNr),I))  Do
 ..Set R(I)=^KKL(^KK1(KLNr),I)
 ..If '$D(Klant(I)) Set Klant(I)=R(I)
 ..Else  If I=0 Set $P(Klant(I),D,2)=$P(Klant(I),D,2)_"-"_$P(R(I),D,2)
 .If '$D(MoKLNr) Set MoKLNr=KLNr,(FP,WP)=502 Write @F,"Moederklant : "
 .Else  Set KLNr(KLNr)="",(FP,WP)=WP+100 Write @F,"      Klant : "
 .W KLNr," ",$P(^KKL(^KK1(KLNr),0),D,2)
 Quit:$O(KLNr(""))=""
 Set FP=2201
 Write @F,@F1,"Wenst u de fusie door te voeren ""J[] = doorvoeren"" ? "
 Read R Quit:R'="J"
 Set $P(Klant(0),D)=ToKLNr,KlantInd=$$UPTRIMAN^vhRtn1($P(Klant(0),D,2))_" "_ToKLNr
 Set ^KK1(ToKLNr)=KlantInd For I=0:1 Quit:'$D(Klant(I))  Set ^KKL(KlantInd,I)=Klant(I)
 Merge ^KSTKL(ToKLNr)=^KSTKL(MoKLNr),^KLPUTZ("N",ToKLNr)=^KLPUTZ("N",MoKLNr),^KLPUTZ("S",ToKLNr)=^KLPUTZ("S",MoKLNr)
 Set KLNr=""
 For  Set KLNr=$O(KLNr(KLNr)) Quit:KLNr=""  Do
 .Set PRNr=""
 .For  Set PRNr=$O(^KSTKL(KLNr,PRNr)) Quit:PRNr=""  Do
 ..Set Periode=""
 ..For  Set Periode=$O(^KSTKL(KLNr,PRNr,Periode)) Quit:Periode=""  Do
 ...Set R=^KSTKL(KLNr,PRNr,Periode),X=$G(^KSTKL(ToKLNr,PRNr,Periode))
 ...If Periode=0 Set:X="" ^KSTKL(ToKLNr,PRNr,Periode)=R Quit
 ...For I=1:1:$L(R,D) Set $P(X,D,I)=$P(X,D,I)+$P(R,D,I)
 ...Set ^KSTKL(ToKLNr,PRNr,Periode)=X
 Quit
 ;