RECUPVP ; Recupereerbare verpakking [ 02/07/2003  11:42 AM ]
 ;
 ; *** Verouderde routine, niet meer gebruikt! ***
 ;
 ; Bepalen van de recupereerbare verpakkingen (+ saldo's)
RVPNR(BONNr) 
 New J,R,KLNr,PRNr,RVPPRNr,RVPNr,Aantal,Fixed,ProdVerp,StockUpd
 Set RVPPRNr=""
 Set RVPNr="",KLNr=$P(^KU1(BONNr,"F"),D),BLNr=100 ; Cumul per verpakkingsprodukt, produkt
 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)
 .Set StockUpd=$P(R,D,14)'["S" Set:StockUpd StockUpd=$P(R,D,14)'["Z"
 .Quit:'PRNr  Quit:'StockUpd
 .Set J=$O(^KPR(PRNr,"J"))
 .Quit:$E(J)'="J"
 .Set R=^KPR(PRNr,J),RVPPRNr=$P(R,D,32),ProdVerp=$P(R,D,33)
 .Set:RVPPRNr RVPNr(RVPPRNr,PRNr)=$G(RVPNr(RVPPRNr,PRNr))+Aantal_D_ProdVerp
 Set RVPPRNr="" ; Ophalen saldo's
 For  Set RVPPRNr=$O(^HISTPAK("D",KLNr,RVPPRNr)) Quit:RVPPRNr=""  Do
 .Set R=$P(^HISTPAK("D",KLNr,RVPPRNr),D,1,2)
 .Set:$P(R,D) RVPNr(RVPPRNr)=R
 Set RVPPRNr="" ; Kontrole fixed per verpakkingsprodukt, produkt
 For  Set RVPPRNr=$O(RVPNr(RVPPRNr)) Quit:'RVPPRNr  Do
 .Set PRNr=""
 .For  Set PRNr=$O(RVPNr(RVPPRNr,PRNr)) Quit:'PRNr  Do
 ..Set R=RVPNr(RVPPRNr,PRNr),Aantal=$P(R,D),ProdVerp=$P(R,D,2)
 ..If 'ProdVerp Set R="\?"
 ..Else  Do
 ...Xecute "Set $P(R,D)=Aantal"_$S(Aantal<0:"-",1:"+")_"(ProdVerp-.1)\ProdVerp"
 ...Set $P(R,D,2)=$S('(Aantal#ProdVerp):"F",1:"V")
 ..Set RVPNr(RVPPRNr,PRNr)=R
 Set RVPPRNr="" ; Kontrole fixed per verpakkingsprodukt
 For  Set RVPPRNr=$O(RVPNr(RVPPRNr)) Quit:'RVPPRNr  Do
 .Set (PRNr,Fixed)="",Aantal=0
 .For  Set PRNr=$O(RVPNr(RVPPRNr,PRNr)) Quit:'PRNr  Do
 ..Set R=RVPNr(RVPPRNr,PRNr),Aantal=Aantal+$P(R,D)
 ..Set:"F"[Fixed Fixed=$P(R,D,2) Set:$P(R,D,2)="?" Fixed=$P(R,D,2)
 .Set:Fixed="" Fixed="S"
 .Set R=$TR($G(RVPNr(RVPPRNr)),D,"#"),$P(R,"#",3)=Aantal,$P(R,"#",4)=Fixed,RVPNr(RVPPRNr)=R
 Set RVPPRNr=""
 For  Set RVPPRNr=$O(RVPNr(RVPPRNr)) Quit:'RVPPRNr  Set RVPNr=RVPNr_D_RVPPRNr_"#"_RVPNr(RVPPRNr)
 Set $E(RVPNr)=""
 Quit RVPNr
 ;
 ; Invullen van de recupereerbare verpakking in een bon
BLDBON(BONNr) 
 New J,R,RVPNr,RVPPRNr,Aantal,Fixed,Saldo,TijsStip
 Set KLNr=$P(^KU1(BONNr,"F"),D)
 Lock +^KUL(KLNr,"F",BONNr,"VP")
 Kill ^KUL(KLNr,"F",BONNr,"VP")
 Set RVPNr=$$RVPNR(BONNr)
 For  Quit:RVPNr=""  Do
 .Set R=$P(RVPNr,D),RVPNr=$P(RVPNr,D,2,99)
 .Set RVPPRNr=$P(R,"#"),R=$TR($P(R,"#",2,99),"#",D)
 .Set ^KUL(KLNr,"F",BONNr,"VP",RVPPRNr)=R
 Lock -^KUL(KLNr,"F",BONNr,"VP")
 Quit
 ;
 ; Opbouwen van de historiek recupereerbare verpakking
BLDHIST(KLNr,PRNr,Geleverd,Fixed,Terug,FANr,Opm) 
 New R,Saldo
 Lock +^HISTPAK("D",KLNr,PRNr)
 Set Geleverd=$G(Geleverd),Fixed=$G(Fixed),Terug=$G(Terug),FANr=$G(FANr),Opm=$G(Opm)
 Set R=$G(^HISTPAK("D",KLNr,PRNr)),Saldo=$P(R,D)
 Set TijdStip=$H,R=Saldo+Geleverd-Terug_D_TijdStip,^HISTPAK("D",KLNr,PRNr)=R
 If 'Geleverd,Fixed="S",'Terug ; Historiek zonder beweging niet opslaan
 Else  Do
 .For  Set R=$G(^HISTPAK("D",KLNr,PRNr,"H",TijdStip)) Quit:R=""  Set $P(TijdStip,",",2)=$P(TijdStip,",",2)+1
 .Set R=Saldo_D_Geleverd_D_Fixed_D_Terug_D_FANr_D_Opm,^HISTPAK("D",KLNr,PRNr,"H",TijdStip)=R
 Lock -^HISTPAK("D",KLNr,PRNr)
 Quit
 ;
 ; Opbouwen recupereerbare verpakking voor fakturatie
BLDFAKT(BONNrs,RecupVp) 
 New R,RVPPRNr,BONNr,KLNr,Gelev,Fixed,Terug,Opm,LD,RVPList,Count,SortKey,TotGelev,TotTerug,Input
 Kill RecupVp
 Set (BONNr,K)=""
 For  Set BONNr=$O(BONNrs(BONNr)) Quit:BONNr=""  Do
 .Set KLNr=$P(^KU1(BONNr,"F"),D),RVPPRNr=""
 .For  Set RVPPRNr=$O(^KUL(KLNr,"F",BONNr,"VP",RVPPRNr)) Quit:RVPPRNr=""  Do
 ..Set SortKey=$$SORTKEY^PRODUKT(RVPPRNr)
 ..Set R=^KUL(KLNr,"F",BONNr,"VP",RVPPRNr),Gelev=$P(R,D,3),Fixed=$P(R,D,4)
 ..Set Terug="" Set:Gelev<0 Terug=-Gelev,Gelev=0
 ..Set RecupVp("S",SortKey)=RVPPRNr,RecupVp("S",SortKey,BONNr)=Gelev_D_Fixed_D_Terug
 Do:$D(RecupVp)
 .Set SortKey="",Count=0,Fixed=""
 .For  Set SortKey=$O(RecupVp("S",SortKey)) Quit:SortKey=""  Do
 ..Set RVPPRNr=RecupVp("S",SortKey),BONNr="",(TotGelev,TotTerug)=0
 ..For  Set BONNr=$O(RecupVp("S",SortKey,BONNr)) Quit:BONNr=""  Do
 ...Set R=RecupVp("S",SortKey,BONNr),TotGelev=TotGelev+$P(R,D),TotTerug=TotTerug+$P(R,D,3)
 ...If Fixed=""!(Fixed="S")!(Fixed="F") Set Fixed=$P(R,D,2)
 ...Set R=RVPPRNr_D_BONNr_D_R,RVPPRNr="",Count=Count+1,RecupVp(Count)=R
 ..Set R=RecupVp("S",SortKey)_"\T\"_TotGelev_D_Fixed_D_TotTerug,Count=Count+1,RecupVp(Count)=R
 .Kill RecupVp("S")
 .Do INIT^vhLIST("FAKTURATIE","RECUPVP",.LD),WRITE^vhLIST(.LD),MOVE^vhLIST(.LD,"DO",1)
 .Set Input="ENTER"
 .For  Do  Quit:Input="CANC"  Quit:Input="F"
 ..If Input="ENTER"
 ..Else  Set Input=$$SCROLL^vhLIST(.LD)
 ..Do:Input="COM" CALL^vhMenu("FAKTRVP")
 ..Do EXEC^vhMenu("FAKTRVP",.Input)
 .Set:Input'="F" K="-"
 Quit
 ;
 ; Wijzigen recupereerbare verpakking voor fakturatie
MODFAKT 
 New %SC,sFL,OldSaldo
 Set sFL(1)=RecupVp(LD("SELECT")),OldSaldo=$P($G(^HISTPAK("D",KLNr,$P(sFL(1),D))),D)
 Do NIEUW^vhScherm("FAKTRVP","","","","","",3)
 If %SC Do
 .Set RecupVp(LD("SELECT"))=sFL(1)
 .Do ENABLE^vhLIST(.LD,LD("SELECT"),1)
 .Set Input=$S(LD("SELECT")=LD("MAX"):"",1:"ENTER")
 .Do MOVE^vhLIST(.LD,"DO",1)
 Else  Set Input=""
 Quit
 ;
 ; Verwerken recupereerbare verpakking voor fakturatie
VERWFAKT(KLNr,RecupVp,FANr) 
 New R,RVPPRNr,Gelev,Fixed,Terug,Opm,Count,Datum
 For Count=1:1 Quit:'$D(RecupVp(Count))  Do
 .Set R=RecupVp(Count)
 .Quit:$P(R,D,2)'="T"
 .Set RVPPRNr=$P(R,D),Gelev=$P(R,D,3),Fixed=$P(R,D,4),Terug=$P(R,D,5),Opm=$P(R,D,6)
 .Do BLDHIST(KLNr,RVPPRNr,Gelev,Fixed,Terug,FANr,Opm) 
 .If 'Gelev,'Terug
 .Else  Do
 ..Set R=$G(^KFA("F",FANr,0,0)),Datum=$P(R,D,6)
 ..Do BLD^STAT(KLNr,RVPPRNr,Datum,Gelev-Terug,,,,,,,,,,1) 
 .Do PRHIST(KLNr,RVPPRNr,FANr,Gelev,Terug) 
 Quit
 ;
 ; Opbouwen van de produkthistoriek
PRHIST(KLNr,PRNr,FANr,Gelev,Terug) 
 New R,PR,FaktDat,Waarde,ModHist,IsEuro,PrijsEUR,ProfFakt
 Set Gelev=$G(Gelev),Terug=$G(Terug)
 Set IsEuro=$$ISEURO^vhRtn1()
 Set PR=PRNr,R=$G(^KFA("F",FANr,0,0))
 Set:KLNr'=$P(R,D) R=$G(^KFAP("F",FANr,0,0))
 If KLNr=$P(R,D) Do
 .Set FaktDat=$P(R,D,6)
 .Set R=^KPR(PRNr,0),ModHist=$P(R,D,15)
 .Set PrijsEUR=0,R=$O(^KPR(PRNr,"J")) Set:$E(R)="J" R=^KPR(PRNr,R) Set ProfFakt=$P(R,D,34)
 .Set:ProfFakt="F" R=$$KLANTPR^KPRIJS(KLNr,PRNr),PrijsEUR=$P(R,D,14)
 .Do:Gelev
 ..Set Waarde=PrijsEUR*Gelev
 ..Set R=$$CONVDATE^vhLib.DataTypes(FaktDat,,"DSN")_2,$P(R,D,12)=""
 ..Set $P(R,D,2)=Gelev,$P(R,D,4)=1,$P(R,D,5)=$J(Waarde,0,$S(IsEuro:4,1:2))
 ..Set $P(R,D,7)=ModHist,$P(R,D,8)="#F"_FANr
 ..Do ^KPR10
 ..Do PUT^PRHIST(PRNr,-Gelev,"U",,KLNr,,,$$INTDATE^vhLib.DataTypes(FaktDat))
 .Do:Terug
 ..Set Waarde=PrijsEUR*-Terug
 ..Set R=$$CONVDATE^vhLib.DataTypes(FaktDat,,"DSN")_2,$P(R,D,12)=""
 ..Set $P(R,D,2)=-Terug,$P(R,D,4)=1,$P(R,D,5)=$J(Waarde,0,$S(IsEuro:4,1:2))
 ..Set $P(R,D,7)=ModHist,$P(R,D,8)="#F"_FANr
 ..Do ^KPR10
 ..Do PUT^PRHIST(PRNr,Terug,"R",,KLNr,,,$$INTDATE^vhLib.DataTypes(FaktDat))
 Quit
 ;