CALL in Xlate

################################################################################
# Name: xlt_splitflds
# Purpose: Provide a capability to split a field into it’s sub fields based
#           upon a user specified separator.
#
#           For example a name field is comprised of three sub-fields:
#              Last Name
#              First Name
#              Middle Initial
#               separated by a comma thus LastName,FirstName,MiddleInitial
#           After the proc has executed, three subfields will have been extracted.
#
#
# UPoC type:    XLTP
# Args: @xlt_splitflds_debug
#           @xlt_splitflds_sep
#           Field to be checked
# Author:       Jim Kosloskey
# Date-written: 10/01/1999
# Purpose:      This procedure splits a Source field into at least as many fields as specified
#               in the Destination (xlateOutList) as separated by the separator specified i
#               (xlt_splitflds_sep).
#
#**************************************************************************************************************
#*                                            C O D E   A U D I T                                                               *
#*_____________________________________________________________________________*
#*Date       I-Catcher  Description                                                                                          *
#*———- ———- ———————————————–*
#*10/01/1999            Procedure conception
#*
#*______________________________________________________________________________*
#*02/24/2004 jrk02242004  Changed use of translit Tcl command to convert DEBUG
#*                        argument to uppercase. Now using string toupper Tcl
#*                        command as translit is being phased out of Tcl.
#*_____________________________________________________________________________*
#**************************************************************************************************************
#
################################################################################
#
# Copyright: Copyright(c) 1999, Oakwood Healthcare System. All rights reserved.

proc xlt_splitflds { } {
   upvar xlateId       xlateId
 xlateInList   xlateInList
 xlateInTypes  xlateInTypes
 xlateInVals   xlateInVals
 xlateOutList  xlateOutList
 xlateOutTypes xlateOutTypes
 xlateOutVals  xlateOutVals

# Global variables
   global HciConnName           ;#Get the connection name

# Local variables
    set fatal_err “N”
    set elem_count 0
    set field_count 1    
    set temp_outvals {}
    set module “$HciConnName XLT_SPLITFLDS v1.1:”
#
#******************************************************************************************************
# Setup the field IDs necessary for this procedure
#******************************************************************************************************
#
   set splitflds_debug {@xlt_splitflds_debug}          ;# xlt_splitflds debug switch
   set splitflds_sep {@xlt_splitflds_sep}              ;# xlt_splitflds separator
#
#******************************************************************************************************
# Setup the Indexes into the Inbound list for the above arguments
#******************************************************************************************************
#
   set debug_ndx {}                         ;# xlt_splitflds debug switch index
   set sep_ndx {}                           ;# xlt_splitflds separator index
#
#******************************************************************************************************
# Setup the Storage Area for the above arguments
#******************************************************************************************************
#
   set debug {N}                             ;# debug switch
   set sep {}                                ;# sep
#
#******************************************************************************************************
# Get the DEBUG argument
#   Find the debug argument position if it exists in the inbound list
#   If it does not exist, notify the invoker
#   If it does exist, find the value of the switch
#       Convert a lower case y to upper case
#******************************************************************************************************
#
   set debug_ndx [lsearch $xlateInList $splitflds_debug]
   if {$debug_ndx == -1} {                     ;# Did we find the argument?
        if {$debug == “Y”} {          ;#Debug on?
            echo “$module $splitflds_debug not located, assuming no debug.”
        }
    }
# jrk02242004 – old way using translit      
#    set debug [translit y Y [lindex $xlateInVals $debug_ndx]]     ;#Change lower to upper  
# jrk02242004 – new way using string toupper
    set debug [string toupper [lindex $xlateInVals $debug_ndx]]

#If debug – display received arguments
    if {$debug == “Y”} {          ;#Debug on?
        echo “$module @xlt_splitflds_debug is >$debug<."     } # #****************************************************************************************************** # Get the SEP argument #   Find the sep argument position if it exists in the inbound list #   If it does not exist, notify the invoker #   If it does exist, find the value of the argument #****************************************************************************************************** #    set sep_ndx [lsearch $xlateInList $splitflds_sep]    if {$sep_ndx == -1} {                     ;# Did we find the argument?        if {$debug == "Y"} {          ;#Debug on?            echo "$module $splitflds_sep not located, proc terminated - NO ACTION TAKEN."        }        xpmerror $xlateId action "$module: Action terminated."     } # # Show the separator argument index     if {$debug == "Y"} {          ;#Debug on?         echo "$module @xlt_splitflds_sep index is >$sep_ndx<."     } # #****************************************************************************************** #* Locate the first element which is NOT an argument #******************************************************************************************    foreach listval $xlateInList {     ;# Step through the xlateInList #    If the list element is one of the arguments #     then bump the list counter      if {[cequal $listval $splitflds_sep] || [cequal $listval $splitflds_debug]} {          incr elem_count 1      } else {                       ;# Found a non-argument element          set elem_ndx $elem_count   ;# set the index for the element          set elem_found 1           ;# set a switch to let everyone else know          if {$debug == "Y"} {       ;# If debug - do da debug dance              echo "$module: First non argument Source element named >$listval< located as element # $elem_count."          }                                  break   ;# Found a non-argument element - stop scanning      }   ;#endelse    }   ;#end foreach       #****************************************************************************************** #* Check to see if we located anything besides our arguments #* If no non-argument elemnts located, #*    - log the event #*    - kill the action #* If an element is located then use that for the substitution #******************************************************************************************    if {!$elem_found} {     ;#No non-argument elements located - Bad News!!        echo "$module: The only elements found in the Source are xlt_splitflds arguments."        echo "$module: Fatal errors occurred while getting arguments (see above)!"        echo "$module:                       NO ACTIVITY PERFORMED!!"        xpmerror $xlateId action "$module: Action terminated."    } else {        set field [lindex $xlateInVals $elem_ndx]    }   ;#endelse #Get the number of Destination fields     set num_flds [llength $xlateOutList] #Get the separator     set sep [lindex $xlateInVals $sep_ndx] #Split the Source field into sub fields based on the separator     set fields_lst [split $field $sep] # # Show the various arguments     if {$debug == "Y"} {          ;#Debug on?         echo "$module @xlt_splitflds_sep value is >$sep<."         echo "$module number of subfields expected (Destination list) value is >$num_flds<."         echo "$module Fields separated are: >$fields_lst<."         echo "$module Source field $listval value is >$field<."    } # #We need to null out the existing xlateOutVals entries in case #   there are less subfields than number of xlateOutVals so the #   COPY action does not erroneously populate xlateOutVals #     if {$debug == "Y"} {          ;#Debug on?         echo "$module -------- Nulling sub fields ---------"         echo "$module   OutVals prior to Null >$xlateOutVals<"         echo "$module   Nulling list elements 0 thru [expr $num_flds - 1]."     }     set xlateOutVals [lreplace $xlateOutVals 0 end ""]     if {$debug == "Y"} {          ;#Debug on?         echo "$module   OutVals after nulling >$xlateOutVals<"         echo "$module ------ End nulling sub fields -------"         echo "$module ------ Start Copying sub fields -------"     }     set field_count 1 #Place the subfields into the Destination fields     foreach sub_field $fields_lst {         if {[expr $field_count > $num_flds]} {
            break
        }
        if {$debug == “Y”} {          ;#Debug on?
            echo “$module Sub field $field_count >$sub_field< copied to [lindex $xlateOutList [expr $field_count - 1]]."         }         xpmstore $xlateId [lindex $xlateOutList [expr $field_count - 1]] c $sub_field         incr field_count 1     }     if {$debug == "Y"} {          ;#Debug on?         echo "$module ------ End Copying sub fields -------"     } }