- This topic has 3 replies, 3 voices, and was last updated 10 years ago by
.
-
Topic
-
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 {
}
}
}
-
Replies
-
-
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}”
}
}
}
}
-
-
-
- The forum ‘Tcl Library’ is closed to new topics and replies.
