The following code would filter off all messages where the gender is male. Or to be more technical, where the PID:8 value is “M”
If you have any questions, let me know.
#########################################################################
# Name: gender_filter.tcl
#########################################################################
# Purpose: TCL proc to filter by gender.
#
# UPoC type: tps
#
# Args: tps keyedlist containing the following keys:
# MODE run mode (“start”, “run”, “time” or “shutdown”)
# MSGID message handle
# CONTEXT tps caller context
# ARGS user-supplied arguments:
#
#
# Returns: tps disposition list:
#
#
# Note: All included routines “inc_” and global variables “gv_” are
# defined in the drmc_includes.tcl file
#
#########################################################################
# Last Update:
# Description:
#
#########################################################################
proc gender_filter { args } {
keylget args MODE mode ;# Fetch mode
set dispList {} ;# Nothing to return
set iKillMsg 0 ;# Kill message indicator (0 = Send | 1 = Kill)
set iDebug 0 ;# Debug indicator ( 0 = Off | 1 = On )
switch -exact — $mode {
start { }
run {
keylget args MSGID mh
# Set message variables
set msg [msgget $mh] ;# Original message
set fs [cindex $msg 3] ;# Field seperator
set sfs [cindex $msg 4] ;# Subfield seperator
set rfs [cindex $msg 5] ;# Repeating field seperator
set segs [split $msg r] ;# Split message into segments using CR
set newmsg {} ;# New message list
# Loop through segments
foreach seg $segs {
set fields [split $seg $fs] ;# Split the segment into fields
# Main Switch
switch [lindex $fields 0] {
PID {
set sGender [lindex $fields 8]
if { $sGender eq “M” } {
set iKillMsg 1
}
set seg [join $fields $fs]
lappend newmsg $seg
}
default {
lappend newmsg $seg
}
}
}
# Join the list with CR
set newmsg [join $newmsg r]
# Set the original message to new message
msgset $mh $newmsg
if {$iKillMsg == 1} {
# Kill Message
lappend dispList “KILL $mh”
} else {
# Send Message
lappend dispList “CONTINUE $mh”
}
}
time { }
shutdown { }
default { error “Unknown mode ‘$mode’ in $module” }
}
return $dispList
}
.
