Limit outgoing NTE segments to be less than 60 characters

Clovertech Forums Read Only Archives Cloverleaf Cloverleaf Limit outgoing NTE segments to be less than 60 characters

  • Creator
    Topic
  • #55160
    Adam Qualls
    Participant

      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.

    Viewing 1 reply thread
    • Author
      Replies
      • #84378
        Robert Kersemakers
        Participant

          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

        • #84379
          Jeff Dinsmore
          Participant

            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

        Viewing 1 reply thread
        • The forum ‘Cloverleaf’ is closed to new topics and replies.