Question

我有以下代码删除了包含附录的第一个OBX段之前的所有OBX段：

# This Cloverleaf TPS script removes all OBX segments prior to the first one that contains "ADDENDUM".
# This script also renumbers the OBX segments.
#
# See http://clovertech.healthvision.com/viewtopic.php?t=5953
proc remove_prior_to_addendum {args} {
    # set the procedure name
    # This is used for error messages
    set procname [lindex [info level [info level]] 0]
    # bring some common variables into the scope of this proc
    global HciSite HciSiteDir HciProcessesDir HciConnName HciRootDir ibdir
    # fetch mode
    keylget args MODE mode
    # keylget args ARGS.ARGNAME argname
    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 msgid
            # get the message
            set msgdata [msgget $msgid]

            # does this message have "ADDENDUM"?
            if {! [regexp {OBX[^\r]*\|ADDENDUM} $msgdata] } {
                # This message does not have an ADDENDUM, so continue the message
                return "{CONTINUE $msgid}"
            }

            # if we get here, we have an ADDENDUM

            # get the separators
            set segment_sep \r
            # process the message
            if { [catch {
                # commands

                # split the message into segments
                set segments [split $msgdata $segment_sep]

                # find the first OBX with an ADDENDUM
                set addendum_index [lsearch -regexp $segments {^OBX[^\r]*\|ADDENDUM}]

                # renumber the OBX segments that will remain
                set i 1
                foreach index [lsearch -all -regexp -start $addendum_index $segments {^OBX}] {
                    set segment [lindex $segments $index]
                    set segments [lreplace $segments $index $index [regsub {^OBX\|[0-9]*\|} $segment "OBX|$i|"]]
                    incr i
                }

                # now find any OBX segments prior to the ADDENDUM segment
                set obx_indexes [lsearch -all -regexp [lrange $segments 0 [expr $addendum_index - 1]] {^OBX}]

                # sort the indexes descending so that we can safely remove the indexes
                set obx_indexes [lsort -decreasing -integer $obx_indexes]

                # remove each segment
                foreach index $obx_indexes {
                    set segments [lreplace $segments $index $index]
                }

                # rebuild the message
                set msgdata [join $segments $segment_sep]
            } errmsg ] } {
                # the commands errored
                global errorInfo
                msgmetaset $msgid USERDATA "ERROR: $errmsg\n*** Tcl TRACE ***\n$errorInfo"
                # rethrow the error
                error $errmsg $errorInfo
            }
            # set the output message
            msgset $msgid $msgdata
            # return whether to kill, continue, etc. the message
            return "{CONTINUE $msgid}"
        }
        time {
            # Timer-based processing
            # N.B.: there may or may not be a MSGID key in args
        }
        shutdown {
            # Do some clean-up work
        }
        default {
            error "Unknown mode in $procname: $mode"
            return ""   ;# Dont know what to do
        }
    }
}

如何编辑脚本以便从邮件中删除所有 OBX段？

Answer 1

我对hl7了解不多（实际上我对此一无所知），但看起来你想要删除这些行：

# does this message have "ADDENDUM"?
if {! [regexp {OBX[^\r]*\|ADDENDUM} $msgdata] } {
   # This message does not have an ADDENDUM, so continue the message
   return "{CONTINUE $msgid}"
}

从HL7消息中删除所有OBX段

1 个答案: