TTPRIJS ;Produkt prijs ;[ 02/01/2001  8:31 AM ]
 ;
 ; Afronding
RND(VrkPrs,Round,Munt) 
 If "R"[Round Quit $$AUTORND(VrkPrs,Munt)
 If Round=1 Set VrkPrs=$J(VrkPrs*100+.499999,0,0)/100
 If Round=2 Set VrkPrs=VrkPrs+.049999*100\5*5/100
 If Round<3 Quit $J(VrkPrs,0,2)
 If Round=3 Quit VrkPrs+.99999\1
 If Round=4 Quit VrkPrs+4.99999\5*5
 If Round=5 Quit VrkPrs\1 ; Afronden naar beneden TIJDELIJK
 If Round=6 Quit $J(VrkPrs,0,2)
 If Round=7 Quit $J($J(VrkPrs,0,1),0,2)
 If Round=8 Quit $J(VrkPrs,0,0)
 If Round=9 Quit $J(VrkPrs/5,0,0)*5
 Quit VrkPrs
 ;
 ; Automatische afronding
AUTORND(VrkPrs,Munt) 
 New ABdCfrs,FaMunt
 Set FaMunt=$$FADEF^vhRtn1(),ABdCfrs=3-($L(VrkPrs*1000\1)-3)
 Set:ABdCfrs>$S(Munt=FaMunt:2,1:2) ABdCfrs=$S(Munt=FaMunt:2,1:2)
 ;Set:ABdCfrs>$S(Munt=FaMunt:1,1:2) ABdCfrs=$S(Munt=FaMunt:1,1:2)
 Set VrkPrs=VrkPrs*(10**ABdCfrs)+.999999\1/(10**ABdCfrs)
 Quit VrkPrs
 ;
PRIJS ; prijsroutine
 New S,FaMunt
 Set S="CIFPPL",@S=$$RND(@S,AFR,$S(KV="MTL":UMC,1:KV))
 Set FaMunt=$$FADEF^vhRtn1(),PLPFaMnt=PLP/AFE,PLP=PLP/UPAR,PVK=PVK/UPAR
 If '$L(PK1)&(PLP) Do
 .Set UEP=PLP-(PVK*KPC/100),PK1=1-(UEP/PLP)*100
 .If KKN!(AFR="R") Do  Quit
 ..Set S="PLP",@S=@S*AFE,@S=$$RND(@S,AFR,$S(KV="MTL":UMC,1:KV))
 ..Set UEP=$J(PLP*(100-$J(PK1,0,2))/100,0,$S(KV=FaMunt&(AFR="R"):0,1:2))
 .For S="PLP","UEP","PLPFaMnt" Set @S=@S*AFE,@S=$$RND(@S,AFR,$S(KV="MTL":UMC,1:KV))
 Else  Do
 .If KKN!(AFR="R") Set S="PLP",@S=@S*AFE,@S=$$RND(@S,AFR,$S(KV="MTL":UMC,1:KV))
 .Set UEP=PLP*(100-PK1)/100 If PK2 Set UEP=UEP*(100-PK2)/100
 .If KKN!(AFR="R") Set UEP=$J(UEP,0,$S(KV=FaMunt&(AFR="R"):0,1:2))
 .Else  For S="PLP","UEP","PLPFaMnt" Set @S=@S*AFE,@S=$$RND(@S,AFR,$S(KV="MTL":UMC,1:KV))
 Set UEPFaMnt=$J(UEP/AFE*UPAR,0,2)
 Quit
 ;
PROD(PRNr,PK1,PK2,KV,KKN,KYW,NoSa) 
 ;ProduktNr,Korting1,Korting2,Munt(ook MTL),IsBrutto,IsHandel,Normaal/Schaduw
 New R,AFA,AFE,AFR,KPC,KPL,KKD,PKP,PLP,PPL,PPLYW,PVK,UEP,UMC,UPAR,USP
 New PEA,PPLS,PKS,PVKS,PWS,PCPS,CIFPPL,CIFPPLS,UEPFaMnt,PLPFaMnt,FaMunt
 Set KKN=$G(KKN),KYW=$G(KYW),FaMunt=$$FADEF^vhRtn1()
 If "N"[$G(NoSa) Set NoSa=""
 Set:KV="" KV=FaMunt
 Set KPL="" If "CPLRSBG"[PK1 Set KPL=PK1,PK1=""
 Set R=^KPR(PRNr,1),PPL=$P(R,D,19),PPLYW=$P(R,D,18) Set:KYW&'PPLYW PPL="" Set PKP=$L(PPL)
 Set KKD=""
 If PPL="" Set PPL=KPL
 Set KPC=$P("0\0\-100\-10\0\25\50\75\100",D,$F("CPLRSBG",PPL)+1)
 Set R=$O(^KPR(PRNr,"J")) Set:$E(R)="J" R=^KPR(PRNr,R)
 Set PLP=$P(R,D,25),CIFPPL=$P(R,D,23),PVK=$P(R,D,26),UMC=$P(R,D,17)
 Set:KV'="MTL" UMC=KV Set UPAR=$$MUNT^vhRtn1(UMC,,12)
 If NoSa="S" Do
 .Set PEA=$P(R,D,28) Set PEA=$S("E"[PEA:1,PEA="H":100,PEA="M":1000,1:0)
 .Set PPLS=$P(R,D,19),PKS=$P(R,D,9),PVKS=$P(R,D,27),PWS=$P(R,D,24),PCPS=$P(R,D,21)
 .Set R=^KPR(PRNr,2) Set:$L($P(R,D,3)) PPLS=$P(R,D,3) Set:$L($P(R,D,4)) PKS=$P(R,D,4)
 .Set:$L($P(R,D,5)) PVKS=$P(R,D,5) Set:$L($P(R,D,6)) PWS=$P(R,D,6) Set:$L($P(R,D,7)) PCPS=$P(R,D,7)
 .Set PPLS=PPLS/PEA
 .If FaMunt'[UMC S R=$$MUNT^vhRtn1(UMC,,11,"S"),PPLS=PPLS*R
 .Set CIFPPLS=PPLS*(100-PKS)/100*(100+PCPS)/100,CIFPPLS=$J(CIFPPLS,1,4) Set:'CIFPPLS PWS=0
 .Set R=CIFPPLS/(100-PWS/100)*PWS/100,R=$J(R,1,4),PLP=CIFPPLS+R
 .Set PVK=CIFPPLS+R*PVKS/100,PVK=$J(PVK,1,4),CIFPPL=CIFPPLS
 .If $D(^KBA("S",11,UMC)) Set:KV'="MTL" UMC=KV Set UPAR=$P(^KBA("S",11,UMC),D,3,5),UPAR=$P(UPAR,D,3)/$P(UPAR,D,1)
 Set USP=$$GETROUND^PRODUKT2(PRNr,KV)
 Set AFA=$E(USP,1),AFR=$E(USP,2),AFE=$P("1\100\1000",D,$F("EHM",AFA)-1)
 Do PRIJS
 Set R=UEP_D_UMC_D_AFA_D_PLP_D_PK1_D_PK2_D_KKD_D_PKP_D_UPAR_D_USP_D_AFE_D_AFR_D_CIFPPL_D_UEPFaMnt_D_PLPFaMnt_D
 ;      1     2     3     4     5     6     7     8      9     10    11    12     13       14      15
 Quit R ; prijs, munt, eenheid, lijstprijs, korting1, korting2, codex, katprijs, pariteit, afrondingsregel, eenheid(numeriek), round, aankpr(BEF), prijs(BEF), lijstprijs(BEF)
 
 ;
KLANTPR(KLNr,PRNr,NoSa) 
 New R,KlantInd,AFA,AFE,AFR,KPC,KPL,KV,KYW,PK1,PK2,KKD,PKP,PLP,PPL,PPLYW,PVK,UEP,UMC,UPAR,USP
 New PEA,PPLS,PKS,PVKS,PWS,PCPS,CIFPPL,CIFPPLS,UEPFaMnt,PLPFaMnt,FaMunt
 Set FaMunt=$$FADEF^vhRtn1()
 If "N"[$G(NoSa) Set NoSa=""
 Set KlantInd=^KK1(KLNr),R=^KKL(KlantInd,0),KV=$P(R,D,11) Set:KV="" KV=FaMunt
 Set KYW=$$IsHandel^KLANT5(KLNr)
 Set R=^KKL(KlantInd,2),KPL=$P(R,D,3) If '$D(KKN) New KKN Set KKN=$P(R,D,5)
 If NoSa="S",$L($P(R,D,25)) Set KPL=$P(R,D,25)
 Set R=^KPR(PRNr,1),PPL=$P(R,D,19),PPLYW=$P(R,D,18) Set:KYW&'PPLYW PPL="" Set PKP=$L(PPL)
 Set KKD="",R=$$KORTPC^KORTING(KLNr,PRNr,NoSa),PK1=$P(R,D),PK2=$P(R,D,2)
 If $P(R,D,3)'="P" Set KKD=1 If $L(PPL) Set (PK1,PK2,KKD)=""
 If PPL="" Set PPL=KPL
 Set KPC=$P("0\0\-100\-10\0\25\50\75\100",D,$F("CPLRSBG",PPL)+1)
 Set R=$O(^KPR(PRNr,"J")) Set:$E(R)="J" R=^KPR(PRNr,R)
 Set PLP=$P(R,D,25),CIFPPL=$P(R,D,23),PVK=$P(R,D,26),UMC=$P(R,D,17)
 Set:KV'="MTL" UMC=KV Set UPAR=$$MUNT^vhRtn1(UMC,,12)
 If NoSa="S" Do
 .Set PEA=$P(R,D,28) Set PEA=$S("E"[PEA:1,PEA="H":100,PEA="M":1000,1:0)
 .Set PPLS=$P(R,D,19),PKS=$P(R,D,9),PVKS=$P(R,D,27),PWS=$P(R,D,24),PCPS=$P(R,D,21)
 .Set R=^KPR(PRNr,2) Set:$L($P(R,D,3)) PPLS=$P(R,D,3) Set:$L($P(R,D,4)) PKS=$P(R,D,4)
 .Set:$L($P(R,D,5)) PVKS=$P(R,D,5) Set:$L($P(R,D,6)) PWS=$P(R,D,6) Set:$L($P(R,D,7)) PCPS=$P(R,D,7)
 .Set PPLS=PPLS/PEA
 .If FaMunt'[UMC S R=$$MUNT^vhRtn1(UMC,,11,"S"),PPLS=PPLS*R
 .Set CIFPPLS=PPLS*(100-PKS)/100*(100+PCPS)/100,CIFPPLS=$J(CIFPPLS,1,4) Set:'CIFPPLS PWS=0
 .Set R=CIFPPLS/(100-PWS/100)*PWS/100,R=$J(R,1,4),PLP=CIFPPLS+R
 .Set PVK=CIFPPLS+R*PVKS/100,PVK=$J(PVK,1,4),CIFPPL=CIFPPLS
 .If $D(^KBA("S",11,UMC)) Set:KV'="MTL" UMC=KV Set UPAR=$P(^KBA("S",11,UMC),D,3,5),UPAR=$P(UPAR,D,3)/$P(UPAR,D,1)
 Set USP=$$GETROUND^PRODUKT2(PRNr,KV)
 Set AFA=$E(USP,1),AFR=$E(USP,2),AFE=$P("1\100\1000",D,$F("EHM",AFA)-1)
 Do PRIJS
 Set R=UEP_D_UMC_D_AFA_D_PLP_D_PK1_D_PK2_D_KKD_D_PKP_D_UPAR_D_USP_D_AFE_D_AFR_D_CIFPPL_D_UEPFaMnt_D_PLPFaMnt_D
 ;      1     2     3     4     5     6     7     8      9     10    11    12     13       14      15
 Quit R ; prijs, munt, eenheid, lijstprijs, korting1, korting2, codex, katprijs, pariteit, afrondingsregel, eenheid(numeriek), round, aankpr(BEF), prijs(BEF), lijstprijs(BEF)
 ;
LEVPR(LEVNr,PRNr,NoSa) 
 New R
 If "N"[$G(NoSa) Set NoSa=""
 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=^KPR(PRNr,2)
 .If $L($P(R,D,3)) Set AankPr=$P(R,D,3)
 .If $L($P(R,D,4)) Set Korting1=$P(R,D,4),Korting2=""
 Set Prijs=AankPr-(AankPr*Korting1/100),Prijs=Prijs-(Prijs*Korting2/100)
 Set R=Prijs_D_Munt_D_Eenheid_D_AankPr_D_Korting1_D_Korting2_"\\\\\"_$S(Eenheid="M":1000,Eenheid="H":100,1:1)
 Quit R ; prijs, munt, eenheid, lijstprijs, korting1, korting2, , , , , eenheid(numeriek), 
 ;
CHKPRIJS(PRNr,LijstPr,VerkPr,Eenheid,Pariteit,AankPr,WachtW,Position,TimeOut,Time) 
 New R,KortText,Ok
 Set WachtW=$G(WachtW),Position=$G(Position),TimeOut=$G(TimeOut),Time=$G(Time)
 Set LijstPr=$J(LijstPr/Eenheid*Pariteit,0,2),VerkPr=$J(VerkPr/Eenheid*Pariteit,0,2),Ok=1
 If VerkPr>LijstPr Do
 .Set KortText=$P(^KPR(PRNr,0),D)
 .Set R=$$^vhTXTPOP("KPRIJS","CHK-VERK-LIJST-PRIJS","",KortText)
 .If $L(WachtW) Set Ok=$$ASK^vhWACHTW(WachtW,Position,TimeOut,Time)
 If VerkPr<AankPr Do
 .Set KortText=$P(^KPR(PRNr,0),D)
 .Set R=$$^vhTXTPOP("KPRIJS","CHK-VERK-AANK-PRIJS","",KortText)
 .If $L(WachtW) Set Ok=$$ASK^vhWACHTW(WachtW,Position,TimeOut,Time)
 Quit Ok
 ;