CEURBON ; Conversie leveringen naar Euro (^KUL) ;[ 06/25/2001  10:54 AM ]
 Quit
 ;
T1 ;Wenst de port u alle leveringen naar Euro te converteren?
T2 ;Conversie leveringen naar Euro (^KUL)
 ;
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 KLNr=0
 .For  Set KLNr=$O(^KUL(KLNr)) Quit:KLNr=""  Do ONECUST(KLNr)
 .Set Global=$P($P($T(T2),"(",2),")")
 .Do COMPRESS^CEUR(Global)
 Quit
 ;
ONECUST(KLNr) 
 New I,R,Port,FromMunt,ToMunt,FakSoort,BONNr
 Set FromMunt="BEF",ToMunt="EUR"
 Set FakSoort=""
 For  Set FakSoort=$O(^KUL(KLNr,FakSoort)) Quit:FakSoort=""  Do
 .Set BONNr=""
 .For  Set BONNr=$O(^KUL(KLNr,FakSoort,BONNr)) Quit:BONNr=""  Do
 ..Set R=^KUL(KLNr,FakSoort,BONNr,1),Port=$P(R,D,13)
 ..Set $P(Port,"#")=$$BEDRAG^CEUR($P(Port,"#"),FromMunt,ToMunt,2)
 ..Set $P(R,D,13)=Port
 ..Set ^KUL(KLNr,FakSoort,BONNr,1)=R
 Quit
 ;
DOC 
 ;Conversie ^KUL (Leveringen)
 ;
 ;
 ;Routine: RUN^CEURBON()
 ;
 ;
 ;Geconverteerde nodes:
 ;
 ;^KUL(KLNr,Soort,BONNr,1)
 ;  $P(Veld 13,"#") in BEF omrekenen naar EUR
 ;***
 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
 ;