source: WorldVistAEHR/trunk/r/LAB_SERVICE-LR-LS/LRDAGE.m@ 724

Last change on this file since 724 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR

File size: 2.1 KB
Line 
1LRDAGE ;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 ;
11DFN(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 ;
30DATE(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 ;
46CALC ;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"
Note: See TracBrowser for help on using the repository browser.