tclproc omitting a segment

######################################################################
# Name: tpsRxCreditQtyFix
# Purpose: This tps tclproc creates, depending on argument criteria,
# multiple outbound credit messages for each inbound credit
# message.  It uses the quantity to determine how many messages,
# each with a quantity of one, to create.  
#
# This will partially fix a problem that occurs between
# STAR Pharmacy and Affinity.  Currently, STAR lumps
# multiple credits for the same item into one HL7 message
# where the quantity is the total amount to credit.  Affinity
# will only apply the credit HL7 message to one charge and the
# quantity to credit must be less than or equal to the quantity
# of the individual charge.  If it isn’t, Affinity does not
# apply the credit and it appears on the exception report for
# accounting.
#
# The MAXMSGS argument puts a limit on the number of credit
# messages created.  This avoids a huge glut of messages if the
# quantity to credit is large.
#
# UPoC type: tps
# Args: tps keyedlist containing the following keys:
#       MODE    run mode (”start”, “run” or “time”)
#       MSGID   message handle
#       ARGS    user-supplied arguments:
#               {MAXMSGS 25}
#
# Returns: tps disposition list:
#          
#

proc tpsRxCreditQtyFix { args } {
   keylget args MODE mode               ;# Fetch mode

   # Set default in case user doesn’t enter the argument
   if ![keylget args ARGS.MAXMSGS maxmsgs] {
    set maxmsgs 20
   }
   
   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] ;# Load the message to variable
           set fs [crange $msg 3 3] ;# Load the field separator from msg
           set segments [split $msg r] ;# Load the transaction quantity
           
           # Roll through the segments to find the FT1 to process
           foreach seg $segments {
            set segtype [crange $seg 0 2] ;# Load the segment name to variable
           
            # Check for an FT1 segment
            if [cequal $segtype “FT1″] {
set fltseg [split $seg $fs] ;# Load a list from the FT1
set trantype [lindex $fltseg 6] ;# Load transaction type
set tranqty [lindex $fltseg 10] ;# Load transaction quantity
echo tranqty: $tranqty
# Set flag ON if message is a credit and the quantity field is
# greater than 1 and less than maximum entered in argument MAXMSGS.
set okFlag “” ;# Clear the flag
if [cequal $trantype “CR”] {
set tranqty [string trim $tranqty]
if [ctype digit $tranqty] {     ;# Validate quantity is number
if [expr ($tranqty > 1)] {
if [expr ($tranqty <= $maxmsgs)] { set okFlag "ON" } } } } # Check flag to determine how to handle message.  If set "ON" # multiple messages get created based on quantity else the # message is passed on unchanged. if [cequal $okFlag "ON"] { # Create duplicate copies of message up to the value of the quantity. # Each message has a quantity of 1. for {set i 0} {$i < $tranqty} {incr i} { # Build new message replacing the quantity with 1. after 500 set newmh [msgcopy $mh] ;# Returns the new msg handle set fltseg [lreplace $fltseg 10 10 1]   ;# Make qty a 1 set newseg [join $fltseg $fs] ;# Put segment back together append tmpmsg $storeseg $newsegr       ;# Add modified segment to message msgset $newmh $tmpmsg ;# Set the message handle with data set tmpmsg "" ;# Clear tmp field lappend dispList "CONTINUE $newmh"      ;# Add message to disp list     } # Dispose of original message since it is no longer needed lappend dispList "KILL $mh" } else { lappend dispList "CONTINUE $mh" ;# Continue original message }             }             append storeseg $segr ;# Append non FT1 segment to stored message            } # Check if the disposition list has been loaded with anything because if it hasn't # then it must not have had an FT1 segment.  Continue the original message. if [cequal $dispList {}] { lappend dispList "CONTINUE $mh" ;# Continue original message }                  }        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 tpsRxCreditQtyFix"        }    }    return $dispList }