Re: tcl code for replacing PID (2) data value with blank space

[Stephan Head]

We use the following to remove PID:2 (HNE #) from the HIS.

######################################################################

# Name:         remove_hne_fld.tcl

# Purpose:

#               Removes PID:2 from PID segment

#               Removes MRG:4 from A34 and A36 messages

#

# UPoC type: Pre Xlate

# Args:      tps keyedlist containing the following keys:

#            MODE    run mode (“start”, “run” or “time”)

#            MSGID   message handle

#            ARGS    user-supplied arguments:

#              

# Returns:   tps disposition list:

#            CONTINUE – Message was processed normally – continue into engine.

#            ERROR – Message processing failed – put message into the error db.

#

#####################################################################

proc remove_hne_fld { args } {

   global HciConnName

   keylget args MODE mode         ;# Fetch mode

   keylget args CONTEXT context   ;# Fetch context

   

   if { ! [info exists HciConnName] } {

       set HciConnName “UNKNOWN_TD”

   }

   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 {

           keylget args MSGID mh                 ;# Fetch the MSGID

   

           set msg [msgget $mh]                  ;# Get the Message Handle

           set field_sep [csubstr $msg 3 1]      ;# HL7 field separator        

           set sub_sep [csubstr $msg 4 1]        ;# HL7 subfield separator

           # Cycle through message and retrieve PID segment.    

           set segmentList [split $msg r]

           foreach segment $segmentList {

               if [cequal [crange $segment 0 2] PID] {

                  set fieldList [split $segment $field_sep]

                  # Set PID-2 variable

                  set pid_2 {}

                  # Remove PID-2 value

                  catch {set fieldList [lreplace $fieldList 2 2 $pid_2]}

                  set segment [join $fieldList $field_sep]

               }

               if [cequal [crange $segment 0 2] MRG] {

                  set fieldList [split $segment $field_sep]

                  # Set MRG-4 variable

                  set mrg_4 {}

                  # Remove MRG-4 value

                  catch {set fieldList [lreplace $fieldList 4 4 $mrg_4]}

                  set segment [join $fieldList $field_sep]

               }

              append outbuf ${segment}r

           }

         set outbuf [string trimright $outbuf “r”]

           set outbuf “$outbufr”

           msgset $mh $outbuf

           lappend dispList “CONTINUE $mh”

        }

       shutdown {

           # Doing some clean-up work

       }

       

       time {

           # Timer-based processing

           # N.B.: there may or may not be a MSGID key in args

       }

       default {

           error “Unknown mode ‘$mode’ in remove_hne_fld”

       }

   }

   return $dispList

}