source: WorldVistAEHR/trunk/r/KERNEL-XU-A4A7-USC-XG-XLF-XNOA-XPD-XQ-XVIR-ZI-ZOSF-ZOSV-ZT-ZU-%Z-XIP--XQAB--XUC--XUR--ZIN--ZTED/XLFDT.m@ 789

Last change on this file since 789 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR

File size: 5.8 KB
Line 
1XLFDT ;ISC-SF/STAFF - Date/Time Functions ;03/27/2003 14:09
2 ;;8.0;KERNEL;**71,120,166,168,179,280**;Jul 10, 1995
3 ;VA FileMan uses 2400 as midnight, many other system use 0000.
4 ;This is true for $H and HL7, so a conversion has to adjust
5 ;the day when converting Midnight.
6 ;i.e. 3001225.24 is the same as HL7 '200012260000' and $H '58434,0'
7 ;The range of accepted $H dates: "2,0" to "99999,85399".
8 ;The range of accepted FM dates: 1410102 to 4141015 (any valid time).
9 ;The range of accepted HL7 dates: 18410102 to 21141015 (any valid time).
10 ;It is expected that input values are valid dates.
11 ;
12HTFM(%H,%F) ;$H to FM, %F=1 for date only
13 N X,%,%T,%Y,%M,%D S:'$D(%F) %F=0
14 I $$HR(%H) Q -1 ;Check Range
15 I '%F,%H[",0" S %H=(%H-1)_",86400"
16 D YMD S:%T&('%F) X=X_%T
17 Q X
18 ;
19H2F(%H) ;Internal to this routine use
20 N X,%,%T,%Y,%M,%D
21 D YMD S:%T X=X_%T
22 Q X
23 ;
24YMD ;21608 = 28 feb 1900, 94657 = 28 feb 2100, 141 $H base year
25 S %=(%H>21608)+(%H>94657)+%H-.1,%Y=%\365.25+141,%=%#365.25\1
26 S %D=%+306#(%Y#4=0+365)#153#61#31+1,%M=%-%D\29+1
27 S X=%Y_"00"+%M_"00"+%D,%=$P(%H,",",2)
28 S %T=%#60/100+(%#3600\60)/100+(%\3600)/100 S:'%T %T=".0"
29 Q
30 ;
31FMTH(X,%F) ;FM to $H, %F=1 for date only
32 N %Y,%H,%A S:'$D(%F) %F=0
33 I $$FR(X) Q -1 ;$H range of 1 - 99999
34 I '%F,X[".24" S %A=1
35 D H S:%F %H=+%H I $D(%A) S %H=(%H+1)_",0"
36 Q %H
37 ;
38F2H(X) ;Internal to this routine use
39 N %Y,%H,%A
40 D H
41 Q %H
42 ;
43H ;Build %H from FM
44 N %,%L,%M,%D,%T I X<1410101 S %H=0,%Y=-1 Q
45 S %Y=$E(X,1,3),%M=$E(X,4,5),%D=$E(X,6,7)
46 S %T=$E(X_0,9,10)*60+$E(X_"000",11,12)*60+$E(X_"00000",13,14)
47 ;%L = (# leap years) - (# leap years before base)
48 S %L=%Y+1700 S:%M<3 %L=%L-1 S %L=(%L\4)-(%L\100)+(%L\400)-446
49 S %H=$P("^31^59^90^120^151^181^212^243^273^304^334","^",%M)+%D
50 S %=('%M)!('%D),%Y=%Y-141,%H=(%H+(%Y*365)+%L+%)_","_%T,%Y=$S(%:-1,1:%H+4#7)
51 Q
52 ;
53HTE(%H,%F) ;$H to external
54 Q:$$HR(%H) %H ;Range Check
55 N Y,%T,%R
56 S %F=$G(%F,1) S Y=$$HTFM(%H,0) G T2
57 ;
58FMTE(Y,%F) ;FM to external
59 Q:(Y<1000000)!(Y>9991231) Y ;Range Check
60 N %T,%R S %F=$G(%F,1)
61 ;Both HTE and FMTE come here.
62T2 S %T="."_$E($P(Y,".",2)_"000000",1,7)
63 D FMT^XLFDT1 Q %R
64 ;
65FR(%V) ;Check FM in valid range
66 Q (%V<1410102)!(%V>4141015.235959)
67HR(%V) ;Check $H in valid range
68 Q (%V<2)!(%V>99999)
69 ;
70FMTHL7(%P1) ;Convert FM date/time to HL7 format
71 N %T Q:'$L(%P1) "" S %P1=+%P1 ;Make sure a cononic number
72 I $$FR(%P1) Q -1 ;Check range
73 S %T=$P(%P1,".",2),%P1=$P(%P1,".")
74 I %T=24 S %P1=$$FMADD($P(%P1,"."),1),%T="0000"
75 S:%P1>1 %P1=%P1+17000000
76 I $L(%T) S %T=$S($L(%T)>4:$E(%T_"00",1,6),1:$E(%T_"0000",1,4))
77 I $L(%T) S %P1=%P1_%T_$$TZ()
78 Q %P1
79 ;
80HL7TFM(%P1,%P2,%P3) ;Convert HL7 D/T to FM.
81 ;%P1 is the value to convert
82 ;%P2 is if output should be local or UCT time (L,U)
83 ;%P3 is 1 if the input just a time value?
84 N %TZ,%LTZ,%SN,%U,%H,%M,%T Q:'$L(%P1) ""
85 S %T=$E(%P1_"0000",1,8)
86 S %P2=$G(%P2),%P3=+$G(%P3),%TZ="",%LTZ=$$TZ()
87 I '%P3 Q:(%T<18410102)!(%T>21141015) -1 ;Date Range Check
88 F %SN="+","-" I %P1[%SN D Q ;Find the timezone
89 . S %TZ=$P(%P1,%SN,2),%P1=$P(%P1,%SN) I %TZ'?4N S %TZ="" Q
90 . S %TZ=%SN_%TZ
91 . Q
92 ;FM only supports time to seconds
93 S %P1=$P(%P1,".")
94 ;See it just a Time value
95 I %P3 S %P1="20000104"_%P1 ;Add a date
96 Q:($L(%P1)#2)!(%P1'?4.14N) -1 ;Length check
97 I $L(%P1)<8 S %P1=$E(%P1_"00000000",1,8) ;Fill out to 8 digits
98 I %TZ="" D
99 . S:%P2["L" %P2="" ;If no TZ, assume local, don't need L.
100 . S:%P2["U" %TZ=%LTZ ;give the local tz
101 ;
102 S %P1=$S($L(%P1)>8:$E(%P1,1,8)-17000000_"."_$E(%P1,9,14),1:%P1-17000000)
103 ;%P1 is now in FM format
104 I %P1[".",+$P(%P1,".",2)=0 S %P1=$$FMADD(+%P1,-1)_".24"
105 ;If HL7 tz and local tz are the same
106 I %P2["L",%TZ=%LTZ S %P2=""
107 I (%P2["U")!(%P2["L"),%P1["." D ;Build UCT from data
108 . S %=$TR(%TZ,"+-","-+") ;Reverse the sign
109 . S %H=$E(%,1,3),%M=$E(%,1)_$E(%,4,5)
110 . S %P1=$$FMADD(%P1,,%H,%M) Q
111 ;
112 I %P2["L",%P1["." D ;Build local from UCT
113 . S %=$$TZ(),%H=$E(%,1,3),%M=$E(%,1)_$E(%,4,5)
114 . S %P1=$$FMADD(%P1,,%H,%M) Q
115 Q +$S(%P3:"."_$P(%P1,".",2),1:%P1)
116 ;
117DOW(X,Y) ;Day of Week
118 N %Y,%M,%D,%H,%T D H I $G(Y) Q %Y
119 Q $P("Sun^Mon^Tues^Wednes^Thurs^Fri^Satur","^",%Y+1)_"day"
120 ;
121FMDIFF(X1,X2,X3) ;FM diff in two dates. if X3=1 in days, if X3=2 in seconds.
122 N %H,%Y,X
123 S X1=$G(X1),X2=$G(X2),X3=$G(X3,1)
124 S:$$FR(X1) X1=0 S:$$FR(X2) X2=0 ;Check range, Use 0 for bad values
125 S X=X1 D H S X1=+%H,X1(1)=$P(%H,",",2),X=X2 D H
126 ;Both FMDIFF and HDIFF come here.
127D2 S X=(X1-%H) S:X3>1 X=X*86400+(X1(1)-$P(%H,",",2))
128 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)
129 Q X
130 ;
131HDIFF(X1,X2,X3) ;$H diff in two dates, X3 same as FMDIFF.
132 N X,%H,%T
133 S:$$HR(X1) X1="1,1" S:$$HR(X2) X2="1,1" ;Check range, use "1,1" for bad values
134 S X3=$G(X3,1)
135 S X1(1)=$P(X1,",",2),X1=+X1,%H=X2
136 G D2
137 ;
138HADD(X,D,H,M,S) ;Add to $H date
139 N %H,%T
140 Q:$$HR(X) -1 ;Check Range
141 S %H=+X,%T=$P(X,",",2) D A2 Q %H_","_%T
142 ;
143A2 S %H=%H+$G(D),%T=%T+($G(H)*3600)+($G(M)*60)+$G(S) ;add days and seconds
144 ;S:%T'<86400 %H=%H+(%T\86400),%T=%T#86400 S:%T<0 %H=%H+(%T\86400)-1,%T=%T#86400
145 S %H=%H+(%T\86400) I %T<0,(%T#86400'=0) S %H=%H-1 ;Adj for sec>day
146 S %T=%T#86400
147 Q
148 ;
149FMADD(X,D,H,M,S) ;Add to FM date
150 N %H,%T,%P
151 Q:$$FR(X) -1 ;Check Range
152 S %P=X[".",%H=$$F2H(X),%T=$P(%H,",",2) D A2
153 I %P,%T=0 S %H=%H-1,%T=86400
154 Q $$H2F(%H_","_%T)
155 ;
156NOW() ;Current Date/time in FM.
157 Q $$HTFM($H)
158 ;
159DT() ;Current Date in FM.
160 Q $$HTFM($H,1)\1
161 ;
162SCH(SCH,LTM,FF) ;Find the next D/T given a schedule, start time.
163 Q $$DECODE^XLFDT2
164 ;
165WITHIN(XLSCH,XLD) ;See if D/T is within schedule
166 G WITHIN^XLFDT4
167 ;
168SEC(%) ;Convert $H to seconds.
169 I %?7.N.".".N S %=$$FMTH(%) ;Check for FM date
170 Q 86400*%+$P(%,",",2)
171 ;
172%H(%) ;Covert from seconds to $H
173 Q (%\86400)_","_(%#86400)
174 ;
175TZ() ;Return current Time Zone from Mailman parameter file
176 N %T,%S
177 S %T=$P($G(^XMB(4.4,+$P($G(^XMB(1,1,0)),"^",2),0)),"^",3),%S=$S(%T["-":"-",1:"+"),%T=$TR(%T,"-+")
178 Q %S_$E(100+%T,2,3)_$S(%T[".5":"30",1:"00")
Note: See TracBrowser for help on using the repository browser.