renumbering OBX segments

[Laurie Chaplen]

I have to remove OBX segments if a condition is met and then renumber them. I am using the following TCL proc which removes the OBX segment correctly but I can’t figure out how to renumber the segments.

Sample output

the OBX should be renumbered to 1, 2 3 and 4 instead of how they look number now as 2, 3 4 and 5.

ORC|RE|838420|17300002:3|17300002|||^^^201305300759||201305300755||||||

OBR|1|838420||LAB282^Red Blood Cells^SHSPROC|||201305300755|||||||201305300755||ADKISSTA^ADKISSON^STANLEY^^^^^^EPIC^^^^PROVID|||||||||P|^^^|3^^^^^R

OBX|2|ST|123154260^UNIT ABO^SHSCOMP|201|O||||||P|||201305300905||JBOWE|201305300905

OBX|3|ST|123154270^UNIT RH^SHSCOMP|202|POS||||||P|||201305300905||JBOWE|201305300905

OBX|4|ST|123154230^UNIT NUMBER^SHSCOMP|203|21N44648||||||P|||201305300905||JBOWE|201305300905

OBX|5|ST|123154290^UNIT STATUS^SHSCOMP|204|Issued||||||P|||201305300905||JBOWE|201305300905

DSP|1||AS-1 RBCS                      21N44648           issued

DSP|2||UNIT ABO                       O

DSP|3||UNIT RH                        POS

DSP|4||UNIT NUMBER                    21N44648

DSP|5||UNIT STATUS                    Issued

this is my tcl proc:

#Get the message from the metadata

          set msg [msgget $mh]

          set fldSep [cindex $msg 3]; #  Field Separator “|”

          set segList [split $msg r]

#Create the looping

          set count 0

          foreach segment $segList {

             set segID [crange $segment 0 2]

               if { ($segID == “MSH”) } {

                  set fieldList [split $segment $fldSep]

                  set MSH3 [lindex $fieldList 3]

               }

          set obxCnt 0

               if { ($segID == “OBX”)} {

                        incr obxCnt

                  set fieldList [split $segment $fldSep]

                  set OBX2 [lindex $fieldList 2]

       

                  if {[cequal $OBX2 TX] && [cequal $MSH3 SCC] } {

                       #if OBX2 is equal to TX and MSH 3 = SCC then delete the OBX segment.

                           lvarpop segList $count

                           set count [incr count -1]

                           lappend newmsg [join $fieldList $fieldList]

                    } else {

                          lappend newmsg $segment

                    }

                }

                incr count

             }

        set msg [join $segList r]

#Return the metadata

              msgset $mh $msg

Topic

[David Barr]

There are a few problems with this code.

[Laurie Chaplen]

Hi I’m still on the early learning curve of tcl… could you spell it out for me?  Also there could be multiple sets of OBX segments and each one would have to be numbered separately

[Jim Kosloskey]

Just a point of information – this can also be done quite easily without Tcl in an Xlate.

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

[David Barr]

I’d write it more like this:

Code:

package require hl7
set hl7 [hl7::parse_msg [msgget $mh]]
if { [hl7::get_field hl7 MSH.4] ne “SCC” } {
 return “{CONTINUE $mh}”
}
for { set i 1 } { $i <= [hl7::count OBX] } { incr i } {
 if { [hl7::get_field hl7 OBX($i).2] eq "TX" } {
   hl7::delete_seg hl7 OBX($i)
   incr i -1
 } else {
   hl7::set_field hl7 OBX($i).1 $i
 }
}
msgset $mh [hl7::join_msg $hl7]
return "{CONTINUE $mh}"

This needs to be adjusted if you can have multiple sets of OBXs.

[Laurie Chaplen]

Hi thank you very much for you tcl guidance

I placed this in a new tcl proc and it crashed as it didn

[Author]

Replies