CEURPRO ; Conversie  verwijderde produkten naar Euro (^KPRO) ;[ 06/21/2001  9:04 AM ]
 Quit
 ;
T1 ;Wenst u alle verwijderde produkten naar Euro te converteren?
T2 ;Conversie verwijderde produkten naar Euro (^KPRO)
 ;
RUN(TxtPop) 
 New (TxtPop)
 Do
 .New TxtPop
 .Do INIT^vhTERMINA
 Set TxtPop=$G(TxtPop,1),Run=1
 Do:TxtPop
 .Write @F11,@F1
 .Set Txt(1)=$P($T(T1),";",2),Run=$$TXTPOP^CEUR(.Txt)
 Do:Run
 .Write !,$ZN,?10,$P($T(T2),";",2)
 .Kill ^CEURERR($ZN)
 .Set PRNr=0
 .For  Set PRNr=$O(^KPRO(PRNr))  Quit:PRNr=""  Do ONEPROD(PRNr)
 .Set Global=$P($P($T(T2),"(",2),")")
 .Do COMPRESS^CEUR(Global)
 Quit
 ;
ONEPROD(PRNr) 
 New I,R,Rec,FromMunt,ToMunt
 Set FromMunt="BEF",ToMunt="EUR"
 Do RECALCJ(PRNr),RECALCG(PRNr,FromMunt,ToMunt)
 If $D(^KPRO(PRNr,0)) Do
 .Set Rec=^KPRO(PRNr,0)
 .Set J=$O(^KPRO(PRNr,"J"))
 .If $E(J)="J" Set R=^KPRO(PRNr,J),$P(Rec,D,19)=$J($P(R,D,23),0,4)
 .Else  Set $P(Rec,D,19)=$$BEDRAG^CEUR($P(Rec,D,19),FromMunt,ToMunt)
 .Set ^KPRO(PRNr,0)=Rec
 Quit
 ;
RECALCJ(PRNr) ; Herrekenen van de "J" node
 New C,P24,B,PR
 Set P24=1
 Set PR=$O(^KPRO(PRNr,"J"))
 Do:$E(PR)="J"
 .Set B(1)=^KPRO(PRNr,PR),PR=PRNr
 .Do ^KPO0 
 .Set ^KPRO(PRNr,"J")="",^KPRO(PRNr,"J"_+B(1))=B(1)
 Quit
 ;
RECALCG(PRNr,FromMunt,ToMunt) ; Herrekenen van de "G" node
 New C,P24,B,PR,BPRNr
 Set P24=1
 Do:$D(^KPRO(PRNr,"G"))
 .Set B(1)=^KPRO(PRNr,"G"),PR=PRNr
 .If $P(B(1),D,17)'="" Do
 ..Do ^KPO0 
 ..Set ^KPRO(PRNr,"G")=B(1)
 .Else  Do
 ..Set BPRNr=$P(^KPRO(PRNr,0),D,3)
 ..Quit:BPRNr'=57791
 ..Set $P(B(1),D,12)=$$BEDRAG^CEUR($P(B(1),D,12),FromMunt,ToMunt)
 ..Set ^KPRO(PRNr,"G")=B(1)
 Quit
 ;
DOC 
 ;Conversie ^KPRO (Verwijderde produkten)
 ;
 ;
 ;Routine: RUN^CEURPRO()
 ;
 ;
 ;Geconverteerde nodes:
 ;
 ;^KPRO(PRNr,0)
 ;  Veld 19 in BEF omrekenen naar EUR
 ;
 ;^KPRO(PRNr,"J"_LEVNr)
 ;  RECALCJ : Copie van RECALC^PRODUKT2(PRNr)
 ;
 ;^KPRO(PRNr,"G")
 ;  RECALCG : Copie van RECALC^PRODUKT2(PRNr)
 ;***
 New L,R
 Write !,$ZN,!
 For L=1:1 Set R=$T(DOC+L) Quit:R=""!($P(R,";",2)="***")  Do
 .If $E(R)=" " Write !?5,$P(R,";",2,99)
 .Else  Xecute $P(R,";")_$P(R,";",2,99)
 Quit
 ;