using tbllookup, need advice

[Gary Atkinson]

Hello- I am a novice clovertecher with very little tcl experience.  I have created a proc to look into a table and change the OBR;4 field.  The table contains a particular string that is OBX;5 and if found sent value to OBR;4.  Were doing a history load (It s a long story why I’m doing this)  😆 Anyways, I was hoping if anyone had any suggestions on how to improve by procedure or sees anything that I am doing wrong.  Running proc through testing tool provides good results so far.  Here is the procedure and thank you for your time:

Code:

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

Topic

[Michael Hertel]

Gary, your proc looks fine to me.

Things I’d change would be:

if {$tblobxlist != “”} {

to

if {![string equal $tblobxlist {}]} {

and

msgset $mh $newMsg

should be moved just before the lappend (only reset $mh when you’re done with everything)

i.e.

msgset $mh $newMsg

lappend dispList “CONTINUE $mh”

[Gary Atkinson]

Michael-

I changed the script to set the newMsg variable outside the loop and then lappend it back to the dispList variable.  Ran it through the testing tool and it looks good.  Thanks so much for your assistance  😀

Gary

[Author]

Replies