XLFDT ;ISC-SF/STAFF - Date/Time Functions ;03/27/2003 14:09
;;8.0;KERNEL;**71,120,166,168,179,280**;Jul 10, 1995
;VA FileMan uses 2400 as midnight, many other system use 0000.
;This is true for $H and HL7, so a conversion has to adjust
;the day when converting Midnight.
;i.e. 3001225.24 is the same as HL7 '200012260000' and $H '58434,0'
;The range of accepted $H dates: "2,0" to "99999,85399".
;The range of accepted FM dates: 1410102 to 4141015 (any valid time).
;The range of accepted HL7 dates: 18410102 to 21141015 (any valid time).
;It is expected that input values are valid dates.
;
HTFM(%H,%F) ;$H to FM, %F=1 for date only
N X,%,%T,%Y,%M,%D S:'$D(%F) %F=0
I $$HR(%H) Q -1 ;Check Range
I '%F,%H[",0" S %H=(%H-1)_",86400"
D YMD S:%T&('%F) X=X_%T
Q X
;
H2F(%H) ;Internal to this routine use
N X,%,%T,%Y,%M,%D
D YMD S:%T X=X_%T
Q X
;
YMD ;21608 = 28 feb 1900, 94657 = 28 feb 2100, 141 $H base year
S %=(%H>21608)+(%H>94657)+%H-.1,%Y=%\365.25+141,%=%#365.25\1
S %D=%+306#(%Y#4=0+365)#153#61#31+1,%M=%-%D\29+1
S X=%Y_"00"+%M_"00"+%D,%=$P(%H,",",2)
S %T=%#60/100+(%#3600\60)/100+(%\3600)/100 S:'%T %T=".0"
Q
;
FMTH(X,%F) ;FM to $H, %F=1 for date only
N %Y,%H,%A S:'$D(%F) %F=0
I $$FR(X) Q -1 ;$H range of 1 - 99999
I '%F,X[".24" S %A=1
D H S:%F %H=+%H I $D(%A) S %H=(%H+1)_",0"
Q %H
;
F2H(X) ;Internal to this routine use
N %Y,%H,%A
D H
Q %H
;
H ;Build %H from FM
N %,%L,%M,%D,%T I X<1410101 S %H=0,%Y=-1 Q
S %Y=$E(X,1,3),%M=$E(X,4,5),%D=$E(X,6,7)
S %T=$E(X_0,9,10)*60+$E(X_"000",11,12)*60+$E(X_"00000",13,14)
;%L = (# leap years) - (# leap years before base)
S %L=%Y+1700 S:%M<3 %L=%L-1 S %L=(%L\4)-(%L\100)+(%L\400)-446
S %H=$P("^31^59^90^120^151^181^212^243^273^304^334","^",%M)+%D
S %=('%M)!('%D),%Y=%Y-141,%H=(%H+(%Y*365)+%L+%)_","_%T,%Y=$S(%:-1,1:%H+4#7)
Q
;
HTE(%H,%F) ;$H to external
Q:$$HR(%H) %H ;Range Check
N Y,%T,%R
S %F=$G(%F,1) S Y=$$HTFM(%H,0) G T2
;
FMTE(Y,%F) ;FM to external
Q:(Y<1000000)!(Y>9991231) Y ;Range Check
N %T,%R S %F=$G(%F,1)
;Both HTE and FMTE come here.
T2 S %T="."_$E($P(Y,".",2)_"000000",1,7)
D FMT^XLFDT1 Q %R
;
FR(%V) ;Check FM in valid range
Q (%V<1410102)!(%V>4141015.235959)
HR(%V) ;Check $H in valid range
Q (%V<2)!(%V>99999)
;
FMTHL7(%P1) ;Convert FM date/time to HL7 format
N %T Q:'$L(%P1) "" S %P1=+%P1 ;Make sure a cononic number
I $$FR(%P1) Q -1 ;Check range
S %T=$P(%P1,".",2),%P1=$P(%P1,".")
I %T=24 S %P1=$$FMADD($P(%P1,"."),1),%T="0000"
S:%P1>1 %P1=%P1+17000000
I $L(%T) S %T=$S($L(%T)>4:$E(%T_"00",1,6),1:$E(%T_"0000",1,4))
I $L(%T) S %P1=%P1_%T_$$TZ()
Q %P1
;
HL7TFM(%P1,%P2,%P3) ;Convert HL7 D/T to FM.
;%P1 is the value to convert
;%P2 is if output should be local or UCT time (L,U)
;%P3 is 1 if the input just a time value?
N %TZ,%LTZ,%SN,%U,%H,%M,%T Q:'$L(%P1) ""
S %T=$E(%P1_"0000",1,8)
S %P2=$G(%P2),%P3=+$G(%P3),%TZ="",%LTZ=$$TZ()
I '%P3 Q:(%T<18410102)!(%T>21141015) -1 ;Date Range Check
F %SN="+","-" I %P1[%SN D Q ;Find the timezone
. S %TZ=$P(%P1,%SN,2),%P1=$P(%P1,%SN) I %TZ'?4N S %TZ="" Q
. S %TZ=%SN_%TZ
. Q
;FM only supports time to seconds
S %P1=$P(%P1,".")
;See it just a Time value
I %P3 S %P1="20000104"_%P1 ;Add a date
Q:($L(%P1)#2)!(%P1'?4.14N) -1 ;Length check
I $L(%P1)<8 S %P1=$E(%P1_"00000000",1,8) ;Fill out to 8 digits
I %TZ="" D
. S:%P2["L" %P2="" ;If no TZ, assume local, don't need L.
. S:%P2["U" %TZ=%LTZ ;give the local tz
;
S %P1=$S($L(%P1)>8:$E(%P1,1,8)-17000000_"."_$E(%P1,9,14),1:%P1-17000000)
;%P1 is now in FM format
I %P1[".",+$P(%P1,".",2)=0 S %P1=$$FMADD(+%P1,-1)_".24"
;If HL7 tz and local tz are the same
I %P2["L",%TZ=%LTZ S %P2=""
I (%P2["U")!(%P2["L"),%P1["." D ;Build UCT from data
. S %=$TR(%TZ,"+-","-+") ;Reverse the sign
. S %H=$E(%,1,3),%M=$E(%,1)_$E(%,4,5)
. S %P1=$$FMADD(%P1,,%H,%M) Q
;
I %P2["L",%P1["." D ;Build local from UCT
. S %=$$TZ(),%H=$E(%,1,3),%M=$E(%,1)_$E(%,4,5)
. S %P1=$$FMADD(%P1,,%H,%M) Q
Q +$S(%P3:"."_$P(%P1,".",2),1:%P1)
;
DOW(X,Y) ;Day of Week
N %Y,%M,%D,%H,%T D H I $G(Y) Q %Y
Q $P("Sun^Mon^Tues^Wednes^Thurs^Fri^Satur","^",%Y+1)_"day"
;
FMDIFF(X1,X2,X3) ;FM diff in two dates. if X3=1 in days, if X3=2 in seconds.
N %H,%Y,X
S X1=$G(X1),X2=$G(X2),X3=$G(X3,1)
S:$$FR(X1) X1=0 S:$$FR(X2) X2=0 ;Check range, Use 0 for bad values
S X=X1 D H S X1=+%H,X1(1)=$P(%H,",",2),X=X2 D H
;Both FMDIFF and HDIFF come here.
D2 S X=(X1-%H) S:X3>1 X=X*86400+(X1(1)-$P(%H,",",2))
I X3=3 S %=X,X="" S:%'<86400 X=(%\86400) S:%#86400 X=X_" "_(%#86400\3600)_":"_$E(%#3600\60+100,2,3)_":"_$E(%#60+100,2,3)
Q X
;
HDIFF(X1,X2,X3) ;$H diff in two dates, X3 same as FMDIFF.
N X,%H,%T
S:$$HR(X1) X1="1,1" S:$$HR(X2) X2="1,1" ;Check range, use "1,1" for bad values
S X3=$G(X3,1)
S X1(1)=$P(X1,",",2),X1=+X1,%H=X2
G D2
;
HADD(X,D,H,M,S) ;Add to $H date
N %H,%T
Q:$$HR(X) -1 ;Check Range
S %H=+X,%T=$P(X,",",2) D A2 Q %H_","_%T
;
A2 S %H=%H+$G(D),%T=%T+($G(H)*3600)+($G(M)*60)+$G(S) ;add days and seconds
;S:%T'<86400 %H=%H+(%T\86400),%T=%T#86400 S:%T<0 %H=%H+(%T\86400)-1,%T=%T#86400
S %H=%H+(%T\86400) I %T<0,(%T#86400'=0) S %H=%H-1 ;Adj for sec>day
S %T=%T#86400
Q
;
FMADD(X,D,H,M,S) ;Add to FM date
N %H,%T,%P
Q:$$FR(X) -1 ;Check Range
S %P=X[".",%H=$$F2H(X),%T=$P(%H,",",2) D A2
I %P,%T=0 S %H=%H-1,%T=86400
Q $$H2F(%H_","_%T)
;
NOW() ;Current Date/time in FM.
Q $$HTFM($H)
;
DT() ;Current Date in FM.
Q $$HTFM($H,1)\1
;
SCH(SCH,LTM,FF) ;Find the next D/T given a schedule, start time.
Q $$DECODE^XLFDT2
;
WITHIN(XLSCH,XLD) ;See if D/T is within schedule
G WITHIN^XLFDT4
;
SEC(%) ;Convert $H to seconds.
I %?7.N.".".N S %=$$FMTH(%) ;Check for FM date
Q 86400*%+$P(%,",",2)
;
%H(%) ;Covert from seconds to $H
Q (%\86400)_","_(%#86400)
;
TZ() ;Return current Time Zone from Mailman parameter file
N %T,%S
S %T=$P($G(^XMB(4.4,+$P($G(^XMB(1,1,0)),"^",2),0)),"^",3),%S=$S(%T["-":"-",1:"+"),%T=$TR(%T,"-+")
Q %S_$E(100+%T,2,3)_$S(%T[".5":"30",1:"00")
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HXLFDT 6084 printed Sep 23, 2025@19:38:42 Page 2
XLFDT ;ISC-SF/STAFF - Date/Time Functions ;03/27/2003 14:09
+1 ;;8.0;KERNEL;**71,120,166,168,179,280**;Jul 10, 1995
+2 ;VA FileMan uses 2400 as midnight, many other system use 0000.
+3 ;This is true for $H and HL7, so a conversion has to adjust
+4 ;the day when converting Midnight.
+5 ;i.e. 3001225.24 is the same as HL7 '200012260000' and $H '58434,0'
+6 ;The range of accepted $H dates: "2,0" to "99999,85399".
+7 ;The range of accepted FM dates: 1410102 to 4141015 (any valid time).
+8 ;The range of accepted HL7 dates: 18410102 to 21141015 (any valid time).
+9 ;It is expected that input values are valid dates.
+10 ;
HTFM(%H,%F) ;$H to FM, %F=1 for date only
+1 NEW X,%,%T,%Y,%M,%D
if '$DATA(%F)
SET %F=0
+2 ;Check Range
IF $$HR(%H)
QUIT -1
+3 IF '%F
IF %H[",0"
SET %H=(%H-1)_",86400"
+4 DO YMD
if %T&('%F)
SET X=X_%T
+5 QUIT X
+6 ;
H2F(%H) ;Internal to this routine use
+1 NEW X,%,%T,%Y,%M,%D
+2 DO YMD
if %T
SET X=X_%T
+3 QUIT X
+4 ;
YMD ;21608 = 28 feb 1900, 94657 = 28 feb 2100, 141 $H base year
+1 SET %=(%H>21608)+(%H>94657)+%H-.1
SET %Y=%\365.25+141
SET %=%#365.25\1
+2 SET %D=%+306#(%Y#4=0+365)#153#61#31+1
SET %M=%-%D\29+1
+3 SET X=%Y_"00"+%M_"00"+%D
SET %=$PIECE(%H,",",2)
+4 SET %T=%#60/100+(%#3600\60)/100+(%\3600)/100
if '%T
SET %T=".0"
+5 QUIT
+6 ;
FMTH(X,%F) ;FM to $H, %F=1 for date only
+1 NEW %Y,%H,%A
if '$DATA(%F)
SET %F=0
+2 ;$H range of 1 - 99999
IF $$FR(X)
QUIT -1
+3 IF '%F
IF X[".24"
SET %A=1
+4 DO H
if %F
SET %H=+%H
IF $DATA(%A)
SET %H=(%H+1)_",0"
+5 QUIT %H
+6 ;
F2H(X) ;Internal to this routine use
+1 NEW %Y,%H,%A
+2 DO H
+3 QUIT %H
+4 ;
H ;Build %H from FM
+1 NEW %,%L,%M,%D,%T
IF X<1410101
SET %H=0
SET %Y=-1
QUIT
+2 SET %Y=$EXTRACT(X,1,3)
SET %M=$EXTRACT(X,4,5)
SET %D=$EXTRACT(X,6,7)
+3 SET %T=$EXTRACT(X_0,9,10)*60+$EXTRACT(X_"000",11,12)*60+$EXTRACT(X_"00000",13,14)
+4 ;%L = (# leap years) - (# leap years before base)
+5 SET %L=%Y+1700
if %M<3
SET %L=%L-1
SET %L=(%L\4)-(%L\100)+(%L\400)-446
+6 SET %H=$PIECE("^31^59^90^120^151^181^212^243^273^304^334","^",%M)+%D
+7 SET %=('%M)!('%D)
SET %Y=%Y-141
SET %H=(%H+(%Y*365)+%L+%)_","_%T
SET %Y=$SELECT(%:-1,1:%H+4#7)
+8 QUIT
+9 ;
HTE(%H,%F) ;$H to external
+1 ;Range Check
if $$HR(%H)
QUIT %H
+2 NEW Y,%T,%R
+3 SET %F=$GET(%F,1)
SET Y=$$HTFM(%H,0)
GOTO T2
+4 ;
FMTE(Y,%F) ;FM to external
+1 ;Range Check
if (Y<1000000)!(Y>9991231)
QUIT Y
+2 NEW %T,%R
SET %F=$GET(%F,1)
+3 ;Both HTE and FMTE come here.
T2 SET %T="."_$EXTRACT($PIECE(Y,".",2)_"000000",1,7)
+1 DO FMT^XLFDT1
QUIT %R
+2 ;
FR(%V) ;Check FM in valid range
+1 QUIT (%V<1410102)!(%V>4141015.235959)
HR(%V) ;Check $H in valid range
+1 QUIT (%V<2)!(%V>99999)
+2 ;
FMTHL7(%P1) ;Convert FM date/time to HL7 format
+1 ;Make sure a cononic number
NEW %T
if '$LENGTH(%P1)
QUIT ""
SET %P1=+%P1
+2 ;Check range
IF $$FR(%P1)
QUIT -1
+3 SET %T=$PIECE(%P1,".",2)
SET %P1=$PIECE(%P1,".")
+4 IF %T=24
SET %P1=$$FMADD($PIECE(%P1,"."),1)
SET %T="0000"
+5 if %P1>1
SET %P1=%P1+17000000
+6 IF $LENGTH(%T)
SET %T=$SELECT($LENGTH(%T)>4:$EXTRACT(%T_"00",1,6),1:$EXTRACT(%T_"0000",1,4))
+7 IF $LENGTH(%T)
SET %P1=%P1_%T_$$TZ()
+8 QUIT %P1
+9 ;
HL7TFM(%P1,%P2,%P3) ;Convert HL7 D/T to FM.
+1 ;%P1 is the value to convert
+2 ;%P2 is if output should be local or UCT time (L,U)
+3 ;%P3 is 1 if the input just a time value?
+4 NEW %TZ,%LTZ,%SN,%U,%H,%M,%T
if '$LENGTH(%P1)
QUIT ""
+5 SET %T=$EXTRACT(%P1_"0000",1,8)
+6 SET %P2=$GET(%P2)
SET %P3=+$GET(%P3)
SET %TZ=""
SET %LTZ=$$TZ()
+7 ;Date Range Check
IF '%P3
if (%T<18410102)!(%T>21141015)
QUIT -1
+8 ;Find the timezone
FOR %SN="+","-"
IF %P1[%SN
Begin DoDot:1
+9 SET %TZ=$PIECE(%P1,%SN,2)
SET %P1=$PIECE(%P1,%SN)
IF %TZ'?4N
SET %TZ=""
QUIT
+10 SET %TZ=%SN_%TZ
+11 QUIT
End DoDot:1
QUIT
+12 ;FM only supports time to seconds
+13 SET %P1=$PIECE(%P1,".")
+14 ;See it just a Time value
+15 ;Add a date
IF %P3
SET %P1="20000104"_%P1
+16 ;Length check
if ($LENGTH(%P1)#2)!(%P1'?4.14N)
QUIT -1
+17 ;Fill out to 8 digits
IF $LENGTH(%P1)<8
SET %P1=$EXTRACT(%P1_"00000000",1,8)
+18 IF %TZ=""
Begin DoDot:1
+19 ;If no TZ, assume local, don't need L.
if %P2["L"
SET %P2=""
+20 ;give the local tz
if %P2["U"
SET %TZ=%LTZ
End DoDot:1
+21 ;
+22 SET %P1=$SELECT($LENGTH(%P1)>8:$EXTRACT(%P1,1,8)-17000000_"."_$EXTRACT(%P1,9,14),1:%P1-17000000)
+23 ;%P1 is now in FM format
+24 IF %P1["."
IF +$PIECE(%P1,".",2)=0
SET %P1=$$FMADD(+%P1,-1)_".24"
+25 ;If HL7 tz and local tz are the same
+26 IF %P2["L"
IF %TZ=%LTZ
SET %P2=""
+27 ;Build UCT from data
IF (%P2["U")!(%P2["L")
IF %P1["."
Begin DoDot:1
+28 ;Reverse the sign
SET %=$TRANSLATE(%TZ,"+-","-+")
+29 SET %H=$EXTRACT(%,1,3)
SET %M=$EXTRACT(%,1)_$EXTRACT(%,4,5)
+30 SET %P1=$$FMADD(%P1,,%H,%M)
QUIT
End DoDot:1
+31 ;
+32 ;Build local from UCT
IF %P2["L"
IF %P1["."
Begin DoDot:1
+33 SET %=$$TZ()
SET %H=$EXTRACT(%,1,3)
SET %M=$EXTRACT(%,1)_$EXTRACT(%,4,5)
+34 SET %P1=$$FMADD(%P1,,%H,%M)
QUIT
End DoDot:1
+35 QUIT +$SELECT(%P3:"."_$PIECE(%P1,".",2),1:%P1)
+36 ;
DOW(X,Y) ;Day of Week
+1 NEW %Y,%M,%D,%H,%T
DO H
IF $GET(Y)
QUIT %Y
+2 QUIT $PIECE("Sun^Mon^Tues^Wednes^Thurs^Fri^Satur","^",%Y+1)_"day"
+3 ;
FMDIFF(X1,X2,X3) ;FM diff in two dates. if X3=1 in days, if X3=2 in seconds.
+1 NEW %H,%Y,X
+2 SET X1=$GET(X1)
SET X2=$GET(X2)
SET X3=$GET(X3,1)
+3 ;Check range, Use 0 for bad values
if $$FR(X1)
SET X1=0
if $$FR(X2)
SET X2=0
+4 SET X=X1
DO H
SET X1=+%H
SET X1(1)=$PIECE(%H,",",2)
SET X=X2
DO H
+5 ;Both FMDIFF and HDIFF come here.
D2 SET X=(X1-%H)
if X3>1
SET X=X*86400+(X1(1)-$PIECE(%H,",",2))
+1 IF X3=3
SET %=X
SET X=""
if %'<86400
SET X=(%\86400)
if %#86400
SET X=X_" "_(%#86400\3600)_":"_$EXTRACT(%#3600\60+100,2,3)_":"_$EXTRACT(%#60+100,2,3)
+2 QUIT X
+3 ;
HDIFF(X1,X2,X3) ;$H diff in two dates, X3 same as FMDIFF.
+1 NEW X,%H,%T
+2 ;Check range, use "1,1" for bad values
if $$HR(X1)
SET X1="1,1"
if $$HR(X2)
SET X2="1,1"
+3 SET X3=$GET(X3,1)
+4 SET X1(1)=$PIECE(X1,",",2)
SET X1=+X1
SET %H=X2
+5 GOTO D2
+6 ;
HADD(X,D,H,M,S) ;Add to $H date
+1 NEW %H,%T
+2 ;Check Range
if $$HR(X)
QUIT -1
+3 SET %H=+X
SET %T=$PIECE(X,",",2)
DO A2
QUIT %H_","_%T
+4 ;
A2 ;add days and seconds
SET %H=%H+$GET(D)
SET %T=%T+($GET(H)*3600)+($GET(M)*60)+$GET(S)
+1 ;S:%T'<86400 %H=%H+(%T\86400),%T=%T#86400 S:%T<0 %H=%H+(%T\86400)-1,%T=%T#86400
+2 ;Adj for sec>day
SET %H=%H+(%T\86400)
IF %T<0
IF (%T#86400'=0)
SET %H=%H-1
+3 SET %T=%T#86400
+4 QUIT
+5 ;
FMADD(X,D,H,M,S) ;Add to FM date
+1 NEW %H,%T,%P
+2 ;Check Range
if $$FR(X)
QUIT -1
+3 SET %P=X["."
SET %H=$$F2H(X)
SET %T=$PIECE(%H,",",2)
DO A2
+4 IF %P
IF %T=0
SET %H=%H-1
SET %T=86400
+5 QUIT $$H2F(%H_","_%T)
+6 ;
NOW() ;Current Date/time in FM.
+1 QUIT $$HTFM($HOROLOG)
+2 ;
DT() ;Current Date in FM.
+1 QUIT $$HTFM($HOROLOG,1)\1
+2 ;
SCH(SCH,LTM,FF) ;Find the next D/T given a schedule, start time.
+1 QUIT $$DECODE^XLFDT2
+2 ;
WITHIN(XLSCH,XLD) ;See if D/T is within schedule
+1 GOTO WITHIN^XLFDT4
+2 ;
SEC(%) ;Convert $H to seconds.
+1 ;Check for FM date
IF %?7.N.".".N
SET %=$$FMTH(%)
+2 QUIT 86400*%+$PIECE(%,",",2)
+3 ;
%H(%) ;Covert from seconds to $H
+1 QUIT (%\86400)_","_(%#86400)
+2 ;
TZ() ;Return current Time Zone from Mailman parameter file
+1 NEW %T,%S
+2 SET %T=$PIECE($GET(^XMB(4.4,+$PIECE($GET(^XMB(1,1,0)),"^",2),0)),"^",3)
SET %S=$SELECT(%T["-":"-",1:"+")
SET %T=$TRANSLATE(%T,"-+")
+3 QUIT %S_$EXTRACT(100+%T,2,3)_$SELECT(%T[".5":"30",1:"00")
