CEURBA ; Conversie basis naar Euro (^KBA) ;[ 06/22/2001  4:08 PM ]
 Quit
 ;
T1 ;Wenst u alle de basisinformatie naar Euro te converteren?
T2 ;Conversie basisinformatie naar Euro (^KBA)
 ;
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)
 .Kill ^KBA("E")
 .Merge ^KBA("E")=^KBA(11)
 .Set FromMunt="BEF",ToMunt="EUR"
 .Set HerNr=""
 .For  Set HerNr=$O(^KBA(38,HerNr)) Quit:HerNr=""  Do
 ..Set Rec=^KBA(38,HerNr)
 ..Quit:Rec=""
 ..Set $P(Rec,D,2)=$$BEDRAG^CEUR($P(Rec,D,2),FromMunt,ToMunt,2)
 ..Set ^KBA(38,HerNr)=Rec
 Quit
 ;
DOC 
 ;Conversie ^KBA (Basis)
 ;
 ;
 ;Routine: RUN^CEURFA()
 ;
 ;
 ;Geconverteerde nodes:
 ;
 ;Kill ^KBA("E")
 ;Merge ^KBA("E")=^KBA(11)
 ;***
 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
 ;