[John Bass]

Thanks for the quick response Jim!  I tried running the script from the shell window after changing the extension but got this error.

tcl getportsall.tcl
Port Type Host/site thread Protocol Thread/Dest Site
——– ————— —————————————- ———- —————————— —————
can’t read “threadlist”: no such variable
while executing
“lsort $threadlist”
invoked from within
“set threadlist [lsort $threadlist]”
(file “getportsall.tcl” line 107)

 

[John Bass]

Thanks for the sample code.  It got me pointed in the right direction.  As it turns out, all I need to do is calculate the patient’s age at admission in years.  Here’s the proc I came up with, I need to do some more testing but it seems to work correctly.  Thanks again!

Code:

######################################################################
# 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"
       }
   }

}

[Author]

Replies