KLPUTZ4 ;Prijsuitzonderingen (copieren) [ 02/21/2002  4:38 PM ]
 ;
N Set NoSa="N" Goto DO
S Set NoSa="S" Goto DO
 ;
DO 
 Do COPY("","",NoSa)
 Quit
 ;
SELECT() 
 New Select
S1 Set Select=$$SELECT^SELALG("KL",.Check,"Copieren prijsuitzonderingen klanten",$P(" Normale \ Schaduw ",D,NoSa="S"+1),1,1,1)
 If Select'="-" Do BEPERK Goto S1:K="-"
 Quit Select
 ;
 ; Copieren
COPY(FromKl,ToKl,NoSa,Intern) 
 New KLNr,NextKl,sFL,GloRef,Check,Klanten
 Set FromKl=$G(FromKl),ToKl=$G(ToKl),Intern=$G(Intern) If Intern Set ToKl=FromKl
 If 'Intern Set %J=$$%J^vhRtn1()
 If $G(NoSa)="" Set NoSa="N"
 If NoSa'="N",NoSa'="S" Quit
 If $L(FromKl),$D(^KK1(FromKl)) Set FromKl=^KK1(FromKl)
 Else  If $L(FromKl),$D(^KKL(FromKl))
 Else  Set FromKl=""
 If $L(ToKl),$D(^KK1(ToKl)) Set ToKl=^KK1(ToKl)
 Else  If $L(ToKl),$D(^KKL(ToKl))
 Else  Set ToKl=""
 If '$L(FromKl)!'$L(ToKl) Set R=$$SELECT() Quit:R="-"  Do
 .Set FromKl=$P(R,D),ToKl=$P(R,D,2),GloRef=$P(R,D,3)
 .If GloRef["KL)" Set GloRef=$P(GloRef,"KL)")_"NextKl)"
 Set:$G(GloRef)="" GloRef="^KKL(NextKl)"
 If 'Intern Kill ^HULP(%J)
 Set NextKl=FromKl,Klanten=0
 Do FMORE Quit:'KLNr
 If Intern Set FP=2101 Write @F,@F1 Do ADD^vhScherm(21,24)
 If '$$ASKCOPY()
 Else  Set FP=2101 Write @F,@F1 For  Do FETCH,SAVE,FMORE Quit:'KLNr
 If 'Intern Kill ^HULP(%J)
 Else  Do ADD^vhScherm(21,24)
 Quit
 ;
FMORE 
 New Bool,B
 If NextKl]ToKl!(NextKl="") Set KLNr="" Quit
 For  Do  Quit:NextKl]ToKl!$G(Bool)!(NextKl="")
 .Set KLNr=$$FETCHNR^SELALG(GloRef)
 .Do FETCHKL^UTILI(KLNr)
 .If $D(^KLPUTZ("N",KLNr))!$D(^KLPUTZ("S",KLNr))!Intern Do
 ..If $L($G(Check)) Quit:'$$CHECK^UTILI("Check")
 ..If $$SKIPCUST("N"),$$SKIPCUST("S") Quit
 ..Set Bool=1
 .Set NextKl=$$NEXT^SELALG(GloRef),Klanten=Klanten+1
 .If '(Klanten#$S(Klanten<100:10,1:100)) Set FP=2301 Write @F,"Klanten verwerkt : ",Klanten,@F2
 Set:'$G(Bool) KLNr=""
 Quit
 ;
ASKCOPY() 
 New Temp
 If Intern Quit:'$D(^HULP(%J,"KEY")) 0
 Set IsChanged=$G(IsChanged),Temp=IsChanged
 If '$$LOCK^KLPUTZ2(KLNr,$P("N\S",D,NoSa="N"+1)) Quit 0
 Set K=$$KEYL^vhINP("KLPUTZ","COPY") Quit:K'="C" 0
 If Intern,$$ASKSAVE^KLPUTZ(1)="-" Set IsChanged=Temp Quit 0
 Set K=$$KEYL^vhINP("KLPUTZ","COPYD")
 If K'="J" Set IsChanged=Temp Quit 0
 Quit 1
 ;
FETCH 
 If 'Intern Do FETCH^KLPUTZ2
 Quit
 ;
SAVE 
 New Temp
 Set Temp=IsChanged,IsChanged=1 Do SAVE^KLPUTZ2($P("N\S",D,NoSa="N"+1))
 If Intern Set IsChanged=Temp Do SAVE^KLPUTZ2(NoSa) Set Input="S"
 Quit
 ;
BEPERK 
 New BST,SEL,LGT,SELECTED
B1 Kill Beperk
 Set FP=1803 Write @F,@F1
 Set K=$$ASKL^vhINP("KLPUTZ","BEPERK")
 If K="-" Set FP=1803 Write @F,@F1 Quit
 Set FP=1803 Write @F,@F1
 Write "Beperking klassifikatie : ",$P("Geen\Hoofdgroep\groep\Subgroep",D,$F("HGS",K))
 If K="" Quit
 Set Beperk=K,SELECTED="("
 Set R=$P("HG\GR\SG\MK",D,$F("HGS",K)-1),BST="P"_R,R=^KPR(0,R),SEL=$P(R,D,2),LGT=$P(R,D,1)
B2 Set K=$E(BST,2,3),K=$S(K="HG":1,K="GR":2,1:3)
 Set K=$$SELECT^KLASS(K) Goto B1:K="-"
 If K'="." Do  Goto B2
 .Set KKey=$P(K,D)
 .Set R=$$UPTRIMAN^vhRtn1($$GETSORT^KLASS(KKey))_" "
 .Set R=$P(@("^"_Q_BST_"(R)"),D,2)
 .Quit:$D(Beperk(R))
 .Set K=$$GETSORT^KLASS(KKey,1)_D_$$GETSORT^KLASS(KKey,2)_D_$$GETSORT^KLASS(KKey,3)
 .Set Beperk(R)=K
 .If SELECTED'="(" Set SELECTED=SELECTED_", "
 .Set SELECTED=SELECTED_$$DISPLS^KLASS(R)
 .Set FP=1829+$L($P($T(T19),U,$F("HGS",Beperk)+1))
 .If $L(SELECTED)+FP>1877 Set SELECTED="(..., "_$P(SELECTED,", ",SELECTED["..."+2,99)
 .Write @F,SELECTED,@F2
 If $D(Beperk)=1 Kill Beperk Set FP=1829 Write @F,@F1,$P($T(T19),U,2) Quit
 Set SELECTED=SELECTED_")",FP=1829+$L($P($T(T19),U,$F("HGS",Beperk)+1))
 If $L(SELECTED)+FP>1877 Set SELECTED="(..., "_$P(SELECTED,", ",SELECTED["..."+2,99)
 Write @F,SELECTED,@F2
 Quit
 ;
SKIPCUST(NoSa) 
 New HGS,SKIP
 If '$D(^KLPUTZ(NoSa,KLNr)) Quit 1
 Set SKIP=0
 If '$D(Beperk) Quit SKIP
 Set HGS="",SKIP=1
 For  Set HGS=$O(Beperk(HGS)) Quit:HGS=""  Do  Quit:'SKIP
 .Set R=Beperk(HGS)
 .If Beperk="H" Set:$D(^KLPUTZ(NoSa,KLNr,$P(R,D))) SKIP=0
 .If Beperk="G" Set:$D(^KLPUTZ(NoSa,KLNr,$P(R,D),$P(R,D,2))) SKIP=0
 .If Beperk="S" Set:$D(^KLPUTZ(NoSa,KLNr,$P(R,D),$P(R,D,2),$P(R,D,3))) SKIP=0
 Quit SKIP
 ;