pvpreur ;Produkt prijs ;[ 08/29/2001  12:29 PM ]
 ;
 ; 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:PK1="P" PK1="L" Set:KV="" KV=FaMunt
 Set R=^KPR(PRNr,1),PPL=$P(R,D,19),PPLYW=$P(R,D,18)
 If "\E\K\"[(D_PK1_D),'$L(PPL) Set PK1=$$KSKORT(PRNr,PK1,NoSa),PK2=""
 Set KPL="" If "EKLSG"[PK1 Set KPL=PK1,PK1=""
 Set:KYW PPL=PPLYW
 Set PKP=$L(PPL)
 Set KKD=""
 If PPL="" Set PPL=KPL
 Set KPC=$P("0\0\0\50\100",D,$F("LSG",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 LevNr=$P(R,D,1)
 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
 .Set:$L($P(^KPR(PRNr,1),D,3)) UMC=$P(^KPR(PRNr,1),D,3) ; Schaduw munt ingevuld
 .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
 ;Set:KV'="MTL" UMC=KV
 If KV'="MTL" Set UMC=KV
 Else  Set UMC=$P(^KLE(^KL1(LevNr),0),D,11) Set:UMC="" UMC=FaMunt
 Set UPAR=$$MUNT^vhRtn1(UMC,,12,"S")
 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 KV="EUR"
 If NoSa="S",$L($P($G(^KKL(KlantInd,7)),D,8))=3 Set KV=$P(^KKL(KlantInd,7),D,8)
 Set R=^KKL(KlantInd,1),KYW=$P(R,D,25)
 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:KPL="P" KPL="L"
 Set R=^KPR(PRNr,1),PPL=$P(R,D,19),PPLYW=$P(R,D,18)
 Set:KYW PPL=PPLYW
 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\0\50\100",D,$F("LSG",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 LevNr=$P(R,D,1)
 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
 .Set:$L($P(^KPR(PRNr,1),D,3)) UMC=$P(^KPR(PRNr,1),D,3) ; Schaduw munt ingevuld
 .Set UMC="EUR"
 .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 KV'="MTL" Set UMC=KV
 Else  Set UMC=$P(^KLE(^KL1(LevNr),0),D,11) Set:UMC="" UMC=FaMunt
 Set UPAR=$$MUNT^vhRtn1(UMC,,12,"S")
 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
 Quit R
 ; 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(BEF),14:prijs(BEF),15:lijstprijs(BEF)
 
CIFPPLPR(PRNr,NoSa) 
 New Key,PRec,SRec,PPL,Kort,Cif,Munt,GO
 Set Key=$O(^KPR(PRNr,"J")) Quit:Key="" 0
 Set PRec=^KPR(PRNr,Key)
 Set GO=$P(PRec,D,28),PPL=$P(PRec,D,19),Munt=$P(PRec,D,17),Kort=$P(PRec,D,9),Cif=$P(PRec,D,21)
 If $G(NoSa)="S" Do
 .Set SRec=^KPR(PRNr,2)
 .Set:$L($P(SRec,D,3)) PPL=$P(SRec,D,3)
 .Set:$L($P(SRec,D,4)) Kort=$P(SRec,D,4)
 .Set:$L($P(SRec,D,7)) Cif=$P(SRec,D,7)
 .Set:$L($P(^KPR(PRNr,1),D,3)) Munt=$P(^KPR(PRNr,1),D,3)
 Goto CIFPPL2
 
CIFPPL(PPL,GO,Munt,Kort,Cif,NoSa) 
CIFPPL2 Set:$G(Munt)="" Munt=$$FADEF^vhRtn1()
 Set PPL=PPL/$S(GO="M":1000,GO="H":100,1:1)/$$MUNTPAR^vhRtn1(Munt,1,$G(NoSa))
 Set PPL=PPL*(1-(Kort/100))*(1+(Cif/100))
 Quit PPL ; in BEF/stuk
 
MAN(CIFPPL,PK1,PK2,KV,KKN,KYW) 
 
 ;
LEVPR(LEVNr,PRNr,NoSa) 
 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=^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:$L($P(^KPR(PRNr,1),D,3)) Munt=$P(^KPR(PRNr,1),D,3)
 Set MuntPar=$$MUNT^vhRtn1(Munt,,11,"S")
 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 ; prijs, munt, eenheid, Aankprijs, korting1, korting2, , , Pariteit, , eenheid(numeriek), , Prijs(BEF)
 ;
CHKPRIJS(PRNr,LijstPr,VerkPr,Eenheid,Pariteit,AankPr,WachtW,Position,TimeOut,Time,Check) 
 New R,KortText,Ok
 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)
 .If $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)
 .If $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
 .Set KortText=$P(^KPR(PRNr,0),D)
 .Set R=$$^vhTXTPOP("KPRIJS","CHK-VERK-AANK-PRIJS","",KortText,$J(VerkPr,0,2))
 .If $L(WachtW) Set Ok=$$ASK^vhWACHTW(WachtW,Position,TimeOut,Time)
 Else  If Check["V",VerkPr>LijstPr 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))
 .If $L(WachtW) Set Ok=$$ASK^vhWACHTW(WachtW,Position,TimeOut,Time)
 Quit Ok
 ;
KSKORT(PRNr,Korting,NoSa) 
 New R,KSDB
 If '$G(PRNr) Set KSDB=20
 Else  Do
 .If "N"[$G(NoSa) Set 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
 ;