vhRtn2 ;Routine library 2 [ 11/28/2003  3:35 PM ]
 ; Format number
FN(Number,Length,Fraction,Type) 
 New Format,R,S
 If Type["C",'Number,"0"'[Number G FN1
 If Type["$" S Length=Length-2,Fraction=0
 Set:Fraction'?.1N Fraction=$$FETCH^vhFMT(Fraction)
 If 'Number,$P(Type,"N",2)'[0 Quit ""
 If $P(Type,"N",1)[0 Set R="",$P(R,0,Length)=0,R=1_R Set:Number<0 R=-R Set Number=Number+R
 Set Format="" Set:Type'["." Format="," Set:Type["+" Format=Format_"-"
 If $P(Type,"N",1)'["-",Type'["+" Set Format=Format_"T"
 Set Number=$FN(Number,Format,Fraction)
 Goto FN1:$P(Type,"N",1)'[0 Set R=$TR($E(Number,1,$L(Number)-Length)," -,0","")
 If R=1 Set Number=$E(Number,$L(Number)-Length+1,$L(Number))
FN1 If Length,$L(Number)>Length S Number="",$P(Number,"#",Length)="#"
 If Type["$" Quit $TR(Number_",-",",.",".,")
 Quit $TR(Number,",.",".,")
 ;
HLD(LDId)        
 Quit $G(^LD("L",LDId,"H"))
 ; Format volgens lijstdefintie
FLD(LDId) 
 New FDef,D,sR
 Set FDef=^LD("L",LDId)
 Set D=$P(FDef,"§",1),D=$S(D?.N:$C(D),1:"\")
 Set FDef=$P(FDef,"§",2,99)
 
 X $G(^LD("E",LDId))_" Set sR=$$FLD2()"
 Quit sR
FLD2() Goto FLD1
BLD(LDId) 
 New FDef,D,R,X
 Set FDef=^LD("L",LDId)
 Set D=$P(FDef,"§",1),D=$S(D?.N:$C(D),1:"\")
 Set FDef=$P(FDef,"§",2,99)
 For X=1:1:$L(FDef,"§") Do
 .Set R=$P(FDef,"§",X)
 .If '$L(R) Quit
 .Set $P(R,"`",1,3)=""""_$J("",$P(R,"`",4))_"""`C`L"
 .Set $P(R,"`",7,99)="",$P(FDef,"§",X)=R
 Goto FLD1
 ;Format line
FL(FDef) New D Set D="\"
FLD1 New String,Piece,POfS,Attr,R,S,OX
 Set (String,Piece)=""
FL1 For  Set Piece=Piece+1,POfS=$P(FDef,"§",Piece) Quit:POfS=""  Set String=String_$$FKOL(POfS)
 Quit String
 
FKOL(POfS) 
 Set:'($D(X)#10) X=""
 ;Set $P(POfS,"`",2)=$$UPCASE^vhRtn1($P(POfS,"`",2))
 If $P(POfS,"`",2)["S" Do BEDRAG Goto FL2
 Set R="",S=$P(POfS,"`",1) Goto FL2:'$L(S) ;ophalen data
 If S?1.N!(S?1.E1"."1.N) Do
 .New i,p,s
 .Set:S?1.N S="1."_S
 .Set s=$P(S,".",1,$L(S,".")-1),p=$P(S,".",$L(S,"."))
 .For i=1:1:$L(s,".") Set $P(s,".",i)=""""_$P(s,".",i)_""""
 .Set s=$TR(s,".",",")
 .Xecute "Set R=$P($G(sFL("_s_")),D,"_p_")"
 Else  Xecute "Set R="_S
 If $P(POfS,"`",8)'="" Do
 .If $P(POfS,"`",2)'["L" S OX=X,X=R X "S R="_$P(POfS,"`",8) S X=OX ; Transform
 .If $P(POfS,"`",2)["L" S R=$$DISPL^POP($P(POfS,"`",8),R,$P(POfS,"`",2))
FL2 Set Attr="",S=$P(POfS,"`",7) ;Attributes
 If S?.N!(S?1N1"."1N) Set:S?.N S="1."_S Set:'$D(sFL(S\1)) sFL(S\1)="" Set Attr=$P(@("sFL("_(S\1)_")"),"\",$P(S,".",2))
 Else  If $L(S)  S OX=X,X=R X "S Attr="_S S X=OX
 Set S=0 For  Quit:Attr=""  Set S=S+$P("1\3\5\10","\",$F("HRUB",$E(Attr))-1),Attr=$E(Attr,2,99) 
 Set Attr=S
 
 If $P(POfS,"`",2)["N" Set R=$$FN(R,$P(POfS,"`",4),$P(POfS,"`",5),$P(POfS,"`",2)) ;verwerking numerieke data
 If $P(POfS,"`",2)="T" S R=$$EXTTIME^vhDTyp(R)
 If "\DN\DC\MN\MC\DM\DM4\DW\W\J\DK\DL\"[("\"_$P(POfS,"`",2)_"\") S R=$$EXTDATE^vhDTyp(R,$P(POfS,"`",2))
 If "\DKD\"[("\"_$P(POfS,"`",2)_"\") S R=$$FormatDateTime^vhLib("ddd DD/MM/JJJJ",R)
 If $P(POfS,"`",4) Do  ; Lengte is bepaald
 .Set R=$E(R,1,$P(POfS,"`",4))
 .If $P(POfS,"`",3)="L" Set R=R_$J("",$P(POfS,"`",4)-$L(R)) ;alignering
 .Else  If $P(POfS,"`",3)="R" Set R=$J(R,$P(POfS,"`",4))
 .Else  If $P(POfS,"`",3)="C" Set R=$J("",($P(POfS,"`",4)-$L(R))\2)_R_$J("",$P(POfS,"`",4)-$L(R)-(($P(POfS,"`",4)-$L(R))\2))
 .Else  Set R="",$P(R,"#",$P(POfS,"`",4))="#"
 If "PS"[$G(%DevT),Attr Set R=cu("a",Attr)_R_cu("a",0)
 If "P"=$G(%DevT),Attr Set R=^cy0("att","PRINTER","a",Attr)_R_^(0)
 ;Set R=R_$P($P(POfS,"`",6),"|",1) ;concatinering
 Quit R_$P(POfS,"`",6) ;concatinering
 If $P(POfS,"`",6)["|" Set R=R_cu("g",1)_cu("g",12)_cu("g",0)_$P($P(POfS,"`",6),"|",2)
 Quit R
 
BEDRAG New Append,Getal,Fmt
 Set R="",S=$P($P(POfS,"`",1),";",1) Goto BD2:'$L(S)
 If S?1.N!(S?1.E1"."1.N) Set:S?1.N S="1."_S Set R=$P($G(sFL($P(S,"."))),D,$P(S,".",2))
 Else  Xecute "Set R="_S
 If $P(POfS,"`",8)'="" Do
 .If $P(POfS,"`",2)'["L" S OX=X,X=R X "S R="_$P(POfS,"`",8) S X=OX ; Transform
BD2 Quit:'$L(R)
 Set Getal=R
 ; Munt
 Set R="",S=$P($P(POfS,"`"),";",2) Goto BD3:'$L(S)
 If S?1.N!(S?1.E1"."1.N) Set:S?1.N S="1."_S Set R=$P($G(sFL($P(S,"."))),D,$P(S,".",2))
 Else  Xecute "Set R="_S
BD3 Set Append=$S($L(R):$J(R,3),1:"")
 ; GrootteOrde
 Set R="",S=$P($P(POfS,"`"),";",3) Goto BD4:'$L(S)
 If S?1.N!(S?1.E1"."1.N) Set:S?1.N S="1."_S Set R=$P($G(sFL($P(S,"."))),D,$P(S,".",2))
 Else  Xecute "Set R="_S
 Set Append=Append_$S(R="H"!(R="1"):"%",1:" ")
BD4 Set Fmt=$P(POfS,"`",2)
 If $L(Append),$Find(Fmt,"-")<$Find(Fmt,"N"),Fmt["-" Set Append=" "_Append
 
 If $P(POfS,"`",2)["N" Set R=$$FN(Getal,$P(POfS,"`",4)-$L(Append),$P(POfS,"`",5),Fmt)
 Set $P(POfS,"`",2)="C"
 Set:$L(R) R=R_Append
 Quit
 ;
 ;Openen dummy Window
ZWINDOW(Bl,Bk) 
 Set:Bl="C" Bl=12 ; beginlijn
 Set:Bk="C" Bk=40 ; beginkolom
 Do O^cA612(Bl,Bk,1,1,0,0,0,0) ; dummy window
 Quit
 ;
ZWINT(On,Bl,Bk) 
 New D
 Set D="\"
 Do:$G(QW)
 .If On Do
 ..If $ZV["MSM" Do X^cA612,^cA338
 ..If $ZV'["MSM" Do ZWINDOW($G(Bl,1),$G(Bk,1)),^cA338
 .Else  Do
 ..New zb
 ..If $ZV["MSM" D ^cA339,W^cA612
 ..If $ZV'["MSM" D ^cA339,C^cA612
 Quit
 ;
ISARBDAG(Val) 
 New IsArbDag
 Set:$G(Val)="" Val=$H    
 Set IsArbDag=+Val=$$CALCDATE^vhDTyp(Val,"A",0)
 Quit IsArbDag
 ;
STACK(Show) 
 New R,StackNr,Place,MCode
 Set Show=$G(Show)
 Kill ^STACK($J)
 For StackNr=0:1:$STACK Do
 .Set Place=$STACK(StackNr,"PLACE"),MCode=$STACK(StackNr,"MCODE")
 .Quit:Place["STACK"  Quit:MCode["STACK"
 .Set:Place="@" Place="*XECUTE*"
 .Set R=$P(Place,":")_" : "_MCode
 .If Show Write !,StackNr,") ",R
 .Else  Set ^STACK($J,StackNr)=R
 Quit
 ;
 ; 11 modulo test voor nummers tot 6 lang
CalcCDigit6(Value)
 New CDigit,I,Sum
 Set CDigit=($E(Value)*2)+($E(Value,2)*3)+($E(Value,3)*5)+($E(Value,4)*7)+($E(Value,5)*11)+($E(Value,6)*13)#11
 Set CDigit=$S(CDigit=0:1,CDigit=1:0,1:11-CDigit)
 Quit CDigit
 ;
 ; Controle check digit voor nummers tot 6 lang
CheckCDigit6(Value,CDigit)
 Quit $$CalcCDigit6(Value)=CDigit
 ;
 ; $Query voor het opkuisen van $C(2) in globals (vooral voor orderingave)
qc2(QRef)
 New TRef,Rec
 Set TRef=QRef,QRef=$Q(@QRef,-1)
 Set:QRef="" QRef=TRef
 Set TRef=$E(TRef,1,$L(TRef)-1)
 For  Set QRef=$Q(@QRef) Quit:$E(QRef,1,$L(TRef))'=TRef  Do
 . Set Rec=@QRef
 . If Rec'[$C(1),Rec'[$C(2),Rec'[$C(3),Rec'[$C(4),Rec'[$C(5),Rec'[$C(6),Rec'[$C(7),Rec'[$C(8),Rec'[$C(9),Rec'[$C(10),Rec'[$C(11),Rec'[$C(12),Rec'[$C(13),Rec'[$C(14),Rec'[$C(15),Rec'[$C(16),Rec'[$C(17),Rec'[$C(18),Rec'[$C(19),Rec'[$C(20),Rec'[$C(21),Rec'[$C(22),Rec'[$C(23),Rec'[$C(24),Rec'[$C(25),Rec'[$C(26),Rec'[$C(27),Rec'[$C(28),Rec'[$C(29),Rec'[$C(30),Rec'[$C(31) Quit
 . Set ^qc2(QRef)=Rec
 . Set Rec=$TR(Rec,$C(1)_$C(2)_$C(3)_$C(4)_$C(5)_$C(6)_$C(7)_$C(8)_$C(9)_$C(10)_$C(11)_$C(12)_$C(13)_$C(14)_$C(15)_$C(16)_$C(17)_$C(18)_$C(19)_$C(20)_$C(21)_$C(22)_$C(23)_$C(24)_$C(25)_$C(26)_$C(27)_$C(28)_$C(29)_$C(30)_$C(31),""),@QRef=Rec
 Quit
 ;
 ; Datumcontrole Data-M via vhDTyp
DCTR(K)
 New %TC,%INT,%EXT,er
 Set %TC="-,"[K&($L(K)<2)
 Do:'%TC
 . Do VALDATE^vhDTyp(K,"DK")
 . Quit:'%TC
 . Set:K["." %EXT=$TR(%EXT,"-",".")
 . Set K=%EXT ; Indien doorgegeven als .Local dan K aanpassen i.v.m. verkorte ingave
 Quit %TC
 ;