PRUCALC ;Tijdelijk 13/8/97 Herekenen van de prijsuitzonderingen voor een produkt zodat de verkoopprijs voor die klant gelijk blijft [ 11/06/2001  3:49 PM ]
 
 ; D KLANT^PVSCHADBKK(11708) 
 ;Vul alle shaduwuitzonderingen in volgens de huidige prijszetting van een klant
KLANT(KLNr)
 If '$G(KLNr) Set KLNr=$$SELECT^KLANT6()
 Do DELOBJ^KLPUTZ(KLNr,"N")
 Set PRNr=0
 For  Set PRNr=$O(^KSTKL(KLNr,PRNr)) Quit:PRNr=""  Do
 . Quit:$O(^KSTKL(KLNr,PRNr,"2007.07 "))=""
 . Quit:'$D(^KPR(PRNr))
 . Set Korting=$$BepaalKorting(KLNr,PRNr)
 . Quit:Korting="QUIT"
 . Do SetUitzondering(KLNr,PRNr,Korting,"N")
 Quit
 
 ; Opslaan van shaduw uitzondering
SetUitzondering(KLNr,PRNr,Korting,NoSa)
 New KHS,KGS,KSS
 Set RecI=$O(^KPR(PRNr,"I"))
 Quit:$E(RecI)'="I"
 Set RecI=^KPR(PRNr,RecI)
 Set KHS=$P(RecI,D,1)
 Set KGS=$P(RecI,D,2)
 Set KSS=$P(RecI,D,3)
 Set ^KLPUTZ(NoSa,KLNr,KHS,KGS,KSS,PRNr,0)=Korting_D_D_"System"_D_PRNr
 Set ^KLPUTZ("I"_NoSa,KHS,KGS,KSS,PRNr,KLNr)=""
 Quit
 
 ; Bepalen van de schaduwkorting zodanig dat de huidige prijs wordt bereikt
BepaalKorting(KLNr,PRNr)
 Set HPrijs=$G(^RPLSCHAD("K"_KLNr,"SPVC",PRNr,"OP")) ;$$KLANTPR^KPRIJS(KLNr,PRNr)
 If HPrijs="" Do 
 . Set StatRec=$G(^KSTKL(KLNr,PRNr,0))
 . Quit:StatRec=""
 . Set $P(HPrijs,D,14)=$P(StatRec,D,2)/$S($E($P(StatRec,D,3))="H":100,1:1)
 . w PRNr," ",$P(^KPR(PRNr,0),D)," ",HPrijs,!
 Quit:HPrijs="" "QUIT"
 Set SRec=$$PRIJSGEG^KPRIJS(PRNr,"N")
 Set LijstPrijsS=$P(SRec,D,15) ; Lijstprijs in EUR/st
 Set VerkoopPrijs=$P(HPrijs,D,14) ; Verkoopprijs in EUR/st
 Quit:+LijstPrijsS=0 0
 Set KortingS=1-(VerkoopPrijs/LijstPrijsS)
 Set KortingS=+$J(KortingS*100,0,12)
 Quit KortingS