vhDTyp ;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^vhDTyp(),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^vhDTyp(%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^vhDTyp(%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^vhDTyp(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^vhDTyp(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^vhDTyp(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^vhDTyp(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^vhDTyp(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^vhDTyp(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
 ;