Need to push messages FIFO via TCL script
- This topic has 4 replies, 2 voices, and was last updated 19 years, 8 months ago by
.
-
Topic
-
Recently, we upgraded our medication administration system, AdminRx from McKesson. This system also runs our medication robot, which fills a nightly cart fills, and fills single patient orders. Our HCIS, MEDITECH, has not provided us with the best possible interfaces for this other vendor system. We purchased from MEDITECH two interfaces. No one interface sends out a message with all of the segments and fields we need to run AdminRx and the robot to its fullest potential. Thus is the reason why we have tried to combine them in the engine. We can (and have in the past) sent both interfaces to AdminRx and the robot (it is the same database) but one message will overwrite the other message, resulting in missing important information. This interface uses a HL7 variant I have named adminRx. The interfaces need to be First In First Out, FIFO. This is our problem, our script is not always outputting in FIFO sequence.
New orders, order edits, and discontinued orders can sometimes happen in a very short time span. If an order edit is sent after a discontinue, it will keep that medication order active, resulting in a medication error and maybe a lawsuit if we kill someone.
message matching/combining
Messages are considered a match when segment ORC, Fields: 1 and 2 match.
The message with the most information is the accu-out interface.
Once matched, copy ZRX segment from rxobot-out to accu-out. Other copies listed below.
If an order number has a *-F* kill it. Only applies to the RXOBOT-OUT interface.
Kill messages that have a give rate of ONCE and order type of OD that came from the RXOBOT-OUT interface. Give rate come in segment ORC, field 7, subfield 1 (example: ORC|NW|F0001431|||AC||^ONCE^^200412070854^200412070855^^0^00000000||200412070855|PHA.BWJ^JOSEPH,BRADLEY W.|||||200412070855).
Kill messages that have a give rate of ONCE and order type of DC that came from the ACCU-OUT interface.
Change order type of OD to DC
Change order type of OH to HD
Change order type of OC to CA
When a message matches copy these fields:
From RXOBOT message To ACCU-OUT message
RXE.23^0 RXE.23^0
RXE.25^0 RXE.25^0
RXE.26^0 RXE.26^0
RXE.10^0 RXE.10^0
ZRX.1^0 ZRX.1^0
ZRX.2^0 ZRX.2^0
From ACCU-OUT message To ACCU-OUT message
IF RXC.1^0 == B THEN
RXC.3^0 RXE.3^0
RXC.4^0 RXC.6^0
END IF
IF RXC(1).1^0 == A THEN
RXC(1).3^0 RXE.3^0
END IF
IF RXR.4^1 == C THEN
=S RXR.4^1
END IF
If no match is found with in 30 seconds then copy some fields and send the stalled message on.
From ACCU-OUT message To ACCU-OUT message
IF RXC.1^0 == B THEN
RXC.3^0 RXE.3^0
RXC.4^0 RXC.6^0
END IF
IF RXC(1).1^0 == A THEN
RXC(1).3^0 RXE.3^0
END IF
IF RXR.4^1 == C THEN
=S RXR.4^1
END IF
Any suggestions would be appreciated, the script follows.
######################################################################
# Name: tps_double_feed
# 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:
#
#
# Returns: tps disposition list:
#
#
proc tps_double_feed { args } {
keylget args MODE mode ;# Fetch mode
set dispList {} ;# Nothing to return
switch -exact — $mode {
start {
# Perform special init function
# 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
global HciConnName
set module “(tps_double_feed/$HciConnName)”
# 1. set variables
set msgType {}
set match {}
set debug true
# 2. Get Message
set msg [msgget $mh]
# 3. What type of message?
regexp {MSH|.*?|.*?|.*?|.*?|.*?|.*?|.*?|(.*?)|(.*?)|} $msg m0 msgType msgInterface
# 4. Strip out extra information from segment MSH field 9 interface
set msgInterface [lindex [split $msgInterface .] 0]
# 5. continue ADT messages that may pass through this interface
if {$msgType != “RDE”} {
echo $module/Continuing ADT message
return “{CONTINUE $mh}”
}
# 6. If you have gotten this far it must be an RDE message regexp order type and number giveRate
regexp {ORC|(..)|(.*?)|.*?|.*?|.*?|.*?|(.*?)|} $msg m1 orderType orderNumber giveRate
# 7. If orderNumber has -F* after it, kill it (only robot interface).
if {[string match *-F* $orderNumber] && $msgInterface == “RXOBOT-OUT”} {
echo $module/Killing order number: $orderNumber with order type: $orderType because it had an order number with a “-F” and came from RXOBOT-OUT
return “{KILL $mh}”
}
# 8. Kill messages that have a give rate of ONCE and order type of OD.
#if {[lindex [split $giveRate ^] 1] == “ONCE” && $orderType == “OD” && $msgInterface == “RXOBOT-OUT”} {
# echo $module/Killing order number: $orderNumber with order type: $orderType because it had a give rate of ONCE, order type of OD, and cam from RXOBOT-OUT
# return “{KILL $mh}”
#}
# 9. Kill messages that have a give rate of ONCE and order type of DC
#if {[lindex [split $giveRate ^] 1] == “ONCE” && $orderType == “DC” && $msgInterface == “ACCU-OUT”} {
# echo $module/Killing order number: $orderNumber with order type: $orderType because it had a give rate of ONCE, order type of DC, and came from ACCU-OUT
# return “{KILL $mh}”
#}
# 10. Change OD to DC
#if {$orderType == “OD”} {set orderType {DC}}
# 11. Change OH to HD
#if {$orderType == “OH”} {set orderType {HD}}
# 12. Make message with order type of NW higher message priority
if {$orderType == “NW” && $orderNumber != “Z9998876”} {
msgmetaset $mh PRIORITY 5121
}
# 13. Make message with order type of CA lower message priority
#if {$orderType == “CA” && $orderNumber != “Z9998876”} {
# msgmetaset $mh PRIORITY 5119
#}
# 14. Alright, lets combine some messages. First, See if the stalledMsgs Variable holds any messages
global stalledMsgs
set ts [clock seconds]
if {[array exists stalledMsgs] == 0 && $orderNumber != “Z9998876”} {
echo $module/message: $mh with order type: $orderType and order number: $orderNumber has been stalled in engine.
set stalledMsgs($mh) “$orderType $orderNumber $ts”
} elseif {$orderNumber != “Z9998876”} {
echo $module/stalled messages array: stalledMsgs exists. Script Will now search array for message with same order Type and order Number.
foreach item [array names stalledMsgs *] {
set itemType [lindex [split [lindex [array get stalledMsgs $item] 1]] 0]
set itemNumber [lindex [split [lindex [array get stalledMsgs $item] 1]] 1]
if {“$itemType $itemNumber” == “$orderType $orderNumber”} {
set match $item
}
}
if {$match != “”} {
#remove message handle from array
array unset stalledMsgs $match
if {$msgInterface == “RXOBOT-OUT”} {
set msgOne [grmcreate -msg $match hl7 2.2 AdminRx RDE]
set msgTwo [grmcreate -msg $mh hl7 2.2 adminRx RDE]
}
if {$msgInterface == “ACCU-OUT”} {
set msgOne [grmcreate -msg $mh hl7 2.2 adminRx RDE]
set msgTwo [grmcreate -msg $match hl7 2.2 adminRx RDE]
}
grmstore $msgOne 0(0).RXE.00323.[0] d [grmfetch $msgTwo 0(0).RXE.00323.[0]]
grmstore $msgOne 0(0).RXE.90014.[0] d [grmfetch $msgTwo 0(0).RXE.90014.[0]]
grmstore $msgOne 0(0).RXE.90015.[0] d [grmfetch $msgTwo 0(0).RXE.90015.[0]]
grmstore $msgOne 0(0).ZRX.90010.[0] d [grmfetch $msgTwo 0(0).ZRX.90010.[0]]
grmstore $msgOne 0(0).ZRX.90011.[0] d [grmfetch $msgTwo 0(0).ZRX.90011.[0]]
if {[datget [grmfetch $msgOne 0(0).RXC(0).00313.[0]] VALUE] == “B”} {
grmstore $msgOne 0(0).RXE.00318.[0] d [grmfetch $msgOne 0(0).RXC(0).00315.[0]]
grmstore $msgOne 0(0).RXC(0).90013.[0] d [grmfetch $msgOne 0(0).RXC(0).00316.[0]]
}
if {[datget [grmfetch $msgOne 0(0).RXC(1).00313.[0]] VALUE] == “A”} {
grmstore $msgOne 0(0).RXE.00318.[0] d [grmfetch $msgOne 0(0).RXC(1).00315.[0]]
}
if {[datget [grmfetch $msgOne 0(0).RXR.00312.[1]] VALUE] == “C”} {
grmstore $msgOne 0(0).RXR.00312.[1] d [datcreate S ch]
}
set newMsg [grmencode -warn w $msgOne]
msgset $mh [msgget $newMsg]
grmdestroy $msgOne $msgTwo
datdestroy -list [datlist]
lappend dispList “CONTINUE $mh”
lappend dispList “KILL $match”
lappend dispList “KILL $newMsg”
} else {
set stalledMsgs($mh) “$orderType $orderNumber $ts”
}
}
# 15. search through array for messages that are older than 30 seconds
set item {}
foreach item [array names stalledMsgs *] {
set itemTs [lindex [split [lindex [array get stalledMsgs $item] 1]] 2]
set ts [clock seconds]
set elapsedTime [expr $ts – $itemTs]
if {$elapsedTime >= 45} {
array unset stalledMsgs $item
set msgGrm [grmcreate -msg $item hl7 2.2 adminRx RDE]
if {[datget [grmfetch $msgGrm 0(0).RXC(0).00313.[0]] VALUE] == “B”} {
grmstore $msgGrm 0(0).RXE.00318.[0] d [grmfetch $msgGrm 0(0).RXC(0).00315.[0]]
grmstore $msgGrm 0(0).RXC(0).90013.[0] d [grmfetch $msgGrm 0(0).RXC(0).00316.[0]]
}
if {[datget [grmfetch $msgGrm 0(0).RXC(1).00313.[0]] VALUE] == “A”} {
grmstore $msgGrm 0(0).RXE.00318.[0] d [grmfetch $msgGrm 0(0).RXC(1).00315.[0]]
}
if {[datget [grmfetch $msgGrm 0(0).RXR.00312.[1]] VALUE] == “C”} {
grmstore $msgGrm 0(0).RXR.00312.[1] d [datcreate S ch]
}
set newGrm [grmencode -warn w $msgGrm]
grmdestroy $msgGrm
datdestroy -list [datlist]
lappend dispList “KILL $item”
lappend dispList “CONTINUE $newGrm”
}
}
set dispList [lsort $dispList]
if {$orderNumber == “Z9998876”} {lappend dispList “KILL $mh”}
#display debug information
if {$debug} {
echo ===============================================
echo $module/ts: [clock format [clock seconds]]
echo $module/mh: $mh
echo $module/msgType: $msgType
echo $module/msgInterface: $msgInterface
echo $module/orderType: $orderType
echo $module/orderNumber: $orderNumber
echo $module/giveRate: [lindex [split $giveRate ^] 1]
echo $module/dispList: $dispList
echo $module/stalledMsgs: [array names stalledMsgs *]
echo $module/grmlist: [grmlist]
echo $module/datlist: [datlist]
echo $module/msg priority: [msgmetaget $mh PRIORITY]
echo $module/msg list: [msglist]
echo $module/newGrm: [if {[info exists newGrm]} {echo $newGrm}]
echo $module/newMsg: [if {[info exists newMsg]} {echo $newMsg}]
echo ===============================================
}
# lappend dispList “CONTINUE $mh”
}
time {
# Timer-based processing
# N.B.: there may or may not be a MSGID key in arg
set ts [clock format [clock seconds] -format %Y%m%d%H%M]
set mh [msgcreate -type data -class protocol “MSH|^~&||.|||$ts||RDE|INTERNAL|D|2.2x0dPID|1||999999||BLANK^MESSAGE^^^^||19820802|M|^^^^^|C|BLANK^^FINDLAY^OH^45840|HAN|999-999-9999|||M||000000000|000-00-0000x0dPV1|1|I|BLANK^000^00|R|||NONST^NONSTAFF^PHYSICIAN^^^^|||NEW||||RP|||NONST^NONSTAFF^PHYSICIAN^^^^|IN||S|||||||||||||||||||.||ADM||$tsx0dAL1|||^BLANK^BLANKx0dAL1|||^BLANK^BLANKx0dORC|NW|Z9998876|||AC||^ONCE^^200502181700^200502191659^^0^00000000||200502181659|BLANK^FAKE,MESSAGE|||||200502181659x0dRXE|^ONCE^^200502181700^200502191659^SCH^^^^|PROMETHI^PROMETHAZINE HCL 25 MG/ML AMP|12.5|PHENERGAN 25 MG/ML AMP|MG|AMP||||0||0.5|12.5 MG = 0.5 AMP||||||||||||25| MG/MLx0dRXR|IVPx0dZRX|N|200501010000x0d”]
lappend dispList “CONTINUE $mh”
}
shutdown {
# Doing some clean-up work
foreach index [array names stalledMsgs *] {
array unset stalledMsgs $index
lappend dispList “CONTINUE $index”
}
set dispList [lsort $dispList]
}
}
return $dispList
}
- The forum ‘Cloverleaf’ is closed to new topics and replies.
