KLPUTZ3 ;Prijsuitzonderingen (afdrukken) [ 02/21/2002  4:37 PM ]
 ;
N Set NoSa="N" Goto DO
S Set NoSa="S" Goto DO
 ;
DO 
 Do PRINT("","",NoSa)
 Quit
 ;
SELECT() 
 New Select
S1 Set Select=$$SELECT^SELALG("KL",.Check,"Afdrukken prijsuitzonderingen klanten",$P(" Normale \ Schaduw ",D,NoSa="S"+1),1,1,1)
S2 If Select="-" Quit Select
 Do BEPERK Goto S1:K="-"
S3 Do MAXKORT Goto S2:K="-"
S4 Do VERKANAL Goto S3:K="-"
 Do TESTDATE Goto S3: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,"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 TestDate,+$P(R,D,15)<TestDate Quit
 ..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)=""
 ..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
 Set PRNr=$P(R,D,5),Bold=1 If $E($P(R,D,7))=" " Set Bold=0
 Set (VerkPr,Munt,Eenheid,%Vork,%Winst,LastDat,LastPr,LastMunt,LastEenh,Omzet,Stuks,KortingE)=""
 Quit:'PRNr
 Set Korting1=$P(R,D,7),Korting2=$P(R,D,8)
 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)
 If '$L(VKa) Set R=$$PROD^KPRIJS(PRNr,Korting1,Korting2,KlMunt,NetBrut,IsHandel,NoSa)
 If $L(VKa) Do
 .Set R=$$KLANTPR^KPRIJS(KLNr,PRNr,NoSa)
 .If $P(R,D,5) Set KortingE=$$EXTNUM^vhLib.DataTypes($P(R,D,5),4,"",1)
 .Quit:'$P(R,D,6)
 .If $L(KortingE) Set KortingE=KortingE_"+"
 .Set KortingE=KortingE_$$EXTNUM^vhLib.DataTypes($P(R,D,6),4,"",1)
 Set VerkPr=$P(R,D),Munt=$P(R,D,2),Eenheid=$P(R,D,3)
 Quit:'$L(VKa)
 Set R=^($O(^KPR(PRNr,"I")))
 Set HoofdGr=$P(R,D),Groep=$P(R,D,2),SubGroep=$P(R,D,3)
 Set R=$G(^KKAAP(KLNr,HoofdGr,Groep,SubGroep,$$COMPR^PRODUKT(PRNr)))
 If R="" Set LastPr="Geen VKA  "
 Else  Do
 .Set Stuks=$P(R,D,3),LastDat=$P(R,D,5),LastPr=$P(R,D,6)
 .Set LastMunt=$P(R,D,7),LastEenh=$P(R,D,8),Omzet=$P(R,D,12)
 If NoSa="S" Set R=$$KLANTPR^KPRIJS(KLNr,PRNr,"N"),LastPr=$P(R,D)
 If +VerkPr=+LastPr Set (LastPr,LastMunt,LastEenh)=""
 Quit
 ;
 ; Afdrukken
PRINT(FromKl,ToKl,NoSa,Intern) 
 New KLNr,NextKl,DL,KLPUTZL,sFL,VerkPr,Munt,Eenheid,%Vork,%Winst,GloRef,Check
 New LastDat,LastPr,LastMunt,LastEenh,Omzet,Stuks,Bold,KortingE,TestDate
 New:'$D(Print) Print
 Set FromKl=$G(FromKl),ToKl=$G(ToKl),Intern=$G(Intern) If Intern Set ToKl=FromKl
 Set TestDate=$G(TestDate)
 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 MaxKort="",TestDate=0,GloRef="^KKL(NextKl)"
 Else  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")
 Set NextKl=FromKl,VKa=$G(VKa)
 Do FMORE
 If Intern Set FP=2101 Write @F,@F1 Do ADD^vhScherm(21,24)
 Do INIT^PROC("KLPUTZL"_$P("MV",D,$L(VKa)),"KLPUTZL")
 Set KLPUTZL(11)=$P("P\Schaduw p",D,NoSa="S"+1)_"rijsuitzonderingen"
 If $L(VKa) Do
 .Set KLPUTZL(11)=KLPUTZL(11)_"\met verkoopanalyse (alle produkten"
 .If MKodex="K" Set KLPUTZL(11)=KLPUTZL(11)_" van de kodex"
 .If MProdukt="S" Set KLPUTZL(11)=KLPUTZL(11)_" op subgroepniveau"
 .If MProdukt="P" Set KLPUTZL(11)=KLPUTZL(11)_" op produktniveau"
 .Set KLPUTZL(11)=KLPUTZL(11)_")"
 .If NoSa="S" Set $E(KLPUTZL(8),68,74)="Schaduw",$E(KLPUTZL(8),85,91)="Huidige"
 Do ^OUTPUT("P","","B")
 If 'Intern Kill ^HULP(%J)
 Else  Kill ^HULP(%J,"PRINT") 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(NoSa,KLNr))!Intern Do
 ..If $L($G(Check)) Quit:'$$CHECK^UTILI("Check")
 ..Quit:$$SKIPCUST()
 ..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^KLPUTZ,FETCH^KLPUTZ2 Do:$L(VKa) MERGE Do FMORE
 .Set R=$$BUILDPL(KlNode),Lines=$P(R,D),BlankL=$P(R,D,2)
 .Set R="BR\;KLPUTZLK"_$P("MV",D,$L(VKa))
 .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\;KLPUTZL"_$P("MV",D,$L(VKa))
 If $L($P(@Ref,D,9)) Set R=";KLPUTZLO"_$P("MV",D,$L(VKa))
 Quit R
 ;
MERGE 
 New R,HoofdGr,Groep,SubGroep,PRNr,SortKey
 Set HoofdGr=0
 For  Set HoofdGr=$O(^KKAAP(KLNr,HoofdGr)) Quit:HoofdGr=""  Do
 .If $L(MKodex),'$D(^KLPUTZ(NoSa,KLNr,HoofdGr)) Quit
 .Set Groep=0
 .For  Set Groep=$O(^KKAAP(KLNr,HoofdGr,Groep)) Quit:Groep=""  Do
 ..If $L(MKodex),'$D(^KLPUTZ(NoSa,KLNr,HoofdGr,Groep)) Quit
 ..Set SubGroep=0
 ..For  Set SubGroep=$O(^KKAAP(KLNr,HoofdGr,Groep,SubGroep)) Quit:SubGroep=""  Do
 ...If $L(MKodex),'$D(^KLPUTZ(NoSa,KLNr,HoofdGr,Groep,SubGroep)) Quit
 ...Quit:$$SKIPKLAS^KLPUTZ2(HoofdGr_D_Groep_D_SubGroep)
 ...Set KortComp=0
 ...For  Set KortComp=$O(^KKAAP(KLNr,HoofdGr,Groep,SubGroep,KortComp)) Quit:KortComp=""  Do
 ....Set R=^KKAAP(KLNr,HoofdGr,Groep,SubGroep,KortComp),PRNr=$P(R,D,15)
 ....If $L(MKodex),MProdukt="S",'$D(^KLPUTZ(NoSa,KLNr,HoofdGr,Groep,SubGroep)) Quit
 ....If $L(MKodex),MProdukt="P",'$D(^KLPUTZ(NoSa,KLNr,HoofdGr,Groep,SubGroep,PRNr)) Quit
 ....Quit:'$D(^KPR(PRNr))
 ....Set SortKey=$$SORTKEY^PRODUKT(PRNr)
 ....Quit:$D(^HULP(%J,"KEY",SortKey))
 ....Set R=SortKey_D_HoofdGr_D_Groep_D_SubGroep_D_PRNr_"\\ \\\"_PRNr
 ....Set ^HULP(%J,"KEY",SortKey,1)=R
 Quit
 ;
SKIPCUST() 
 New HGS,SKIP
 If '$D(^KLPUTZ(NoSa,KLNr)) Quit 1
 Set SKIP=0
 If TestDate Set SKIP=$$SKIPDATE()
 If 'SKIP,MaxKort'="" Set SKIP=$$SKIPKORT()
 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
 ;
SKIPDATE() 
 New HoofdGr,Groep,SubGroep,PRNr,Next,Skip
 Set HoofdGr="",Skip=1
 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
 ...Set PRNr=""
 ...For  Set PRNr=$O(^KLPUTZ(NoSa,KLNr,HoofdGr,Groep,SubGroep,PRNr)) Quit:PRNr=""  Do
 ....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 +$P(R,D,9)'<TestDate Set Skip=0
 Quit Skip
 ;
SKIPKORT() 
 New HoofdGr,Groep,SubGroep,PRNr,Next,Skip
 Set HoofdGr="",Skip=1
 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
 ...Set PRNr=""
 ...For  Set PRNr=$O(^KLPUTZ(NoSa,KLNr,HoofdGr,Groep,SubGroep,PRNr)) Quit:PRNr=""  Do
 ....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 $J($P(R,D),0,1)+$J($P(R,D,2),0,1)>MaxKort Set Skip=0
 Quit Skip
 ;
BEPERK 
 New BST,SEL,LGT,SELECTED
B1 Kill Beperk
 Set FP=1703 Write @F,@F1
 Set K=$$ASKL^vhINP("KLPUTZ","BEPERK")
 Set FP=1703 Write @F,@F1 Quit:K="-"
 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=1729+$L($P($T(T19),U,$F("HGS",Beperk)+1))
 .If $L(SELECTED)+FP>1777 Set SELECTED="(..., "_$P(SELECTED,", ",SELECTED["..."+2,99)
 .Write @F,SELECTED,@F2
 If $D(Beperk)=1 Kill Beperk Set FP=1729 Write @F,@F1,$P($T(T19),U,2) Quit
 Set SELECTED=SELECTED_")",FP=1729+$L($P($T(T19),U,$F("HGS",Beperk)+1))
 If $L(SELECTED)+FP>1777 Set SELECTED="(..., "_$P(SELECTED,", ",SELECTED["..."+2,99)
 Write @F,SELECTED,@F2
 Quit
 ;
VERKANAL 
 Set FP=1903 Write @F,@F1
 Set (K,VKa)=$$ASKL^vhINP("KLPUTZ","VERKANAL")
 Set FP=1903 Write @F,@F1 Quit:K="-"
 Write $P("Zonder\Met",D,$L(K)+1)_" verkoopanalyse"
 Set (MKodex,MProdukt)=""
 If $L(K) Do
 .If K'="." Do
 ..Set MKodex="K" If "PS"[K Set MProdukt=K
 ..Set K=": "_$S(MKodex="":"Alle produkten",1:"Kodex")
 ..Set K=K_$S(MProdukt="":"",1:" op "_$S(MProdukt="P":"produkt",1:"subgroep")_"niveau")
 ..Set FP=1927 Write @F,@F1,K
 .Set (K,VKa)="."
 Quit
 ;
TESTDATE 
 Set TestDate=0
 Quit
 ;
MAXKORT 
 Set FP=1803 Write @F,@F1
 Set (K,MaxKort)=$$ASKL^vhINP("KLPUTZ","MAXKORT")
 Set FP=1803 Write @F,@F1 Quit:K="-"
 Write "Beperking max korting > : ",$S(MaxKort="":"Geen",1:MaxKort_"%")
 Quit
 ;