Ok, I may having a “blonde” day. I am posting my entire proc. Tcl is now complaining of the an extra switch without a body, but I do not see this…
I am posting my code in hopes someone pitty me’s 😯
proc tps_escape_char { args } {
keylget args MODE mode
keylget args ARGS uargs ;# Get user arguments and set default if not found
set segtable CIS_TABLE ;keylget uargs SEGMENTBL segtable
set expr_match {&} ;keylget uargs EXPR_MATCH expr_match
set expr_set {\T\} ;keylget uargs EXPR_SET expr_set
set dispList {} ;# Nothning to return
switch -exact — $mode { ;# Fetch mode
start {
return {} ;# Nothing specific
}
run {
keylget args MSGID mh ;# Get message handle
set msg [msgget $mh] ;# Get message
# Create a copy of the message omitting the encoding characters and check
# Do any $expr_match exist in the remaining message – if yes, reformat else continue msg
set chkmsg [crange $msg 9 end]
if {[regexp “$expr_match” $chkmsg] == 1} {
# Get field separator from MSH segment
set fieldSeparator [crange $msg 3 3]
# Split message into segments
set segmentList [split $msg r]
set newSegmentList “”
# Search table for each Segment
# When match on Segment ID, field numbers to check are returned
foreach segment $segmentList {
set tblfieldlist 0
set segmentID [crange $segment 0 2]
set tblfieldlist [tbllookup $segtable $segmentID]
if {$tblfieldlist != 0} {
set fieldIDlist [split $tblfieldlist “-“]
set fieldList [split $segment $fieldSeparator]
foreach fieldID $fieldIDlist {
set oldfield “”
set oldfield [lindex $fieldList $fieldID]
if {$oldfield != “”} {
regsub -all — “$expr_match” $oldfield “$expr_set” newfield
set fieldList [lreplace $fieldList $fieldID $fieldID $newfield]
}
}
set segment [join $fieldList $fieldSeparator]
}
set newSegmentList [lappend newSegmentList $segment]
}
set newMsg [join $newSegmentList r]
set mhNew [msgcopy $mh]
msgset $mhNew $newMsg
lappend dispList “KILL $mh”
lappend dispList “CONTINUE $mhNew”
} else {
lappend dispList “CONTINUE $mh”
}
}
shutdown {
# Doing some clean-up work
}
default {
error “Unknown mode ‘$mode’ in tps_escape_char”
}
}
return $dispList
}
The error code is this:
[0:TEST] Tcl error:
msgId = message0
proc = ‘tps_escape_char’
args = ”
result = ‘extra switch pattern with no body’
errorInfo: ‘
extra switch pattern with no body
while executing
“switch -exact — $mode { ;# Fetch mode
start {
return {} ;# Nothing specific
}
run {
keyl…”
(procedure “tps_escape_char” line 11)
invoked from within
“tps_escape_char {MSGID message0} {CONTEXT sms_ib_data} {ARGS {}} {MODE run} {VERSION 3.0}”‘
[/code]
.
