- 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 Feb 18, 2025@23:39:44 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"