Re: Adding Dummy Fields to a Segment

[Bob Richardson]

Greetings,

Yes, I agree that vendors in the health care industry skirt the HL7 requirements with impunity and so forth.  Rather than develop ulcers, heart attacks, and other undesirable side effects, our approach has been to insert a Post Route Detail TCL procedure to check/add those dummy fields.  Please feel free to use the following code which accepts arguments for the segment and number of fields to insert.

I hope that it proves useful for you.

####################################################################################

#

#  Name:  tps_add_blank_fields

#

#  Date:  8/11/2004

#

#  Description:     Appends additional blank fields to specified segments

#

#  Author:     Ian Smith

#

#  UPOC Type:  TPS

#

#  Args:  A list of Segments & Number of required fields (zero based)

#         Argument example:

#         {PID 21} {PV1 47} {GT1 14} {IN2 28}

#

#         The previous example will make sure that PID has 20 fields,

#         PV1 has 46 fields, GT1 has 13 fields and IN2 has 27 fields.

#

#  Returns:    Continue reformatted message

#

#####################################################################################

proc tps_add_blank_fields { args } {

    keylget args MODE mode

    keylget args ARGS arglist

    if {$mode == “run”} {

         keylget args MSGID mh

         set msg  [msgget $mh]

         set segs [split $msg r]

         lassign  [split [crange $msg 3 7] {}] fsep csep rsep esep ssep

         set new_msg_list {}

         foreach element $arglist {

              lappend arg_seg_list [lindex $element 0]

         }

         foreach seg $segs {

              set fields  [split $seg $fsep]

              set segpos  [lsearch $arg_seg_list [lindex $fields 0]]

              if {![cequal $segpos {-1}]} {

                   set arg_num [lindex [lindex $arglist $segpos] 1]

                   if {![ctype digit $arg_num]} {

                        set arg_num 0

                   }

                   while {[expr [llength $fields] < $arg_num]} {                         lappend fields {}                    }                    lappend new_msg_list [join $fields $fsep]               } else {                    lappend new_msg_list $seg               }          }          set newmsg [join $new_msg_list r]          msgset $mh $newmsg          return “{CONTINUE $mh}”     } }