Limit outgoing NTE segments to be less than 60 characters

[Adam Qualls]

Does anyone have a script that would limit our NTE segments to 60 characters or less per NTE?  I can’t figure out how to code without cutting words and wrapping.  I would like for the script to not wrap in the middle of a word, but somehow know if the word at the end of the line is going to go over 60 characters and then take the whole word to the next line.

Topic

[Robert Kersemakers]

Hi Adam,

I don’t have a script for this specific case, but I can help you with some scripts. Basically what you need to do is:

* Iterate through all NTE segments and collect all text into one big text.

* Split this text into lines, where each line is no longer than 60 characters.

* Build new NTE segments based on the split lines.

For the second step I have made some scripts. These are old scripts (I can see lots of cconcat and clength commands, which I wouldn’t use anymore) but they should still do what you need.

I normally call this script from an Xlate:

Code:

set xlateOutVals [orbis_split_hl7_text [lindex $xlateInVals 0] 72]

The proc is:

Code:

proc orbis_split_hl7_text { itekst {ilengte 80}} {

# This procedure splits an HL7-text into a list of separate lines. The HL7-text is split on .br.
# If one of the separate lines is longer than $lengte then this line is reformatted into
# lines of max. $lengte length.
#
# returned is a list of separate lines and the number of elements in the list

 set ireturnlist {};
 set iregels {};
 set newlist {};
 set iblok “”;

 # Splits de tekst op Break
 regsub -all {\.br\} $itekst x0f iblok;
 set iregels [split $iblok x0f];

 # Nagaan of elke regel korter is dan het gestelde maximum
 set ifout “”;
 foreach iregel $iregels {
   if { [clength $iregel] > $ilengte } then {
     # regel te lang: opsplitsen en elke regel aan nieuwe lijst toevoegen
     foreach newregel [orbis_split_tekst $iregel $ilengte] {
       lappend newlist $newregel
     }
   } else {
     # anders regel gewoon aan nieuwe lijst toevoegen
     lappend newlist $iregel
   }
 }

 return [list $newlist [llength $newlist]];

}

And you will need this proc as well:

Code:

proc orbis_split_tekst { tekst {lengte 80}} {

 # This procedure checks whether (a part of) an additional LAB-text is longer than $lengte characters
 # If so, this text is split into separate parts; the list of parts is returned.

set returnlist {};

 if {[string length $tekst] > $lengte} {

   # String is te lang: opsplitsen in woorden.
   set woordlist [split $tekst ” “];

   # Tevens wordt er een lege ‘nieuwe tekst’ aangelegd
   set newtekst “”;

   # Alle woorden worden nu doorlopen
   foreach woord $woordlist {

     if { [clength $newtekst] == 0} {
       # Eerste woord: gewoon toevoegen (zonder spatie) aan ‘newtekst’
       set newtekst $woord;

     } else {
       # Indien er een x0e (andere representatie van .br) volgt: nieuwe regel
       if {[cequal $woord x0e]} then {
         set returnlist [lappend returnlist $newtekst];
         set newtekst “”;

       } else {
         # Nu wordt de ‘nieuwe’ lengte bepaald: lengte ‘woord’ + lengte ‘nieuwe tekst’ + 1 (spatie)
         set nl [expr [clength $woord] + [clength $newtekst] + 1];
         
         # Als ‘nieuwe’ lengte groter dan $lengte, dan wordt de ‘newtekst’ aan de ‘returnlist’ toegevoegd
         if {$nl > $lengte} {
           set returnlist [lappend returnlist $newtekst];
           set newtekst $woord;
         } else {
           # Anders wordt ‘woord’ aan ‘newtekst’ (met een spatie) toegevoegd
           set newtekst [string trim [cconcat $newtekst ” ” $woord]]
         };
       };
     };
   };
   # De laatste ‘newtekst’ wordt nog aan de ‘returnlist’ toegevoegd.
   lappend returnlist $newtekst;
 } else {
   # Hele tekst kan aan returnlist worden toegevoegd
   if {[string length $tekst] > 0} {
     lappend returnlist $tekst;
   }
 };

 return $returnlist;

}

Of course lots of comments in Dutch, just ignore these. Hope this helps.

There will be some extensions out there that will do the same and faster/better, but this worked for me.

Zuyderland Medisch Centrum; Heerlen/Sittard; The Netherlands

[Jeff Dinsmore]

Here’s the code I use to break lines at word boundaries.

Code:

namespace eval crmcHL7utils {
   
}

proc crmcHL7utils::breakLineInitOutArray { outArrayName } {
 
 upvar $outArrayName outArray
 
 catch {unset outArray}
 set outArray(numElements) 0
 
}

proc crmcHL7utils::breakLineSetOutArrayElement { outArrayName str } {
 
 upvar $outArrayName outArray
 
 set outArray($outArray(numElements)) $str
 incr outArray(numElements)
 
}

proc crmcHL7utils::breakLineAtWord { inStr maxChars trimLeftWhitespace outArrayName } {

 upvar $outArrayName outArray
 
 crmcHL7utils::breakLineInitOutArray outArray
 
 set maxI [expr $maxChars – 1]

 # break lines longer than maxChars
 if { [string length $inStr] } {

   # break lines longer than $maxChars
   while { [string length $inStr] > $maxChars } {

     # get word start character nearest to max line length
     if { [set wi [string wordstart $inStr $maxI]] force break at $maxI so we don’t loop forever….
       set wi $maxI
     } else {
       
       incr wi -1
       
       # added this code 10/17/2014 – jld
       #   … to accomodate number strings that contain non alpha/numeric data
       #   something like 1:200,000 – can break at the comma or colon, so we
       #   back up $wi until we find a space to keep this ratio as a single string
       #
       #   It may also find non-alphanumeric separated strings – such as “bob/fred/john”
       #   or “my pockets contain coins,phone,cash” – that may be OK broken at slash or
       #   comma, but it should be better than separating strings that should remain
       #   intact
       #
       while { [string index $inStr $wi] ne ” ” && $wi >= 0 } {
         incr wi -1
       }
       
       if { $wi force break at $maxI so we don’t loop forever….
         set wi $maxI
       }

     }

     crmcHL7utils::breakLineSetOutArrayElement outArray [string trimright [string range $inStr 0 $wi]]
     
     if { $trimLeftWhitespace } {
       set inStr [string trimleft [string range $inStr [incr wi] end]]
     } else {
       set inStr [string range $inStr [incr wi] end]
     }

   }

   if { [string length $inStr] } {
     # Write the remainder of the line if any
     crmcHL7utils::breakLineSetOutArrayElement outArray $inStr
   }

 } else {
   # Special case – zero length line (would be skipeed by for loop above)
   crmcHL7utils::breakLineSetOutArrayElement outArray $inStr
 }
 
 return 1
}

Usage is something like this:

Code:

crmcHL7utils::breakLineAtWord $obx5 80 1 outArray

for { set i 0 } { $i > depending on outbound message requirements, you may need to insert new segments to hold the broken lines
}

Jeff Dinsmore
Chesapeake Regional Healthcare

[Author]

Replies