TCL proc to group segments and cleanup message

[Skip Williams]

😯 I have order messages that have repeating ORC segment groups.  Some of the groups are not valid and must be deleted because of the order code in OBR.4.  I need to iterate through the message segments and create the groups .  I am using the following tcl code to create them:

               set pat “OBR.*?OBR”

set OBRlist [regexp -all -inline — $pat $msg].

As I create the groups I will evaluate and create a goodgroup list which I will use to put the message back together.  I have been to iterate through the segements (foreach segment $msgseglist {) and create the first group but cannot create any additional groups.  For example:

         OBR1  bad

         NTE1

         NTE1

         ORC2

         OBR2  good

         NTE2

         NTE2

         ORC3  bad

         OBR3

         NTE3

I need to eliminate the bad segment and the other segments in its group and keep the good group and then put the message back together.  Here is the code I have right now (its pretty crude):

foreach segment $msgseglist {

echo “segment = $segment”

if {([crange $segment 0 2] == “OBR”)} {

  set pat “OBR.*?OBR”

  set OBRlist [regexp -all -inline — $pat $msg]

echo “OBRlist=$OBRlist”

  set OBRfieldlist [split $OBRlist |]

  set codefld [lindex $OBRfieldlist 4]

  set codelist [split $codefld ^]

  set code [lindex $codelist 0]

echo “code = $code”

  set 1stNum [string range $code 0 0]

echo “1stNum = $1stNum”

if {$1stNum == 7} {

  set killgroup [lappend killgroup $OBRlist]

echo “killgroup = $killgroup”    

} else {

  set goodgroup [lappend goodgroup $OBRlist]

echo “goodgroup = $goodgroup”

   }

set pat “OBR.*?OBR”

set OBRlist [regexp -all -inline — $pat $msg]

echo “OBRlist=$OBRlist”

set goodgroup [lappend goodgroup $OBRlist]

echo “goodgroup = $goodgroup”

}

set segcounter1 [incr segcounter1]

}

Any ideas how I can make this work?

Thank you

Topic

[Jim Kosloskey]

Skip,

Based on your description of the challenge at hand, I think you are making this more difficult than it need be.

I think you can do all of this within the Xlate, no Tcl required (especially if you are on CL 3.8.x or later).

As you Iterate through the ORC, check the criteria. If it is not true then build whatever you need in the ORC group for the outbound message.

If it is true, don’t do anything and the Iterate will take you to the next group.

You will need to maintain your own counter for the outbound iterations of ORC group.

That can be done.

Let’s say your Iteration Counter for the ORC group (inbound) is %g1, use %g2 for your outbound counter. Now you have to maintain %g2 yourself.

Initialize %g2 to zeros (before the ORC Iteration) by:

COPY =0 —> $%g2

Note the $ in the front of %g2.

Now inside the portion of the IF where you want to keep the current ORC group use %g1 for the inbound notation and %g2 for the outbound notation when COPYing or whatever.

Something like this:

COPY 0(0).0(%g1).ORC….00001(0)

---

> 0(0).0(%g2).ORC….0001(0)

The notation is for example only but note when using %g2 for repetition notation no $.

Now AFTER you mave COPYed everything you want from the inbound ORC group (within the IF) do a MATH Action adding 1 to %g2. Like this:

MATH ADD =1 $%g2

---

> $%g2

Note again the use of the $.

The above logic is generally how to do it, the specifics will depend on your situation.

Jim Kosloskey

email: jim.kosloskey@jim-kosloskey.com 29+ years Cloverleaf, 59 years IT - old fart.

[Michael Hertel]

Skip,

If you want to post an example message, I’d be more than happy to take a whack at it.

-mh

[Skip Williams]

😀 Here is a sample message for testing:

MSH|^~&|4MEDICA|WESTLFH|LAB|OML|200612060733||ORM^O01|3910304|P|2.3|||AL|AL

PID|1|999999|77777777|5555555|TEST^SKIP ||19641015|M||O|28775 SW HOPE S MT LEBANON^OR^973550000||5414510999|||U||7054A2|544-50-4398|

PV1|1||LAB|||||FARLEDB^FARLEY^DAVID^^^^MD^P|

IN1|1|BS|5|BLUE CROSS|SEE PLANS^^^^0||(503)225-6619|063383000|||||||BS|TEST^SKIP^|3||||||||||||||N|||||YVP921195460|

GT1|0||TEST^KAREN^||28775 SW HOPE S MT RD^^LEBANON^OR^973550000|(541)451-0999||19741019|F||UN|999-99-9999|

GT1|1||TEST^KAREN^||||||||UN|

ORC|NW|9868213800|||||||20061206073100|||FARLEDB^FARLEY^DAVID^^^^MD^P|

OBR|1|9868213800||71306^HEPFUNCT PNL; HEPATIC FUNCTION PANEL^L|||20061206073200||||N|||||FARLEDB^FARLEY^DAVID^^^^MD^P|||||||||||1^^^^^R|

DG1|1|I9|272.4|HYPER&IPIDEMIA NEC/NOS||F|

ORC|NW|9868213800|||||||20061206073100|||FARLEDB^FARLEY^DAVID^^^^MD^P|

OBR|2|9868213800||43540^LIPID PAN; LIPID PANEL^L|||20061206073200||||N|||||FARLEDB^FARLEY^DAVID^^^^MD^P|||||||||||1^^^^^R|

OBX|1||CHM1^FASTING STATE:||12||||||F|||20061206073100|

DG1|1|I9|272.4|HYPERLI&IDEMIA NEC/NOS||F|

ORC|NW|9868213800|||||||20061206073100|||FARLEDB^FARLEY^DAVID^^^^MD^P|

OBR|3|9868213800||75730^VENI; VENIPUNCTURE (DRAW FEE)^L|||20061206073200||||N|||||FARLEDB^FARLEY^DAVID^^^^MD^P|||||||||||1^^^^^R|

DG1|1|I9|272.4|HYPERLIPIDEMI& NEC/NOS||F|

[Michael Hertel]

Here’s what I’ve come up with:

Code:

       run {
# ‘run’ mode always has a MSGID; fetch and process it
keylget args MSGID mh
set msg [msgget $mh]
# Get groups
lassign [split [crange $msg 3 7] {}] fsep csep rsep esep ssep
set workmsg [string map {x0dORC x0dx1cORC} $msg]
set grouplist [split $workmsg x1c]
# Analyze each group
foreach group $grouplist {
if {[cequal [crange $group 0 2] ORC]} {
if {![cequal [cindex [lindex [split [lmatch -regexp [split $group r] ^OBR] $fsep] 4] 0] 7]} {
lappend newgrouplist $group
}
} else {
lappend newgrouplist $group
}
}
set msg [join $newgrouplist {}]
# Renumber OBR segments
set OBRcount 0
set msglist [split $msg r]
foreach seg $msglist {
if {[cequal [crange $seg 0 2] OBR]} {
incr OBRcount
set OBRlist [split $seg $fsep]
lvarpop OBRlist 1 $OBRcount
lappend newmsg [join $OBRlist $fsep]
} else {
lappend newmsg $seg
}
}
set msg [join $newmsg r]
msgset $mh $msg
lappend dispList “CONTINUE $mh”
       }

[Skip Williams]

Thank you to Jim Kosloskey and Michael Hertel for their help with the solution for creating segment groups to cleanup order messages.  Both offered viable solutions.  The tcl solution was preferred by my supervisor.

Skip Williams

[Author]

Replies