Age at admission

######################################################################
# Name:         calc_age.tcl  
# Purpose:      Calculate patient age at time of admission and
#                  add OBX segment with calculated age in OBX-5
#
# Args:         tps keyedlist containing the following keys:
#               MODE    run mode (”start”, “run” or “time”)
#               MSGID   message handle
#               ARGS    user-supplied arguments:
#              
#

proc calc_age { args } {
   global HciConnName

   keylget args MODE mode        ;# Fetch mode argument
   keylget args CONTEXT context  ;# Fetch context argument (where this proc is being called from)

   set dispList {}               ;# default dispList to Nothing to return
   
   switch -exact — $mode {
       start {
           # Perform special init functions
           # N.B.: there may or may not be a MSGID key in args
       }
       
       run {
           keylget args MSGID mh               ;# Fetch the MSGID
           set msg [msgget $mh]                ;# Get the Message Handle

           set outbuf {}
           
           # Now we need to determine our field and sub components
           set field_sep [csubstr $msg 3 1]      ;# HL7 field separator
           set sub_sep [csubstr $msg 4 1]        ;# HL7 subfield separator
           set sub_sub_sep [csubstr $msg 7 1]    ;# HL7 sub-subfield separator
           set rep_sep [csubstr $msg 5 1]
           set outbuf {}
           
           set segmentList [split $msg r]
           
           # Get Date of Birth in PID-7
           set pidLoc [lsearch -regexp $segmentList {^PID}]
           if {$pidLoc == -1} {error “No PID segment!”}
           set pidSeg [lindex $segmentList $pidLoc]
           set pidFld [split $pidSeg $field_sep]
           set pidFld_7 [lindex $pidFld 7]
           if {$pidFld_7 > “”} {
               set dob [string range $pidFld_7 0 7]
               set dob_ccyy [string range $pidFld_7 0 3]
               set dob_mmdd [string range $pidFld_7 4 7]
           }
           
           # Get Admission Date in PV1-44
           set pv1Loc [lsearch -regexp $segmentList {^PV1}]
           if {$pv1Loc == -1} {error “No PV1 segment!”}
           set pv1Seg [lindex $segmentList $pv1Loc]
           set pv1Fld [split $pv1Seg $field_sep]
           set pv1Fld_44 [lindex $pv1Fld 44]
           if {$pv1Fld_44 > “”} {
               set admit_date [string range $pv1Fld_44 0 7]
               set admit_ccyy [string range $pv1Fld_44 0 3]
               set admit_mmdd [string range $pv1Fld_44 4 7]
               # Calculate age at admission in years
               set age [expr $admit_ccyy – $dob_ccyy]
               if {”$dob_mmdd” > “$admit_mmdd”} {
                 set age [expr $age – 1]
               }
               if {$age < "0"} {
                   set age "0"
               }

        set unit "YEARS"

           }
           
           foreach segment $segmentList {
           if [cequal $segment ""] { continue }
           append outbuf ${segment}r
           set eventtype [csubstr $segment 0 3]
           }
           if {[cequal $eventtype "PV2"]} {
           # Add OBX segment with age at admission
           set addOBX "OBX|1|TX|||$age|$unit"
           append outbuf ${addOBX}r
           }

           msgset $mh $outbuf
           lappend dispList "CONTINUE $mh"
           return $dispList
           
        }
       
       time {
           # Timer-based processing
           # N.B.: there may or may not be a MSGID key in args
       }

       shutdown {
           # Doing some clean-up work
       }

       default {
           error "Unknown mode '$mode' in calc_age.tcl"
       }
   }

}