source: ccr/branches/ohum/p/VWTIME.m@ 1313

Last change on this file since 1313 was 1213, checked in by George Lilly, 14 years ago

VWTIME needed for CPRS 27 - fix for eRX
File size: 5.9 KB
Line 
1VWTIME ; Report Age in Time / Date;5:33 AM 11 Feb 2010
2 ;;1.0;WorldVistA;;WorldVistA 30-June-08;Build 2
3 ;
4 ;Modified from FOIA VISTA,
5 ;Copyright 2008 WorldVistA. Licensed under the terms of the GNU
6 ;General Public License See attached copy of the License.
7 ;
8 ;This program is free software; you can redistribute it and/or modify
9 ;it under the terms of the GNU General Public License as published by
10 ;the Free Software Foundation; either version 2 of the License, or
11 ;(at your option) any later version.
12 ;
13 ;This program is distributed in the hope that it will be useful,
14 ;but WITHOUT ANY WARRANTY; without even the implied warranty of
15 ;MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
16 ;GNU General Public License for more details.
17 ;
18 ;You should have received a copy of the GNU General Public License along
19 ;with this program; if not, write to the Free Software Foundation, Inc.,
20 ;51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
21 ;
22 QUIT ; No Fall Through
23 ; =============
24 ; FDT = First Date/Time (SD)
25 ; W $$DIF^VWTIME(3090512.1145)
26DIF(SD,ED) ; Now a Call will look like the above
27 N BUF,DED,DSD,EH,EI,FTD
28 S SD=$G(SD),ED=$G(ED)
29 I ED="" D NOW^%DTC S ED=%
30 I SD<.00001 D NOW^%DTC S SD=% ; Invalid start date is set to now
31 S X=SD
32 D
33 . I SD="" S ER=99 Q
34 . ;
35 . ; Convert both Values to Fileman Time to Decimal.
36 . ; We are interested in just the differences
37 . ;
38 . I SD>1400000 D
39 . . S X=$$F2D(SD)
40 . . D H^%DTC
41 . . S SD=%H_","_$TR($J(%T,5)," ","0")
42 . .QUIT
43 . S DST=$$F2D(SD)
44 . S DET=$$F2D(ED)
45 .QUIT
46 ; Decimal Date/Times calculated in DST (start) and DET (end),
47 ; differeence of DET-DST is FTD - First Time and Date, DTD - Declining Time and Date
48 S (DTD,FTD)=DET-DST
49 ; Time Frames
50 ; 1 Minute = .000694444444444444444
51 ; 1 Hour = .0416666666666666666
52 ; 1 Day = 1
53 ; 1 WeeK = 7
54 ; 1 Month = 30.5
55 ; 1 Year = 365.249
56 N BUF,DAY,HR,MIN,MON,WK,YR
57 S BUF=""
58 S DAY=1
59 S SEP=""
60 D
61 . N HR,MON,YR,WEEK
62 . S MON=30.49,YR=365.249,HR=1/24,WEEK=7
63 . I FTD>(2*YR) D
64 . . S T=DTD\YR
65 . . S BUF=BUF_SEP_T_" Year"
66 . . S:T>1 BUF=BUF_"s"
67 . . S DTD=(DTD#YR),SEP=", "
68 . . .QUIT
69 . QUIT:FTD>(20*YR)
70 . ;
71 . ; Time Calculations
72 . I FTD>(4*MON) I FTD<(18*YR) D
73 . . S T=DTD\MON
74 . . S BUF=BUF_SEP_T_" Month"
75 . . S:T>1 BUF=BUF_"s"
76 . . S DTD=(DTD#MON),SEP=", "
77 . .QUIT
78 . QUIT:FTD>(18*YR)
79 . I FTD>29 I FTD<4*WEEK D
80 . . S T=DTD\WEEK
81 . . S BUF=BUF_SEP_T_" Week"
82 . . S:T>1 BUF=BUF_"s"
83 . . S DTD=(DTD#WEEK),SEP=", "
84 . .QUIT
85 . ; Time Calculations
86 . I FTD<29 I DTD'<2 D
87 . . S T=DTD\1
88 . . S BUF=BUF_SEP_T_" Day"
89 . . S:T>1 BUF=BUF_"s"
90 . . S DTD=(DTD#DAY),SEP=", "
91 . .QUIT
92 . I DTD>.999999&(FTD<4) D
93 . . S T=DTD\HR
94 . . S BUF=BUF_SEP_T_" Hour"
95 . . S:T>1 BUF=BUF_"s"
96 . . S DTD=(DTD#HR),SEP=", "
97 . .QUIT
98 . D:(FTD<4.00000001)
99 . . N MIN,HR
100 . . S HR=1/24,SEP=$G(SEP)
101 . . S MIN=HR/60
102 . . ;
103 . . I DTD>MIN D
104 . . . S T=DTD\MIN
105 . . . S BUF=BUF_SEP_T_" Minute"
106 . . . S:T>1 BUF=BUF_"s"
107 . . . S DTD=(DTD#MIN),SEP=", "
108 . .QUIT
109 . . ;
110 . . S SEC=MIN/60
111 . . I DTD>SEC D
112 . . . S T=DTD\SEC
113 . . . S BUF=BUF_SEP_T_" Second"
114 . . . S:T>1 BUF=BUF_"s"
115 . . . S DTD=(DTD#SEC),SEP=", "
116 . . .QUIT
117 . .QUIT
118 . ; I DTD S BUF=BUF_" Less than a Minute"
119 .QUIT
120 QUIT BUF
121 ; ==========
122 ; W $$BRIEF^VWTIME(DOB) >>> Years^Months^Weeks^Days^Hours^Minutes^Seconds
123BRIEF(SD,ED) ; Now a Call will look like the above
124 N BUF,DED,DSD,EH,EI,FTD,BUF
125 S SD=$G(SD),ED=$G(ED)
126 I ED="" D NOW^%DTC S ED=%
127 S:SD<2 SD=""
128 S BUF="INVALID INPUT"
129 D:SD ; SD has been checked and passed if it passes here
130 . S X=SD
131 . ;
132 . ; Convert both Values to Fileman Time to Decimal.
133 . ; We are interested in just the differences
134 . ;
135 . ; I SD>1400000 D
136 . ; . S X=$$F2D(SD)
137 . ; . D H^%DTC
138 . ; . S SD=%H_","_$TR($J(%T,5)," ","0")
139 . ; .QUIT
140 . ; If we get here, we have the ST and ET defined and ready
141 . S DST=$$F2D(SD)
142 . S DET=$$F2D(ED)
143 . D TDIFF(.BUF)
144 .QUIT
145 QUIT BUF
146 ; ===========
147TDIFF(BF) ; Time Difference formulation
148 ; Decimal Date/Times calculated in DST (start) and DET (end),
149 ; differeence of DET-DST is FTD - First Time and Date, DTD - Declining Time and Date
150 S (DTD,FTD)=DET-DST
151 ; Time Frames
152 ; 1 Minute = .000694444444444444444
153 ; 1 Hour = .0416666666666666666
154 ; 1 Day = 1
155 ; 1 WeeK = 7
156 ; 1 Month = 30.5
157 ; 1 Year = 365.249
158 N DAY,HR,MIN,MON,WK,YR
159 S $P(BF,"^",7)=""
160 S DAY=1
161 S SEP=""
162 D
163 . N HR,MON,YR,WEEK
164 . S MON=30.49,YR=365.249,HR=1/24,WEEK=7
165 . I FTD>(2*YR) D
166 . . S $P(BF,"^")=DTD\YR
167 . . S DTD=(DTD#YR)
168 . .QUIT
169 . ;
170 . ; Time Calculations
171 . I FTD>(4*MON) I FTD<(18*YR) D
172 . . S $P(BF,"^",2)=DTD\MON
173 . . S DTD=(DTD#MON)
174 . .QUIT
175 . D ; I FTD>29 I FTD<4*WEEK D
176 . . S $P(BF,"^",3)=DTD\WEEK
177 . . S DTD=(DTD#WEEK)
178 . .QUIT
179 . ; Time Calculations
180 . D ; I FTD<29 I DTD'<2 D
181 . . S $P(BF,"^",4)=DTD\1
182 . . S DTD=(DTD#DAY)
183 . .QUIT
184 . D ; I DTD>.999999&(FTD<4) D
185 . . S $P(BF,"^",5)=DTD\HR
186 . . S DTD=(DTD#HR)
187 . .QUIT
188 . S MIN=1/(24*60)
189 . D ; :(FTD<4.00000001)
190 . . N HR
191 . . S HR=1/24
192 . . S MIN=HR/60
193 . . ;
194 . . ; I DTD>MIN D
195 . . S $P(BF,"^",6)=DTD\MIN
196 . . S DTD=(DTD#MIN)
197 . .QUIT
198 . . ;
199 . S SEC=MIN/60
200 . ; I DTD>SEC D
201 . S $P(BF,"^",7)=DTD\SEC
202 . S DTD=(DTD#SEC)
203 . .QUIT
204 . ; I DTD S BF=BF_" Less than a Minute"
205 .QUIT
206 QUIT
207 ; ==========
208F2D(X) ; Conver FM Date/Time to Decimal
209 N %H,%T,%Y
210 D H^%DTC
211 QUIT $$H2D(%H_","_%T)
212 ; ========
213H2D(X) ; Convert Horolog to Decimal Days
214 N D,T
215 S D=$P(X,","),T=$P(X,",",2)/86400
216 QUIT D+T
217 ; =============
218LONGAGE(VWAGE,VWDFN) ; RPC FOR LONG AGE
219 N VWDOB
220 S VWDOB=$P(^DPT(VWDFN,0),"^",3)
221 S VWAGE=$$DIF(VWDOB)
222 QUIT
223 ; =============
224BRFAGE(VWAGE,VWDFN) ; RPC FOR BRIEF AGE
225 N VWDOB
226 S VWDOB=$P(^DPT(VWDFN,0),"^",3)
227 S VWAGE=$$BRIEF(VWDOB)
228 QUIT
229 ; =============
230RPCREG ; Register NEW RPCs
231 N MENU,RPC,FDA,FDAIEN,ERR,DIERR
232 S MENU="OR CPRS GUI CHART"
233 F RPC="VWTIME LONG AGE","VWTIME BRIEF AGE" D
234 . S FDA(19,"?1,",.01)=MENU
235 . S FDA(19.05,"?+2,?1,",.01)=RPC
236 . D UPDATE^DIE("E","FDA","FDAIEN","ERR")
237 .QUIT
238 QUIT
239 ; ============
Note: See TracBrowser for help on using the repository browser.