Blank PID 4

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

# Name:         blank_pid_4.tcl                          

# Purpose       Blank out various fields in PID for TrueVue interface

# UPoC type:    tps

# Args:         tps keyedlist containing the following keys:

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

#               MSGID   message handle

#               ARGS    user-supplied arguments:

#                       KILLCOND        Literal that the field will be qualifying on

#                       SEGNAME         Segment to check

#                       FIELDNUM        Field number to check within the segment

#                       SUBFIELDNUM     Subfield to check within the field

#

# Returns: tps disposition list:

#

proc blank_pid_4 { 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]                                ;# Get message

           set outbuf {}

#

# Split the message and get fields to check

# First set up some constants

#

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

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

           set rep [csubstr $msg 5 1]      

           set segments [split $msg r]                        ;# Get segments

#

# LOOP through to find the qualifying field

#

           set orc1 “”

           set obr25 “”

         

           foreach seg $segments {

               if [cequal $seg “”] { continue }                ;# Just in case

               set segtype [csubstr $seg 0 3]                  ;# Get segment name

       if {[cequal $segtype “PID”]} {

                        set fields [split $seg $sep]                

                        catch {set fields [lreplace $fields 2 2 “”]

                        catch {set fields [lreplace $fields 3 3 “”]

                        catch {set fields [lreplace $fields 10 10″”]

                        catch {set fields [lreplace $fields 15 15 “”]

                        catch {set fields [lreplace $fields 18 18 “”]

                        catch {set fields [lreplace $fields 40 40 “”]

                                                 }

                        set seg [join $fields $sep]

                   }

                   append outbuf ${seg}r

          } ;# end of ‘foreach’

          msgset $mh $outbuf

        lappend dispList “CONTINUE $mh”

         

   

       } ;# end of ‘run’

       time {

           # Timer-based processing

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

       }

       shutdown {

           #No shutdown code

       }

   }

   return $dispList

}