| 1 | LRDAGE ;DFW/MRL/DALOI/FHS - RETURN TIMEFRAME IN DAYS, MONTHS OR YEARS; 15 MAR 90
|
|---|
| 2 | ;;5.2;LAB SERVICE;**279,302**;Sep 27, 1994
|
|---|
| 3 | ;Adapted from IDAGE routine
|
|---|
| 4 | ;If period is under 31 days then format is nnd where d=days
|
|---|
| 5 | ;If period is under 2 years then format is nnm where m=month(s)
|
|---|
| 6 | ;In all other cases format is in nny where y=years
|
|---|
| 7 | ;
|
|---|
| 8 | ;
|
|---|
| 9 | ;Entry point from patient file in VA FileManager
|
|---|
| 10 | ;
|
|---|
| 11 | DFN(DFN,FILE,LRCDT) ; Call returns patient age based on specimen collection date
|
|---|
| 12 | ; Age is returned as day (dy) month (mo) or years (yr)
|
|---|
| 13 | ; DFN = IEN of patient
|
|---|
| 14 | ; FILE = File number where patient is found
|
|---|
| 15 | ; LRCDT = Specimen collection date otherwise age will be calculated
|
|---|
| 16 | ; using the current date
|
|---|
| 17 | ; Sex is a coded value of Male = "M" (default) Female = "F"
|
|---|
| 18 | ; DOD = Date of Death
|
|---|
| 19 | N LRSAGE
|
|---|
| 20 | S:'$G(LRCDT) LRCDT=$$DT^XLFDT
|
|---|
| 21 | S LRCDT=$P(LRCDT,".")
|
|---|
| 22 | S SEX="M",AGE="99yr"
|
|---|
| 23 | D GETS^DIQ(FILE,DFN_",",".02;.03;.351","IE","LRSAGE")
|
|---|
| 24 | S SEX=$G(LRSAGE(FILE,DFN_",",.02,"I")) S:$L(SEX)="" SEX="M"
|
|---|
| 25 | S DOB=$G(LRSAGE(FILE,DFN_",",.03,"I")) I '$G(DOB) Q
|
|---|
| 26 | S DOD=$G(LRSAGE(FILE,DFN_",",.351,"I"))
|
|---|
| 27 | S AGE=$$DATE(DOB,LRCDT)
|
|---|
| 28 | Q
|
|---|
| 29 | ;
|
|---|
| 30 | DATE(DOB,LRCDT) ;Entry point if passing only a valid Date without patient
|
|---|
| 31 | ; Dates must be defined in VA FileManager internal format.
|
|---|
| 32 | ; DOB, Date of birth
|
|---|
| 33 | ; LRCDT = collection date
|
|---|
| 34 | ; Date formate error will return 99yr
|
|---|
| 35 | N X,Y,%DT
|
|---|
| 36 | I '$G(LRCDT) S LRCDT=$$DT^XLFDT
|
|---|
| 37 | S DOB=$P(DOB,".")
|
|---|
| 38 | I '$G(DOB) Q "99yr" ;no DOB passed
|
|---|
| 39 | S X=DOB,LRCDT=$P(LRCDT,".")
|
|---|
| 40 | I $S(DOB'=+DOB:1,LRCDT'=+LRCDT:1,1:0) Q "99yr"
|
|---|
| 41 | I $S(DOB'?7N.NE:1,LRCDT'?7N.NE:1,1:0) Q "99yr"
|
|---|
| 42 | D ^%DT I Y'>0 Q "99yr" ;invalid date
|
|---|
| 43 | S X=LRCDT
|
|---|
| 44 | K %DT D ^%DT I Y'>0 Q "99yr" ;invalid date
|
|---|
| 45 | ;
|
|---|
| 46 | CALC ;Calculate timeframe based on difference between DOB and collection
|
|---|
| 47 | ; date. Time is stripped off.
|
|---|
| 48 | ; .0001-24 hour = dy
|
|---|
| 49 | ; 0-29 days = dy
|
|---|
| 50 | ; 30-730 dy = mo
|
|---|
| 51 | ; >24 mo = yr
|
|---|
| 52 | ;
|
|---|
| 53 | I DOB>LRCDT Q "99yr"
|
|---|
| 54 | I DOB=LRCDT Q "1dy" ;same dates---pass 1 day old
|
|---|
| 55 | S X=$E(LRCDT,1,3)-$E(DOB,1,3)-($E(LRCDT,4,7)<$E(DOB,4,7))
|
|---|
| 56 | I X>1 S X=+X_"yr" Q X ;age 2 years or more---pass in years
|
|---|
| 57 | S X=$$FMDIFF^XLFDT(LRCDT,DOB,1)
|
|---|
| 58 | I X>30 S X=X\30_"mo" Q X ;over 30 days---pass in months
|
|---|
| 59 | E S X=X_"dy" Q X ;under 31 days---pass in days
|
|---|
| 60 | Q "99yr"
|
|---|
