Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: LRDAGE

LRDAGE.m

Go to the documentation of this file.
  1. 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
  1. ;Adapted from IDAGE routine
  1. ;If period is under 31 days then format is nnd where d=days
  1. ;If period is under 2 years then format is nnm where m=month(s)
  1. ;In all other cases format is in nny where y=years
  1. ;
  1. ;
  1. ;Entry point from patient file in VA FileManager
  1. ;
  1. 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)
  1. ; DFN = IEN of patient
  1. ; FILE = File number where patient is found
  1. ; LRCDT = Specimen collection date otherwise age will be calculated
  1. ; using the current date
  1. ; Sex is a coded value of Male = "M" (default) Female = "F"
  1. ; DOD = Date of Death
  1. N LRSAGE
  1. S:'$G(LRCDT) LRCDT=$$DT^XLFDT
  1. S LRCDT=$P(LRCDT,".")
  1. S SEX="M",AGE="99yr"
  1. D GETS^DIQ(FILE,DFN_",",".02;.03;.351","IE","LRSAGE")
  1. S SEX=$G(LRSAGE(FILE,DFN_",",.02,"I")) S:$L(SEX)="" SEX="M"
  1. S DOB=$G(LRSAGE(FILE,DFN_",",.03,"I")) I '$G(DOB) Q
  1. S DOD=$G(LRSAGE(FILE,DFN_",",.351,"I"))
  1. S AGE=$$DATE(DOB,LRCDT)
  1. Q
  1. ;
  1. DATE(DOB,LRCDT) ;Entry point if passing only a valid Date without patient
  1. ; Dates must be defined in VA FileManager internal format.
  1. ; DOB, Date of birth
  1. ; LRCDT = collection date
  1. ; Date formate error will return 99yr
  1. N X,Y,%DT
  1. I '$G(LRCDT) S LRCDT=$$DT^XLFDT
  1. S DOB=$P(DOB,".")
  1. I '$G(DOB) Q "99yr" ;no DOB passed
  1. S X=DOB,LRCDT=$P(LRCDT,".")
  1. I $S(DOB'=+DOB:1,LRCDT'=+LRCDT:1,1:0) Q "99yr"
  1. I $S(DOB'?7N.NE:1,LRCDT'?7N.NE:1,1:0) Q "99yr"
  1. D ^%DT I Y'>0 Q "99yr" ;invalid date
  1. S X=LRCDT
  1. K %DT D ^%DT I Y'>0 Q "99yr" ;invalid date
  1. ;
  1. CALC ;Calculate timeframe based on difference between DOB and collection
  1. ; date. Time is stripped off.
  1. ; .0001-24 hour = dy
  1. ; 0-29 days = dy
  1. ; 30-730 dy = mo
  1. ; >24 mo = yr
  1. ;
  1. I DOB>LRCDT Q "99yr"
  1. I DOB=LRCDT Q "1dy" ;same dates---pass 1 day old
  1. S X=$E(LRCDT,1,3)-$E(DOB,1,3)-($E(LRCDT,4,7)<$E(DOB,4,7))
  1. I X>1 S X=+X_"yr" Q X ;age 2 years or more---pass in years
  1. S X=$$FMDIFF^XLFDT(LRCDT,DOB,1)
  1. I X>30 S X=X\30_"mo" Q X ;over 30 days---pass in months
  1. E S X=X_"dy" Q X ;under 31 days---pass in days
  1. Q "99yr"