- This topic has 3 replies, 3 voices, and was last updated 13 years, 8 months ago by
.
-
Topic
-
-
Replies
-
-
Phillip,
I see you are specifying using Tcl.
Is that Tcl in a TPS or inside an Xlate?
If this is to be inside an Xlate I don’t think you will need any Tcl.
How that is accomplished inside an Xlate without Tcl is dependent on the situation.
Can you give us more details?
email: jim.kosloskey@jim-kosloskey.com 29+ years Cloverleaf, 59 years IT - old fart.
-
-
Philip,
As Jim mentioned, it’s usually easier to perform this kind of task within an Xlate and no Tcl is required.
However, if your situation requires you to do it within a TPS, here is a sample proc that can get you started. Please modify it according to your needs.
Code:
######################################################################
# Name: tpsAddOBX
#
# Purpose: Add an additional OBX segment at the beginning
# of an OBX group.
#
# For this exercise, it is assumed that all OBX
# segments come as part of a single OBX group in
# the inbound message.
#
# The new OBX segment is added to become the first
# OBX, so all the original OBX segments must be moved
# down one position in the message.
#
# UPoC type: tps
# Use in inbound TPS (pre Xlate)
#
# Args: tps keyedlist containing the following keys:
# MODE run mode (”start”, “run” or “time”)
# MSGID message handle
# ARGS user-supplied arguments: None for this script
#
#
# Returns: tps disposition list:
# CONTINUE -We always continue the message.
#
# Date:proc tpsAddOBX { args } {
global HciConnName
if ![info exists HciConnName] { set HciConnName UNKNOWN }
# A good way to generically get the name of the procedure
# (to be used for error messages, debug, etc.)
set module “$HciConnName/[lindex [info level 1] 0]”
keylget args MODE mode
keylget args CONTEXT context
switch -exact — $mode {
start {
# Perform special init functions
# N.B.: there may or may not be a MSGID key in args
}
run {
keylget args MSGID mh ;# Get message handle
set msg [msgget $mh] ;# Get message
# Get the field, sub-field, and repetition separators
set fldSep [string index $msg 3]
set subSep [string index $msg 4]
set repSep [string index $msg 5]
# Get a list of HL7 segments by splitting the message on CR
set segList [split $msg r]
set newsegList {} ;# Buffer to hold the new outbound message
# To make room for the additional OBX segment, we need to shift
# down one position all the existing OBX segments. To achieve this,
# we must increment by 1 the sequence number in OBX.1
# LOOP through the message and modify each OBX segment.
# We add the modified OBX segments and any other segment
# to our new message
foreach seg $segList {
if [string equal $seg “”] { continue } ;# Skip any empty segment
set segname [string range $seg 0 2] ;# segment name
if {[string equal $segname OBX]} {
# Break the segment in a list of fields
set OBXflds [split $seg $fldSep]
# This should never happen, but we make sure the list has
# at least 1 element by appending empty elements until
# it does.
while {[llength $OBXflds] < 1} { lappend OBXflds {} }
# Get field 1 (sequence number). Note that even though the command is
# 0-based we still refer to the field as field 1 since the "OBX"
# header itself is field 0
set OBX1 [lindex $OBXflds 1]
# echo "OBX.1 is $OBX1"
# Increment the value only if it's numeric
if {[regexp ^\d+$ $OBX1]} { set OBX1 [incr OBX1]}
# Put the updated value back in OBX.1
set OBXflds [lreplace $OBXflds 1 1 $OBX1]
# Put the OBX segment back together
set seg [join $OBXflds $fldSep]
# echo "Modified OBX segment: $seg"
} ;# end if statement
# Add the segments to the new message
lappend newsegList $seg
} ;# end foreach loop
# Now we build our additional OBX segment according to the
# specifications given to us.
# a) make sure that the sequence number in OBX.1 is 1.
# b) make sure that the data type in OBX.2 is the appropriate one
# (FT, ST, TX, NM …). Probably the same as the other OBX segments.
# c) make sure that the result status in OBX.11 is the same as
# in the other OBX segments (P, F …)
# d) fill in values for OBX.3 and OBX.5 as desired
set newOBX "OBX|1|ST|||YOUR VALUE HERE||||||F"
# Search for the location of the first OBX segment in the list,
# so that we can insert the new one right above it.
# The lsearch command will return the location of the first match
# only in Tcl versions prior to 8.5. Tcl 8.5 and above will return
# a list of all locations. It's safer to specifically pick the first
# location by using 'lindex … 0'
set OBXloc [lindex [lsearch -regexp $newsegList {^OBX}] 0]
# Insert our new OBX segment at the correct position
set newsegList [linsert $newsegList $OBXloc $newOBX]
# Join the segments back into a message with segments
# separated by CR
set msg [join $newsegList r]
# Put modified message in message handle and CONTINUE
msgset $mh $msg
return "{CONTINUE $mh}"
}
shutdown {
# Doing some clean-up work
}
default {
error "Unknown mode '$mode' in $module"
}
}
}I hope this helps.
-
- The forum ‘Tcl Library’ is closed to new topics and replies.
