KPRIJSS ;Produkt prijs ;[ 12/20/2003  2:09 PM ]
 Quit
 ;
KLANTPR(KLNr,PRNr,NoSa,SimPPL) 
 ; De SimPPL wordt genomen ter vervanging van de PPL in PRNr, 
 ;zo kan dan het product een generisch product zijn waarvoor het afgeleid product nog niet bestaat
 ;De SimPPL moet voldoen aan de muntpariteit en de grootteorde
 ; Output: Piece  1 = prijs
 ;         Piece  2 = munt
 ;         Piece  3 = eenheid
 ;         Piece  4 = lijstprijs
 ;         Piece  5 = korting1
 ;         Piece  6 = korting2
 ;         Piece  7 = codex
 ;         Piece  8 = katprijs
 ;         Piece  9 = pariteit
 ;         Piece 10 = afrondingsregel
 ;         Piece 11 = eenheid(numeriek)
 ;         Piece 12 = round
 ;         Piece 13 = aankpr(EUR)
 ;         Piece 14 = prijs(EUR)
 ;         Piece 15 = lijstprijs(EUR)
 If $G(KLNr)="?" Do HELPFUNC^vhRtn1($ZN,"KLANTPR") Quit ""
 New R,KatProd,IsKatPr,FaMunt,Munt,MuntPar
 New VkpPr,Korting1,Korting2,KortNiv,AkpEUR,VkpEUR,LijstEUR
 ; Opgezet via GETCUST
 New KlMunt,KlTyp,NetBrutP,PrijsKl,IsKsCust,IsLidVan,%LidVan
 ; Opgezet via GETPROD
 New LEVNr,KatPrHan,KatPrInd,KatPrKs,GrOrde,GrOrdNum,PrMunt,CifPPL,LijstPr,Vork
 Set:$G(NoSa)'="S" NoSa=""
 Set FaMunt=$$FADEF^vhRtn1()
 Do GETCUST(KLNr,NoSa),GETPROD(PRNr,NoSa,$G(SimPPL))
 Set IsKatPr=$S(IsKsCust:KatPrKs,KlTyp:KatPrHan,1:KatPrInd)
 Set Munt=KlMunt
 If KlMunt="MTL" Do
 .Set Munt=PrMunt
 .Set:Munt="" Munt=$P(^KLE(^KL1(LevNr),0),D,11)
 Set:Munt="" Munt=FaMunt ; Defaulting naar EUR
 Set MuntPar=$$MUNTPAR^vhRtn1(Munt,2,NoSa)
 Do KKORTING,CALC
 If IsLidVan,%LidVan Set VkpEUR=+$J(VkpEUR*(100-%LidVan/100),0,4)
 Quit $$BUILD
 ;
 ; KlTyp 0=Industrie, 1=handel, P=prijslijst
PROD(PRNr,Korting1,Korting2,KlMunt,NetBrutP,KlTyp,NoSa,SimPPL) 
 New R,KatProd,IsKatPr,FaMunt,Munt,MuntPar,IsKsCust
 New VkpPr,KortNiv,AkpEUR,VkpEUR,LijstEUR
 New PrijsKl
 Set FaMunt=$$FADEF^vhRtn1()
 ;Defaulting
 Set Korting2=$G(Korting2)
 Set KlMunt=$G(KlMunt,FaMunt)
 Set NetBrutP=$G(NetBrutP)
 Set KlTyp=$G(KlTyp),IsKsCust=KlTyp="P"
 Set:$G(NoSa)'="S" NoSa=""
 ; Opgezet via GETPROD
 New LEVNr,KatPrHan,KatPrInd,KatPrKs,GrOrde,GrOrdNum,PrMunt,CifPPL,LijstPr,Vork
 Do GETPROD(PRNr,NoSa)
 Set IsKatPr=$S(Korting1:"",IsKsCust:KatPrKs,KlTyp:KatPrHan,1:KatPrInd) Set:$L(IsKatPr) Korting2=0 ; Code mag niet veranderd worden anders werkt KATprijs niet meer : PV - 03/11/03
 .;Set IsKatPr=$S(IsKsCust:KatPrKs,KlTyp:KatPrHan,KlTyp?1A:KatPrInd,1:"") Set:$L(IsKatPr) Korting2=0
 Set Munt=KlMunt
 If KlMunt="MTL" Do
 .Set Munt=PrMunt
 .Set:Munt="" Munt=$P(^KLE(^KL1(LevNr),0),D,11)
 Set:Munt="" Munt=FaMunt ; Defaulting naar EUR
 Set MuntPar=$$MUNTPAR^vhRtn1(Munt,2,NoSa)
 Do PKORTING,CALC
 Quit $$BUILD
 ;
BUILD() Quit VkpPr_D_Munt_D_GrOrde_D_LijstPr_D_Korting1_D_Korting2_D_PrijsKl_D_KortNiv_D_+$J(1/MuntPar,0,8)_D_GrOrde_1_D_GrOrdNum_D_1_D_AkpEUR_D_VkpEUR_D_LijstEUR
 ; 1:prijs,2:munt,3:eenheid,4:lijstprijs,5:korting1,6:korting2,7:codex,8 :katprijs,9:pariteit,10:afrondingsregel,11:eenheid(numeriek),12:round,13:aankpr(EUR),14:prijs(EUR),15:lijstprijs(EUR)
 ;
CALC Set LijstPr=LijstPr*GrOrdNum
 If NetBrutP Do  ; Bruto
 .Set LijstPr=$J($$ROUND(LijstPr)*MuntPar,0,2)
 .Set VkpPr=$J(LijstPr*(100-Korting1/100)*(100-Korting2/100),0,2)
 Else  Do  ; Netto
 .Set VkpPr=LijstPr*(100-Korting1/100)*(100-Korting2/100)
 .Set VkpPr=$J($$ROUND(VkpPr)*MuntPar,0,2)
 .Set LijstPr=$J($$ROUND(LijstPr)*MuntPar,0,2)
 Set AkpEUR=+$J(CifPPL,0,4)
 Set LijstEUR=+$J(LijstPr/GrOrdNum/MuntPar,0,4)
 Set VkpEUR=+$J(VkpPr/GrOrdNum/MuntPar,0,4)
 Quit
 ;
KKORTING ; Korting bepalen afhankelijk van KATPrijs of Klantcodex
 ;Routine KORTPC houdt reeds rekening met KATPRIJS
 Set R=$$KORTPC^KORTING(KLNr,PRNr,NoSa),Korting1=$P(R,D),Korting2=$P(R,D,2),KortNiv=$P(R,D,3)
 If KortNiv'="P" Do  ; dit moet eigenlijk in KORTPC zitten
 .Set:$L($S(IsKsCust:KatPrKs,KlTyp:KatPrHan,1:KatPrInd)) KortNiv="K" 
 Set:KortNiv="" KortNiv="C" ; Codex klant
 Quit
 ;
PKORTING ; Korting bepalen afhankelijk van KATPrijs
 If "\E\K\"[(D_Korting1_D),'$L(IsKatPr) Set Korting1=$$KSKORT(PRNr,Korting1,NoSa),Korting2=""
 Set:$L(IsKatPr) Korting1=IsKatPr
 Set PrijsKl="" Set:"EKLSG"[Korting1 (PrijsKl,IsKatPr)=Korting1,Korting1=""
 ; PV : Voor de BRUTO klanten moet de korting1 anders berekend worden
 ; De korting is een deel van de vork en moet NIET teruggerekend worden van uit de verkoopprijs 
 If $L(IsKatPr),LijstPr Set PrijsKl=IsKatPr,Korting1=1-(LijstPr-(Vork*$S(IsKatPr="G":100,IsKatPr="S":50,1:0)/100)/LijstPr)*100
 Set KortNiv=$S($L($S(IsKsCust:KatPrKs,KlTyp:KatPrHan,1:KatPrInd)):"K",1:"")
 Quit
 ;
ROUND(Prijs) ; Afronden naar boven op 1 cent
 Set Prijs=$J(Prijs*100+.499999,0,0)/100
 Quit Prijs
 ;
GETCUST(KLNr,NoSa) 
 New R,FaMunt,KlantId, KlantPartijID
 Set:$G(NoSa)'="S" NoSa=""
 Set FaMunt=$$FADEF^vhRtn1(),KlantId=^KK1(KLNr)
 Set R=^KKL(KlantId,0),KlMunt=$P(R,D,11) Set:KlMunt="" KlMunt=FaMunt
 Set R=$G(^KKL(KlantId,7))
 If NoSa="S",$L($P(R,D,8))=3 Set KLMunt=$P(R,D,8)
 Set KlTyp=$$IsHandel^KLANT5(KLNr)
 Set R=^KKL(KlantId,2),PrijsKl=$P(R,D,3),NetBrutP=$P(R,D,5)
 Set IsLidVan=$$GetLidVan^KF21B(KLNr),%LidVan=$LI(IsLidVan,2),IsLidVan=$LI(IsLidVan)
 If NoSa="S",$L($P(R,D,25)) Set PrijsKl=$P(R,D,25)
 #dim KlantPartijID As DOM.common.PartijID = ##class(DOM.DomeinContext).Instance().GeefLegacyPartijAPI().GeefKlantPartijID(KLNr)
 #dim IsKsCust As %Boolean = '(##class(DOM.DomeinContext).Instance().GeefKlantTypeAPI().IsIndustriePoolKlant(KlantPartijID))
 Quit
 ;
GETPROD(PRNr,NoSa,SimPPL) 
 New J,R,FaMunt,EenhAank,PPL,Korting,%Vork,%DB,%Cif
 Set:$G(NoSa)'="S" NoSa=""
 Set R=^KPR(PRNr,1),KatPrHan=$P(R,D,18),KatPrInd=$P(R,D,19)
 Set R=^KPR(PRNr,2),KatPrKs=$P(R,D,24)
 Set R="",J=$O(^KPR(PRNr,"J")) Set:$E(J)="J" R=^KPR(PRNr,J)
 Set LEVNr=$P(R,D),PrMunt=$P(R,D,17)
 Set EenhAank=$P(R,D,28),EenhAank=$S("E"[EenhAank:1,EenhAank="H":100,EenhAank="M":1000,1:0)
 Set PPL=$P(R,D,19),%Korting=$P(R,D,9),%Vork=$P(R,D,27),%DB=$P(R,D,24),%Cif=$P(R,D,21)
 Do:NoSa="S"
 .Set R=^KPR(PRNr,2) Set:$L($P(R,D,3)) PPL=$P(R,D,3) Set:$L($P(R,D,4)) %Korting=$P(R,D,4)
 .Set:$L($P(R,D,5)) %Vork=$P(R,D,5) Set:$L($P(R,D,6)) %DB=$P(R,D,6) Set:$L($P(R,D,7)) %Cif=$P(R,D,7)
 .Set R=^KPR(PRNr,1) Set:$L($P(R,D,3)) PrMunt=$P(R,D,3)
 Set:$G(SimPPL) PPL=SimPPL
 Set FaMunt=$$FADEF^vhRtn1()
 Set PPL=PPL/EenhAank
 If FaMunt'[PrMunt S R=$$MUNT^vhRtn1(PrMunt,,11,"S"),PPL=PPL*R
 Set CifPPL=PPL*(100-%Korting)/100*(100+%Cif)/100,CifPPL=$J(CifPPL,1,4) Set:'CifPPL %DB=0
 Set R=CifPPL/(100-%DB/100)*%DB/100,R=$J(R,1,4),LijstPr=CifPPL+R
 Set Vork=CifPPL+R*%Vork/100,Vork=$J(Vork,1,4)
 Set GrOrde=$$GRORDE^PRODUKT2(PRNr,NoSa)
 Set:GrOrde="" GrOrde="E"
 Set GrOrdNum=$S(GrOrde="M":1000,GrOrde="H":100,1:1)
 Quit
 ;
KSKORT(PRNr,Korting,NoSa) 
 New R,J,KSDB,%Vork,KatPrKs
 If $G(PRNr) Set R=^KPR(PRNr,2),KatPrKs=$P(R,D,24) If $L(KatPrKs)  Do  Quit Korting
 .Set R="",J=$O(^KPR(PRNr,"J")) Set:$E(J)="J" R=^KPR(PRNr,J)
 .Set %Vork=$P(R,D,27)
 .Set Korting=%Vork*$S(KatPrKs="G":100,KatPrKs="S":50,1:0)/100
 If '$G(PRNr) Set KSDB=20
 Else  Do
 .Set:$G(NoSa)'="S" NoSa=""
 .Set R=$O(^KPR(PRNr,"J")) Set:$E(R)="J" R=^KPR(PRNr,R)
 .Set KSDB=$P(R,D,10)
 .If NoSa="S" Set R=^KPR(PRNr,2) Set:$P(R,D,10) KSDB=$P(R,D,10)
 Set:Korting="E" Korting=100-(10000/(100-KSDB))
 Set:Korting="K" Korting=100-(10000/(100-KSDB))/2.5
 Quit Korting
 ;
PRIJSGEG(PRNr,NoSa,SimPPL) 
 ; Output: Piece  1 = PPL
 ;         Piece  2 = aankoopmunt
 ;         Piece  3 = aankoopeenheid
 ;         Piece  4 = aankoopeenheid (numeriek)
 ;         Piece  5 = korting
 ;         Piece  6 = CifPPL
 ;         Piece  7 = firmamunt
 ;         Piece  8 = verkoopeenheid
 ;         Piece  9 = verkoopeenheid (numeriek)
 ;         Piece 10 = Cif%
 ;         Piece 11 = dekkingsbijdrage
 ;         Piece 12 = dekkingsbijdrage%
 ;         Piece 13 = vork
 ;         Piece 14 = vork%
 ;         Piece 15 = lijstprijs (per stuk)
 ;         Piece 16 = katprod industrie (Codex code)
 ;         Piece 17 = katprod handel (Codex code)
 ;         Piece 18 = katprod KS (Codex code)
 ;         Piece 19
 ;         Piece 20 = CorFakt
 New I,J,R,LEVNr,KatPrHan,KatPrInd,KatPrKs,GrOrde,GrOrdNum,PrMunt,CifPPL,LijstPr,Vork,DB,CorFakt
 New FaMunt,Decimal,EenhAank,PPL,%Korting,%Vork,%DB,%Cif
 Set:$G(NoSa)'="S" NoSa=""
 Set R=^KPR(PRNr,1),KatPrHan=$P(R,D,18),KatPrInd=$P(R,D,19)
 Set R=^KPR(PRNr,2),KatPrKs=$P(R,D,24)
 Set R="",J=$O(^KPR(PRNr,"J")) Set:$E(J)="J" R=^KPR(PRNr,J)
 Set LEVNr=$P(R,D),PrMunt=$P(R,D,17)
 Set EenhAank=$P(R,D,28),EenhAank=$S("E"[EenhAank:1,EenhAank="H":100,EenhAank="M":1000,1:0)
 Set PPL=$P(R,D,19),%Korting=$P(R,D,9),%Vork=$P(R,D,27),%DB=$P(R,D,24),%Cif=$P(R,D,21),CorFakt=$P(R,D,8)
 Do:NoSa="S"
 .Set R=^KPR(PRNr,2) Set:$L($P(R,D,3)) PPL=$P(R,D,3) Set:$L($P(R,D,4)) %Korting=$P(R,D,4)
 .Set:$L($P(R,D,5)) %Vork=$P(R,D,5) Set:$L($P(R,D,6)) %DB=$P(R,D,6) Set:$L($P(R,D,7)) %Cif=$P(R,D,7)
 .Set R=^KPR(PRNr,1) Set:$L($P(R,D,3)) PrMunt=$P(R,D,3)
 Set FaMunt=$$FADEF^vhRtn1(),Decimal=$$MUNT^vhRtn1(FaMunt,4)
 Set PPL=PPL/EenhAank
 If FaMunt'[PrMunt S R=$$MUNT^vhRtn1(PrMunt,,11,"S"),PPL=PPL*R
 Set CifPPL=PPL*(100-%Korting)/100*(100+%Cif)/100,CifPPL=$J(CifPPL,1,4) Set:'CifPPL %DB=0
 Set GrOrde=$$GRORDE^PRODUKT2(PRNr,NoSa)
 Set:GrOrde="" GrOrde="E"
 Set GrOrdNum=$S(GrOrde="M":1000,GrOrde="H":100,1:1)
 ;Set %DB=$J(%DB*GrOrdNum,0,Decimal)
 Set R=CifPPL/(100-%DB/100)*%DB/100,R=$J(R,1,4),LijstPr=CifPPL+R
 Set LijstPr=LijstPr*GrOrdNum
 Set GrtPr=LijstPr*(100-%Vork/100)
 Set GrtPr=$J($$ROUND(GrtPr),0,2)
 Set LijstPr=$J($$ROUND(LijstPr),0,2)
 Set Vork=LijstPr-GrtPr/GrOrdNum
 Set LijstPr=LijstPr/GrOrdNum
 Set PPL=$J(PPL*EenhAank,0,4)
 Set DB=LijstPr-CifPPL
 Set R=PPL_D_PrMunt_D_$S(EenhAank=1:"E",EenhAank=100:"H",EenhAank=1000:"M",1:"")_D_EenhAank
 Set R=R_D_%Korting_D_CifPPL_D_FaMunt_D_GrOrde_D_GrOrdNum_D_%Cif_D_DB_D_%DB_D_Vork_D_%Vork_D_LijstPr
 Set R=R_D_KatPrInd_D_KatPrHan_D_KatPrKs_D_LEVNr_D_CorFakt
 Quit R
 ;