Date:         Thu, 21 Jul 2011 16:56:24 -0400
Reply-To:     Chang Chung <chang_y_chung@HOTMAIL.COM>
Sender:       "SAS(r) Discussion" <SAS-L@LISTSERV.UGA.EDU>
From:         Chang Chung <chang_y_chung@HOTMAIL.COM>
Subject:      Re: Figuring out Age in Years, Months and Days
Comments: To: John Parker <John.V.Parker@KP.ORG>

On Wed, 20 Jul 2011 11:30:11 -1000, John Parker <John.V.Parker@KP.ORG>
wrote:
...
>I have a requirement to figure out Age at Death and it has to be expressed
>in Years, Months, Weeks and Days.
...
Hi, John,
I think Mark Miller has a right approach, which I implement a bit
differently. HTH.
Cheers,
Chang

options nocenter;

proc fcmp outlib=work.func.test;
   /* report age in years months weeks and days */
   /* public wrapper */
   function xage(birth, death) $200;
      length r $200;
      r = xagerec(birth, death, "year");
      if missing(r) then r = "less than a day";
      return (r);
   endsub;
   /* recursive work horse */
   function xagerec(birth, death, unit $) $200;
      length current next r $200;
      if missing(unit) then return (" ");
      if unit = "day" then return (putf(death-birth, "day"));
      b = birth;
      do n = 0 by 1 until (b > death);
         b = intnx(unit, birth, n, 'same');
      end;
      m = n - 1;
      current = catx(" ", putf(m, unit));
      b = intnx(unit, birth, m, 'same');
      nextunit = smaller(unit);
      next = xagerec(b, death, nextunit);
      r = catx(" ", current, next);
      return (r);
   endsub;
   /* utilities */
   function smaller(unit $) $5;
      if unit = "year" then return ("month");
      if unit = "month" then return ("week");
      if unit = "week" then return ("day");
      if unit = "day" then return ("");
   endsub;
   function putf(n, unit $) $20;
      length r $20;
      if n <= 0 then r = "";
      else do;
         r = catx(" ", putn(n, "best."), unit);
         if n > 1 then r = cats(r, "s");
      end;
      return (r);
   endsub;
quit;

%let cmplib = %sysfunc(getoption(cmplib));
options cmplib = (work.func &cmplib);
   data one;
      input (born died)(:yymmdd.);
      format born died yymmdd10.;
      length age $80.;
      age = xage(born, died);
      cards;
      19131230  19131230
      19131230  19131231
      19131231  20110601
      19140101  20110602
      19140201  19140202
      19140201  19140206
      19140201  19140207
      19140201  19140208
      19140201  19140228
      19440111  20100103
      19450627  20110627
      19451012  20110512
      19451012  20110511
      19451012  20110513
      19990227  20000228
      19990227  20000229
      20000201  20000229
      20000201  20000301
      20000228  20010227
      20000229  20010301
      20071012  20100421
      20071012  20081011
      20071012  20081012
      20071012  20081013
      20071012  20081014
      20071012  20071021
      20071012  20071029
      20011221  20020102
      ;
   run;
   /* check */
   proc print data=one;
   run;
   /* on lst
   Obs          born          died    age
     1    1913-12-30    1913-12-30    less than a day
     2    1913-12-30    1913-12-31    1 day
     3    1913-12-31    2011-06-01    97 years 5 months 1 day
     4    1914-01-01    2011-06-02    97 years 5 months 1 day
     5    1914-02-01    1914-02-02    1 day
     6    1914-02-01    1914-02-06    5 days
     7    1914-02-01    1914-02-07    6 days
     8    1914-02-01    1914-02-08    1 week
     9    1914-02-01    1914-02-28    3 weeks 6 days
    10    1944-01-11    2010-01-03    65 years 11 months 3 weeks 2 days
    11    1945-06-27    2011-06-27    66 years
    12    1945-10-12    2011-05-12    65 years 7 months
    13    1945-10-12    2011-05-11    65 years 6 months 4 weeks 1 day
    14    1945-10-12    2011-05-13    65 years 7 months 1 day
    15    1999-02-27    2000-02-28    1 year 1 day
    16    1999-02-27    2000-02-29    1 year 2 days
    17    2000-02-01    2000-02-29    4 weeks
    18    2000-02-01    2000-03-01    1 month
    19    2000-02-28    2001-02-27    11 months 4 weeks 2 days
    20    2000-02-29    2001-03-01    1 year 1 day
    21    2007-10-12    2010-04-21    2 years 6 months 1 week 2 days
    22    2007-10-12    2008-10-11    11 months 4 weeks 1 day
    23    2007-10-12    2008-10-12    1 year
    24    2007-10-12    2008-10-13    1 year 1 day
    25    2007-10-12    2008-10-14    1 year 2 days
    26    2007-10-12    2007-10-21    1 week 2 days
    27    2007-10-12    2007-10-29    2 weeks 3 days
    28    2001-12-21    2002-01-02    1 week 5 days
   */
options cmplib = (&cmplib);