Reply To: Need TcL Proc to kill message based upon TrxId

Homepage Clovertech Forums Read Only Archives Cloverleaf Cloverleaf Need TcL Proc to kill message based upon TrxId Reply To: Need TcL Proc to kill message based upon TrxId

#56387
Brian Goad
Participant

Here is what we use at UT Medical Center.

The script uses a table to review the event and make a determination. This way if you ever need to add another event just add it to the table and be done with it, no code changes required.

Brian

## Purpose:     kill all messages other than those specfied in the arg list

##

## UPoC type:   tps

## Args:        tps keyedlist containing the following keys:

##              MODE    run mode (“start”, “run” or “test”)

##              MSGID   message handle

##              ARGS    user-supplied arguments:

##              DEBUG: determines weather we recieve all of the echo commands.

##                      Use this syntax for new echo statemtents: if {[debug == 1]} {

                                                                      #echo “DEBUG($myprocName) -MESSAGE “}

##      

##

##

##

##

## Returns: tps disposition list:

##      

##        

##Written By: Brian Goad          

##Date: 4 August 2003

##

proc event_type_filter { args } {

   keylget args MODE mode                      ;# Fetch mode

   #global HciConnName

   global env HciConnName

   

   switch -exact — $mode {

       start {

           # Perform special init functions

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

           #

           

           #echo info procs

       }

       run {

          # ‘run’ mode always has a MSGID; fetch and process it

           keylget args MSGID mh

         keylget args ARGS.DEBUG debug

        #process variables

        #get the proc name from the info array!!!

        set myprocName [lindex [info level 0] 0]

       

        #The following command returns the process name!!!!!

        #set myprocessName [file tail [pwd]]

       

       

       

       #set myprocName event_type.tcl

 

         # get contents of message

         set msgtext [msgget $mh]

         # get field delimiter

         set field_delim [cindex $msgtext 3]

         set field_sub_delim [cindex $msgtext 4]

         #get MSH segment and pull out MSH:8.1 (A01, A02, A03, ….)

         set segments [split $msgtext “r”]

          set msh [lindex $segments 0]

         set msh_fields [split $msh $field_delim]

         set msh_8 [lindex $msh_fields 8]

         set qid [lindex $msh_fields 9]

         set msh_field_8 [split $msh_8 $field_sub_delim];

         set msh_8_1 [lindex $msh_field_8 1]

         if {$debug == 1} {

               echo “DEBUG DATA****************************************************”

               echo “DEBUG($myprocName) – Complete Field: $msh_field_8”

               echo “DEBUG($myprocName) – SubField: $msh_8_1”

       }      

        #echo “msh_field_8 $msh_field_8”

               #echo “msh_8_1: $msh_8_1”

         set table_name “events_$HciConnName”

       # compare MSH(8.1) with each arg list element to determine if we need to forward

       #echo “table_name: $table_name”

           set filter_result [tbllookup $table_name $msh_8_1]

       #echo “filter_result: $filter_result”

              if {[cequal $filter_result “KILL”] || [cequal $filter_result “”] } {

               if {$debug == 1} {

                       echo “DEBUG($myprocName) – Message: $msh”; # Debugging Info

                       echo “DEBUG($myprocName) – Lookup Table Name: $table_name”; # Debugging Info

                       echo “DEBUG($myprocName) – Table Result: $filter_result”; # Debugging Info

                       echo “DEBUG DATA****************************************************”

               }

               echo “$myprocName: $msh_8_1 with QID: $qid has been filtered for $HciConnName”

               return “{KILL $mh}”            

           } else {

               #echo “Continue”

               #echo “MSH_8 Doesn’t meet Kill Criteria: Sending $msh”

               if {$debug == 1} {

                       echo “DEBUG($myprocName) – $msh_8_1 with QID: $qid was not filtered for $HciConnName”

                       echo “DEBUG($myprocName) – Message: $msh”

                       echo “DEBUG($myprocName) – Lookup Table Name: $table_name”; # Debugging Info

                       echo “DEBUG($myprocName) – Table Result: $filter_result”; # Debugging Info

                       echo “DEBUG DATA****************************************************”

               }

               

               return  “{CONTINUE $mh}”

          }

       }

       shutdown {

           # Doing some clean-up work

           set datetime [clock format [clock seconds] -format “%d/%m/%Y %H:%M:%S”]

           echo “Shutdown event_type_filter.tcl at $datetime”

       }

       time {

           # Timer-based processing

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

       }

       default {

           error “Unknown mode ‘$mode’ in event_type_filter.tcl”

       }

   }

}

Forum Statistics

Registered Users
5,115
Forums
28
Topics
9,291
Replies
34,426
Topic Tags
286
Empty Topic Tags
10