TCL Issue

[Jon Melin]

Hello,

This is similar to my previous question but slightly modified. I am having and issue getting the replacement to work. What I need to do is locate the TRN segment in an X12 file, there could me multiple. I need to find the second segment value (could be anything, any size) and append a letter onto the end of that word. So for instance I would need to change TRN like this:

From:

~TRN*1*XXXXX*11111111~DTM*423*20130715~

To:

~TRN*1*XXXXXZ*11111111~DTM*423*20130715~

I was new to X12 so now I know the segments delimiter is ~ and the field delimiter is * – I can find and echo the values but when I use (below), it doesn’t replace anything, it just spits out the original value in the output file

set seg [regsub -all — {$Loc_TRN} $seg {$Sub_Word}]

lappend NewSegList $seg

Please let me know if you have any suggestions. Thank you in advance.

Also, on a side note, I can’t use the testing tool (with hcitpstestshowbydisp) to test my TCL procs anymore. It used to work and display as designed but now it just shows blank, I can only see errors by actually running it through the route and reading the output.

Code:

proc Sub_TRN_2 { args } {
   keylget args MODE mode                ;# Fetch mode
   set DebugOn 1
   set module Sub_TRN_2
     
   set dispList {}        ;# Nothing to return

   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 mh
           
           set msg [msgget $mh]
           #
           # Split the message and get fields to check
           # First set up some constants

           set sep “*”   ;# HL7 field separator      
         
           set segments [split $msg “~”] ;# get segments
           
           # Find TRN segment. Only search for TRN at the
           # start of the segment.

 foreach seg $segments {
 
 set trn_loc [lsearch -regexp $segments “TRN”]
 echo “$trn_loc Location TRN”

            set Loc_TRN “”
            set trn_seg [lindex $segments $trn_loc]
           
           #Split TRN segment into list of fields
           set trn_seg_list [split $trn_seg $sep]
echo “$trn_seg_list fields here”

set Loc_TRN [lindex [lindex $trn_seg_list 2] 0]

#ADDED BELOW
set Sub_Word $Loc_TRN
set Sub_Word [append Sub_Word “Z”]
           
echo “$Loc_TRN This is the value to be appended”
echo “$Sub_Word This is the appended value”

set seg [regsub -all — {$Loc_TRN} $seg {$Sub_Word}]
lappend NewSegList $seg

}; #end foreach

set NewMsg [join $NewSegList r]
msgset $mh $NewMsg
echo “Continue Message – Being Forwarded”
lappend dispList “CONTINUE $mh”    

           }  ; # Run Mode

       time {
           # Timer-based processing
           # N.B.: there may or may not be a MSGID key in args
           }

       startup {
           # Do nothing
       }
      shutdown {
           # Do nothing
       }

       default {
     error “Unknown mode ‘$mode’ in Sub_TRN_2”
       }
   }

return $dispList  
}

[/code]

Topic

[Jeff Dinsmore]

Since you  have your segment split into fields, and you want to replace an entire field, my first suggestion would be to use lreplace and join instead of regsub.

Note also the use of “~” instead of “r” in your “set NewMsg” statment.

Something like this:

Code:

proc Sub_TRN_2 { args } {
   keylget args MODE mode                ;# Fetch mode
   set DebugOn 1
   set module Sub_TRN_2
     
   set dispList {}        ;# Nothing to return

   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 mh
           
           set msg [msgget $mh]

           set sep “*”   ;# HL7 field separator      
         
           
           # Split the message into segments
set segments [split $msg “~”] ;# get segments
           
foreach seg $segments {

set seg_list [split $seg $sep]

if { [lindex $seg_list 0] eq “TRN” } {
 set seg [join [lreplace $seg_list 2 2 “[lindex $seg_list 2]Z”] $sep]
}

lappend NewSegList $seg

}; #end foreach

set NewMsg [join $NewSegList ~]
msgset $mh $NewMsg
echo “Continue Message – Being Forwarded”
lappend dispList “CONTINUE $mh”    
 
}  ; # Run Mode

     
time {
           # Timer-based processing
           # N.B.: there may or may not be a MSGID key in args
       }

       startup {
           # Do nothing
       }
shutdown {
           # Do nothing
       }

       default {
error “Unknown mode ‘$mode’ in Sub_TRN_2”
       }
   }

return $dispList  
}

Jeff Dinsmore
Chesapeake Regional Healthcare

[Author]

Replies