CEURHAD ; Conversie Haluxstatistiek naar Euro (^HADSTAT) ;[ 05/17/2001  10:47 AM ]
 Quit
 ;
T1 ;Wenst u alle Haluxstatistiek naar Euro te converteren?
T2 ;Conversie Haluxstatistiek naar Euro (^HADSTAT)
 ;
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)
 .Do OVERZ,DETAIL
 .Set Global=$P($P($T(T2),"(",2),")")
 .Do COMPRESS^CEUR(Global)
 Quit
 ;
OVERZ 
 New I,R,LEVNr,Week,Node,Soort,FromMunt,ToMunt
 Set FromMunt="BEF",ToMunt="EUR"
 Set LEVNr=""
 For  Set LEVNr=$O(^HADSTAT("O",LEVNr)) Quit:LEVNr=""  Do
 .Set Week=""
 .For  Set Week=$O(^HADSTAT("O",LEVNr,Week)) Quit:Week=""  Do
 ..Set Node=""
 ..For  Set Node=$O(^HADSTAT("O",LEVNr,Week,Node)) Quit:Node=""  Do
 ...Set Soort=""
 ...For  Set Soort=$O(^HADSTAT("O",LEVNr,Week,Node,Soort)) Quit:Soort=""  Do
 ....Set R=^HADSTAT("O",LEVNr,Week,Node,Soort)
 ....For I=3,4 Set $P(R,D,I)=$$BEDRAG^CEUR($P(R,D,I),FromMunt,ToMunt)
 ....Set ^HADSTAT("O",LEVNr,Week,Node,Soort)=R
 Quit
 ;
DETAIL 
 New I,R,LEVNr,Week,Node,VolgNr,FromMunt,ToMunt
 Set FromMunt="BEF",ToMunt="EUR"
 Set LEVNr=""
 For  Set LEVNr=$O(^HADSTAT("D",LEVNr)) Quit:LEVNr=""  Do
 .Set Week=""
 .For  Set Week=$O(^HADSTAT("D",LEVNr,Week)) Quit:Week=""  Do
 ..Set Node=""
 ..For  Set Node=$O(^HADSTAT("D",LEVNr,Week,Node)) Quit:Node=""  Do
 ...Set VolgNr=""
 ...For  Set VolgNr=$O(^HADSTAT("D",LEVNr,Week,Node,VolgNr)) Quit:VolgNr=""  Do
 ....Set R=^HADSTAT("D",LEVNr,Week,Node,VolgNr)
 ....For I=10,11 Set $P(R,D,I)=$$BEDRAG^CEUR($P(R,D,I),FromMunt,ToMunt)
 ....Set ^HADSTAT("D",LEVNr,Week,Node,VolgNr)=R
 Quit
 ;
DOC 
 ;Conversie ^HADSTAT (Haluxstatistiek)
 ;
 ;
 ;Routine: RUN^CEURHAD()
 ;
 ;
 ;Geconverteerde nodes:
 ;
 ;^HADSTAT("O",LEVNr,Week,Node,Soort)
 ;  Velden 3 en 4 in BEF omrekenen naar EUR
 ;
 ;^HADSTAT("D",LEVNr,Week,Node,VolgNr)
 ;  Velden 10 en 11 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
 ;