#include Prod.Product
 
PRBSC ;Product bouwstenen conversie/prijscontrole[ 12/16/2003  4:34 PM ]
 Quit
TAB
 Set L(30786)=19146
 Set L(30787)=19147
 Do CHANGE(.L,)
 Q
 
ChangeBepaalde ; Reverse L local
 S PRNr=174999
 For  Set PRNr=$O(^PRBS("IP",120209,PRNr)) Q:PRNr=""!(PRNr>175532)  Do
 . Write $P(^KPR(PRNr,0),D)," ",PRNr," ",!
 . Set Result=$$CONTROLE(PRNr)
 . Do DISPMSG(PRNr,Result,1)
 . ;Do CHANGE(.P,"V")
 Q
 
 
ASK(PRLijst) 
 New VanPRNr,NaarPRNr,K
 Set FP=2001
 Write @F,@F1,"Ingave VAN product (oud product)"
 Set VanPRNr=$$SELECT^PRODUKT6()
 Quit:VanPRNr'?4.7N
 Set FP=301
 Write @F,@F1," VAN : ",VanPRNr," ",$P(^KPR(VanPRNr,0),"\")
 Set FP=2001
 Write @F,@F1,"Ingave NAAR product (nieuw product)"
 Set NaarPRNr=$$SELECT^PRODUKT6()
 Quit:NaarPRNr'?4.7N
 Set FP=401
 Write @F,@F1,"NAAR : ",NaarPRNr," ",$P(^KPR(NaarPRNr,0),"\")
 Write !,"ENTER = Zoeken en vervangen    - =  Exit"
 Read K
 Quit:K="-"
 Set FP=501
 Write @F,@F1
 Set PRLijst(VanPRNr)=NaarPRNr
 Quit
 
 
 
CHANGE(PRLijst,Ask) ; Vervangen van oud product met nieuw product
 ; Via .Local doorgeven PRLijst(VanPRNr)=NaarPRNr
 ; Ask = "V" ; Vragen
 
 New MPRNr,BSCode,BSRec,KPRNr,Lock,%J
 Write @F11,@F1
 Write @FMTI," Product bouwstenen : Vervang product - ",QN," ",@FMTi
 If '$D(PRLijst) Do ASK(.PRLijst)
 Quit:'$D(PRLijst)
 Set:'$D(Ask) Ask=$$^vhTXTPOP("PRBS","CONTROLEALL")
 Set %J=$$%J^vhRtn1()
 Set KPRNr=""
 For  Set KPRNr=$O(PRLijst(KPRNr)) Quit:KPRNr=""  Do
 . Set MPRNr=""
 . For  Set MPRNr=$O(^PRBS("IP",KPRNr,MPRNr)) Quit:MPRNr=""  Do
 .. Do LOCK^PRBS(MPRNr,"NX") ; changes NoMod
 .. If NoMod Quit
 .. Do FETCH^PRBS(MPRNr)
 .. Set BSCode=""
 .. For  Set BSCode=$O(^PRBS("IP",KPRNr,MPRNr,BSCode)) Quit:BSCode=""  Do
 ... Set BSRec=^HULP(%J,"C",BSCode)
 ... Set $P(BSRec,D,1)=PRLijst(KPRNr)
 ... Set ^HULP(%J,"C",BSCode)=BSRec
 .. Do SAVE^PRBS(MPRNr)
 .. If Ask'="" Do
 ... Set:Ask="V" Result=$$CONTROLE(MPRNr)
 ... Set:Ask'="V" Result=$$CONTROLE(MPRNr,Ask)
 .. Do DISPMSG(MPRNr,$S(Ask="":"NO",1:Result),1)
 .. Lock -^PRBS("BS",MPRNr)
 Read !,"Einde (Druk op ENTER)",K
 Quit
 
DISPMSG(PRNr,Result,Move) 
 New sTop,sRight,sLeft
 If $G(Move) Do
 . Set sTop=7,sRight=80,sLeft=1
 . Do WMOVE^vhLIST(2,24,1)
 Set FP=2401
 Write @F,@F2,PRNr," ",$P($G(^KPR(PRNr,0),"***Onbekend***"),D)," "
 Set FP=2434 Write @F
 Set Chk=$P(Result,D,1)
 Write:Chk="PPL" "PPL gewijzigd"
 Write:Chk="SPPL" "S-PPL gewijzigd"
 Write:Chk="DB" "PPL en DB gewijzigd"
 Write:Chk="NIET" "PLL ongewijzigd"
 Write:Chk="NO" "geen controle"
 Write:Chk="OK" "PPL was OK"
 Write:Chk="ERROR" "Fout in berekening"
 If $P(Result,D,2) Do
 .Write "  O:",$P(Result,D,2)
 .Write " N:",$P(Result,D,3)
 Quit
 
LIJST
 Set Dev=0 
 ;Set Dev=$$OPEN^vhDEV(,"SOPRLIJST.TXT","W")
 Use Dev
 Set PRNr=0
 For  Set PRNr=$O(^KPR(PRNr)) Quit:PRNr=""  Do
 . Set IDNr=$P(^KPR(PRNr,2),D,25)
 . Set IdNr2=$E($TR(IDNr,".","")_" ",2,99)
 . Set SOPR=0
 . If ($E(IDNr)>0)&&($E(IDNr)<8) Set SOPR=1
 . Else  For I=1:1:7 If $D(^KPR2(I_IDNr2)) Set SOPR=1
 . Quit:'SOPR
 . Set Rec2=^KPR(PRNr,2)
 . Set SPPL=$P(Rec2,3)
 . Set SDB=$P(Rec2,4)
 . Set SCif=$P(Rec2,7)
 . Write PRNr,*9,$P(^KPR(PRNr,0),D),*9,$TR(SPPL,".",","),*9,$TR(SDB,".",","),$TR(SCif,".",","),!
 Close:0'[Dev Dev
 
CalcAllSchaduw ;Schaduw prijs invullend voor alle producten met bouwstenen
 New PRNr,sTop,sRight,sLeft,Meta
 Set NoMeta=1
 Set Dev=$$OPEN^vhDEV(,"Prijsvgl PRBS schaduw.txt","W")
 Use Dev
 Set PRNr=0
 For  Set PRNr=$O(^PRBS("BS",PRNr)) Quit:PRNr=""  Do
 . If '$D(^KPR(PRNr)) Do  Quit
 .. Do DELOBJ^PRBS(PRNr)
 . If '$G(NoMeta) Quit:$P(^PRBS("BS",PRNr),D,2)'=Meta
 . If $G(NoMeta) Quit:$$BouwSteenTypes^PRBS(PRNr)="K" ;Alleen kindproducten niet verwerken
 . Quit:$E(^KPR(PRNr,0),1,2)="OL" ; geen Orgalux
 . Set sTop=7,sRight=80,sLeft=1
 . Set Result=$$CONTROLE(PRNr,"S","S",1) ; Opslaan in Schaduw en Schaduw prijs berekening
 . Use Dev
 . Write PRNr,*9,$P(^KPR(PRNr,0),D,1),*9,$$$PRGet($$$PPLMTL),*9,$$$PRGet($$$SchaduwPPL),*9,Result,!
 . Use 0
 Close:0'[Dev Dev
 Quit
 
CTRALL(Ask,NoSa,NoMeta) ;Prijs controle
 New PRNr,sTop,sRight,sLeft,Meta
 Write @F11,@F1
 Write @FMTI," Product bouwstenen : Controle prijs - ",QN," ",@FMTi
 If '$G(NoMeta) Do
 . Set Meta=$$PI^vhPOPUP("C;C","KO1","Type","PRBS","META")
 . Quit:Meta=""
 Set:'$D(Ask) Ask=$$^vhTXTPOP("PRBS","CONTROLEALL")
 
 Set PRNr=0
 For  Set PRNr=$O(^PRBS("BS",PRNr)) Quit:PRNr=""  Do
 . If '$D(^KPR(PRNr)) Do  Quit
 .. Do DELOBJ^PRBS(PRNr)
 . If '$G(NoMeta) Quit:$P(^PRBS("BS",PRNr),D,2)'=Meta
 . If $G(NoMeta) Quit:$$BouwSteenTypes^PRBS(PRNr)="K" ;Alleen kindproducten niet verwerken
 . Quit:$E(^KPR(PRNr,0),1,2)="OL"
 . Set sTop=7,sRight=80,sLeft=1
 . Do WMOVE^vhLIST(2,24,1)
 . Do CTRONE(PRNr,Ask,.NoSa,1)
 . ;R "press enter",K
 Quit
 
CTRONE(PRNr,Ask,NoSa,Looping)  ;Prijscontrole
 ; AskAll= "V" : Steeds vragen
 ; AskAll= "S" : Opslaan in schaduw
 ; AskAll= "A" : Aanpassen in PPL
 ; AskAll= "H" : Herreken winst	
 New Result
 Do CALCONE(PRNr,.Ask,.NoSa,.Looping,.Result)
 Do DISPMSG(PRNr,Result)
 Quit
 
CALCONE(PRNr,Ask,NoSa,Looping,Result)  ;Prijscontrole
 ; AskAll= "V" : Steeds vragen
 ; AskAll= "S" : Opslaan in schaduw
 ; AskAll= "A" : Aanpassen in PPL
 ; AskAll= "H" : Herreken winst	
 Lock +^PRBS("BS",PRNr)
 Set Result=$$CONTROLE(PRNr,Ask,.NoSa,.Looping)
 Lock -^PRBS("BS",PRNr)
 Quit
 
CTRUP(KPRNr,Ask) ; Via de kind->moeder relatie alle moeder controleren
 New PRNr,sTop,sRight,sLeft
 Write @F11,@F1
 Write @FMTI," Product bouwstenen : Controle prijs van alle moeders - ",QN," ",@FMTi
 Set:'$D(Ask) Ask=$$^vhTXTPOP("PRBS","CONTROLEALL")
 Set MPRNr=""
 For  Set MPRNr=$O(^PRBS("IP",KPRNr,MPRNr)) Quit:MPRNr=""  Do
 . Set sTop=7,sRight=80,sLeft=1
 . Do WMOVE^vhLIST(2,24,1)
 . Do CTRONE(MPRNr,Ask,1)
 Quit
 
CONTROLE(PRNr,AskAll,NoSa,Looping) 
 ; AskAll= "V" : Steeds vragen
 ; AskAll= "S" : Opslaan in schaduw
 ; AskAll= "A" : Aanpassen in PPL
 ; AskAll= "H" : Herreken winst	
 New Som,Key,PRRec,PPL,Ask,Result,NewPPL,OpNonAktief
 ;Q:PRNr'=90635 ""
 Quit:$D(^PRBS("BS",PRNr))'>1 ""
 Do CALC^PRBS(PRNr,.Som,,,,.NoSa)
 ;zw Som
 Set NewPPL=$P(Som,D) ;+$P(Som,D,5) ; CiffPPLs + cor.faktors
 Do FETCHPR^UTILI(PRNr,$NA(PRRec))
 Set PrijsGeg=$$PRIJSGEG^KPRIJS(PRNr,$S(($G(NoSa)="S")&&($G(AskAll)="S"):"S",1:""))
 If $P(PrijsGeg,D,2)'="EUR" Do  Quit ""
 . Do:'$G(Looping) WARN^vhTXTPOP(PRNr_": Alleen producten met EURO prijzen kunnen gewijzigd worden")
 . Do:$G(Looping) MODFIELD^PRODUKT(PRNr,225,1,1,"Non-Aktief (BS)") ; Automatisch op NON-aktief plaatsen
 Set PPL=$P(PrijsGeg,D,1)
 Set GO=$P(PrijsGeg,D,3)
 Set NewPPL=NewPPL*$P(PrijsGeg,D,4)
 
 Set Result="OK"_D_+$J(PPL,0,2)_D_+$J(NewPPL,0,2)
 ;zw PPL
 ;zw NewPPL
 ;w !
 ;r k
 If $P(Som,D)<0 Do  Quit Result
 . Set $P(Result,D)="ERROR"
 . Set:'$G(Looping) OpNonAktief=$$^vhTXTPOP("PRBS","OPNONAKTIEF","")
 . Do:$G(Looping)!$G(OpNonAktief) MODFIELD^PRODUKT(PRNr,225,1,1,"Non-Aktief (BS)") ; Automatisch op NON-aktief plaatsen
 If +$J(NewPPL,0,2)'=+$J(PPL,0,2) Do
 .If $G(AskAll)="V" Kill AskAll ; Steeds Vragen
 .Set:$D(AskAll) Ask=AskAll 
 .Set:'$D(AskAll) Ask=$$^vhTXTPOP("PRBS","CONTROLE",,$P(PRRec(0),D),$J(PPL,0,2)_"/"_GO,$J(NewPPL,0,2)_"/"_GO)
 .Set:'$D(AskAll)&Ask="A" Ask=$$^vhTXTPOP("PRBS","CONTROLE","OPGELET",$P(PRRec(0),D),$J(PPL,0,2)_"/"_GO,$J(NewPPL,0,2)_"/"_GO) ; Bij A een tweede maal vragen
 .If $L(Ask) Do PRIJSUPD(PRNr,+$J(NewPPL,0,2),Ask,.PRRec)
 .Set $P(Result,D,1)=$S(Ask="A":"PPL",Ask="S":"SPPL",Ask="H":"DB",1:"NIET")
 Quit Result
 
PRIJSUPD(PRNr,NewPrijs,Wijze,PRRec) 
 ;Wijze : H = Herreken winst
 ;        A = Verkoopprijs aanpassen
 ;        S = S- aanpassen
 ;PRRec doorgeven via .Local
 New NewDB,Key,Ask
 Set Ask=$$LOCKW^vhLock("XN",$NA(^KPR(PRNr)))
 Set Key=$O(^KPR(PRNr,"J"))
 Do:$D(PRRec)<10 FETCHPR^UTILI(PRNr,$NA(PRRec))
 If Wijze="A" Do
 . Do PUTLOG^PRODUKT(PRNr,,$P(PRRec("J"),D,19),NewPrijs,"PPL (BS)") 
 . Set $P(^KPR(PRNr,Key),D,19)=NewPrijs
 . Do RECALC^PRODUKT2(PRNr)
 Else  If Wijze="S" Do
 . If +$P(PRRec(2),D,3)'=+NewPrijs Do
 .. Do PUTLOG^PRODUKT(PRNr,,$P(PRRec(2),D,3),NewPrijs,"S-PPL (BS)") 
 .. Set $P(^KPR(PRNr,2),D,3)=NewPrijs
 . ;If $P(PRRec(2),D,7)'=0 Do
 .. ;Do PUTLOG^PRODUKT(PRNr,,$P(PRRec(2),D,7),0,"S-Cif (BS)") 
 .. ;Set $P(^KPR(PRNr,2),D,7)=0
 Else  If Wijze="H" Do
 . Set PRRec(2)=""
 . Set $P(PRRec(2),D,3)=NewPrijs
 . Set NewDB=$$CALCDB^PRSCALC(.PRRec)
 . If NewDB="" Do  Quit
 .. Do WARN^vhTXTPOP($P(PRRec(0),D)_" Fout bij het berekenen van de nieuwe DB%.~Er is niet gewijzigd")
 . Do PUTLOG^PRODUKT(PRNr,,$P(PRRec("J"),D,19),NewPrijs,"PPL (BS)") 
 . Do PUTLOG^PRODUKT(PRNr,,$P(PRRec("J"),D,24),NewDB,"DB% (BS)") 
 . Set $P(^KPR(PRNr,Key),D,19)=NewPrijs
 . Set $P(^KPR(PRNr,Key),D,24)=NewDB
 . Do RECALC^PRODUKT2(PRNr)
 Lock -^KPR(PRNr)
 Quit