- This topic has 0 replies, 1 voice, and was last updated 14 years, 9 months ago by
.
-
Topic
-
I put this script together from several different resources. I couldn’t find any other script that would filter on blank fields (active nulls “” or truly blank). I saw reference to another script that did the same thing but could not find it. Standard disclaimer applies 😆 ######################################################################
# Name: tps_filterBlankHL7Field.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:
# Segment Name, Field Number, Sub Field Number
# Ex. {SEGNAME PID} {FIELDNUM 18} {SUBFIELDNUM 0}
# will filter all messages with blanks or active nulls in PID 18.0
#
# Returns: tps disposition list:
#
#
proc tps_filterBlankHL7Field { 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 segname {}
keylget args ARGS.SEGNAME segname
set fieldnum {}
keylget args ARGS.FIELDNUM fieldnum
set subfieldnum {}
keylget args ARGS.SUBFIELDNUM subfieldnum
set RESULT CONTINUE
set msg [msgget $mh]
set sep [csubstr $msg 3 1]
set sub [csubstr $msg 4 1]
set subsub [csubstr $msg 5 1]
set seg_list [split $msg r]
foreach item $seg_list {
set seg_id [crange $item 0 2]
if [cequal $seg_id $segname] {
set fields [split $item $sub]
set checkfield [lindex $fields $fieldnum]
set subfields [split $checkfield $subsub]
set checkvalue [lindex $subfields $subfieldnum]
if {[cequal [string map {{“} {}} $checkvalue] “”]} {
set RESULT “KILL”
}
}
}
if {[cequal $RESULT “KILL”]} {
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
}
- The forum ‘Tcl Library’ is closed to new topics and replies.
