Rocket U2 | UniVerse & UniData

 View Only
  • 1.  AGE CALCULATION

    Posted 09-24-2021 14:33
    Seems so simple but, i'm trying to get ones exact age, on any given day, using their internal birthday. If I do the obvious, subtract internal birthdate from current date and divide by 36525, I get the accurate year but months and days comes out as a fraction of a year...

    Anyone have an easy calc for this?

    Thanks

    ------------------------------
    Kathleen Hambrick
    PROGRAMMER
    William C Earhart Co Inc
    Portland OR United States
    ------------------------------


  • 2.  RE: AGE CALCULATION

    Posted 09-27-2021 08:58

    Hi Kathleen!

    It's been a few years (decades?) since I did something along those lines.  I don't have the code handy, but if I remember correctly, it used a combination of the REM() and MOD() functions.




    ------------------------------
    Brian Paige
    Enterprise Systems Manager
    Serta /Simmons Bedding LLC
    Doraville GA United States
    ------------------------------



  • 3.  RE: AGE CALCULATION

    Posted 09-27-2021 09:34
    Hi, I wrote this almost a decade ago, I only needed to go to years and months but days could be added easily.

    I'm sure it could possibly be written a little simpler also (UK date format).

    SUBROUTINE CalculateDateDifference (PeriodStartInternalDate, PeriodEndInternalDate, ElapsedPeriod)
    $INCLUDE CONSTANTS.BP DelimiterConstants

    * Calculate the number or years and months that have elapsed between the supplied start and end
    * dates (each expressed in internal format) and return a textual description of that elapsed
    * period. If the period end date is left blank, then today's date will be assumed.

    LastDaysOfMonths = 31:AM:28:AM:31:AM:30:AM:31:AM:30:AM:31:AM:31:AM:30:AM:31:AM:30:AM:31
    IF UNASSIGNED(PeriodEndInternalDate) THEN
    PeriodEndInternalDate = ''
    END
    IF PeriodStartInternalDate = "" THEN
    ElapsedPeriod = "Cannot Determine"
    END ELSE
    IF PeriodEndInternalDate = "" THEN
    PeriodEndInternalDate = DATE()
    END
    PeriodEndDate = OCONV(PeriodEndInternalDate, "D/")
    PeriodEndDay = FIELD(PeriodEndDate, "/", 1)
    PeriodEndMonth = FIELD(PeriodEndDate, "/", 2)
    PeriodEndYear = FIELD(PeriodEndDate, "/", 3)
    LastDayOfMonth = LastDaysOfMonths<PeriodEndMonth>
    PeriodStartDate = OCONV(PeriodStartInternalDate,"D/")
    PeriodStartDay = FIELD(PeriodStartDate, "/", 1)
    PeriodStartMonth = FIELD(PeriodStartDate, "/", 2)
    PeriodStartYear = FIELD(PeriodStartDate, "/", 3)
    CalculatedYearsElapsed = PeriodEndYear - PeriodStartYear
    CalculatedMonthsElapsed = PeriodEndMonth - PeriodStartMonth
    CalculatedDaysElapsed = PeriodEndDay - PeriodStartDay
    IF (CalculatedMonthsElapsed < 0) OR (CalculatedMonthsElapsed = 0 AND CalculatedDaysElapsed < 0) THEN
    CalculatedYearsElapsed = CalculatedYearsElapsed - 1
    END
    IF CalculatedMonthsElapsed < 0 THEN
    CalculatedMonthsElapsed = 12 + CalculatedMonthsElapsed
    END
    IF CalculatedDaysElapsed < 0 AND PeriodEndDay # LastDayOfMonth THEN
    CalculatedMonthsElapsed = CalculatedMonthsElapsed - 1
    IF CalculatedMonthsElapsed < 0 THEN
    CalculatedMonthsElapsed = 12 + CalculatedMonthsElapsed
    END
    END
    IF CalculatedYearsElapsed = 1 Then
    YearsToReturn = CalculatedYearsElapsed:' Year'
    END ELSE
    YearsToReturn = CalculatedYearsElapsed:' Years'
    END
    IF CalculatedMonthsElapsed = 1 THEN
    MonthsToReturn = CalculatedMonthsElapsed:' Month'
    END ELSE
    MonthsToReturn = CalculatedMonthsElapsed:' Months'
    END
    ElapsedPeriod = YearsToReturn:' ':MonthsToReturn
    END
    RETURN

    ------------------------------
    Sean Hannam
    Payroll Architect
    The Access Group
    CHESTERFIELD United Kingdom
    ------------------------------



  • 4.  RE: AGE CALCULATION

    PARTNER
    Posted 09-28-2021 11:48
    Hi Kathleen,

    This raises some questions for me:

    02/01/1968 - 03/01/1968 = 0 years, 1 month, 0 days (seems obvious)
    but then there's this:
    02/29/1968 - 03/31/1968 = 0 years, 1 month, 0 days OR 0 years, 1 month, 2 days?

    02/01/1967 - 02/01/1968 = 1 year, 0 months, 0 days (again, seems obvious)
    but then there's:
    02/28/1967 - 02/29/1968 = 1 year, 0 months, 0 days OR 1 year, 0 months, 1 day?
    02/29/1968 - 02/28/1969 = 1 year, 0 months, 0 days OR 0 years, 11 months, 28 days?

    If you think, "I won't worry about this, I'll only look at whole years and whole months and then gather up the stray days," in other words: days from the start date to the end of that month + whole years and whole months + days from the first of the end month to the end date.  But doing that can lead to more days than any given month could have:
    02/10/1967 - 03/20/1969 = 18 days + 2 years and 0 months + 20 days ... or 2 years and 38 days!

    In the above example, you might say "I'll just go from 10th to 10th to 10th, and then pick up any days left over!" In other words go from 02/10 to 03/10 to 04/10 to etc, to get 2 years, 1 month and 10 days.
    What if we reverse the DDs: 02/20/1967 - 03/10/1969 = 2/20 to 3/20 to 4/20 to etc = 2 years and 18 days. That seems reasonable.
    What about 01/30/1967 - 02/28/1969? 1/30/67 - 2/28/67 - 3/30/67 - ... - 1/30/69 - 2/28/69, so 2 years and 1 month? (The question is the day from 1/30/1967 to 1/31/1967, but it seems reasonable to leave it out.)
    What about 01/28/1967 - 02/29/1968? 1 year, 1 month, 1 day? I guess that seems reasonable.
    What about the above examples where the start date is the end of the month? I think that's a special case where you have to go from end of month to end of month, not exact dates. (We already kind of did that for Jan 30th to Feb 28th, etc. I'm just suggesting that if you start at the end of February then you go to the end of each other month before gathering up the stray days.)

    So if you don't have a problem with 1/30/1967 - 2/28/1969 being 2 years and 1 month, then that seems like the way to go. If you do have a problem with it, then there will always potentially be wonkiness with start dates 29th, 30th or 31st.

    Assuming you can live with that, this is a quick stab at an algorithm. It could definitely be made more efficient.

          PROGRAM DIFF.DATE
    *
          D1 = '2/1/1968'
          D2 = '3/1/1968'
          GOSUB CALC.IT
    *
          D1 = '2/29/1968'
          D2 = '3/31/1968'
          GOSUB CALC.IT
    *
          D1 = '2/1/1967'
          D2 = '2/1/1968'
          GOSUB CALC.IT
    *
          D1 = '2/28/1967'
          D2 = '2/29/1968'
          GOSUB CALC.IT
    *
          D1 = '2/29/1968'
          D2 = '2/28/1969'
          GOSUB CALC.IT
    *
          D1 = '2/10/1967'
          D2 = '3/20/1969'
          GOSUB CALC.IT
    *
          D1 = '1/30/1967'
          D2 = '2/28/1969'
          GOSUB CALC.IT
    *
          D1 = '2/12/1967'
          D2 = '10/18/1968'
          GOSUB CALC.IT
    *
          D1 = '8/26/1967'
          D2 = '9/27/2021'
          GOSUB CALC.IT
    *
          D1 = '10/28/1967'
          D2 = '9/27/2021'
          GOSUB CALC.IT
    BOTTOM:
          STOP
    
    CALC.IT:
          D1I = ICONV(D1,'D')
          D2I = ICONV(D2,'D')
    *
          IF D2I <= D1I THEN
             YDIFF = 0
             MDIFF = 0
             DDIFF = 0
             GOTO EXIT.CALC.IT
          END
    *
          PRINT OCONV(D1I,'D4/'):" - ":OCONV(D2I,'D4/')
    *
          * are we starting on the last day of the month?
          IF (OCONV(D1I,'D M[2]') # OCONV(D1I+1,'D M[2]')) THEN
             * yes! advance both dates by 1 day
             D1I += 1
             D2I += 1
          END
    *
          D1O = OCONV(D1I,'D4/')
          D2O = OCONV(D2I,'D4/')
          MM1 = D1O['/',1,1]; MM2 = D2O['/',1,1]
          DD1 = D1O['/',2,1]
          YYYY1 = D1O['/',3,1]; YYYY2 = D2O['/',3,1]
    *
          IF YYYY1 < YYYY2 THEN
             YYYY3 = YYYY1
             LOOP
                DD3 = DD1
    Y.TRY.AGAIN:
                D3I = ICONV(MM1:'/':DD3:'/':(YYYY3 + 1),'D')
                IF STATUS() THEN
                   DD3 -= 1
                   GOTO Y.TRY.AGAIN
                END
                TEST = D2I - D3I
             WHILE TEST >= 0 DO
                YYYY3 += 1
             REPEAT
          END ELSE
             YYYY3 = YYYY1
          END
          YDIFF = YYYY3 - YYYY1
    *
          IF YYYY3 < YYYY2 OR MM1 < MM2 THEN
             MDIFF = 0
             MM3 = MM1; TEMP = DD1
             LOOP
                DD3 = DD1
    M.TRY.AGAIN:
                IF MM3 = 12 THEN
                   D3O = '01/':DD3:'/':(YYYY3 + 1)
                END ELSE
                   D3O = (MM3 + 1):'/':DD3:'/':YYYY3
                END
                D3I = ICONV(D3O,'D')
                IF STATUS() THEN
                   DD3 -= 1
                   GOTO M.TRY.AGAIN
                END
                TEST = D2I - D3I
             WHILE TEST >= 0 DO
                MM3 = D3O['/',1,1]
                TEMP = D3O['/',2,1]
                YYYY3 = D3O['/',3,1]
                MDIFF += 1
             REPEAT
             DD3 = TEMP
          END ELSE
             DD3 = DD1
             MM3 = MM1
             MDIFF = 0
          END
    *
          DDIFF = 0
          D3I = ICONV(MM3:'/':DD3:'/':YYYY3,'D')
          DDIFF = D2I - D3I
    *
    EXIT.CALC.IT:
          PRINT "YDIFF = ":YDIFF
          PRINT "MDIFF = ":MDIFF
          PRINT "DDIFF = ":DDIFF
          PRINT " "
          RETURN
    *
       END
    ​

    If that works for you, feel free to carve out the "CALC.IT" part and work it into a subroutine.

    Thanks,

    ------------------------------
    Tyrel Marak
    Technical Support Manager
    Aptron Corporation
    Florham Park NJ United States
    ------------------------------



  • 5.  RE: AGE CALCULATION

    Posted 09-28-2021 12:15

    Hi Kathleen,

    Well your conundrum got me thinking while i was having a coffee and I thought perhaps this simpler approach might work for you, which i am sure you can hack to your own needs.....

    PRINT @(-1):@(10,10):"ENTER DATE ": ; INPUT START.DATE
    TODAY = DATE()
    BDATE = ICONV(START.DATE,"D2/")
    DAYS = (TODAY - BDATE)
    BDAY.MONTH = FIELD(START.DATE,"/",2,1)
    TODAY.MONTH = FIELD(OCONV(DATE(),"D2/"),"/",2,1)
    IF BDATE LT "0" THEN
    YEARS =INT((DAYS / 365.25))
    END ELSE
    IF BDAY.MONTH LT TODAY.MONTH THEN
    YEARS =(INT((DAYS / 365.25)) - 1)
    END ELSE
    YEARS =(INT(DAYS / 365.25))
    END
    END
    DYEAR = ((DAYS / 365.25) - (INT(DAYS /365)))
    DDAYS = (DYEAR * 365.25)
    MONTHS = INT(((DDAYS * 12)/365.25))
    TODAY.DAY = OCONV(DATE(),"D2/")[1,2]
    BDAY = START.DATE[1,2]
    IF BDAY LT "0" THEN
    BDAY = (BDAY * -1)
    END
    NO.DAYS = TODAY.DAY - BDAY
    PRINT @(10,12):YEARS:" YEARS ":MONTHS:" MONTHS ":NO.DAYS: " DAYS"
    END

    I seems to work with pre 1967 dates

    Thanks

    Andy



    ------------------------------
    Andrew Milne
    Business Systems Manager
    Potter and Moore Innovations
    Peterborough, Cambs United Kingdom
    ------------------------------



  • 6.  RE: AGE CALCULATION

    Posted 09-29-2021 08:26
    Kathleen,

    It is difficult to calculate the age of someone based on the internal date. You need the year, month and day. See the function below. It determines the years of age (YOA) . I hope this helps.

    FUNCTION YOA(BDAY,CDAY)
    * BDAY IS THE BIRTHDATE IN INTERNAL FORMAT
    * CDAY IS THE CHECK DATE IN INTERNAL FORMAT
    YOA = 0 ;* YEAR OF AGE
    OBDAY=OCONV(BDAY,"DYMD[4'',2'',2]") ;* YYYYMMDD
    IF STATUS() THEN GOTO END.OF.FUNC:
    OCDAY=OCONV(CDAY,"DYMD[4'',2'',2]") ;* YYYYMMDD
    IF STATUS() THEN GOTO END.OF.FUNC:
    IF CDAY LT BDAY THEN GOTO END.OF.FUNC:
    YOA = OCDAY[1,4]-OBDAY[1,4]
    IF OCDAY[5,2] LT OBDAY[5,2] THEN YOA -= 1
    IF OCDAY[5,2] EQ OBDAY[5,2] AND OCDAY[2] LT OBDAY[2] THEN YOA -= 1
    IF YOA LT 0 THEN YOA = 0
    END.OF.FUNC:
    RETURN(YOA)

    ------------------------------
    Jon Kristofferson
    Pick Programmer
    Snap-on Credit LLC
    Libertyville IL United States
    ------------------------------



  • 7.  RE: AGE CALCULATION

    PARTNER
    Posted 09-29-2021 08:56
    hi kathleen,
    here is my used function :
    FUNCTION DateDiff(begDate, endDate)
    if num(begDate) else begDate = Iconv(begDate, 'D4/')
    if num(endDate) else endDate = Iconv(endDate, 'D4/')
    if begDate > endDate then x = begDate; begDate = endDate; endDate = x
    begYear   = oconv(begDate, 'D4Y')
    begMonth  = oconv(begDate, 'DM')
    begDay    = oconv(begDate, 'DD')
    begJulian = oconv(begDate, 'DJ')
    endYear   = oconv(endDate, 'D4Y')
    endMonth  = oconv(endDate, 'DM')
    endDay    = oconv(endDate, 'DD')
    endJulian = oconv(endDate, 'DJ')
    diffYear  = endYear - begYear - (endJulian < begJulian) ;* bool = 1/0
    diffMonth = (endMonth - begMonth) - (endDay < begDay) ;* bool = 1/0
    if diffMonth < 0 then diffMonth += 12
    diffDay   = endDay - begDay
    if diffDay < 0 then diffDay += oconv(iconv('01/' : (if begMonth = 12 then 1 else begMonth + 1) : '/' : (begYear + (begMonth = 12)), 'd4/') - 1, 'DD') ;* first day of next month -1 , DD minus begDate 
    
    RETURN (diffYear : @am : diffMonth : @am : diffDay)
    ​


    usage 

    DEFFUN DateDiff(startDate, stopDate, opt)
    
    prompt ''
    crt 'begin date' :;input d1
    crt 'end   date' :;input d3
    diff = DateDiff(d1,d2)
    crt diff ;* <1> = year(s), <2> = month(s), <3> = day(s) 
    


    I hope this can help 



    ------------------------------
    Manu Fernandes
    ------------------------------



  • 8.  RE: AGE CALCULATION

    Posted 09-29-2021 16:41
    Thanks all, I have what I need now.

    ------------------------------
    Kathleen Hambrick
    PROGRAMMER
    William C Earhart Co Inc
    Portland OR United States
    ------------------------------