Shortening a tcl proc

Clovertech Forums Read Only Archives Cloverleaf Tcl Library Shortening a tcl proc

  • Creator
    Topic
  • #50896
    Kevin Crist
    Participant

      I have a tclproc from the people who i have followed in this job. Their way of writing the tclprocs were a bit longer, but easier to read for me (limited tcl knowledge). Is their any advice on how to make the posted tclproc shorter, faster…etc

      Thanks.

    Viewing 3 reply threads
    • Author
      Replies
      • #67942
        Steve Carter
        Participant

          Try this:

          proc tpsKillA08DischargedForWork { args } {

          keylget args MODE mode               ;# Fetch mode

             

              global HciConnName

              set procName “tpsKillA08DischargedForWork”

          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

          set foundA08 0

          set foundDischargeDate 0

          set foundAccountStatus 0

          set msgtext  [msgget $mh]

          set fieldsep [string index $msgtext 3]

          set subfieldsep [string index $msgtext 4]

          set segments [split $msgtext “r”]

          set mshSeg [lindex [lregexp $segments ^MSH.*] 0]

          set mshFields [split $mshSeg $fieldsep]

          set msgType [lindex $mshFields 8]

          set triggerType [lindex [split $msgType $subfieldsep] 0]

          set triggerEvent [lindex [split $msgType $subfieldsep] 1]

          if { ([string match “ADT” $triggerType]) && ([string match “A08” $triggerEvent]) } {

             set foundA08 1

          }

          set pidSeg [lindex [lregexp $segments ^PID.*] 0]

          set pidFields [split $pidSeg $fieldsep]

          set patientAccount [lindex $pidFields 18]

          set patientName [lindex $pidFields 5]

          set pv1Seg [lindex [lregexp $segments ^PV1.*] 0]

          set pv1Fields [split $pv1Seg $fieldsep]

          set patientType [lindex $pv1Fields 2]

          set patientDischargeDate [lindex $pv1Fields 45]

          set patientAccountStatus [lindex $pv1Fields 41]

          if { $patientDischargeDate != “” } {

             set foundDischargeDate 1

          }

          if { [string match “X” $patientAccountStatus] } {

             set foundAccountStatus 1

          }

               # If the ADT trigger event is an A08 and the patient discharge date is loaded

               # or patient account status is X then kill the message, otherwise continue it.  

               if { ($foundA08 && $foundDischargeDate) || ($foundAccountStatus) } {

                           puts “$HciConnName\$procName – KILLING A08 for Inpatient: $patientName – $patientAccount”

                                   lappend dispList “KILL $mh”

                       } else  {

                           puts “$HciConnName\$procName – CONTINUING ADT for Patient: $patientName – $patientAccount”

                           lappend dispList “CONTINUE $mh”

                   }

                 return $dispList

          }

          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 tpsKillA08DischargedForWork”

          }

          }

          return $dispList

          }

        • #67943
          Kevin Crist
          Participant

            Thanks steve

            what i was looking for. So if you want to pull a specific field from a segment(s) do you have to the same steps you did with every one?

          • #67944
            Kevin Crist
            Participant

              i have tried to make  a simplified tclproc  and have been fighting the closing braces. Can anyone help me with this.

              sourceFilter /quovadx/qdx5.4.1/integrator/test700/tclprocs/tpsKillNonHemaORU1.tcl: Failed to source filtered file: missing close-brace

              sourceFilter /quovadx/qdx5.4.1/integrator/test700/tclprocs/tpsKillNonHemaORU1.tcl: Failed to source filtered file: missing close-brace

              [0:TEST] Tcl error:

              msgId = message0

              proc = ‘tpsKillNonHemaORU1.tcl’

              args = ”

              result = ‘invalid command name “tpsKillNonHemaORU1.tcl”‘

              errorInfo: ‘

              invalid command name “tpsKillNonHemaORU1.tcl”

                 while executing

              “tpsKillNonHemaORU1.tcl {MSGID message0} {CONTEXT sms_ib_data} {ARGS {}} {MODE run} {VERSION 3.0}”‘

              Here is my code.

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

              # Name: tpsKillNonHemaORU1.tcl

              # 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 disposition list:

              #          

              #

              proc tpsKillNonHemaORU1.tcl { 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

                       

                        set foundHEMA 0

                       

                        set msgtext [msgget $mh]

                        set fieldsep [string index $msgtext 3]

                        set subfieldsep [string index $msgtext 4]

                        set segments [split $msgtext “r”]

                       

                        set obrSeg [lindex [lregexp $segments ^OBR.*]0]

                        set obrFields [split $obrSeg $fieldsep]

                        set orderNumber [lindex obrFields 2]

                        set testType [lindex obrFields 18]

                   echo testType: $testType

                       

                       

                       

                        if {$testType != “”} {

                            puts $orderNumber

                            lappend $dispList “KILL $mh”

                       

                        } else {

                       

                      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

              }

                 

              }

                 return $dispList

              }

              }

            • #67945
              Jerry Tilsley
              Participant

                The brace that is missing is the one for the closing of the run section.  There should be a closing brace right before the Time section.

            Viewing 3 reply threads
            • The forum ‘Tcl Library’ is closed to new topics and replies.