using tbllookup, need advice

####################################################################### Name: tpsCheckTable
# Purpose: Messages with test code “90397^RADIOLOGY” are sent to the error database (see proc TpsOBR4_check), because Cerner  
#          does not recognize this test code.  These error messages will be re-sent throught this procedure.  
#          The table RAD_TABLE contains strings found in OBX;5, which map to a test code that is recognize by Cerner.
#          **NOTE** RAD_TABLE needs to be updated after each radiology load with correct mapping of OBX;5 strings to valid OBR;4
#          test codes. The value (test code) from the table replaces what is in OBR;4.
# UPoC type: tps
# Args: tps keyedlist containing the following keys:
#       MODE    run mode (”start”, “run” or “time”)
#       MSGID   message handle
#       ARGS    user-supplied arguments:
#               {HISTORYTBL RAD_TABLE}
#
# Returns: tps disposition list:
#          
#

proc tpsCheckTable { args } {
   keylget args MODE mode               ;# Fetch mode

   set dispList {} ;# 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 {
   # ‘run’ mode always has a MSGID; fetch and process it
           keylget args MSGID mh
           set msg [ msgget $mh ]
           set radTable [ keylget args ARGS.HISTORYTBL ]              
           set fieldsep [ string index $msg 3 ]
           set segmentList [ split $msg r ]                        
           set OBRidx [ lsearch -regexp $segmentList ^OBR ]
           #puts “OBRidx: $OBRidx”
           set OBRsegment [ lindex [ lregexp $segmentList ^OBR ] 0 ]
           set OBRfieldlist [ split $OBRsegment $fieldsep ]
           set OBR4 [ lindex $OBRfieldlist 4 ]                        
           set newSegmentList “”

           foreach segment $segmentList {       ;#Loop through list of segs
               set segtype [ string range $segment 0 2 ]
               if [ string equal $segtype “OBX” ] {
                   set fieldsList [ split $segment $fieldsep ]
                   set obX5 [ lindex $fieldsList 5 ]                  
                   #puts “OBX5 is: $obX5”
                   set tblobxlist “”
                   set tblobxlist [ tbllookup $radTable $obX5 ]
                   if {$tblobxlist != “”} {                          
                       set newOBR4 $tblobxlist
                       #puts “New OBR4 is: $newOBR4”  
                       #puts “Original OBR4: $OBR4”
                       set newSegmentList [ join [ lreplace $OBRfieldlist 4 4 $newOBR4 ] $fieldsep ]
                       #puts “New OBR segmentlist: $newSegmentList”
                       
                       set segmentList [ lreplace $segmentList $OBRidx $OBRidx $newSegmentList ]     ;#insert new OBR segment
                       #puts “New segmentList: $segmentList”
                       set newMsg [ join $segmentList r ]                                           ;#join msg back together with r
                       #puts “New msg: $newMsg”
                       msgset $mh $newMsg    
                   }
               }
           }
           
           lappend dispList “CONTINUE $mh”
       }

       time {
           # Timer-based processing
   # N.B.: there may or may not be a MSGID key in args
       }
       
       shutdown {
   # Doing some clean-up work
}
   }

   return $dispList
}