Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: XLFDT

XLFDT.m

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