TCL proc to group segments and cleanup message

Clovertech Forums Read Only Archives Cloverleaf Tcl Library TCL proc to group segments and cleanup message

  • Creator
    Topic
  • #48942
    Skip Williams
    Participant

      😯 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

    Viewing 4 reply threads
    • Author
      Replies
      • #60195
        Jim Kosloskey
        Participant

          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.

        • #60196
          Michael Hertel
          Participant

            Skip,

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

            -mh

          • #60197
            Skip Williams
            Participant

              😀 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|

            • #60198
              Michael Hertel
              Participant

                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”
                       }

              • #60199
                Skip Williams
                Participant

                  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

              Viewing 4 reply threads
              • The forum ‘Tcl Library’ is closed to new topics and replies.