SMAT History strategies

I am also looking at the SMAT history functionality

######################################################################
# Name: store_trans
# Purpose: Stores the incoming transaction in a MySQL Database
# UPoC type: tps
# Args: tps keyedlist containing the following keys:
#       MODE    run mode (”start”, “run” or “time”)
#       MSGID   message handle
#       ARGS    user-supplied arguments:
#              
#
# Returns: tps disposition list:
#          
#
#####################################
# Modifications
#
# 20100511 – Added a stanza of regsub to replace backslashes with two
#             to get thru the multiple escapes needed to get thru
#             layers of TCL and SQL.
#
# 20100608 – Found that regsub put in on 0511 disturbs the escape removal
#             regsubs.  Some micro messages are corrupted.
#             Moving escape replacement above backslash enhancement corrects
#             the problem.

proc store_trans { args } {
   keylget args MODE mode               ;# Fetch mode

   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
   load /opt/quovadx/qdx5.6/integrator/usercmds/sql.so
       }

       run {
   # ‘run’ mode always has a MSGID; fetch and process it
           keylget args MSGID mh
           set msg [msgget $mh]
           regsub -all {’} $msg “” msg
   # 20100511
           regsub -all {x5c} $msg {\\} msg    
           regsub -all {x7b} $msg {&} msg
           regsub -all {x7d} $msg {&} msg
           regsub -all {x22} $msg {\”} msg
           regsub -all {xc0} $msg {\xc0} msg
           regsub -all {x80} $msg {\x80} msg

           # Send to Venus – Localhost
           set conn [sql connect 127.0.0.1 clem kaddadlehoffer]
           sql selectdb $conn cloverleaf
           #echo [msgget $mh]
           if { [catch {
           sql exec $conn “INSERT INTO translist VALUES (null,’$msg’,0,null,’uhadtordprod’)”
                 } result] } {
               echo ‘Unable to store message $msg on Mercury’
                 }
           sql disconnect $conn

 
           #### We don’t need the message anymore
           #lappend dispList “KILL $mh”
           #### Testing the test code for pathlab – Cont the messages
           lappend dispList “CONTINUE $mh”
       }

       time {
           # Timer-based processing
   # N.B.: there may or may not be a MSGID key in args
       }
       
       shutdown {
   # Doing some clean-up work
}
   }

   return $dispList
}

proc store_outbound_trans { args } {
   keylget args MODE mode               ;# Fetch mode

   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
   load /opt/quovadx/qdx5.6/integrator/usercmds/sql.so
       }

       run {
   # ‘run’ mode always has a MSGID; fetch and process it
           keylget args MSGID mh
           set msg [msgget $mh]
           regsub -all {’} $msg “” msg
   # 20100608 Moved before backslash enhancement.
           regsub -all {\R\} $msg {~} msg ;# Replace HL7 CR escapes with tilde
           regsub -all {\S\} $msg {^} msg ;# Replace HL7 Caret Escapes with Caret
   # 20100511
           regsub -all {x5c} $msg {\\} msg        
           regsub -all {x7b} $msg {&} msg
           regsub -all {x7d} $msg {&} msg
           regsub -all {x22} $msg {\”} msg
           regsub -all {xc0} $msg {\xc0} msg
           regsub -all {x80} $msg {\x80} msg
           #regsub -all {\R\} $msg {~} msg ;# Replace HL7 CR escapes with tilde
           #regsub -all {\S\} $msg {^} msg ;# Replace HL7 Caret Escapes with Caret

           # Send to Venus – Localhost
           set conn [sql connect 127.0.0.1 clem kaddlehoffer]
           sql selectdb $conn cloverleaf
           #echo [msgget $mh]
           if { [catch {
           sql exec $conn “INSERT INTO outtrans VALUES (null,’$msg’,0,null,’sccoutmsg’)”
                 } result] } {
               echo ‘Unable to store message $msg on Mercury’
                 }
           sql disconnect $conn

 
           #### We don’t need the message anymore
           #lappend dispList “KILL $mh”
           #### Testing the test code for pathlab – Cont the messages
           lappend dispList “CONTINUE $mh”
       }

       time {
           # Timer-based processing
   # N.B.: there may or may not be a MSGID key in args
       }
       
       shutdown {
   # Doing some clean-up work
}
   }

   return $dispList
}

CREATE TABLE `transindex` (
 `msgnum` bigint(20) NOT NULL DEFAULT ‘0’,
 `msh03` varchar(100) DEFAULT ”,
 `msh04` varchar(100) DEFAULT ”,
 `msh06` varchar(100) DEFAULT ”,
 `msh07` varchar(100) DEFAULT ”,
 `msh09` varchar(100) DEFAULT ”,
 `pid02` varchar(100) DEFAULT ”,
 `pid03` varchar(100) DEFAULT ”,
 `pid04` varchar(100) DEFAULT ”,
 `pid05` varchar(100) DEFAULT ”,
 `pid07` varchar(100) DEFAULT ”,
 `pid08` varchar(100) DEFAULT ”,
 `pid10` varchar(100) DEFAULT ”,
 `pid18` varchar(100) DEFAULT ”,
 `pid19` varchar(100) DEFAULT ”,
 `pv103` varchar(100) DEFAULT ”,
 `pv107` varchar(100) DEFAULT ”,
 `pv108` varchar(100) DEFAULT ”,
 `pv109` varchar(100) DEFAULT ”,
 `pv117` varchar(100) DEFAULT ”,
 `pv119` varchar(100) DEFAULT ”,
 `in102` varchar(100) DEFAULT ”,
 `in103` varchar(100) DEFAULT ”,
 `in136` varchar(100) DEFAULT ”,
 PRIMARY KEY (`msgnum`),
 KEY `pid10` (`pid10`),
 KEY `msh09` (`msh09`),
 KEY `pv119` (`pv119`),
 KEY `in102` (`in102`),
 KEY `in103` (`in103`),
 KEY `pv103` (`pv103`),
 KEY `in136` (`in136`),
 KEY `pv107` (`pv107`),
 KEY `pid18` (`pid18`),
 KEY `pv108` (`pv108`),
 KEY `pid19` (`pid19`),
 KEY `pv109` (`pv109`),
 KEY `pid02` (`pid02`),
 KEY `pid03` (`pid03`),
 KEY `pid04` (`pid04`),
 KEY `pid05` (`pid05`),
 KEY `pid07` (`pid07`),
 KEY `pid08` (`pid08`),
 KEY `msh03` (`msh03`),
 KEY `msh04` (`msh04`),
 KEY `msh06` (`msh06`),
 KEY `msh07` (`msh07`),
 KEY `pv117` (`pv117`),
 KEY `Name-DOB` (`pid05`,`pid07`)
) ENGINE=InnoDB DEFAULT CHARSET=latin1 ROW_FORMAT=COMPRESSED KEY_BLOCK_SIZE=4

#!/usr/bin/tclsh
#
# ob_moveandindex_nodel.tcl – 20070808 – Terry Kellum
#                          This program moves records from the feeding
#                          system to the data respository system.
#                          Designed for the outbound HL7 transactions, it
#                          does the initial MSH, PID and PV1 indexing,
#                          then generates index/content tables for the
#                          ORCs, OBRs, OBXs and NTEs.
#                      20071204 – Terry Kellum
#                          Script development completed.  Script deployed.
#
#
###############################################################################
# Modifications
###############################################################################
#
#   20081120 – Terry Kellum
#                Modified to product this nodel version that DOES NOT cleanup
#                 old records in the source table.
#
#   20100511 – Terry Kellum
#              Added a regsub line to the replication stanza to duplicate
#              backslashes to preserve their copy to the dest db.
#
#   20101011 – Terry Kellum
#                Modified code to adapt to 64 bit change to mysqltcl binary
#                package.
#
#   20110216 – Terry Kellum
#                Modified to place new DSP segments in the NTE table.
#
#   20110817 – Terry Kellum
#                Modified to prevent enumeration of old records in nodel script.
#
#   20111102 – Terry Kellum
#               CHARON ONLY – Modified to add update of the year tables.
#               Database has been divided to allow quicker access to larger
#               datastores.  The four tables outtrans, outindex, translist and
#               outtrans have been divided into year tables.
#
###############################################################################

########
# Globals
########
global prog_name
global source_conn
global dest_conn

########
# Defines
########

set prog_name “ob_moveandindex_nodel”

# Source
#set source_host 1.2.3.4
# Temp Pluto
set source_host 1.1.1.31
#set source_host 127.0.0.1
set source_db cloverleaf
#set source_db temp
set source_table outtrans
#set source_table outtrans_source

# Dest
set dest_host 127.0.0.1
#set dest_host 127.0.0.1
set dest_db cloverleaf
#set dest_db temp
set dest_trans_table outtrans
#set dest_trans_table outtrans_dest
set dest_index_table outindex
#set dest_index_table outindex_test
set dest_outorc outorc
#set dest_outorc outorc_test
set dest_outobr outobr
#set dest_outobr outobr_test
set dest_outobx outobx
#set dest_outobx outobx_test
set dest_outnte outnte
#set dest_outnte outnte_test

set user clem
set password kaddadlehoffer

# Number of seconds back for cleanup:
# 3369600 = 39 days   604800 = 7 days    259200 = 3 days   172800 = 2 days
#set cleanupage 604800
set cleanupage 864000

#set debug 0
set debug 1

# Set Nodel version
set skipdel 1

#set UpdateYearTables 0
set UpdateYearTables 1

#############
# procedures
#############

proc GetHighKey {conn table} {
 # Gets the highest key in the specified db table
 set fieldlist [GetFields $conn $table]
 set keyfield [lindex $fieldlist 0]
 if {[catch {set hi_list [mysql::sel $conn “select $keyfield from $table order by $keyfield desc limit 1” -list] } errmsg]} {
   puts “**SQL Query Problem in GetHighKey: Table $table”
   puts “**$errmsg”
   return 0
 }
 set high [lindex $hi_list 0]
 return $high
}

proc GetLowKey {conn table} {
 # Gets the highest key in the specified db table
 set fieldlist [GetFields $conn $table]
 set keyfield [lindex $fieldlist 0]
 if {[catch {set lo_list [mysql::sel $conn “select $keyfield from $table order by $keyfield limit 1” -list] } errmsg]} {
   puts “**SQL Query Problem in GetLowKey: Table $table”
   puts “**$errmsg”
   return 0
 }
 set low [lindex $lo_list 0]
 return $low
}

proc getSourceRecord {conn table recno} {
 # Returns a database record from the source system matching the msgnum of recno
 #upvar  source_conn conn
 #upvar  source_table source_table
 if {[catch {set row [mysql::sel $conn “select * from $table where msgnum = $recno” -list] } errmsg]} {
   puts “**Unable to obtain record $recno from Source:”
   puts “**$errmsg”
   return “”
 } else {
   set output [lindex $row 0]
   return $output
 }
}

proc insertDestRecord {conn table row} {
 # Inserts the row into the destination database table

 # Get all the little quoties out.
 set v1 [lindex $row 0]
 set v2 [mysql::escape [lindex $row 1]]
 #set v3 [lindex $row 2]
 set v3 0
 set v4 [lindex $row 3]
 set v5 [lindex $row 4]

 # Changed to use single quotes to prevent interp of slash sequences
 set query “insert into $table values (’$v1′,’$v2′,$v3,’$v4′,’$v5’)”
 if {[catch {mysql::exec $conn $query} errmsg]} {
   puts “**Unable to insert row $v1 on Destination:”
   puts “** $query”
   puts “** Error: $errmsg”
   puts “**Non-critical error.  Continuing…”
 }
}

proc CleanupForExit {} {
 global prog_name source_conn dest_conn
 # Catch a rollback if exists
 catch {mysql::rollback $dconn}

 # cleans up db connections and delete lock file
 ##catch {sql disconnect $sconn}
 ##catch {sql disconnect $dconn}
 catch {mysql::close $source_conn}
 catch {mysql::close $dest_conn}

 # Remove running instance flag
 file delete “/tmp/$prog_name.processing”
}

proc GetQueryResult {conn query} {
 global prog_name
 # Safely submits a query and returns a list of rows
 if {[catch {set out [mysql::sel $conn $query -list ] } errmsg]} {
   # Error running query
   puts “**Error on query:”
   puts “** $query”
   puts “** Error Message:”
   puts “**$errmsg”
   puts “**aborting $prog_name at [clock format [clock seconds]]”
   CleanupForExit
   puts “########################################################”
   exit
 }
 
 set resultlist {}
 foreach row $out {
   set nrow [NormalizeString $row]
   lappend resultlist $nrow
 }
 return $resultlist
}

proc GetSingleQueryResult {conn query} {
 global prog_name
 #### Temp Comment – Watch this one.  Tricky
 # Safely submits a query and returns a list of rows
 if {[catch {set row [mysql::sel $conn $query -list]} errmsg]} {
   # Error running query
   puts “**Error on query:”
   puts “** $query”
   puts “** Error Message:”
   puts “**$errmsg”
   puts “**aborting $prog_name at [clock format [clock seconds]]”
   CleanupForExit
   puts “########################################################”
   exit
 }
 set result [NormalizeString $row]
 return $result
}

proc SubmitSQL {conn statement} {
 global prog_name
 # Safely submits an SQL Statement
 if {[catch {mysql::exec $conn $statement} errmsg]} {
   # Error running Statement
   puts “**Error on Statement:”
   puts “** $statement”
   puts “** Error Message:”
   puts “**$errmsg”
   puts “**aborting $prog_name at [clock format [clock seconds]]”
   CleanupForExit
   puts “########################################################”
   exit
 }
}

proc GetFields {conn table} {
 # Returns the field names in a table
 set query “show columns from $table”
 set fieldrows [GetQueryResult $conn $query]
 foreach row $fieldrows {
   lappend fields [lindex $row 0]
 }
 return $fields
}

proc GenerateNewRecord {conn table} {
 global prog_name
 # Big assumption: The first field is the autoincrementing primary key
 set fieldlist [GetFields $conn $table]
 #puts “$fieldlist”; CleanupForExit; exit;
 set keyfield [lindex $fieldlist 0]
 set highnum [GetHighKey $conn $table]
 set statement “insert into $table values (”
 foreach field $fieldlist {
   append statement “null,”
 }
 set statement [string range $statement 0 [expr [string length $statement] – 2]]
 append statement “)”
 SubmitSQL $conn $statement
 set newrecordkey [GetHighKey $conn $table]
 if {$newrecordkey > $highnum} {
   return $newrecordkey
 } else {
   puts “** Error in GenerateNewRecord: New key is not greater than previous high record number”
   puts “**  Table: $table  Key Field: $keyfield”
   puts “**  Previous High Key: $highnum   Current key $keyfield number: $newrecordkey”
   puts “**aborting $prog_name at [clock format [clock seconds]]”
   CleanupForExit
   puts “########################################################”
   exit
 }
}

proc PopulateORC {conn orctab orcnum msgnum segment fd sfd rep} {
 set worklist “{orc01 1} {orc03 3} {orc04 4} {orc07-1 7 0} {orc07-4 7 3} {orc07-6 7 5} {orc09 9} {orc12-1 12 0} {orc12-2 12 1} {orc12-3 12 2} {orc12-4 12 3} {orc12-8 12 7}”
 ParseSegIntoTable $conn $orctab orcnum $orcnum $worklist $segment $fd $sfd $rep
 set query “update $orctab set msgnum = $msgnum where orcnum = $orcnum”
 SubmitSQL $conn $query
}

proc PopulateOBR {conn obrtab obrnum parentorc msgnum segment fd sfd rep} {
 set worklist “{obr02 2} {obr03 3} {obr04-1 4 0} {obr04-2 4 1} {obr04-4 4 3} {obr07 7} {obr10-1 10 0} {obr10-2 10 1} {obr10-3 10 2} {obr14 14} {obr15-2 15 1} {obr15-4 15 3} {obr16-1 16 0} {obr16-2 16 1} {obr16-3 16 2} {obr16-4 16 3} {obr16-8 16 7} {obr22 22} {obr25-1 25 0} {obr25-2 25 1} {obr27-1 27 0} {obr27-4 27 3} {obr27-6 27 5} {obr28a-1 28 0 0} {obr28b-1 28 0 1} {obr28c-1 28 0 2}”  
 ParseSegIntoTable $conn $obrtab obrnum $obrnum $worklist $segment $fd $sfd $rep
 set query “update $obrtab set msgnum = $msgnum where obrnum = $obrnum”
 SubmitSQL $conn $query
 set query “update $obrtab set orcnum = ‘$parentorc’ where obrnum = $obrnum”
 SubmitSQL $conn $query
}

proc PopulateOBX {conn obxtab obxnum parentobr msgnum segment fd sfd rep } {
 set worklist “{obx01 1} {obx02 2} {obx03-1 3 0} {obx03-2 3 1} {obx03-4 3 3} {obx03-5 3 4} {obx05 5} {obx06 6} {obx07 7} {obx08 8} {obx11 11} {obx14 14} {obx15 15} {obx16 16} {obx17 17}”
 ParseSegIntoTable $conn $obxtab obxnum $obxnum $worklist $segment $fd $sfd $rep
 set query “update $obxtab set msgnum = $msgnum where obxnum = $obxnum”
 SubmitSQL $conn $query
 set query “update $obxtab set obrnum = ‘$parentobr’ where obxnum = $obxnum”
 SubmitSQL $conn $query
}

proc PopulateNTE {conn ntetab ntenum parentobr parentobx msgnum segment fd sfd rep lastseg} {
 set worklist “{nte01 1} {nte03 3}”
 ParseSegIntoTable $conn $ntetab ntenum $ntenum $worklist $segment $fd $sfd $rep
 set query “update $ntetab set msgnum = $msgnum where ntenum = $ntenum”
 SubmitSQL $conn $query
 if {[string equal $lastseg  OBR]} {
   set query “update $ntetab set obrnum = ‘$parentobr’ where ntenum = $ntenum”
   SubmitSQL $conn $query
 }
 if {[string equal $lastseg OBX]} {
   set query “update $ntetab set obxnum = ‘$parentobx’ where ntenum = $ntenum”
   SubmitSQL $conn $query
 }
}

proc PopulateDSP {conn ntetab ntenum parentobr parentobx msgnum segment fd sfd rep lastseg} {
 set worklist “{nte01 1} {nte03 3}”
 ParseSegIntoTable $conn $ntetab ntenum $ntenum $worklist $segment $fd $sfd $rep
 set query “update $ntetab set msgnum = $msgnum where ntenum = $ntenum”
 SubmitSQL $conn $query
 if {[string equal $lastseg  OBR]} {
   set query “update $ntetab set obrnum = ‘$parentobr’ where ntenum = $ntenum”
   SubmitSQL $conn $query
 }
 if {[string equal $lastseg OBX]} {
   set query “update $ntetab set obxnum = ‘$parentobx’ where ntenum = $ntenum”
   SubmitSQL $conn $query
 }
}

proc ParseSegIntoTable {conn table keyname key worklist segment fd sfd rep} {
 # Process thru the work list
 foreach item $worklist {
   # Get db field
   set dbfield [lindex $item 0]
   if {[llength $item] == 2} {
     # Simple Single Field
     set data [lindex [split $segment $fd] [lindex $item 1]]
     catch {set data [mysql::escape $data]}
     #set query “update $table set $dbfield = ‘$data’ where $keyname = $key”
     set query “update $table set $dbfield = ‘$data’ where $keyname = $key”      
     SubmitSQL $conn $query
     continue
   }
   if {[llength $item] == 3} {
     # Extract Sub Field
     set data [lindex [split [lindex [split $segment $fd] [lindex $item 1]] $sfd] [lindex $item 2]]
     catch {set data [mysql::escape $data]}
     set query “update $table set `$dbfield` = ‘$data’ where $keyname = $key”
     SubmitSQL $conn $query
     continue
   }
   if {[llength $item] == 4} {
     # Extract a Rep
     set data [lindex [split [lindex [split [lindex [split $segment $fd] [lindex $item 1]] $rep] [lindex $item 3]] $sfd] [lindex $item 2]]
     catch {set data [mysql::escape $data]}
     set query “update $table set `$dbfield` = ‘$data’ where $keyname = $key”
     SubmitSQL $conn $query
     continue
   }
   puts “** Workist item not 2 or 3 long”
 }
}

proc NormalizeString {string} {
   # running into trouble where strings are listified and have
   # embedded meta characters.  Routine checks a transaction for
   # “listification” (llength = 1) and de-listfies.
   # Metacharacters are also removed.
   
   # Get rid of curlys
   regsub -all {x7b} $string {} string ;# Remove Open Curly
   regsub -all {x7d} $string {} string ;# Remove Close Curly
   # Backslash…
   regsub -all {x5c} $string {/} string ;# Sub forward slash for Backslash
   #   Escape the quotes
   regsub -all {x22} $string {\”} string ;# Escape Double quote
   regsub -all {x27} $string {\’} string ;# Escape single quote
   #catch {set string [mysql::escape $string]}
   # Send it back
   return $string
}

proc DelistifyString {string} {
   if {[llength $string] == 1} {
       # String is listified.
       #set string [lindex $string 0]
       set string [join $string]
   }
   # Check for a list.  2 levels gripe.
   set slen [llength $string]
   if {$slen == 1} {
       # String still list – gripe & break
       puts “**  Error processing string for delistification.”
       puts “** String: $string”
       puts “**aborting ob_moveandindex at [clock format [clock seconds]]”
       CleanupForExit
       puts “########################################################”
       exit
   }
   # String is delistified.
   return $string
}    

##############################################################
# Main code
puts “########################################################”
puts “$prog_name.tcl started at [clock format [clock seconds]]”

# Setup running instance checking.
if {[file exists “/tmp/$prog_name.processing”] == 1} {
 # Another instance is running?
 puts “*** Another instance of $prog_name is running – Aborting run.”
 puts “**aborting $prog_name at [clock format [clock seconds]]”
 puts “########################################################”
 exit
}
exec touch “/tmp/$prog_name.processing”

package require mysqltcl

# Connect to Destination DB
if {$debug == 1} { puts “Connecting to Destination DB” }
if {[catch {set dest_conn [mysql::connect -host $dest_host -user $user -password $password -db $dest_db]} errmsg]} {
 # Error on destination connect
 puts “**Error on Destination Connect: host $dest_host”
 puts “**$errmsg”
 puts “**aborting $prog_name at [clock format [clock seconds]]”
 CleanupForExit
 puts “########################################################”
 exit
}

# Connect to Source DB
if {$debug == 1} { puts “Connecting to Source DB” }
if {[catch {set source_conn [mysql::connect -host $source_host -user $user -password $password -db $source_db]} errmsg]} {
 # Error on source connect
 puts “**Error on Source Connect: host $source_host”
 puts “**$errmsg”
 puts “**aborting ob_moveandindex at [clock format [clock seconds]]”
 CleanupForExit
 puts “########################################################”
 exit
}

# get low and high record numbers for tables
if {$debug == 1} { puts “Getting message numbers” }
set sourcelow [GetLowKey $source_conn $source_table]
set sourcehigh [GetHighKey $source_conn $source_table]
set desthigh [GetHighKey $dest_conn $dest_trans_table]

puts “Source ($source_host) database message numbers run from $sourcelow to $sourcehigh.”
puts “Destination ($dest_host) high msgnum is $desthigh.”

# Check for zero or alpha in bounds numbers. This indicates an SQL error
#  in the functions.  Die if we have been handed one.
if {$sourcelow == 0 || $sourcehigh == 0 || $desthigh == 0 ||
      ![string is integer $sourcelow] || ![string is integer $sourcehigh] ||
      ![string is integer $desthigh] } {
 # We have been given the poison pill.  I’d have taken the RED one…
 puts “**SQL problem detected in message numbers. Aborting run.”
 puts “**aborting $prog_name at [clock format [clock seconds]]”
 CleanupForExit
 puts “########################################################”
 exit
}

while {$desthigh 0} {
 set NumRecs [lindex $argv 0]
} else {
 #set NumRecs 4000
  set NumRecs 5000
}

puts “Processing a max of $NumRecs records.”

# Get the unindexed record msgnums
set query “select msgnum from $dest_trans_table where processed = 0 order by msgnum limit $NumRecs”
set msglist [GetQueryResult $dest_conn $query]

puts “There are [llength $msglist] messages to process.”

# Turn off autocommit
catch {mysql::autocommit $dest_conn 0}

# Do the Initial Indexing
foreach msgnum $msglist {
 set query “select msg from $dest_trans_table where msgnum = $msgnum”
 set msg [GetSingleQueryResult $dest_conn $query]
 set seglist [split $msg r]
 set mshstr [lindex $seglist 0]
 set fd [string range $mshstr 3 3]
 set sfd [string range $mshstr 4 4]
 set msh [lindex $seglist 0]

 # Create a segment index for speed!
 set segindex {}
 foreach segment $seglist {
   lappend segindex [string range $segment 0 2]
 }
 # create a work list – Segment tag, index to field, sql field name
 set worklist { {MSH 2 msh03} {MSH 3 msh04} {MSH 5 msh06} {MSH 6 msh07} {MSH 8 msh09} {PID 2 pid02} {PID 3 pid03} {PID 4 pid04} {PID 5 pid05} {PID 7 pid07} {PID 8 pid08} {PID 10 pid10} {PID 18 pid18} {PID 19 pid19} {PV1 3 pv103} {PV1 7 pv107} {PV1 8 pv108} {PV1 9 pv109} {PV1 17 pv117} {PV1 19 pv119} }

 # Autocommit is off – No need to start a transaction.
 #### Start a transaction
 ###if {[catch {sql exec $dest_conn “START TRANSACTION”} errmsg]} {
 ###  # Cannot establish transaction lock – Abort
 ###  puts “** Unable to lock transaction (START TRANSACTION)”
 ###  puts “** $errmsg”
 ###  puts “**aborting ob_moveandindex at [clock format [clock seconds]]”
 ###  CleanupForExit
 ###  puts “########################################################”
 ###  exit  
 ###}
 if {[catch {mysql::exec $dest_conn “insert into $dest_index_table values ($msgnum,”,”,”,”,”,”,”,”,”,”,”,”,”,”,”,”,”,”,”,”,0)”} errmsg]} {
   # Unable to insert blank record
   catch {mysql::rollback $dest_conn}
   puts “** Unable to insert blank record into $dest_index_table : $msgnum”
   puts “** $errmsg”
   puts “**aborting $prog_name at [clock format [clock seconds]]”
   CleanupForExit
   puts “########################################################”
   exit      
 }

 # create the output record updates – Value the fields
 set querystart “update $dest_index_table set ”
 set queryend “where msgnum = $msgnum”
 for {set i 0} {$i (select msgnum from $table_$year order by msgnum desc limit 1) order by msgnum;”
     #if {$debug} {puts “Query set to:  $queryn”}
     puts “Processing table: $table_$year …”
     if {[catch {set resmsg [GetQueryResult $dest_conn $query]} errmsg]} {
       puts “n** Unable to complete query: $query”
       puts “** Error is:  $errmsg”
       puts “** Noncritical Error – Continuing”
     }
     #if {$debug} {puts “Query Result: $resmsgn”}
     puts “…….. Completed.”
   } else {
     # Year table not found – Create and Initialize the table from the proto.
     set table_proto “$tablex5fproto”
     puts “Year Table: $table_$year not found in list of tables.  Creating.”
     set query “create table if not exists $table_$year like $table_proto;”
     if {$debug} {puts “Create Table Query: $query”}
     if {[catch {set resmsg [GetQueryResult $dest_conn $query]} errmsg]} {
       puts “** Unable to create needed table $table_$year”
       puts “** Error is: $errmsg”
       puts “** Critical Error – Aborting $prog_name at [clock format [clock seconds]]”
       CleanupForExit $source_conn $dest_conn $prog_name
       puts “#########################################################################”
       exit
     }
     # Query executed successfully – Initialize Table
     ## Get last recordnumber for previous year – assuming last record
     set query “select msgnum from $table_[expr $year – 1] order by msgnum desc limit 1”
     if {[catch {set LastRecordList [GetQueryResult $dest_conn $query]} errmsg]} {
       puts “** Unable to get last record number from table $table_[expr $year – 1]”
       puts “** Error is: $errmsg”
       puts “** Critical Error – Blindly renaming table”
       puts “[GetQueryResult $dest_conn {rename table $table_$year to $table_$yearx5fERR}]”
       CleanupForExit $source_conn $dest_conn $prog_name
       puts “#########################################################################”
       exit
     }
     set LastRecord [lindex $LastRecordList 0]
     # Check to insure that we have a good last record number.
     if {$LastRecord ne “” && $LastRecord > 0} {
       # Good LastRecord Number
       #if {$debug} {puts “Last Record Number: $LastRecord”}
       puts “Initializing table $table_$year with last record number of $LastRecord.”
       set query “insert into $table_$year set msgnum = ‘$LastRecord’;”
       #if {$debug} {puts “Query: $query”}
       if {[catch {mysql::exec $dest_conn $query} errmsg]} {
         puts “** Unable to create table: $table_$year .”
         puts “** Query: $query”
         puts “** Err Message:  $errmsg”
         puts “** Non-critical error.  Continuing.”
       }
     } else {
       # Bad LastRecord Number
       puts “** Unable to get valid last record number from query:”
       puts “** $query”
       puts “** Renaming table:  $table_$year”
       catch [set numrecs [mysql::sel $dest_conn “select count(*) from $table_year” -flatlist]] errmsg
       set numrec [lindex $numrecs 0]
       if {$numrecs < 2} {
         # tiny table – drop
         puts "** Blindly renaming table: $table_$year"
         catch {mysql::exec $dest_conn "rename table $table_$year to $table_$year[clock seconds]"} errmsg
         puts "** Result: $errmsg"
       } else {
         # Table contains more than 2 records.  We need to give up.
         #  We should not be here unless things are really strange.
         puts "*** Critical error – Newly created table apparently has multiple records."
         puts "***  This is a highly unusual situation."
         puts "***  There is no action taken – Continuing"
       }
     }
   }
 }
}

CleanupForExit
puts "$prog_name ending at [clock format [clock seconds]]"
puts "########################################################"
# done.