KPRIJS ;Produkt prijs
#define CheckAXFase (##class(TECH.Config.ConfigMgr).Instance().GetString("AX_SalesPriceOut_Fase") = "2A")
#define MaatwerkKlantenMetWildcardUitz ";19485;14604;"
#include vhLib.Macro
#include Prod.Product
#include BL.Derde.LevSpecifiek
#include BL.Derde.KlantSpecifiek
#define CodexList "LRSBG"
#define CodexDeelVork "0;25;50;75;100"
#define CodexDeelVorkOL "0;27.27272727;45.45454545;72.72727272;100"

KlantPrijsObject(KLNr,PRNr,NoSa,RefDat,Aantal,LevTerm,Optie)
	Quit $$KlantPrijsNaarKlantPrijsObject($$KlantPrijs(.KLNr,.PRNr,.NoSa,.RefDat,.Aantal,.LevTerm,.Optie))
	
KLANTPRObject(KLNr,PRNr,NoSa,SimPPL)
	quit $$KlantPrijsNaarKlantPrijsObject($$KLANTPR(.KLNr,.PRNr,.NoSa,.SimPPL))
	
KlantPrijsNaarKlantPrijsObject(Record)
	new PrijsInfo set PrijsInfo = ##class(APPS.VKP.dto.PrijsInfo).%New()
	set PrijsInfo.Prijs = +$piece(Record,"\",1)
	set PrijsInfo.Munt = $piece(Record,"\",2)
	set PrijsInfo.GrootteOrde = $piece(Record,"\",3)
	set PrijsInfo.LijstPrijs = $piece(Record,"\",4)
	set PrijsInfo.KortingPercentage1 = +$piece(Record,"\",5)
	set PrijsInfo.KortingPercentage2 = +$piece(Record,"\",6)
	set PrijsInfo.PrijsCodex = $piece(Record,"\",7)
	set PrijsInfo.PrijsBerekingManier = $piece(Record,"\",8)
	set PrijsInfo.Pariteit = $piece(Record,"\",9)
	set PrijsInfo.AfrondingRegel = $piece(Record,"\",10)
	set PrijsInfo.GrootteOrdeNumeriek  = $piece(Record,"\",11)
	set PrijsInfo.AfrondingRegelNumeriek = $piece(Record,"\",12)
	set PrijsInfo.AankoopprijsInEuro = +$piece(Record,"\",13)
	set PrijsInfo.PrijsInEuro = +$piece(Record,"\",14)
	set PrijsInfo.LijstPrijsInEuro = +$piece(Record,"\",15)
	quit PrijsInfo
	
 
 // Bereken van de verkoopprijs van een product voor een bepaalde klant rekening houdend met optionele kortigen
KlantPrijs(KLNr,PRNr,NoSa,RefDat,Aantal,LevTerm,Optie)
	; Optie : T = Geen TANDEMBOX korting berekening
	; Optie : D = Display van optionele kortingen 
	Goto KLANTPR2
	
 // Berekenen van de verkoopprijs van een product volgens de opgegeven korting
 // eventueel wordt er gecontroleerd op de KATprijs	
KlantPrijsViaKorting(KLNr,PRNr,Korting1,Korting2,KlantGrOrde,CheckKAT,NoSa)
	; GrootteOrde is optioneel
	Goto KLANTPR3
	
 // Berekenen van de productverkoopprijs van een klant
KLANTPR(KLNr,PRNr,NoSa,SimPPL)
 If $G(KLNr)="?" Do HELPFUNC^vhRtn1($ZN,"KLANTPR") Quit ""
 New Aantal,RefDat,LevTerm,Optie,VolgNr
 ; 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)
KLANTPR2
 New Korting1,Korting2,CheckKAT,KlantGrOrde
KLANTPR3
 New R,KatProd,IsKatPr,FaMunt,Munt,MuntPar,VkpPr,KortNiv,AkpEUR,VkpEUR,LijstEUR,KlMunt,KlTyp,NetBrutP,PrijsKl,IsKsCust,IsLidVan,%LidVan,LEVNr,KatPrHan,KatPrInd,KatPrKs,GrOrde,GrOrdNum,PrMunt,CifPPL,LijstPr,Vork,%Vork
 New BTWfactor,LijstPr1,VkpEURIncl,VkpPr1,VkpPrIncl,VkpEURAX,LijstEURAX,InclBTW,PriceUnit,CachePPL
 ; Opgezet via GETCUST : KlMunt,KlTyp,NetBrutP,PrijsKl,IsKsCust,IsLidVan,%LidVan
 ; Opgezet via GETPROD : LEVNr,KatPrHan,KatPrInd,KatPrKs,GrOrde,GrOrdNum,PrMunt,CifPPL,LijstPr,Vork,%Vork
 New LEVNr,KatPrHan,KatPrInd,KatPrKs,GrOrde,GrOrdNum,PrMunt,CifPPL,LijstPr,Vork,%Vork,BusinessType,Klant,KlantID, CorFakt,KortRec
 Set:$G(NoSa)'="S" NoSa=""
 Set FaMunt=$$FADEF^vhRtn1()
 Do GETCUST(KLNr,NoSa,PRNr),GETPROD(PRNr,NoSa,$G(SimPPL))
 Set IsKatPr=$S(IsKsCust:KatPrKs,KlTyp:KatPrHan,1:KatPrInd)
 Set Munt=KlMunt
 If KlMunt="MTL" Do  ; Munt leverancier
 .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)
 Set KlantID = ##class(DOM.DomeinContext).Instance().GeefLegacyPartijAPI().GeefKlantPartijID(KLNr)
 Set Klant = ##class(DOM.DomeinContext).Instance().GeefVerkoopAPI().GeefKlant(KlantID)
 Set BusinessType = Klant.GeefBusinessType()
 Do KKORTING, CALC
 
 If $$IsAX(KLNr,PRNr) {
	Set CachePPL=$S($G(SimPPL):SimPPL,1:$$CifPPL(PRNr))
	Set CacheMinuten = $ListGet($Get(^AXPrijsCache(KLNr,PRNr,+CachePPL,$S($G(Aantal):Aantal,1:"*"))),1)

 	If (($$GeefMinuten($Horolog)-600) < CacheMinuten) {
		Set lb=^AXPrijsCache(KLNr,PRNr,+CachePPL,$S($G(Aantal):Aantal,1:"*"))
		Set VkpEURAX=$LIST(lb,2)
		Set LijstEURAX=$LI(lb,3)
		Set PriceUnit=$LI(lb,4)
		Set InclBTW=$LI(lb,5)
	} Else {
		Try {
			New SalesPriceService, Result, ResultLine
			
			#dim SalesPriceService As AXimpl.Admin.VKP.SalesPriceService = ##class(AXimpl.Admin.VKP.SalesPriceService).%New()
			#dim Result As AXif.Dynamics.SalesPriceIn.MessageParts.ADUSalesPriceHeaderOutputDC = SalesPriceService.GeefPrijs(KLNr, PRNr, $select($Get(SimPPL):SimPPL, 1:""), .Aantal)
			#dim ResultLine As AXif.Dynamics.SalesPriceIn.MessageParts.ADUSalesPriceLineOutputDC = Result.Lines.GetAt(1)
			
			Set VkpEURAX = ResultLine.Price
			Set LijstEURAX = ResultLine.GrossPrice
			Set PriceUnit = +ResultLine.PriceUnit
			Set InclBTW = Result.InclVAT
			
			Set ^AXPrijsCache(KLNr,PRNr,+CachePPL,$S($G(Aantal):Aantal,1:"*"))=$LB($$GeefMinuten($H),VkpEURAX,LijstEURAX,PriceUnit,InclBTW)
		} Catch {
			New Exception
			
			Set (VkpEURAX,LijstEURAX)=99999
			Set PriceUnit=1
			Set InclBTW = $$$False 
			
			#dim Exception As TECH.Exceptions.Exception = ##class(TECH.ExceptionHandler).Catch() 
			Do ##class(vhLib.Logger).LogExceptie(Exception)
		}
	}
	
	If (VkpEURAX>0)&&(VkpEURAX'=99999)
	{
		Set VkpEUR=VkpEURAX
		Set LijstEUR=LijstEURAX
		If InclBTW
		{
			Set VkpEUR=+$J(VkpEUR/1.21,0,10)
		}
		Set VkpPr = VkpEUR
		Set LijstPr = LijstEUR
		If PriceUnit>1
		{ 
			Set VkpEUR=VkpEUR/PriceUnit
			Set LijstEUR=LijstEUR/PriceUnit
		}
		Set GrOrde=$Case(PriceUnit,100:"H",:"E")
		Set GrOrdNum=$Case(GrOrde,"H":100,:1)
		Set Korting2=0
		If +LijstEUR=0 {
			Set Korting1=0
		} Else {
			Set Korting1=(1-(VkpEUR/LijstEUR))*100
		}
	} Else {
		Do:(+VkpEUR>0)||(+VkpEURAX>0) ##class(vhLib.Logger).%New().Warning("Prijsberekening AX Fallback","Klant : '"_KLNr_"' Product : '"_PRNr_"' SimPPL : '"_$G(SimPPL)_"' -> Prijs : "_VkpEURAX_" -> fallback naar cache berekening '"_VkpEUR_"'")
	}	
 }
 Quit $$BUILD

 ; Build = VkpPr_D_Munt_D_GrOrde_D_LijstPr_D_Korting1_D_Korting2_D_$G(PrijsKl)_D_$G(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)
PrijzenViaAdmin(KLNr)
{
	Quit $$$MaatwerkKlantenMetWildcardUitz[(";"_KLNr_";")
}

ProdViaAdmin(PRNr)
  Quit:PRNr=1732579 0
  Quit:$E($P(^KPR(PRNr,2),"\",25))="6" 0 ; kind producten
  Quit:$P(^KPR(PRNr,1),"\",25)=1 0 ; Niet actief
 
  Quit 1

GeefMinuten(DatumEnTijd)
	Quit $P(DatumEnTijd,".")*24*60+($P(DatumEnTijd,".",2)\60)

KillAXCache
	Kill ^AXPrijsCache
	Quit
	
 // Set twee kortingen om van in % (*100) naar één korting in %
OneKorting(Korting1,Korting2)
 	Quit (1-((1-(Korting1/100))*(1-(Korting2/100))))*100
 	
IsAX(KLNr,PRNr)
 New Fase,IsAX
 Set IsAX=0
 If ($$$CheckAXFase)&&$$ProdViaAdmin(PRNr) {
 	Set IsAX=1
 	If $$PrijzenViaAdmin(KLNr) {
	 	If PRNr,$$$PRGet($$$LeveranciersNr)=$$$LevHalux {
		 	Set IsAX=0
		}
 	}
 }
 Quit IsAX
 
PRODINCLBTW(PRNr,Land,KlMunt,Korting1,Korting2,NetBrutP,KlTyp,NoSa,SimPPL,KlantGrOrde,CheckKAT,BusinessType)
 New R
 Set R = $$PROD(.PRNr,.Korting1,.Korting2,.KlMunt,.NetBrutP,.KlTyp,.NoSa,.SimPPL,.KlantGrOrde,.CheckKAT,.BusinessType)
 Set $P(R,"\") = $P(R,"\")*$$GETBTWFACTOR(.Land)
 Quit R
 
ProdViaCodex(PRNr,Codex)
	New KLNr
	Set KLNr=$Case(Codex,"L":$$$CKlantL,"R":$$$CKlantR,"S":$$$CKlantS,"B":$$$CKlantB,"G":$$$CKlantG,"P":$$$CKlantP,"C":$$$CKlantCExcl)
	
	Quit:'$D(^KK1(KLNr)) ""
	Quit $$KLANTPR(KLNr,PRNr)
 
PROD(PRNr,Korting1,Korting2,KlMunt,NetBrutP,KlTyp,NoSa,SimPPL,KlantGrOrde,CheckKAT,BusinessType)
 ; KlTyp 0=Industrie, 1=handel, P=prijslijst
 ; 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
 New R,KatPr,CorFakt,KatProd,IsKatPr,FaMunt,Munt,MuntPar,IsKsCust,PrijsKl,VkpPr,KortNiv,AkpEUR,VkpEUR,LijstEUR,LEVNr,KatPrHan,KatPrInd,KatPrKs,GrOrde,GrOrdNum,PrMunt,CifPPL,LijstPr,Vork,%Vork
 New BTWfactor,LijstPr1,VkpEURIncl,VkpPr1,VkpPrIncl

 If $$$CheckAXFase&&($G(Korting1)'="")&&("CPLRSBG"[Korting1) Quit $$ProdViaCodex(PRNr,Korting1) 
 
 
 ; Opgezet via GETPROD : LEVNr,KatPrHan,KatPrInd,KatPrKs,GrOrde,GrOrdNum,PrMunt,CifPPL,LijstPr,Vork,%Vork
 
 Set:$Get(BusinessType)="" BusinessType = ##class(DOM.VKP.enu.BusinessType).B2B()
 Set CheckKAT=$G(CheckKAT,1),FaMunt=$$FADEF^vhRtn1()
 ;Defaulting
 Set Korting2=$G(Korting2)
 Set KlMunt=$G(KlMunt,FaMunt)
 Set NetBrutP=$G(NetBrutP)
 Set KlTyp=$G(KlTyp),IsKsCust=0 ;KlTyp="P"
 Set:$G(NoSa)'="S" NoSa=""
 Do GETPROD(PRNr,NoSa)
 If ($$$CheckAXFase) {
	 Set LijstPr=$$GeefLijstPrijsInAX(PRNr,$S($G(SimPPL):SimPPL,1:""),LijstPr)
 }
 Set Munt=KlMunt
 If KlMunt="MTL" Do  ; Munt leverancier
 .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
 
LEVPR(LEVNr,PRNr,NoSa) ; Prijsgegevens ophalen voor opmaak toelevering
 New R,MuntPar,Korting1,Korting2,Munt,AankPr,Eenheid,Prijs
 If "N"[$G(NoSa) Set NoSa=""
 Set:'$D(LEVNr) LEVNr=$O(^KPR(PRNr,"J")),LEVNr=$S($E(LEVNr)="J":$E(LEVNr,2,9),1:"?")
 If '$D(^KPR(PRNr,"J"_LEVNr)) Quit "Undef"
 Set R=^KPR(PRNr,"J"_LEVNr),Korting1=$P(R,D,9),Korting2="",Munt=$P(R,D,17)
 Set AankPr=$P(R,D,19),Eenheid=$P(R,D,28)
 If NoSa="S" Do
 .Set R=$$SchaduwPPL(PRNr) Set:$L(R) AankPr=R
 .Set R=^KPR(PRNr,2)
 .If $L($P(R,D,4)) Set Korting1=$P(R,D,4),Korting2=""
 .Set:$L($P(^KPR(PRNr,1),D,3)) Munt=$P(^KPR(PRNr,1),D,3)
 Set:LEVNr=$$$LevBlum Korting2=$$ExtraKorting^Blum.RaadplegenProduct(PRNr)*100 ; Blum geeft vanaf 01/03/2010 extra korting voor sommige kundestammen - PV 25/02/2010
 Set:(+Korting1=0)&&(+Korting2'=0) Korting1=Korting2,Korting2=""
 Set MuntPar=$$MUNT^vhRtn1(Munt,,11,NoSa)
 Set Prijs=AankPr-(AankPr*Korting1/100),Prijs=Prijs-(Prijs*Korting2/100)
 Set R=$J(Prijs,0,2)_D_Munt_D_Eenheid_D_AankPr_D_Korting1_D_Korting2_"\\\"_MuntPar_"\\"
 Set Eenheid=$S(Eenheid="M":1000,Eenheid="H":100,1:1),Prijs=$J(Prijs/Eenheid*MuntPar,0,4)
 Set R=R_Eenheid_"\\"_Prijs
 Quit R ; PPL(incl. korting, munt lev) munt, eenheid, Aankprijs( excl. korting, munt lev.), korting1, korting2, , , Pariteit, , eenheid(numeriek), , PPL(EUR incl. korting)
 
PRIJSGEG(PRNr,NoSa,SimPPL) ; Ophalen van de prijsgegevens van een product 
 ; 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 = 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 (Prijsklasse code)
 ;         Piece 17 = katprod handel (Prijsklasse code)
 ;         Piece 18 = katprod KS (Prijsklasse code)
 ;         Piece 19 = LEVNr
 ;         Piece 20 = CorFakt
 New I,J,R,LEVNr,KatPrHan,KatPrInd,KatPrKs,GrOrde,GrOrdNum,GrtPr,PrMunt,CifPPL,LijstPr,Vork,DB,FaMunt,Decimal,EenhAank,PPL,%Korting,%Vork,%DB,%Cif,CorFakt
 Do GetProdBasis
 ;Set Decimal=$$MUNT^vhRtn1(FaMunt,4),%DB=$J(%DB*GrOrdNum,0,Decimal)
 Set R=CifPPL/(100-%DB/100)*%DB/100,R=$J(R,1,4),LijstPr=CifPPL+R
 If ($$$CheckAXFase) {
	 Set LijstPr=$$GeefLijstPrijsInAX(PRNr,$S($G(SimPPL):CifPPL,1:""),LijstPr)
 }
 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
 
GeefLijstPrijsInAX(PRNr,SimCifPPL,AdminLijstPr)
	New CachePPL,VkpEURAX, VkpEUR,LijstEURAX,PriceUnit,IncBTW,KLNr
	
	Quit:$$ProdViaAdmin(PRNr) AdminLijstPr
	Set KLNr=$$$CKlantL
	
 	Set CachePPL=$S($G(SimPPL):SimPPL,1:$$CifPPL(PRNr))
	Set CacheMinuten = $ListGet($Get(^AXPrijsCache(KLNr,PRNr,+CachePPL,"*")),1)
 	
 	If (($$GeefMinuten($Horolog)-600) < CacheMinuten) {
		Set lb=^AXPrijsCache(KLNr,PRNr,+CachePPL,"*")
		Set VkpEURAX=$LI(lb,2)
		Set PriceUnit=$LI(lb,4)
		Set InclBTW=$LI(lb,5)
	} Else {
		Try {
			New SalesPriceService, Result, ResultLine
			
			#dim SalesPriceService As AXimpl.Admin.VKP.SalesPriceService = ##class(AXimpl.Admin.VKP.SalesPriceService).%New()
			#dim Result As AXif.Dynamics.SalesPriceIn.MessageParts.ADUSalesPriceHeaderOutputDC = SalesPriceService.GeefPrijs(KLNr, PRNr, $select($get(SimPPL):SimPPL,1:""),.Aantal)
			#dim ResultLine As AXif.Dynamics.SalesPriceIn.MessageParts.ADUSalesPriceLineOutputDC = Result.Lines.GetAt(1)
			
			Set VkpEURAX = ResultLine.Price
			Set LijstEURAX = ResultLine.GrossPrice
			Set PriceUnit = +ResultLine.PriceUnit
			Set InclBTW = Result.InclVAT
			
			Set ^AXPrijsCache(KLNr,PRNr,+CachePPL,"*")=$LB($$GeefMinuten($H),VkpEURAX,LijstEURAX,PriceUnit,InclBTW,"LP")
		} Catch {
			Set (VkpEURAX)=99999
			Set PriceUnit=1
			Set InclBTW = $$$False
			 
			#dim Exception As TECH.Exceptions.Exception = ##class(TECH.ExceptionHandler).Catch() 
			Do ##class(vhLib.Logger).LogExceptie(Exception)
		}
	}
	
	If (VkpEURAX>0)&&(VkpEURAX'=99999)
	{
		Set VkpEUR=VkpEURAX
		If InclBTW
		{
			Set VkpEUR=+$J(VkpEUR/1.21,0,10)
		}
		If PriceUnit>1
		{ 
			Set VkpEUR=VkpEUR/PriceUnit
		}
	} Else {
		Set VkpEUR=AdminLijstPr
		Do:(+VkpEUR>0)||(+VkpEURAX>0) ##class(vhLib.Logger).%New().Warning("Prijsberekening AX Fallback","LIJSTPRIJS Klant : '"_KLNr_"' Product : '"_PRNr_"' SimPPL : '"_$G(SimPPL)_"' -> Prijs : "_VkpEURAX_" -> fallback naar cache berekening '"_$G(AdminLijstPr)_"'")
	}	
 	Quit VkpEUR


PRIJSGEGZONDERAX(PRNr,NoSa,SimPPL) ; Ophalen van de prijsgegevens van een product 
 ; 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 = 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 (Prijsklasse code)
 ;         Piece 17 = katprod handel (Prijsklasse code)
 ;         Piece 18 = katprod KS (Prijsklasse code)
 ;         Piece 19 = LEVNr
 ;         Piece 20 = CorFakt
 New I,J,R,LEVNr,KatPrHan,KatPrInd,KatPrKs,GrOrde,GrOrdNum,GrtPr,PrMunt,CifPPL,LijstPr,Vork,DB,FaMunt,Decimal,EenhAank,PPL,%Korting,%Vork,%DB,%Cif,CorFakt
 Do GetProdBasis
 ;Set Decimal=$$MUNT^vhRtn1(FaMunt,4),%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
 
GETPROD(PRNr,NoSa,SimPPL) ; Ophalen productgegevens
 New J,R,FaMunt,EenhAank,PPL,%Korting,%DB,%Cif
 Do GetProdBasis
 Quit
 
GetProdBasis
 Set:$G(NoSa)="" NoSa="N"
 Set:($G(D)="") D = "\"
 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)
 Set CorFakt=$P(R,D,8)
 Do:NoSa="S"
 .Set R=$$SchaduwPPL(PRNr) Set:$L(R) PPL=R
 .Set R=^KPR(PRNr,2) 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:$L($P(R,D,26)) CorFakt=$P(R,D,26)
 .Set R=^KPR(PRNr,1) Set:$L($P(R,D,3)) PrMunt=$P(R,D,3)
 .Set:$L($P(R,D,15)) KatPrHan=$P(R,D,15) Set:$L($P(R,D,16)) KatPrInd=$P(R,D,16)
 .Set:KatPrHan="Z" KatPrHan=""
 .Set:KatPrInd="Z" KatPrInd=""
 Set:$G(SimPPL) PPL=SimPPL
 Set FaMunt=$$FADEF^vhRtn1()
 Set PPL=PPL/EenhAank
 If FaMunt'[PrMunt S R=$$MUNT^vhRtn1(PrMunt,,11,NoSa),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
 
CifPPL(PRNr,NoSa)
 New I,J,R,LEVNr,KatPrHan,KatPrInd,KatPrKs,GrOrde,GrOrdNum,GrtPr,PrMunt,CifPPL,LijstPr,Vork,DB,FaMunt,Decimal,EenhAank,PPL,%Korting,%Vork,%DB,%Cif,CorFakt
 Do GetProdBasis
 Quit CifPPL
	 
BUILD() Quit VkpPr_D_Munt_D_GrOrde_D_LijstPr_D_Korting1_D_Korting2_D_$G(PrijsKl)_D_$G(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 
 If $L($G(KlantGrOrde)) Do
 . Set GrOrde=KlantGrOrde
 . Set GrOrdNum=$S(GrOrde="M":1000,GrOrde="H":100,1:1)
 
 If (BusinessType = ##class(DOM.VKP.enu.BusinessType).B2B()) {
	 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)
	 If $G(%LidVan) S VkpEUR=+$J(VkpEUR*(100-%LidVan/100),0,4) ; De verkoopprijs wordt verlaagd met de commissie vergoeding van de aankoopgroep
 } Else {
	 Set LijstEUR = +$J(LijstPr,0,4)									// Lijstprijs excl BTW in euro, per eenheid
 	 Set LijstPr1=LijstPr*GrOrdNum
	 Set BTWfactor = $$GETBTWFACTOR("BE", PRNr)
	 Set VkpPr1=LijstPr1*(100-Korting1/100)*(100-Korting2/100)			// Verkoopprijs excl BTW in euro
	 Set VkpEURIncl=$$B2CROUND(VkpPr1*BTWfactor)				// Verkoopprijs incl BTW in euro
	 Set VkpEUR=+$J(VkpEURIncl/BTWfactor/GrOrdNum,0,4)					// Verkoopprijs excl BTW via terugrekenen van de inclusiefprijs, in euro, per eenheid
	 Set VkpPrIncl=$J(VkpEURIncl*MuntPar,0,2)							// Verkoopprijs incl BTW in de gevraagde munt
	 Set VkpPr=VkpPrIncl/BTWfactor										// Verkoopprijs excl BTW via terugrekenen van de inclusiefprijs, in de gevraagde munt
	 																	// Niet afgerond voor maximale precisie bij opnieuw bijtellen an de BTW
	 Set LijstPr=$J($$ROUND(LijstPr1)*MuntPar,0,2)					// Lijstprijs excl BTW volgens bestaande afronding, in de gevraagde munt
	 Set AkpEUR=+$J(CifPPL,0,4)											// Aankoopprijs in euro excl BTW, per eenheid
	 Set VkpEURIncl=+$J(VkpEURIncl/GrOrdNum,0,4)						// Verkoopprijs incl BTW in euro, per eenheid
 }
 Quit
 
KKORTING ; Korting bepalen afhankelijk van KATPrijs of Klantcodex
 If $G(Korting1)="" Do  ; Korting was niet opgegeven dus zelf bepalen
 . Set KortRec=$$GetKorting^KORTING(KLNr,PRNr,NoSa,.RefDat,.Aantal,.LevTerm,.Optie)
 . Set Korting1=$LI(KortRec,2),Korting2=$LI(KortRec,3),KortNiv=$LI(KortRec,6)
 . If $L($LG(KortRec,7)) Set KlantGrOrde=$LI(KortRec,7) ; GrootteOrde wordt overruled met deze van de uitzondering
 Else  If '$G(CheckKAT) Do  ; Korting was opgegeven maar controle op KATprijs moet uitgevoerd worden
 . Set KATprijs=$$KATPrijs^KORTING(KLNr,PRNr,.NoSa)
 . If $L(PrijsKl),"CP"[PrijsKl Set KATprijs="" ; Geen katprijs indien "C" of "P" klant
 . Set:$L(KATprijs) Korting1=KATprijs,Korting2="",KortNiv="K"
 Quit
 
TranslateCodex(PRNr,Codex,NoSa,%Vork)
 New Korting
 Quit:Codex'?.1A Codex
 ; Voor KS-korting E=per stuk, K=kleinverpakking
 If "KE"[Codex,$L(Codex) Do  Quit Korting
 . New R,KSDB 
 . If '$G(PRNr) Set KSDB=20
 . Else  Do 
 . . Set R=$O(^KPR(PRNr,"J")) Set:$E(R)="J" R=^KPR(PRNr,R)
 . . Set KSDB=$P(R,D,10)
 . . If $G(NoSa)="S" Set R=^KPR(PRNr,2) Set:$P(R,D,10) KSDB=$P(R,D,10)
 . Set Korting=100-(10000/(100-KSDB))/$S(Codex="K":2.5,1:1)
 If "CP"[Codex,$L(Codex) Do  Quit Korting
 . Set Korting=$S(Codex="C":-100,1:-10)
 . Set Korting=$$TranslateCodexBeslag^KPRIJSExeptions(PRNr, Codex, Korting)
 . If (##class(DOM.DomeinContext).Instance().GeefProductTypeAPI().IsTAORIndelingProduct(PRNr)) Do
 . . Set Korting = 0	// Cons en Plus staan op lijstprijs
 . . Set Korting=$$TranslateCodexTaorIndeling^KPRIJSExeptions(PRNr, Codex, Korting)
 . If Codex="C",$$ISORGAL^PRODUKT2(PRNr) Do
 . . New R,%Vork,CifPPL,CorFakt,GrOrdNum,GrOrde,KatPrHan,KatPrInd,KatPrKs,LEVNr,LijstPr,PrMunt,Vork,KatPr
 . . Do GETPROD(PRNr,NoSa)
 . . If 'LijstPr Set Korting=0 Quit
 . . Set R=$$PROD(PRNr,"S",,,,,NoSa) ; Berekenen Spilprijs
 . . Set Korting=1-($P(R,D)*2/LijstPr)*100 ; Spilprijs * 2
 . . Set Korting=$$TranslateCodexOrgalux^KPRIJSExeptions(PRNr, Codex, Korting)
 Set:($$$CodexList'[Codex)!(Codex="") Codex="L"
 Set:$G(%Vork)="" %Vork=$P($$PRIJSGEG(PRNr,.NoSa),D,14)
 Quit +$J(%Vork*$P($S($$ISORGAL^ORGALUX(PRNr):$$$CodexDeelVorkOL,1:$$$CodexDeelVork),";",$F($$$CodexList,Codex)-1)/100,0,4)
 
PKORTING ; opgevenen korting eventueel overrulen met KATprijs
 ; KATprijs
 Set KatPr=$S(Korting1="C":"",Korting1="P":"",'CheckKAT:"",IsKsCust:KatPrKs,KlTyp:KatPrHan,1:KatPrInd)
 Set:$L(KatPr) Korting1=KatPr,Korting2="",KortNiv="K"
 ; Omzetting code naar %
 If Korting1?1A Set Korting1=$$TranslateCodex(PRNr,Korting1,.NoSa,%Vork),Korting2=""
 
 Quit
  
ROUND(Prijs,Eenheid=100) ; Afronden naar boven op 1 cent
 Set Prijs=$J(Prijs*Eenheid+.499999,0,0)/Eenheid
 Quit Prijs
 
B2CROUND(Prijs)			// Afronding voor B2C prijsberekening
  Quit $$ROUND(Prijs,2)
  
GETBTWFACTOR(LandVanVerkoop, PRNr)	// Geeft het BTW-percentage, los van het feit of we de BTW al dan niet aanrekenen
  // TODO In principe moet het BTW% bepaald worden uit de BTW-code van het product.
  // TODO BTW-code omzetten naar een % via ^KBA
  New Land
  Set Land=$G(LandVanVerkoop)
  Quit $S(Land?1(1"B",1"BE"):1.21,Land="NL":1.21,Land="CH":1.076,1:1)
  
GETCUST(KLNr,NoSa,PRNr) ; Ophalen klantgegevens
 New R,KlantId,FaMunt
 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)
 Set PrijsKl=$$PRIJSKL^KLANT(KLNr,PRNr,NoSa),NetBrutP=$P(R,D,5)
 Set IsLidVan=$$GetLidVan^KF21B(KLNr),%LidVan=$LI(IsLidVan,2),IsLidVan=$LI(IsLidVan) ; %LidVan bevat de commissie % van de aankoopgroep
 If NoSa="S",$L($P(R,D,25)) Set PrijsKl=$P(R,D,25)
 Set IsKsCust=0 ;$$ISKLANT^KS(KLNr,,NoSa)
 Quit
 
 ; Controle of de prijs niet onder de aankoopprijs zit
 ; Controle of de prijs niet boven de lijstprijs zit
CHKPRIJS(PRNr,LijstPr,VerkPr,Eenheid,Pariteit,AankPr,WachtW,Position,TimeOut,Time,Check,KLNr) 
 New R,KortText,Ok,Klant,KlantID
 #dim KlantID As DOM.VKP.VanHoeckeKlantID
 #dim Klant As DOM.VKP.Klant
 Set WachtW=$G(WachtW),Position=$G(Position),TimeOut=$G(TimeOut),Time=$G(Time)
 Set Check=$G(Check) Set:Check="" Check="ALV"
 Set LijstPr=LijstPr/Eenheid*Pariteit,VerkPr=VerkPr/Eenheid*Pariteit,Ok=1
 If Check["L",'LijstPr Do
 .Set KortText=$P(^KPR(PRNr,0),D)
 .Set R=$$^vhTXTPOP("KPRIJS","CHK-LIJST-NUL-PRIJS","",KortText),Ok=R'="A"
 .If Ok,$L(WachtW) Set Ok=$$ASK^vhWACHTW(WachtW,Position,TimeOut,Time)
 Else  If Check["A",'AankPr Do
 .Set KortText=$P(^KPR(PRNr,0),D)
 .Set R=$$^vhTXTPOP("KPRIJS","CHK-AANK-NUL-PRIJS","",KortText),Ok=R'="A"
 .If Ok,$L(WachtW) Set Ok=$$ASK^vhWACHTW(WachtW,Position,TimeOut,Time)
 ELse  If Check["V",VerkPr<AankPr Do
 .If $G(KLNr)'=3479,$G(KC)'=3479,$G(KLNr)'=3711,$G(KC)'=3711
 .Else  Quit:$$LEVNR^PRODUKT2(PRNr)=6332
 .If $G(KLNr),$$HeeftUitzondering^KLPUTZ(KLNr,PRNr,4) Quit
 .Set KortText=$P(^KPR(PRNr,0),D)
 .Set R=$$^vhTXTPOP("KPRIJS","CHK-VERK-AANK-PRIJS","",KortText,$J(VerkPr,0,2)),Ok=R'="A"
 .If Ok,$L(WachtW) Set Ok=$$ASK^vhWACHTW(WachtW,Position,TimeOut,Time)
 Else  If Check["V",VerkPr>LijstPr Do
 .Set KlantID = ##class(DOM.DomeinContext).Instance().GeefLegacyPartijAPI().GeefKlantPartijID($G(KLNr,KC))
 .Set Klant = ##class(DOM.DomeinContext).Instance().GeefVerkoopAPI().GeefKlant(KlantID)
 .If Klant.GeefBusinessType() = ##class(DOM.VKP.enu.BusinessType).B2B() Do
 ..Set KortText=$P(^KPR(PRNr,0),D)
 ..Set R=$$^vhTXTPOP("KPRIJS","CHK-VERK-LIJST-PRIJS","",KortText,$J(VerkPr,0,2),$J(LijstPr,0,2)),Ok=R'="A"
 ..If Ok,$L(WachtW) Set Ok=$$ASK^vhWACHTW(WachtW,Position,TimeOut,Time)
 Quit Ok
 
 ; Deze routine komt te vervallen na het afschaffen van de Prijslijst-klant
KSKORT(PRNr,Korting,NoSa) 
 Goto KSKORT+1^KPRIJSS
 
 ; ShaduwPPL van een product ophalen i.v.m. bouwstenen
 ; ForceSchaduwPPL = 0 of '$G() geeft leeg indien gelijk aan de PPL (default)
 ;                 = 1 geeft steeds de SchaduwPPL ook indien gelijk aan de PPL
SchaduwPPL(PRNr,ForceSchaduwPPL)
 New J,R,SchaduwPPL,PPL,PRBS
 
 If ($$HasHalfFabr^PRBS(PRNr)||($$$ProductGet(PRNr,$$$LinkType)="S")),'$$ExcludeSchaduwPPL(PRNr) Do ; Halfabrikaat of Stock over kinderen EXEPT 358M5002SF *7587* 
 . New GrOrde
 . Do CALC^PRBS(PRNr,.PRBS,,,,"S") ; recursie mogelijk
 . Set SchaduwPPL=$P(PRBS,D)
 . Set J=$O(^KPR(PRNr,"J")),R=^(J),GrOrde=$P(R,D,28)
 . Set GrOrde=$S(GrOrde="M":1000,GrOrde="H":100,1:1)
 . Set SchaduwPPL=+$J(SchaduwPPL*GrOrde,0,2)
 Else  Set R=^KPR(PRNr,2),SchaduwPPL=$P(R,D,3)
 Do:'$G(ForceSchaduwPPL)  ; Leeg indien SchaduwPPL = PPL
 . Set J=$O(^KPR(PRNr,"J")),R=^(J),PPL=$P(R,D,19)
 . Set:+PPL=+SchaduwPPL SchaduwPPL=""
 Quit SchaduwPPL
 
ExcludeSchaduwPPL(PRNr)
 Quit:(PRNr?1(1"355494",1"355495")) 1
 ;Quit:($P($$GENTYP^HAD(PRNr),"\")="KAD") 1 ; PV 09/09/10 op vraag van JB
 Quit 0 ; include
 
SchaduwPPLRecurse(PRNr,ForceSchaduwPPL)
 New J,R,SchaduwPPL,PPL,PRBS
 If ($$HasHalfFabr^PRBS(PRNr)||($$$ProductGet(PRNr,$$$LinkType)="S")) Do ; Halfabrikaat of Stock over kinderen
 . If '$D(%SchaduwPPLRecurse(PRNr)) Do
 . . New GrOrde,StartRecurse
 . . Set:'$D(%SchaduwPPLRecurse) %SchaduwPPLRecurse=PRNr
 . . Set %SchaduwPPLRecurse(PRNr)=""
 . . Set:StartRecurse %SchaduwPPLRecurse=PRNr ; Start product
 . . Do CALC^PRBS(PRNr,.PRBS,,,,"S")
 . . Kill %SchaduwPPLRecurse(PRNr)
 . . Kill:%SchaduwPPLRecurse=PRNr %SchaduwPPLRecurse ; Start product
 . . Set SchaduwPPL=$P(PRBS,D)
 . . Set J=$O(^KPR(PRNr,"J")),R=^(J),GrOrde=$P(R,D,28)
 . . Set GrOrde=$S(GrOrde="M":1000,GrOrde="H":100,1:1)
 . . Set SchaduwPPL=+$J(SchaduwPPL*GrOrde,0,2)
 . Else  Do ; Recursie probleem
 . . Set R=^KPR(PRNr,2),SchaduwPPL=$P(R,D,3) ; best mogelijke waarde
 . . ; Mail versturen van de fout
 . . ; Hoofdnood is start product
 . . Set Body=$$ArrayToText^vhLib("%SchaduwPPLRecurse")
 . . Set From="System@vanhoecke.be"
 . . Set Subj="KPRIJS - recursie probleem in bouwstenen"
 . . Set To=$LB("pv@vanhoecke.be")
 . . Do SendMiniMail^vhLib(From,To,Subj,Body,,,,,)
 Else  Set R=^KPR(PRNr,2),SchaduwPPL=$P(R,D,3)
 Do:'$G(ForceSchaduwPPL)  ; Leeg indien SchaduwPPL = PPL
 . Set J=$O(^KPR(PRNr,"J")),R=^(J),PPL=$P(R,D,19)
 . Set:+PPL=+SchaduwPPL SchaduwPPL=""
 Quit SchaduwPPL