age TCL problem????

Creator

Topic

• Author
  Replies
• • September 18, 2006 at 9:50 pm #59676
    Charlie Bursell

    Participant

    Take a look at this:

    Use the “howlong” routine

    http://mini.net/tcl/3189.html

  • September 19, 2006 at 12:22 pm #59677
    Scott Lee

    Participant

    Many ways to skin this cat, here is what I came up with a while back.  

    I converted all my dates to integers and did the simple math.  One thing I found with my method is I had to make special consideration if the person was born before 1900 or so due to the way TCL/Unix stores dates as integers.  I called it my Y1.9k problem.   🙄  I got around it by adding 100 years to the person’s birth date if they were born before 1903 before I converted to the integers, then added the 100 years back after I had their age.

    Whatever code you use in the end, be sure and test with both very young and very old people…

    In answer to your question – Could it be the field you are assigning the value to is too short?

    Scott

    Code:

    ######################################################################
    # Name: xltp_calculate_age
    # Purpose: To calculate the age of a person based on the admit date
    # date of birth.  Special coding is involved for birth
    # dates earlier than 1903 due to the integer limitation
    # of the tcl engine.  Output is converted to days, weeks,
    # months, or years depending on the age of the individual.
    # Output also indicates if the person is a minor or not.
    # UPoC type: xltp
    # Args: none
    # Notes: All data is presented through special variables.  The initial
    # upvar in this proc provides access to the required variables.
    #
    # This proc style only works when called from a code fragment
    # within an XLT.
    #

    proc xltp_calculate_age {} {
       upvar xlateId       xlateId
     xlateInList   xlateInList
     xlateInTypes  xlateInTypes
     xlateInVals   xlateInVals
     xlateOutList  xlateOutList
     xlateOutTypes xlateOutTypes
     xlateOutVals  xlateOutVals

    set dob [lindex $xlateInVals 0]
    #echo dob: $dob
    set admitdate [lindex $xlateInVals 1]
    #echo admitdate: $admitdate
    set dobyear [string range $dob 0 3]
    #echo dobyear: $dobyear
    set dobadjust 0
    if {$dobyear < 1903} { set dobyear [expr $dobyear + 100] set dobadjust 36525 #echo dobyear: $dobyear #echo dobadjust: $dobadjust } set dob $dobyear[string range $dob 4 7] #echo dob: $dob set admitdays [expr [clock scan [string range $admitdate 0 7]] / 60 / 60 / 24] #echo admitdays: $admitdays set dobdays [expr [clock scan $dob] / 60 / 60 / 24] #echo dobdays: $dobdays set age [expr [clock scan [string range $admitdate 0 7]] - [clock scan $dob]] set age [expr $admitdays - $dobdays + $dobadjust] #echo age: $age set xlateOutVals "" if {$age > 6575} {
    set minor FALSE
    } else {
    set minor TRUE
    }
    #echo minor: $minor
    if {$age > 730} {
    set age [int [expr $age/365.25]]
    lappend xlateOutVals $age “$age Y” $minor
    } elseif {$age > 61} {
    set age [int [expr $age/30.4]]
    lappend xlateOutVals $age “$age M” $minor
    } elseif {$age > 13} {
    set age [int [expr $age/7]]
    lappend xlateOutVals $age “$age W” $minor
    } else {
    lappend xlateOutVals $age “$age D” $minor
    }
    #echo outvals: [lindex $xlateOutVals 0] [lindex $xlateOutVals 1] [lindex $xlateOutVals 2]
    }

• Author
  Replies