Reply To: How do I add a trailing bars to a Segment

Clovertech Forums Read Only Archives Cloverleaf Cloverleaf How do I add a trailing bars to a Segment Reply To: How do I add a trailing bars to a Segment

#59361
Russ Ross
Participant

    Yes Jim it has been a long time since we had to pad segments here at MD Anderson Cancer Center and perhaps was done even before you came on-board.

    There is a global TPS proc  ( tps_pad_segemnts ) in both our test and production environment that is used in one of our old integrations.

    Here is the code for tps_pad_segemnts.tcl

    Code:

    ################################################################################
    # Name: tps_pad_segments
    # Purpose:
    # UPoC type: tps
    # Args: tps keyedlist containing the following keys:
    #       MODE    run mode (”start”, “run” or “time”)
    #       MSGID   message handle
    #       ARGS    user-supplied arguments:
    #
    #               Returns: tps CONTINUE
    #
    # Notes :      
    #              
    #            
    #———
    # History:  
    #———
    #
    # 2000.07.17 Goutham Mullaguru
    #          – wrote initial version
    #
    # 2000.07.20 Russ Ross
    #          – fixed bug that errors out and causes the message to be lost
    #            when $add_fields = 0
    #
    ################################################################################
    proc tps_pad_segments { args } {
      keylget args MODE mode
      switch -exact — $mode {

         start {
                  #  Perform special init functions
                  return “”
         }

         run   {
                  keylget args MSGID mh
                  keylget args ARGS.KEEPLIST keeplist
    #
                  set msg [msgget $mh]
                  set segments [split $msg “r”]
                  set field_separator [csubstr $msg 3 1]
             
                  set seg_list [split $keeplist “|”]
                  set argcntr [llength $keeplist]

    #
                  set cntr 0

                  foreach seg $seg_list {
                    set sublist [split $seg “^”]
                    set subseg [lindex $sublist 0]
                    set keepfields [lindex $sublist 1]

                    set segment_location [lsearch -regexp $segments “^$subseg”]
                    set segment [lindex $segments $segment_location]
                        if [cequal $segment “”] {continue}
                    set no_of_fields [regsub -all — {|} $segment “” segout]
                    set add_fields [expr $keepfields – $no_of_fields]  
                       if {$add_fields <= 0} {continue}                    if {$add_fields > 0 } {
                    set new_fields [replicate | $add_fields]
                    set new_segment “$segment$new_fields”
                    }
                    set segments [lreplace $segments $segment_location $segment_location $new_segment]

                        if ![cequal $cntr $argcntr] {incr cntr}
                  }
                  set new_message [join $segments r]
                  msgset $mh $new_message
                  return “{CONTINUE $mh}”

         }

    shutdown {
       # Doing some clean-up work
    }

         default {
                  return “”
                  error “Unknown mode ‘$mode’ in tps_pad_segments”
         }

      }

    }

    I might as well post this procs counter part called tps_truncate_segments.tcl

    Code:

    ################################################################################
    # Name: tps_truncate_segments
    # Purpose:
    # UPoC type: tps
    # Args: tps keyedlist containing the following keys:
    #       MODE    run mode (”start”, “run” or “time”)
    #       MSGID   message handle
    #       ARGS    user-supplied arguments:
    #
    #               Returns: tps CONTINUE
    #
    # Notes :       This proc keeps only the fields required by receving system
    #               This proc is a generic proc and can be used for multiple  
    #               segments at the same time.
    # Example :     If the receving system requires only two fields of EVN segement
    #               and 18-fields for PID segments. Configure as below as ARGS.
    #              
    #               “^” Splits the Segment and Req’d fields
    #               “|” Splits multiple segments
    #
    #               {KEEPLIST EVN^2}————— For One segment
    #               {KEEPLIST EVN^2|PID^18}——– For Multiple segment
    #                
    #          
    #
    # Author : Goutham Mullaguru (Healthcare.com)
    # Date   : 07/17/00
    #
    ################################################################################
    proc tps_truncate_segments { args } {
      keylget args MODE mode
      switch -exact — $mode {

         start {
                  #  Perform special init functions
                  return “”
         }

         run   {
                  keylget args MSGID mh
                  keylget args ARGS.KEEPLIST keeplist
    #
                  set msg [msgget $mh]
                  set segments [split $msg “r”]
                  set field_separator [csubstr $msg 3 1]
             
                  set seg_list [split $keeplist “|”]
                  set argcntr [llength $keeplist]

                  set out “”
    #
                  set cntr 0

                  foreach seg $seg_list {
                    set sublist [split $seg “^”]

                    set subseg [lindex $sublist 0]
                    set keepfields [lindex $sublist 1]

                    set segment_location [lsearch -regexp $segments “^$subseg”]
                        if [cequal $segment_location “”] {continue}

                    set segment [lindex $segments $segment_location]
                    set reqd_fields [lrange [split $segment $field_separator] 0 $keepfields]

                    set new_segment [join $reqd_fields $field_separator]
                    set segments [lreplace $segments $segment_location $segment_location $new_segment]

                        if ![cequal $cntr $argcntr] {incr cntr}
                  }
                  set new_message [join $segments r]
                  msgset $mh $new_message
                  return “{CONTINUE $mh}”

         }

    shutdown {
       # Doing some clean-up work
    }

         default {
                  return “”
                  error “Unknown mode ‘$mode’ in tps_truncate_segments”
         }

      }

    }

    thanks to Gotham for writing these procs for me way back when in 2000 before I really new much TCL.

    Now that I’m in my global procs directory I see yet one more proc that might be worth posting related to this subject and it is called tps_remove_segment.tcl

    Code:

    ######################################################################
    # Name:     tps_remove_segment
    #
    # Author:   Chris Hale
    #
    # Date:    
    # 1999.03.10 Chris Hale
    #          – wrote intitial version          
    #
    # 1999.05.24 Russ Ross
    #          – fixed to not have memory leaks when creating new message
    #
    # Purpose:  Removes a segment(s) within a message.
    # UPoC type:   tps
    # Args:  tps keyedlist containing the following keys:
    #        MODE    run mode (”start”, “run” or “time”)
    #        MSGID   message handle
    #        ARGS    user-supplied arguments:
    #                 SEGMENTS – Segments that you wish to have removed.
    #           The segments should be passed with no
    #           spaces.  This allows you to delete as many
    #           segments as you like.
    #           EXAMPLE:
    #              {SEGMENTS PV1NK1OBX}
    #
    # Returns: tps disposition list:
    #    CONTINUE – original message will be overwritten
    #               with new messages that has the specified
    #               segments removed

    proc tps_remove_segment { args } {
      keylget args MODE mode                 ;# Fetch mode
      keylget args ARGS.SEGMENTS segments

      set dispList {}            ;# Nothing to return

      switch -exact — $mode {
     
         start {
            return “”
         }

         run {
            # ‘run’ mode always has a MSGID; fetch and process it
            keylget args MSGID mh

            # Initialize variables
            set segname_list {}
            set index1 0
            set index2 2
            set count 1
            set new_msg {}

            # Determine number of segments that you want to have eliminated
            # and put them in list format
            set arg_length [clength $segments]
            set num_segments [expr $arg_length/3]
            while {$count <= $num_segments} {            lappend segname_list [crange $segments $index1 $index2]            incr count            incr index1 3            incr index2 3         }         # echo REMOVING SEGMENTS ($segname_list)         # Retrieve the message and create a new message that         # contains only the segments that are wanted.         set msg [msgget $mh]         set seg_list [split $msg r]         foreach item $seg_list {            if {[cequal $item {}]} continue            set seg_id [crange $item 0 2]            set found_list [intersect $segname_list $seg_id]            if {[cequal $found_list {}]} {               append new_msg $item r            }         }                 msgset $mh $new_msg         lappend dispList "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 tps_remove_segment"      }   }    return $dispList }

    Thanks for Gotham for writing these procs for me.

    Attached are NetConfig screen shots to illustrate usage.

    Russ Ross
    RussRoss318@gmail.com