Help with tcl scripts using arguments

Homepage Clovertech Forums Read Only Archives Cloverleaf Cloverleaf Help with tcl scripts using arguments

  • Creator
    Topic
  • #51312
    Tom Arrowsmith
    Participant

    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

    }

Viewing 9 reply threads
  • Author
    Replies
    • #69645
      Jim Kosloskey
      Participant

      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

    • #69646
      Tom Rioux
      Participant

      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

    • #69647
      Troy Morton
      Participant

      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”
      #    }

    • #69648
      Todd Lundstedt
      Participant

      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.  😆

    • #69649
      Chris Williams
      Participant

      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}

    • #69650
      John Stafford
      Participant

      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
         }
       }
      }

    • #69651
      Yves Guerin
      Participant

      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

    • #69652
      Charlie Bursell
      Participant

      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

    • #69653
      John Stafford
      Participant

      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.

    • #69654
      Bob Richardson
      Participant

      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.

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

Forum Statistics

Registered Users
4,965
Forums
28
Topics
9,104
Replies
33,616
Topic Tags
248