TCL ~ Cannot get it to look at OBR works good on PV1

[Barbi]

Cannot get it to look at OBR works good on PV1

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

# Name:        select_pv1_17_obr_16                                           #

# Purpose: This proc determines if the message contains                           #

# one of the Doctors in the table.                             #

# If the message matches the criteria, it is passed;           #

# ELSE the message is killed.                                  #

# Table is entered as an argument.                             #

#                                                                                 #

# Written by: Barbi Heller                                                        #

#    Micro Star Inc.com                                                 #

# Date:    05/01/2012                                                         #

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

# # # # # # # # # # # # # # #  Changes  # # # # # # # # # # # # # # # # # # # # # #

#                                                                                 #

# Date Comments      Changed By                                   #

#                                                                                 #

# UPoC type: tps                                                          #

# Args: tps keyedlist containing the following keys:                           #

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

#       MSGID   message handle                                                 #

#       ARGS    none                                                           #

#                                                                           #

#                                                                                 #

# Returns: tps disposition list:                                                  #

#                                                #

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

proc select_pv1_17_obr_16 { args } {

   keylget args MODE mode               ;# Fetch mode

   set dispList {}

   switch -exact — $mode {

       start {

           # Perform special init functions

     }

       run {

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

#          Hard Code                                                              #

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

         set segment1 “PV1”

         set segment2 “OBR”

keylget args MSGID mh

keylget args ARGS arg_tbl

   set msg [msgget $mh]

   set segmentList [split $msg “r”]

   set fieldSeparator [crange $msg 3 3]

   set subfieldSeparator [crange $msg 4 4]

   set DocTable $arg_tbl

       set header [lrange [split $msg “r”] 0 1]

       set msh [split [lindex $header 0] $fieldSeparator]

foreach seg [split $msg “r”] {

set segID [lindex [split $seg $fieldSeparator] 0]

  if { [cequal $segID “PV1”]} {

   #set ptclass [lindex [split $seg $fieldSeparator] 2]

   # set pttype [lindex [split $seg $fieldSeparator] 10]

             set doctest_fld [lindex [split $seg $fieldSeparator] 17]

             set doctest [lindex [split $doctest_fld $subfieldSeparator] 0]

   }

}

     foreach seg [split $msg “r”] {

set segID [lindex [split $seg $fieldSeparator] 0]

  if { [cequal $segID “OBR”]} {

             set dr_number [lindex [split $seg $fieldSeparator] 16]

   }

}

echo docnums:$doctest

echo segment1:$segment1

echo segment2:$segment2

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

# If doctor number matches one of the entries in the argument table               #

#     set match to yes, so the pass flag will be set to Yes                       #

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

set match “N”

         set match [tbllookup $DocTable $doctest]

         

     if {[cequal $segment1 “PV1”]} {

if {$match != “N”} {

      lappend dispList “CONTINUE $mh”

echo CONTINE PV1:$mh

    } else {

}

                   }

if {[cequal “CONTINUE” $mh]} {

         if {[cequal $segment2 “OBR”]} {

if {$match != “N”} {

      lappend dispList “CONTINUE $mh”

echo CONTINE OBR:$mh

    } else {

        lappend dispList “KILL $mh”

echo KILL OBR:$mh

}

                   }

}

          return $dispList

      }

 

}

 

}

       

          return $dispList

      }

      shutdown {

}

   }

 }

Topic

[Charlie Bursell]

It is hard to figure out since there is so much superfluous stuff going on.  For example why fetch OBR.16 if not used?  I would simplify it like below:

Put echo statements where you need them. I did not run it so there may be some “fat-finger” errors.

proc select_pv1_17_obr_16 { args } {

   keylget args MODE mode               ;# Fetch mode

   set dispList {}

   switch -exact — $mode {

       start {

           return “”

        }

       run {

           keylget args MSGID mh

           keylget args ARGS DocTable

           # Make sure valid table with bogus lookup

           if {[catch {tbllookup $DocTable foo} err]} {

               # Table does not exist

               echo nn$HciConnName/select_pv1_17_obr_16

                        invalid argument

                       Table does not exist

               echo To Error Database!nn

               msgmetaset $mh USERDATA “Invalid User Argument “

               return “{ERROR $mh}”

           }

           # Get message and split into segments

           set msg [msgget $mh]

           set segmentList [split $msg r]

           set fieldSeparator [string index $msg 3]

           set subfieldSeparator [string index $msg 4]

           # Get PV1 fields

           set PV1 [split [lsearch -inline -regexp $segmentList {^PV1}] $fieldSeparator]

           # Get OBR fields

           set OBR [split [lsearch -inline -regexp $segmentList {^OBR}] $fieldSeparator]

           # Get doc test field

           set doctest [lindex [split [lindex $PV1 17] $subfieldSeparator] 0]

           # Get Dr Number

           set dr_number [lindex $OBR 16]

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

# If doctor number matches one of the entries in the argument table

#     set match to yes, so the pass flag will be set to Yes

#

# No need to check if segment exists as field will be empty if they do not

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

# It looks to me like PV1.17 must be in table and equal “N” and OBR segment must exist

# What is purpose of dr_number?  I don’t see it used anywhere

           set match [tbllookup $DocTable $doctest]

           if {$match eq “N” && $OBR ne “”} {

               return “{CONTINUE $mh}”

           } else {

               return “{KILL $mh}”

           }

       }

   }

}

[Barbi]

thanks

[Robert Denny]

When there are many CCed docs in OBR28, I need some help with a proc like this that needs to run the first field of each provider that is listed in OBR28.

Any examples for a TCL proc that will do that type of task?

[Author]

Replies