VWTIME needed for CPRS 27 - fix for eRX
This commit is contained in:
george
parent
964e26c2fe
commit
77646915c0
|
|
@ -0,0 +1,239 @@
|
|||
VWTIME ; Report Age in Time / Date;5:33 AM 11 Feb 2010
|
||||
;;1.0;WorldVistA;;WorldVistA 30-June-08;Build 2
|
||||
;
|
||||
;Modified from FOIA VISTA,
|
||||
;Copyright 2008 WorldVistA. Licensed under the terms of the GNU
|
||||
;General Public License See attached copy of the License.
|
||||
;
|
||||
;This program is free software; you can redistribute it and/or modify
|
||||
;it under the terms of the GNU General Public License as published by
|
||||
;the Free Software Foundation; either version 2 of the License, or
|
||||
;(at your option) any later version.
|
||||
;
|
||||
;This program is distributed in the hope that it will be useful,
|
||||
;but WITHOUT ANY WARRANTY; without even the implied warranty of
|
||||
;MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
||||
;GNU General Public License for more details.
|
||||
;
|
||||
;You should have received a copy of the GNU General Public License along
|
||||
;with this program; if not, write to the Free Software Foundation, Inc.,
|
||||
;51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
|
||||
;
|
||||
QUIT ; No Fall Through
|
||||
; =============
|
||||
; FDT = First Date/Time (SD)
|
||||
; W $$DIF^VWTIME(3090512.1145)
|
||||
DIF(SD,ED) ; Now a Call will look like the above
|
||||
N BUF,DED,DSD,EH,EI,FTD
|
||||
S SD=$G(SD),ED=$G(ED)
|
||||
I ED="" D NOW^%DTC S ED=%
|
||||
I SD<.00001 D NOW^%DTC S SD=% ; Invalid start date is set to now
|
||||
S X=SD
|
||||
D
|
||||
. I SD="" S ER=99 Q
|
||||
. ;
|
||||
. ; Convert both Values to Fileman Time to Decimal.
|
||||
. ; We are interested in just the differences
|
||||
. ;
|
||||
. I SD>1400000 D
|
||||
. . S X=$$F2D(SD)
|
||||
. . D H^%DTC
|
||||
. . S SD=%H_","_$TR($J(%T,5)," ","0")
|
||||
. .QUIT
|
||||
. S DST=$$F2D(SD)
|
||||
. S DET=$$F2D(ED)
|
||||
.QUIT
|
||||
; Decimal Date/Times calculated in DST (start) and DET (end),
|
||||
; differeence of DET-DST is FTD - First Time and Date, DTD - Declining Time and Date
|
||||
S (DTD,FTD)=DET-DST
|
||||
; Time Frames
|
||||
; 1 Minute = .000694444444444444444
|
||||
; 1 Hour = .0416666666666666666
|
||||
; 1 Day = 1
|
||||
; 1 WeeK = 7
|
||||
; 1 Month = 30.5
|
||||
; 1 Year = 365.249
|
||||
N BUF,DAY,HR,MIN,MON,WK,YR
|
||||
S BUF=""
|
||||
S DAY=1
|
||||
S SEP=""
|
||||
D
|
||||
. N HR,MON,YR,WEEK
|
||||
. S MON=30.49,YR=365.249,HR=1/24,WEEK=7
|
||||
. I FTD>(2*YR) D
|
||||
. . S T=DTD\YR
|
||||
. . S BUF=BUF_SEP_T_" Year"
|
||||
. . S:T>1 BUF=BUF_"s"
|
||||
. . S DTD=(DTD#YR),SEP=", "
|
||||
. . .QUIT
|
||||
. QUIT:FTD>(20*YR)
|
||||
. ;
|
||||
. ; Time Calculations
|
||||
. I FTD>(4*MON) I FTD<(18*YR) D
|
||||
. . S T=DTD\MON
|
||||
. . S BUF=BUF_SEP_T_" Month"
|
||||
. . S:T>1 BUF=BUF_"s"
|
||||
. . S DTD=(DTD#MON),SEP=", "
|
||||
. .QUIT
|
||||
. QUIT:FTD>(18*YR)
|
||||
. I FTD>29 I FTD<4*WEEK D
|
||||
. . S T=DTD\WEEK
|
||||
. . S BUF=BUF_SEP_T_" Week"
|
||||
. . S:T>1 BUF=BUF_"s"
|
||||
. . S DTD=(DTD#WEEK),SEP=", "
|
||||
. .QUIT
|
||||
. ; Time Calculations
|
||||
. I FTD<29 I DTD'<2 D
|
||||
. . S T=DTD\1
|
||||
. . S BUF=BUF_SEP_T_" Day"
|
||||
. . S:T>1 BUF=BUF_"s"
|
||||
. . S DTD=(DTD#DAY),SEP=", "
|
||||
. .QUIT
|
||||
. I DTD>.999999&(FTD<4) D
|
||||
. . S T=DTD\HR
|
||||
. . S BUF=BUF_SEP_T_" Hour"
|
||||
. . S:T>1 BUF=BUF_"s"
|
||||
. . S DTD=(DTD#HR),SEP=", "
|
||||
. .QUIT
|
||||
. D:(FTD<4.00000001)
|
||||
. . N MIN,HR
|
||||
. . S HR=1/24,SEP=$G(SEP)
|
||||
. . S MIN=HR/60
|
||||
. . ;
|
||||
. . I DTD>MIN D
|
||||
. . . S T=DTD\MIN
|
||||
. . . S BUF=BUF_SEP_T_" Minute"
|
||||
. . . S:T>1 BUF=BUF_"s"
|
||||
. . . S DTD=(DTD#MIN),SEP=", "
|
||||
. .QUIT
|
||||
. . ;
|
||||
. . S SEC=MIN/60
|
||||
. . I DTD>SEC D
|
||||
. . . S T=DTD\SEC
|
||||
. . . S BUF=BUF_SEP_T_" Second"
|
||||
. . . S:T>1 BUF=BUF_"s"
|
||||
. . . S DTD=(DTD#SEC),SEP=", "
|
||||
. . .QUIT
|
||||
. .QUIT
|
||||
. ; I DTD S BUF=BUF_" Less than a Minute"
|
||||
.QUIT
|
||||
QUIT BUF
|
||||
; ==========
|
||||
; W $$BRIEF^VWTIME(DOB) >>> Years^Months^Weeks^Days^Hours^Minutes^Seconds
|
||||
BRIEF(SD,ED) ; Now a Call will look like the above
|
||||
N BUF,DED,DSD,EH,EI,FTD,BUF
|
||||
S SD=$G(SD),ED=$G(ED)
|
||||
I ED="" D NOW^%DTC S ED=%
|
||||
S:SD<2 SD=""
|
||||
S BUF="INVALID INPUT"
|
||||
D:SD ; SD has been checked and passed if it passes here
|
||||
. S X=SD
|
||||
. ;
|
||||
. ; Convert both Values to Fileman Time to Decimal.
|
||||
. ; We are interested in just the differences
|
||||
. ;
|
||||
. ; I SD>1400000 D
|
||||
. ; . S X=$$F2D(SD)
|
||||
. ; . D H^%DTC
|
||||
. ; . S SD=%H_","_$TR($J(%T,5)," ","0")
|
||||
. ; .QUIT
|
||||
. ; If we get here, we have the ST and ET defined and ready
|
||||
. S DST=$$F2D(SD)
|
||||
. S DET=$$F2D(ED)
|
||||
. D TDIFF(.BUF)
|
||||
.QUIT
|
||||
QUIT BUF
|
||||
; ===========
|
||||
TDIFF(BF) ; Time Difference formulation
|
||||
; Decimal Date/Times calculated in DST (start) and DET (end),
|
||||
; differeence of DET-DST is FTD - First Time and Date, DTD - Declining Time and Date
|
||||
S (DTD,FTD)=DET-DST
|
||||
; Time Frames
|
||||
; 1 Minute = .000694444444444444444
|
||||
; 1 Hour = .0416666666666666666
|
||||
; 1 Day = 1
|
||||
; 1 WeeK = 7
|
||||
; 1 Month = 30.5
|
||||
; 1 Year = 365.249
|
||||
N DAY,HR,MIN,MON,WK,YR
|
||||
S $P(BF,"^",7)=""
|
||||
S DAY=1
|
||||
S SEP=""
|
||||
D
|
||||
. N HR,MON,YR,WEEK
|
||||
. S MON=30.49,YR=365.249,HR=1/24,WEEK=7
|
||||
. I FTD>(2*YR) D
|
||||
. . S $P(BF,"^")=DTD\YR
|
||||
. . S DTD=(DTD#YR)
|
||||
. .QUIT
|
||||
. ;
|
||||
. ; Time Calculations
|
||||
. I FTD>(4*MON) I FTD<(18*YR) D
|
||||
. . S $P(BF,"^",2)=DTD\MON
|
||||
. . S DTD=(DTD#MON)
|
||||
. .QUIT
|
||||
. D ; I FTD>29 I FTD<4*WEEK D
|
||||
. . S $P(BF,"^",3)=DTD\WEEK
|
||||
. . S DTD=(DTD#WEEK)
|
||||
. .QUIT
|
||||
. ; Time Calculations
|
||||
. D ; I FTD<29 I DTD'<2 D
|
||||
. . S $P(BF,"^",4)=DTD\1
|
||||
. . S DTD=(DTD#DAY)
|
||||
. .QUIT
|
||||
. D ; I DTD>.999999&(FTD<4) D
|
||||
. . S $P(BF,"^",5)=DTD\HR
|
||||
. . S DTD=(DTD#HR)
|
||||
. .QUIT
|
||||
. S MIN=1/(24*60)
|
||||
. D ; :(FTD<4.00000001)
|
||||
. . N HR
|
||||
. . S HR=1/24
|
||||
. . S MIN=HR/60
|
||||
. . ;
|
||||
. . ; I DTD>MIN D
|
||||
. . S $P(BF,"^",6)=DTD\MIN
|
||||
. . S DTD=(DTD#MIN)
|
||||
. .QUIT
|
||||
. . ;
|
||||
. S SEC=MIN/60
|
||||
. ; I DTD>SEC D
|
||||
. S $P(BF,"^",7)=DTD\SEC
|
||||
. S DTD=(DTD#SEC)
|
||||
. .QUIT
|
||||
. ; I DTD S BF=BF_" Less than a Minute"
|
||||
.QUIT
|
||||
QUIT
|
||||
; ==========
|
||||
F2D(X) ; Conver FM Date/Time to Decimal
|
||||
N %H,%T,%Y
|
||||
D H^%DTC
|
||||
QUIT $$H2D(%H_","_%T)
|
||||
; ========
|
||||
H2D(X) ; Convert Horolog to Decimal Days
|
||||
N D,T
|
||||
S D=$P(X,","),T=$P(X,",",2)/86400
|
||||
QUIT D+T
|
||||
; =============
|
||||
LONGAGE(VWAGE,VWDFN) ; RPC FOR LONG AGE
|
||||
N VWDOB
|
||||
S VWDOB=$P(^DPT(VWDFN,0),"^",3)
|
||||
S VWAGE=$$DIF(VWDOB)
|
||||
QUIT
|
||||
; =============
|
||||
BRFAGE(VWAGE,VWDFN) ; RPC FOR BRIEF AGE
|
||||
N VWDOB
|
||||
S VWDOB=$P(^DPT(VWDFN,0),"^",3)
|
||||
S VWAGE=$$BRIEF(VWDOB)
|
||||
QUIT
|
||||
; =============
|
||||
RPCREG ; Register NEW RPCs
|
||||
N MENU,RPC,FDA,FDAIEN,ERR,DIERR
|
||||
S MENU="OR CPRS GUI CHART"
|
||||
F RPC="VWTIME LONG AGE","VWTIME BRIEF AGE" D
|
||||
. S FDA(19,"?1,",.01)=MENU
|
||||
. S FDA(19.05,"?+2,?1,",.01)=RPC
|
||||
. D UPDATE^DIE("E","FDA","FDAIEN","ERR")
|
||||
.QUIT
|
||||
QUIT
|
||||
; ============
|
||||
Loading…
Reference in New Issue