Created
June 14, 2012 22:49
-
-
Save jamerfort/2933489 to your computer and use it in GitHub Desktop.
This Cloverleaf TPS script removes all OBX segments prior to the first one that contains "ADDENDUM". This script also renumbers the OBX segments. See http://clovertech.healthvision.com/viewtopic.php?t=5953
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
# This Cloverleaf TPS script removes all OBX segments prior to the first one that contains "ADDENDUM". | |
# This script also renumbers the OBX segments. | |
# | |
# See http://clovertech.healthvision.com/viewtopic.php?t=5953 | |
proc remove_prior_to_addendum {args} { | |
# set the procedure name | |
# This is used for error messages | |
set procname [lindex [info level [info level]] 0] | |
# bring some common variables into the scope of this proc | |
global HciSite HciSiteDir HciProcessesDir HciConnName HciRootDir ibdir | |
# fetch mode | |
keylget args MODE mode | |
# keylget args ARGS.ARGNAME argname | |
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 msgid | |
# get the message | |
set msgdata [msgget $msgid] | |
# does this message have "ADDENDUM"? | |
if {! [regexp {OBX[^\r]*\|ADDENDUM} $msgdata] } { | |
# This message does not have an ADDENDUM, so continue the message | |
return "{CONTINUE $msgid}" | |
} | |
# if we get here, we have an ADDENDUM | |
# get the separators | |
set segment_sep \r | |
# process the message | |
if { [catch { | |
# commands | |
# split the message into segments | |
set segments [split $msgdata $segment_sep] | |
# find the first OBX with an ADDENDUM | |
set addendum_index [lsearch -regexp $segments {^OBX[^\r]*\|ADDENDUM}] | |
# renumber the OBX segments that will remain | |
set i 1 | |
foreach index [lsearch -all -regexp -start $addendum_index $segments {^OBX}] { | |
set segment [lindex $segments $index] | |
set segments [lreplace $segments $index $index [regsub {^OBX\|[0-9]*\|} $segment "OBX|$i|"]] | |
incr i | |
} | |
# now find any OBX segments prior to the ADDENDUM segment | |
set obx_indexes [lsearch -all -regexp [lrange $segments 0 [expr $addendum_index - 1]] {^OBX}] | |
# sort the indexes descending so that we can safely remove the indexes | |
set obx_indexes [lsort -decreasing -integer $obx_indexes] | |
# remove each segment | |
foreach index $obx_indexes { | |
set segments [lreplace $segments $index $index] | |
} | |
# rebuild the message | |
set msgdata [join $segments $segment_sep] | |
} errmsg ] } { | |
# the commands errored | |
global errorInfo | |
msgmetaset $msgid USERDATA "ERROR: $errmsg\n*** Tcl TRACE ***\n$errorInfo" | |
# rethrow the error | |
error $errmsg $errorInfo | |
} | |
# set the output message | |
msgset $msgid $msgdata | |
# return whether to kill, continue, etc. the message | |
return "{CONTINUE $msgid}" | |
} | |
time { | |
# Timer-based processing | |
# N.B.: there may or may not be a MSGID key in args | |
} | |
shutdown { | |
# Do some clean-up work | |
} | |
default { | |
error "Unknown mode in $procname: $mode" | |
return "" ;# Dont know what to do | |
} | |
} | |
} |
Sign up for free
to join this conversation on GitHub.
Already have an account?
Sign in to comment