Removing a segment from an outgoing message

######################################################################
# Name:     tps_remove_segment
#
# Author:   Chris Hale
#
# Date:    
# 1999.03.10 Chris Hale
#          – wrote intitial version          
#
# 1999.05.24 Russ Ross
#          – fixed to not have memory leaks when creating new message
#
# Purpose:  Removes a segment(s) within a 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:
#                 SEGMENTS – Segments that you wish to have removed.
#           The segments should be passed with no
#           spaces.  This allows you to delete as many
#           segments as you like.
#           EXAMPLE:
#              {SEGMENTS PV1NK1OBX}
#
# Returns: tps disposition list:
#    CONTINUE – original message will be overwritten
#               with new messages that has the specified
#               segments removed

proc tps_remove_segment { args } {
  keylget args MODE mode                 ;# Fetch mode
  keylget args ARGS.SEGMENTS segments

  set dispList {}            ;# Nothing to return

  switch -exact — $mode {
 
     start {
        return “”
     }

     run {
        # ‘run’ mode always has a MSGID; fetch and process it
        keylget args MSGID mh

        # Initialize variables
        set segname_list {}
        set index1 0
        set index2 2
        set count 1
        set new_msg {}

        # Determine number of segments that you want to have eliminated
        # and put them in list format
        set arg_length [clength $segments]
        set num_segments [expr $arg_length/3]
        while {$count <= $num_segments} {            lappend segname_list [crange $segments $index1 $index2]            incr count            incr index1 3            incr index2 3         }         # echo REMOVING SEGMENTS ($segname_list)         # Retrieve the message and create a new message that         # contains only the segments that are wanted.         set msg [msgget $mh]         set seg_list [split $msg r]         foreach item $seg_list {            if {[cequal $item {}]} continue            set seg_id [crange $item 0 2]            set found_list [intersect $segname_list $seg_id]            if {[cequal $found_list {}]} {               append new_msg $item r            }         }                 msgset $mh $new_msg         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        }      default {         error "Unknown mode '$mode' in tps_remove_segment"      }   }    return $dispList }