Help with tcl scripts using arguments

[Tom Arrowsmith]

Two or three times now I have tried writing scripts using arguments and not succeeded – only to find that if I abandoned the “argument” strategy and simply hard coded the value(s) in the code then the script was successful.

This has just happened to me again – so I am posting the script in the hopes that someone might be able to tell me what I’m doing wrong.

For the following I am submitting the aguments like this:

{VALUE_1 HEART}

{VALUE_2 BLAND}

Here’s the script (it runs successfully if not using args and hardcoding the values):

######################################################################

# Name:         kill_non_dietary_orders_sub_sep_arg.tcl

# UPoC type:    tps

# Args:         tps keyedlist containing the following keys:

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

#               MSGID   message handle

#               ARGS    user-supplied arguments:

# VALUE_1 value_1

# VALUE_2 value_2

# VALUE_3 value_3

# Description:  Kills message if the specified substring in the arguments is somewhere present in the OBR-4.2

# Returns: tps disposition list:

#          $CONTINUE

#          $KILL

proc kill_non_dietary_orders_sub_sep_arg { args } {

   keylget args MODE mode                                      ;# Fetch mode

   set dispList {}                                             ;# Nothing to return

   switch -exact — $mode {

       start {

           # Perform special init functions

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

       }

       

run {

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

             keylget args MSGID mh

   # Here we retrieve the data from our original message

   set msg [msgget $mh]

   # Get the argument value

   keylget args ARGS.VALUE_1 value_1

   keylget args ARGS.VALUE_2 value_2

   keylget args ARGS.VALUE_3 value_3

# Now we need to determine our field and subcomponent seperators

set field_sep [csubstr $msg 3 1] ;# HL7 field separator    

set sub_sep [csubstr $msg 4 1] ;# HL7 subfield separator

set rep_sep [csubstr $msg 5 1]       ;# HL7 field repetition separator

set subsub_sep [csubstr $msg 7 1]    ;# HL7 sub subfield separator

   

# Here we split the original message into a list of the segments contained within

set segmentList [split $msg r]

# Now we iterate over each segment in our list.

foreach segment $segmentList {

if {[cequal [crange $segment 0 2] OBR]} {

set fieldList [split $segment $field_sep]

set obr_4 [lindex $fieldList 4]

set obr_4_list [split $obr_4 $sub_sep]

set obr_4_2 [lindex $obr_4_list

} else {

}

   }

if {[string first $value_1 $obr_4] !=-1 || [string first $value_2 $obr_4] !=-1} {

lappend dispList “CONTINUE $mh”

return $dispList

    } else {

              lappend dispList “KILL $mh”

return $dispList

   }

}

        time {

           # Timer-based processing

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

        }

shutdown {

   # Shutdown mode

echo “kill_non_dietary_orders_sub_sep_arg is shutting down”

}

       default {

           error “Unknown mode ‘$mode’ in kill_non_dietary_orders_sub_sep_arg”

       }

   }

   return $dispList

}

Topic

[Jim Kosloskey]

Have you echoed the arguments (including the $args keyed list) to the log to see if you are picking the arguments up properly and to assure they are specified correctly?

If you need an example proc email me and I will send one to you.

Lately, I have ben writing my procs to pick up arguments from a Clovelreaf(R) Table instead of the NetConfig.

email: jim.kosloskey@jim-kosloskey.com 29+ years Cloverleaf, 59 years IT - old fart.

[Tom Rioux]

Tom,

Here is how we do it here:

keylget args ARGS uargs   ;# Get’s user arguments

keylget uargs VALUE_1 value_1

keylget uargs VALUE_2 value_2

keylget uargs VALUE_3 value_3

I’m not sure why your way isn’t working.  Seems like it should be.

Thanks….Tom

[Troy Morton]

What you have looks correct to me.  I agree that it would be good to add some echo statements to make sure your ARGS are getting into the proc correctly.

How are you entering your ARGS into the UPOC args field?  Remeber that you have to use {} around the key and the value.  If any of the values you provide have spaces or special chars, then you need another set of {}.

Example:

{VALUE_1 “SomeValue”} {VALUE_2 {Some value with space}} {VALUE_3 QuotesOptional}

HEre is more example code using user ARGS passed from the UPoC.

Code:

roc tps_EmailKillMsgByFldVal { args } {
 
 global HciSite HciConnName
 keylget args MODE mode

 # initialize the return disposition list
 set dispList {}

 # Get the hostname
 if [catch { set env(HOST) } hostname] {
         if [catch {exec /usr/bin/hostname} hostname] {
                 set hostname “UNKNOWN_HOST”
         }
 }
 
 # Validate the thread name
 if { ! [info exists HciConnName] } {
   set HciConnName “UNKNOWN_THREAD”
 }
 
 # Validate the site name
 if { ! [info exists HciSite] } {
   set HciSite “UNKNOWN_SITE”
 }    

 switch -exact — $mode {
 start {
     #echo “Start Mode”
     return “”
 }

 run {

   # initialize variables
   set module “tps_EmailKillMsgByFldVal”
     set now [clock format [clock seconds] -f “%m/%d/%Y %H:%M:%S”]
   
#    set debug “No”
   
   #getting arguments from parameter list
   keylget args           MSGID mh
   keylget args         CONTEXT ctx  
   keylget args      ARGS.SEGID segid
   keylget args    ARGS.FIELDID fieldid
   keylget args  ARGS.FIELDCOMP fieldcomp
   keylget args   ARGS.GOODLIST goodlist
   keylget args    ARGS.BADLIST badlist
   keylget args  ARGS.PASSTRXID passtrxid
   keylget args  ARGS.KILLTRXID killtrxid
   keylget args       ARGS.HOSP hosp
   keylget args     ARGS.TOFILE blnTrcWrite
   keylget args ARGS.ALLOWBLANK blnAllowBlankVal
   
   keylget args     ARGS.MAILTO mailto
   keylget args   ARGS.MAILFROM mailfrom
   keylget args   ARGS.MAILSUBJ mailsubj
   keylget args    ARGS.MAILMSG mailmsg
   keylget args ARGS.MAILSERVER mailserver
   keylget args ARGS.MAILDOMAIN maildomain
   keylget args  ARGS.MAILSTART mailstart
   keylget args   ARGS.MAILSTOP mailstop
   
#    keylget args ARGS.DEBUG debug
   
#    if { $debug } {
#       echo ”             MH: $mh”  
#       echo ”        CONTEXT: $ctx”
#       echo ”     ARGS.SEGID: $segid”
#       echo ”   ARGS.FIELDID: $fieldid”
#       echo ” ARGS.FIELDCOMP: $fieldcomp”
#       echo ”  ARGS.GOODLIST: $goodlist”
#       echo ”   ARGS.BADLIST: $badlist”
#       echo ”      ARGS.HOSP: $hosp”
#       echo ”    ARGS.TOFILE: $blnTrcWrite”
#       echo “ARGS.ALLOWBLANK: $blnAllowBlankVal”
#       echo ”    ARGS.MAILTO: $mailto”
#       echo ”  ARGS.MAILSUBJ: $mailsubj”
#       echo ”   ARGS.MAILMSG: $mailmsg”
#       echo “ARGS.MAILSERVER: $mailserver”
#       echo “ARGS.MAILDOMAIN: $maildomain”
#       echo ” ARGS.MAILSTART: $mailstart”
#       echo ”  ARGS.MAILSTOP: $mailstopn”
#    }

[Todd Lundstedt]

Tom,

I took your code and ran through it echoing it out line by line, and it works fine with input args… except… you are missing a close brace.  If all you did was change the exact code you posted here to hard code values into value_1 and value_2, I don’t see how it ever worked with that missing brace.

At anyrate…

if {[cequal [crange $segment 0 2] OBR]} {

set fieldList [split $segment $field_sep]

set obr_4 [lindex $fieldList 4]

set obr_4_list [split $obr_4 $sub_sep]

set obr_4_2 [lindex $obr_4_list

} else {

}

should be

if {[cequal [crange $segment 0 2] OBR]} {

set fieldList [split $segment $field_sep]

set obr_4 [lindex $fieldList 4]

set obr_4_list [split $obr_4 $sub_sep]

set obr_4_2 [lindex $obr_4_list]

} else {

}

The offending line…

set obr_4_2 [lindex $obr_4_list

s/b

set obr_4_2 [lindex $obr_4_list]

Good luck!

ps…. take a look at that code I posted on your other inquiry… I think it will do what you are looking for.  However yours does do what amounts to a “contains” function with that “string first” bizness.  I’ve filed that idea away for future use.  😆

[Chris Williams]

Another common error when calling a tcl proc in a UPOC using multiple args is not realizing that you must have a space between the pairs of braces. It’s difficult to see when examples are given using a variable width typeface:

Code:

Correct: {VALUE_1 xxx} {VALUE_2 yyy}
Incorrect: {VALUE_1 xxx}{VALUE_2 yyy}

[John Stafford]

I am trying to do something similar with a filter proc. Basically, I will pass field names along with wanted values, and it will kill any messages that do not have the desired values in the desired fields. I use a foreach loop to check all 3 arguments in parallel (SEGFLD1 + VLIST1 + SUBSTR1 | SEGFLD2 + VLIST2 + SUBSTR2 | etc).

For example, I would pass the following args:

{SEGFLD {PID-2 PID-2.5}} {VLIST {1074653 {SMH MRN}}} {SUBSTR {}}

It successfully checks for 1074653 in PID-2. My problem is that PID-2.5 contains MRN, so when I do an [lsearch -exact $value [string range $fvalue $subfirst $sublast], it finds MRN in {SMH MRN}, but I want it to match the entire string, “SMH MRN”. Is this a consequence of using the foreach? Is it an issue with the lsearch?

Code:

proc  filter_msgs_allow_test2 { args } {

 global HciConnName

 set mode [keylget args MODE]
 set DebugOn 1

 set context [keylget args CONTEXT]
 if { ![info exists HciConnName] } {
   set HciConnName “UNKNOWN_TD”
 }
 
 set segflds [keylget args ARGS.SEGFLD]      ;# User supplied list of fields
 set values [keylget args ARGS.VLIST]        ;# User supplied list of values
 set substrings [keylget args ARGS.SUBSTR]   ;# User supplied list of substrings

 set module “$HciConnName/ filter_msgs_ALLOW_test2”  ;# for error reports

 switch -exact — $mode {
   start {
     return “”   ;# Nothing specific
   }

   run {
     set dispList {}
     set mh [keylget args MSGID]  ;# Message header
     set msg [msgget $mh]       ;# The message
     set fldsep [csubstr $msg 3 1]     ;# Field separator (|)
     set subsep [csubstr $msg 4 1]     ;# Subfield sep (^)
 
     #
     # Split the message into segments
     #
     set segments [split $msg r]
 
     foreach segfld $segflds value $values substring $substrings {
       set seg [lindex [split $segfld -] 0]
       set fld [lindex [split $segfld -] 1]
       set fldnum [lindex [split $fld .] 0]       ;# and field…
       set subfldnum [lindex [split $fld .] 1]  ;# And subfield
       set subfirst [lindex [split $substring] 0] ;# First index in substring
       set sublast [lindex [split $substring] 1]  ;# Last index in substring
   
       if {$subfirst < " "} {
         set subfirst 0
         set sublast end
       }

       if {$subfldnum < " "} {
         set subfldnum 0
       } else {
         set subfldnum [expr $subfldnum – 1]
       }

       #
       # Get the desired segment location
       #
       set segnum [lsearch -regexp $segments ^$seg]

       if {$DebugOn} {
         echo "seg-field: $seg-$fldnum.[expr $subfldnum + 1]"
         echo "Wanted Values: " $value
         echo "subfirst: {$subfirst}  | sublast: {$sublast}"
       }

       if {$segnum = 0}   {
           if {$DebugOn} {echo “$module: Based on criteria to this point, CONTINUE message”
             echo “$seg-$fldnum.[expr $subfldnum + 1] value: $fvalue   —   GOOD: $value”
           }
         } else {
           if {$DebugOn} {echo “$module: Message KILL’d”
             echo “$seg-$fldnum.[expr $subfldnum + 1] value: $fvalue   —   GOOD: $value”
             return “{KILL $mh}”
 }
         }
       }
     }
   #
   # If no criteria were met to kill the message, send it
   #
   return “{CONTINUE $mh}”
   }

   shutdown {
     # Doing some clean-up work
   }

   default {
      return “”               ;# unknown mode
   }
 }
}

[Yves Guerin]

Dear,

What I did, is the following:

   passing args:

       

Code:

varname_1 value_1 varname_2 value_2

       or

       

Code:

{varname_1 value_1} {varname_2 value_2}

   reading args:

       declare default value:

         

Code:

set varname_1 default_value

   get the args

     

Code:

keylget args ARGS argslist

   affect value to varname

     

Code:

foreach {var val} $argslist {
         set $var $val
       # debug output
#puts “$var $val => [set $var]”
    }

    use the varname as usual:

Code:

set foobar [open $var r]

In fact so many ways to get it works  😉

Yves

[Charlie Bursell]

The problem I see with all of the posted examples is they all assume all of the arguments will always be there.  Remember, Murphy was an optimist.

Make sure you don’t fail for lack of a Tcl variable being set

set argList “”; keylget args ARGS argList

set val1 “”; keylget argList varname_1 val1

set val2 “”; ketlget argList varname_2 val2

Instead of empty string you could set to some default value or check for empty string and take some action if argumnet missing

FWIW, passing arguments as a keyed list is convention but required.  You could just pass a list of arguments and get them by position.  Keyed lists are less error prone however.

As others have suggested, if it is not working, echo out the values or you can even echo $args itself

[John Stafford]

Thanks for the suggestions. I’ll make sure to initialize the variables.

As it turns out, I was missing a second set of brackets to specify that SMH MRN was a single list item, rather than two items in the same list.

[Bob Richardson]

Greetings,

Another logic practice that I follow is to test for argument existence:

if {! [info exist variable]} { set variable {}}  ;#create with null value

Just to interject here.

Enjoy.

[Author]

Replies