kprijss ;Produkt prijs ;[ 12/12/2001  2:42 PM ]
 Quit
 ;
KLANTPR(KLNr,PRNr,NoSa) 
 New R,KatProd,IsKatPr,FaMunt,Munt,MuntPar
 New VkpPr,Korting1,Korting2,KortNiv,AkpEUR,VkpEUR,LijstEUR
 ; Opgezet via GETCUST
 New KlMunt,KlTyp,NetBrutP,PrijsKl,IsKsCust
 ; 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)
 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
 Quit $$BUILD
 ;
 ; KlTyp 0=Industrie, 1=handel, P=prijslijst
PROD(PRNr,Korting1,Korting2,KlMunt,NetBrutP,KlTyp,NoSa) 
 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
 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=""
 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,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 R=^KKL(KlantId,1),KlTyp=$P(R,D,25)
 Set R=^KKL(KlantId,2),PrijsKl=$P(R,D,3),NetBrutP=$P(R,D,5)
 If NoSa="S",$L($P(R,D,25)) Set PrijsKl=$P(R,D,25)
 Set IsKsCust=$$ISKLANT^KS(KLNr,,NoSa)
 Quit
 ;
GETPROD(PRNr,NoSa) 
 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 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
 ;