; Routines speciaal Peter Van Driessche
 Quit
 ;
StockSaneringViaProforma
 New R,File,KLNr,Date,PROFNr,BONNr,PROFLNr,StockSan,PRNr,Aantal,KortTekst,CifPPL
 Set File=$$OPEN^vhDEV(,"StockSanering.Txt","NW")
 Do:0'[File
 . Use File
 . Write "Proforma",$C(9),"Datum",$C(9),"Product",$C(9),"Korttekst",$C(9),"Aantal",$C(9),"CifPPL",$C(10)
 . Set KLNr=4682,Date=""
 . For  Set Date=$O(^KFAP1("F",KLNr,Date)) Quit:Date=""  Quit:(-Date<61908)  Do
 . . Set PROFNr=""
 . . For  Set PROFNr=$O(^KFAP1("F",KLNr,Date,PROFNr)) Quit:PROFNr=""  Do
 . . . Set BONNr="U"
 . . . For  Set BONNr=$O(^KFAP("F",PROFNr,BONNr)) Quit:$E(BONNr)'="U"  Do
 . . . . Set PROFLNr=100,StockSan=0
 . . . . For  Set PROFLNr=$O(^KFAP("F",PROFNr,BONNr,PROFLNr)) Quit:PROFLNr=""  Do
 . . . . . Set R=^KFAP("F",PROFNr,BONNr,PROFLNr)
 . . . . . Set:$P(R,D,17)="KF5" StockSan=$$UPCASE^vhRtn1(R)["STOCKSAN"
 . . . . . Quit:'StockSan
 . . . . . Set PRNr=$P(R,D,2),Aantal=$P(R,D,3)
 . . . . . Quit:'PRNr
 . . . . . Set KortTekst=$P($G(^KPR(PRNr,0)),D)
 . . . . . Set:KortTekst="" KortTekst=$P($G(^KPRO(PRNr,0)),D)
 . . . . . Set CifPPL=$$CifPPL(PRNr)
 . . . . . Write PROFNr,$C(9),$$EXTDATE^vhDTyp(-Date),$C(9),PRNr,$C(9),KortTekst,$C(9),Aantal,$C(9),$TR(CifPPL,".",","),$C(10)
 . Close File
 Quit
 
StockSaneringViaBon(BONNr)
 New R,File,KLNr,BLNr,PRNr,Aantal,KortTekst,CifPPL
 Set File=$$OPEN^vhDEV(,"StockSanering"_BONNr_".Txt","NW")
 Do:0'[File
 . Use File
 . Set KLNr=$P(^KU1(BONNr,"F"),D)
 . Write "Product",$C(9),"Korttekst",$C(9),"Aantal",$C(9),"CifPPL",$C(10)
 . Set BLNr=100
 . For  Set BLNr=$O(^KUL(KLNr,"F",BONNr,BLNr)) Quit:'BLNr  Do
 . . Set R=^KUL(KLNr,"F",BONNr,BLNr),PRNr=$P(R,D,2),Aantal=$P(R,D,3)
 . . Quit:'PRNr
 . . Set KortTekst=$P($G(^KPR(PRNr,0)),D)
 . . Set:KortTekst="" KortTekst=$P($G(^KPRO(PRNr,0)),D)
 . . Set CifPPL=$$CifPPL(PRNr)
 . . Write PRNr,$C(9),KortTekst,$C(9),Aantal,$C(9),$TR(CifPPL,".",","),$C(10)
 . Close File
 Quit
 
CifPPL(PRNr)
 New R,J,PrMunt,EenhAank,PPL,%Korting,%Cif,FaMunt,CifPPL
 Set R=""
 If $D(^KPR(PRNr)) Set J=$O(^KPR(PRNr,"J")) Set:$E(J)="J" R=^KPR(PRNr,J)
 Else  Set J=$O(^KPRO(PRNr,"J")) Set:$E(J)="J" R=^KPRO(PRNr,J)
 Set 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),%Cif=$P(R,D,21)
 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)
 Quit CifPPL