/*
** Frame: employees
** Form: samp_employees
** Source File: employees.osq
** Description:
**
** Allows the user to browse and update the Employees and
** Employee_histories tables. The tables are presented to the
** user in Master/Detail form (Employees is the Master, and
** Employee_histories is the detail). The Master records are
** presented in alphabetical order (by last name, first
** name, and initial).
**
** The user is allowed to do arbitrary inserts, updates, and
** deletes on both the master and the details as long as
** referential integrity is maintained. The user can update
** any fields in the tables except for the last_updated_at
** (time) and last_updated_by (user) columns of the Master
** (Employee) table, which are maintained by code in this
** frame.
**
** The last_updated_at column is used to implement an
** optimistic locking scheme: If two users simultaneously
** manipulate a Master record (and its associated details),
** the changes of the first user to select Save are written
** to the database; the second user is informed that his
** changes didn't take.
*/

initialize =
declare

  /* hidden versions of primary keys & join fields */
  hid_ssn = integer not null,
  tf.hid_start_date = date not null,
  tf.hid_position_code = integer not null,

/* working variables */
  char1 = char(1) not null,          /* holds answer to 
                                     ** Yes/No prompts */
  error_no = integer not null,       /* holds DBMS statement
                                     ** error number */
  i = integer not null,              /* general purpose
                                     ** integer */
  obj_name = char(32) not null,      /* holds an object name */
  row_count = integer not null,      /* holds DBMS statement
                                     ** row count */
  row_number = integer not null,     /* holds table field
                                     ** row number (positive when
                                     ** processing the non-deleted
                                     ** rows of a tablefield, zero
                                     ** or negative otherwise) */
  rows_found = char(1) not null,     /* tells if query
                                     ** selected >0 rows */
  row_state = integer not null,      /* holds table field
                                     ** row state */

 

  save_ok = char(1) not null,        /* tells if Save is legal */
                                     /* the following 2 variables
                                     ** are used by local procedures
                                     ** that print error messages */
  current_op = varchar(16) not null, /* current activation 
                                     ** operation */
  record_type = varchar(8) not null, /* set to 'master' or 'detail'
                                     ** during an INSERT, UPDATE, 
                                     ** or DELETE; set to '' 
                                     ** during other DB stmts */

  /* local procedures */
  do_addnew = procedure returning integer not null,
  do_save = procedure returning integer not null,
  do_delete = procedure returning integer not null,
  check_io_err = procedure returning integer not null,
  do_listchoices = procedure returning none,
  do_after_code = procedure returning integer not null,
  verify_in_tf = procedure returning char(1) not null,
  verify_nothing_to_save = procedure returning char(1) not null,

begin
  set_forms frs (validate(nextfield) = 1,
    validate(previousfield) = 1,
    activate(nextfield) = 1, activate(previousfield) = 1,
    activate(menuitem) = 1, activate(keys) = 1,
    getmessages = 0);

  /* query mode required for qualification function */
  set_forms form (mode = 'query');
  set_forms field samp_employees (mode(tf) = 'read');

  set autocommit off;

  /* If the application hasn't done so yet, the following
  ** statements ask the DBMS for the name of the user
  ** running the application, and save the name in a global
  ** variable.
  */
  if (user_name = '') then
    select user_name = dbmsinfo('username');
    commit work;
  endif;

  row_number = 0;
  record_type = '';
end

'Go' (explanation = 'run query'), key frskey4 =
begin
  current_op = 'Go';

  rows_found = 'n';

  message 'Selecting data . . .';

 /*# begin Select\Master */

  samp_employees := select
    ssn = m.ssn, hid_ssn = m.ssn,
    last_name = m.last_name, first_name = m.first_name,
    initial = m.initial, last_updated_at = m.last_updated_at,
    last_updated_by = m.last_updated_by
  from employees m
  where
  qualification(m.ssn = ssn,
    m.last_name = last_name, m.first_name = first_name,
    m.initial = initial)
  order by last_name asc, first_name asc, initial asc

/*# end Select\Master */

/*# begin Select\Detail */

  samp_employees.tf := repeated select
    start_date = d.start_date, hid_start_date = d.start_date,
    position_code = d.position_code, salary = d.salary,
    position_title = dl.position_title
  from employee_histories d, positions dl
  where
    d.position_code = dl.position_code and d.ssn = :ssn
  order by start_date asc

/*# end Select\Detail */

 

  begin                 /* begin submenu in 'Go' menuitem */
  initialize =
  begin
    commit work;                 /* release locks */

    /* submenu temporarily changes form from query to
    ** update mode */

    set_forms field samp_employees (mode(tf) = 'fill');

    save_ok = 'y';       /* 'Save' is okay now, because
                         ** the AddNew menuitem has not 
                         ** been run on this data.
                         */
    rows_found = 'y';    /* indicate that >0 rows
                         ** qualified */

    set_forms form (change = 0);     /* typing query
                                     ** qualification
                                     ** set change = 1 */
  end

  'RowDelete' (validate = 0, activate = 0,
    explanation = 'Delete current row from table field') =
  begin
    current_op = 'RowDelete';

    if (verify_in_tf() = 'y') then
      deleterow tf;
      set_forms form (change = 1);
    endif;
  end

  'RowInsert' (explanation = 'Open new row in table field') =
  begin
    current_op = 'RowInsert';

    if (verify_in_tf() = 'y') then
      validrow tf; /* error if current row invalid */
      inquire_forms table '' (i = rowno);
      insertrow tf[i-1] (_state = 0);
    endif;
  end

  'AddNew' (activate = 1,
    explanation = 
    'Insert current screen data into database') =
  begin
    current_op = 'AddNew';

    validate; /* validate all fields on form */

    i = callproc do_addnew; /* attempt to save the data */
    if (i = 0) then
      /* data saved successfully */
      set_forms form (change = 0);
      save_ok = 'n';   /* 'Save' is forbidden now,
                       ** because the AddNew menuitem 
                       ** has been run on this data.*/
      mode 'fill';     /* display default values and
                       ** clear simple fields*/
      set_forms form (mode = 'update'); /* cursor off
                                         **Query-only flds*/
      clear field tf;
    else               /* error occurred */
      record_type = '';
      if (row_number > 0) then
        scroll tf to :row_number;
        row_number = 0;
        resume field tf;
      endif;
    endif;
  end

  'Save' (activate = 1,
    explanation = 'Update database with current screen data'),
    key frskey8 (activate = 1) =
  begin
    current_op = 'save';

    /* Must prevent AddNew followed by Save or Delete.
    ** Reasons: 1. User may have changed keys before
    ** selecting AddNew. Save/Delete assume hidden
    ** field/column versions of keys give true database
    ** identity of the displayed data.
    ** 2. Table field row _STATEs won't show just the
    ** changes made since AddNew.
    */
    if (save_ok = 'n') then
      callproc beep; /* 4gl built-in procedure */
      message 'Error: You cannot Save changes to data if'
        + ' you have previously selected AddNew on'
        + ' that data. Changes not Saved. To change'
        + ' this data you must reselect it, make'
        + ' changes and then press Save.'
        with style = popup;
      resume;
    endif;

    inquire_forms form (i = change);
    if (i = 1) then
      validate; /* validate all fields on form */

      i = callproc do_save; /* attempt to save the data */
      if (i = 0) then
        /* data saved successfully */
        set_forms form (change = 0);

        next;           /* Changes saved. Get next
                        ** screen of data. */
        commit work;    /* Release any locks acquired
                        ** while selecting data for 
                        ** the "next" statement.
                        */

 

      else /* error occurred */
        record_type = '';
        if (row_number > 0) then
          scroll tf to :row_number;
          row_number = 0;
          resume field tf;
        endif;
      endif;
    else
      message 'No changes to Save.' with style = popup;
    endif;
  end
  'Delete' (validate = 0, activate = 0,
    explanation = 
    'Delete current screen of data from Database') =
  begin
    current_op = 'Delete';

    /* Must prevent AddNew followed by Save or Delete. 
    ** Reasons:1. User may have changed keys before 
    ** selecting AddNew.Save/Delete assume hidden
    ** field/column versions of keys give
    ** true database identity of the displayed data.
    ** 2. Table field row _STATEs won't show just the 
    ** changes made since AddNew.
    */
    if (save_ok = 'n') then
      callproc beep; /* 4gl built-in procedure */
      message 'Error: You cannot Delete data if you have'
        + ' previously selected AddNew on that data.'
        + ' Data not Deleted. To Delete this data you'
        + ' must reselect it and then press Delete.'
        with style = popup;
      resume;
    endif;

    char1 = callproc confirm (
      question = 'Delete this master and all its details' 
                + ' from the Database?',
      no = 'Cancel the "Delete" operation.',
      yes = 'Delete this master and all its details.'
    );
    if (char1 = 'n') then
      resume;
    endif;

    i = callproc do_delete; /* attempt to delete the data */
    if (i = 0) then
      /* data deleted successfully */
      set_forms form (change = 0);

      next;          /* Data deleted. Get next
                     ** screen of data */
      commit work;   /* Release any locks acquired 
                     ** while selecting data for
                     ** the "next" statement.
                     */
    else             /* error occurred */
      record_type = '';
    endif;
  end

  'Next' (validate = 0, activate = 0,
    explanation = 'Display next row of selected data'),
    key frskey4 (validate = 0, activate = 0) =
  begin
    current_op = 'Next';

    if (verify_nothing_to_save() = 'n') then
      resume menu;
    endif;
    set_forms form (change = 0);
    next;
    commit work;    /* Release any locks acquired 
                    ** while selecting data for
                    ** the "Next" statement.
                    */
    save_ok = 'y';  /* 'Save' is okay now, because 
                    ** the AddNew menuitem has not
                    ** been run on this data.
                    */
  end

 

  'ListChoices' (validate = 0, activate = 0,
    explanation = 'Show valid values for current field'),
    key frskey10 (validate = 0, activate = 0) =
  begin
    current_op = 'ListChoices';

    callproc do_listchoices;
  end

  key frskey5 (explanation = 'Scroll to top of table field') =
  begin
    current_op = 'Top';

    if (verify_in_tf() = 'y') then
      scroll tf to 1;
    endif;
  end

  key frskey6 (explanation = 'Scroll to bottom of table field') =
  begin
    current_op = 'Bottom';

    if (verify_in_tf() = 'y') then
      scroll tf to end;
    endif;
  end

  key frskey7
  (explanation = 'Search table field for a specified value') =
  begin
    current_op = 'FindRecord';

    i = callproc find_record;
  end

  'Help' (validate = 0, activate = 0,
    explanation = 'Display help for this frame'),
    key frskey1 (validate = 0, activate = 0) =
  begin
    helpfile 'employees and employee_histories tables'
      '/m/corgi/supp60/employee/employees.hlp';
  end

  'End' (validate = 0, activate = 0,
    explanation = 'Return from Update mode to Query mode'),
    key frskey3 (validate = 0, activate = 0) =
  begin
    current_op = 'End';

    if (verify_nothing_to_save() = 'n') then
      resume menu;
    endif;
    endloop; /* exit submenu */
  end

  after field 'tf.position_code' =
  begin
    if (do_after_code() = 1) then
      resume;
    endif;
    resume next;
  end
  end; /* end of submenu in 'Go' menuitem */

  /* display mode reverts to prior mode ('query') after submenu */

  if (rows_found = 'y') then
    set_forms field samp_employees (mode(tf) = 'read');
    clear field all;
    set_forms form (change = 0);
  endif;
end /* end of 'Go' menuitem */

'AppendMode' (validate = 0, activate = 0,
  explanation = 'Display submenu for Appending new data') =
begin
  set_forms form (mode = 'update');
  set_forms field samp_employees (mode(tf) = 'fill');

  save_ok = 'n';   /* 'Save' is not okay now;
                   ** it's not on menu */
  display submenu
  begin

  'RowDelete' (validate = 0, activate = 0,
    explanation = 'Delete current row from table field') =
  begin
    current_op = 'RowDelete';

    if (verify_in_tf() = 'y') then
      deleterow tf;
      set_forms form (change = 1);
    endif;
  end

  'RowInsert' (explanation = 'Open new row in table field') =
  begin
    current_op = 'RowInsert';

    if (verify_in_tf() = 'y') then
      validrow tf; /* error if current row invalid */
      inquire_forms table '' (i = rowno);
      insertrow tf[i-1] (_state = 0);
    endif;
  end

  'AddNew' (activate = 1,
    explanation = 'Insert current screen data into database') =
  begin
    current_op = 'AddNew';

    validate; /* validate all fields on form */

    i = callproc do_addnew; /* attempt to save the data */
    if (i = 0) then
      /* data saved successfully */
      set_forms form (change = 0);

      mode 'fill';   /* display default values 
                     ** and clear simple fields*/
      set_forms form (mode = 'update'); /* cursor off
                                        ** query-only fields*/
      clear field tf;
    else             /* error occurred */
      record_type = '';
      if (row_number > 0) then
        scroll tf to :row_number;
        row_number = 0;
        resume field tf;
      endif;
    endif;
  end

  'ListChoices' (validate = 0, activate = 0,
    explanation = 'Show valid values for current field'),
    key frskey10 (validate = 0, activate = 0) =
  begin
    current_op = 'ListChoices';

    callproc do_listchoices;
  end

  key frskey5 (explanation = 'Scroll to top of table field') =
  begin
    current_op = 'Top';

    if (verify_in_tf() = 'y') then
      scroll tf to 1;
    endif;
  end

  key frskey6 (explanation = 'Scroll to bottom of table field') =
  begin
    current_op = 'Bottom';

    if (verify_in_tf() = 'y') then
      scroll tf to end;
    endif;
  end

  key frskey7 
  (explanation = 'Search table field for a specified value') =
  begin
    current_op = 'FindRecord';

    i = callproc find_record;
  end

  'Help' (validate = 0, activate = 0,
    explanation = 'Display help for this frame'),
    key frskey1 (validate = 0, activate = 0) =
  begin
    helpfile 'employees and employee_histories tables'
      '/m/corgi/supp60/employee/employees.hla';
  end

  'End' (validate = 0, activate = 0,
    explanation = 'Leave AppendMode and re-enter Query mode'),
    key frskey3 (validate = 0, activate = 0) =
  begin
    current_op = 'End';

    if (verify_nothing_to_save() = 'n') then
      resume menu;
    endif;
    endloop;            /* exit submenu */
  end 

 

  after field 'tf.position_code' =
  begin
    if (do_after_code() = 1) then
      resume;
    endif;
    resume next;
  end
  end;  /* end of submenu in 'AddNew' menu item */

  set_forms form (mode = 'query');
  set_forms field samp_employees (mode(tf) = 'read');
  clear field all;
end

'Clear' (validate = 0, activate = 0,
  explanation = 'Clear all fields') =
begin
  clear field all;
end

'ListChoices' (validate = 0, activate = 0,
  explanation = 'Show valid values for current field'),
  key frskey10 (validate = 0, activate = 0) =
begin
  current_op = 'ListChoices';

  callproc do_listchoices;
end

'Help' (validate = 0, activate = 0,
  explanation = 'Display help for this frame'),
  key frskey1 (validate = 0, activate = 0) =
begin
  helpfile 'employees and employee_histories tables'
    '/m/corgi/supp60/employee/employees.hlq';
end

'end' (validate = 0, activate = 0,
  explanation = 'Return to previous frame'),
  key frskey3 (validate = 0, activate = 0) =
begin
  return;
end

/*
** Local procedure: do_addnew
**
** Description:
**       Attempts to add the data in the current screen to the
**       database.
**
**       the caller must validate the data in the screen
**       before calling this procedure.
**
** Returns:
**       0 if data saved successfully.
**       1 if an error occurred.
*/

procedure do_addnew =
begin
  message 'Saving new data . . .';

  record_type = 'master';

  repeated insert
  into employees(ssn, last_name, first_name, initial,
    last_updated_at, last_updated_by)
  values(ssn, last_name, first_name, initial, 
    'now', user_name);

  if (check_io_err() != 0) then
    return 1;
  endif;

  record_type = 'detail';
  unloadtable tf (row_state = _state, row_number = _record)
  begin
    /* insert new, unchanged & changed rows */
    if ((row_state = 1) or (row_state = 2) or (row_state = 3)) then

      /* Try to insert the new detail record into 
      ** employee_histories. Instead of using a
      ** straightforward VALUES clause,
      ** use an artificial subselect that is equivalent
      ** to a VALUES clause, except that it will insert 
      ** nothing if the position_code in the new detail 
      ** record has been deleted from the positions 
      ** table since it was loaded into the tablefield
      ** (or entered by the user).
      */
      repeated insert
      into employee_histories(ssn, start_date,
        position_code, salary)
      select :ssn, :tf.start_date,
        :tf.position_code, :tf.salary
      from positions dl
      where dl.position_code = :tf.position_code;
      if (check_io_err() != 0) then
        return 1;
      endif;

      inquire_sql (row_count = rowcount);
      if row_count <= 0 then
        rollback work;
        message 'The "Save" operation was not '
          + ' performed, because the position_code'
          + ' in a detail record has been deleted'
          + ' from the positions table by another'
          + ' user while you were updating the'
          + ' tablefield. The cursor will be'
          + ' placed on the row where the error'
          + ' occurred. Tab to Position Code and'
          + ' select ListChoices to see which'
          + ' position codes are now available.'
          with style = popup;
        return 1;
      endif;
    endif;
  end;

  row_number = 0;
  record_type = '';

  commit work;

  if (check_io_err() != 0) then
    return 1;
  endif;

  return 0;
end /* end of do_addnew */

/*
** Local procedure: do_save
**
** Description:
**      Attempts to update the database using the data in the 
**      current screen.
**
**      the caller must verify that the form contains
**      changed data and validate it before calling this procedure.
**
** Returns:
**       0 if data saved successfully.
**       1 if an error occurred.
*/
procedure do_save =
declare
  need_check = char(1) not null,
begin
  message 'Saving changes . . .';

  /* The logic below may require modification in case of rules
  ** or referential integrities on master data. For example,
  ** if a master update changes the value of join field,
  ** and that fires a rule that changes the join key value
  ** for all matching detail data, then that could cause
  ** detail updates to fail (rowcount=0).
  */
  record_type = 'master';

  repeated update employees
  set ssn = :ssn,
    last_name = :last_name, first_name = :first_name,
    initial = :initial, last_updated_at = 'now',
    last_updated_by = :user_name
  where ssn = :hid_ssn and last_updated_at = :last_updated_at;

  if (check_io_err() != 0) then
    return 1;
  endif;

  inquire_sql (row_count = rowcount);
  if row_count <= 0 then
    rollback work;
    message 'The "Save" operation was not performed,'
      + ' because the master record (or one of its details)'
      + ' has been updated or deleted'
      + ' by another user since you selected it.'
      + ' Before selecting "Next" or "End", you may wish'
      + ' to (1) make a note of your changes,'
      + ' or (2) change the key (ssn) and select "AddNew".'
      + ' In either case, you should subsequently'
      + ' (1) determine what happened to the record'
      + ' (e.g. by attempting to re-select it)'
      + ' and (2) reconcile your changes'
      + ' with the other users'' changes.'
      with style = popup;
    save_ok = 'n';
    return 1;
  endif;

  record_type = 'detail';

  /* Process the deleted rows before other rows.
  ** If we process deleted rows last, which is the order
  ** that Unloadtable delivers them in, then if
  ** a row with an identical key is deleted and then inserted
  ** into the table field before the user selects Save,
  ** we will erroneously attempt the insert before the 
  ** delete, and the insert will fail (duplicate key).
  */
  unloadtable tf (row_state = _state, row_number = _record)
  begin
    if (row_state = 4) then /* deleted */

      /* delete row using hidden field keys in where clause. */
      repeated delete from employee_histories
      where ssn = :hid_ssn and start_date = :tf.hid_start_date;

      if (check_io_err() != 0) then
        return 1;
      endif;
    endif;
  end; /* end of first unloadtable */

  /* process all but Deleted rows */
  unloadtable tf (row_state = _state, row_number = _record)
  begin
    need_check = 'n';

    if (row_state = 1) then /* new */

      /* Try to insert the new detail record into 
      ** employee_histories. Instead of using a
      ** straightforward VALUES clause,
      ** use an artificial subselect which is equivalent
      ** to a VALUES clause, except that it inserts nothing
      ** if the position_code in the new detail record
      ** has been deleted from the positions table since 
      ** it was loaded into the tablefield (or entered
      ** by the user).
      */

      repeated insert
      into employee_histories(ssn, start_date,
        position_code, salary)
      select :ssn, :tf.start_date,
        :tf.position_code, :tf.salary
      from positions dl
      where dl.position_code = :tf.position_code;

      need_check = 'y';

    elseif (row_state = 3) /* table field data changed */
      or (row_state = 2 and 
      ssn != hid_ssn) /* join field changed */
    then

      /* Try to update the detail record in 
      ** employee_histories. Use the hidden version of
      ** the key field in the WHERE clause.
      ** Also add an artificial condition to the WHERE 
      ** clause to ensure that no rows are updated
      ** if the position_code in the detail record
      ** has been deleted from the positions table since 
      ** it was loaded into the tablefield (or entered
      ** by the user).
      */
      repeated update employee_histories d
      from positions dl
      set ssn = :ssn, start_date = :tf.start_date,
        position_code = :tf.position_code,
        salary = :tf.salary
      where d.ssn = :hid_ssn 
      and d.start_date = :tf.hid_start_date
      and dl.position_code = :tf.position_code;

      need_check = 'y';
    endif;

    if (need_check = 'y') then

      if (check_io_err() != 0) then
        return 1;
      endif;

      inquire_sql (row_count = rowcount);
      if row_count <= 0 then
        rollback work;
        message 'The "Save" operation was not'
          + ' performed, because the position_code'
          + ' in a detail record has been deleted'
          + ' from the positions table by another'
          + ' user while you were updating'
          + ' the tablefield.'
          + ' The cursor will be placed on the row'
          + ' where the error occurred.'
          + ' Tab to Position Code and'
          + ' select ListChoices to see which'
          + ' position codes are now available.'
          with style = popup;
        return 1;
      endif;
    endif;
  end; /* end of second unloadtable */

  row_number = 0;
  record_type = '';

  commit work;

  if (check_io_err() != 0) then
    return 1;
  endif;

  return 0;
end /* end of do_save */
/*
** Local procedure: do_delete
**
** Description:
**       Attempts to delete the master in the current screen
**       and all its details from the database.
**
**       the caller is responsible for any prompting
**       (e.g. 'Are you sure you want to delete').
**
** Returns:
**       0 if data deleted successfully.
**       1 if an error occurred.
*/

procedure do_delete =
begin
  message 'Deleting . . .';

  record_type = 'master';

  repeated delete from employees
  where ssn = :hid_ssn and last_updated_at = :last_updated_at;

  if (check_io_err() != 0) then
    return 1;
  endif;

  inquire_sql (row_count = rowcount);
  if row_count <= 0 then
    rollback work;
    message 'The "Delete" operation was not performed,'
      + ' because the master record (or one of its'
      + ' details) has been updated or deleted'
      + ' by another user since you selected it.'
      + ' After selecting "Next" or "End", you may wish'
      + ' to determine what happened to the master'
      + ' record (e.g. by trying to re-select it).'
      with style = popup;
    save_ok = 'n';
    return 1;
  endif;

  record_type = 'detail';

  repeated delete from employee_histories
  where ssn = :hid_ssn;

  if (check_io_err() != 0) then
    return 1;
  endif;

  record_type = '';

  commit work;

  if (check_io_err() != 0) then
    return 1;
  endif;

  return 0;
end /* end of do_delete */

/*
** Local procedure: check_io_err
**
** Description:
**       Checks to see if the last database I/O statement
**       executed properly; does a ROLLBACK and puts out an
**       error message if not. Note that if an error *has*
**       occurred, the DBMS has already issued its own
**       error message.
**
** Returns:
**       The error number generated by the database I/O statement
**       (0 if no error).
*/

 

procedure check_io_err =
declare
  err_data_loc = varchar(80) not null,
  cursor_msg = varchar(80) not null,
  correct_msg = varchar(80) not null,
begin
  inquire_sql (error_no = dbmserror);
  if (error_no = 0) then
    return 0;
  endif;
  if (record_type = '') then
    err_data_loc = '';
  else
    err_data_loc = ' The error occurred on a ' +
                      record_type + ' record.';
  endif;
  if (row_number <= 0) then
    cursor_msg = '';
  else
    cursor_msg = ' The cursor will be placed on the row'
      + ' where the error occurred.';
  endif;

  if (error_no = 4700) then   /* deadlock (DBMS has 
                              ** already done ROLLBACK) */
    correct_msg = '';         /* nothing to fix on a
                              ** deadlock; just retry */
  else
    correct_msg = ' correct the error (if possible) and';
    rollback work;
  endif;
  Message 'the "' + current_op + '" Operation Was Not Performed,'
    + ' due to the error described in the previous message.'
    + err_data_loc + cursor_msg
    + ' Please' + correct_msg + ' select "' + current_op'
    + '" again.'
    with style = popup;
  return error_no;3
end

/*
** Local procedure: do_listchoices
**
** Description:
**       Implements the ListChoices activation for the main menu
**       and both submenus.**
** Returns: none.
*/ 
procedure do_listchoices =
declare
  value_selected = integer not null,   /* if > 0, indicates value
                                       ** selected onto form */
begin
  value_selected = 0;
  inquire_forms field '' (obj_name = name);
  if (obj_name = 'tf') then /* cursor in table field */

    /* Skip look_up call if table field is empty
    ** (Returns an error if you read from or assign
    ** to an empty table field) 
    */
    inquire_forms table '' (i = datarows('tf'));
    if (i >0) then
      inquire_forms table '' (obj_name = column);
      if (obj_name = 'position_code') then

        value_selected = callframe look_up (
          ii_rows = 10;
          ii_query = select distinct position_code,
                            position_title, position_description
                      from positions
                      order by position_code,
                        position_title;
          ii_field1 = 'position_code';
          ii_field2 = 'position_title';
          ii_field3 = 'position_description';
          ii_titles = 1;
          ii_field_title1 = 'Position Code';
          ii_field_title2 = 'Position Title';
          ii_field_title3 = 'Position Description';
          position_code = byref(tf.hid_position_code);
          position_title =
            byref(tf.position_title)
        );
        if (value_selected > 0) then
          tf.position_code =
            tf.hid_position_code;
          commit work; /* release shared locks on
                        ** lookup table */
        endif;
      endif;
    endif;
  endif;

 

  if (value_selected <= 0) then
    /* No look_up available for current field */
    value_selected = callproc help_field;
  endif;

  if (value_selected > 0) then
    /* value was selected onto form */
    set_forms form (change = 1);
  endif;

  return;
end

/*
** Local procedure: do_after_code
**
** Description:
**       Implements the AFTER FIELD 'tf.position_code' 
**       activation for the main menu and both submenus.
**
**       If the field has changed and the form is not in query
**       mode, the position_title field is derived from 
**       the position_code field via the positions table. If 
**       the position_code is not found in the positions table,
**       an error is displayed (indicating that the
**       position_code is invalid).
**
** Returns:
**       0 if tf.position_code is valid
**       1 if tf.position_code is invalid
*/

procedure do_after_code =

begin
  inquire_forms row '' '' (i = change);
  inquire_forms form (obj_name = mode);
  if (i = 1) and (uppercase(obj_name) != 'QUERY') then

    samp_employees := repeated select
      :tf[].position_code = positions.position_code,
      :tf[].position_title =
        positions.position_title
    from positions
    where positions.position_code = :tf.position_code;

    inquire_sql (row_count = rowcount);
    if row_count <= 0 then
      callproc beep; /* 4gl built-in function */
      message '"' + ifnull(varchar(:tf.position_code), '') +
        '" is not a valid value for this field' +
        ' (select ListChoices for help).'
        with style = popup;
      set_forms row '' '' (change = 1);
      return 1;
    endif;
    commit work;     /* release shared locks on
                     ** lookup table */
  endif;
  return 0;
end

/*
** Local procedure: verify_in_tf
**
** Description:
**       Checks to see if cursor is positioned in the table 
**       field; puts out error message if not.
**
** Returns:
**       'y' if in the table field.
**       'n' if not in the table field.
*/
procedure verify_in_tf =
begin
  inquire_forms field '' (i = table);
  if (i = 1) then
    return 'y';
  endif;
  callproc beep; /* 4gl built-in procedure */
  message 'You can only "' + current_op +
    '" when your cursor is in a table field.'
    with style = popup;
  return 'n';
end

/*
** Local procedure: verify_nothing_to_save
**
** Description:
**       Checks to see if anything has changed on the form
**       (and is thus a candidate for a Save). If so, the user
**       is prompted as to whether these changes
**       should be saved. The prompting is done via the
**       procedure "confirm".
**
** Returns:
**       'y' if nothing has changed, or if the user 
**       says to discard the changes.
**       'n' if something has changed, and the user 
**       says the changes must be saved.
*/
procedure verify_nothing_to_save =
declare
  save_op = varchar(8) not null,
begin
  inquire_forms form (i = change);
  if (i = 0) then
    return 'y';
  endif;

  if (save_ok = 'y') then
    save_op = ' Save or';
  else
    save_op = '';
  endif;

  return confirm (
    question = 'Do you wish to "' + current_op +
      '" without saving changes?',
    no = 'Cancel the "' + current_op + '" operation.' +
      ' (You can then save your changes by selecting' +
      save_op + ' AddNew).',
    yes = '"' + current_op + '" without saving changes.'
  );
end