TCL HELP PLEASE – REMOVE OBX SEGMENT

[Femina Jaffer]

Can anyone please help?

I have already written code to remove OBX segment if OBX 5 has the value “SUPRESSED”, and then resequence the OBXs.  The problem is that after it removes the segment it replaces it with a blank line, then adds the next segment after the blank line.  What did I do wrong in the code where it is placing a blank segment in place of the suppresed segment?

Here is the output after the segment was removed:

OBX|12|CE||||

OBX|13|CE||||

             BLANK LINE

OBX|14|CE|||||||

All 3 segments should be together.  The code is below.

             set New_Seg_List “”

             set obx_cnt 1

             foreach Segment $Seg_List {

             set Seg_ID [crange $Segment 0 2]

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

                   set Field_List [split $Segment $Fld_Sep]

                   set Result_Value [lindex $Field_List 5]

             if {$Result_Value ==”SUPRESSED” } {

                       set Segment “”

                       incr obx_cnt -1

             }

                 set Segment [replaceHL7Field $Segment OBX 1 $obx_cnt]

                 incr obx_cnt

             }

             set New_Seg_List [lappend New_Seg_List $Segment]

             set msg [join $New_Seg_List r]

             #  Replace message with new one created.

              msgset $mh $msg

  }

  }

# Assume change was made

#msgset $mh [join $segments r]

}

return “{CONTINUE $mh}”

       }

       time {

           # Timer-based processing

   # N.B.: there may or may not be a MSGID key in args

       }

shutdown {

   # Doing some clean-up work

}

       default {

   error “Unknown mode ‘$mode’ in OBX Suppress”

       }

   }

   return $dispList

}

Topic

[Charlie Bursell]

I think I have mentioned this many times but if you want to delete segments it is best to traverse the list in reverse order so you maintain order of the remaining segments

You are jumping through too many hoops.  No need to tear down and rebuild.

set locList [lsort -integer -decreasing [lsearch -all -regexp $segments {^OBX}]

foreach loc $locList {

     set flds [split [lindex $segments $loc] $fldSep]

     if {[string toupper [lindex $flds 5]] eq “SUPRESSED”} {

           lvarpop segments $loc

     }

}

msgset $mh [join $segments r]

return “{CONTINUE $mh}”

[Femina Jaffer]

Thanks Charlie, never thought about this or writing the code this way.  It definitely is cleaner.

I am now having the problem with the sequencing, and that is why I had written this the other way previously (above code).

The OUTPUT now after removing the OBX that contains the “SUPRESSED” in OBX 5, looks like this:

OBX|12|CE|UNITR^Nitrite^UNITR^L^|1|

OBX|13|CE|ULCE^LeukocyteEsterase^ULCE^L^|1|

OBX|15|CE|CNOT^Ur Culture RflxOrder^CNOT^L^|1|

Desired output hould look like this …

OBX|12|CE|UNITR^Nitrite^UNITR^L^|1|

OBX|13|CE|ULCE^LeukocyteEsterase^ULCE^L^|1|

OBX|14|CE|CNOT^Ur Culture RflxOrder^CNOT^L^|1|

As we removed OBX 14 (Supressed).

Here is the code I changed as per your suggestion:

            set Seg_List [split $msg r]

            set locList [lsort -integer -decreasing [lsearch -all -regexp $Seg_List {^OBX}]]

  foreach loc $locList {

        set flds [split [lindex $Seg_List $loc] $fldsep]

        if {[string toupper [lindex $flds 5]] eq “SUPRESSED”} {

                lvarpop Seg_List $loc

                }

             }

            msgset $mh [join $Seg_List r]

            return “{CONTINUE $mh}”

[Charlie Bursell]

You could do some fancy stuff within the loop I sent you but, unless you have a unique requirement for speed, for maimtainability, use two loops

set changed 0

foreach loc $locList {

     set flds [split [lindex $segments $loc] $fldSep]

     if {[string toupper [lindex $flds 5]] eq “SUPRESSED”} {

            incr changed

            lvarpop segments $loc

     }

}

# If changed, renumber  No need to do in reverse this time

if {$changed} {

   set num 1

   foreach loc [lsearch -all -regexp $segments {^OBX}] {

            set flds [split [lindex $segments $loc] $fldSep]

            set flds [lreplace $flds 1 1 $num]

            incr num

            set segments [lreplace $segments $loc $loc [join $flds $fldSep]]

   }

}

[David Barr]

You could write it like this:

Code:

package require hl7
set hl7 [hl7::parse_msg [msgget $mh]]
for { set i 1 } { $i <= [hl7::count hl7 OBX] } { incr i } {
 if { [hl7::get_field hl7 OBX($i).5] eq "SUPRESSED" } {
   delete_seg hl7 OBX($i)
   incr i -1
 } else {
   hl7::set_field hl7 OBX($i).1 $i
 }
}
msgset $mh [hl7::join_msg hl7]

See this thread for more information:

<a href="https://usspvlclovertch2.infor.com/viewtopic.php?t=4886&#8243; class=”bbcode_url”>https://usspvlclovertch2.infor.com/viewtopic.php?t=4886

[Femina Jaffer]

Thank you Charlie for always coming to the rescue.  That did the trick.

Thank you too David!  I like the code you provided and will try to utilize it in the future; however, I was having some issues understanding it.  I will review the link you have to better understand this.  Would I just apply the snippet/fragment to the hl7.tcl code section – do I need that entire code or just the piece you provided?

[Lee Anne Caruso]

Where is the package hl7 that is mentioned in this post to delete an OBX segment.

Thank you.

[David Barr]

https://usspvlclovertch2.infor.com/viewtopic.php?t=4886

[Author]

Replies