LRDAGE.m

LRDAGE ;DFW/MRL/DALOI/FHS - RETURN TIMEFRAME IN DAYS, MONTHS OR YEARS;JUL 06, 2010 3:14 PM

 ;;5.2;LAB SERVICE;**279,302,1022,1027**;NOV 01, 1997

 ;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

 ;

 ; IHS/OIT/MKK LR*5.2*1027 - Date Format error will return -1

 ;     Because people in RPMS can be 99yrs old (or older)

 N X,Y,%DT

 I '$G(LRCDT) S LRCDT=$$DT^XLFDT

 S DOB=$P(DOB,".")

 ; I '$G(DOB) Q "99yr"  ;no DOB passed

 I '$G(DOB) Q -1  ; no DOB passed -- IHS/OIT/MKK LR*5.2*1027

 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

 I $S(DOB'=+DOB:1,LRCDT'=+LRCDT:1,1:0) Q -1      ; IHS/OIT/MKK LR*5.2*1027

 I $S(DOB'?7N.NE:1,LRCDT'?7N.NE:1,1:0) Q -1      ; IHS/OIT/MKK LR*5.2*1027

 D ^%DT I Y'>0 Q -1               ; invalid date   IHS/OIT/MKK LR*5.2*1027

 S X=LRCDT

 ; K %DT D ^%DT I Y'>0 Q "99yr"  ;invalid date

 K %DT D ^%DT I Y'>0 Q -1         ; invalid date   IHS/OIT/MKK LR*5.2*1027

 ;

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 -1                                ; IHS/OIT/MKK LR*5.2*1027

 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"

 Q -1                                            ; IHS/OIT/MKK LR*5.2*1027

LRDAGE    ;DFW/MRL/DALOI/FHS - RETURN TIMEFRAME IN DAYS, MONTHS OR YEARS;JUL 06, 2010 3:14 PM

 +1       ;;5.2;LAB SERVICE;**279,302,1022,1027**;NOV 01, 1997

 +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       ;Entry point from patient file in VA FileManager

 +8       ;

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       ;

 +6       ; IHS/OIT/MKK LR*5.2*1027 - Date Format error will return -1

 +7       ;     Because people in RPMS can be 99yrs old (or older)

 +8        NEW X,Y,%DT

 +9        IF '$GET(LRCDT)

               SET LRCDT=$$DT^XLFDT

 +10       SET DOB=$PIECE(DOB,".")

 +11      ; I '$G(DOB) Q "99yr"  ;no DOB passed

 +12      ; no DOB passed -- IHS/OIT/MKK LR*5.2*1027

           IF '$GET(DOB)

               QUIT -1

 +13       SET X=DOB

           SET LRCDT=$PIECE(LRCDT,".")

 +14      ; I $S(DOB'=+DOB:1,LRCDT'=+LRCDT:1,1:0) Q "99yr"

 +15      ; I $S(DOB'?7N.NE:1,LRCDT'?7N.NE:1,1:0) Q "99yr"

 +16      ; D ^%DT I Y'>0 Q "99yr"  ;invalid date

 +17      ; IHS/OIT/MKK LR*5.2*1027

           IF $SELECT(DOB'=+DOB:1,LRCDT'=+LRCDT:1,1:0)

               QUIT -1

 +18      ; IHS/OIT/MKK LR*5.2*1027

           IF $SELECT(DOB'?7N.NE:1,LRCDT'?7N.NE:1,1:0)

               QUIT -1

 +19      ; invalid date   IHS/OIT/MKK LR*5.2*1027

           DO ^%DT

           IF Y'>0

               QUIT -1

 +20       SET X=LRCDT

 +21      ; K %DT D ^%DT I Y'>0 Q "99yr"  ;invalid date

 +22      ; invalid date   IHS/OIT/MKK LR*5.2*1027

           KILL %DT

           DO ^%DT

           IF Y'>0

               QUIT -1

 +23      ;

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       ; I DOB>LRCDT Q "99yr"

 +8       ; IHS/OIT/MKK LR*5.2*1027

           IF DOB>LRCDT

               QUIT -1

 +9       ;same dates---pass 1 day old

           IF DOB=LRCDT

               QUIT "1dy"

 +10       SET X=$EXTRACT(LRCDT,1,3)-$EXTRACT(DOB,1,3)-($EXTRACT(LRCDT,4,7)<$EXTRACT(DOB,4,7))

 +11      ;age 2 years or more---pass in years

           IF X>1

               SET X=+X_"yr"

               QUIT X

 +12       SET X=$$FMDIFF^XLFDT(LRCDT,DOB,1)

 +13      ;over 30 days---pass in months

           IF X>30

               SET X=X\30_"mo"

               QUIT X

 +14      ;under 31 days---pass in days

          IF '$TEST

               SET X=X_"dy"

               QUIT X

 +15      ; Q "99yr"

 +16      ; IHS/OIT/MKK LR*5.2*1027

           QUIT -1