calculate age down to years, mths, days?

Collapse
X
 
  • Filter
  • Time
  • Show
Clear All
new posts
  • Robert E. Carneal
    Member
    • Aug 2001
    • 343

    calculate age down to years, mths, days?

    Does anyone know where I can get a formula that I can program into Power Basic that given two complete dates (such as 1918-09-22 and 1994-04-04) it will return the difference in years, months, and days? It would be a BIG help in this project I have.

    Btw, the answer (arrived by using a calendar and actually counting by hand), should be 75 years, 6 months, 13 days. Can a formula do that for me in Power Basic please?

    Thank you.

    Robert
  • Mel Bishop
    Member
    • May 1999
    • 3603

    #2
    Check out:



    Should be easily convertable to PB/DOS.

    Convert the two dates to julian, subtract the two and that will be the number of days between the two. Should be easy to convert that to YY/MM/DD's
    There are no atheists in a fox hole or the morning of a math test.
    If my flag offends you, I'll help you pack.

    Comment

    • Mike Doty
      Member
      • Feb 2005
      • 9264

      #3
      or search for julian or astroday
      Eighth Amendment:
      “Excessive bail shall not be required, nor excessive fines imposed, nor cruel and unusual punishments inflicted.”​

      Comment

      • Don Schullian
        Member
        • Jun 1999
        • 1535

        #4


        Robert,

        Here's some code on my page that can get you the # of days between the dates. Figuring from the number of days you'll use this formula to get the number of elapsed full years:

        Years = ( 4 * (ToDay& - Bdate&) ) \ 1461

        Computing the # of elapsed months and days is going to be brute work however.
        C'ya
        Don

        http://www.ImagesBy.me

        Comment

        • Mike Doty
          Member
          • Feb 2005
          • 9264

          #5
          I'm thinking that an offset from the beginning/ending of the julian dates
          could be used and push the highest julian date back to the beginning of
          the year. Then push the date forward to obtain the reminder represented as the month and days.
          Eighth Amendment:
          “Excessive bail shall not be required, nor excessive fines imposed, nor cruel and unusual punishments inflicted.”​

          Comment

          • Mike Doty
            Member
            • Feb 2005
            • 9264

            #6
            How about this?

            Code:
            #COMPILE EXE
            #DIM ALL
            '4/13/08 pbDate.Bas by Mike Doty 4/13/08
            'Tested against: [URL]http://www.timeanddate.com/date/duration.html[/URL]
            '
            'Can you break this code?  
            '
            DECLARE SUB pbDate(BYVAL LowDate AS STRING, BYVAL HighDate AS STRING, Years AS LONG, Months AS LONG, Days AS LONG, TotalDays AS LONG)
            DECLARE FUNCTION date2julian(mm_dd_yyyy AS STRING) AS LONG
            DECLARE FUNCTION julian2date(jd AS LONG) AS STRING
            FUNCTION PBMAIN AS LONG
            LOCAL Years, Months, Days, MonthCorrection, TotalDays AS LONG, LowDate, HighDate AS STRING
            LowDate$ = "09/22/1918" 'mm/dd/yyyy required
            HighDate$ = "04/04/1994" 'mm/dd/yyyy required
            pbDate LowDate$,HighDate$,Years&,Months&,Days&,TotalDays&
            '
            'Display results: 75 years, 6 months and 13 days. Total days 27588
            ? LowDate$ + " to "+ HighDate$ + _
            STR$(Years) + " years, " + FORMAT$(Months) + " months, " + FORMAT$(Days) + " days. Total days" + STR$(TotalDays)+ "."
            END FUNCTION
            '
            SUB pbDate(BYVAL LowDate AS STRING, BYVAL HighDate AS STRING, Years AS LONG, Months AS LONG, Days AS LONG, TotalDays AS LONG)
            'Pass LowDate (mm/dd/yyyy)
            'Pass HighDate (mm/dd/yyyy)
            'Years&,Months&,Days&,TotalDays& returned '4/13/08 Mike Doty
            LOCAL A AS LONG, B AS LONG, offset1 AS LONG, Offset2 AS LONG, MonthCorrection AS LONG
            A = Date2Julian&(LowDate$) '(A) = low date
            B= Date2Julian&(HighDate$) '(B) = high date
            TotalDays = B-A 'Total days difference
            offset1 = B - Date2Julian&("01/01/" + RIGHT$(HighDate,4)) '01/01/ of (B)
            B = B - Offset1 'move high date (B) back to the beginning of the year
            A = A - Offset1 'move low date (A) back by same number of days as (B)
            offset2 = Date2Julian&("12/31/" + RIGHT$(LowDate,4)) - A '12/31/ of (A) the low date
            A = A + Offset2 'move low date (A) forward to end of year
            B = B + Offset2 'move high date (B) forward same number of days
            Years = (B - A)\365 'questionable, open to suggestions (can you break it?)
            IF LEFT$(HighDate,5) < LEFT$(LowDate,5) THEN MonthCorrection =1 'correct month (if needed)
            Months = VAL(LEFT$(Julian2Date$(B),2)) - MonthCorrection 'get number of months from julian date
            Days = VAL(MID$(Julian2Date$(B),4,2)) 'get number of days from julian date
            END SUB
            '
            FUNCTION date2julian(mm_dd_yyyy AS STRING) AS LONG
            DIM month&,day&,year&
            month = VAL(LEFT$(mm_dd_yyyy$,2))
            day = VAL(MID$(mm_dd_yyyy$,4,2))
            year = VAL (RIGHT$(mm_dd_yyyy$,4))
            LOCAL k AS LONG, julian AS LONG
            k = INT((14 - month) / 12)
            julian = day + INT(367 * (month + (k * 12) - 2) / 12) _
            + INT(1461 * (year + 4800 - k) / 4) - 32113
            julian = julian - (INT(3 * INT((year + 100 - k) / 100) / 4) - 2) 'convert to gregorian
            date2julian = julian
            END FUNCTION
            '
            FUNCTION julian2date(jd AS LONG) AS STRING
            DIM yr$,mo$,da$
            DIM m&,d&,y&, q&, r&, s&, t&, u&, v&
            q = INT((jd / 36524.25) - 51.12264)
            r = jd + q - INT(q / 4) + 1
            s = r + 1524
            t = INT((s / 365.25) - 0.3343)
            u = INT(t * 365.25)
            v = INT((s - u) / 30.61)
            d = s - u - INT(v * 30.61)
            m = (v - 1) + 12 * (v > 13.5)
            y = t - (m < 2.5) - 4716
            FUNCTION = FORMAT$(M,"00") + "-" + _ ' Return the date string, thank you Larry Cooke
            FORMAT$(D,"00") + "-" + _ ' using the new values...
            FORMAT$(Y,"0000") ' " " " "
            END FUNCTION
            Last edited by Mike Doty; 16 Apr 2008, 12:01 AM. Reason: Put ' between sections so it looks bettter.
            Eighth Amendment:
            “Excessive bail shall not be required, nor excessive fines imposed, nor cruel and unusual punishments inflicted.”​

            Comment

            • Mel Bishop
              Member
              • May 1999
              • 3603

              #7
              Keeping in mind that Mike's code was written for and in PB/CC. Needs to be converted to PB/DOS.
              There are no atheists in a fox hole or the morning of a math test.
              If my flag offends you, I'll help you pack.

              Comment

              • Mike Doty
                Member
                • Feb 2005
                • 9264

                #8
                I missed that this was DOS. Hopefully, an easy conversion.
                Eighth Amendment:
                “Excessive bail shall not be required, nor excessive fines imposed, nor cruel and unusual punishments inflicted.”​

                Comment

                • Mike Doty
                  Member
                  • Feb 2005
                  • 9264

                  #9
                  Is my solution above flawed?
                  Eighth Amendment:
                  “Excessive bail shall not be required, nor excessive fines imposed, nor cruel and unusual punishments inflicted.”​

                  Comment

                  • Paul Purvis
                    Member
                    • Mar 2003
                    • 2923

                    #10
                    until code is reposted in this thread
                    see website below for newer code
                    Last edited by Paul Purvis; 18 Apr 2008, 08:42 PM.
                    p purvis

                    Comment

                    • Mike Doty
                      Member
                      • Feb 2005
                      • 9264

                      #11
                      'Validate date
                      jd = Date2Julian(LowDate)
                      IF Julian2Date(Jd) <> LowDate THEN ? "Invalid date"
                      Eighth Amendment:
                      “Excessive bail shall not be required, nor excessive fines imposed, nor cruel and unusual punishments inflicted.”​

                      Comment

                      • Mike Doty
                        Member
                        • Feb 2005
                        • 9264

                        #12


                        timeanddate.com computes 02/29/1988 to 02/28/1989 as
                        11 months and 30 days.

                        I sent to the author at timeanddate.com and received a very fast response and was given permission to post here.

                        Hello Mike,

                        Unfortunately, there are several ways to count days/months in some
                        cases, in the future we hope to be able to show all alternative ways a
                        duration can be counted as, to pinpoint these differences.

                        So yes, you might also say that it is one year, given the assumption
                        that you
                        "round" February 29, 1989 down to February 28 (and not roll over to
                        March 1).

                        Best regards,
                        Steffen



                        I like your answer better of 1 year, 0 months and 0 days.
                        If 1 is added to their computation it still shows 1 year and 1 day.
                        They never show just 1 year with this date range.
                        -----------------------------------------------------------------------------------------------
                        This one comes up with 0 years, 11 months and 28 days.

                        Today in history, 10,000-year calendar, a store with thousands of calendars, calendar encyclopedia, and hundreds of links.
                        Last edited by Mike Doty; 17 Apr 2008, 09:09 AM.
                        Eighth Amendment:
                        “Excessive bail shall not be required, nor excessive fines imposed, nor cruel and unusual punishments inflicted.”​

                        Comment

                        • Paul Purvis
                          Member
                          • Mar 2003
                          • 2923

                          #13
                          i had that thought too,
                          but went the other way because somebody might not want to calculate dates, just validate a date, maybe for key entry, or for importing purposes, also the routine can accept a date of 00/00/0000.
                          which your routine does not if i am not mistaken, nothing wrong about that.

                          i could have made changes in your date2julian code to validate the date there, but if the dates are valid, much like what would be inside of database, your date2julian would be much faster and also code in my date functions where it validates the lowdate and highdate could be removed, adding more speed to the routine of calculating date differences.

                          i am not suggesting any change to your code to allow for 00/00/0000 dates
                          and a julian(really georgian) date number to be 0, but i do believe many times a programmer will place code just before your code anyways to test entry or convert strings to match strings in the routine.

                          the code before your date2julian could simply be

                          on datevalidate("xx/xx/xxxx")+1& GOTO LINE1, LINE2,LINE3
                          LINE1:
                          some kind of an error line
                          exit function or goto somewhere
                          LINE2:
                          juliandate=0
                          exit function or goto somewhere
                          LINE3:
                          date2julian("xx/xx/xxxx")
                          goto somewhere

                          OR YOU CAN DO THE CASE OR IF THEN BLOCKS

                          i do not know what is the fastest code here
                          if you are going to use case block or if block then probably the fastest would be
                          line3 should be done first
                          line 2 done second
                          line 3 done last

                          the validate routine is now written to be streamlined and as fast as i could make it for getting into the routine, maybe a sub routine would be faster than a function routine in this program, but left it as a function for more portability. also, to test for dates of 00/00/0000, even if you moved he code to the date2julian function, you only save code from the ON GOTO statement to the end of the function. i have also streamlined the code from the ON GOTO statement to the end of the function.

                          by streamlined, get out of the function fast if certain test are meet and planning what variables equaling certain values maybe occur more often than others and also trying to keep variables inside the cpu cache.

                          paul
                          p purvis

                          Comment

                          • Paul D. Elliott
                            Member
                            • May 2002
                            • 1167

                            #14
                            It may be that I've missed something or just a problem of my
                            misunderstanding the wording. Say my birthday is tomorrow and if I plug in
                            tomorrow's date ( but prior year ) & today's date and use Birthdate math then I am 1 year older today.
                            If I use simple calendar math then I get so many years 11 months and
                            30 days ( which I've always considered right ).

                            What have I missed?

                            Yes, it is a PAIN. I remember having a lot of problems with this when I did a program
                            for hospital data that needed to calculate the age for patients. All sorts of discussions
                            dealing with newborns and those up to 1 month of age ( had to calculate days or weeks
                            or months or years ).
                            Last edited by Paul D. Elliott; 18 Apr 2008, 09:30 AM. Reason: little bit more info.

                            Comment

                            • Michael Mattias
                              Member
                              • Aug 1998
                              • 43447

                              #15
                              >What have I missed?

                              The discussion with the user and the associated written confirmation re how they want the calculations performed. Correct=whatever they agreed to.

                              MCM
                              Michael Mattias
                              Tal Systems (retired)
                              Port Washington WI USA
                              [email protected]
                              http://www.talsystems.com

                              Comment

                              • Mike Doty
                                Member
                                • Feb 2005
                                • 9264

                                #16
                                STDOUT computeymdd("13/18/2008","04/18/2008",0)
                                This incorrectly passes the date validation routine.
                                Just about there!!!!

                                MM: The responses are from the authors of internet date sites, not casual users.
                                A lot of research has gone into this and this pssting is the best I've seen.
                                We are looking for accuracy as #1 and speed as #2. Many routines handle a single
                                day into the next month as an month. This routine takes that into consideration.
                                This would not be used for making headstones because birthdays are handled differently.
                                The author was asked for for permission to post the email response.
                                This is the best date routine I've seen for returning the years, months and days on the internet.

                                Another idea would be to use 0 as failing the date verification instead of -1 and zero.

                                Paul, great work.
                                Last edited by Mike Doty; 18 Apr 2008, 10:35 AM.
                                Eighth Amendment:
                                “Excessive bail shall not be required, nor excessive fines imposed, nor cruel and unusual punishments inflicted.”​

                                Comment

                                • Mike Doty
                                  Member
                                  • Feb 2005
                                  • 9264

                                  #17
                                  If someone is performing date math they would format the string after obtaining the result.
                                  This would also remove the string handling. The current version is for ease of use in displaying the result.

                                  Code:
                                  DECLARE SUB DateDif(FromYear AS LONG, FromMonth AS LONG, FromDay AS LONG, _
                                                   ToYear   AS LONG, ToMonth   AS LONG, ToDay   AS LONG, _
                                                   OPTIONAL BYVAL Birthday AS LONG)
                                  Last edited by Mike Doty; 18 Apr 2008, 11:01 AM.
                                  Eighth Amendment:
                                  “Excessive bail shall not be required, nor excessive fines imposed, nor cruel and unusual punishments inflicted.”​

                                  Comment

                                  • Michael Mattias
                                    Member
                                    • Aug 1998
                                    • 43447

                                    #18
                                    The problem with 'accuracy' is there are multiple possible correct answers:

                                    Is the difference between April 18 2007 and April 18 2008 Exactly one year? Or it is it "one year, one day" because there was a Feb 29th in 2008 which had to be lived, a day which never happened between 4/18/06 and 4/18/07?

                                    IIRC there was a fairly lengthy thread on this exact same subject about six months ago, and the answer came out the same: "Correct = Whatever the User Thinks It Should Be"

                                    When "what the user thinks" is involved, written confirmation is mandatory.
                                    Michael Mattias
                                    Tal Systems (retired)
                                    Port Washington WI USA
                                    [email protected]
                                    http://www.talsystems.com

                                    Comment

                                    • Paul Purvis
                                      Member
                                      • Mar 2003
                                      • 2923

                                      #19
                                      please go to this thread at this time

                                      new code listed on internet is pointed to in the above thread
                                      i found an error in the code and fix it prior to asking for test from members at the thread above

                                      once testing is felt to be completed, i will repost in this section.
                                      follow above thread for testing

                                      in response to Mike's note about a validation error on a month being larger that 12, i could not see an error or i could not see what he was seeing.
                                      non valid dates return dates of -1(negative) on calculation returns.

                                      paul
                                      Last edited by Paul Purvis; 18 Apr 2008, 08:53 PM.
                                      p purvis

                                      Comment

                                      • Paul Purvis
                                        Member
                                        • Mar 2003
                                        • 2923

                                        #20
                                        the only changes in the future will be in an alternative for date string to julian date numbers and julian date numbers to date strings.

                                        this listing will work with dates in the year 0000 and the next will not.
                                        both routines will give the same julian date routines from the year 0001 forward.

                                        the date routines listed here will allow the year 0000 and the julian date numbers will match up to the iso 8601 date standards that are now the most current ISO date standard.

                                        but once again this program was written mostly for the today's useage and the program as tested will handle two different aging methods, one based on where end of months are the same in length and the second method, anniversary style dating for such things as how old a person is in months and days.

                                        paul



                                        Code:
                                        'compymmdd.bas
                                        'compute years month and days differences
                                        'program considers end of months dates to be the same no matter the days in the month.
                                        '
                                        'this program is somewhat different in that if the first date is the last day of a month
                                        'a whole month will not increase until any month has passed
                                        'if you wanted to be calculate birthdays, it would be best to subtract 30 from the days variable and add one month to the totalmonths
                                        
                                        #COMPILE EXE
                                        #DIM ALL
                                        DECLARE FUNCTION date2julian(mm_dd_yyyy AS STRING) AS LONG
                                        DECLARE FUNCTION julian2date(jd AS LONG) AS STRING
                                        DECLARE FUNCTION computeymdd(lowdate AS STRING, highdate AS STRING,usebirthdaytypemonth AS LONG) AS STRING
                                        
                                        
                                        FUNCTION datevalidate(mm_dd_yyyy AS STRING) AS LONG
                                        LOCAL temp1&,temp2&,temp3&,temp4&,templeapyearflag&
                                        LOCAL tbuffer AS BYTE PTR
                                        FUNCTION=0&
                                        temp4&=LEN(mm_dd_yyyy)
                                        IF temp4<10& THEN
                                             IF temp4<9& THEN EXIT FUNCTION
                                             mm_dd_yyyy=RIGHT$("0"+mm_dd_yyyy,10&)
                                        END IF
                                        tbuffer=STRPTR(mm_dd_yyyy)
                                        temp1&=(PEEK(BYTE,tbuffer)-48)*10+PEEK(BYTE,tbuffer+1?)-48
                                        temp2&=(PEEK(BYTE,tbuffer+3?)-48)*10+PEEK(BYTE,tbuffer+4?)-48
                                        temp3&=(PEEK(BYTE,tbuffer+6?)-48)*1000+(PEEK(BYTE,tbuffer+7?)-48)*100+(PEEK(BYTE,tbuffer+8?)-48)*10+(PEEK(BYTE,tbuffer+9?)-48)
                                        
                                        IF temp3&<1 THEN
                                            IF temp3& THEN EXIT FUNCTION
                                            IF temp2&=0& AND temp1&=0& THEN FUNCTION=-1&
                                            'Remove or remark out the next line if you want to include the year 0000
                                            EXIT FUNCTION
                                        END IF
                                        
                                        IF temp1&<1 OR TEMP2&<1 THEN EXIT FUNCTION
                                        IF temp2&<29 THEN FUNCTION=1&:EXIT FUNCTION
                                        temp4&=CHOOSE&(temp1&,32,30,32,31,32,31,32,32,31,32,31,32)
                                        IF temp4& THEN
                                              IF temp1&<>2 THEN                  ' here if the month is february pass over test
                                                 IF temp2&<temp4& THEN FUNCTION=1& ' if true the #of days are equal to or less than the total days in a month
                                                 EXIT FUNCTION  'here the day is greater than the # of days in a month
                                              ELSE
                                                 IF temp2&>29& THEN EXIT FUNCTION
                                                'here is where we know the day is the 29th of february
                                                IF temp3& MOD 4& = 0& THEN templeapyearflag&=1&
                                                IF temp3& MOD 100& =0& THEN templeapyearflag&=0&
                                                IF temp3& MOD 400& =0& THEN templeapyearflag&=1&
                                                IF templeapyearflag& THEN FUNCTION=1&
                                              END IF
                                        END IF
                                        'this function will return a 0 if the program gets here
                                        END FUNCTION
                                        
                                        
                                        
                                        
                                        FUNCTION PBMAIN AS LONG
                                        ' ex computeymdd(lowdate,highdate,0) 'mm/dd/yyyy required
                                        ' ex for counting birthdays computeymdd(lowdate,highdate,1) 'mm/dd/yyyy required
                                        
                                        
                                        STDOUT "the same dates with two methods"
                                        STDOUT "1st method could be called a whole month method because"
                                        STDOUT "  it treats days at the end of each month being the same"
                                        STDOUT "  ex. one month from 06/30/0001 equals 07/30/0001 and 07/31/0001"
                                        STDOUT "2nd method could be called a calendar method because it counts"
                                        STDOUT "  the months and days since a certain date."
                                        STDOUT "  ex. one month from 06/30/0001 equals 07/30/0001"
                                        STDOUT "   07/31/001 is one month and one day, closer to counting a birthday"
                                        STDOUT
                                        STDOUT "09/22/1918  04/04/1994"
                                        STDOUT computeymdd("09/22/1918","04/04/1994",0)
                                        STDOUT computeymdd("09/22/1918","04/04/1994",1)
                                        STDOUT "-----------------------------------------------------"
                                        STDOUT "01/01/0004  02/03/0004"
                                        STDOUT computeymdd("01/01/0004","02/03/0004",0)
                                        STDOUT computeymdd("01/01/0004","02/03/0004",1)
                                        STDOUT "-----------------------------------------------------"
                                        STDOUT "01/01/0004  02/29/0004"
                                        STDOUT computeymdd("01/01/0004","02/29/0004",0)
                                        STDOUT computeymdd("01/01/0004","02/29/0004",1)
                                        STDOUT "-----------------------------------------------------"
                                        STDOUT "01/27/0001  02/28/0001"
                                        STDOUT computeymdd("01/27/0001","02/28/0001",0)
                                        STDOUT computeymdd("01/27/0001","02/28/0001",1)
                                        STDOUT "-----------------------------------------------------"
                                        STDOUT "01/27/1989  02/28/1989"
                                        STDOUT computeymdd("01/27/1989","02/28/1989",0)
                                        STDOUT computeymdd("01/27/1989","02/28/1989",1)
                                        STDOUT "-----------------------------------------------------"
                                        STDOUT "01/31/0004  02/28/0004"
                                        STDOUT computeymdd("01/31/0004","02/28/0004",0)
                                        STDOUT computeymdd("01/31/0004","02/28/0004",1)
                                        STDOUT "-----------------------------------------------------"
                                        STDOUT "01/31/0004  02/29/0004"
                                        STDOUT computeymdd("01/31/0004","02/29/0004",0)
                                        STDOUT computeymdd("01/31/0004","02/29/0004",1)
                                        STDOUT "-----------------------------------------------------"
                                        STDOUT "01/31/0001  02/28/0001"
                                        STDOUT computeymdd("01/31/0001","02/28/0001",0)
                                        STDOUT computeymdd("01/31/0001","02/28/0001",1)
                                        STDOUT "-----------------------------------------------------"
                                        STDOUT "01/31/0001  03/30/0001"
                                        STDOUT computeymdd("01/31/0001","03/30/0001",0)
                                        STDOUT computeymdd("01/31/0001","03/30/0001",1)
                                        STDOUT "-----------------------------------------------------"
                                        STDOUT "01/31/0001  03/31/0001"
                                        STDOUT computeymdd("01/31/0001","03/31/0001",0)
                                        STDOUT computeymdd("01/31/0001","03/31/0001",1)
                                        STDOUT "-----------------------------------------------------"
                                        STDOUT "02/28/0001  03/30/0001"
                                        STDOUT computeymdd("02/28/0001","03/30/0001",0)
                                        STDOUT computeymdd("02/28/0001","03/30/0001",1)
                                        STDOUT "-----------------------------------------------------"
                                        STDOUT "02/28/0001  03/31/0001"
                                        STDOUT computeymdd("02/28/0001","03/31/0001",0)
                                        STDOUT computeymdd("02/28/0001","03/31/0001",1)
                                        STDOUT "-----------------------------------------------------"
                                        STDOUT "02/28/0003  03/30/0004"
                                        STDOUT computeymdd("02/28/0003","03/30/0004",0)
                                        STDOUT computeymdd("02/28/0003","03/30/0004",1)
                                        STDOUT "-----------------------------------------------------"
                                        STDOUT "02/28/0003  03/31/0004"
                                        STDOUT computeymdd("02/28/0003","03/31/0004",0)
                                        STDOUT computeymdd("02/28/0003","03/31/0004",1)
                                        STDOUT "-----------------------------------------------------"
                                        STDOUT "02/29/0004  03/30/0004"
                                        STDOUT computeymdd("02/29/0004","03/30/0004",0)
                                        STDOUT computeymdd("02/29/0004","03/30/0004",1)
                                        STDOUT "-----------------------------------------------------"
                                        STDOUT "02/29/0004  03/31/0004"
                                        STDOUT computeymdd("02/29/0004","03/31/0004",0)
                                        STDOUT computeymdd("02/29/0004","03/31/0004",1)
                                        STDOUT "-----------------------------------------------------"
                                        STDOUT "02/29/1988  03/31/1989"
                                        STDOUT computeymdd("02/29/1988","03/31/1989",0)
                                        STDOUT computeymdd("02/29/1988","03/31/1989",1)
                                        STDOUT "-----------------------------------------------------"
                                        STDOUT "02/29/1988  02/28/1989"
                                        STDOUT computeymdd("02/29/1988","02/28/1989",0)
                                        STDOUT computeymdd("02/29/1988","02/28/1989",1)
                                        STDOUT "-----------------------------------------------------"
                                        STDOUT "02/29/1988  06/30/1988"
                                        STDOUT computeymdd("02/29/1988","06/30/1988",0)
                                        STDOUT computeymdd("02/29/1988","06/30/1988",1)
                                        STDOUT "-----------------------------------------------------"
                                        STDOUT "06/30/0004  07/31/0004"
                                        STDOUT computeymdd("06/30/0004","07/31/0004",0)
                                        STDOUT computeymdd("06/30/0004","07/31/0004",1)
                                        STDOUT "-----------------------------------------------------"
                                        STDOUT "12/31/0004  01/31/0005"
                                        STDOUT computeymdd("12/31/0004","01/31/0005",0)
                                        STDOUT computeymdd("12/31/0004","01/31/0005",1)
                                        STDOUT "-----------------------------------------------------"
                                        STDOUT "check the validatiy of date routines "
                                        STDOUT "date 1875-05-20 should be equal to julian date 2406029"
                                        STDOUT "calculated julian date of 05/20/1875 ="+STR$(date2julian("05/20/1875"))
                                        STDOUT "calculated date from julian  2406029 = "+julian2date(2406029)
                                        
                                        WAITKEY$
                                        END FUNCTION
                                        
                                        
                                        
                                        FUNCTION computeymdd(lowdate AS STRING, highdate AS STRING,usebirthdaytypemonth AS LONG) AS STRING
                                        'mm/dd/yyyy required for lowdate and highdate
                                        'usebirthdaytypemonth will add a month if the days are over 30 days and subtract 30 from the days
                                        'usebirthdaytypemonth could have an difference in years,months and days
                                        LOCAL years, months, days, totaldays,totalmonths AS LONG
                                        LOCAL lowdateateom, I AS LONG
                                        LOCAL lowdatemth,lowdateday,lowdateyear,highdatemth,highdateday,highdateyear AS LONG
                                        LOCAL tempdate AS STRING
                                        'LOCAL  usebirthdaytypemonth as long
                                        'usebirthdaytypemonth=0&
                                        
                                        IF datevalidate(lowdate)<1& OR datevalidate(highdate)<1& THEN
                                           YEARS=-1&
                                           MONTHS=-1&
                                           DAYS=-1&
                                           TOTALDAYS=-1&
                                           totalmonths=-1&
                                          ' PRINT "error in dates"
                                           GOTO EXITTHEFUNCTION
                                        END IF
                                        
                                        totaldays=date2julian(highdate)-date2julian(lowdate)
                                        IF totaldays<0& THEN
                                           YEARS=-1&
                                           MONTHS=-1&
                                           DAYS=-1&
                                           TOTALDAYS=-1&
                                           totalmonths=-1&
                                           'PRINT "error 2nd date prior to first date"
                                           GOTO exitthefunction
                                        END IF
                                        
                                        REM days are valid and computation can be done
                                        
                                        lowdatemth=VAL(MID$(lowdate,1&,2&))
                                        lowdateday=VAL(MID$(lowdate,4&,2&))
                                        lowdateyear=VAL(MID$(lowdate,7&,4&))
                                        highdatemth=VAL(MID$(highdate,1&,2&))
                                        highdateday=VAL(MID$(highdate,4&,2&))
                                        highdateyear=VAL(MID$(highdate,7&,4&))
                                        
                                        IF lowdateyear=highdateyear THEN
                                           IF lowdatemth=highdatemth THEN
                                           YEARS=0&
                                           MONTHS=0&
                                           DAYS=totaldays
                                           totalmonths=0&
                                           GOTO EXITTHEFUNCTION
                                           END IF
                                        END IF
                                        
                                        'compute to see if the low date is a date at the end of a month and if so check the high date
                                        '  if the high date is also at the end of the month do date math
                                        IF usebirthdaytypemonth&=0 THEN
                                        IF VAL(MID$(julian2date(date2julian(lowdate)+1&),1&,2&))<>lowdatemth THEN
                                                IF VAL(MID$(julian2date(date2julian(highdate)+1&),1&,2&))<>highdatemth THEN
                                               'both dates are end of the month, compute months"
                                                totalmonths=(highdatemth+(highdateyear*12&))-(lowdatemth+(lowdateyear*12&))
                                                years=totalmonths\12&
                                                months=totalmonths MOD 12&
                                                days=0&
                                                GOTO exitthefunction
                                                END IF
                                              lowdateateom=1&
                                            ELSE
                                              lowdateateom=0&
                                        END IF
                                        END IF
                                        
                                        'set a temporary date
                                        tempdate=highdate
                                        FOR I=0& TO 3&
                                        MID$(tempdate,4,2)=RIGHT$("0"+TRIM$(STR$(lowdateday-I)),2)
                                        IF datevalidate(tempdate)=1 THEN EXIT FOR
                                        NEXT I
                                        IF date2julian(tempdate)=date2julian(highdate) THEN
                                                totalmonths=(highdatemth+(highdateyear*12&))-(lowdatemth+(lowdateyear*12&))
                                                years=totalmonths\12&
                                                months=totalmonths MOD 12&
                                                days=0&
                                                GOTO exitthefunction
                                            END IF
                                        
                                        tempdate=highdate
                                        MID$(tempdate,4,2)=RIGHT$("0"+TRIM$(STR$(lowdateday)),2)
                                        IF datevalidate(tempdate)=1 THEN
                                            IF date2julian(tempdate)<=date2julian(highdate) THEN
                                              totalmonths=(VAL(MID$(tempdate,1,2))+(VAL(MID$(tempdate,7,4))*12&))-(lowdatemth+(lowdateyear*12&))
                                              years=totalmonths\12&
                                              months=totalmonths MOD 12&
                                              days=date2julian(highdate)-date2julian(tempdate)
                                              GOTO EXITTHEFUNCTION
                                            END IF
                                        END IF
                                        'find the last day of the month previous to the highdate
                                        IF lowdateateom THEN
                                            tempdate=highdate
                                            MID$(tempdate,4,2)="01
                                            tempdate=julian2date(date2julian(tempdate)-1)
                                        END IF
                                        IF date2julian(tempdate)<date2julian(highdate) THEN
                                            totalmonths=(VAL(MID$(tempdate,1,2))+(VAL(MID$(tempdate,7,4))*12&))-(lowdatemth+(lowdateyear*12&))
                                            years=totalmonths\12&
                                            months=totalmonths MOD 12&
                                            days=date2julian(highdate)-date2julian(tempdate)
                                            GOTO EXITTHEFUNCTION
                                        END IF
                                        
                                        tempdate=highdate
                                        MID$(tempdate,4,2)="01
                                        tempdate=julian2date(date2julian(tempdate)-1)
                                        FOR I=0& TO 3&
                                        MID$(tempdate,4,2)=RIGHT$("0"+TRIM$(STR$(lowdateday-I)),2)
                                        IF datevalidate(tempdate)=1 THEN EXIT FOR
                                        NEXT I
                                        totalmonths=(VAL(MID$(tempdate,1,2))+(VAL(MID$(tempdate,7,4))*12&)) - (lowdatemth+(lowdateyear*12&))
                                        years=totalmonths\12&
                                        months=totalmonths MOD 12&
                                        days=date2julian(highdate)-date2julian(tempdate)
                                        
                                        
                                        EXITTHEFUNCTION:
                                        IF usebirthdaytypemonth THEN
                                               computeymdd=_lowdate+" to "+highdate+ "  using birthdate date math"+$CRLF+_
                                                 STR$(years)+" yrs"+STR$(months)+" mths"+STR$(days)+" days    "+_
                                                 STR$(totalmonths)+" total months actual days "+STR$(totaldays)
                                               ELSE
                                             computeymdd=_lowdate+" to "+highdate+ "  using simple calendar date math"+$CRLF+_
                                                 STR$(years)+" yrs"+STR$(months)+" mths"+STR$(days)+" days    "+_
                                                 STR$(totalmonths)+" total months actual days "+STR$(totaldays)
                                              END IF
                                        
                                        END FUNCTION
                                        
                                        
                                        '=============================================================================================================================================================
                                        
                                        
                                        FUNCTION date2julian(mm_dd_yyyy AS STRING) AS LONG
                                        'this function does not check the validity of a date, use the datevalidate function above for that purpose
                                        LOCAL month,day,year,k,julian AS LONG
                                        LOCAL tbuffer AS BYTE PTR
                                        tbuffer=STRPTR(mm_dd_yyyy)
                                        month=(PEEK(BYTE,tbuffer)-48)*10+PEEK(BYTE,tbuffer+1?)-48
                                        day=(PEEK(BYTE,tbuffer+3?)-48)*10+PEEK(BYTE,tbuffer+4?)-48
                                        year=(PEEK(BYTE,tbuffer+6?)-48)*1000+(PEEK(BYTE,tbuffer+7?)-48)*100+(PEEK(BYTE,tbuffer+8?)-48)*10+(PEEK(BYTE,tbuffer+9?)-48)
                                        k = INT((14 - month) / 12)
                                        IF month THEN
                                            date2julian = (day + INT(367 * (month + (k * 12) - 2) / 12)+ INT(1461 * (year + 4800 - k) / 4) - 32113)-_
                                                       (INT(3& * INT((year + 100& - k) / 100&) / 4&) - 2&) 'convert to gregorian
                                            ELSE
                                            date2julian=0
                                        END IF
                                        
                                        END FUNCTION
                                        
                                        FUNCTION julian2date(jd AS LONG) AS STRING
                                        'any julian date number below 1721060 will return a date of "00/00/0000"
                                        LOCAL ss AS STRING
                                        ss="00/00/0000"
                                        IF jd<1721060 THEN GOTO EXITTHEFUNCTION
                                        LOCAL  m,d,y, q, r, s, t, u, v AS LONG
                                        q = INT((jd / 36524.25) - 51.12264)
                                        r = jd + q - INT(q / 4&) + 1&
                                        s = r + 1524&
                                        t = INT((s / 365.25) - 0.3343)
                                        u = INT(t * 365.25)
                                        v = INT((s - u) / 30.61)
                                        d = s - u - INT(v * 30.61)
                                        m = (v - 1&) + 12& * (v > 13.5)
                                        y = t - (m < 2.5) - 4716&
                                        LOCAL remains AS LONG
                                        LOCAL digit AS LONG
                                        LOCAL nextdigit AS LONG
                                        LOCAL nextcharacter AS LONG
                                        
                                         ASC(ss,1)  = m \10  +48
                                          ASC(ss,2)  = m MOD 10 + 48
                                          ASC(ss,4)  = d\10 + 48
                                          ASC(ss,5)  = d MOD 10 + 48
                                          Remains&=y
                                          FOR digit& = 4 TO 1 STEP -1
                                            NextDigit&=Remains& MOD 10
                                            Remains&=Remains& \ 10
                                            NextCharacter&=NextDigit& + 48
                                            ASC(ss,digit+6) = NextCharacter
                                          NEXT
                                        EXITTHEFUNCTION:
                                        FUNCTION=ss
                                        END FUNCTION
                                        Last edited by Paul Purvis; 23 Apr 2008, 11:31 AM.
                                        p purvis

                                        Comment

                                        Working...
                                        X