› Clovertech Forums › Read Only Archives › Cloverleaf › Cloverleaf › How do I add a trailing bars to a Segment › Reply To: How do I add a trailing bars to a Segment
There is a global TPS proc ( tps_pad_segemnts ) in both our test and production environment that is used in one of our old integrations.
Here is the code for tps_pad_segemnts.tcl
################################################################################
# Name: tps_pad_segments
# Purpose:
# UPoC type: tps
# Args: tps keyedlist containing the following keys:
# MODE run mode (”start”, “run” or “time”)
# MSGID message handle
# ARGS user-supplied arguments:
#
# Returns: tps CONTINUE
#
# Notes :
#
#
#———
# History:
#———
#
# 2000.07.17 Goutham Mullaguru
# – wrote initial version
#
# 2000.07.20 Russ Ross
# – fixed bug that errors out and causes the message to be lost
# when $add_fields = 0
#
################################################################################
proc tps_pad_segments { args } {
keylget args MODE mode
switch -exact — $mode {
start {
# Perform special init functions
return “”
}
run {
keylget args MSGID mh
keylget args ARGS.KEEPLIST keeplist
#
set msg [msgget $mh]
set segments [split $msg “r”]
set field_separator [csubstr $msg 3 1]
set seg_list [split $keeplist “|”]
set argcntr [llength $keeplist]
#
set cntr 0
foreach seg $seg_list {
set sublist [split $seg “^”]
set subseg [lindex $sublist 0]
set keepfields [lindex $sublist 1]
set segment_location [lsearch -regexp $segments “^$subseg”]
set segment [lindex $segments $segment_location]
if [cequal $segment “”] {continue}
set no_of_fields [regsub -all — {|} $segment “” segout]
set add_fields [expr $keepfields – $no_of_fields]
if {$add_fields <= 0} {continue}
if {$add_fields > 0 } {
set new_fields [replicate | $add_fields]
set new_segment “$segment$new_fields”
}
set segments [lreplace $segments $segment_location $segment_location $new_segment]
if ![cequal $cntr $argcntr] {incr cntr}
}
set new_message [join $segments r]
msgset $mh $new_message
return “{CONTINUE $mh}”
}
shutdown {
# Doing some clean-up work
}
default {
return “”
error “Unknown mode ‘$mode’ in tps_pad_segments”
}
}
}
I might as well post this procs counter part called tps_truncate_segments.tcl
################################################################################
# Name: tps_truncate_segments
# Purpose:
# UPoC type: tps
# Args: tps keyedlist containing the following keys:
# MODE run mode (”start”, “run” or “time”)
# MSGID message handle
# ARGS user-supplied arguments:
#
# Returns: tps CONTINUE
#
# Notes : This proc keeps only the fields required by receving system
# This proc is a generic proc and can be used for multiple
# segments at the same time.
# Example : If the receving system requires only two fields of EVN segement
# and 18-fields for PID segments. Configure as below as ARGS.
#
# “^” Splits the Segment and Req’d fields
# “|” Splits multiple segments
#
# {KEEPLIST EVN^2}————— For One segment
# {KEEPLIST EVN^2|PID^18}——– For Multiple segment
#
#
#
# Author : Goutham Mullaguru (Healthcare.com)
# Date : 07/17/00
#
################################################################################
proc tps_truncate_segments { args } {
keylget args MODE mode
switch -exact — $mode {
start {
# Perform special init functions
return “”
}
run {
keylget args MSGID mh
keylget args ARGS.KEEPLIST keeplist
#
set msg [msgget $mh]
set segments [split $msg “r”]
set field_separator [csubstr $msg 3 1]
set seg_list [split $keeplist “|”]
set argcntr [llength $keeplist]
set out “”
#
set cntr 0
foreach seg $seg_list {
set sublist [split $seg “^”]
set subseg [lindex $sublist 0]
set keepfields [lindex $sublist 1]
set segment_location [lsearch -regexp $segments “^$subseg”]
if [cequal $segment_location “”] {continue}
set segment [lindex $segments $segment_location]
set reqd_fields [lrange [split $segment $field_separator] 0 $keepfields]
set new_segment [join $reqd_fields $field_separator]
set segments [lreplace $segments $segment_location $segment_location $new_segment]
if ![cequal $cntr $argcntr] {incr cntr}
}
set new_message [join $segments r]
msgset $mh $new_message
return “{CONTINUE $mh}”
}
shutdown {
# Doing some clean-up work
}
default {
return “”
error “Unknown mode ‘$mode’ in tps_truncate_segments”
}
}
}
thanks to Gotham for writing these procs for me way back when in 2000 before I really new much TCL.
Now that I’m in my global procs directory I see yet one more proc that might be worth posting related to this subject and it is called tps_remove_segment.tcl
######################################################################
# 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
}
Thanks for Gotham for writing these procs for me.
Attached are NetConfig screen shots to illustrate usage.
Russ Ross
RussRoss318@gmail.com