source: ccr/trunk/p/VWTIME.m@ 1448

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
 ;  ============