T in free text field

[Kathy Riggle]

Our HIS sends T whenever a user types an ampersand in the HIS in a free text field. Depending on the field, sometimes this passes as-is; sometimes it truncates on the second . In either case, we have a couple of downstream systems that choke on it.

Does anyone have a tcl that will do a regsub on that sequence – or something else that will work for this?

Thanks, Kathy

Topic

[Max Drown (Infor)]

Example:

Code:

set var “foo \T\ bar”
puts $var
regsub -all — {BTB} $var {&} var
puts $var

The “B” means “” (backslash).

-- Max Drown (Infor)

[Gary Atkinson]

Here is proc I use to escape hl7 encoding characters.  It is argument driven and uses a table for fields.

Code:

######################################################################
# Name: tps_escape_char
# Purpose:
#
# A table is read to obtain the Segment and the number of the field(s) within
# the segment to check.  The field numbers must be separated by a dash.
# The specified field is checked, all occurrences of {$expr_match} are replaced with {$expr_set}.
# The new message is then created, the original message killed,
# and the new message is continued.
#
# This proc can be used in escape hl7 encoding characters.
# Written By: Gary Atkinson
# Date: 12/18/2008
#
# UPoC type: tps     Must be used/entered in TPS Inbound Data
# on Inbound Thread OR TPS Outbound Data.
# Args: tps keyed list containing the following keys:
#       MODE    run mode (”start”, “run” or “time”)
#       MSGID   message handle
#       ARGS
#      
#     {SEGMENTBL table_name}  name of table used:
#               {EXPR_MATCH {&}}   default
#              {EXPR_SET {\T\}}  default **note** need to escaped & if using in EXPR_SET.
#                                  Regsub will not replace if this is not done.
#
#        In the above ARGS the sub-component character & is escapedt to T.  The
#        engine will then not interpret.  The ARGS can be reversed in TPS Outbound data
#        to unescape the encoding character.  This procedure is usefully where encoding
#        characters are used as literal text.            
#
#
# Returns: tps disposition list:
#    If the message contains any $expr_match (except encoding characters in MSH)
#     A new reformattted messages is created.
#    The new (copied)  message is CONTINUE.
#    The original message is KILL.
# Otherwise
#    The origianl message is CONTINUE.

proc tps_escape_char { args } {
   keylget args MODE mode
   keylget args ARGS uargs    
   set segtable CIS_TABLE     ;keylget uargs SEGMENTBL segtable
   set expr_match {&}         ;keylget uargs EXPR_MATCH expr_match
   set expr_set {\T\}       ;keylget uargs EXPR_SET expr_set          
   
   set dispList {}    
   switch -exact — $mode {  
       start {
           return “”              
       }
       run {
           keylget args MSGID mh
           set msg [msgget $mh]                  
           set chkmsg [crange $msg 9 end]
           if {[regexp “$expr_match” $chkmsg] == 1} {
             set fieldSeparator [crange $msg 3 3]
             set segmentList [split $msg r]
             set newSegmentList “”
             foreach segment $segmentList {
                    set tblfieldlist 0
                    set segmentID [crange $segment 0 2]
                    set tblfieldlist [tbllookup $segtable $segmentID]
                    if {$tblfieldlist != 0} {
                           set fieldIDlist [split $tblfieldlist “-“]
                           set fieldList [split $segment $fieldSeparator]
                           foreach fieldID $fieldIDlist {
                                set oldfield “”
                                set oldfield [lindex $fieldList $fieldID]
 if {$oldfield != “”} {  
    regsub -all — “$expr_match” $oldfield “$expr_set” newfield
                                   set fieldList [lreplace $fieldList $fieldID $fieldID $newfield]
                               }
                           }
                    set segment [join $fieldList $fieldSeparator]
                   }      
            set newSegmentList [lappend newSegmentList $segment]
            }
            set newMsg [join $newSegmentList r]
            set mhNew [msgcopy $mh]
            msgset $mhNew $newMsg
            lappend dispList “KILL $mh”
            lappend dispList “CONTINUE $mhNew”
           } else {
            lappend dispList “CONTINUE $mh”
           }
     }

  shutdown {
   # Doing some clean-up work
  }

       default {
  error “Unknown mode ‘$mode’ in tps_escape_char”
   }
  }

 return $dispList
}

[Kathy Riggle]

Thanks, guys! We used Max’s code and it did the trick!

[Author]

Replies