tcl proc to strip out segments

#######################################################################################
#######################################################################################
#######################################################################################
#
# Name: tpsRemoveSegment
# Purpose: This procedure removes all the occurances of the user
#             specified segment from the message.
#
# UPoC type: tps
# Args: tps keyedlist containing the following keys:
#       MODE    run mode (”start”, “run” or “time”)
#       MSGID   message handle
#       ARGS    user-supplied arguments:
#               1) The user supplied segment to remove is in the form of a keyed list
#                The key is DLTSEG
#                The value is a 3 char string the represent the segment
# 2) The user can specify if we are to echo to log
# The key is ECHOON
# ECHOON = YES -> put entry in engine log
# ECHOON = NO -> do not put entry in log
#
# Example arguments: {DLTSEG ZTM} {ECHOON YES}
#
# Returns: tps disposition list:
#
# John Zalesak 01/19/2009
#
#######################################################################################
#######################################################################################
#######################################################################################

proc tpsRemoveSegment { args } {

#######################################################################################
# Get the Connection Name, Date, Time and tps name for Error/Debug Messages
#######################################################################################

global HciConnName
set myname “$HciConnName/[lindex [info level 1] 0]”
set nowis [clock format [clock scan now] -format “%D – %T”]

#######################################################################################
# Initialize Variables Used
#######################################################################################

set dispList {} ;# Disposition List Returned to Engine
set dltseg “xxx” ;# Segment to Delete
set dltpos 0 ;# Position in list of segment to delete

set echoon “xxx”   ;# Echo in Engine Log Indiator

set segfound NO ;# Flag to indicate if segment found

set MSHseg “” ;# Used to Store MSH Segment
set PIDseg “” ;# Used to Store PID Segment

#######################################################################################
# Load in the arguments we need that were passed from the caller
#######################################################################################

keylget args MODE mode             ;# The mode the engine called from
keylget args ARGS.DLTSEG dltseg ;# The segement to Delete
set dltseg [string toupper $dltseg] ;# Segments always upper case
keylget args ARGS.ECHOON echoon ;# The Engine Log output indicator
set echoon [string toupper $echoon] ;# Use upper case in procedure

#######################################################################################
# Error check arguments – Continue Msg and return if error found
#######################################################################################

if {$dltseg == “xxx”} {
echo “ERR:”
  echo “ERR:  ——————————————————————”
  echo “ERR:  Segment to Delete is not defined”
  echo “ERR:  Skipping procedure”
  echo “ERR:  $myname  –  $nowis”
  echo “ERR:  ——————————————————————”
  echo “ERR:”
  if {$mode == “run”} {
  set mh [keylget args MSGID] ;# Get message handle from args
   set dispList [list “CONTINUE $mh”] ;# Continue original message
   return $dispList
   }
  }

switch -exact — $echoon {
YES –
NO {}
default {
set echoon “YES”
echo “ERR:”
  echo “ERR:  ——————————————————————”
  echo “ERR:  Invalid Value for ECHOON = $echoon”
  echo “ERR:  ECHOON defaults to YES”
  echo “ERR:  $myname  –  $nowis”
  echo “ERR:  ——————————————————————”
  echo “ERR:”
  }
  }

#######################################################################################
# We only want to take action if called from the run mode
#######################################################################################

switch -exact — $mode {
start {
;# Do Nothing
     }

run {
set mh [keylget args MSGID] ;# Get message handle from args
   set dispList [list “CONTINUE $mh”] ;# Initialize to good message
     set msg [msgget $mh] ;# Get a copy of the message

     set fldSep [string index $msg 3] ;# Field Seperator
     set subSep [string index $msg 4] ;# Sub-Field Seperator

     set segList [split $msg r] ;# Split message into Segments        
     
#######################################################################################
# Get the MSH and PID for entry in the engine log if we delete a segment
#######################################################################################  
     
     set MSHseg [lindex $segList [lsearch -regexp $segList {^MSH}]]
     set PIDseg [lindex $segList [lsearch -regexp $segList {^PID}]]
     
#######################################################################################
# Search throught the segements for the segement to delete and delete them as you go
#######################################################################################
     
     set delpos [lsearch -regexp $segList ^$dltseg]
     while {$delpos >= 0} {
       ;# Begin While
      lvarpop segList $delpos
      set delpos [lsearch -regexp $segList ^$dltseg]
     
      set segfound YES

      } ;# End While
     
#######################################################################################
# Place message in engine log if user specified to and segment to delete is found
#######################################################################################
     
if {$echoon == “YES” && $segfound == “YES”} {          
      echo “:WARN”
      echo “:WARN  ——————————————————————”
      echo “:WARN  $dltseg segment(s) removed from message”
      echo “:WARN  $myname  –  $nowis”
      echo “:WARN  $MSHseg”
      echo “:WARN  $PIDseg”
      echo “:WARN  ——————————————————————”
      echo “:WARN”
      }
 
     
     
#######################################################################################
# Make sure that at least there is still an MSH segment
# If none – Put text in Metadata
# – Echo in Engine Log
# – Send original message to error database
#######################################################################################      
         
if {[lsearch -regexp $segList {^MSH}] < 0} {
;# Begin If
 msgmetaset $mh USERDATA "No MSH Segment!"
      echo ":WARN"
      echo ":WARN  ——————————————————————"
 echo ":WARN  Message reduced to nothing after removing $dltseg segment(s)."
 echo ":WARN  Sending original message to error db."
 echo ":WARN  $myname  –  $nowis"
      echo ":WARN  ——————————————————————"  
      echo ":WARN"
     
 msgset $mh $msg      
       set dispList [list "ERROR $mh"]

} else {
     
#######################################################################################
# Recreate message & write the new message back into memory for the engine to access
#######################################################################################

set msg [join $segList r]  
      msgset $mh $msg
      }

}

     time {
;# Do Nothing
       }
       
     shutdown {
;# Do Nothing
    }
} ;# End Switch

return $dispList

} ;# End Proc