Tcl script to split ORU message after each OBR

[Timothy O’Donnell]

Good afternoon. I have a vendor who can only accept an ORU if it has one OBR with corresponding OBXs. Our Nursing Assessment ORUs have multiple OBRs with corresponding OBXs, not always the same amount of OBXs to OBRs.

Right now I’m able to pull the “base HL7” out and I can pull each individual OBR but I’m having trouble getting the corresponding OBXs and then putting everything together into their own messages. Right now my tcl is a mess so any help would be appreciated.

run {
# ‘run’ mode always has a MSGID; fetch and process it

keylget args MSGID mh

set msg [msgget $mh]
set segList [split $msg “\r”]

set dispList

set obrLoc [lsearch -regexp $segList {^OBR}]
incr obrLoc -1

set baseHL7 [lrange $segList 0 $obrLoc]
#echo “$baseHL7”

foreach loc [lsearch -all -regexp $segList {^OBR}] {
set OBR [lindex $segList $loc]
echo “$loc”
set newMsg [lappend baseHL7 $OBR]
echo “$OBR”
}

foreach loc [lsearch -all -regexp $segList {^OBX}] {
set OBX [lindex $segList $loc]
echo “$loc”
echo “$OBX”
}

set OBXloc $loc
incr OBXloc
# echo “$OBXloc”

set OBX [lindex $segList $OBXloc]
#echo “$OBX”

while {[regexp {^OBX} $OBX]} {
set newMsg [lappend newMsg $OBX]
incr OBXloc
set OBX [lindex $segList $OBXloc]
#echo “$OBX”
#echo “$newMsg”
}

#msgset $mh [join $newMsg “\r”]
#lappend dispList “CONTINUE $mh”
}

Topic

[Jim Kosloskey]

Is there a reason you are not using an Xate? This can be accomplished easily using Xlate.

email: jim.kosloskey@jim-kosloskey.com 29+ years Cloverleaf, 59 years IT - old fart.

[Timothy O’Donnell]

I don’t specifically need to do it via tcl but wanted it to have this tcl and another for iterating OBX.5 as pre-proc tcls.

Is it not feasible in tcl or just easier as an xlate? At this point, I’d be fine with either.

[David Barr]

This might work. I haven’t tested it.

run {
# ‘run’ mode always has a MSGID; fetch and process it

keylget args MSGID mh

set msg [msgget $mh]
# split the segments into a list. trailing \r adds an empty element
# which we remove here.
set segList [lsearch -inline -all -exact -not [split $msg “\r”] ""]
set outSegs {}

set dispList {}

# put all segments up to the first OBR in outSegs
for { set segNum 0 } { $segNum < [llength $segList] } { incr segNum } {
set seg [lindex $segList $segNum]
if { [regexp {^OBR} $seg] } {
break
}
lappend outSegs $seg
}
set outSegs2 $outSegs
# process each OBR group and add them to a copy of outSegs
for { incr segNum} { $segNum < [llength $segList] } { incr segNum } {
lappend outSegs2 $seg
set seg [lindex $segList $segNum]
if { [regexp {^OBR} $seg] } {
# start a new message
msgset $mh "[join $outSegs2 \r]\r"
lappend dispList "CONTINUE $mh"
set mh [msgcopy $mh]
set outSegs2 $outSegs
}
}
# add the last message to dispList
lappend outSegs2 $seg
msgset $mh "[join $outSegs2 \r]\r"
lappend dispList "CONTINUE $mh"
}

[Timothy O’Donnell]

David,

The script almost worked! – it split up the message into one new one for each OBR but it copied the same OBXs from the first OBR/OBX iteration to all the rest. So I’m trying to figure out the code for the OBXs that correspond to the OBRs which I assume is similar to this code but using OBX?

if { [regexp {^OBR} $seg] } {
# start a new message
msgset $mh “[join $outSegs2 \r]\r”
lappend dispList “CONTINUE $mh”
set mh [msgcopy $mh]
set outSegs2 $outSegs

}

-Timothy

[David Barr]

I tested my code, and I didn’t have the OBX problem that you mention. Do you have a sample message I could try that demonstrates the problem?

My code doesn’t look for OBXs. I look for OBRs and use those to determine when I need to start a new message and I keep all segments from one OBR to the next one in the same message as the first OBR.

[Timothy O’Donnell]

David,

It worked actually, I was using a bad example message where each OBR has the exact same OBXs so it looked like it was copying wrong – I used a few different messages and it worked as expected!

-Timothy

[Jim Kosloskey]

To me it is much easier to do in an Xlate (along with all the other work needed).

There is no reason it cannot be done in Tcl – I just can’t help you with that.

email: jim.kosloskey@jim-kosloskey.com 29+ years Cloverleaf, 59 years IT - old fart.

[Timothy O’Donnell]

I’m OK using an xlate – I’m trying it myself now but not having any luck. I’ve got my personal counter, I’ve got my CONTINUE outside the iterations of OBR and OBX, but I can’t get separate messages. Any help would be appreciated.

[Jim Kosloskey]

I can assist if you like. email me and we will work on this off-line.

email: jim.kosloskey@jim-kosloskey.com 29+ years Cloverleaf, 59 years IT - old fart.

[Timothy O’Donnell]

Jim,

I’m reaching out by email now. Thank you!

-Timothy

[Timothy O’Donnell]

Thanks to Jim for helping with the solution. Thought I would post it here for anyone searching for this in the future. Below is dependent on your HL7 variant so adjust as needed:

SUPPRESS (kill original message)

PATHCOPY other segments as needed

ITERATE on group %g1

PATHCOPY 1(0).1(%g1).OBR(0) -> 1(0).1(0).OBR(0)

ITERATE on segment %s1

PATHCOPY 1(0).1(%g1).OBX(%s1) -> 1(0).1(0).OBX(%s1)

CONTINUE

ITERATE on segment %s2

PATHCOPY @null -> 1(0)1(0).OBX(%s2)

This will give you one OBR per message and the corresponding OBXs.

Hope this helps and Jim, thank you again!

-Timothy

[Charlie Bursell]

Are there only OBX segments after the OBR segments.?   If so it is simple to remove the OBR segments – all but the first

set segList [split $msg \r]

# Get OBR locations in reverse order

set locList [lsort -integer -decreasing [lsearch -all -regexp $segList {^OBR}]]

# Remove last loc in list, which is first in segList

lvarpop locList end

# Now simply remove OBR segments.  Note reverse order so as not to skew locations in the list

foreach loc $locList {set segList [lreplace $segList $loc $loc]}

msgset $msh [join $segList \r}

# Note you must leave the last empty segment in the list so after the join the last segment (as required) is terminated with a CR

You could add additional code after the above to renumber OBX segments (OBX.1) if desired

I hope I did not fat-finger anything 🙂

[Author]

Replies