# sched - A program to track personal schedule of events including budget.
# Rick Smereka, Copyright (C) 2008.

# This program is free software; you can redistribute it and/or modify
# it under the terms of the GNU General Public License as published by
# the Free Software Foundation; either version 2 of the License, or
# (at your option) any later version.

# This program is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
# GNU General Public License for more details.

# You should have received a copy of the GNU General Public License
# along with this program; if not, get a copy via the Internet at
# http://gnu.org/copyleft/gpl.html or write to the Free Software
# Foundation, Inc., 59 Temple Place, Suite 330, Boston,
# MA 02111-1307 USA

# You can contact the author via email at rsmereka@future-lab.com

# This program will store and calculate your schedule of events.
# Events include budgetary and reminder's. Events are tracked on
# a day to day basis. This program makes it possible to see your
# bank account balance for every day there is an event.

# All data is stored in 'bbuuzzb' tables. Each table is a year's
# worth of data and this program allow you to see the data one
# month at a time.

# As yearend approaches, you need to manually create next year's
# 'bbuuzzb' table. The table names have the convention of
# 'schedule.nnnn' where 'nnnn' is the year.

# Each time monthly events are listed, they will be displayed in
# the following form:

#    c:mmdd.s desc,cat,pl,plb,act,actp

# Where the 'c' is an list event count, 'mmdd' are the month and day
# of the event, 's' is the day sequence count (since there may be
# more than one event per day), 'des' is the event description,
# 'cat' is the event category (see below), 'pl' is the planned
# amount, 'plb' is the current planned balance, 'act' is the
# actual amount spent and 'actp' is the current actual account
# balance. The balances are as at after the event has taken
# place.

# This program depends on a category table which you need to set
# up. Every event will belong to one of these categories. The
# name of the category table must be 'schedule.category'.
# The field layout of this category table is as follows:

#    1. category number (sequential count)
#    2. category description
#    3. category type (see below)

# Each category entry has a type which tells this program
# what to do with all the events that belong to this
# category. Here are the event types:

#    1 credit
#    2 debit
#    3 na (reminder)

# You must use the category type number in field 3 of the
# category record (see above).

# This program also uses its own temporary table called
# 'schedule.tmp'. Ths table must also already exist.

# Initial Tcl version, Mar/2008, Rick Smereka

# required path to library modules
set TCLDIR /gpl/tcl

source $TCLDIR/lib/stdhead.tcl
source $TCLDIR/lib/comcode.tcl
source $TCLDIR/lib/appinit.tcl
const MULTIUSER 0
source $TCLDIR/dbeng/dbmess.tcl
source $TCLDIR/dbeng/dbiocode.tcl
source $TCLDIR/dbeng/dbeng.tcl
source $TCLDIR/dbeng/dbengcfg.tcl
source $TCLDIR/dbeng/dbengcat.tcl
source $TCLDIR/dbeng/dbfxp.tcl
source $TCLDIR/dbeng/dbengsrt.tcl
source $TCLDIR/dbeng/dbcomm.tcl

const APNAME "sched"
const VERSION "1.03.01-2008.03.24"
const SCHED_NAME "schedule"
const SCHED_CAT_NAME "schedule.category"
const SCHED_TMP_NAME "schedule.tmp"
const DEBUG 0
const DEBUG_DEST "/work/logs/$APNAME.log"

# schedule table field definitions
# date field is in the form mmdd.seq
const SCHED_FIELD_DATE 1
const SCHED_FIELD_DESC 2
const SCHED_FIELD_CAT 3
const SCHED_FIELD_PLANNED 4
const SCHED_FIELD_ACTUAL 5
const SCHED_FIELD_PLANNED_BAL 6
const SCHED_FIELD_ACTUAL_BAL 7

# schedule tmp table field definitions
const SCHED_TMP_FIELD_DATE 1
const SCHED_TMP_FIELD_PLANNED_BAL 2
const SCHED_TMP_FIELD_ACTUAL_BAL 3

# schedule category table field definitions
const CAT_FIELD_NUM 1
const CAT_FIELD_DESC 2
const CAT_FIELD_TYPE 3

# category table counter record value
const CAT_COUNT_REC "count"

# category table type field values
const CAT_TYPE_CREDIT 1
const CAT_TYPE_DEBIT 2
const CAT_TYPE_NA 0

# fxp scale to all dollar amounts
const SCHED_FXP_SCALE 2

# filters for 'get_sched'
const SCHED_FILTER_ALL 0
const SCHED_FILTER_BUDGET 1
const SCHED_FILTER_OTHER 2

# global data
set year_num 0
set month_num 0
set sched_tid 0 
set sched_cat_tid 0
set sched_changed 0 
set sched_cat_changed 0

# currently displayed event list (field 1 is stored)
set event_list ""

proc get_date {} {
   # Load globals with the current year and month.
   global year_num month_num

   set tmp [get_time]
   set year_num [string range $tmp 0 3]
   set month_num [string range $tmp 4 5]
}

proc c_initialize {} {
   # Start the 'dbeng' local engine, read the config file and
   # display the result settings. Returns 1 upon success, 0
   # otherwise.
   global DBENG_OK DBENG_CONFIG_UNABLE_TO_OPEN
   set mname "c_initialize"

   set ret [db_initialize]

   # interpret code from init which may be a
   # fatal config error
   switch $ret \
      $DBENG_OK {puts "$mname:read config file successfully"} \
      $DBENG_CONFIG_UNABLE_TO_OPEN \
                {puts "$mname:config file not found,loaded defaults"} \
      default {puts "$mname:fatal config error([db_io_code_string $ret])"; \
               puts "$mname:terminating";return 0}

   db_config_get_tmp_path mes
   puts "$mname:tmp path is '$mes'"
   db_config_get_log mes
   puts "$mname:log is '$mes'"
   set ret [db_config_get_catalog mes]

   if {$ret == $DBENG_OK} {
      puts "$mname:catalog is '$mes'"
   } else {
      puts "$mname:catalog name not loaded"
   }

   db_config_get_catalog_flag flag

   if {[flag_2_logic_string $flag mes]} {
      puts "$mname:catalog is $mes"
   }

   return 1
}

proc open_tables {} {
   # Open application tables. Returns 1 upon success, 0 otherwise.
   global SCHED_NAME DBENG_OK SCHED_CAT_NAME sched_changed
   global sched_cat_changed year_num sched_tid sched_cat_tid
   set mname "open_tables"

   set table "$SCHED_NAME.$year_num"

   if {[set ret [db_open $table sched_tid]] != $DBENG_OK} {
      puts "$mname:open of $table failed([db_io_code_string $ret])"
      return 0
   }

   if {[set ret [db_open $SCHED_CAT_NAME sched_cat_tid]] != $DBENG_OK} {
      puts "$mname:open of $SCHED_CAT_NAME failed([db_io_code_string $ret])"
      db_close $sched_tid
      return 0
   }

   set sched_changed 0
   set sched_cat_changed 0
   return 1
}

proc main_menu {} {
   # Display main menu, get a choice and dispatch. Returns 0 normally,
   # 1 on exit request.
   global event_list year_num month_num SCHED_FILTER_ALL
   set mname "main_menu"

   # if event list is not empty, empty it
   if {$event_list != ""} {
      set event_list ""
   }

   puts [format "using date %s/%02d" $year_num $month_num]
   puts "1. change current date(yyyymm)"
   puts "2. add new events"
   puts "3. modify existing events"
   puts "4. summarize month"
   puts "5. add categories"
   puts "6. display events"
   puts "7. delete events"
   puts "8. copy month"
   puts "9. exit program"
   set choice [get_input "9"]

   switch -- [string index $choice 0] {
      1 {
         # change date
         change_date

         # when the date changes, close and re-open table
         close_tables

         if {![open_tables]} {
            puts "reverting to current year and month"
            get_date
            open_tables
         }
      }

      2 {
         add_events
      }
  
      3 {
         modify_events
      }

      4 {
         summarize_month
      }

      5 {
         add_category
      }

      6 {
         display_events $SCHED_FILTER_ALL
      }

      7 {
         delete_events
      }

      8 {
         copy_month
      }

      9 {
         puts "exit requested"
         return 1
      }

      default {
         puts "unknown menu option"
      }
   }

   return 0
}

proc change_date {} {
   # Change year and/or month.
   global year_num month_num

   puts -nonewline "year"
   set buf $year_num
   set value [get_input $buf]

   if {$value == $buf} {
      puts "year not changed"
   } else {
      if {![num $value]} {
         puts "year is not a number"
         return
      }

      set year_num $value
   }

   set buf $month_num
   puts -nonewline "month"
   set value [get_input $buf]

   if {$value == $buf} {
      puts "month not changed"
   } else {
      if {![num $value]} {
         puts "month is not a number"
         return
      }

      set month_num $value
   }
}

proc get_input {def} {
   # Get keyboard input. The 'def' will apply if the user simply
   # presses enter. Proc will call 'term_app' if the user types
   # 'end'. Proc returns the line that the user typed.
   set buf ""

   puts -nonewline "($def, 'end' to quit)>"
   set buf [get_rec stdin]

   if {[ucase $buf] == "END"} {
      puts "exit requested"
      term_app
      exit
   }

   if {![string length $buf]} {
      return $def
   }

   return $buf
}

proc add_category {} {
   # Add category records.
   global CAT_TYPE_CREDIT CAT_TYPE_DEBIT CAT_TYPE_NA CAT_FIELD_NUM
   global sched_cat_changed sched_cat_tid DBENG_OK CAT_FIELD_DESC
   global CAT_FIELD_TYPE
   set mname "add_category"

   while {1} {
      if {![display_categories]} {
         return
      }

      puts -nonewline "description or 'q' to quit adding"
      set buf [get_input "q"]

      if {![string compare -nocase $buf "Q"]} {
         return
      }

      set desc $buf
      set ret 0

      while {!$ret} {
         puts -nonewline \
            "calc type('d'ebit,'c'redit,'n'a) or 'q' to quit adding"
         set buf [get_input "q"]

         if {![string compare -nocase $buf "Q"]} {
            return
         }

         switch [string toupper [string range $buf 0 0]] {
            C {
               set type_int $CAT_TYPE_CREDIT
               set ret 1
            }

            D {
               set type_int $CAT_TYPE_DEBIT
               set ret 1
            }

            N {
               set type_int $CAT_TYPE_NA
               set ret 1
            }

            default {
               puts "$mname:invalid calc type"
            }
         }
      }

      if {[set cat_id [get_category_count]] == 0} {
         return
      }
            
      if {[set ret [db_put_field $sched_cat_tid $CAT_FIELD_NUM $cat_id]] \
          != $DBENG_OK} {
         puts "$mname:error putting category id([db_io_code_string $ret])"
         return
      }

      if {[set ret [db_put_field $sched_cat_tid $CAT_FIELD_DESC $desc]] \
          != $DBENG_OK} {
         puts "$mname:error putting category description(\
               [db_io_code_string $ret])"
         return
      }

      if {[set ret [db_put_field $sched_cat_tid $CAT_FIELD_TYPE $type_int]] \
          != $DBENG_OK} {
         puts "$mname:error putting category calc type(\
               [db_io_code_string $ret])"
         return
      }

      if {[set ret [db_write $sched_cat_tid]] != $DBENG_OK} {
         puts "$mname:error writing category record(db_io_code_string $ret])"
         return
      }

      set sched_cat_changed 1
   }
}

proc add_events {} {
   # Add event records.
   global SCHED_FILTER_ALL year_num month_num CAT_TYPE_CREDIT CAT_TYPE_DEBIT
   global sched_tid DBENG_OK SCHED_FIELD_DATE SCHED_FIELD_DESC
   global SCHED_FIELD_CAT SCHED_FIELD_PLANNED SCHED_FXP_SCALE
   global SCHED_FIELD_ACTUAL sched_changed
   set mname "add_events"

   while {1} {
      if {![display_events $SCHED_FILTER_ALL]} {
         return
      }

      while {1} {
         puts -nonewline "day of month or 'q' to quit adding"
         set buf [get_input "q"]
        
         if {![string compare -nocase $buf "Q"]} {
            return
         }

         if {![num $buf]} {
            puts "$mname:day of month not numeric"
            continue
         }

         set ret $buf
         set modays [days_in_month $year_num $month_num]

         if {$ret <= 0} {
            puts "$mname:out of range day"
            continue
         }

         if {$ret > $modays} {
            puts "$mname:out of range day"
            continue
         }

         set seq [get_next_seq $ret]
         set date [format "%02d%02d.%d" $month_num $ret $seq]
         break
      }

      puts -nonewline "description or 'q' to quit adding"
      set buf [get_input "q"]

      if {![string compare -nocase $buf "Q"]} {
         return
      }

      set desc $buf

      if {![get_event_category "q" cat_id]} {
         return
      }

      # if category type is budget, get planned and actual amounts
      if {![xref_category $cat_id type_int]} {
         return
      }

      if {$type_int == $CAT_TYPE_CREDIT || $type_int == $CAT_TYPE_DEBIT} {
         if {![get_event_aplanned "planned" "q" planned]} {
            return
         }

         if {![get_event_aplanned "actual" "q" actual]} {
            return
         }
      }

      if {[set ret [db_new $sched_tid]] != $DBENG_OK} {
         puts "$mname:error([db_io_code_string $ret]) setting up new\
               event record"
         return
      }

      if {[set ret [db_put_field $sched_tid $SCHED_FIELD_DATE $date]] != \
          $DBENG_OK} {
         puts "$mname:error putting event date([db_io_code_string $ret])"
         return
      }
                 
      if {[set ret [db_put_field $sched_tid $SCHED_FIELD_DESC $desc]] != \
          $DBENG_OK} {
         puts "$mname:error putting event desc([db_io_code_string $ret])"
         return
      }

      if {[set ret [db_put_field $sched_tid $SCHED_FIELD_CAT $cat_id]] != \
          $DBENG_OK} {
         puts "$mname:error putting event category([db_io_code_string $ret])"
         return
      }

      if {$type_int == $CAT_TYPE_CREDIT || $type_int == $CAT_TYPE_DEBIT} {
         if {[set result [fxp_iconv $planned]] == ""} {
            puts "$mname:error converting planned value to fxp"
            return
         }

         if {[set ret [dbfxp_put $sched_tid $SCHED_FIELD_PLANNED \
             $SCHED_FXP_SCALE $result]] != $DBENG_OK} {
            puts "$mname:error putting event planned amount(\
                  [db_io_code_string $ret])"
            return
         }

         if {[set result [fxp_iconv $actual]] == ""} {
            puts "$mname:error converting actual value to fxp"
            return
         }

         if {[set ret [dbfxp_put $sched_tid $SCHED_FIELD_ACTUAL \
             $SCHED_FXP_SCALE $result]] != $DBENG_OK} {
            puts "$mname:error putting event actual amount(\
                  [db_io_code_string $ret])"
            return
         }
      }

      if {[set ret [db_write $sched_tid]] != $DBENG_OK} {
         puts "$mname:error writing event record([db_io_code_string $ret])"
         return
      }

      set sched_changed 1
   }
}

proc modify_events {} {
   # Modify event records.
   global SCHED_FILTER_ALL sched_tid DBENG_OK SCHED_FIELD_DATE
   global year_num month_num sched_changed SCHED_FIELD_DESC SCHED_FIELD_CAT
   global CAT_TYPE_NA SCHED_FIELD_PLANNED SCHED_FXP_SCALE SCHED_FIELD_ACTUAL
   set mname "modify_events"
   set record_changed 0

   while {1} {
      if {![display_events $SCHED_FILTER_ALL]} {
         return
      }

      while {1} {
         puts -nonewline "event number or 'q' to quit modifying"
         set buf [get_input "q"]

         if {![string compare -nocase $buf "Q"]} {
            return
         }

         if {![num $buf]} {
            puts "$mname:event number not numeric"
            continue
         }

         if {[set the_event [ll_locate $buf]] == ""} {
            puts "$mname:no such event"
            continue
         }

         if {[set ret [db_top $sched_tid]] != $DBENG_OK} {
            puts "$mname:error going to top of schedule table(\
                  [db_io_code_string $ret])"
            return
         }

         # locate the event record in the schedule table
         if {[set ret [db_find_field $sched_tid 0 $the_event\
             $SCHED_FIELD_DATE]] != $DBENG_OK} {
            puts "$mname:error locating event record(\
                  [db_io_code_string $ret])"
            return
         }

         break
      }

      while {1} {
         puts -nonewline "day of month"
         set date [string range $the_event 2 3]
         set buf [get_input $date]

         if {[string compare $date $buf]} {
            if {![num $buf]} {
               puts "$mname:day of month not numeric"
               continue
            }

            set ret $buf
            set modays [days_in_month $year_num $month_num]

            if {$ret <= 0} {
               puts "$mname:out of range day"
               continue
            }

            if {$ret > $modays} {
               puts "$mname:out of range day"
               continue
            }

            set seq [get_next_seq $ret]
            set date [format "%02d%02d.%d" $month_num $ret $seq]

            if {[set ret [db_put_field $sched_tid $SCHED_FIELD_DATE \
                $date]] != $DBENG_OK} {
               puts "$mname:error putting date field into record(\
                     [db_io_code_string $ret])"
               return
            }

            set record_changed 1
            break
         } else {
            break
         }
      }

      puts -nonewline "description"

      if {[set ret [db_get_field $sched_tid $SCHED_FIELD_DESC desc]] != \
          $DBENG_OK} {
         puts "$mname:error getting desc([db_io_code_string $ret])"
         return
      }

      set buf [get_input $desc]

      if {$buf != $desc} {
         if {[set ret [db_put_field $sched_tid $SCHED_FIELD_DESC $buf]] != \
             $DBENG_OK} {
            puts "$mname:error putting desc field into record(\
                  [db_io_code_string $ret])"
            return
         }

         set record_changed 1
      }

      if {[set ret [db_get_field $sched_tid $SCHED_FIELD_CAT cat_id]] != \
          $DBENG_OK} {
         puts "$mname:error getting category([db_io_code_string $ret])"
         return
      }

      if {![get_event_category $cat_id buf]} {
         return
      }

      if {![xref_category $cat_id cat_typ]} {
         puts "$mname:error getting category type"
         return
      }

      if {$buf != $cat_id} {
         if {[set ret [db_put_field $sched_tid $SCHED_FIELD_CAT $buf]] != \
             $DBENG_OK} {
            puts "$mname:error putting category field into record(\
                  [db_io_code_string $ret])"
            return
         }

         set record_changed 1
      }

      if {$cat_typ != $CAT_TYPE_NA} {
         if {[set ret [dbfxp_get $sched_tid $SCHED_FIELD_PLANNED \
             $SCHED_FXP_SCALE result]] != $DBENG_OK} {
            puts "$mname:error getting planned field([db_io_code_string])\
                  ($date)"
            return
         }

         if {![fxp_oconv $result $SCHED_FXP_SCALE planned]} {
            puts "$mname:error converting planned field($date)"
            return
         }

         if {![get_event_aplanned "planned" $planned buf]} {
            return
         }

         if {$buf != $planned} {
            if {[set result [fxp_iconv $buf]] == ""} {
               puts "$mname:error converting planned value to fxp"
               return
            }

            if {[set ret [dbfxp_put $sched_tid $SCHED_FIELD_PLANNED \
                $SCHED_FXP_SCALE $result]] != $DBENG_OK} {
               puts "$mname:error putting event planned amount(\
                     [db_io_code_string])"
               return
            }

            set record_changed 1
         }

         if {[set ret [dbfxp_get $sched_tid $SCHED_FIELD_ACTUAL \
             $SCHED_FXP_SCALE result]] != $DBENG_OK} {
            puts "$mname:error getting actual field([db_io_code_string])\
                  ($date)"
            return
         }

         if {![fxp_oconv $result $SCHED_FXP_SCALE actual]} {
            puts "$mname:error converting actual field($date)"
            return
         }

         if {![get_event_aplanned "actual" $actual buf]} {
            return
         }

         if {$buf != $actual} {
            if {[set result [fxp_iconv $buf]] == ""} {
               puts "$mname:error converting actual value to fxp"
               return
            }

            if {[set ret [dbfxp_put $sched_tid $SCHED_FIELD_ACTUAL \
                $SCHED_FXP_SCALE $result]] != $DBENG_OK} {
               puts "$mname:error putting event actual amount(\
                     [db_io_code_string])"
               return
            }

            set record_changed 1
         }
      }

      if {$record_changed} {
         if {[set ret [db_write $sched_tid]] != $DBENG_OK} {
            puts "$mname:error writing event record(db_io_code_string $ret])"
            return
         }

         set sched_changed 1
      }
   }
}

proc delete_events {} {
   # Delete event records.
   global SCHED_FILTER_ALL sched_tid DBENG_OK SCHED_FIELD_DATE sched_changed
   set mname "delete_events"

   while {1} {
      if {![display_events $SCHED_FILTER_ALL]} {
         return
      }

      while {1} {
         puts -nonewline "event number or 'q' to quit deleting"
         set buf [get_input "q"]

         if {![string compare -nocase $buf "Q"]} {
            return
         }

         if {![num $buf]} {
            puts "$mname:event number is not numeric"
            continue
         }

         if {[set the_event [ll_locate $buf]] == ""} {
            puts "$mname:no such event"
            continue
         }

         if {[set ret [db_top $sched_tid]] != $DBENG_OK} {
            puts "$mname:error going to top of table([db_io_code_string $ret])"
            return
         }

         # locate the event record in the schedule table
         if {[set ret [db_find_field $sched_tid 0 $the_event\
             $SCHED_FIELD_DATE]] != $DBENG_OK} {
            puts "$mname:error locating event record(\
                  [db_io_code_string $ret])"
            return
         }

         break
      }                

      if {[set ret [db_delete $sched_tid]] != $DBENG_OK} {
         puts "$mname:error deleteing schedule record([db_io_code_string $ret])"
         return
      }

      set sched_changed 1
   }
}

proc get_event_category {def cat} {
   # Get the event category id from the user. First display a list of
   # valid categories. Prompt default is in 'def'. Returns 1 upon
   # success with the category id in 'cat'. Returns 0 upon error
   # or quit signal.
   upvar $cat lk
   global sched_cat_tid DBENG_OK CAT_FIELD_NUM DBENG_EOF
   set mname "get_event_category"

   while {1} {
      if {![display_categories]} {
         return 0
      }

      if {![string compare -nocase $def "Q"]} {
         puts -nonewline "category id or 'q' to quit adding"
         set cat_id [get_input "q"]

         if {![string compare -nocase $cat_id "Q"]} {
            return 0
         }
      } else {
         puts -nonewline "category id"
         set cat_id [get_input $def]
      }

      if {[set ret [db_top $sched_cat_tid]] != $DBENG_OK} {
         puts "$mname:error going to top of category table(\
               [db_io_code_string $ret])"
         return 0
      }

      if {[set ret [db_find_field $sched_cat_tid 0 $cat_id $CAT_FIELD_NUM]] \
          != $DBENG_OK} {
         if {$ret == $DBENG_EOF} {
            puts "$mname:category id $cat_id not found"
         } else {
            return 0
         }
      } else {
         break
      }
   }

   set lk $cat_id
   return 1
}

proc get_event_aplanned {actplan def out} {
   # Get a planned or actual amount from the user. Returns the amount
   # (with zero cents if necessary in 'out' upon success with a 1
   # return code. Returns zero otherwise.
   upvar $out lk
   set mname "get_event_aplanned"

   while {1} {
      set buf ""

      if {![string compare -nocase $def "Q"]} {
         puts -nonewline "$actplan amount or 'q' to quit adding"
         set buf [get_input "q"]

         if {![string compare -nocase $buf "Q"]} {
            return 0
         }
      } else {
         puts -nonewline "$actplan amount"
         set buf [get_input $def]
      }

      if {[ll_words $buf "."] > 1} {
         ll_word $buf tmp 1 "."

         if {![num $tmp]} {
            puts "$mname:amount is not numeric"
            continue
         }

         ll_word $buf tmp 2 "."

         if {![num $tmp]} {
            puts "$mname:amount is not numeric"
            continue
         }

         # one decimal place eg: 50.5
         if {[string length $tmp] == 1} {
            set tmp [format "%s0" $buf]
            set buf $tmp
         }

         break
      } else {
         # whole dollars
         if {![num $buf]} {
            puts "$mname:amount is not numeric"
            continue
         }

         set tmp [format "%s.00" $buf]
         set buf $tmp
         break
      }
   }

   set lk $buf
   return 1
}

proc display_categories {} {
   # Display all current categories. Returns 1 upon success,
   # 0 otherwise.
   global sched_cat_tid DBENG_OK CAT_FIELD_NUM CAT_FIELD_TYPE CAT_COUNT_REC
   global CAT_FIELD_DESC CAT_TYPE_CREDIT CAT_TYPE_DEBIT CAT_TYPE_NA
   set mname "display_categories"

   if {[set ret [db_top $sched_cat_tid]] != $DBENG_OK} {
      puts "$mname:error going to top of category table(\
            [db_io_code_string $ret])"
      return 0
   }

   # error getting the first record is assumed to be no records,ok
   if {[set ret [db_next $sched_cat_tid]] != $DBENG_OK} {
      puts "$mname:no categories([db_io_code_string $ret])"
      return 1
   }

   while {$ret == $DBENG_OK} {
      if {[set ret [db_get_field $sched_cat_tid $CAT_FIELD_NUM num]] != \
          $DBENG_OK} {
         puts "$mname:error getting category count([db_io_code_string $ret])"
         return 0
      }

      # ignore counter record
      if {$num == $CAT_COUNT_REC} {
         set ret [db_next $sched_cat_tid]
         continue
      }

      if {[set ret [db_get_field $sched_cat_tid $CAT_FIELD_DESC desc]] != \
          $DBENG_OK} {
         puts "$mname:error getting category count([db_io_code_string $ret])"
         return 0
      }

      if {[set ret [db_get_field $sched_cat_tid $CAT_FIELD_TYPE type]] != \
          $DBENG_OK} {
         puts "$mname:error getting category count([db_io_code_string $ret])"
         return 0
      }

      if {![num $type]} {
         puts "$mname:category($desc) type is not numeric"
         return 0
      }

      switch $type \
         $CAT_TYPE_CREDIT {set type_desc "credit"} \
         $CAT_TYPE_DEBIT {set type_desc "debit"} \
         $CAT_TYPE_NA {set type_desc "not applicable"} \
         default {puts "$mname:category($desc) type code is out of range";\
                  return 0}

      puts "id=$num,desc=$desc,type=$type_desc"
      set ret [db_next $sched_cat_tid]
   }

   return 1
}
      
proc display_events {typ} {
   # Display all events for the current month and build the event list.
   # Returns 1 upon success, 0 otherwise.
   global sched_changed sched_tid SCHED_FIELD_DATE event_list month_num
   global DBENG_OK SCHED_FIELD_DESC SCHED_FIELD_CAT CAT_TYPE_NA
   global SCHED_FIELD_PLANNED SCHED_FXP_SCALE SCHED_FIELD_ACTUAL
   global SCHED_FIELD_PLANNED_BAL SCHED_FIELD_ACTUAL_BAL
   set mname "display_events"
   set cnt 1

   # if schedule table has changed, sort it
   if {$sched_changed} {
      puts "$mname:sorting schedule table"
      db_sort $sched_tid $SCHED_FIELD_DATE
      set sched_changed 0
   }

   # if event list is not empty, clear it
   if {$event_list != ""} {
      set event_list ""
   }

   set month [lpad $month_num "0" 2]

   if {[set ret [db_top $sched_tid]] != $DBENG_OK} {
      puts "$mname:error going to top of event table(\
            [db_io_code_string $ret])"
      return 0
   }

   if {[set ret [get_sched $typ $sched_tid $month_num]] != $DBENG_OK} {
      puts "$mname:no existing events([db_io_code_string $ret])"
      return 1
   }

   while {$ret == $DBENG_OK} {
      if {[set ret [db_get_field $sched_tid $SCHED_FIELD_DATE date]] != \
           $DBENG_OK} {
         puts "$mname:error getting date field([db_io_code_string $ret])"
         return 0
      }

      if {[set ret [db_get_field $sched_tid $SCHED_FIELD_DESC desc]] != \
           $DBENG_OK} {
         puts "$mname:error getting description([db_io_code_string $ret])\
               ($date)"
         return 0
      }

      if {[set ret [db_get_field $sched_tid $SCHED_FIELD_CAT cat]] != \
           $DBENG_OK} {
         puts "$mname:error getting category field([db_io_code_string $ret])\
               ($date)"
         return 0
      }

      if {![xref_category $cat cat_typ]} {
         puts "$mname:error getting category type"
         return 0
      }

      if {$cat_typ != $CAT_TYPE_NA} {
         if {[set ret [dbfxp_get $sched_tid $SCHED_FIELD_PLANNED \
              $SCHED_FXP_SCALE planned]] != $DBENG_OK} {
            puts "$mname:error getting planned field([db_io_code_string $ret])\
                  ($date)"
            return 0
         }

         if {![fxp_oconv $planned $SCHED_FXP_SCALE planned_st]} {
            puts "$mname:error converting planned field($date)"
            return 0
         }

         if {[set ret [dbfxp_get $sched_tid $SCHED_FIELD_ACTUAL \
              $SCHED_FXP_SCALE actual]] != $DBENG_OK} {
            puts "$mname:error getting actual field([db_io_code_string $ret])\
                  ($date)"
            return 0
         }

         if {![fxp_oconv $actual $SCHED_FXP_SCALE actual_st]} {
            puts "$mname:error converting actual field($date)"
            return 0
         }

         set has_bal 1
      
         # only display balance fields if they are present
         if {[set ret [dbfxp_get $sched_tid $SCHED_FIELD_PLANNED_BAL \
              $SCHED_FXP_SCALE planned]] != $DBENG_OK} {
            set has_bal 0
         }

         if {$has_bal} {
            if {![fxp_oconv $planned $SCHED_FXP_SCALE planned_bal]} {
               puts "$mname:error converting planned bal field($date)"
               return 0
            }

            if {[set ret [dbfxp_get $sched_tid $SCHED_FIELD_ACTUAL_BAL \
                 $SCHED_FXP_SCALE actual]] != $DBENG_OK} {
               puts "$mname:error getting actual bal field(\
                     [db_io_code_string $ret])($date)"
               return 0
            }

            if {![fxp_oconv $actual $SCHED_FXP_SCALE actual_bal]} {
               puts "$mname:error converting actual bal field($date)"
               return 0
            }
         }

         lappend event_list $date

         if {$cat_typ == $CAT_TYPE_NA} {
            puts "$cnt:$date,$desc,$cat"
            set cnt [expr $cnt + 1]
         } else {
            if {$has_bal} {
               puts "$cnt:$date,$desc,$cat,$planned_st,$planned_bal,\
                     $actual_st,$actual_bal"
               set cnt [expr $cnt + 1]
            } else {
               puts "$cnt:$date,$desc,$cat,$planned_st,$actual_st"
               set cnt [expr $cnt + 1]
            }
         }
      }

      set ret [get_sched $typ $sched_tid $month_num]
   }

   return 1
}

proc summarize_month {} {
   # Perform calcs on current month and display.
   global month_num sched_tid DBENG_OK SCHED_FILTER_BUDGET SCHED_FIELD_DATE
   global SCHED_FIELD_CAT SCHED_FIELD_PLANNED SCHED_FXP_SCALE SCHED_TMP_NAME
   global SCHED_FIELD_ACTUAL SCHED_TMP_FIELD_DATE CAT_TYPE_CREDIT
   global SCHED_TMP_FIELD_PLANNED_BAL SCHED_TMP_FIELD_ACTUAL_BAL
   global SCHED_FIELD_PLANNED_BAL SCHED_FIELD_ACTUAL_BAL
   set mname "summarize_month"

   set month [format "%02d" $month_num]

   if {[set ret [db_top $sched_tid]] != $DBENG_OK} {
      puts "$mname:error going to top of event table([db_io_code_string $ret])"
      return 0
   }

   # error getting the first record is assumed to be no records,ok
   if {[set ret [get_sched $SCHED_FILTER_BUDGET $sched_tid $month_num]] != \
       $DBENG_OK} {
      puts "$mname:no existing events([db_io_code_string $ret])"
      return 1
   }

   # load planned and actual open balance
   set found_open_bal 0

   while {$ret == $DBENG_OK} {
      if {[set ret [db_get_field $sched_tid $SCHED_FIELD_DATE date]] != \
          $DBENG_OK} {
         puts "$mname:error getting date field([db_io_code_string $ret])"
         return 0
      }

      # open balance is the only record in the month with category 6
      if {[set ret [db_get_field $sched_tid $SCHED_FIELD_CAT cat]] != \
          $DBENG_OK} {
         puts "$mname:error getting category field([db_io_code_string $ret])\
               ($date)"
         return 0
      }

      if {$cat != "6"} {
         set ret [get_sched $SCHED_FILTER_BUDGET $sched_tid $month_num]
         continue
      }

      if {[set ret [dbfxp_get $sched_tid $SCHED_FIELD_PLANNED \
          $SCHED_FXP_SCALE bal_planned]] != $DBENG_OK} {
         puts "$mname:error getting planned field([db_io_code_string $ret])\
               ($date)"
         return 0
      }

      if {[set ret [dbfxp_get $sched_tid $SCHED_FIELD_ACTUAL $SCHED_FXP_SCALE \
          bal_actual]] != $DBENG_OK} {
         puts "$mname:error getting actual field([db_io_code_string $ret])\
               ($date)"
         return 0
      }

      set found_open_bal 1
      break
   }

   # cannot calc if no open balance for the month
   if {!$found_open_bal} {
      puts "$mname:open balance record not found,cannot calculate"
      return 0
   }

   if {[set ret [db_top $sched_tid]] != $DBENG_OK} {
      puts "$mname:error going to top of event table([db_io_code_string $ret])"
      return 0
   }

   if {[set ret [get_sched $SCHED_FILTER_BUDGET $sched_tid $month_num]] != \
       $DBENG_OK} {
      puts "$mname:no existing events([db_io_code_string $ret])"
      return 0
   }

   # clear schedule temporary table
   if {[set ret [db_clear_table $SCHED_TMP_NAME]] != $DBENG_OK} {
      puts "$mname:unable to clear schedule tmp table\
            ([db_io_code_string $ret])"
      return 0
   }

   # open schedule temporary table
   if {[set ret [db_open $SCHED_TMP_NAME tmp_tid]] != $DBENG_OK} {
      puts "$mname:unable to open schedule tmp table\
            ([db_io_code_string $ret])"
      return 0
   }

   # initialize all total accumulators
   if {[set ptot_credit [fxp_iconv "0.00"]] == ""} {
      puts "$mname:error initializing ptot_credit"
      return 0
   }

   if {[set atot_credit [fxp_iconv "0.00"]] == ""} {
      puts "$mname:error initializing atot_credit"
      return 0
   }

   if {[set ptot_debit [fxp_iconv "0.00"]] == ""} {
      puts "$mname:error initializing ptot_debit"
      return 0
   }

   if {[set atot_debit [fxp_iconv "0.00"]] == ""} {
      puts "$mname:error initializing atot_debit"
      return 0
   }

   set credit_cnt 0
   set debit_cnt 0

   # loop through all month event records calculating while ignoring
   # the open balance record, write balances to the temporary table
   while {$ret == $DBENG_OK} {
      if {[set ret [db_get_field $sched_tid $SCHED_FIELD_DATE date]] !=
          $DBENG_OK} {
         puts "$mname:error getting date field([db_io_code_string $ret])"
         db_close $tmp_tid
         return 0
      }

      if {[set ret [db_get_field $sched_tid $SCHED_FIELD_CAT cat]] !=
          $DBENG_OK} {
         puts "$mname:error getting category field([db_io_code_string $ret])"
         db_close $tmp_tid
         return 0
      }

      # ignore balance record
      if {$cat == "6"} {
         set ret [get_sched $SCHED_FILTER_BUDGET $sched_tid $month_num]
         continue
      }

      # lookup category type
      if {![xref_category $cat cat_typ]} {
         db_close $tmp_tid
         return 0
      }

      if {[set ret [dbfxp_get $sched_tid $SCHED_FIELD_PLANNED \
          $SCHED_FXP_SCALE planned]] != $DBENG_OK} {
         puts "$mname:error getting planned field([db_io_code_string $ret])\
               ($date)"
         db_close $tmp_tid
         return 0
      }

      if {[set ret [dbfxp_get $sched_tid $SCHED_FIELD_ACTUAL \
          $SCHED_FXP_SCALE actual]] != $DBENG_OK} {
         puts "$mname:error getting actual field([db_io_code_string $ret])\
               ($date)"
         db_close $tmp_tid
         return 0
      }

      if {[set ret [db_put_field $tmp_tid $SCHED_TMP_FIELD_DATE $date]] != \
          $DBENG_OK} {
         puts "$mname:error putting date field([db_io_code_string $ret])\
               ($date)"
         db_close $tmp_tid
         return 0
      }

      if {$cat_typ == $CAT_TYPE_CREDIT} {
         set credit_cnt [expr $credit_cnt + 1]

         if {[set ftmp [fxp_add $bal_planned $planned]] == ""} {
            puts "$mname:error adding planned and balance planned"
            db_close $tmp_tid
            return 0
         }

         set bal_planned $ftmp

         if {[set ftmp [fxp_add $ptot_credit $planned]] == ""} {
            puts "$mname:error adding planned and total credit planned"
            db_close $tmp_tid
            return 0
         }

         set ptot_credit $ftmp
   
         if {[set ret [dbfxp_put $tmp_tid $SCHED_TMP_FIELD_PLANNED_BAL \
             $SCHED_FXP_SCALE $bal_planned]] != $DBENG_OK} {
            puts "$mname:error putting planned balance amount\
                  ([db_io_code_string $ret])"
            db_close $tmp_tid
            return 0
         }

         if {[set ftmp [fxp_add $bal_actual $actual]] == ""} {
            puts "$mname:error adding actual and balance actual"
            db_close $tmp_tid
            return 0
         }

         set bal_actual $ftmp

         if {[set ftmp [fxp_add $atot_credit $actual]] == ""} {
            puts "$mname:error adding actual and total credit actual"
            db_close $tmp_tid
            return 0
         }

         set atot_credit $ftmp

         if {[set ret [dbfxp_put $tmp_tid $SCHED_TMP_FIELD_ACTUAL_BAL \
             $SCHED_FXP_SCALE $bal_actual]] != $DBENG_OK} {
            puts "$mname:error putting actual balance amount\
                  ([db_io_code_string $ret])"
            db_close $tmp_tid
            return 0
         }
      } else {
         set debit_cnt [expr $debit_cnt + 1]

         if {[set ftmp [fxp_sub $bal_planned $planned]] == ""} {
            puts "$mname:error subtracting planned and balance planned"
            db_close $tmp_tid
            return 0
         }

         set bal_planned $ftmp

         if {[set ftmp [fxp_add $ptot_debit $planned]] == ""} {
            puts "$mname:error adding planned and total debit planned"
            db_close $tmp_tid
            return 0
         }

         set ptot_debit $ftmp

         if {[set ret [dbfxp_put $tmp_tid $SCHED_TMP_FIELD_PLANNED_BAL \
              $SCHED_FXP_SCALE $bal_planned]] != $DBENG_OK} {
            puts "$mname:error putting planned balance amount(\
                  [db_io_code_string $ret])"
            db_close $tmp_tid
            return 0
         }

         if {[set ftmp [fxp_sub $bal_actual $actual]] == ""} {
            puts "$mname:error subtracting actual and balance actual"
            db_close $tmp_tid
            return 0
         }

         set bal_actual $ftmp

         if {[set ftmp [fxp_add $atot_debit $actual]] == ""} {
            puts "$mname:error adding actual and total debit actual"
            db_close $tmp_tid
            return 0
         }

         set atot_debit $ftmp

         if {[set ret [dbfxp_put $tmp_tid $SCHED_TMP_FIELD_ACTUAL_BAL \
              $SCHED_FXP_SCALE $bal_actual]] != $DBENG_OK} {
            puts "$mname:error putting actual balance amount(\
                  [db_io_code_string $ret])"
            db_close $tmp_tid
            return 0
         }
      }

      if {[set ret [db_write $tmp_tid]] != $DBENG_OK} {
         puts "$mname:error writing tmp schedule record(\
               [db_io_code_string $ret])"
         db_close $tmp_tid
         return 0
      }

      set ret [get_sched $SCHED_FILTER_BUDGET $sched_tid $month_num]
   }

   db_top $tmp_tid
   db_next $tmp_tid
   set ret $DBENG_OK

   # copy temporary table balances to schedule table
   while {$ret == $DBENG_OK} {
      if {[set ret [db_get_field $tmp_tid $SCHED_TMP_FIELD_DATE date]] != \
          $DBENG_OK} {
         puts "$mname:error getting date field([db_io_code_string $ret])"
         db_close $tmp_tid
         return 0
      }

      if {[set ret [db_top $sched_tid]] != $DBENG_OK} {
         puts "$mname:error going to top of schedule table(\
               [db_io_code_string $ret])"
         db_close $tmp_tid
         return 0
      }

      if {[set ret [db_find_field $sched_tid 0 $date $SCHED_FIELD_DATE]] != \
          $DBENG_OK} {
         puts "$mname:error locating schedule table record(\
               [db_io_code_string $ret])"
         db_close $tmp_tid
         return 0
      }

      if {[set ret [db_get_field $tmp_tid $SCHED_TMP_FIELD_PLANNED_BAL mes]] \
          != $DBENG_OK} {
         puts "$mname:error getting tmp sched planned bal field(\
               [db_io_code_string $ret])"
         db_close $tmp_tid
         return 0
      }

      if {[set ret [db_put_field $sched_tid $SCHED_FIELD_PLANNED_BAL $mes]] \
          != $DBENG_OK} {
         puts "$mname:error putting sched planned bal field(\
               [db_io_code_string $ret])"
         db_close $tmp_tid
         return 0
      }

      if {[set ret [db_get_field $tmp_tid $SCHED_TMP_FIELD_ACTUAL_BAL mes]] \
          != $DBENG_OK} {
         puts "$mname:error getting tmp sched actual bal field(\
               [db_io_code_string $ret])"
         db_close $tmp_tid
         return 0
      }

      if {[set ret [db_put_field $sched_tid $SCHED_FIELD_ACTUAL_BAL $mes]] \
          != $DBENG_OK} {
         puts "$mname:error putting sched actual bal field(\
               [db_io_code_string $ret])"
         db_close $tmp_tid
         return 0
      }

      if {[set ret [db_write $sched_tid]] != $DBENG_OK} {
         puts "$mname:error writing schedule record([db_io_code_string $ret])"
         db_close $tmp_tid
         return 0
      }

      set ret [db_next $tmp_tid]
   }   

   db_close $tmp_tid
   puts "$mname:sorting schedule table"
   db_sort $sched_tid $SCHED_FIELD_DATE
   display_events $SCHED_FILTER_BUDGET

   # calc and display monthly summary
   if {![fxp_oconv $ptot_credit $SCHED_FXP_SCALE sptot_credit]} {
      puts "$mname:error converting planned total credit"
      return 0
   }

   if {![fxp_oconv $atot_credit $SCHED_FXP_SCALE satot_credit]} {
      puts "$mname:error converting actual total credit"
      return 0
   }

   if {![fxp_oconv $ptot_debit $SCHED_FXP_SCALE sptot_debit]} {
      puts "$mname:error converting planned total debit"
      return 0
   }

   if {![fxp_oconv $atot_debit $SCHED_FXP_SCALE satot_debit]} {
      puts "$mname:error converting actual total debit"
      return 0
   }

   puts "$mname:$credit_cnt credit event(s),$debit_cnt debit event(s)"
   puts "$mname:totals"
   puts "$mname:credit:planned=$sptot_credit,actual=$satot_credit"
   puts "$mname:debit:planned=$sptot_debit,actual=$satot_debit"
   return 1
}

proc copy_month {} {
   # Copy the current month records to a new year/month.
   global month_num year_num SCHED_NAME DBENG_OK SCHED_FILTER_ALL sched_tid
   global SCHED_FIELD_DATE SCHED_FIELD_DESC SCHED_FIELD_CAT
   global SCHED_FIELD_PLANNED SCHED_FIELD_ACTUAL SCHED_FIELD_PLANNED_BAL
   global SCHED_FIELD_ACTUAL_BAL
   set mname "copy_month"

   # get destination year and month
   # suggest year based on current year unless this is month 12
   if {$month_num == 12} {
      set buf [expr $year_num + 1]
   } else {
      set buf $year_num
   }

   puts -nonewline "destination year"
   set value [get_input $buf]

   if {![num $value]} {
      puts "$mname:year is not a number"
      return
   }

   set dest_year $value

   # suggest next month
   if {$month_num == 12} {
      set buf 1
   } else {
      set buf [expr $month_num + 1]
   }

   puts -nonewline "destination month"
   set value [get_input $buf]

   if {![num $value]} {
      puts "$mname:month is not a number"
      return
   }

   set dest_month $value

   # don't allow copy to current year/month
   if {$dest_year == $year_num && $dest_month == $month_num} {
      puts "$mname:cannot copy to current month"
      return
   }

   # open destination table, ok if it is current year
   set value [format "%s.%d" $SCHED_NAME $dest_year]

   if {[set ret [db_open $value dest_tid]] != $DBENG_OK} {
      puts "$mname:open of $value failed([db_io_code_string $ret])"
      return
   }

   # attempt to find existing destination records and ask to delete
   # if they exist
   if {[set ret [db_top $dest_tid]] != $DBENG_OK} {
      puts "$mname:error going to top of event table(\
            [db_io_code_string $ret])"
      return
   }

   if {[set ret [get_sched $SCHED_FILTER_ALL $dest_tid $dest_month]] == \
       $DBENG_OK} {
      if {![getyn "destination month records exist,ok to delete"]} {
         db_close $dest_tid
         return
      }

      while {$ret == $DBENG_OK} {
         if {[set ret [db_delete $dest_tid]] != $DBENG_OK} {
            puts "$mname:error deleting sched record([db_io_code_string $ret])"
            db_close $dest_tid
            return
         }

         if {[set ret [db_top $dest_tid]] != $DBENG_OK} {
            puts "$mname:error going to top of event table(\
                  [db_io_code_string $ret])"
            db_close $dest_tid
         }

         set ret [get_sched $SCHED_FILTER_ALL $dest_tid $dest_month]
      }
   }

   # get each source record, change it's ID, zero out balances and write
   # it as a destination record
   if {[set ret [db_top $sched_tid]] != $DBENG_OK} {
      puts "$mname:error going to top of event table([db_io_code_string $ret])"
      db_close $dest_tid
      return
   }

   if {[set ret [get_sched $SCHED_FILTER_ALL $sched_tid $month_num]] != \
       $DBENG_OK} {
      puts "$mname:no existing source events?([db_io_code_string $ret])"
      db_close $dest_tid
      return
   }

   set value [format "%02d" $dest_month]

   while {$ret == $DBENG_OK} {
      if {[set ret [db_new $dest_tid]] != $DBENG_OK} {
         puts "$mname:error setting up new event record(\
               [db_io_code_string $ret])"
         db_close $dest_tid
         return
      }

      if {[set ret [db_get_field $sched_tid $SCHED_FIELD_DATE buf]] != \
          $DBENG_OK} {
         puts "$mname:error get date field([db_io_code_string $ret])"
         db_close $dest_tid
         return
      }

      set buf [string replace $buf 0 1 $value]

      if {[set ret [db_put_field $dest_tid $SCHED_FIELD_DATE $buf]] != \
          $DBENG_OK} {
         puts "$mname:error putting event date([db_io_code_string $ret])"
         db_close $dest_tid
         return
      }

      if {[set ret [db_get_field $sched_tid $SCHED_FIELD_DESC buf]] != \
          $DBENG_OK} {
         puts "$mname:error getting desc field([db_io_code_string $ret])"
         db_close $dest_tid
         return
      }

      if {[set ret [db_put_field $dest_tid $SCHED_FIELD_DESC $buf]] != \
          $DBENG_OK} {
         puts "$mname:error putting event desc([db_io_code_string $ret])"
         db_close $dest_tid
         return
      }

      if {[set ret [db_get_field $sched_tid $SCHED_FIELD_CAT buf]] != \
          $DBENG_OK} {
         puts "$mname:error getting category field([db_io_code_string $ret])"
         db_close $dest_tid
         return
      }

      if {[set ret [db_put_field $dest_tid $SCHED_FIELD_CAT $buf]] != \
          $DBENG_OK} {
         puts "$mname:error putting event category([db_io_code_string $ret])"
         db_close $dest_tid
         return
      }

      if {[set ret [db_get_field $sched_tid $SCHED_FIELD_PLANNED buf]] != \
          $DBENG_OK} {
         puts "$mname:error getting planned field([db_io_code_string $ret])"
         db_close $dest_tid
         return
      }

      if {[set ret [db_put_field $dest_tid $SCHED_FIELD_PLANNED $buf]] != \
          $DBENG_OK} {
         puts "$mname:error putting event planned([db_io_code_string $ret])"
         db_close $dest_tid
         return
      }

      if {[set ret [db_put_field $dest_tid $SCHED_FIELD_ACTUAL "000"]] != \
          $DBENG_OK} {
         puts "$mname:error putting event actual value(\
               [db_io_code_string $ret])"
         db_close $dest_tid
         return
      }

      if {[set ret [db_put_field $dest_tid $SCHED_FIELD_PLANNED_BAL "000"]] \
          != $DBENG_OK} {
         puts "$mname:error putting event planned bal(\
               [db_io_code_string $ret])"
         db_close $dest_tid
         return
      }

      if {[set ret [db_put_field $dest_tid $SCHED_FIELD_ACTUAL_BAL "000"]] \
          != $DBENG_OK} {
         puts "$mname:error putting event actual bal(\
               [db_io_code_string $ret])"
         db_close $dest_tid
         return
      }

      if {[set ret [db_write $dest_tid]] != $DBENG_OK} {
         puts "$mname:error writing destination record(\
               [db_io_code_string $ret])"
         db_close $dest_tid
         return
      }

      set ret [get_sched $SCHED_FILTER_ALL $sched_tid $month_num]
   }

   puts "$mname:sorting schedule table"
   db_sort $dest_tid $SCHED_FIELD_DATE
   db_close $dest_tid
}

proc get_next_seq {day} {
   # Calc the next event sequence number. Returns the
   # sequence number upon success, zero otherwise.
   global event_list month_num
   set seq_int 0

   set nitems [llength $event_list]

   # if the event list is empty, start at one
   if {!$nitems} {
      return 1
   }

   set date [format "%02d%02d" $month_num $day]

   for {set i 0} {$i < $nitems} {incr i} {
      set id [lindex $event_list $i]

      if {[string range $date 0 3] == [string range $id 0 3]} {
         ll_word $id tmp 2 "."

         if {$tmp > $seq_int} {
            set seq_int $tmp
         }
      }
   }

   incr seq_int
   return $seq_int
}

proc xref_category {cat typ} {
   # Lookup a category and return the category type. Returns
   # 1 upon success with the category type loaded into 'typ'.
   # Returns 0 otherwise.
   global sched_cat_tid DBENG_OK CAT_FIELD_NUM CAT_FIELD_TYPE
   upvar $typ lk
   set mname "xref_category"
   set lk -1

   if {[set ret [db_top $sched_cat_tid]] != $DBENG_OK} {
      puts "$mname:error going to top of category table(\
           [db_io_code_string $ret])"
      return 0
   }

   set ret [db_find_field $sched_cat_tid 0 $cat $CAT_FIELD_NUM]

   if {$ret != $DBENG_OK} {
      puts "$mname:error locating category record([db_io_code_string $ret])"
      return 0
   }

   set ret [db_get_field $sched_cat_tid $CAT_FIELD_TYPE buf]

   if {$ret != $DBENG_OK} {
      puts "$mname:error getting category type([db_io_code_string $ret])"
      return 0
   }

   if {![num $buf]} {
      puts "$mname:category type is not numeric"
      return 0
   }

   set lk $buf
   return 1
}

proc get_category_count {} {
   # Locate the category table count record, retrieve the count,
   # increment it and re-write the counter record. Returns the
   # category number upon success, zero otherwise.
   global sched_cat_tid DBENG_OK sched_cat_changed CAT_COUNT_REC
   set mname "get_category_count"

   if {[set ret [db_top $sched_cat_tid]] != $DBENG_OK} {
      puts "$mname:error going to top of category table(\
            [db_io_code_string $ret])"
      return 0
   }

   if {[set ret [db_find_field $sched_cat_tid 0 $CAT_COUNT_REC 1]] \
       != $DBENG_OK} {
      puts "$mname:error getting category count([db_io_code_string $ret])"
      return 0
   }

   if {[set ret [db_get_field $sched_cat_tid 2 buf]] != $DBENG_OK} {
      puts "$mname:error getting category count([db_io_code_string $ret])"
      return 0
   }

   if {![num $buf]} {
      puts "$mname:category count is not numeric"
      return 0
   }

   set cnt [expr $buf + 1]
   
   if {[set ret [db_put_field $sched_cat_tid 2 $cnt]] != $DBENG_OK} {
      puts "$mname:error putting category count([db_io_code_string $ret])"
      return 0
   }

   if {[set ret [db_write $sched_cat_tid]] != $DBENG_OK} {
      puts "$mname:error writing category count record(\
            [db_io_code_string $ret])"
      return 0
   }

   set sched_cat_changed 1
   return $buf
}

proc get_sched {filter tid amonth} {
   # Get next record from the schedule table 'tid' and make sure it
   # applies only to the month 'amonth' and apply the 'filter'
   # (see 'SCHED_FILTER' types). Returns a 'bbuuzzb' code.
   global DBENG_OK SCHED_FIELD_DATE SCHED_FIELD_CAT SCHED_FILTER_ALL
   global DBENG_INVALID_FUNCTION SCHED_FILTER_BUDGET CAT_TYPE_CREDIT
   global SCHED_FILTER_OTHER CAT_TYPE_DEBIT CAT_TYPE_NA
   set mname "get_sched"

   set month [lpad $amonth 0 2]
   set ret [db_next $tid]

   if {$ret != $DBENG_OK} {
      return $ret
   }

   while {$ret == $DBENG_OK} {
      set ret [db_get_field $tid $SCHED_FIELD_DATE date]

      if {$ret != $DBENG_OK} {
         puts "$mname:error getting date field([db_io_code_string $ret])"
         return $ret
      }

      # only include current month events
      if {[string range $month 0 1] != [string range $date 0 1]} {
         set ret [db_next $tid]
         continue
      }

      # if filter is set to all in this month,exit
      if {$filter == $SCHED_FILTER_ALL} {
         return $DBENG_OK
      }

      set ret [db_get_field $tid $SCHED_FIELD_CAT cat]

      if {$ret != $DBENG_OK} {
         puts "$mname:error getting category field([db_io_code_string $ret])\
               ($date)"
         return $ret
      }

      if {![xref_category $cat cat_typ]} {
         puts "$mname:error getting category type"
         return $DBENG_INVALID_FUNCTION
      }

      switch $filter \
         $SCHED_FILTER_BUDGET {if {$cat_typ == $CAT_TYPE_CREDIT || \
                                  $cat_typ == $CAT_TYPE_DEBIT} \
                                  {return $DBENG_OK}} \
         $SCHED_FILTER_OTHER {if {$cat_typ == $CAT_TYPE_NA} \
                                 {return $DBENG_OK}} \
         default {puts "$mname:unknown filter"; return $DBENG_INVALID_FUNCTION}

      set ret [db_next $tid]
   }

   return $ret
}

proc ll_locate {seq} {
   # Locate an entry in the event list by its sequence number. Returns
   # the list entry upon success, an empty string otherwise.
   global event_list

   return [lindex $event_list [expr $seq - 1]]
}

proc close_tables {} {
   # Sort table (if changed) and close them.
   global sched_changed sched_cat_changed sched_tid SHCED_FIELD_DATE
   global sched_cat_tid CAT_FIELD_NUM

   if {$sched_changed} {
      puts "sorting schedule table"
      db_sort $sched_tid $SCHED_FIELD_DATE
      set sched_changed 0
   }

   if {$sched_cat_changed} {
      puts "sorting schedule category table"
      db_sort $sched_cat_tid $CAT_FIELD_NUM
      set sched_cat_changed 0
   }

   db_close $sched_tid
   db_close $sched_cat_tid
}

proc term_app {} {
   # Prepare to terminate the application. Shutdown all IPC API's.

   db_end

   if {[logman_is_active]} {
      logman_end
   }

   appinit_remove_name
}

# Program main line.
# unbuffered stdout
fconfigure stdout -buffering none

# display logo
puts "$APNAME for $tcl_platform(platform) Version $VERSION"
puts "By Rick Smereka, Copyright (c) 2008"
get_date

# register application name with 'appinit'
if {![appinit_register_name $APNAME]} {
   puts "$APNAME:fatal error registering app name with appinit"
   exit
}

# initialize local engine if we are running locally or
# startup the 'socloc' interface and connect to a
# Bbuuzzb database server if we are running in
# client/server mode
if {![c_initialize]} {
   puts "program abort"
   term_app
   exit
}

# log everything if in 'debug' mode
if {$DEBUG} {
   if {[logman_start $DEBUG_DEST $APNAME]} {
      puts "$APNAME:bad rc from logman_start,program abort"
      term_app
      exit
   }
}

set ret 0

if {[open_tables]} {
   while {!$ret} {
      set ret [main_menu]
   }
}

term_app
exit

