I should have know I would fat-finger it if I did not test 😳
Here is as it should be. Modified to handle multiple OBX segments after the OBR. It still assumes the OBR/OBX segments are last in the message
I did test it 🙂
run {
# Message handle
keylget args MSGID mh
# Get msg and split into a list of segs
set msg [msgget $mh]
set segList [split $msg r]
# We will always KILL the original message
set dispList
# Find first OBR and make a message header there
set obrLoc [lsearch -regexp $segList {^OBR}]
# All upto but not including first OBR
incr obrLoc -1
set baseHL7 [lrange $segList 0 $obrLoc]
# Now just loop through and grab OBR/OBX
foreach loc [lsearch -all -regexp $segList {^OBR}] {
# Get OBR segment
set OBR [lindex $segList $loc]
# Start building new message
set newMsg [lappend baseHL7 $OBR]
# Possible multiple OBX
# See how many OBX segments follow
set OBXloc $loc; incr OBXloc
# First segment following OBR
set OBX [lindex $segList $OBXloc]
# While we have OBX segments, append to new message
while {[regexp — {^OBX} $OBX]} {
# Add OBX
set newMsg [lappend newMsg $OBX]
# Get next and check for OBX
incr OBXloc
set OBX [lindex $segList $OBXloc]
}
# Do not forget CR at the end
set newMsg [lappend newMsg “”]
# New message
set nmh [msgcopy $mh]
msgset $nmh [join $newMsg r]
lappend dispList “CONTINUE $nmh”
}
# Send them on
return $dispList
}
.
