Tcl script to split ORU message after each OBR

This topic has 12 replies, 4 voices, and was last updated 4 years, 9 months ago by Timothy O’Donnell.

Creator

Topic
March 12, 2020 at 1:01 pm #115911
Timothy O’Donnell
Participant
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”
}
Creator

Topic

Viewing 4 reply threads

Author

Replies
- March 12, 2020 at 1:54 pm #115915
  Jim Kosloskey
  Participant
  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.
  - March 12, 2020 at 2:18 pm #115916
    Timothy O’Donnell
    Participant
    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.
- March 12, 2020 at 2:48 pm #115920
  David Barr
  Participant
  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"
  }
  - March 13, 2020 at 10:50 am #115936
    Timothy O’Donnell
    Participant
    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
  - March 13, 2020 at 12:19 pm #115941
    David Barr
    Participant
    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.
  - March 16, 2020 at 1:36 pm #115952
    Timothy O’Donnell
    Participant
    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
- March 12, 2020 at 3:31 pm #115924
  Jim Kosloskey
  Participant
  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.
  - March 13, 2020 at 8:37 am #115935
    Timothy O’Donnell
    Participant
    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.
- March 13, 2020 at 11:48 am #115939
  Jim Kosloskey
  Participant
  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.
  - March 16, 2020 at 1:35 pm #115951
    Timothy O’Donnell
    Participant
    Jim,
    
    I’m reaching out by email now. Thank you!
    
    -Timothy
  - March 18, 2020 at 1:29 pm #115996
    Timothy O’Donnell
    Participant
    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
- March 15, 2020 at 2:27 am #115947
  Charlie Bursell
  Participant
  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

Viewing 4 reply threads

You must be logged in to reply to this topic.