KLPUTZ5 ;Prijsuitzonderingen (afdrukken verschillen) [ 02/21/2002  4:39 PM ]
 ;
 Do PRINT("","")
 Quit
 ;
SELECT() 
 New Select
S1 Set Select=$$SELECT^SELALG("KL",.Check,"Afdrukken verschillen prijsuitzonderingen klanten","",1,1,1)
 If Select'="-" Do BEPERK Goto S1:K="-"
 Quit Select
 ;
 ; Opbouw van de print-lijst
BUILDPL(KlNode) 
 New Lines,BlankL,HoofdGr,Groep,SubGroep,PRNr,SortKey,Next
 Set (Lines,BlankL)=0,(HoofdGr,Groep,SubGroep,PRNr,SortKey)=""
 For  Set SortKey=$O(^HULP(%J,"VGL",SortKey)) Quit:SortKey=""  Do
 .Set Next=""
 .For  Set Next=$O(^HULP(%J,"VGL",SortKey,Next)) Quit:Next=""  Do
 ..Set R=^HULP(%J,"VGL",SortKey,Next)
 ..If HoofdGr=$P(R,D,2) Set $P(R,D,2)=""
 ..Else  Set HoofdGr=$P(R,D,2),BlankL=BlankL+1
 ..If Groep=$P(R,D,3) Set $P(R,D,3)=""
 ..Else  Set Groep=$P(R,D,3)
 ..If SubGroep=$P(R,D,4) Set $P(R,D,4)=""
 ..Else  Set SubGroep=$P(R,D,4)
 ..If PRNr=$P(R,D,5) Set $P(R,D,5)=""
 ..Else  Set PRNr=$P(R,D,5)
 ..Set Lines=Lines+1,^HULP(%J,"PRINT",KlNode,Lines)=R
 ..Quit:'$L($P(R,D,9))
 ..Set $P(^HULP(%J,"PRINT",KlNode,Lines),D,9)=""
 ..Quit
 ..If "\APK\AURC\"[(D_$P(R,D,9)_D) Quit
 ..Set Lines=Lines+1,$P(^HULP(%J,"PRINT",KlNode,Lines),D,9)=$P(R,D,9)
 Quit Lines_D_BlankL
 ;
 ; Ophalen info
INITLINE(R) 
 New PRNr,Korting1,Korting2,HoofdGr,Groep,SubGroep,SchKort1,SchKort2
 Set PRNr=$P(R,D,5),Bold=1 If $E($P(R,D,7))=" " Set Bold=0
 Set (VerkPr,SchaPrys,Munt,SchaMunt,Eenheid,SchaEenh)=""
 Set (%Vork,%Winst,LastDat,LastPr,LastMunt,LastEenh,Omzet,Stuks,KortingE)=""
 Quit:'PRNr
 Set Korting1=$P(R,D,7),Korting2=$P(R,D,8)
 Set SchKort1=$P(R,D,16),SchKort2=$P(R,D,17)
 Do FETCHPR^UTILI(PRNr,"sFL")
 Set %Winst=$P(sFL("J"),D,24),%Vork=$P(sFL("J"),D,27)
 If NoSa="S" Set:$P(sFL(2),D,6) %Winst=$P(sFL(2),D,6) Set:$P(sFL(2),D,5) %Vork=$P(sFL(2),D,5)
 Set R="" If $L(Korting1) Set R=$$PROD^KPRIJS(PRNr,Korting1,Korting2,KlMunt,NetBrut,IsHandel,"N")
 Set VerkPr=$P(R,D),Munt=$P(R,D,2),Eenheid=$P(R,D,3)
 Set R="" If $L(SchKort1) Set R=$$PROD^KPRIJS(PRNr,SchKort1,SchKort2,KlMunt,NetBrut,IsHandel,"S")
 Set SchaPrys=$P(R,D),SchaMunt=$P(R,D,2),SchaEenh=$P(R,D,3)
 Quit
 ;
 ; Afdrukken
PRINT(FromKl,ToKl,Intern) 
 New KLNr,NextKl,DL,KLPUTZL,Print,sFL,VerkPr,Munt,Eenheid,%Vork,%Winst,GloRef,Check
 New LastDat,LastPr,LastMunt,LastEenh,Omzet,Stuks,Bold,KortingE
 New OldNoSa Set OldNoSa=$G(NoSa) New NoSa Set NoSa=OldNoSa
 Set FromKl=$G(FromKl),ToKl=$G(ToKl),Intern=$G(Intern) If Intern Set ToKl=FromKl
 If 'Intern Set %J=$$%J^vhRtn1()
 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)"
 Kill ^HULP(%J,"PRINT"),^HULP(%J,"VGL")
 Set NextKl=FromKl
 Do FMORE
 If Intern Set FP=2101 Write @F,@F1 Do ADD^vhScherm(21,24)
 Do INIT^PROC("KLPUTZLV","KLPUTZL")
 Set KLPUTZL(11)="Vergelijk prijsuitzonderingen"
 Do ^OUTPUT("P","","B")
 If 'Intern Kill ^HULP(%J)
 Else  Kill ^HULP(%J,"PRINT"),^HULP(%J,"VGL") Do ADD^vhScherm(21,24)
 Quit
 ;
FMORE 
 New Count,KLNr,B
 Quit:NextKl]ToKl!(NextKl="")
 For  Do  Quit:NextKl]ToKl!$G(Count)!(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 Count=$O(^HULP(%J,"PRINT",""),-1)+1,^HULP(%J,"PRINT",Count)=KLNr
 .Set NextKl=$$NEXT^SELALG(GloRef)
 Quit
 ;
CBPRINT(Ref) 
 New R,KlNode,LnNode,Lines,BlankL
 If $E(Ref)'="^" Do  Quit R
 .;If Ref="H" Set R="BR" Quit
 .Set R=""
 Set Intern=$G(Intern),KlNode=+$P(Ref,",",3),LnNode=+$P(Ref,",",4)
 If 'LnNode Do  Quit R
 .Set KLNr=$P(@Ref,D) If 'Intern Do INITKL
 .Kill ^HULP(%J,"VGL")
 .Do COPY(NoSa),MERGE(NoSa) If 'Intern Do FMORE
 .Set R=$$BUILDPL(KlNode),Lines=$P(R,D),BlankL=$P(R,D,2)
 .Set R="BR\;KLPUTZLVK\;KLPUTZLVB"
 .If $D(Print("BLZ")),$D(Print("LIJN")),Print("LIJN")+Lines+BlankL+3>(Print("MAXLIJN")-Print("FOOT")) Set R="PB\"_R
 Set R=""
 If $L($P(@Ref,D,2)) Set R="BL\;KLPUTZLV"
 If $L($P(@Ref,D,9)) Set R=";KLPUTZLO"
 Quit R
 ;
 ; Copieren indien intern
COPY(NoSa) 
 New R,SortKey,Next
 Quit:NoSa=""
 Set SortKey=""
 For  Set SortKey=$O(^HULP(%J,"KEY",SortKey)) Quit:SortKey=""  Do
 .Set Next=""
 .For  Set Next=$O(^HULP(%J,"KEY",SortKey,Next)) Quit:Next=""  Do
 ..Set R=^HULP(%J,"KEY",SortKey,Next)
 ..If NoSa="S" Set R=$P(R,D,1,6)_"\\\\\\\\\\"_$P(R,D,7,15)
 ..Set ^HULP(%J,"VGL",SortKey,Next)=R
 Quit
 ;
 ; Samanvoegen van normale en schaduw
MERGE(NoSa) 
 If NoSa="N" Do FETCH("S") Quit
 If NoSa="S" Do FETCH("N") Quit
 Do FETCH("N"),FETCH("S")
 Quit
 ;
 ; Ophalen van de gegevens
FETCH(NoSa) 
 New R,X,HoofdGr,Groep,SubGroep,PRNr,Next,SortKey
 Set HoofdGr=""
 For  Set HoofdGr=$O(^KLPUTZ(NoSa,KLNr,HoofdGr)) Quit:HoofdGr=""  Do
 .Set Groep=""
 .For  Set Groep=$O(^KLPUTZ(NoSa,KLNr,HoofdGr,Groep)) Quit:Groep=""  Do
 ..Set SubGroep=""
 ..For  Set SubGroep=$O(^KLPUTZ(NoSa,KLNr,HoofdGr,Groep,SubGroep)) Quit:SubGroep=""  Do
 ...Quit:$$SKIPKLAS^KLPUTZ2(HoofdGr_D_Groep_D_SubGroep)
 ...Set PRNr=""
 ...For  Set PRNr=$O(^KLPUTZ(NoSa,KLNr,HoofdGr,Groep,SubGroep,PRNr)) Quit:PRNr=""  Do
 ....If PRNr,'$D(^KPR(PRNr)) Kill ^KLPUTZ(NoSa,KLNr,HoofdGr,Groep,SubGroep,PRNr) Quit
 ....Set Next=""
 ....For  Set Next=$O(^KLPUTZ(NoSa,KLNr,HoofdGr,Groep,SubGroep,PRNr,Next)) Quit:Next=""  Do
 .....Set R=^KLPUTZ(NoSa,KLNr,HoofdGr,Groep,SubGroep,PRNr,Next)
 .....If PRNr Set $P(R,D,4)=PRNr,SortKey=$$SORTKEY^PRODUKT(PRNr)
 .....Else  Set SortKey=HoofdGr If Groep'=0 Set SortKey=Groep If SubGroep'=0 Set SortKey=SubGroep
 .....If $D(^HULP(%J,"VGL",SortKey,Next)) Set X=^HULP(%J,"VGL",SortKey,Next)
 .....Else  Set X=SortKey_D_HoofdGr_D_Groep_D_SubGroep_D_PRNr_D_Next
 .....If NoSa="N" Set $P(X,D,7,15)=$P(R,D,1,9)
 .....Else  Set $P(X,D,16,24)=$P(R,D,1,9)
 .....Set ^HULP(%J,"VGL",SortKey,Next)=X
 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
 ;
 ; Init klant
INITKL 
 Set IsChanged=0
 Do FETCHKL^UTILI(KLNr,"sFL")
 Set KlMunt=$P(sFL(0),D,11),PrijsKl=$P(sFL(2),D,3),NetBrut=$P(sFL(2),D,5) 
 Set SchaPrKl=$P(sFL(2),D,25) Set:SchaPrKl="" SchaPrKl=PrijsKl
 Set IsHandel=$$IsHandel^KLANT5(KLNr)
 Quit
 ;