Index: vhLib/DataTypes.mac.rou
===================================================================
diff -u
--- vhLib/DataTypes.mac.rou	(revision 0)
+++ vhLib/DataTypes.mac.rou	(revision 40)
@@ -0,0 +1,594 @@
+  ;DataTypes [ 08/20/2003  3:59 PM ] 
+ ;
+TN1 ;Jan;Feb;Maa;Apr;Mei;Jun;Jul;Aug;Sep;Okt;Nov;Dec;
+TF1 ;Jan;F�v;Mar;Avr;Mai;Jun;Jul;Ao�;Sep;Oct;Nov;D�c;
+TD1 ;J�n;Feb;M�r;Apr;Mai;Jun;Jul;Aug;Sep;Okt;Nov;Dez;
+TE1 ;Jan;Feb;Mar;Apr;May;Jun;Jul;Aug;Sep;Oct;Nov;Dec;
+TN2 ;Donderdag;Vrijdag;Zaterdag;Zondag;Maandag;Dinsdag;Woensdag;
+TF2 ;Jeudi;Vendredi;Samedi;Dimanche;Lundi;Mardi;Mercredi;
+TD2 ;Donnerstag;Freitag;Samstag;Sonntag;Montag;Dienstag;Mittwoch;
+TE2 ;Thursday;Friday;Saturday;Sunday;Monday;Tuesday;Wednesday;
+TN3 ;u;m;s
+TF3 ;h;m;s
+TD3 ;s;m;s
+TE3 ;h;m;s
+TN4 ;Januari;Februari;Maart;April;Mei;Juni;Juli;Augustus;September;Oktober;November;December;
+TN5 ;Don;Vri;Zat;Zon;Maa;Din;Woe;
+TF5 ;Jeu;Ven;Sam;Dim;Lun;Mar;Mer;
+TD5 ;Don;Fre;Sam;Son;Mon;Die;Mit;
+TE5 ;Thu;Fri;Sat;Sun;Mon;Tue;Wed;
+T3 ;  J;  F;  M;  A;  M;  J;  J;  A;  S;  O;  N;  D;
+T4 ; JA; FE; MA; AP; ME; JU; JU; AU; SE; OK; NO; DE;
+T5 ;JAN;FEB;MAA;APR;MEI;JUN;JUL;AUG;SEP;OKT;NOV;DEC;
+T6 ;31;28;31;30;31;30;31;31;30;31;30;31
+ ;
+ S:'$D(sLand) sLand="B"
+ S:'$D(sTaal) sTaal="N"
+ Set SCR="DTYPE-10 1" d ^Cysr
+ Quit
+PUTNUM(Fld,Val,L,F,D) 
+ New %EXT
+ S opi(1)="PS;"_Fld_";Val"
+ Set %EXT=$$EXTNUM(Val,L,F,D)
+ S opi(2)="PDP;"_Fld_";%EXT"
+ S opi=2 x op
+ Quit
+EXTNUM(Val,L,F,D) 
+ ;Format paramter 'F'
+ ; + -> Force sign
+ ; Z -> Force blank as Zero
+ ; 0 -> Force zero as blank
+ ; T -> Trailing negative sign
+ ; - -> No negative sign (pos number)
+ ; . -> No thousand separator
+ ; % -> Percent getal * 100    
+ Quit:Val=""&(F'["Z") ""
+ Quit:+Val=0&(F["0") ""
+ Quit $J($TR($FN(Val*$S(F["%":100,1:1),$TR(F,".0%Z",","),D),",.",".,"),L)
+INTNUM(Val,F) 
+ Quit $S(Val["-":-1,1:1)*$TR(Val,",. -",".")/$S(F["%":100,1:1)
+EDITNUM(Val) 
+ Set opi="I;;Fld" x op Set opi="FS;"_Fld_";%INT" x op
+ Set %OLD=%INT
+ If %INT="" Set %EXT="" Quit ""
+ Set %EXT=$TR($S(Val["-":-1,1:1)*$TR(Val,",. -","."),".",",")
+ Quit %EXT
+CALC Set %TC=0,er="Fout in ingave" Do WARN^vhRtn1    
+ Quit
+VALNUM(Val,L,F,D,Min,Max) 
+ Set %TC=Val'=%EXT+1
+ If Val="",F'["Z" Set (%INT,%EXT)="" Quit
+ If Val=%EXT Set X=%INT
+ Else  Do 
+ .If $E(Val,$L(Val))="-" Set Val="-"_$E(Val,1,$L(Val)-1)
+ .Set $ZT="CALC",Y="Set Val="_$TR(Val,",",".") X:X'="" Y
+ .Set %INT=$TR($J($S(Val["-":-1,1:1)*$TR(Val," -",""),L,D)," ","")/$S(F["%":100,1:1)
+ If $D(Min),%INT<Min Set %TC=0,er="Ingave kleiner dan ondergrens "_Min Quit
+ If $D(Max),%INT>Max Set %TC=0,er="Ingave groter dan bovengrens "_Max Quit
+ S %EXT=$S(+%INT=0&(F["0"):"",1:$J($TR($FN(%INT*$S(F["%":100,1:1),$TR(F,".0%Z+",","),D),",.",".,"),L))
+ Quit
+VALTEL(Val) 
+ New Z
+ Set Z=Val
+ If $E(Val,1,2)="00" Set (%EXT,%INT)=$TR(Z,"-,;:.","/    ") Set %TC=1 Quit
+ If $E(Z,1,2)="03",$H<58074 Set Z=$E(Z,3,99)
+ If $E(Z,1)'="0" Do FTEL("1;3; \4;5; \6;7;") Set %TC=1 Quit
+ If $E(Z,1,2)="02" Do FTEL("1;2;/\3;5; \6;7; \8;9;") Set %TC=1 Quit
+ Else  Do FTEL("1;3;/\4;5; \6;7; \8;9;") Set %TC=1 Quit
+ 
+FTEL(P) New X,K,L,PC
+ Set X=""
+ For K=1:1:$L(P,"\") Do
+ .Set PC=$P(P,"\",K),T=0
+ .For L=$P(PC,";",1):1:$P(PC,";",2) Do
+ ..Quit:$E(Z,1)=""
+ ..For  Quit:$E(Z,1)=""!(",.:;/- "'[$E(Z,1))  Set Z=$E(Z,2,99)
+ ..S:Z?1N.E X=X_$E(Z,1),Z=$E(Z,2,99),T=1
+ .S:T X=X_$P(PC,";",3)
+ For  Quit:$E(Z,1)=""!(",.:;/- "'[$E(Z,1))  Set Z=$E(Z,2,99)
+ S:$L(X) X=X_" "
+ If Z?1N.E Set X=X_"("_Z Set:$E(X,$L(X))'=")" X=X_")"
+ Else  Set X=X_Z
+ S (%INT,%EXT)=$E(X,1,30)
+ Quit
+VALBTW(Val) 
+ New Y,M
+ Set (%EXT,%INT)=Val
+ Goto VALREG1:sLand="NL"
+ If sLand'="B" Set %TC=1 Quit
+ S Y=$$UPTRIMA^vhRtn1(Val)
+ If $L(Y),$E("ONBEKEND",1,$L(Y))=Y Set (%INT,%EXT)="000.000.000" Set %TC=1 Quit
+ If $L(Y),$E("GEEN",1,$L(Y))=Y Set (%INT,%EXT)="Geen" Set %TC=1 Quit
+ Set Y=$$TRIMN^vhRtn1(Val)
+ Set M=$E(Y,8,9)
+ If $L(M)'=2!(+M'=(97-($E(Y,1,7)#97))) Set %TC=0 Quit
+ Set (%INT,%EXT)=$TR($FN($E(Y,1,9),",-"),",",".")
+ Set %TC=1 Quit
+VALREG() 
+VALREG1 Set %TC=1 Quit
+FMTBTW(Val) 
+ New K,U3,SWBTW
+ Set K=Val
+ Do S1^cA248
+ Quit $G(U3)
+VALBANK(Val) 
+ New Y,M
+ Set (%EXT,%INT)=Val
+ If sLand'="B" Set %TC=1 Quit
+ S Y=$$UPTRIMA^vhRtn1(Val)
+ If $L(Y),$E("ONBEKEND",1,$L(Y))=Y Set (%INT,%EXT)="000-0000000-00" Set %TC=1 Quit
+ If $L(Y),$E("GEEN",1,$L(Y))=Y Set (%INT,%EXT)="Geen" Set %TC=1 Quit
+ Set Y=$$TRIMN^vhRtn1(Val)
+ Set M=$E(Y,11,12)
+ If $L(M)'=2!($E(Y,1,10)#97-M'=0&($E(Y,1,10)#97-M'=-97)) Set %TC=0 Quit
+ Set (%INT,%EXT)=$E(Y,1,3)_"-"_$E(Y,4,10)_"-"_$E(Y,11,12)
+ Set %TC=1 Quit
+ ; Berekenen tijd (extern naar $H formaat)
+INTTIME(%TS) 
+ New I,%TN,%ER
+ Set %TS=$TR(%TS,".",":")
+ Set:%TS["AM" %TS=$TR(%TS," AM","")
+ If %TS["PM" Set %TS=$TR(%TS," PM","") Set:$P(%TS,":")<12 $P(%TS,":")=$P(%TS,":")+12
+ Set %TS=$TR(%TS,"uUmMsS ",":::::")
+ For I=1:1:3 Set $P(%TS,":",I)=$TR($J($P(%TS,":",I),2)," ",0)
+ If $P(%TS,":",3)?2N,$P(%TS,":",3)'<0,$P(%TS,":",3)<60 Do
+ .If $ZV["MSM" Do ^%TI
+ .If $ZV'["MSM" Do INT^%TI
+ Else  Set %ER=1
+ Quit $S($D(%ER):"",%TN=-1:"",1:%TN)
+ ; Berekenen tijd ($H naar extern formaat)
+EXTTIME(%TN,Typ,Taal) 
+ New I,%TS,TypSec,TypNum,Types
+ Set:$G(Typ)="" Typ="TK" Set:$G(Taal)="" Taal="N"
+ Set:'$D(%TN) %TN=$H
+ Set TypSec=$E(Typ,3),TypNum=$E(Typ,4),Typ=$E(Typ,1,2)
+ If Typ="TK" Do
+ .If TypSec="N",TypNum="S" Set TypSec="S",TypNum="N"
+ .Set:TypSec="N" TypNum=TypSec,TypSec=""
+ .Set:TypSec="L" TypNum=TypSec,TypSec=""
+ Else  Set TypNum=""
+ Quit:"S"'[TypSec ""
+ Set Types="TK\TL\TP"
+ If Typ="?" Do
+ .Write !,"Type - Resultaat",!,"-----------------"
+ .For I=1:1:$L(Types,"\") Do
+ ..Write !,$P(Types,"\",I),?5,"- ",$$EXTTIME(%TN,$P(Types,"\",I),Taal)
+ ..Write !,$P(Types,"\",I),"S",?5,"- ",$$EXTTIME(%TN,$P(Types,"\",I)_"S",Taal)
+ ..Do:$P(Types,"\",I)="TK"
+ ...Write !,$P(Types,"\",I),"L",?5,"- ",$$EXTTIME(%TN,$P(Types,"\",I)_"L",Taal)
+ ...Write !,$P(Types,"\",I),"N",?5,"- ",$$EXTTIME(%TN,$P(Types,"\",I)_"N",Taal)
+ ...Write !,$P(Types,"\",I),"NS",?5,"- ",$$EXTTIME(%TN,$P(Types,"\",I)_"NS",Taal)
+ ..If '(I#10),I'=$L(Types,"\") Read !!,"[] = vervolg",R
+ .Write !
+ If ("\"_Types_"\")'[("\"_Typ_"\") Quit ""
+ Set %TS=""
+ Set %TN=$TR(%TN,"n","N")
+ If %TN="N" Set %TN=$H
+ If %TN["," Set %TN=$P(%TN,",",2)
+ If %TN,%TN'<0,%TN'>86399 Do
+ .If $ZV["MSM" Do @($S(Typ="TP":"100",1:"")_"^%TO") Quit
+ .Xecute "Set %TS=$ZT(%TN,$S(Typ=""TP"":4,1:2))"
+ .Quit:Typ'="TP"
+ .Set:%TS["AM" %TS=$P(%TS,"AM")_" AM" Set:%TS["PM" %TS=$P(%TS,"PM")_" PM"
+ If $L(%TS) Do
+ .Set %TS=$TR($J($P(%TS,":"),2)," ",0)_":"_$P(%TS,":",2)
+ .Set:TypSec="S" $P(%TS," ")=$P(%TS," ")_":"_$TR($J(%TN#60,2)," ",0)
+ .If Typ="TL" Do
+ ..Set $P(%TS,":")=$P(%TS,":")_$P($T(@("T"_Taal_3)),";",2)
+ ..Set $P(%TS,":",2)=$P(%TS,":",2)_$P($T(@("T"_Taal_3)),";",3)
+ ..Set:$L($P(%TS,":",3)) $P(%TS,":",3)=$P(%TS,":",3)_$P($T(@("T"_Taal_3)),";",4)
+ ..Set %TS=$TR(%TS,":"," ")
+ Set:TypNum="N" %TS=$TR(%TS,":","")
+ Set:TypNum="L" %TS=$TR(%TS,":",$P($T(@("T"_Taal_3)),";",2))
+ Quit %TS
+ ; Inputkontrole voor tijdsingave
+VALTIME(Val) 
+ Set %EXT="",%TC=0
+ Set %INT=$$INTTIME(Val)
+ If %INT Set %EXT=$$EXTTIME(%INT),%TC=1
+ Quit
+ ; Berekenen datum (extern naar $H formaat)
+INTDATE(%DS,Typ,Taal) 
+ New I,R,%DN,Types
+ Set Typ=$G(Typ) Set:$G(Taal)="" Taal="N"
+ If Typ="",$D(%DS) Set Typ=$$DATETYP(%DS)
+ Set:Typ="" Typ="DK"
+ Set:'$D(%DS) %DS=$S(Typ="?":$$EXTDATE(),1:"")
+ Set Types="DS\DS2\DSN\DSN2\DVS\DK\DK4\DKP\DL\DM\DMC\DM4\DW\DW4\J\J4\W"
+ If %DS="" Quit ""
+ If Typ'="?",("\"_Types_"\")'[("\"_Typ_"\") Set Typ=$$DATETYP(%DS)
+ Set:Typ="" Typ="DK"
+ If Typ="?" Do
+ .New Typ
+ .Set Typ=$$DATETYP(%DS),%DS=$$INTDATE(%DS,Typ)
+ .Quit:%DS=""
+ .Write !,"Type - Int date - Ext date",!,"--------------------------"
+ .For I=1:1:$L(Types,"\") Do
+ ..Write !,$P(Types,"\",I),?5,"- ",$$INTDATE($$EXTDATE(%DS,$S($P(Types,"\",I)="W":"DW",1:$P(Types,"\",I))),$P(Types,"\",I))
+ ..Write ?16,"- ",$$EXTDATE(%DS,$P(Types,"\",I))
+ ..Write:"\DK\DKP\DM\DW\"[("\"_$P(Types,"\",I)_"\") ?30,"(inputkontrole)"
+ ..If '(I#20),I'=$L(Types,"\") Read !!,"[] = vervolg",R
+ .Write !
+ If ("\"_Types_"\")'[("\"_Typ_"\") Quit ""
+ If Typ="DMC" Set %DS=$$JAAR4($P(%DS,"'",2))_"."_$TR($J($F($P($T(@("T"_Taal_1)),";",2,99),$P(%DS,"'"))/4,2)," ",0),Typ="DM4"
+ Set %DS=$TR(%DS,"n","N")
+ If %DS="N" Set Typ=$S($E(Typ,1,2)="DK":"DK",$E(Typ,1,2)="DM":"DM",$E(Typ,1,2)="DW":"DW",1:Typ)
+ If '(%DS=0!(%DS?1"N")!(%DS?1"N+".N)!(%DS?1"N-".N)!(%DS?1"+".N)!(%DS?1"-".N)) Goto @("I"_Typ)
+ If %DS["N" Set %DS=$P(%DS,"N",2)
+ If "0+-"[%DS Set %DS="+0" ; min of plus X
+MPD If "\DK\DL\"[("\"_$E(Typ,1,2)_"\") Xecute "Set %DN=$H"_%DS Quit %DN
+MPW If "\DW\"[("\"_$E(Typ,1,2)_"\") Quit $$CALCDATE($H,"W","MD",%DS)
+MPM If "\DM\"[("\"_$E(Typ,1,2)_"\") Quit $$CALCDATE($H,"M","MD",%DS)
+MPJ Quit $$CALCDATE($H,"J","MD",%DS)
+IDVS Set %DS=$TR(%DS,"/","\"),%DS=$P(%DS,"\",3)_$TR($J($P(%DS,"\"),2,0)," ",0)_$TR($J($P(%DS,"\",2),2,0)," ",0) ; mm/dd/jj
+IDSN2 ; jjmmdd
+IDSN Set %DS=$TR($J(%DS,6)," ",0) ; jjjjmmdd
+ Set $E(%DS,$L(%DS)-3)=("."_$E(%DS,$L(%DS)-3)),$E(%DS,$L(%DS)-1)=("."_$E(%DS,$L(%DS)-1))
+IDS2 ; jj\mm\dd
+IDS Set (R,%DS)=$TR(%DS,".- \","////"),$P(%DS,"/")=$P(R,"/",3),$P(%DS,"/",3)=$P(R,"/") ; jjjj\mm\dd
+IDK ; dd of dd-mm of dd-mm-jj
+IDK4 ; dd of dd-mm of dd-mm-jjj
+IDKP ; dd of dd.mm of dd.mm.jj
+IDL Set R=$TR(%DS,".- \","////") ; dd of dd-mmm of dd-mmm-jj
+ If $L($P(R,"/",2)),'$P(R,"/",2) Set R=$$UPCASE^vhRtn1(R)
+ Set %DS=$$EDATE($H) Set:$L($P(R,"/")) $P(%DS,"/")=$P(R,"/")
+ Set:$L($P(R,"/",2)) $P(%DS,"/",2)=$P(R,"/",2) Set:$L($P(R,"/",3)) $P(%DS,"/",3)=$P(R,"/",3)
+ If '$P(%DS,"/",2) Set $P(%DS,"/",2)=$F($T(@("T"_(2+$L($P(%DS,"/",2))))),";"_$J($P(%DS,"/",2),3)_";")-5/4
+ If $D(Typ),'$P(%DS,"/",2) Quit ""
+ If %DS?.N1"/".N1"/".N  Set %DN=$$IDATE(%DS) If %DN!$D(Typ) Quit %DN
+ Set $P(%DS,"/")=15 Goto IDM1
+IDM Set R=$TR(%DS,".- ","///") ; mm of mmm of jj-mm of jj-mmm of jjjj-mm of jjjj-mmm
+ If $L($P(R,"/",2)) Set R=$P(R,"/",2)_"/"_$P(R,"/")
+ If $L($P(R,"/")),'$P(R,"/") Set R=$$UPCASE^vhRtn1(R)
+ Set %DS=$$EDATE($H),$P(%DS,"/")=15
+ Set:$L($P(R,"/")) $P(%DS,"/",2)=$P(R,"/") Set:$L($P(R,"/",2)) $P(%DS,"/",3)=$P(R,"/",2)
+ If '$P(%DS,"/",2) Set $P(%DS,"/",2)=$F($T(@("T"_(2+$L($P(%DS,"/",2))))),";"_$J($P(%DS,"/",2),3)_";")-5/4
+IDM1 If $D(Typ),'$P(%DS,"/",2) Quit ""
+ If %DS?.N1"/".N1"/".N  Set %DN=$$IDATE(%DS) If %DN!$D(Typ) Quit %DN
+ Set %DS=$P(%DS,"/",2,3) Goto IJ ;IDW1
+IDM4 Quit $$INTDATE(%DS,"DM")
+IW 
+IDW Set R=$TR(%DS,".- ","///") ; ww of jj/ww of jjjj/ww
+ If $P(R,"/")?4N Set $P(R,"/")=$E($P(R,"/"),3,4)
+ If $P(R,"/",2) Set R=$P(R,"/",2)_"/"_$P(R,"/")
+ Set %DS=$P($$EDATE($H),"/",2,3)
+ Set:$L($P(R,"/")) $P(%DS,"/")=$P(R,"/") Set:$L($P(R,"/",2)) $P(%DS,"/",2)=$P(R,"/",2)
+IDW1 If +$P(%DS,"/")>+$$MAXWEEK($P(%DS,"/",2)) Quit ""
+ If %DS?.N1"/".N Quit $$INTWEEK($P(%DS,"/",2),$P(%DS,"/"))
+IDW4 If $TR(%DS,".- ","///")?4N1"/".N Quit $$INTDATE(%DS,"DW")
+IJ Set %DS="01/07/"_%DS ; jj
+ If %DS?.N1"/".N1"/".N  Quit $$IDATE(%DS)
+IJ4 If %DS?4N Goto IJ
+ Quit ""
+ ; Berekening datum (dd/mm/jj naar $H)
+IDATE(%DS) 
+ New %DN,%ER
+ Set %DS=$P(%DS,"/",2)_"/"_$P(%DS,"/")_"/"_$P(%DS,"/",3)
+ If $P(%DS,"/",3)<100 Set $P(%DS,"/",3)=$S($P(%DS,"/",3)<50:2000,1:1900)+$P(%DS,"/",3)
+ If $ZV["MSM" Do ^%DI If $D(%ER) Quit ""
+ If $ZV'["MSM" Do INT^%DI If %DN=-1 Quit ""
+ Quit %DN
+ ; Berekenen datum ($H naar extern formaat)
+ ; Indien $D(lbTijdVenster)
+ ;   -Is een $LB(DagenVoor,DagenNa,TranslateChar) t.o.v. $h waarbinnen de datum nomaal zal weergegeven worden
+ ;    DagenVoor     -> default 60
+ ;    DagenNa       -> default 300
+ ;    TranslateChar -> default "?"
+ ;   -Buiten dit venster: $TR(%DS,"-./\",TranslateChar)
+EXTDATE(%DN,Typ,Taal,lbTijdVenster) 
+ New I,R,Types
+ Set:$G(Typ)="" Typ="DK" Set:$G(Taal)="" Taal="N"
+ Set:'$D(%DN) %DN=$H
+ Set %DN=+%DN If '%DN Quit ""
+ Set Types="DS\DS2\DSN\DSN2\DVS\DK\DK4\DKN\DKN4\DKP\DKD\DL\DL4\DM\DMC\DM4\DW\DW4\BJ\J\J4\DC\DCK\W\MN\MC\MCL\DWN\DMN\DJN"
+ If Typ'="?",$D(lbTijdVenster) New %DS Do  Quit %DS
+ . New DagenVoor,DagenNa,TranslateChar
+ . Set DagenVoor=$LG(lbTijdVenster),DagenNa=$LG(lbTijdVenster,2),TranslateChar=$LG(lbTijdVenster,3)
+ . Set:'DagenVoor DagenVoor=60
+ . Set:'DagenNa DagenNa=300
+ . Set:TranslateChar="" TranslateChar="?"
+ . Set %DS=$$EXTDATE(%DN,Typ,Taal)
+ . If %DN<$H,($H-%DN)<DagenVoor
+ . Else  If %DN>$H,(%DN-$H)<DagenNa
+ . Else  If +%DN'=+$H Set %DS=$TR(%DS,"-./\",TranslateChar)
+ 
+ If Typ="?" Do
+ .New Typ,%DS
+ .Write !,"Type - Ext date   - Int date - Formaat",!,"-----------------------------------------"
+ .For I=1:1:$L(Types,"\") Do
+ ..Set %DS=$$EXTDATE(%DN,$P(Types,"\",I),Taal,.lbTijdVenster)
+ ..Write !,$P(Types,"\",I),?5,"- ",%DS,?23,"- ",%DN
+ ..Write ?33,"-",$P($T(@("E"_$P(Types,"\",I))),";",$L($T(@("E"_$P(Types,"\",I))),";"))
+ ..Write:"\DK\DKP\DM\DW\"[("\"_$P(Types,"\",I)_"\") ?52,"(inputkontrole)"
+ ..If '(I#20),I'=$L(Types,"\") Read !!,"[] = vervolg",R
+ .Write !
+ If ("\"_Types_"\")'[("\"_Typ_"\") Quit ""
+ Goto @("E"_Typ)
+EDSN2 ; jjmmdd
+EDSN ; jjjjmmdd
+EDS2 ; jj\mm\dd
+EDVS ; mm/dd/jj
+EDS Set %DN=$ZD(%DN) ; jjjj\mm\dd
+ Quit:Typ="DVS" %DN
+ Set:$P(%DN,"/",3)<100 $P(%DN,"/",3)=$S($P(%DN,"/",3)<50:20,1:19)_$P(%DN,"/",3)
+ Set:$E(Typ,$L(Typ))=2 $P(%DN,"/",3)=$E($P(%DN,"/",3),3,4),Typ=$P(Typ,2)
+ Set %DN=$P(%DN,"/",3)_"/"_$P(%DN,"/",1,2) Quit $TR(%DN,"/",$S(Typ="DS":"\",1:""))
+EDK Quit $TR($$EDATE(%DN),"/","-") ; dd-mm-jj
+EDK4 Set %DN=$$EDATE(%DN) Quit $P(%DN,"/")_"-"_$P(%DN,"/",2)_"-"_$$JAAR4($P(%DN,"/",3)) ; dd-mm-jjjj
+EDKN Quit $TR($$EXTDATE(%DN,"DK"),"-","") ; ddmmjj
+EDKN4 Quit $TR($$EXTDATE(%DN,"DK4"),"-","") ; ddmmjjjj
+EDKP Quit $TR($$EDATE(%DN),"/",".") ; dd.mm.jj
+EDKD Quit $$FormatDateTime^vhLib("ddd DD/MM/JJJJ",%DN) ; ddd dd/mm/jjjj
+EDL Set %DN=$$EDATE(%DN),$P(%DN,"/",2)=$P($T(@("T"_Taal_1)),";",$P(%DN,"/",2)+1) Quit $TR(%DN,"/","-") ; dd-mmm-jj
+EDL4 Set %DN=$$EXTDATE(%DN,"DK4"),$P(%DN,"-",2)=$P($T(@("T"_Taal_1)),";",$P(%DN,"-",2)+1) Quit %DN ; dd-mmm-jjjj
+EDM set %DN=$$EDATE(%DN) Quit $P(%DN,"/",3)_"-"_$P(%DN,"/",2) ; jj-mm
+EDMC set %DN=$$EDATE(%DN) Quit $P($T(@("T"_Taal_1)),";",$P(%DN,"/",2)+1)_"'"_$P(%DN,"/",3) ; mmm'jj
+EDM4 set %DN=$$EDATE(%DN) Quit $$JAAR4($P(%DN,"/",3))_"."_$P(%DN,"/",2) ; jjjj.mm
+EDW Quit $$EXTWEEK(%DN) ; jj/ww
+EDW4 S %DN=$$EXTWEEK(%DN) Quit $$JAAR4($P(%DN,"/",1))_"/"_$P(%DN,"/",2) ; jjjj/ww
+EJ Quit $P($$EDATE(%DN),"/",3) ; jj
+EJ4 Quit $$JAAR4($P($$EDATE(%DN),"/",3))  ; jjjj
+EBJ	Quit $$JAAR4($P($$EDATE($$CALCDATE(%DN,"BJ","LD")),"/",3)) ; Boekjaar
+EDC Quit $P($T(@("T"_Taal_2)),";",%DN#7+2) ; ddddddddd
+EDCK Quit $P($T(@("T"_Taal_5)),";",%DN#7+2) ; ddd
+EW Quit $P($$EXTWEEK(%DN),"/",2) ; ww
+EMN Quit $P($$EDATE(%DN),"/",2) ; mm
+EMC Quit $P($T(@("T"_Taal_1)),";",$P($$EDATE(%DN),"/",2)+1) ; mmm
+EMCL Quit $P($T(@("T"_Taal_4)),";",$P($$EDATE(%DN),"/",2)+1) ; mmmmmmmmm
+EDWN Quit %DN-4#7+1 ; d
+EDMN Quit +$$EDATE(%DN) ; dd
+EDJN Quit %DN-$$INTDATE("01.01."_$P($$EDATE(%DN),"/",3),"DK")+1 ; ddd
+EDATE(%DN) 
+ New %DS
+ Set %DS=$ZD(%DN,$S($ZV["MSM":3,1:4))
+ If $L(%DS)=10 Set $P(%DS,"/",3)=$E(%DS,9,10)
+ Quit %DS
+JAAR4(Jaar2) 
+ Quit $S(Jaar2<50:2000,1:1900)+Jaar2
+ ; Inputkontrole voor datumingave
+VALDATE(Val,Typ,Min,Max) 
+ If Val="" Set (%INT,%EXT)="",%TC=1 Quit
+ If '$D(Typ) Set Typ=""
+ Set %EXT="",%TC=0
+ Set %INT=$$INTDATE(Val,Typ)
+ If $D(Min),%INT+$S(Typ["M":30,Typ["W":30,1:7)<Min,Val?1.2N Set %INT=$$CALCDATE(%INT,$S(Typ["M":"J",Typ["W":"J",1:"M"),1)
+ If $D(Min),%INT<Min Set %TC=0,er="Kleiner dan ondergrens "_$$EXTDATE(Min,Typ) Quit
+ If $D(Max),%INT>Max Set %TC=0,er="Groter dan de bovengrens "_$$EXTDATE(Max,Typ) Quit
+ If '%INT Set er="Foutieve datum ingave"
+ If %INT Set %EXT=$$EXTDATE(%INT,Typ),%TC=1
+ Quit
+ ; Berekenen weeknummer ($H naar extern formaat)
+EXTWEEK(%DN) 
+ New %DW,%DJ
+ Do GetWeek^vhLib(%DN,.%DJ,.%DW)
+ Quit $E(%DJ,3,4)_"/"_%DW
+ ; Berekenen weeknummer (extern naar $H formaat)
+INTWEEK(%DJ,%DW) 
+ New %DN,%D,%DWT,%DNP
+ Set %DJ=$S(%DJ>50:19,1:20)_$E(%DJ+100,2,3)
+INTW2 Set %DNP=%DJ-1841*365+(%DJ-1841\4)-(%DJ-1801\100)+(%DJ-1601\400)
+ Set %DN=%DNP+10
+ Set %DWT=%DN-%DNP+6+(%DNP+4#7)\7-$S(%DNP+4#7>3:1,1:0)
+ If %DWT=0 Set %DN=%DNP,%DJ=%DJ-1 Goto INTW2
+ Set:%DWT=53&(%DNP+365+(%DJ\4)-(%DJ\100)+(%DJ\400)+4#7<4) %DWT=1
+ Set %D=%DN-4#7
+ Set %DN=%DN-(7*(%DWT-2))-%D+1
+ Quit %DN+1+(7*(%DW-2))
+ ; Berekenen maximum weeknummer van een jaar
+MAXWEEK(%DJ) 
+ New %DN,%DW,%DS
+ Set %DS="31/12/"_%DJ
+ Set %DJ=$S(%DJ>50:19,1:20)_$E(%DJ+100,2,3)
+ Set %DN=%DJ-1840*365+(%DJ-1840\4)-(%DJ-1800\100)+(%DJ-1600\400)
+ Set %DW=0
+ For %DN=%DN:-1 Quit:+%DW>1  Set %DW=$P($$EXTWEEK(%DN),"/",2)
+ Quit %DW
+ ; Herberekenen datum (extern naar ander extern formaat)
+CONVDATE(%DN,FromTyp,ToTyp,Taal) 
+ Set:$G(ToTyp)="" ToTyp="DK" Set:$G(Taal)="" Taal="N"
+ Quit $$EXTDATE($$INTDATE(%DN,$G(FromTyp)),ToTyp,Taal)
+ ;Aantal dagen tussen 2 datums
+DIFFDATE(D1,D2,Type) 
+ New Diff,Neg
+ Set Type=$G(Type)
+ If Type="A" Do  Quit Diff*Neg
+ .Set Neg=1
+ .Set:D2<D1 Neg=D1,D1=D2,D2=Neg,Neg=-1
+ .Set Diff=D2-D1
+ .Set:Diff>7 Diff=Diff*5/7\1
+ .For Diff=Diff:-1:0 Quit:$$CALCDATE(D1,"A",Diff)'>D2
+ Else  Do
+ .If $L(D1) Set D1=$$INTDATE(D1,Type)
+ .If $L(D2) Set D2=$$INTDATE(D2,Type)
+ Quit D2-D1
+ ; Berekenen $H voor begin, midden, einde, eerste of laatste arbeidsdag van jaar, maand of week
+ ; Typ : A = Arbeidsdag, W = Week, M = Maand, J = Jaar
+ ; FD = eerste dag
+ ; MD = middelste dag
+ ; LD = laatste dag
+ ; FA = eerste arbeidsdag
+ ; LA = laatste arbeidsdag
+CALCDATE(Val,Typ,P1,P2) 
+ New R
+ If $G(Val)="" Set Val=$H
+ Goto:Typ="AW" CAW
+ Goto:Typ="A" CA
+ If '$D(P1) Set P1="MD"
+ If '$D(P2),"\FD\MD\LD\\"[("\"_P1_"\") Set P2=0
+ If '$D(P2) Set P2=""
+ If "\FD\MD\LD\FA\LA\\"[("\"_P2_"\") Set P2=P2_"\"_P1,P1=$P(P2,"\"),P2=$P(P2,"\",2,99)
+ If "\FD\MD\LD\FA\LA\\"'[("\"_P1_"\") Quit ""
+ If "\A\W\M\J\BJ\"'[("\"_Typ_"\") Quit ""
+ If "\FA\LA\"[("\"_P1_"\") Goto @("C"_P1)
+ Goto @("C"_Typ)
+ 
+CAW ; Ophogen van een datum met een aantal weken maar rekeing houden met verlofdagen (vooral kerst en grootverlof)
+	New EndDatum,Datum,BeginDatum,Cnt
+	Set BeginDatum=Val,Aantal=P1
+	Set EndDatum=$$CALCDATE(BeginDatum,"W",Aantal)
+	Set Datum=BeginDatum-1
+	Set Cnt=0
+	For  Set Datum=$O(^KBA("VP",Datum)) Quit:Datum=""  Quit:Datum>EndDatum  Set Cnt=Cnt+1
+	; In KBA("VP",...) zitten alleen de weekdagen niet de weekends, daarom /5 ipv /7
+	;w !,Cnt," ",$zd(EndDatum,11)," ",$zd(EndDatum,8)," "
+	Set EndDatum=$$CALCDATE(EndDatum,"A",$S($J(Cnt/5,0):Cnt,1:"+0"))
+	;w !,$zd(EndDatum,11)," ",$zd(EndDatum,8)," "
+	Quit EndDatum
+ 
+CA
+ New P3,P4,Found
+ Set P3=$G(P2)
+ For P2=1:1:$S(P1>0:P1,+P1=0:1,P1<0:-P1) Do
+ .For  Set Val=Val+$S(+P1=0:0,P1>0:1,1:-1) Do  Quit:'Found
+ ..; Eerste werkdag
+ ..Set:+P1=0 P1=$S(P1["-":-1,1:1)
+ ..Set Found=0
+ ..Set:$$EXTDATE(Val,"DWN")>5 Found=1
+ ..Do:$D(^KBA("VP",Val))
+ ...Set Found=1
+ ...If $L(P3) Set P4=";"_$P(^KBA("VP",Val),"\",2)_";",Found=P4[(";"_P3_";")
+ Quit Val
+CJ Set Val=$$EXTDATE(Val,"DK4") ; jaar
+ Set $P(Val,"-",3)=$P(Val,"-",3)+P2
+ If "\FD\MD\LD\"[("\"_P1_"\") Set Val=$P("01-01-\01-07-\31-12-","\",$F("FML",$E(P1))-1)_$P(Val,"-",3)
+ Quit $$INTDATE(Val,"DK")
+CBJ Set Val=$$EXTDATE(Val,"DK4") ; jaar
+ Set $P(Val,"-",3)=$P(Val,"-",3)+P2
+ If "\FD\MD\LD\"[("\"_P1_"\") Do
+ .Set $P(Val,"-",3)=$P(Val,"-",3)+(+$P(Val,"-",2)>6)-(P1="FD")
+ .Set Val=$P("01-07-\01-01-\30-06-","\",$F("FML",$E(P1))-1)_$P(Val,"-",3)
+ Quit $$INTDATE(Val,"DK")
+CM Set Val=$TR($$EXTDATE(Val,"DK"),"-",".") ; maand
+ Xecute "Set $P(Val,""."",2)=$P(Val,""."",2)+"_P2
+ If $P(Val,".",2)>12 Set $P(Val,".",3)=$P(Val,".",3)+($P(Val,".",2)\12),$P(Val,".",2)=$P(Val,".",2)#12
+ If $P(Val,".",3)>99 Set $P(Val,".",3)=$E($P(Val,".",3),2,3)
+ If $P(Val,".",2)<1 Set $P(Val,".",3)=$P(Val,".",3)-(12-$P(Val,".",2)\12),$P(Val,".",2)=12-(-$P(Val,".",2)#12)
+ If $P(Val,".",3)<0 Set $P(Val,".",3)=100+$P(Val,".",3)
+ If P1="" Goto CM1
+ If "\FD\MD\"[("\"_P1_"\") Set Val=$P("01.\15.","\",$F("FM",$E(P1))-1)_$P(Val,".",2,3) Goto CM1
+ Set Val=$P($T(T6),";",$P(Val,".",2)+1)_"."_$P(Val,".",2,3)
+ If +$P(Val,".",2)=2,'($P(Val,".",3)#4) Set Val=29_$E(Val,3,999) ; schrikkeljaar
+CM1 Set R=$$INTDATE(Val,"DK") If R="" Set $P(Val,".")=1,R=$$CALCDATE($$INTDATE(Val,"DK"),"M","LD")
+ Quit R
+CW Xecute "Set Val=Val+(7*+"_P2_")" ; week
+ If P1="" Quit Val-2+($H+3#7)
+ If "\FD\MD\LD\"[("\"_P1_"\") Xecute "Set Val=Val+$S(Val#7<4:-(Val#7),1:7-(Val#7))"_$P("-3\-1\+3","\",$F("FML",$E(P1))-1)
+ Quit Val
+ 
+ ; Eerste arbeidsdag van een week, maand of jaar
+CFA
+ Set Val=$$CALCDATE(Val,Typ,"FD",P2)
+ For Val=Val:1  Quit:Val=$$CALCDATE(Val,"A",0)
+ Quit Val
+ 
+ ; Laatste arbeidsdag van een week, maand of jaar
+CLA
+ Set Val=$$CALCDATE(Val,Typ,"LD",P2)
+ For Val=Val:-1  Quit:Val=$$CALCDATE(Val,"A",0)
+ Quit Val
+  
+ ; Vergelijken van twee datums
+COMPDATE(Val,Typ,Op,Ref) 
+ If "\=\'=\<\'<\>\'>\]\']\"'[("\"_Op_"\") Quit 0
+ Set Val=$$CALCDATE(Val,Typ,"MD")
+ Set Ref=$$CALCDATE(Ref,Typ,"MD")
+ If @(Val_Op_Ref) Quit 1
+ Quit 0
+ ; Herberekenen tijd (extern naar ander extern formaat)
+CONVTIME(%TN,ToTyp,Taal) 
+ Set:$G(ToTyp)="" ToTyp="TK" Set:$G(Taal)="" Taal="N"
+ Quit $$EXTTIME($$INTTIME(%TN),ToTyp,Taal)
+ ; Aantal seconden tussen 2 tijdstippen
+ ; TE = tijdseenheid (default = "S")
+ ; 		"S" of "s" = in seconden --> .....
+ ; 		"M" of "m" = in minuten  --> .....m ..s
+ ; 		"U" of "u" = in uren     --> .....u ..m ..s
+ ; 		"D" of "d" = in dagen    --> .....d ..u ..m ..s
+DIFFTIME(T1,T2,TE) 
+ New Diff,Neg
+ Set TE=$$UPCASE^vhRtn1($G(TE,"S"))
+ Set T1=$P(T1,",")*(24*60*60)+$P(T1,",",2)
+ Set T2=$P(T2,",")*(24*60*60)+$P(T2,",",2)
+ Set Diff=T2-T1,Neg=Diff<0
+ If TE'="S" Do
+ . Set $P(Diff,",")=$P(Diff,",")\60_"m,"_($P(Diff,",")#60)_"s"
+ . If TE'="M" Do
+ . . Set $P(Diff,",")=$P(Diff,",")\60_"u,"_($P(Diff,",")#60)_"m"
+ . . If TE'="U" Do
+ . . . Set $P(Diff,",")=$P(Diff,",")\24_"d,"_($P(Diff,",")#24)_"u"
+ . . . If TE'="D" Set Diff="Error"
+ . Set Diff=$TR(Diff,","," ")
+ . Set:Neg Diff=$$REPLACE^vhRtn1(Diff," "," -")
+ Quit Diff
+ 
+ROUNDTIME(Val,P1,P2)
+	;Val = Tweede deel van $H ($p($H,",",2)
+	;P1 ="H","M" of "S" optioneel aangevuld met + of -; 
+	;Indien P1 ook een "-" bevat dan wordt er steeds naar beneden afgerond !
+	;Indien P2 ook een "+" bevat dan wordt er steeds naar boven afgerond !
+	;P2 = aantal, minuten uren of seconden
+	;bv : afronden (wiskundig) op een halfuur : P1="M", P2=30
+	;bv : afronden naar beneden per kwartier : P1="M-", P2=5
+	Set Round=0
+	Set:P1["-" Round=-1
+	Set:P1["+" Round=+1
+	Set:Val[":" Val=$$INTTIME(Val) 
+ 	Set Sec=$CASE($TR(P1,"+-"),"M":60*P2,"H":3600*P2,:P2)
+ 	Set Val=$J(Val+(Round*(Sec-1)/2)/Sec,0,0)*Sec
+	Quit Val
+	
+CALCTIME(Val,P1,P2) 
+ New R,Sec
+ If $G(Val)="" Set Val=$H
+ If '$D(P1) Set P1="S"
+ If '$D(P2),"\D\H\M\S\\"[("\"_P1_"\") Set P2=0
+ If '$D(P2) Set P2=""
+ If "\D\H\M\S\\"[("\"_P2_"\") Set P2=P2_"\"_P1,P1=$P(P2,"\"),P2=$P(P2,"\",2,99)
+ If "\D\H\M\S\\"'[("\"_P1_"\") Quit ""
+ Set Sec=$S(P1="S":1,P1="M":60,P1="H":3600,1:86400)*P2
+ If Sec<0,-Sec>$P(Val,",",2) Set Sec=Sec-86400
+ Set Sec=Sec+$P(Val,",",2)
+ Set $P(Val,",")=$P(Val,",")+(Sec\86400),$P(Val,",",2)=$TR($J(Sec#86400,5)," ",0)
+ Quit Val
+FMTDT(%DT,Typ,Taal) 
+ New R
+ Set %DT=$G(%DT,$H),Typ=$G(Typ),Taal=$G(Taal)
+ Set R=$$EXTDATE(%DT,Typ,Taal)
+ If $P(%DT,",",2) Set:$L(R) R=R_"  " Set R=R_$$EXTTIME(%DT)
+ Quit R
+ ;
+DATETYP(%DS) 
+ New Typ,Trans
+ Set Trans=%DS[".",%DS=$TR(%DS,".- \'","/////")
+ If $L(%DS,"/")=3 Do
+ .If $P(%DS,"/")?4N Set $P(%DS,"/",2)=$J($P(%DS,"/",2),2),$P(%DS,"/",3)=$J($P(%DS,"/",3),2)
+ .Else  If $P(%DS,"/",3)?4N Set $P(%DS,"/")=$J($P(%DS,"/"),2),$P(%DS,"/",2)=$J($P(%DS,"/",2),2)
+ .Else  Set $P(%DS,"/")=$J($P(%DS,"/"),2),$P(%DS,"/",2)=$J($P(%DS,"/",2),2),$P(%DS,"/",2)=$J($P(%DS,"/",2),2)
+ .Set %DS=$TR(%DS," ",0)
+ .If %DS?4N1"/"2N1"/"2N Set Typ="DS"
+ .Else  If %DS?2N1"/"2N1"/"2N Set Typ=$S(Trans:"DKP",1:"DK")
+ .Else  If %DS?2N1"/"2N1"/"4N Set Typ="DK4"
+ .Else  If %DS?2N1"/".E1"/"2N,";"_$$UPCASE^vhRtn1($P($T(TN1),";",2,99))_";"[(";"_$$UPCASE^vhRtn1($P(%DS,"/",2))_";") Set Typ="DL"
+ If $L(%DS,"/")=2 Do
+ .If %DS?2N1"/"2N Set Typ="DM"
+ .If %DS?4N1"/"2N Set Typ="DM4"
+ .Else  If %DS?.E1"/"2N,";"_$$UPCASE^vhRtn1($P($T(TN1),";",2,99))_";"[(";"_$$UPCASE^vhRtn1($P(%DS,"/"))_";") Set Typ="DMC"
+ Else  If %DS?2N Set Typ="J"
+ Else  If %DS?4N Set Typ="J4"
+ Else  If %DS?6N Set Typ="DSN"
+ Else  If %DS?8N Set Typ="DSN"
+ Else  If %DS'?.N Do
+ .If ";"_$$UPCASE^vhRtn1($P($T(TN2),";",2,99))_";"[(";"_$$UPCASE^vhRtn1(%DS)_";") Set Typ="DC"
+ .Else  If ";"_$$UPCASE^vhRtn1($P($T(TN1),";",2,99))_";"[(";"_$$UPCASE^vhRtn1(%DS)_";") Set Typ="MC"
+ Quit $G(Typ)
+ ;
+HELP 
+ New
+ Do INIT^vhTERMINA
+ Do STORE^vhTERMINA()
+ Do DISPLAY^vhScherm("DTYPED")
+ Do REFRESH^vhTERMINA()
+ Quit
+ ;
+
+