- This topic has 0 replies, 1 voice, and was last updated 6 years, 7 months ago by
.
-
Topic
-
###################################################################### # Name: kill_A35.tcl
# Purpose: KILL or CONTINUE a message based on a user defined content
# UPoC type: tps
# Args: tps keyedlist containing the following keys:
# MODE run mode (“start”, “run” or “time”)
# MSGID message handle
# ARGS user-supplied arguments:
# KILLCOND Literal that the field will be qualifying on
# SEGNAME Segment to check
# FIELDNUM Field number to check within the segment
# SUBFIELDNUM Subfield to check within the field
#
# Returns: tps disposition list:
# KILL: if field matches user defined literal
# CONTINUE: if field does not match user defined literal
#
proc kill_A35 { 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 msg [msgget $mh] ;# Get message
set pt_acct “”
set pt_class “”
set msh9_1 “”
#
# Split the message and get fields to check
# First set up some constants
#
set sep [csubstr $msg 3 1] ;# HL7 field separator
set sub [csubstr $msg 4 1] ;# HL7 subfield separator
set segments [split $msg r] ;# Get segments
#
# LOOP through to find the qualifying field
#
foreach seg $segments {
if [cequal $seg “”] { continue } ;# Just in case
set segtype [csubstr $seg 0 3] ;# Get segment name
if [cequal $segtype MSH] { ;# MSH, EVN, PID, etc.?
set fields [split $seg $sep] ;# List of Fields
set msh9_1 [lindex [split [lindex $fields 8] $sub] 1] ;# Get approp. field
} ;# end of segment ‘if’
break
} ;# end of ‘foreach’
#
# Qualify whether to KILL or CONTINUE
#
if {[cequal $msh9_1 “A35”]} {
lappend dispList “KILL $mh”
} else {
lappend dispList “CONTINUE $mh”
} ;# end of qualifying ‘if
} ;# end of ‘run’
time {
# Timer-based processing
# N.B.: there may or may not be a MSGID key in args
}
shutdown {
#No shutdown code
}
}
return $dispList
}
- The forum ‘Tcl Library’ is closed to new topics and replies.
