CEURFA ; Conversie fakturen naar Euro (^KFA) ;[ 05/17/2001  10:32 AM ]
 Quit
 ;
T1 ;Wenst u alle fakturen naar Euro te converteren?
T2 ;Conversie fakturen naar Euro (^KFA)
 ;
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 FANr=0
 .For  Set FANr=$O(^KFA("F",FANr)) Quit:FANr=""  Do ONEFAKT(FANr)
 .Set Global=$P($P($T(T2),"(",2),")")
 .Do COMPRESS^CEUR(Global)
 Quit
 ;
ONEFAKT(FANr) 
 New I,R,PRNr,FromMunt,ToMunt,BONNr,BLNr,ZR
 Set FromMunt="BEF",ToMunt="EUR"
 Set R=^KFA("F",FANr,0,0),ZR=$ZR
 If $D(^KBA(11,$P(R,D,5))) Do
 .;Set $P(R,D,4)=$$MUNT^vhRtn1(ToMunt,,,,$P(R,D,5))
 .;Set $P(R,D,14)=""
 .;Set:$P(R,D,12) $P(R,D,14)=$J($P(R,D,12)*$P(R,D,4),0,2)
 .;Set ^KFA("F",FANr,0,0)=R
 .Set BONNr="U"
 .For  Set BONNr=$O(^KFA("F",FANr,BONNr)) Quit:$E(BONNr)'="U"  Do
 ..Set BLNr=100
 ..For  Set BLNr=$O(^KFA("F",FANr,BONNr,BLNr)) Quit:BLNr=""  Do
 ...Set R=^KFA("F",FANr,BONNr,BLNr),PRNr=$P(R,D,2)
 ...Quit:'PRNr
 ...For I=32:1:34 Set $P(R,D,I)=$$BEDRAG^CEUR($P(R,D,I),FromMunt,ToMunt)
 ...Set ^KFA("F",FANr,BONNr,BLNr)=R
 Else  Do ERRLOG^CEUR($ZN,ZR)
 Quit
 ;
 ;^KFA("F",FANr,0,0)
 ;  Veld 4  : de pariteit t.o.v. de Euro (ook voor de euro)
 ;  Veld 14 : veld 12 (bedrag faktuur) * veld 4 (pariteit)
 ;
DOC 
 ;Conversie ^KFA (Fakturen)
 ;
 ;
 ;Routine: RUN^CEURFA()
 ;
 ;
 ;Geconverteerde nodes:
 ;
 ;^KFA("F",FANr,BONNr,BLNr)
 ;  Velden 32, 33 en 34 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
 ;