vhFMT ;Formatering 2 [ 10/19/2001  3:59 PM ]
 
LIJN(sFmtRef,sWrite) ; Entry voor het formateren
 New sString,sPiece,sNode,sK,sNodeRec
 
LIJN2 Set:'$D(sWrite) sWrite=$P($G(@sFmtRef),"`",2)
 If $P($G(@sFmtRef),"`") New D Set D=$C($P($G(@sFmtRef),"`"))
 Set sString=""
 For sNode=1:1 Set sNodeRec=$G(@sFmtRef@(sNode)) Quit:'$L(sNodeRec)  Do
 .For sPiece=1:1 Set sK=$P(sNodeRec,"§",sPiece) Quit:sK=""  Do
 ..Set sString=sString_$$CEL(sWrite,$P(sK,"`",1),$P(sK,"`",2),$P(sK,"`",3),$P(sK,"`",4),$P(sK,"`",5),$P(sK,"`",6),$P(sK,"`",7),$P(sK,"`",8),$P(sK,"`",9))
 Quit:sWrite
 Quit sString
 
LEN(sFmtRef) ; Opvragen van de lengte van een formatering
 New sNode,sPiece,sLen,sNodeRec,sK
LEN2 Set sLen=""
 For sNode=1:1 Set sNodeRec=$G(@sFmtRef@(sNode)) Quit:'$L(sNodeRec)  Do
 .For sPiece=1:1 Set sK=$P(sNodeRec,"§",sPiece) Quit:sK=""  Do
 ..Set sLen=sLen+$L($P(sK,"`",6))+$P(sK,"`",4)
 Quit sLen
 
CEL(sWrite,sVal,sFmt,sAlign,sLen,sDec,sSepar,sAttr,sTrans,sATrans) 
 New sJ
 If sFmt["S" Set sVal=$$SPECIAAL(sVal,sFmt,sTrans) Goto FL2
 Goto FL2:'$L(sVal)
 S sVal=$$FETCH(sVal,$G(sTrans)) ;Ophalen data
FL2 ; Formateren
 If "\DN\DC\MN\MC\DM\DM4\DW\W\J\J4\DKP\DK\DL\"[("\"_sFmt_"\") S sVal=$$EXTDATE^vhDTyp(sVal,sFmt)
 If sFmt["N" Set sVal=$$FN(sVal,sLen,sDec,sFmt) ;verwerking numerieke data
 If sFmt="T" S sVal=$$EXTTIME^vhDTyp(sVal)
 ; Alignment of Fill
 If sLen Do  ; Lengte is bepaald
 .Set sVal=$E(sVal,1,sLen)
 .Set:sAlign="" sAlign="L"
 .If sAlign="L" Set sVal=sVal_$J("",sLen-$L(sVal)) ;alignering
 .Else  If sAlign="R" Set sVal=$J(sVal,sLen)
 .Else  If sAlign="C" Set sVal=$J("",(sLen-$L(sVal))\2)_sVal_$J("",sLen-$L(sVal)-((sLen-$L(sVal))\2))
 .Else  If sAlign="F",$L(sVal) Set $P(sVal,sVal,sLen\$L(sVal))=sVal,sVal=$E(sVal,1,sLen)
 .Else  Set sVal="",$P(sVal,"#",sLen)="#"
 If sWrite Do 
 .Set sAttr=$$FETCH(sAttr,$G(sATrans))
 .For sJ=1:1:$L(sAttr) Write @(@("FMT"_$E(sAttr,sJ)))
 .Write sVal
 .For sJ=1:1:$L(sAttr) Write @(@("FMT"_$C($A($E(sAttr,sJ))+32)))
 .If sWrite=2,sSepar["|" Write $P(sSepar,"|"),@F7,@$P(FG,"\",10),@F8,$P(sSepar,"|",2)
 .Else  Write sSepar
 Quit sVal_sSepar ;concatinering
 
FETCH(sF,sT) ; Ophalen van de waarde 
 New X
 If sF?1.2N!(sF?1.E1"."1.2N) Set:sF?.N sF="1."_sF Set X=$P($G(@("sFL($P(sF,"".""))")),D,$P(sF,".",2))
 Else  If sF?1"#"1.2N!(sF?1.E1"#"1.2N) Set:sF?1"#".N sF="1"_sF Set X=$LG($G(@("sFL($P(sF,""#""))")),$P(sF,"#",2))
 Else  If $L(sF) Xecute "S X="_sF
 Set:'$D(X) X=""
 Quit:$G(sT)="" X
 If $L($P(sT,"`"))=1 Do EXEC^vhLIST2($P(sT,"`"),$P(sT,"`",2),.X,"(X)") Quit X
 Xecute "S X="_sT
 Quit X
 
SPECIAAL(sVal,sFmt,sTrans) 
 New sR,sAppend
 Set sR=$$FETCH($P(sVal,";",1),sTrans)
SPEC2 Quit:'$L(sR)
 Set sGetal=sR
 ; Munt
 Set sR=$$FETCH($P(sVal,";",2))
 Goto SPEC3:'$L(sR)
SPEC3 Set sAppend=$S($L(sR):$J(sR,3),1:"")
 ; GrootteOrde
 Set sR=$$FETCH($P(sVal,";",3))
 Goto SPEC4:'$L(S)
 Set sAppend=sAppend_$S(sR="H"!(sR="1"):"%",1:" ")
SPEC4 
 If $L(sAppend),$Find(sFmt,"-")<$Find(sFmt,"N"),sFmt["-" Set sAppend=" "_sAppend
 If sFmt["N" Set R=$$FN(Getal,sLen-$L(sAppend),sDec,sFmt)
 Set sFmt="C"
 Quit $S($L(sR):R_sAppend,1:"")
 
 ; 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(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,",.",".,")_",-"
 If Type["%" Quit $TR(Number,",.",".,")_"%"
 Quit $TR(Number,",.",".,")