| 1 | VWTIME ; 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) | 
|---|
| 26 | DIF(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 | 
|---|
| 123 | BRIEF(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 | ;  =========== | 
|---|
| 147 | TDIFF(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 | ;  ========== | 
|---|
| 208 | F2D(X) ;  Conver FM Date/Time to Decimal | 
|---|
| 209 | N %H,%T,%Y | 
|---|
| 210 | D H^%DTC | 
|---|
| 211 | QUIT $$H2D(%H_","_%T) | 
|---|
| 212 | ;  ======== | 
|---|
| 213 | H2D(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 | ;  ============= | 
|---|
| 218 | LONGAGE(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 | ;  ============= | 
|---|
| 224 | BRFAGE(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 | ;  ============= | 
|---|
| 230 | RPCREG ; 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 | ;  ============ | 
|---|