LRDAGE ;DFW/MRL/DALOI/FHS - RETURN TIMEFRAME IN DAYS, MONTHS OR YEARS; 15 MAR 90
;;5.2;LAB SERVICE;**279,302**;Sep 27, 1994
;Adapted from IDAGE routine
;If period is under 31 days then format is nnd where d=days
;If period is under 2 years then format is nnm where m=month(s)
;In all other cases format is in nny where y=years
;
;
;Entry point from patient file in VA FileManager
;
DFN(DFN,FILE,LRCDT) ; Call returns patient age based on specimen collection date
; Age is returned as day (dy) month (mo) or years (yr)
; DFN = IEN of patient
; FILE = File number where patient is found
; LRCDT = Specimen collection date otherwise age will be calculated
; using the current date
; Sex is a coded value of Male = "M" (default) Female = "F"
; DOD = Date of Death
N LRSAGE
S:'$G(LRCDT) LRCDT=$$DT^XLFDT
S LRCDT=$P(LRCDT,".")
S SEX="M",AGE="99yr"
D GETS^DIQ(FILE,DFN_",",".02;.03;.351","IE","LRSAGE")
S SEX=$G(LRSAGE(FILE,DFN_",",.02,"I")) S:$L(SEX)="" SEX="M"
S DOB=$G(LRSAGE(FILE,DFN_",",.03,"I")) I '$G(DOB) Q
S DOD=$G(LRSAGE(FILE,DFN_",",.351,"I"))
S AGE=$$DATE(DOB,LRCDT)
Q
;
DATE(DOB,LRCDT) ;Entry point if passing only a valid Date without patient
; Dates must be defined in VA FileManager internal format.
; DOB, Date of birth
; LRCDT = collection date
; Date formate error will return 99yr
N X,Y,%DT
I '$G(LRCDT) S LRCDT=$$DT^XLFDT
S DOB=$P(DOB,".")
I '$G(DOB) Q "99yr" ;no DOB passed
S X=DOB,LRCDT=$P(LRCDT,".")
I $S(DOB'=+DOB:1,LRCDT'=+LRCDT:1,1:0) Q "99yr"
I $S(DOB'?7N.NE:1,LRCDT'?7N.NE:1,1:0) Q "99yr"
D ^%DT I Y'>0 Q "99yr" ;invalid date
S X=LRCDT
K %DT D ^%DT I Y'>0 Q "99yr" ;invalid date
;
CALC ;Calculate timeframe based on difference between DOB and collection
; date. Time is stripped off.
; .0001-24 hour = dy
; 0-29 days = dy
; 30-730 dy = mo
; >24 mo = yr
;
I DOB>LRCDT Q "99yr"
I DOB=LRCDT Q "1dy" ;same dates---pass 1 day old
S X=$E(LRCDT,1,3)-$E(DOB,1,3)-($E(LRCDT,4,7)<$E(DOB,4,7))
I X>1 S X=+X_"yr" Q X ;age 2 years or more---pass in years
S X=$$FMDIFF^XLFDT(LRCDT,DOB,1)
I X>30 S X=X\30_"mo" Q X ;over 30 days---pass in months
E S X=X_"dy" Q X ;under 31 days---pass in days
Q "99yr"
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HLRDAGE 2239 printed Sep 23, 2025@19:49:30 Page 2
LRDAGE ;DFW/MRL/DALOI/FHS - RETURN TIMEFRAME IN DAYS, MONTHS OR YEARS; 15 MAR 90
+1 ;;5.2;LAB SERVICE;**279,302**;Sep 27, 1994
+2 ;Adapted from IDAGE routine
+3 ;If period is under 31 days then format is nnd where d=days
+4 ;If period is under 2 years then format is nnm where m=month(s)
+5 ;In all other cases format is in nny where y=years
+6 ;
+7 ;
+8 ;Entry point from patient file in VA FileManager
+9 ;
DFN(DFN,FILE,LRCDT) ; Call returns patient age based on specimen collection date
+1 ; Age is returned as day (dy) month (mo) or years (yr)
+2 ; DFN = IEN of patient
+3 ; FILE = File number where patient is found
+4 ; LRCDT = Specimen collection date otherwise age will be calculated
+5 ; using the current date
+6 ; Sex is a coded value of Male = "M" (default) Female = "F"
+7 ; DOD = Date of Death
+8 NEW LRSAGE
+9 if '$GET(LRCDT)
SET LRCDT=$$DT^XLFDT
+10 SET LRCDT=$PIECE(LRCDT,".")
+11 SET SEX="M"
SET AGE="99yr"
+12 DO GETS^DIQ(FILE,DFN_",",".02;.03;.351","IE","LRSAGE")
+13 SET SEX=$GET(LRSAGE(FILE,DFN_",",.02,"I"))
if $LENGTH(SEX)=""
SET SEX="M"
+14 SET DOB=$GET(LRSAGE(FILE,DFN_",",.03,"I"))
IF '$GET(DOB)
QUIT
+15 SET DOD=$GET(LRSAGE(FILE,DFN_",",.351,"I"))
+16 SET AGE=$$DATE(DOB,LRCDT)
+17 QUIT
+18 ;
DATE(DOB,LRCDT) ;Entry point if passing only a valid Date without patient
+1 ; Dates must be defined in VA FileManager internal format.
+2 ; DOB, Date of birth
+3 ; LRCDT = collection date
+4 ; Date formate error will return 99yr
+5 NEW X,Y,%DT
+6 IF '$GET(LRCDT)
SET LRCDT=$$DT^XLFDT
+7 SET DOB=$PIECE(DOB,".")
+8 ;no DOB passed
IF '$GET(DOB)
QUIT "99yr"
+9 SET X=DOB
SET LRCDT=$PIECE(LRCDT,".")
+10 IF $SELECT(DOB'=+DOB:1,LRCDT'=+LRCDT:1,1:0)
QUIT "99yr"
+11 IF $SELECT(DOB'?7N.NE:1,LRCDT'?7N.NE:1,1:0)
QUIT "99yr"
+12 ;invalid date
DO ^%DT
IF Y'>0
QUIT "99yr"
+13 SET X=LRCDT
+14 ;invalid date
KILL %DT
DO ^%DT
IF Y'>0
QUIT "99yr"
+15 ;
CALC ;Calculate timeframe based on difference between DOB and collection
+1 ; date. Time is stripped off.
+2 ; .0001-24 hour = dy
+3 ; 0-29 days = dy
+4 ; 30-730 dy = mo
+5 ; >24 mo = yr
+6 ;
+7 IF DOB>LRCDT
QUIT "99yr"
+8 ;same dates---pass 1 day old
IF DOB=LRCDT
QUIT "1dy"
+9 SET X=$EXTRACT(LRCDT,1,3)-$EXTRACT(DOB,1,3)-($EXTRACT(LRCDT,4,7)<$EXTRACT(DOB,4,7))
+10 ;age 2 years or more---pass in years
IF X>1
SET X=+X_"yr"
QUIT X
+11 SET X=$$FMDIFF^XLFDT(LRCDT,DOB,1)
+12 ;over 30 days---pass in months
IF X>30
SET X=X\30_"mo"
QUIT X
+13 ;under 31 days---pass in days
IF '$TEST
SET X=X_"dy"
QUIT X
+14 QUIT "99yr"
