Was this helpful?
Employees Frame
The Employees frame uses the Employees table and Employee_histories table in a Master/Detail relationship. A user can display a record (or, by entering a qualification, a set of records) from the Employees table and corresponding records from the Employee_histories table. If desired, the user then can update a selected record or add new records.
The following figure shows the form for the Employees frame:
The form components have the following names:
The table field is named "tf"
The table field columns are named "start_date," "position_code," "position_description," and "salary"
The simple fields are named "ssn," "last_name," "first_name," "initial," "last_updated_at," and "last_updated_by"
The "last_updated_at" and "last_updated_by" columns are display-only. When a row in the Employee_histories table is updated, the "last_updated_at" and "last_updated_by" columns in the corresponding row of the Employees table are updated to indicate when and by whom each row was last updated.
The "last_updated_at" column is used to implement an optimistic locking scheme as follows:
The DBMS does not hold any locks before the user saves data to the database.
A commit or rollback statement is issued if needed to release locks before issuing a prompt or message or before exiting from an activation.
The update and delete statements are coded to fail if another user has changed the same records (as determined by checking the "last_updated_at" column).
The frame uses the Positions table as a lookup table to ensure the validity of a user-specified position_code, and to obtain the corresponding position_title and position_description. A select statement is used to populate the lookup table with data.
When a user selects ListChoices with the cursor in the "position_code" field after having selected data, the window displays a table field containing the valid position codes. The following figure shows this window.
Because the "position_description" column is of type varchar(1900), the table is too wide to display as a pop-up. Therefore, the lookup table is displayed full screen. The column "position_description" is scrollable.
Menu Operations
The Employees frame provides the following menu operations:
Menu Item
Function
Go
Displays a Master record and all corresponding Detail records
If the user has entered a qualification into a field of the Master table and then presses Go, displays the first record (in alphabetical order by last name) that meets the qualification. The user then can use the Next operation to page through any additional selected records.
After a Master record (and any Detail records) is displayed, the frame is put into update mode and displays a submenu as described in the table Go and AppendMode Submenu Operations.
AppendMode
Puts the frame into append mode and lets the user add new records, and displays a submenu as described in the table Go and AppendMode Submenu Operations.
Clear
Clears all data from the screen
ListChoices
Displays format information about the field on which the cursor is positioned
Help
Displays information about this frame
End
Returns to the previous frame
The following operations are available after a user has selected Go or AppendMode:
Menu Item
Function
RowDelete
Deletes the current row from the table field
RowInsert
Inserts a blank row into the table field so that the user can add a new Detail record
AddNew
Saves a changed Master record and its Detail records (if any) to the database without overwriting the original records
Save (Go submenu only)
Writes the user's changes to the database.
Delete (Go submenu only)
Deletes a Master record and any corresponding Detail records.
Next (Go submenu only)
Displays the next record from the Master table.
If the user has entered a qualification, this is the next record that meets the qualification.
ListChoices
When the cursor is positioned on the "Position Code" table field column, displays a list of valid position codes and descriptions from which the user can select.
(On other fields or table field columns, ListChoices displays format information about the field or column.)
Help
Displays information about the current frame.
End
Clears the screen and returns the frame to query mode.
4GL Source Code
The following is the complete Linux 4GL source code file for the Employees frame. The code for the frame's local procedures follows the basic frame processing code.
Note the equivalent 4GL source code for other systems is nearly identical to this Linux example. The only difference is the format of the helpfile pathnames.
/*
** 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
Last modified date: 11/09/2022