?? RIGHT := 110 ??
?? NEWTITLE := 'NOS/VE Screen Formating: Process Program Requests' ??
MODULE fdm$process_program_requests;

{ PURPOSE:
{   This module processes CYBIL application program requests that
{   interact with a terminal user through a previously defined form.
{
{ DESIGN:
{   Record data about the screen updates until a read or show call occurs.

?? LIBRARY := 'MLF$LIBRARY' ??

?? NEWTITLE := 'Global Declarations Referenced by This Module', EJECT ??

?? PUSH (LISTEXT := ON) ??
*copyc amk$base_keypoint_values
*copyc cyd$run_time_error_condition
*copyc fdc$im_smart_capability
*copyc fdc$integer_length
*copyc fdc$message_variable_length
*copyc fdc$real_length
*copyc fdc$screen_formatting_version
*copyc fdc$system_display_name
*copyc fdc$system_exponent_character
*copyc fde$condition_identifiers
*copyc fdk$screen_formatting_keypoints
*copyc fdt$current_form_identifier
*copyc fdt$display_index
*copyc fdt$event_index
*copyc fdt$event_position
*copyc fdt$form_object_definition
*copyc fdt$form_object_key
*copyc fdt$input_format
*copyc fdt$screen_change_index
*copyc fdt$valid_integer_index
*copyc fdt$valid_string_index
*copyc fdt$valid_real_index
*copyc fdt$variable_status
*copyc fdt$variable_value
*copyc fdt$work_area_length
*copy i#build_adaptable_array_ptr
*copyc lle$loader_status_conditions
*copyc ost$name
?? POP ??
*copyc fdv$colors
*copyc fdv$line_attributes
*copyc fdv$screen_status

*copyc clp$convert_date_time_to_string
*copyc clp$convert_string_to_date_time
*copyc clp$validate_date_time
*copyc clp$validate_name
*copyc fdp$change_currency_symbols
*copyc fdp$check_for_active_form
*copyc fdp$create_cobol_description
*copyc fdp$date_variable
*copyc fdp$delete_area
*copyc fdp$find_display_name
*copyc fdp$find_form_definition
*copyc fdp$find_form_status
*copyc fdp$find_object_definition
*copyc fdp$find_table_definition
*copyc fdp$find_variable_definition
*copyc fdp$locate_added_variable_facts
*copyc fdp$move_cobol_data
*copyc fdp$ptr_comments
*copyc fdp$ptr_displays
*copyc fdp$ptr_events
*copyc fdp$ptr_objects
*copyc fdp$ptr_screen_variable
*copyc fdp$ptr_table_objects
*copyc fdp$ptr_table_variables
*copyc fdp$ptr_tables
*copyc fdp$ptr_record_definitions
*copyc fdp$ptr_text
*copyc fdp$ptr_valid_integers
*copyc fdp$ptr_valid_reals
*copyc fdp$ptr_valid_strings
*copyc fdp$ptr_variable
*copyc fdp$ptr_variables
*copyc fdp$tab_to_next_variable
*copyc i#move
*copyc mlp$compare_bytes
*copyc mlp$input_floating_number
*copyc mlp$input_integer
*copyc mlp$move_bytes
*copyc mlp$output_floating_number
*copyc mlp$output_integer
*copyc mlp$scan_bytes
*copyc mlp$translate_bytes
*copyc mmp$delete_scratch_segment
*copyc osp$append_status_integer
*copyc osp$append_status_parameter
*copyc pmp$this_is_a_leap_year
*copyc pmp$continue_to_cause
*copyc osp$establish_condition_handler
*copyc osp$format_message
*copyc osp$set_status_abnormal
*copyc osp$set_status_condition

?? TITLE := 'Global Declarations Declared by This Module', EJECT ??

  CONST
    fdc$forms_to_expand = 7,
    fdc$screen_changes_to_expand = 10;

{ Date format strings.

  CONST
    fdc$dmy_format_string = 'd2/m2/y2',
    fdc$iso_format_string = 'isod',
    fdc$mdy_format_string = 'm2/d2/y2',
    fdc$month_format_string = 'month',
    fdc$ydm_format_string = 'y2/d2/m2';

?? TITLE := 'fdp$add_form', EJECT ??
*copyc fdh$add_form

  PROCEDURE [XDCL] fdp$add_form
    (    form_identifier: fdt$form_identifier;
     VAR status: ost$status);

    VAR
      event_form_identifier: fdt$form_identifier,
      form_added: boolean,
      local_status: ost$status,
      p_form_definition: ^fdt$form_definition,
      p_form_status: ^fdt$form_status,
      screen_change: fdt$screen_change;

?? NEWTITLE := 'condition_handler', EJECT ??

    PROCEDURE condition_handler
      (    condition: pmt$condition;
           condition_information: ^pmt$condition_information;
           stack_frame_save_area: ^ost$stack_frame_save_area;
       VAR handler_status: ost$status);

      CASE condition.selector OF

      = pmc$system_conditions =
        IF (condition.system_conditions * $pmt$system_conditions
              [pmc$instruction_specification, pmc$address_specification, pmc$access_violation,
              pmc$invalid_segment_ring_0, pmc$divide_fault, pmc$arithmetic_overflow, pmc$exponent_overflow,
              pmc$exponent_underflow, pmc$fp_significance_loss, pmc$fp_indefinite,
              pmc$arithmetic_significance, pmc$invalid_bdp_data]) <> $pmt$system_conditions [] THEN
          osp$set_status_abnormal (fdc$format_display_identifier, fde$bad_data_value, '', status);
          EXIT fdp$add_form;
        IFEND;

      = pmc$user_defined_condition =
        IF condition.user_condition_name = cye$run_time_condition THEN
          osp$set_status_abnormal (fdc$format_display_identifier, fde$bad_data_value, '', status);
          EXIT fdp$add_form;
        IFEND;

      ELSE
        ;
      CASEND;
      pmp$continue_to_cause (pmc$execute_standard_procedure, handler_status);
    PROCEND condition_handler;

?? OLDTITLE, EJECT ??
    osp$establish_condition_handler (^condition_handler, FALSE);
    fdp$find_form_status (form_identifier, p_form_status, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    IF p_form_status^.added THEN
      osp$set_status_abnormal (fdc$format_display_identifier, fde$form_already_added,
            p_form_status^.p_form_definition^.form_name, status);
      RETURN;
    IFEND;

    IF p_form_status^.combined THEN
      osp$set_status_abnormal (fdc$format_display_identifier, fde$form_already_combined,
            p_form_status^.p_form_definition^.form_name, status);
      RETURN;
    IFEND;

    IF p_form_status^.push_count <> 0 THEN
      osp$set_status_abnormal (fdc$format_display_identifier, fde$form_pushed,
            p_form_status^.p_form_definition^.form_name, status);
      RETURN;
    IFEND;

{ Form must fit on terminal screen.

    p_form_definition := p_form_status^.p_form_definition;
    check_form_screen_fit (p_form_status^.form_x_position, p_form_status^.form_y_position,
          p_form_definition^.width, p_form_definition^.height, p_form_definition^.form_name, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

{ Remove any duplicate screen changes.

    fdp$delete_screen_changes (form_identifier, form_added);

{ Record add of form to screen. The form will be displayed when the screen is updated.

    screen_change.key := fdc$add_form;
    screen_change.form_identifier := form_identifier;
    screen_change.form_x_position := p_form_status^.form_x_position;
    screen_change.form_y_position := p_form_status^.form_y_position;
    fdp$record_screen_change (screen_change, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    p_form_status^.added := TRUE;
    p_form_status^.push_count := 0;

{ Update form priority. Higher priority  forms  cover up lower
{ priority forms. The last added form is the highest priority form.

    p_form_status^.next_lower_form := fdv$screen_status.current_form_identifier;
    p_form_status^.next_higher_form := 0;
    IF fdv$screen_status.current_form_identifier <> 0 THEN
      fdv$screen_status.p_forms_status^ [fdv$screen_status.current_form_identifier].next_higher_form :=
            form_identifier;
    IFEND;

    fdv$screen_status.current_form_identifier := form_identifier;
    fdv$screen_status.compute_new_screen_size := TRUE;
    fdv$screen_status.last_cursor_position_valid := FALSE;

{ If an event form is associated with the added form, combine the event form with the added form.
{ The event form inherits the events of the added form so that any terminal user events on the
{ event form act in the same way as the added form.

    IF p_form_status^.event_form_defined THEN
      event_form_identifier := p_form_status^.event_form_identifier;
      fdp$combine_form (form_identifier, event_form_identifier, status);
      IF NOT status.normal THEN
        fdp$delete_form (form_identifier, local_status);
        RETURN;
      IFEND;
    IFEND;
  PROCEND fdp$add_form;

?? TITLE := 'fdp$change_table_size', EJECT ??
*copy fdh$change_table_size

  PROCEDURE [XDCL] fdp$change_table_size
    (    form_identifier: fdt$form_identifier;
         table_name: ost$name;
         table_size: fdt$table_size;
     VAR status: ost$status);

    VAR
      name_exists: boolean,
      object_index: fdt$object_index,
      p_form_definition: ^fdt$form_definition,
      p_form_module: ^fdt$form_module,
      p_form_object_definition: ^fdt$form_object_definition,
      p_form_object_definitions: ^array [1 .. * ] of fdt$form_object_definition,
      p_form_object_statuses: ^array [1 .. * ] of fdt$form_object_status,
      p_form_status: ^fdt$form_status,
      p_form_table_definition: ^fdt$form_table_definition,
      p_table_object: ^fdt$table_object,
      p_table_objects: ^array [1 .. * ] of fdt$table_object,
      p_table_variables: ^array [1 .. * ] of fdt$table_variable,
      screen_change: fdt$screen_change,
      table_index: fdt$table_index,
      table_object_index: fdt$object_index,
      table_variable_index: fdt$variable_index,
      valid_name: ost$name;

?? NEWTITLE := 'condition_handler', EJECT ??

    PROCEDURE condition_handler
      (    condition: pmt$condition;
           condition_information: ^pmt$condition_information;
           stack_frame_save_area: ^ost$stack_frame_save_area;
       VAR handler_status: ost$status);

      CASE condition.selector OF

      = pmc$system_conditions =
        IF (condition.system_conditions * $pmt$system_conditions
              [pmc$instruction_specification, pmc$address_specification, pmc$access_violation,
              pmc$invalid_segment_ring_0, pmc$divide_fault, pmc$arithmetic_overflow, pmc$exponent_overflow,
              pmc$exponent_underflow, pmc$fp_significance_loss, pmc$fp_indefinite,
              pmc$arithmetic_significance, pmc$invalid_bdp_data]) <> $pmt$system_conditions [] THEN
          osp$set_status_abnormal (fdc$format_display_identifier, fde$bad_data_value, '', status);
          EXIT fdp$change_table_size;
        IFEND;

      = pmc$user_defined_condition =
        IF condition.user_condition_name = cye$run_time_condition THEN
          osp$set_status_abnormal (fdc$format_display_identifier, fde$bad_data_value, '', status);
          EXIT fdp$change_table_size;
        IFEND;

      ELSE
        ;
      CASEND;
      pmp$continue_to_cause (pmc$execute_standard_procedure, handler_status);
    PROCEND condition_handler;

?? OLDTITLE, EJECT ??
    osp$establish_condition_handler (^condition_handler, FALSE);
    fdp$find_form_status (form_identifier, p_form_status, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    IF p_form_status^.push_count <> 0 THEN
      osp$set_status_abnormal (fdc$format_display_identifier, fde$form_pushed,
            p_form_status^.p_form_definition^.form_name, status);
      RETURN;
    IFEND;

    p_form_definition := p_form_status^.p_form_definition;
    #translate (osv$lower_to_upper, table_name, valid_name);
    fdp$find_table_definition (valid_name, p_form_status^.p_form_table_definitions,
          p_form_definition^.form_table_definitions.active_number, p_form_table_definition, table_index,
          name_exists);
    IF NOT name_exists THEN
      osp$set_status_abnormal (fdc$format_display_identifier, fde$unknown_table_name, table_name, status);
      osp$append_status_parameter (osc$status_parameter_delimiter, p_form_definition^.form_name, status);
      RETURN;
    IFEND;

    IF ((table_size < 0) OR (table_size > p_form_table_definition^.stored_occurrence)) THEN
      osp$set_status_abnormal (fdc$format_display_identifier, fde$invalid_table_size, table_name, status);
      osp$append_status_parameter (osc$status_parameter_delimiter, p_form_definition^.form_name, status);
      RETURN;
    IFEND;

    p_form_status^.p_form_table_statuses^ [table_index].last_active_occurrence := table_size;
    p_form_module := p_form_status^.p_form_module;
    p_form_object_definitions := p_form_status^.p_form_object_definitions;
    p_form_object_statuses := p_form_status^.p_form_object_statuses;
    p_table_variables := fdp$ptr_table_variables (p_form_table_definition^.table_variables, p_form_module);

{ Make objects visible or invisible.  Table size number of objects are made visible.
{ The remaining objects are made invisible.

    FOR table_variable_index := 1 TO p_form_table_definition^.table_variables.active_number DO
      p_table_objects := fdp$ptr_table_objects (p_table_variables^ [table_variable_index].table_objects,
            p_form_module);
      FOR table_object_index := 1 TO table_size DO
        p_table_object := ^p_table_objects^ [table_object_index];
        object_index := p_table_object^.object_index;
        p_form_object_definition := ^p_form_object_definitions^ [object_index];
        p_form_object_statuses^ [object_index].display_attribute_set :=
              p_form_object_definition^.display_attribute;
      FOREND;

      FOR table_object_index := 1 + table_size TO p_form_table_definition^.stored_occurrence DO
        p_table_object := ^p_table_objects^ [table_object_index];
        object_index := p_table_object^.object_index;
        p_form_object_definition := ^p_form_object_definitions^ [object_index];
        p_form_object_statuses^ [object_index].display_attribute_set :=
              (p_form_object_definition^.display_attribute * fdv$colors) +
              $fdt$display_attribute_set [fdc$protect, fdc$hidden];
      FOREND;
    FOREND;

    IF p_form_status^.displayed_on_screen AND (p_form_status^.added OR p_form_status^.combined) THEN
      screen_change.key := fdc$change_table_size;
      screen_change.table_form_identifier := form_identifier;
      screen_change.table_index := table_index;
      fdp$record_screen_change (screen_change, status);
    IFEND;
  PROCEND fdp$change_table_size;

?? TITLE := 'fdp$close_form', EJECT ??
*copy fdh$close_form

  PROCEDURE [XDCL] fdp$close_form
    (    form_identifier: fdt$form_identifier;
     VAR status: ost$status);

    VAR
      event_form_identifier: fdt$form_identifier,
      form_added: boolean,
      local_status: ost$status,
      p_form_status: ^fdt$form_status,
      p_form_object_statuses: ^array [1 .. * ] of fdt$form_object_status,
      screen_change: fdt$screen_change;

?? NEWTITLE := 'condition_handler', EJECT ??

    PROCEDURE condition_handler
      (    condition: pmt$condition;
           condition_information: ^pmt$condition_information;
           stack_frame_save_area: ^ost$stack_frame_save_area;
       VAR handler_status: ost$status);

      CASE condition.selector OF

      = pmc$system_conditions =
        IF (condition.system_conditions * $pmt$system_conditions
              [pmc$instruction_specification, pmc$address_specification, pmc$access_violation,
              pmc$invalid_segment_ring_0, pmc$divide_fault, pmc$arithmetic_overflow, pmc$exponent_overflow,
              pmc$exponent_underflow, pmc$fp_significance_loss, pmc$fp_indefinite,
              pmc$arithmetic_significance, pmc$invalid_bdp_data]) <> $pmt$system_conditions [] THEN
          osp$set_status_abnormal (fdc$format_display_identifier, fde$bad_data_value, '', status);
          EXIT fdp$close_form;
        IFEND;

      = pmc$user_defined_condition =
        IF condition.user_condition_name = cye$run_time_condition THEN
          osp$set_status_abnormal (fdc$format_display_identifier, fde$bad_data_value, '', status);
          EXIT fdp$close_form;
        IFEND;

      ELSE
        ;
      CASEND;
      pmp$continue_to_cause (pmc$execute_standard_procedure, handler_status);
    PROCEND condition_handler;

?? OLDTITLE, EJECT ??
    osp$establish_condition_handler (^condition_handler, FALSE);
    fdp$find_form_definition (form_identifier, p_form_status, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

{ A form owned by the system is in the process of being closed.
{ Screen Formatting needs to keep some data about the form until the screen is updated.

    IF ((NOT p_form_status^.opened) AND (p_form_status^.owned_by_system)) THEN
      osp$set_status_abnormal (fdc$format_display_identifier, fde$invalid_form_identifier, '', status);
      osp$append_status_integer (osc$status_parameter_delimiter, $INTEGER (form_identifier), 10, FALSE,
            status);
      RETURN;
    IFEND;

{ A pushed form cannot be closed.

    IF p_form_status^.push_count <> 0 THEN
      osp$set_status_abnormal (fdc$format_display_identifier, fde$form_pushed,
            p_form_status^.p_form_definition^.form_name, status);
      RETURN;
    IFEND;

{ Remove any duplicate screen changes.

    fdp$delete_screen_changes (form_identifier, form_added);

    IF p_form_status^.displayed_on_screen THEN

{ Record close of form as a screen change. Keep a record of the form until the
{ screen is updated in order to know what forms are uncovered
{ by the closed form.

        screen_change.key := fdc$close_form;
        screen_change.close_form_identifier := form_identifier;
        fdp$record_screen_change (screen_change, local_status);
        fdv$screen_status.compute_new_screen_size := TRUE;
        IF ((fdv$screen_status.last_cursor_position_valid) AND
              (fdv$screen_status.last_cursor_form_identifier = form_identifier)) THEN
          fdv$screen_status.last_cursor_position_valid := FALSE;
        IFEND;

      ELSE

{ Form is not displayed on screen.  There is no need to record changes to
{ screen.

        IF p_form_status^.p_form_object_statuses <> NIL THEN
          FREE p_form_status^.p_form_object_statuses;
        IFEND;

        IF p_form_status^.defined_dynamically THEN
          mmp$delete_scratch_segment (p_form_status^.segment_pointer, local_status);
        IFEND;
    IFEND;

{ Free storage associated with the  form.

    IF p_form_status^.p_program_record <> NIL THEN
      FREE p_form_status^.p_program_record;
    IFEND;

    IF p_form_status^.p_screen_record <> NIL THEN
      FREE p_form_status^.p_screen_record;
    IFEND;

    IF p_form_status^.p_form_table_statuses <> NIL THEN
      FREE p_form_status^.p_form_table_statuses;
    IFEND;

    IF p_form_status^.p_form_event_statuses <> NIL THEN
      FREE p_form_status^.p_form_event_statuses;
    IFEND;

    IF p_form_status^.p_form_image <> NIL THEN
      FREE p_form_status^.p_form_image;
    IFEND;

{ Remove form from list recording priorities of forms.

    IF p_form_status^.added THEN
      update_form_priorities (p_form_status);
      p_form_status^.added := FALSE;
    IFEND;

    IF p_form_status^.combined THEN
      update_form_priorities (p_form_status);
      p_form_status^.combined := FALSE;
    IFEND;

{ Also close any associated event form.
{ Since the application program may have closed the event form
{ disregard errors on close.

    IF p_form_status^.event_form_defined THEN
      event_form_identifier := p_form_status^.event_form_identifier;
      fdp$close_form (event_form_identifier, local_status);
      p_form_status^.event_form_defined := FALSE;
    IFEND;

    p_form_status^.opened := FALSE;
    IF p_form_status^.displayed_on_screen THEN
      p_form_status^.owned_by_system := TRUE;
    ELSE
      p_form_status^.entry_used := FALSE;
    IFEND;

  PROCEND fdp$close_form;

?? TITLE := 'fdp$combine_form', EJECT ??
*copy fdh$combine_form

  PROCEDURE [XDCL] fdp$combine_form
    (    added_form_identifier: fdt$form_identifier;
         combine_form_identifier: fdt$form_identifier;
     VAR status: ost$status);

    VAR
      form_added: boolean,
      local_status: ost$status,
      p_added_form_status: ^fdt$form_status,
      p_form_definition: ^fdt$form_definition,
      p_combine_form_status: ^fdt$form_status,
      screen_change: fdt$screen_change;

?? NEWTITLE := 'condition_handler', EJECT ??

    PROCEDURE condition_handler
      (    condition: pmt$condition;
           condition_information: ^pmt$condition_information;
           stack_frame_save_area: ^ost$stack_frame_save_area;
       VAR handler_status: ost$status);

      CASE condition.selector OF

      = pmc$system_conditions =
        IF (condition.system_conditions * $pmt$system_conditions
              [pmc$instruction_specification, pmc$address_specification, pmc$access_violation,
              pmc$invalid_segment_ring_0, pmc$divide_fault, pmc$arithmetic_overflow, pmc$exponent_overflow,
              pmc$exponent_underflow, pmc$fp_significance_loss, pmc$fp_indefinite,
              pmc$arithmetic_significance, pmc$invalid_bdp_data]) <> $pmt$system_conditions [] THEN
          osp$set_status_abnormal (fdc$format_display_identifier, fde$bad_data_value, '', status);
          EXIT fdp$combine_form;
        IFEND;

      = pmc$user_defined_condition =
        IF condition.user_condition_name = cye$run_time_condition THEN
          osp$set_status_abnormal (fdc$format_display_identifier, fde$bad_data_value, '', status);
          EXIT fdp$combine_form;
        IFEND;

      ELSE
        ;
      CASEND;
      pmp$continue_to_cause (pmc$execute_standard_procedure, handler_status);
    PROCEND condition_handler;

?? OLDTITLE, EJECT ??
    osp$establish_condition_handler (^condition_handler, FALSE);
    fdp$find_form_status (added_form_identifier, p_added_form_status, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    fdp$find_form_status (combine_form_identifier, p_combine_form_status, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    p_form_definition := p_combine_form_status^.p_form_definition;
    IF p_combine_form_status^.added THEN
      osp$set_status_abnormal (fdc$format_display_identifier, fde$form_already_added,
            p_form_definition^.form_name, status);
      RETURN;
    IFEND;

    IF p_combine_form_status^.combined THEN
      osp$set_status_abnormal (fdc$format_display_identifier, fde$form_already_combined,
            p_form_definition^.form_name, status);
      RETURN;
    IFEND;

    IF NOT p_added_form_status^.added THEN
      osp$set_status_abnormal (fdc$format_display_identifier, fde$form_not_added,
            p_form_definition^.form_name, status);
      RETURN;
    IFEND;

    IF p_combine_form_status^.push_count <> 0 THEN
      osp$set_status_abnormal (fdc$format_display_identifier, fde$form_pushed, p_form_definition^.form_name,
            status);
      RETURN;
    IFEND;

{ Form must fit on terminal screen.

    check_form_screen_fit (p_combine_form_status^.form_x_position, p_combine_form_status^.form_y_position,
          p_form_definition^.width, p_form_definition^.height, p_form_definition^.form_name, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

{ Remove any duplicate screen changes.

    fdp$delete_screen_changes (combine_form_identifier, form_added);

{ Record add of form to screen. The form will be displayed when the screen is updated.

    screen_change.key := fdc$add_form;
    screen_change.form_identifier := combine_form_identifier;
    screen_change.form_x_position := p_combine_form_status^.form_x_position;
    screen_change.form_y_position := p_combine_form_status^.form_y_position;
    fdp$record_screen_change (screen_change, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    p_combine_form_status^.combined := TRUE;
    p_combine_form_status^.combined_events := FALSE;
    p_combine_form_status^.added_form_identifier := added_form_identifier;
    p_combine_form_status^.push_count := 0;

{ Update form priority. Higher priority  forms  cover up lower
{ priority forms. The last added form is the highest priority form.

    p_combine_form_status^.next_lower_form := fdv$screen_status.current_form_identifier;
    p_combine_form_status^.next_higher_form := 0;
    IF fdv$screen_status.current_form_identifier <> 0 THEN
      fdv$screen_status.p_forms_status^ [fdv$screen_status.current_form_identifier].next_higher_form :=
            combine_form_identifier;
    IFEND;

    fdv$screen_status.current_form_identifier := combine_form_identifier;
    fdv$screen_status.compute_new_screen_size := TRUE;
    fdv$screen_status.last_cursor_position_valid := FALSE;

  PROCEND fdp$combine_form;

?? TITLE := 'fdp$combine_form_events', EJECT ??
*copy fdh$combine_form_events

  PROCEDURE [XDCL] fdp$combine_form_events
    (    added_form_identifier: fdt$form_identifier;
         combine_form_identifier: fdt$form_identifier;
     VAR status: ost$status);

    VAR
      form_added: boolean,
      local_status: ost$status,
      p_added_form_status: ^fdt$form_status,
      p_form_definition: ^fdt$form_definition,
      p_combine_form_status: ^fdt$form_status,
      screen_change: fdt$screen_change;

?? NEWTITLE := 'condition_handler', EJECT ??

    PROCEDURE condition_handler
      (    condition: pmt$condition;
           condition_information: ^pmt$condition_information;
           stack_frame_save_area: ^ost$stack_frame_save_area;
       VAR handler_status: ost$status);

      CASE condition.selector OF

      = pmc$system_conditions =
        IF (condition.system_conditions * $pmt$system_conditions
              [pmc$instruction_specification, pmc$address_specification, pmc$access_violation,
              pmc$invalid_segment_ring_0, pmc$divide_fault, pmc$arithmetic_overflow, pmc$exponent_overflow,
              pmc$exponent_underflow, pmc$fp_significance_loss, pmc$fp_indefinite,
              pmc$arithmetic_significance, pmc$invalid_bdp_data]) <> $pmt$system_conditions [] THEN
          osp$set_status_abnormal (fdc$format_display_identifier, fde$bad_data_value, '', status);
          EXIT fdp$combine_form_events;
        IFEND;

      = pmc$user_defined_condition =
        IF condition.user_condition_name = cye$run_time_condition THEN
          osp$set_status_abnormal (fdc$format_display_identifier, fde$bad_data_value, '', status);
          EXIT fdp$combine_form_events;
        IFEND;

      ELSE
        ;
      CASEND;
      pmp$continue_to_cause (pmc$execute_standard_procedure, handler_status);
    PROCEND condition_handler;

?? OLDTITLE, EJECT ??
    osp$establish_condition_handler (^condition_handler, FALSE);
    fdp$find_form_status (added_form_identifier, p_added_form_status, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    fdp$find_form_status (combine_form_identifier, p_combine_form_status, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    p_form_definition := p_combine_form_status^.p_form_definition;
    IF p_combine_form_status^.added THEN
      osp$set_status_abnormal (fdc$format_display_identifier, fde$form_already_added,
            p_form_definition^.form_name, status);
      RETURN;
    IFEND;

    IF p_combine_form_status^.combined THEN
      osp$set_status_abnormal (fdc$format_display_identifier, fde$form_already_combined,
            p_form_definition^.form_name, status);
      RETURN;
    IFEND;

    IF NOT p_added_form_status^.added THEN
      osp$set_status_abnormal (fdc$format_display_identifier, fde$form_not_added,
            p_form_definition^.form_name, status);
      RETURN;
    IFEND;

    IF p_combine_form_status^.push_count <> 0 THEN
      osp$set_status_abnormal (fdc$format_display_identifier, fde$form_pushed, p_form_definition^.form_name,
            status);
      RETURN;
    IFEND;

{ Form must fit on terminal screen.

    check_form_screen_fit (p_combine_form_status^.form_x_position, p_combine_form_status^.form_y_position,
          p_form_definition^.width, p_form_definition^.height, p_form_definition^.form_name, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

{ Remove any duplicate screen changes.

    fdp$delete_screen_changes (combine_form_identifier, form_added);

{ Record add of form to screen. The form will be displayed when the screen is updated.

    screen_change.key := fdc$add_form;
    screen_change.form_identifier := combine_form_identifier;
    screen_change.form_x_position := p_combine_form_status^.form_x_position;
    screen_change.form_y_position := p_combine_form_status^.form_y_position;
    fdp$record_screen_change (screen_change, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    p_combine_form_status^.combined := TRUE;
    p_combine_form_status^.combined_events := TRUE;
    p_combine_form_status^.added_form_identifier := added_form_identifier;
    p_combine_form_status^.push_count := 0;

{ Update form priority. Higher priority  forms  cover up lower
{ priority forms. The last added form is the highest priority form.

    p_combine_form_status^.next_lower_form := fdv$screen_status.current_form_identifier;
    p_combine_form_status^.next_higher_form := 0;
    IF fdv$screen_status.current_form_identifier <> 0 THEN
      fdv$screen_status.p_forms_status^ [fdv$screen_status.current_form_identifier].next_higher_form :=
            combine_form_identifier;
    IFEND;

    fdv$screen_status.current_form_identifier := combine_form_identifier;
    fdv$screen_status.compute_new_screen_size := TRUE;
    fdv$screen_status.last_cursor_position_valid := FALSE;

  PROCEND fdp$combine_form_events;

?? TITLE := 'fdp$convert_to_program_value', EJECT ??
*copyc fdh$convert_to_program_value

  PROCEDURE [XDCL] fdp$convert_to_program_value
    (    form_identifier: fdt$form_identifier;
         variable_name: ost$name;
         p_text: ^fdt$text;
     VAR variable_value: fdt$variable_value;
     VAR variable_status: fdt$variable_status;
     VAR status: ost$status);

    VAR
      name_exists: boolean,
      p_form_variable_definition: ^fdt$form_variable_definition,
      p_form_status: ^fdt$form_status,
      p_value: ^cell,
      valid_name: ost$name,
      variable_index: fdt$variable_index;

?? NEWTITLE := 'condition_handler', EJECT ??

    PROCEDURE condition_handler
      (    condition: pmt$condition;
           condition_information: ^pmt$condition_information;
           stack_frame_save_area: ^ost$stack_frame_save_area;
       VAR handler_status: ost$status);

      CASE condition.selector OF

      = pmc$system_conditions =
        IF (condition.system_conditions * $pmt$system_conditions
              [pmc$instruction_specification, pmc$address_specification, pmc$access_violation,
              pmc$invalid_segment_ring_0, pmc$divide_fault, pmc$arithmetic_overflow, pmc$exponent_overflow,
              pmc$exponent_underflow, pmc$fp_significance_loss, pmc$fp_indefinite,
              pmc$arithmetic_significance, pmc$invalid_bdp_data]) <> $pmt$system_conditions [] THEN
          osp$set_status_abnormal (fdc$format_display_identifier, fde$bad_data_value, '', status);
          EXIT fdp$convert_to_program_value;
        IFEND;

      = pmc$user_defined_condition =
        IF condition.user_condition_name = cye$run_time_condition THEN
          osp$set_status_abnormal (fdc$format_display_identifier, fde$bad_data_value, '', status);
          EXIT fdp$convert_to_program_value;
        IFEND;

      ELSE
        ;
      CASEND;
      pmp$continue_to_cause (pmc$execute_standard_procedure, handler_status);
    PROCEND condition_handler;

?? OLDTITLE, EJECT ??
    osp$establish_condition_handler (^condition_handler, FALSE);
    status.normal := TRUE;
    variable_status := fdc$no_error;
    fdp$find_form_definition (form_identifier, p_form_status, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    #TRANSLATE (osv$lower_to_upper, variable_name, valid_name);
    fdp$find_variable_definition (valid_name, p_form_status^.p_form_variable_definitions,
           p_form_status^.p_form_definition^.form_variable_definitions.active_number,
           p_form_variable_definition, variable_index, name_exists);
    IF NOT name_exists THEN
      osp$set_status_abnormal (fdc$format_display_identifier, fde$unknown_variable_name,
            variable_name, status);
      osp$append_status_parameter( osc$status_parameter_delimiter, p_form_status^.
            p_form_definition^.form_name, status);
      RETURN;
    IFEND;

    variable_value.program_data_type := p_form_variable_definition^.program_data_type;
    CASE variable_value.program_data_type OF

    = fdc$program_cobol_type =
      p_value := variable_value.p_cobol_data;
      variable_value.cobol_data_length := p_form_variable_definition^.program_variable_length;

    = fdc$program_character_type,  fdc$program_upper_case_type =
      p_value := variable_value.p_text;
      variable_value.text_length := STRLENGTH (p_text^);

    = fdc$program_integer_type =
      p_value := ^variable_value.integer_value;

    ELSE {fdc$program_real_type
      p_value := ^variable_value.real_value;

    CASEND;

    fdp$move_to_program_variable (p_form_status, p_form_variable_definition,
            p_text, p_value, variable_status, status);

  PROCEND fdp$convert_to_program_value;

?? TITLE := 'fdp$convert_to_program_variable', EJECT ??
*copy fdh$convert_to_program_variable

  PROCEDURE [XDCL] fdp$convert_to_program_variable
    (    program_data_type: fdt$program_data_type;
         p_program_variable: ^cell;
         program_variable_length: fdt$program_variable_length;
         input_format: fdt$input_format;
         p_screen_variable: ^fdt$text;
         screen_variable_length: fdt$text_length;
     VAR variable_status: fdt$variable_status;
     VAR status: ost$status);

?? NEWTITLE := 'condition_handler', EJECT ??

    PROCEDURE condition_handler
      (    condition: pmt$condition;
           condition_information: ^pmt$condition_information;
           stack_frame_save_area: ^ost$stack_frame_save_area;
       VAR handler_status: ost$status);

      CASE condition.selector OF

      = pmc$system_conditions =
        IF (condition.system_conditions * $pmt$system_conditions
              [pmc$instruction_specification, pmc$address_specification, pmc$access_violation,
              pmc$invalid_segment_ring_0, pmc$divide_fault, pmc$arithmetic_overflow, pmc$exponent_overflow,
              pmc$exponent_underflow, pmc$fp_significance_loss, pmc$fp_indefinite,
              pmc$arithmetic_significance, pmc$invalid_bdp_data]) <> $pmt$system_conditions [] THEN
          osp$set_status_abnormal (fdc$format_display_identifier, fde$bad_data_value, '', status);
          EXIT fdp$convert_to_program_variable;
        IFEND;

      = pmc$user_defined_condition =
        IF condition.user_condition_name = cye$run_time_condition THEN
          osp$set_status_abnormal (fdc$format_display_identifier, fde$bad_data_value, '', status);
          EXIT fdp$convert_to_program_variable;
        IFEND;

      ELSE
        ;
      CASEND;
      pmp$continue_to_cause (pmc$execute_standard_procedure, handler_status);
    PROCEND condition_handler;

?? OLDTITLE, EJECT ??
?? NEWTITLE := 'convert_currency', EJECT ??

    PROCEDURE [INLINE] convert_currency
      (    program_data_type: fdt$program_data_type;
           p_program_variable: {output} ^cell;
       VAR integer_number: integer;
       VAR variable_status: fdt$variable_status);

       VAR
         real_number: real;

      variable_status := fdc$no_error;
      CASE program_data_type OF

        = fdc$program_real_type =
          real_number := $REAL(integer_number) / 100.0;
          i#move (^real_number, p_program_variable, fdc$real_length);

        = fdc$program_integer_type =
          i#move (^integer_number, p_program_variable, fdc$integer_length);

      ELSE
        variable_status := fdc$invalid_bdp_data;
      CASEND;
    PROCEND convert_currency;

?? OLDTITLE, EJECT ??
?? NEWTITLE := 'convert_date', EJECT ??

    PROCEDURE convert_date
      (    program_data_type: fdt$program_data_type;
           p_text: ^fdt$text;
           format: clt$date_time_form_string;
           p_program_variable: {output} ^cell;
       VAR variable_status: fdt$variable_status);

      VAR
        date_time: clt$date_time,
        ignore_character_found: boolean,
        local_status: ost$status,
        start_index: integer,
        yymmdd: integer;


      variable_status := fdc$no_error;
      CASE program_data_type OF

      = fdc$program_integer_type =
        #SCAN (non_space, p_text^, start_index, ignore_character_found);
        IF start_index > screen_variable_length THEN
          yymmdd := 0;
          i#move (^yymmdd, p_program_variable, fdc$integer_length);
          RETURN;
        IFEND;
        clp$convert_string_to_date_time (p_text^, format, date_time, local_status);
        IF NOT local_status.normal THEN
          variable_status := fdc$invalid_integer;
          RETURN;
        IFEND;
        IF (date_time.value.year > 99) THEN
          variable_status := fdc$invalid_integer;
        ELSE
          variable_status := fdc$no_error;
          yymmdd := (date_time.value.year * 10000) + (date_time.value.month * 100) + date_time.value.day;
          i#move (^yymmdd, p_program_variable, fdc$integer_length);
        IFEND;
      ELSE
        variable_status := fdc$invalid_integer;
      CASEND;

    PROCEND convert_date;

?? OLDTITLE, EJECT ??

    VAR
      actual_text_length: mlt$string_length,
      character_index: integer,
      character_found: boolean,
      decimal_point_found: boolean,
      error: mlt$error,
      integer_number: integer,
      leading_space_found: boolean,
      non_alphabetic: [READ, STATIC] packed array [char] of boolean := [
            {---} REP 65 of TRUE,
            {A..Z} REP 26 of FALSE,
            {---} REP 6 of TRUE,
            {a..z} REP 26 of FALSE,
            {---} REP 133 of TRUE],
      non_digit: [READ, STATIC] packed array [char] of boolean := [
            {---} REP 48 of TRUE,
            {0..9} REP 10 of FALSE,
            {---} REP 198 of TRUE],
      non_sign_digit: [READ, STATIC] packed array [char] of boolean := [
            {---} REP 43 of TRUE,
            { + } REP 1 of FALSE,
            {---} REP 1 of TRUE,
            { - } REP 1 of FALSE,
            {---} REP 2 of TRUE,
            {0..9} REP 10 of FALSE,
            {---} REP 199 of TRUE],
      non_space: [READ, STATIC] packed array [char] of boolean := [
            {---} REP 32 of TRUE,
            {- -} FALSE,
            {---} REP 223 of TRUE],
      p_integer_text: ^fdt$text,
      p_text: ^fdt$text,
      real_number: real,
      scan_index: integer,
      start_index: integer,
      text_index: integer,
      thousand_character_count: integer;

    osp$establish_condition_handler (^condition_handler, FALSE);
    status.normal := TRUE;
    variable_status := fdc$no_error;

{ Validate input format.

  /validate_format/
    BEGIN
      CASE input_format.key OF

      = fdc$alphabetic_input_format =

{ Ignore leading spaces.

        #SCAN (non_space, p_screen_variable^, start_index, character_found);
        IF start_index > screen_variable_length THEN
          EXIT /validate_format/;
        IFEND;

{ Characters must be A-Z, a-z.

        #SCAN (non_alphabetic, p_screen_variable^ (start_index, * ), character_index, character_found);
        IF ((start_index + character_index - 1) > screen_variable_length) THEN
          EXIT /validate_format/;
        IFEND;

{ Remaining characters must be spaces.

        #SCAN (non_space, p_screen_variable^ (start_index + character_index - 1, * ), character_index,
              character_found);
        IF character_found THEN
          variable_status := fdc$invalid_bdp_data;
          RETURN;
        IFEND;

      = fdc$character_input_format =

{ Do nothing.  All characters are valid.

      = fdc$digits_input_format =

{ Ignore leading spaces.

        #SCAN (non_space, p_screen_variable^, start_index, character_found);
        IF start_index > screen_variable_length THEN
          EXIT /validate_format/;
        IFEND;

{ Characters must be 0-9.

        #SCAN (non_digit, p_screen_variable^ (start_index, * ), character_index, character_found);
        IF ((start_index + character_index - 1) > screen_variable_length) THEN
          EXIT /validate_format/;
        IFEND;

{ Remaining characters must be spaces.

        #SCAN (non_space, p_screen_variable^ (start_index + character_index - 1, * ), character_index,
              character_found);
        IF character_found THEN
          variable_status := fdc$invalid_bdp_data;
          RETURN;
        IFEND;

      = fdc$signed_input_format =

{ Ignore leading spaces.

        #SCAN (non_space, p_screen_variable^, start_index, character_found);
        IF start_index > screen_variable_length THEN
          EXIT /validate_format/;
        IFEND;

{ Allow leading plus or minus.

        IF ((p_screen_variable^ (start_index) = '+') OR
           (p_screen_variable^ (start_index) = '-')) THEN
          start_index := start_index +1;
        IFEND;

{ Characters must be 0-9.

        #SCAN (non_digit, p_screen_variable^ (start_index, * ), character_index, character_found);
        IF ((start_index + character_index - 1) > screen_variable_length) THEN
          EXIT /validate_format/;
        IFEND;

{ Remaining characters must be spaces.

        #SCAN (non_space, p_screen_variable^ (start_index + character_index - 1, * ),
              character_index, character_found);
        IF character_found THEN
          variable_status := fdc$invalid_bdp_data;
          RETURN;
        IFEND;

      = fdc$real_input_format =

{ Allow math conversion procedures used later to detect errors.

      = fdc$currency_input_format =

{ Edit screen input text.  Remove currency symbol, thousands separator,
{ and decimal point. Because real numbers are approximations use
{ integer format initially.

      PUSH p_text: [screen_variable_length];
      p_text^ (1, *) := '';
      text_index := 0;
      leading_space_found := FALSE;
      decimal_point_found := FALSE;
      thousand_character_count := 0;

      /validate_currency/
        FOR scan_index := screen_variable_length DOWNTO 1 DO
          IF (p_screen_variable^ (scan_index, 1) = ' ') THEN
            IF text_index = 0 THEN

{ Ignore trailing spaces.

              CYCLE /validate_currency/;

            ELSEIF leading_space_found THEN

{ Ignore leading spaces.

              CYCLE /validate_currency/;

            ELSE
              leading_space_found := TRUE;
            IFEND;

{ Character is not a space.

          ELSEIF leading_space_found THEN

{ Currency format cannot have embedded spaces.

            variable_status := fdc$invalid_bdp_data;
            RETURN;

          ELSEIF (p_screen_variable^ (scan_index, 1) =
               input_format.input_currency_format.decimal_point) THEN

{ Terminal user may type x, x., x.y, x.yz for currency
{ where x, y, and z are digits.

            IF text_index = 0 THEN
              thousand_character_count := 0;
            ELSEIF text_index = 1 THEN
              decimal_point_found := TRUE;
              p_text^ (screen_variable_length - 1, 1) :=
                   p_text^ (screen_variable_length, 1);
              p_text^ (screen_variable_length, 1) := '0';
              text_index := 2;
              thousand_character_count := 0;
            ELSEIF text_index = 2 THEN
              thousand_character_count := 0;
              decimal_point_found := TRUE;
            ELSE
              variable_status := fdc$invalid_bdp_data;
              RETURN;
            IFEND;

          ELSEIF (p_screen_variable^ (scan_index, 1) =
               input_format.input_currency_format.thousands_separator) THEN
               IF thousand_character_count = 3 THEN
                 thousand_character_count := 0;
                 CYCLE /validate_currency/;
               ELSE
                 variable_status := fdc$invalid_bdp_data;
                 RETURN;
               IFEND;

          ELSEIF (p_screen_variable^ (scan_index, 1) =
               input_format.input_currency_format.currency_sybmol) THEN
            CYCLE /validate_currency/;

          ELSE

{ Math routine will find other invalid characters.

            text_index := text_index + 1;
            p_text^ (screen_variable_length - text_index +1, 1) :=
                 p_screen_variable^ (scan_index, 1);
            thousand_character_count := thousand_character_count + 1;
          IFEND;
        FOREND /validate_currency/;

      IF text_index = 0 THEN
        integer_number := 0;
        convert_currency (program_data_type, p_program_variable, integer_number,
              variable_status);
        RETURN;
      IFEND;


      IF NOT decimal_point_found THEN

{ User did not enter any cents.  Multiply amount entered by 100.

        PUSH p_integer_text: [text_index + 2];
        p_integer_text^ (text_index + 2 - 1, 2) := '00';
        p_integer_text^ (1, text_index) :=
             p_text^ (screen_variable_length - text_index + 1, text_index);
        mlp$input_integer(p_integer_text, STRLENGTH(p_integer_text^), ^integer_number,
              mlc$max_integer_length, mlc$signed_integer, mlc$stop_on_blank,
              actual_text_length, error);
      ELSE
        mlp$input_integer(p_text, screen_variable_length, ^integer_number,
              mlc$max_integer_length, mlc$signed_integer, mlc$stop_on_blank,
              actual_text_length, error);

      IFEND;
      CASE error OF

      = mle$no_error, mle$no_digits =
        convert_currency (program_data_type, p_program_variable, integer_number,
              variable_status);

      = mle$overflow =
        variable_status := fdc$overflow;

      ELSE
        variable_status := fdc$invalid_bdp_data;
      CASEND;
      RETURN;

      = fdc$ydm_format =
        convert_date (program_data_type, ^p_screen_variable^ (1,screen_variable_length),
              fdc$ydm_format_string, p_program_variable, variable_status);
        RETURN;

      = fdc$mdy_format =
        convert_date (program_data_type, ^p_screen_variable^ (1,screen_variable_length),
              fdc$mdy_format_string, p_program_variable, variable_status);
        RETURN;

      = fdc$dmy_format =
        convert_date (program_data_type, ^p_screen_variable^ (1,screen_variable_length),
              fdc$dmy_format_string, p_program_variable, variable_status);
        RETURN;

      = fdc$iso_date_format =
        convert_date (program_data_type, ^p_screen_variable^ (1,screen_variable_length),
              fdc$iso_format_string, p_program_variable, variable_status);
        RETURN;

      = fdc$month_dd_yyyy_format =
        convert_date (program_data_type, ^p_screen_variable^ (1,screen_variable_length),
              fdc$month_format_string, p_program_variable, variable_status);
        RETURN;

      ELSE
        osp$set_status_abnormal (fdc$format_display_identifier, fde$invalid_input_format_key, '', status);
        RETURN;
      CASEND;
    END /validate_format/;

{ Convert screen character data to program data type.

    CASE program_data_type OF

    = fdc$program_character_type =
      mlp$move_bytes (p_screen_variable, screen_variable_length, p_program_variable, program_variable_length,
            error);

    = fdc$program_upper_case_type =
      mlp$translate_bytes (p_screen_variable, screen_variable_length, p_program_variable,
            program_variable_length, ^osv$lower_to_upper, error);

    = fdc$program_real_type =

{ Ignore leading spaces.

      #SCAN (non_space, p_screen_variable^, start_index, character_found);
      IF start_index > screen_variable_length THEN
        real_number := 0.0;
        i#move (^real_number, p_program_variable, fdc$real_length);
        RETURN;
      IFEND;

{ Spaces in middle of number are invalid so stop on blanks.

      mlp$input_floating_number (^p_screen_variable^ (start_index, *) ,
      screen_variable_length - start_index + 1, ^real_number,
            mlc$single_precision, mlc$stop_on_blank, actual_text_length, error);

      CASE error OF

      = mle$no_error, mle$no_digits =
        IF (actual_text_length < (screen_variable_length - start_index + 1)) THEN

{ Remaining characters must be spaces.

          #SCAN (non_space, p_screen_variable^ (start_index + actual_text_length, * ), character_index,
                character_found);
          IF character_found THEN
            variable_status := fdc$invalid_bdp_data;
            RETURN;
          IFEND;
        IFEND;
        i#move (^real_number, p_program_variable, fdc$real_length);

      = mle$invalid_bdp_data =
        variable_status := fdc$invalid_bdp_data;

      = mle$overflow =
        variable_status := fdc$overflow;

      ELSE
        variable_status := fdc$invalid_real;
      CASEND;

    = fdc$program_integer_type =

{ Ignore leading spaces.

      #SCAN (non_space, p_screen_variable^, start_index, character_found);
      IF start_index > screen_variable_length THEN
        integer_number := 0;
        i#move (^integer_number, p_program_variable, fdc$integer_length);
        RETURN;
      IFEND;

      mlp$input_integer (^p_screen_variable^ (start_index, *),
            screen_variable_length - start_index + 1, ^integer_number, mlc$max_integer_length,
            mlc$signed_integer, mlc$stop_on_blank, actual_text_length, error);
      CASE error OF

      = mle$no_error, mle$no_digits =
        IF (actual_text_length < (screen_variable_length - start_index + 1)) THEN

{ Remaining characters must be spaces.

          #SCAN (non_space, p_screen_variable^ (start_index + actual_text_length, * ), character_index,
                character_found);
          IF character_found THEN
            variable_status := fdc$invalid_bdp_data;
            RETURN;
          IFEND;
        IFEND;
        i#move (^integer_number, p_program_variable, fdc$integer_length);

      = mle$invalid_bdp_data =
        variable_status := fdc$invalid_bdp_data;

      = mle$loss_of_significance =
        variable_status := fdc$loss_of_significance;

      ELSE
        variable_status := fdc$invalid_integer;
      CASEND;

    ELSE


{ Invalid program data type.

     osp$set_status_abnormal (fdc$format_display_identifier, fde$program_data_type, '', status);
    CASEND;
  PROCEND fdp$convert_to_program_variable;

?? TITLE := 'fdp$convert_to_screen_value', EJECT ??
*copyc fdh$convert_to_screen_value

  PROCEDURE [XDCL] fdp$convert_to_screen_value
    (    form_identifier: fdt$form_identifier;
         variable_name: ost$name;
         variable_value: fdt$variable_value;
         p_text: {output} ^fdt$text;
     VAR variable_status: fdt$variable_status;
     VAR status: ost$status);

    VAR
      name_exists: boolean,
      p_form_variable_definition: ^fdt$form_variable_definition,
      p_form_status: ^fdt$form_status,
      p_value: ^cell,
      valid_name: ost$name,
      variable_index: fdt$variable_index;

?? NEWTITLE := 'condition_handler', EJECT ??

    PROCEDURE condition_handler
      (    condition: pmt$condition;
           condition_information: ^pmt$condition_information;
           stack_frame_save_area: ^ost$stack_frame_save_area;
       VAR handler_status: ost$status);

      CASE condition.selector OF

      = pmc$system_conditions =
        IF (condition.system_conditions * $pmt$system_conditions
              [pmc$instruction_specification, pmc$address_specification, pmc$access_violation,
              pmc$invalid_segment_ring_0, pmc$divide_fault, pmc$arithmetic_overflow, pmc$exponent_overflow,
              pmc$exponent_underflow, pmc$fp_significance_loss, pmc$fp_indefinite,
              pmc$arithmetic_significance, pmc$invalid_bdp_data]) <> $pmt$system_conditions [] THEN
          osp$set_status_abnormal (fdc$format_display_identifier, fde$bad_data_value, '', status);
          EXIT fdp$convert_to_screen_value;
        IFEND;

      = pmc$user_defined_condition =
        IF condition.user_condition_name = cye$run_time_condition THEN
          osp$set_status_abnormal (fdc$format_display_identifier, fde$bad_data_value, '', status);
          EXIT fdp$convert_to_screen_value;
        IFEND;

      ELSE
        ;
      CASEND;
      pmp$continue_to_cause (pmc$execute_standard_procedure, handler_status);
    PROCEND condition_handler;

?? OLDTITLE, EJECT ??
    osp$establish_condition_handler (^condition_handler, FALSE);
    status.normal := TRUE;
    variable_status := fdc$no_error;
    fdp$find_form_definition (form_identifier, p_form_status, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    #TRANSLATE (osv$lower_to_upper, variable_name, valid_name);
    fdp$find_variable_definition (valid_name, p_form_status^.p_form_variable_definitions,
           p_form_status^.p_form_definition^.form_variable_definitions.active_number,
           p_form_variable_definition, variable_index, name_exists);
    IF NOT name_exists THEN
      osp$set_status_abnormal (fdc$format_display_identifier, fde$unknown_variable_name,
            variable_name, status);
      osp$append_status_parameter( osc$status_parameter_delimiter, p_form_status^.
            p_form_definition^.form_name, status);
      RETURN;
    IFEND;

    CASE variable_value.program_data_type OF

    = fdc$program_cobol_type =
      p_value := variable_value.p_cobol_data;

    = fdc$program_character_type,  fdc$program_upper_case_type =
      p_value := variable_value.p_text;

    = fdc$program_integer_type =
      p_value := ^variable_value.integer_value;

    ELSE {fdc$program_real_type
      p_value := ^variable_value.real_value;

    CASEND;

    fdp$move_to_screen_variable (p_form_status, p_form_variable_definition,
            p_value, p_text, variable_status, status);

  PROCEND fdp$convert_to_screen_value;

?? TITLE := 'fdp$convert_to_screen_variable', EJECT ??
*copyc fdh$convert_to_screen_variable

  PROCEDURE [XDCL] fdp$convert_to_screen_variable
    (    program_data_type: fdt$program_data_type;
         p_program_variable: ^cell;
         program_variable_length: fdt$program_variable_length;
         output_format: fdt$output_format;
         p_screen_variable: ^fdt$text;
         screen_variable_length: fdt$text_length;
     VAR variable_status: fdt$variable_status;
     VAR status: ost$status);

    VAR
      end_of_text: boolean,
      error: mlt$error,
      integer_number: integer,
      invalid_string: boolean,
      minimum_index: fdt$text_length,
      p_text: ^fdt$text,
      real_number: real,
      scan_index: integer,
      screen_format: mlt$output_format,
      string_length: mlt$string_length,
      terminal_control_characters: [READ] packed array [char] of boolean :=
            [REP 30 of TRUE, REP 226 of FALSE],
      text_index: integer,
      thousand_character_count: integer;

?? NEWTITLE := 'add_character', EJECT ??
   PROCEDURE [INLINE] add_character
      (     character: string (1);
            separator: string (1);
            p_text: {output} ^fdt$text;
       VAR  text_index: integer;
       VAR separator_count: integer;
       VAR variable_status: fdt$variable_status);

       variable_status := fdc$no_error;
       separator_count := separator_count + 1;
       IF separator_count > 3 THEN
         separator_count := 1;
         IF separator <> ' ' THEN
           text_index := text_index - 1;
           IF text_index > 0 THEN
             p_text^ (text_index, 1) := separator;
           ELSE
             variable_status := fdc$loss_of_significance;
             RETURN;
           IFEND;
         IFEND;
       IFEND;

       text_index := text_index - 1;
       IF text_index > 0 THEN
         p_text^ (text_index, 1) := character;
       ELSE
         variable_status := fdc$loss_of_significance;
         RETURN;
       IFEND;

    PROCEND add_character;

?? OLDTITLE ??
?? NEWTITLE := 'check_error', EJECT ??

    PROCEDURE [INLINE] check_error;

      CASE error OF

      = mle$no_error =
        variable_status := fdc$no_error;

      = mle$loss_of_significance =
        variable_status := fdc$loss_of_significance;
        p_screen_variable^ := '*';

      = mle$infinite =
        variable_status := fdc$infinite;
        p_screen_variable^ := 'R';

      = mle$indefinite =
        variable_status := fdc$indefinite;
        p_screen_variable^ := 'I';

      = mle$bad_parameters =
        variable_status := fdc$output_format_bad;
        p_screen_variable^ := '*';

      ELSE
        variable_status := fdc$output_format_bad;
        p_screen_variable^ := '*';
      CASEND;

    PROCEND check_error;

?? OLDTITLE ??
?? NEWTITLE := 'condition_handler', EJECT ??

    PROCEDURE condition_handler
      (    condition: pmt$condition;
           condition_information: ^pmt$condition_information;
           stack_frame_save_area: ^ost$stack_frame_save_area;
       VAR handler_status: ost$status);

      CASE condition.selector OF

      = pmc$system_conditions =
        IF (condition.system_conditions * $pmt$system_conditions
              [pmc$instruction_specification, pmc$address_specification, pmc$access_violation,
              pmc$invalid_segment_ring_0, pmc$divide_fault, pmc$arithmetic_overflow, pmc$exponent_overflow,
              pmc$exponent_underflow, pmc$fp_significance_loss, pmc$fp_indefinite,
              pmc$arithmetic_significance, pmc$invalid_bdp_data]) <> $pmt$system_conditions [] THEN
          osp$set_status_abnormal (fdc$format_display_identifier, fde$bad_data_value, '', status);
          EXIT fdp$convert_to_screen_variable;
        IFEND;

      = pmc$user_defined_condition =
        IF condition.user_condition_name = cye$run_time_condition THEN
          osp$set_status_abnormal (fdc$format_display_identifier, fde$bad_data_value, '', status);
          EXIT fdp$convert_to_screen_variable;
        IFEND;

      ELSE
        ;
      CASEND;
      pmp$continue_to_cause (pmc$execute_standard_procedure, handler_status);
    PROCEND condition_handler;

?? OLDTITLE ??
?? NEWTITLE := 'convert_date_to_string', EJECT ??
    PROCEDURE convert_date_to_string
    (    yymmdd: integer;
         format: clt$date_time_form_string;
         p_screen_variable: ^fdt$text;
         screen_variable_length: fdt$text_length;
     VAR variable_status: fdt$variable_status);

     VAR
        date_string: ost$string,
        date_time: clt$date_time,
        local_status: ost$status;


      IF yymmdd = 0 THEN
        p_screen_variable^ (1, screen_variable_length) := ' ';
        RETURN;
      IFEND;
      fdp$convert_yymmdd_to_date_time (yymmdd, date_time, variable_status);
      IF variable_status <> fdc$no_error THEN
        p_screen_variable^ (1, screen_variable_length) := ' ';
        RETURN;
      IFEND;
      clp$convert_date_time_to_string (date_time, format, date_string, local_status);
      IF NOT local_status.normal THEN
        variable_status := fdc$invalid_integer;
        p_screen_variable^ (1, screen_variable_length) := ' ';
        RETURN;
      IFEND;
      p_screen_variable ^(1, screen_variable_length) := date_string.value (1, date_string.size);

    PROCEND convert_date_to_string;
?? OLDTITLE, EJECT ??
    osp$establish_condition_handler (^condition_handler, FALSE);
    status.normal := TRUE;
    variable_status := fdc$no_error;

    CASE output_format.key OF

    = fdc$character_output_format =
      mlp$move_bytes (p_program_variable, program_variable_length, p_screen_variable, screen_variable_length,
            error);

{ Do not allow terminal control characters in output.  They may destroy form content.

      #SCAN (terminal_control_characters, p_screen_variable^, scan_index, invalid_string);
      IF invalid_string THEN
        variable_status := fdc$invalid_bdp_data;
        p_screen_variable^ (1, screen_variable_length) := ' ';
      IFEND;

    = fdc$ydm_output_format =

      i#move (p_program_variable, ^integer_number, program_variable_length);
      convert_date_to_string (integer_number, fdc$ydm_format_string, p_screen_variable,
            screen_variable_length, variable_status);

    = fdc$mdy_output_format =

      i#move (p_program_variable, ^integer_number, program_variable_length);
      convert_date_to_string (integer_number, fdc$mdy_format_string, p_screen_variable,
            screen_variable_length, variable_status);

    = fdc$dmy_output_format =

      i#move (p_program_variable, ^integer_number, program_variable_length);
      convert_date_to_string (integer_number, fdc$dmy_format_string, p_screen_variable,
            screen_variable_length, variable_status);

    = fdc$iso_output_format =

      i#move (p_program_variable, ^integer_number, program_variable_length);
      convert_date_to_string (integer_number, fdc$iso_format_string, p_screen_variable,
            screen_variable_length, variable_status);

    = fdc$month_dd_yyyy_out_format =

      i#move (p_program_variable, ^integer_number, program_variable_length);
      convert_date_to_string (integer_number, fdc$month_format_string, p_screen_variable,
            screen_variable_length, variable_status);

    = fdc$currency_output_format =

      CASE program_data_type OF

        = fdc$program_real_type =
          i#move (p_program_variable, ^real_number, program_variable_length);

        = fdc$program_integer_type =
          i#move (p_program_variable, ^integer_number, program_variable_length);
          real_number := $REAL (integer_number);
          real_number := real_number / 100.0;
      ELSE
        variable_status := fdc$output_format_bad;
        p_screen_variable^ := '*';
        RETURN;
      CASEND;

      IF (real_number = 0.0)  THEN
        IF output_format.output_currency_format.suppress_leading_zeros THEN

{ Suppress leading zeros really means display spaces when currency has
{ zero value.

          p_screen_variable^ (1, screen_variable_length) := ' ';
        ELSE

{ Display zero currency value in format $0.00

          p_screen_variable^ (1, screen_variable_length) := ' ';
          IF screen_variable_length > 3 THEN
            p_screen_variable^ (screen_variable_length - 1, 2) := '00';
            p_screen_variable^ (screen_variable_length - 2, 1) :=
                  output_format.output_currency_format.decimal_point;
            p_screen_variable^ (screen_variable_length - 3, 1) := '0';
            IF output_format.output_currency_format.currency_sybmol <> ' ' THEN
              IF screen_variable_length > 4 THEN
                p_screen_variable^ (screen_variable_length - 4, 1) :=
                     output_format.output_currency_format.currency_sybmol;
              ELSE
                variable_status := fdc$loss_of_significance;
                p_screen_variable^ := '*';
              IFEND;
            IFEND;
          ELSE {The object is not long enough to display the currency value.}
            variable_status := fdc$loss_of_significance;
            p_screen_variable^ := '*';
          IFEND;
        IFEND;
        RETURN;
      IFEND;

      PUSH p_text: [screen_variable_length];
      screen_format.justification := mlc$right_justify;
      screen_format.sign := output_format.output_currency_format.sign_treatment;
      screen_format.format := mlc$f_style;
      screen_format.scale_factor := 0;
      screen_format.width := output_format.output_currency_format.field_width;
      screen_format.digits := 2;
      screen_format.exponent_character := fdc$system_exponent_character;
      screen_format.exponent_style := 0;
      mlp$output_floating_number (^real_number, mlc$single_precision, p_text, screen_format,
            string_length, error);
      check_error;
      IF error <> mle$no_error THEN
        RETURN;
      IFEND;

{ Put in form definition for decimal point.

      p_screen_variable^ := p_text^;
      p_screen_variable^ (screen_variable_length - 2, 1) :=
           output_format.output_currency_format.decimal_point;

{ Put in thousands separator.

      thousand_character_count := 0;
      text_index := output_format.output_currency_format.field_width - 2;

      /format_currency/
        FOR scan_index :=
             output_format.output_currency_format.field_width - 3  DOWNTO 1 DO
          IF ((p_text^ (scan_index, 1) = ' ')  OR (p_text^ (scan_index, 1) = '-')) THEN
            EXIT /format_currency/;
          ELSE  { The character is a digit.}
            add_character (p_text^ (scan_index, 1),
                 output_format.output_currency_format.thousands_separator,
                 p_screen_variable, text_index, thousand_character_count, variable_status);
            IF variable_status <> fdc$no_error THEN
              p_screen_variable^ := '*';
              RETURN;
            IFEND;
          IFEND;
        FOREND /format_currency/;

{ Put in minus sign.

        IF (p_text^ (scan_index, 1) = '-') THEN
          text_index := text_index - 1;
          IF text_index > 0 THEN
            p_screen_variable^ (text_index, 1) := '-';
          ELSE
            variable_status := fdc$loss_of_significance;
            RETURN;
         IFEND;
       IFEND;

{ Put in currency symbol.

       IF output_format.output_currency_format.currency_sybmol <> ' ' THEN
         text_index := text_index - 1;
         IF text_index > 0 THEN
           p_screen_variable^ (text_index, 1) := output_format.output_currency_format.currency_sybmol;
         ELSE
           variable_status := fdc$loss_of_significance;
           RETURN;
         IFEND;
       IFEND;

    = fdc$integer_output_format =
      mlp$output_integer (p_program_variable, mlc$max_integer_length, mlc$signed_integer, p_screen_variable,
            output_format.integer_output_format.field_width, mlc$right_justify,
            output_format.integer_output_format.sign_treatment, string_length, error);
      check_error;
      IF error <> mle$no_error THEN
        RETURN;
      IFEND;

      IF output_format.integer_output_format.minimum_output_digits < 1 THEN
        i#move (p_program_variable, ^integer_number, program_variable_length);
        IF integer_number = 0 THEN
          p_screen_variable^ (1, screen_variable_length) := ' ';
          RETURN;
        IFEND;
      ELSE

{ Format output to obtain minimum number of digits.

        FOR scan_index := 1 TO
             output_format.integer_output_format.minimum_output_digits  DO
             text_index := screen_variable_length - scan_index + 1;
          IF p_screen_variable^ (text_index, 1) = ' ' THEN
            p_screen_variable^ (text_index, 1) := '0';

{ Shift minus or plus sign to left to obtain specified number of digits.

          ELSEIF p_screen_variable^ (text_index, 1) = '-' THEN
            IF (text_index > 1) THEN
              p_screen_variable^ (text_index - 1, 1) := '-';
              p_screen_variable^ (text_index, 1) := '0';
            ELSE
              error := mle$loss_of_significance;
              check_error;
              RETURN;
            IFEND;

          ELSEIF p_screen_variable^ (text_index, 1) = '+' THEN
            IF (text_index > 1) THEN
              p_screen_variable^ (text_index - 1, 1) := '+';
              p_screen_variable^ (text_index, 1) := '0';
            ELSE
              error := mle$loss_of_significance;
              check_error;
              RETURN;
            IFEND;
          IFEND;
        FOREND;
      IFEND;

    = fdc$f_output_format =
      IF output_format.float_output_format.suppress_zero THEN
        i#move (p_program_variable, ^real_number, program_variable_length);
        IF real_number = 0.0 THEN
          p_screen_variable^ (1, screen_variable_length) := ' ';
          RETURN;
        IFEND;
      IFEND;

      screen_format.justification := mlc$right_justify;
      screen_format.sign := output_format.float_output_format.sign_treatment;
      screen_format.format := mlc$f_style;
      screen_format.scale_factor := 0;
      screen_format.width := output_format.float_output_format.field_width;
      screen_format.digits := output_format.float_output_format.digits_right_decimal;
      screen_format.exponent_character := fdc$system_exponent_character;
      screen_format.exponent_style := 0;
      mlp$output_floating_number (p_program_variable, mlc$single_precision, p_screen_variable, screen_format,
            string_length, error);
      check_error;

    = fdc$e_output_format =
      IF output_format.float_output_format.suppress_zero THEN
        i#move (p_program_variable, ^real_number, program_variable_length);
        IF real_number = 0.0 THEN
          p_screen_variable^ (1, screen_variable_length) := ' ';
          RETURN;
        IFEND;
      IFEND;

      screen_format.justification := mlc$right_justify;
      screen_format.sign := output_format.float_output_format.sign_treatment;
      screen_format.format := mlc$e_style;
      screen_format.scale_factor := 0;
      screen_format.width := output_format.float_output_format.field_width;
      screen_format.digits := output_format.float_output_format.digits_right_decimal;
      screen_format.exponent_character := fdc$system_exponent_character;
      screen_format.exponent_style := 0;
      mlp$output_floating_number (p_program_variable, mlc$single_precision, p_screen_variable, screen_format,
            string_length, error);
      check_error;

    = fdc$g_output_format =
      IF output_format.float_output_format.suppress_zero THEN
        i#move (p_program_variable, ^real_number, program_variable_length);
        IF real_number = 0.0 THEN
          p_screen_variable^ (1, screen_variable_length) := ' ';
          RETURN;
        IFEND;
      IFEND;

      screen_format.justification := mlc$right_justify;
      screen_format.sign := output_format.float_output_format.sign_treatment;
      screen_format.format := mlc$g_style;
      screen_format.scale_factor := 0;
      screen_format.width := output_format.float_output_format.field_width;
      screen_format.digits := output_format.float_output_format.digits_right_decimal;
      screen_format.exponent_character := fdc$system_exponent_character;
      screen_format.exponent_style := 0;
      mlp$output_floating_number (p_program_variable, mlc$single_precision, p_screen_variable, screen_format,
            string_length, error);
      check_error;

    = fdc$e_e_output_format =
      IF output_format.exponent_output_format.suppress_zero THEN
        i#move (p_program_variable, ^real_number, program_variable_length);
        IF real_number = 0.0 THEN
          p_screen_variable^ (1, screen_variable_length) := ' ';
          RETURN;
        IFEND;
      IFEND;
      screen_format.justification := mlc$right_justify;
      screen_format.sign := output_format.exponent_output_format.sign_treatment;
      screen_format.format := mlc$e_style;
      screen_format.scale_factor := 0;
      screen_format.width := output_format.exponent_output_format.field_width;
      screen_format.digits := output_format.exponent_output_format.digits_right_decimal;
      screen_format.exponent_character := fdc$system_exponent_character;
      screen_format.exponent_style := output_format.exponent_output_format.digits_in_exponent;
      mlp$output_floating_number (p_program_variable, mlc$single_precision, p_screen_variable, screen_format,
            string_length, error);
      check_error;

    = fdc$g_e_output_format =
      screen_format.justification := mlc$right_justify;
      screen_format.sign := output_format.exponent_output_format.sign_treatment;
      screen_format.format := mlc$g_style;
      screen_format.scale_factor := 0;
      screen_format.width := output_format.exponent_output_format.field_width;
      screen_format.digits := output_format.exponent_output_format.digits_right_decimal;
      screen_format.exponent_character := fdc$system_exponent_character;
      screen_format.exponent_style := output_format.exponent_output_format.digits_in_exponent;
      mlp$output_floating_number (p_program_variable, mlc$single_precision, p_screen_variable, screen_format,
            string_length, error);
      check_error;

    ELSE

{ Invalid output format key.

     variable_status := fdc$invalid_bdp_data;
     p_screen_variable^ := '*';
    CASEND;

  PROCEND fdp$convert_to_screen_variable;

?? TITLE := 'fdp$convert_yymmdd_to_date_time', EJECT ??
*copyc fdh$convert_yymmdd_to_date_time

  PROCEDURE [XDCL] fdp$convert_yymmdd_to_date_time
    (    yymmdd: integer;
     VAR date_time: clt$date_time;
     VAR variable_status: fdt$variable_status);

    VAR
      day: integer,
      local_status: ost$status,
      month: integer,
      year: integer;


    variable_status := fdc$no_error;
    IF yymmdd = 0 THEN
      date_time.date_specified := FALSE;
      date_time.time_specified := FALSE;
      RETURN;
    IFEND;
    year := yymmdd DIV 10000;
    month := (yymmdd MOD 10000) DIV 100;
    day := yymmdd MOD 100;

    IF (year < 0) OR (year > 99) OR (month < 1) OR (month > 12) OR (day < 1) OR (day > 31) THEN
      variable_status := fdc$invalid_integer;
      RETURN;
    IFEND;

    date_time.value.year := year;
    date_time.value.month := month;
    date_time.value.day := day;
    date_time.value.hour := 0;
    date_time.value.minute := 0;
    date_time.value.second := 0;
    date_time.value.millisecond := 0;
    date_time.date_specified := TRUE;
    date_time.time_specified := TRUE;

    clp$validate_date_time (date_time, '', local_status);
    IF NOT local_status.normal THEN
      variable_status := fdc$invalid_integer;
    IFEND;

  PROCEND fdp$convert_yymmdd_to_date_time;

?? TITLE := 'fdp$create_form_status', EJECT ??
*copyc fdh$create_form_status

  PROCEDURE [XDCL] fdp$create_form_status
    (VAR form_identifier: fdt$form_identifier;
     VAR p_form_status: ^fdt$form_status;
     VAR status: ost$status);

    VAR
      i: fdt$form_identifier,
      j: fdt$form_identifier,
      local_status: ost$status,
      message_status: ost$status,
      p_status_message: ^ost$status_message,
      p_status_message_line_count: ^ost$status_message_line_count,
      p_status_message_line_size: ^ost$status_message_line_size,
      p_status_message_text: ^string ( * ),
      p_old_forms_status: ^fdt$forms_status,
      status_message: ost$status_message,
      status_message_line_size: [STATIC] ost$max_status_message_line := fdc$message_variable_length;

?? NEWTITLE := 'initialize_form_status', EJECT ??

    PROCEDURE initialize_form_status;

      p_form_status^.active_form_object_statuses := 0;
      p_form_status^.added := FALSE;
      p_form_status^.changed_variable_search.status := fdc$not_searched;
      p_form_status^.combined := FALSE;
      p_form_status^.design_form := FALSE;
      p_form_status^.displayed_on_screen := FALSE;
      p_form_status^.defined_dynamically := FALSE;
      p_form_status^.entry_used := TRUE;
      p_form_status^.events_active := FALSE;
      p_form_status^.field_number_defined := FALSE;
      p_form_status^.graphic_identifier_defined := FALSE;
      p_form_status^.input_error_search.status := fdc$not_searched;
      p_form_status^.invalid_data_character.defined := FALSE;
      p_form_status^.last_cursor_position_valid := FALSE;
      p_form_status^.mark_defined := FALSE;
      p_form_status^.event_form_defined := FALSE;
      p_form_status^.fast_form_creation := FALSE;
      p_form_status^.opened := FALSE;
      p_form_status^.opened_for_query_only := FALSE;
      p_form_status^.output_error_search.status := fdc$not_searched;
      p_form_status^.owned_by_system := FALSE;
      p_form_status^.p_form_event_statuses := NIL;
      p_form_status^.p_form_image := NIL;
      p_form_status^.p_form_object_statuses := NIL;
      p_form_status^.p_form_table_statuses := NIL;
      p_form_status^.p_program_record := NIL;
      p_form_status^.p_screen_record := NIL;
      p_form_status^.push_count := 0;
      p_form_status^.storage_allocated := FALSE;
      p_form_status^.total_form_object_statuses := 0;
    PROCEND initialize_form_status;

?? OLDTITLE ??

    status.normal := TRUE;
    IF fdv$screen_status.p_forms_status = NIL THEN

{ Create the initial array for form  status.

      ALLOCATE fdv$screen_status.p_forms_status: [1 .. fdc$forms_to_expand];
      IF fdv$screen_status.p_forms_status = NIL THEN
        osp$set_status_abnormal (fdc$format_display_identifier, fde$no_space_available, '', status);
        RETURN;
      IFEND;

      form_identifier := 1;
      p_form_status := ^fdv$screen_status.p_forms_status^ [1];
      FOR i := 2 TO fdc$forms_to_expand DO
        fdv$screen_status.p_forms_status^ [i].entry_used := FALSE;
      FOREND;

{ Allocate initial array for screen changes.

      ALLOCATE fdv$screen_status.p_screen_changes: [1 .. fdc$screen_changes_to_expand];
      IF fdv$screen_status.p_screen_changes = NIL THEN
        osp$set_status_abnormal (fdc$format_display_identifier, fde$no_space_available, '', status);
        RETURN;
      IFEND;
      fdv$screen_status.number_screen_changes := 0;
      initialize_form_status;
    IFEND;

{ An array for form status exists. Try to use an existing record.

    FOR i := 1 TO UPPERBOUND (fdv$screen_status.p_forms_status^) DO
      IF (NOT fdv$screen_status.p_forms_status^ [i].entry_used) THEN
        form_identifier := i;
        p_form_status := ^fdv$screen_status.p_forms_status^ [i];
        initialize_form_status;
        RETURN;
      IFEND;
    FOREND;

{ No current records are inactive. Allocate a bigger array.

    p_old_forms_status := fdv$screen_status.p_forms_status;
    i := UPPERBOUND (fdv$screen_status.p_forms_status^);
    ALLOCATE fdv$screen_status.p_forms_status: [1 .. i + fdc$forms_to_expand];
    IF fdv$screen_status.p_forms_status = NIL THEN
      osp$set_status_abnormal (fdc$format_display_identifier, fde$no_space_available, '', status);
      fdv$screen_status.p_forms_status := p_old_forms_status;
      RETURN;
    IFEND;

{ Move form status to new array.

    FOR j := 1 TO i DO
      fdv$screen_status.p_forms_status^ [j] := p_old_forms_status^ [j];
    FOREND;

{ Assign an entry for the new form.

    i := i + 1;
    form_identifier := i;
    p_form_status := ^fdv$screen_status.p_forms_status^ [i];

{ Mark unused entries in new array.

    FOR j := (i + 1) TO UPPERBOUND (fdv$screen_status.p_forms_status^) DO
      fdv$screen_status.p_forms_status^ [j].entry_used := FALSE;
    FOREND;
    initialize_form_status;
  PROCEND fdp$create_form_status;

?? TITLE := 'fdp$delete_form', EJECT ??
*copyc fdh$delete_form

  PROCEDURE [XDCL] fdp$delete_form
    (    form_identifier: fdt$form_identifier;
     VAR status: ost$status);

    VAR
      current_form_identifier: fdt$current_form_identifier,
      event_form_identifier: fdt$form_identifier,
      form_added: boolean,
      local_status: ost$status,
      p_delete_form_status: ^fdt$form_status,
      p_form_status: ^fdt$form_status,
      screen_change: fdt$screen_change;

?? NEWTITLE := 'condition_handler', EJECT ??

    PROCEDURE condition_handler
      (    condition: pmt$condition;
           condition_information: ^pmt$condition_information;
           stack_frame_save_area: ^ost$stack_frame_save_area;
       VAR handler_status: ost$status);

      CASE condition.selector OF

      = pmc$system_conditions =
        IF (condition.system_conditions * $pmt$system_conditions
              [pmc$instruction_specification, pmc$address_specification, pmc$access_violation,
              pmc$invalid_segment_ring_0, pmc$divide_fault, pmc$arithmetic_overflow, pmc$exponent_overflow,
              pmc$exponent_underflow, pmc$fp_significance_loss, pmc$fp_indefinite,
              pmc$arithmetic_significance, pmc$invalid_bdp_data]) <> $pmt$system_conditions [] THEN
          osp$set_status_abnormal (fdc$format_display_identifier, fde$bad_data_value, '', status);
          EXIT fdp$delete_form;
        IFEND;

      = pmc$user_defined_condition =
        IF condition.user_condition_name = cye$run_time_condition THEN
          osp$set_status_abnormal (fdc$format_display_identifier, fde$bad_data_value, '', status);
          EXIT fdp$delete_form;
        IFEND;

      ELSE
        ;
      CASEND;
      pmp$continue_to_cause (pmc$execute_standard_procedure, handler_status);
    PROCEND condition_handler;

?? OLDTITLE, EJECT ??

    osp$establish_condition_handler (^condition_handler, FALSE);
    fdp$check_for_active_form (form_identifier, p_form_status, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

{ A delete of a form may mean that the screen size of the terminal
{ may be made smaller. Screen Formatting tries to use the largest
{ characters on the terminal screen as possible.

    fdv$screen_status.compute_new_screen_size := TRUE;
    p_form_status^.added := FALSE;
    p_form_status^.combined := FALSE;

{ If cursor is positioned in deleted form, a new cursor position needs
{ to be computed on the next screen update.

    IF ((fdv$screen_status.last_cursor_position_valid) AND
          (fdv$screen_status.last_cursor_form_identifier = form_identifier)) THEN
      fdv$screen_status.last_cursor_position_valid := FALSE;
    IFEND;

{ Delete any associated event form.
{ Ignore errors since the user may have already deleted the event form.

    IF p_form_status^.event_form_defined THEN
      event_form_identifier := p_form_status^.event_form_identifier;
      fdp$delete_form (event_form_identifier, local_status);
    IFEND;

{ Remove form from list giving the priority of forms on the screen.

    update_form_priorities (p_form_status);
    fdp$delete_screen_changes (form_identifier, form_added);

    IF NOT form_added THEN

{ Record delete of form on screen.

      screen_change.key := fdc$delete_form;
      screen_change.form_identifier := form_identifier;
      screen_change.form_x_position := p_form_status^.form_x_position;
      screen_change.form_y_position := p_form_status^.form_y_position;
      fdp$record_screen_change (screen_change, status);
    IFEND;

{ Delete any forms combined with this form.

    current_form_identifier := fdv$screen_status.current_form_identifier;
    WHILE current_form_identifier <> 0 DO
      p_delete_form_status := ^fdv$screen_status.p_forms_status^ [current_form_identifier];
      IF p_delete_form_status^.entry_used THEN
        IF p_delete_form_status^.combined THEN
          IF p_delete_form_status^.added_form_identifier = form_identifier THEN
            fdp$delete_form (p_delete_form_status^.added_form_identifier, local_status);
          IFEND;
        IFEND;
      IFEND;
      current_form_identifier := p_delete_form_status^.next_lower_form;
    WHILEND;


  PROCEND fdp$delete_form;

?? TITLE := 'fdp$delete_screen_changes', EJECT ??
*copyc fdh$delete_screen_changes

  PROCEDURE [XDCL] fdp$delete_screen_changes
    (    form_identifier: fdt$form_identifier;
     VAR form_added: boolean);

    VAR
      n: integer,
      p_screen_change: ^fdt$screen_change;

    form_added := FALSE;

{ Delete any previous changes to the screen that now do not apply.

    FOR n := 1 TO fdv$screen_status.number_screen_changes DO
      p_screen_change := ^fdv$screen_status.p_screen_changes^ [n];
      CASE p_screen_change^.key OF

      = fdc$add_form =
        IF p_screen_change^.form_identifier = form_identifier THEN

{ An add and a delete of the same form with the same screen ordering on the
{ same screen update
{ should result in no screen changes.

          form_added := TRUE;
          p_screen_change^.key := fdc$no_screen_change;
        IFEND;

      = fdc$change_table_size =
        IF p_screen_change^.table_form_identifier = form_identifier THEN
          p_screen_change^.key := fdc$no_screen_change;
        IFEND;

      = fdc$delete_form =
        IF p_screen_change^.form_identifier = form_identifier THEN
          IF fdv$screen_status.p_forms_status^ [form_identifier].displayed_on_screen THEN
            p_screen_change^.key := fdc$erase_form;
          ELSE
            p_screen_change^.key := fdc$no_screen_change;
          IFEND;
        IFEND;

      = fdc$add_object, fdc$delete_object =
        IF p_screen_change^.object_form_identifier = form_identifier THEN
          p_screen_change^.key := fdc$no_screen_change;
        IFEND;

      = fdc$create_mark =
        IF p_screen_change^.create_mark_form_identifier = form_identifier THEN
          p_screen_change^.key := fdc$no_screen_change;
        IFEND;

      = fdc$delete_mark =
        IF p_screen_change^.delete_mark_form_identifier = form_identifier THEN
          p_screen_change^.key := fdc$no_screen_change;
        IFEND;

      = fdc$replace_variable =
        IF p_screen_change^.variable_form_identifier = form_identifier THEN
          p_screen_change^.key := fdc$no_screen_change;
        IFEND;

      = fdc$set_attribute =
        IF p_screen_change^.attribute_form_identifier = form_identifier THEN
          p_screen_change^.key := fdc$no_screen_change;
        IFEND;

      = fdc$set_cursor =
        IF p_screen_change^.cursor_form_identifier = form_identifier THEN
          p_screen_change^.key := fdc$no_screen_change;
        IFEND;

      ELSE { Ignore other screen changes.}
      CASEND;
    FOREND;
  PROCEND fdp$delete_screen_changes;

?? TITLE := 'fdp$get_integer_variable', EJECT ??
*copyc fdh$get_integer_variable

  PROCEDURE [XDCL] fdp$get_integer_variable
    (    form_identifier: fdt$form_identifier;
         name: ost$name;
         occurrence: fdt$occurrence;
     VAR variable: integer;
     VAR variable_status: fdt$variable_status;
     VAR status: ost$status);

    VAR
      object_exists: boolean,
      object_index: fdt$object_index,
      p_form_variable_definition: ^fdt$form_variable_definition,
      p_form_status: ^fdt$form_status,
      p_program_record: ^cell,
      program_record_position: fdt$record_position,
      screen_record_position: fdt$record_position,
      valid_name: ost$name;

?? NEWTITLE := 'condition_handler', EJECT ??

    PROCEDURE condition_handler
      (    condition: pmt$condition;
           condition_information: ^pmt$condition_information;
           stack_frame_save_area: ^ost$stack_frame_save_area;
       VAR handler_status: ost$status);

      CASE condition.selector OF

      = pmc$system_conditions =
        IF (condition.system_conditions * $pmt$system_conditions
              [pmc$instruction_specification, pmc$address_specification, pmc$access_violation,
              pmc$invalid_segment_ring_0, pmc$divide_fault, pmc$arithmetic_overflow, pmc$exponent_overflow,
              pmc$exponent_underflow, pmc$fp_significance_loss, pmc$fp_indefinite,
              pmc$arithmetic_significance, pmc$invalid_bdp_data]) <> $pmt$system_conditions [] THEN
          osp$set_status_abnormal (fdc$format_display_identifier, fde$bad_data_value, '', status);
          EXIT fdp$get_integer_variable;
        IFEND;

      = pmc$user_defined_condition =
        IF condition.user_condition_name = cye$run_time_condition THEN
          osp$set_status_abnormal (fdc$format_display_identifier, fde$bad_data_value, '', status);
          EXIT fdp$get_integer_variable;
        IFEND;

      ELSE
        ;
      CASEND;
      pmp$continue_to_cause (pmc$execute_standard_procedure, handler_status);
    PROCEND condition_handler;

?? OLDTITLE, EJECT ??
    osp$establish_condition_handler (^condition_handler, FALSE);
    fdp$find_form_status (form_identifier, p_form_status, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    #translate (osv$lower_to_upper, name, valid_name);
    find_record_variable (p_form_status, valid_name, occurrence, p_form_variable_definition, object_exists,
          object_index, program_record_position, screen_record_position, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    IF NOT (p_form_variable_definition^.program_data_type = fdc$program_integer_type) THEN
      osp$set_status_abnormal (fdc$format_display_identifier, fde$wrong_variable_type, 'INTEGER', status);
      RETURN;
    IFEND;

    variable_status := p_form_status^.p_form_object_statuses^ [object_index].variable_input_status;
    IF variable_status = fdc$no_error THEN
      p_program_record := ^p_form_status^.p_program_record^ [program_record_position];
      i#move (p_program_record, ^variable, fdc$integer_length);
    IFEND;

  PROCEND fdp$get_integer_variable;

?? TITLE := 'fdp$get_next_changed_variable', EJECT ??
*copyc fdh$get_next_changed_variable

{ DESIGN:
{   Each variable object that has been changed by the terminal user is assigned an index corresponding to
{   instance of Read Forms that changed the field.  Indices that match the current index were changed by the
{   last execution of Read Forms.
{ NOTE:
{   Any field that the terminal user has typed in is flagged as 'changed' even if the contents were not
{   altered.  The check for an actual change is not made because of performance reasons.
{

  PROCEDURE [XDCL] fdp$get_next_changed_variable
    (    form_identifier: fdt$form_identifier;
     VAR variable_name: ost$name;
     VAR occurrence: fdt$occurrence;
     VAR change_found: boolean;
     VAR status: ost$status);

    VAR
      object_index: fdt$object_index,
      p_form_object_definitions: ^array [1 .. * ] of fdt$form_object_definition,
      p_form_object_statuses: ^array [1 .. * ] of fdt$form_object_status,
      p_form_status: ^fdt$form_status,
      start_object_index: fdt$object_index;
?? NEWTITLE := 'condition_handler', EJECT ??

    PROCEDURE condition_handler
      (    condition: pmt$condition;
           condition_information: ^pmt$condition_information;
           stack_frame_save_area: ^ost$stack_frame_save_area;
       VAR handler_status: ost$status);

      CASE condition.selector OF

      = pmc$system_conditions =
        IF (condition.system_conditions * $pmt$system_conditions
              [pmc$instruction_specification, pmc$address_specification, pmc$access_violation,
              pmc$invalid_segment_ring_0, pmc$divide_fault, pmc$arithmetic_overflow, pmc$exponent_overflow,
              pmc$exponent_underflow, pmc$fp_significance_loss, pmc$fp_indefinite,
              pmc$arithmetic_significance, pmc$invalid_bdp_data]) <> $pmt$system_conditions [] THEN
          osp$set_status_abnormal (fdc$format_display_identifier, fde$bad_data_value, '', status);
          EXIT fdp$get_next_changed_variable;
        IFEND;

      = pmc$user_defined_condition =
        IF condition.user_condition_name = cye$run_time_condition THEN
          osp$set_status_abnormal (fdc$format_display_identifier, fde$bad_data_value, '', status);
          EXIT fdp$get_next_changed_variable;
        IFEND;

      ELSE
        ;
      CASEND;
      pmp$continue_to_cause (pmc$execute_standard_procedure, handler_status);

    PROCEND condition_handler;

?? OLDTITLE, EJECT ??

    osp$establish_condition_handler (^condition_handler, FALSE);
    status.normal := TRUE;
    variable_name := '';
    change_found := FALSE;

    fdp$find_form_status (form_identifier, p_form_status, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    IF p_form_status^.push_count <> 0 THEN
      osp$set_status_abnormal (fdc$format_display_identifier, fde$form_pushed,
            p_form_status^.p_form_definition^.form_name, status);
      RETURN;
    IFEND;

    CASE p_form_status^.changed_variable_search.status OF
    = fdc$searching =

{ Continue search after the last changed variable that was found.

      IF p_form_status^.changed_variable_search.object_index < UPPERBOUND (p_form_object_statuses^) THEN
        start_object_index := p_form_status^.changed_variable_search.object_index + 1;
      ELSE

{ Must be at the end of the object list.

        p_form_status^.changed_variable_search.status := fdc$search_completed;
        RETURN;
      IFEND;

    = fdc$not_searched =
      start_object_index := 1;

    ELSE  { fdc$search_completed

{ No changes left to find.

      RETURN;
    CASEND;

    p_form_object_statuses := p_form_status^.p_form_object_statuses;
    p_form_object_definitions := p_form_status^.p_form_object_definitions;

    FOR object_index := start_object_index TO UPPERBOUND (p_form_object_statuses^) DO
      CASE p_form_object_definitions^ [object_index].key OF
      = fdc$form_stored_variable, fdc$form_variable_text, fdc$form_variable_text_box =
        IF p_form_object_statuses^ [object_index].changed_by_read_forms_index =
              fdv$screen_status.read_forms_index THEN

{ Variable object was changed during the last execution of Read Forms.

          p_form_status^.changed_variable_search.status := fdc$searching;
          p_form_status^.changed_variable_search.object_index := object_index;
          variable_name := p_form_object_definitions^ [object_index].name;
          occurrence := p_form_object_definitions^ [object_index].occurrence;
          change_found := TRUE;
          RETURN;
        IFEND;
      ELSE
      CASEND;
    FOREND;

{ There are no more changes left to find.

    p_form_status^.changed_variable_search.status := fdc$search_completed;

  PROCEND fdp$get_next_changed_variable;
?? TITLE := 'fdp$get_next_event', EJECT ??
*copyc fdh$get_next_event

  PROCEDURE [XDCL] fdp$get_next_event
    (VAR event_name: ost$name;
     VAR event_normal: boolean;
     VAR event_position: fdt$event_position;
     VAR last_event: boolean;
     VAR status: ost$status);

?? NEWTITLE := 'condition_handler', EJECT ??

    PROCEDURE condition_handler
      (    condition: pmt$condition;
           condition_information: ^pmt$condition_information;
           stack_frame_save_area: ^ost$stack_frame_save_area;
       VAR handler_status: ost$status);

      CASE condition.selector OF

      = pmc$system_conditions =
        IF (condition.system_conditions * $pmt$system_conditions
              [pmc$instruction_specification, pmc$address_specification, pmc$access_violation,
              pmc$invalid_segment_ring_0, pmc$divide_fault, pmc$arithmetic_overflow, pmc$exponent_overflow,
              pmc$exponent_underflow, pmc$fp_significance_loss, pmc$fp_indefinite,
              pmc$arithmetic_significance, pmc$invalid_bdp_data]) <> $pmt$system_conditions [] THEN
          osp$set_status_abnormal (fdc$format_display_identifier, fde$bad_data_value, '', status);
          EXIT fdp$get_next_event;
        IFEND;

      = pmc$user_defined_condition =
        IF condition.user_condition_name = cye$run_time_condition THEN
          osp$set_status_abnormal (fdc$format_display_identifier, fde$bad_data_value, '', status);
          EXIT fdp$get_next_event;
        IFEND;

      ELSE
        ;
      CASEND;
      pmp$continue_to_cause (pmc$execute_standard_procedure, handler_status);
    PROCEND condition_handler;

?? OLDTITLE, EJECT ??
    osp$establish_condition_handler (^condition_handler, FALSE);
    status.normal := TRUE;
    event_name := fdv$screen_status.event_name;
    event_normal := fdv$screen_status.event_normal;
    event_position := fdv$screen_status.event_position;
    last_event := TRUE;
  PROCEND fdp$get_next_event;

?? TITLE := 'fdp$get_next_input_error', EJECT ??
*copyc fdh$get_next_input_error

  PROCEDURE [XDCL] fdp$get_next_input_error
    (    form_identifier: fdt$form_identifier;
     VAR variable_name: ost$name;
     VAR occurrence: fdt$occurrence;
     VAR variable_status: fdt$variable_status;
     VAR status: ost$status);

    VAR
      p_form_status: ^fdt$form_status,
      start_object_index: fdt$object_index;
?? NEWTITLE := 'condition_handler', EJECT ??

    PROCEDURE condition_handler
      (    condition: pmt$condition;
           condition_information: ^pmt$condition_information;
           stack_frame_save_area: ^ost$stack_frame_save_area;
       VAR handler_status: ost$status);

      CASE condition.selector OF

      = pmc$system_conditions =
        IF (condition.system_conditions * $pmt$system_conditions
              [pmc$instruction_specification, pmc$address_specification, pmc$access_violation,
              pmc$invalid_segment_ring_0, pmc$divide_fault, pmc$arithmetic_overflow, pmc$exponent_overflow,
              pmc$exponent_underflow, pmc$fp_significance_loss, pmc$fp_indefinite,
              pmc$arithmetic_significance, pmc$invalid_bdp_data]) <> $pmt$system_conditions [] THEN
          osp$set_status_abnormal (fdc$format_display_identifier, fde$bad_data_value, '', status);
          EXIT fdp$get_next_input_error;
        IFEND;

      = pmc$user_defined_condition =
        IF condition.user_condition_name = cye$run_time_condition THEN
          osp$set_status_abnormal (fdc$format_display_identifier, fde$bad_data_value, '', status);
          EXIT fdp$get_next_input_error;
        IFEND;

      ELSE
        ;
      CASEND;
      pmp$continue_to_cause (pmc$execute_standard_procedure, handler_status);

    PROCEND condition_handler;

?? OLDTITLE, EJECT ??

    osp$establish_condition_handler (^condition_handler, FALSE);
    status.normal := TRUE;
    variable_name := '';
    variable_status := fdc$no_error;

    fdp$find_form_status (form_identifier, p_form_status, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    IF p_form_status^.push_count <> 0 THEN
      osp$set_status_abnormal (fdc$format_display_identifier, fde$form_pushed,
            p_form_status^.p_form_definition^.form_name, status);
      RETURN;
    IFEND;

    CASE p_form_status^.input_error_search.status OF
    = fdc$searching =

{ Continue search after the last error found.

      IF p_form_status^.input_error_search.object_index < UPPERBOUND (p_form_status^.p_form_object_statuses^)
            THEN
        start_object_index := p_form_status^.input_error_search.object_index + 1;
      ELSE

{ Must be at end of object list.

        p_form_status^.input_error_search.status := fdc$search_completed;
        RETURN;
      IFEND;

    = fdc$not_searched =
      start_object_index := 1;
    = fdc$search_completed =

{ No errors left to find.

      RETURN;
    ELSE { fdc$search_not_allowed
      osp$set_status_abnormal (fdc$format_display_identifier, fde$unexpected_call_to,
            'Get Next Input Error', status);

      RETURN;
    CASEND;

    find_next_input_error (p_form_status, start_object_index, variable_name, occurrence, variable_status);

  PROCEND fdp$get_next_input_error;
?? TITLE := 'fdp$get_next_output_error', EJECT ??
*copyc fdh$get_next_output_error

  PROCEDURE [XDCL] fdp$get_next_output_error
    (    form_identifier: fdt$form_identifier;
     VAR variable_name: ost$name;
     VAR occurrence: fdt$occurrence;
     VAR variable_status: fdt$variable_status;
     VAR status: ost$status);

    VAR
      object_index: fdt$object_index,
      p_form_object_definitions: ^array [1 .. * ] of fdt$form_object_definition,
      p_form_object_statuses: ^array [1 .. * ] of fdt$form_object_status,
      p_form_status: ^fdt$form_status,
      start_object_index: fdt$object_index;
?? NEWTITLE := 'condition_handler', EJECT ??

    PROCEDURE condition_handler
      (    condition: pmt$condition;
           condition_information: ^pmt$condition_information;
           stack_frame_save_area: ^ost$stack_frame_save_area;
       VAR handler_status: ost$status);

      CASE condition.selector OF

      = pmc$system_conditions =
        IF (condition.system_conditions * $pmt$system_conditions
              [pmc$instruction_specification, pmc$address_specification, pmc$access_violation,
              pmc$invalid_segment_ring_0, pmc$divide_fault, pmc$arithmetic_overflow, pmc$exponent_overflow,
              pmc$exponent_underflow, pmc$fp_significance_loss, pmc$fp_indefinite,
              pmc$arithmetic_significance, pmc$invalid_bdp_data]) <> $pmt$system_conditions [] THEN
          osp$set_status_abnormal (fdc$format_display_identifier, fde$bad_data_value, '', status);
          EXIT fdp$get_next_output_error;
        IFEND;

      = pmc$user_defined_condition =
        IF condition.user_condition_name = cye$run_time_condition THEN
          osp$set_status_abnormal (fdc$format_display_identifier, fde$bad_data_value, '', status);
          EXIT fdp$get_next_output_error;
        IFEND;

      ELSE
        ;
      CASEND;
      pmp$continue_to_cause (pmc$execute_standard_procedure, handler_status);

    PROCEND condition_handler;

?? OLDTITLE, EJECT ??

    osp$establish_condition_handler (^condition_handler, FALSE);
    status.normal := TRUE;
    variable_name := '';
    variable_status := fdc$no_error;

    fdp$find_form_status (form_identifier, p_form_status, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    IF p_form_status^.push_count <> 0 THEN
      osp$set_status_abnormal (fdc$format_display_identifier, fde$form_pushed,
            p_form_status^.p_form_definition^.form_name, status);
      RETURN;
    IFEND;

    p_form_object_statuses := p_form_status^.p_form_object_statuses;
    p_form_object_definitions := p_form_status^.p_form_object_definitions;

    CASE p_form_status^.output_error_search.status OF
    = fdc$searching =

{ Continue search after the last error found.

      IF p_form_status^.output_error_search.object_index < UPPERBOUND (p_form_object_statuses^) THEN
        start_object_index := p_form_status^.output_error_search.object_index + 1;
      ELSE

{ Must be at end of object list.

        p_form_status^.output_error_search.status := fdc$search_completed;
        RETURN;
      IFEND;

    = fdc$not_searched =
      start_object_index := 1;
    = fdc$search_completed =

{ No errors left to find.

      RETURN;
    ELSE { fdc$search_not_allowed
      osp$set_status_abnormal (fdc$format_display_identifier, fde$unexpected_call_to,
            'Get Next Output Error', status);
      RETURN;
    CASEND;

    FOR object_index := start_object_index TO UPPERBOUND (p_form_object_statuses^) DO
      CASE p_form_object_definitions^ [object_index].key OF
      = fdc$form_stored_variable, fdc$form_variable_text, fdc$form_variable_text_box =
        IF p_form_object_statuses^ [object_index].variable_output_status <> fdc$no_error THEN
          p_form_status^.output_error_search.status := fdc$searching;
          p_form_status^.output_error_search.object_index := object_index;
          variable_name := p_form_object_definitions^ [object_index].name;
          occurrence := p_form_object_definitions^ [object_index].occurrence;
          variable_status := p_form_object_statuses^ [object_index].variable_output_status;
          RETURN;
        IFEND;
      ELSE
      CASEND;
    FOREND;

    p_form_status^.output_error_search.status := fdc$search_completed;

  PROCEND fdp$get_next_output_error;
?? TITLE := 'fdp$get_number_of_occurrences', EJECT ??
*copyc fdh$get_number_of_occurrences

  PROCEDURE [XDCL] fdp$get_number_of_occurrences
    (    form_identifier: fdt$form_identifier;
         variable_name: ost$name;
     VAR table_member: boolean;
     VAR occurrences: fdt$occurrence;
     VAR status: ost$status);

    VAR
      object_exists: boolean,
      object_index: fdt$object_index,
      p_form_variable_definition: ^fdt$form_variable_definition,
      p_form_status: ^fdt$form_status,
      program_record_position: fdt$record_position,
      screen_record_position: fdt$record_position,
      screen_variable_length: fdt$text_length,
      table_index: fdt$table_index,
      valid_name: ost$name;

?? NEWTITLE := 'condition_handler', EJECT ??

    PROCEDURE condition_handler
      (    condition: pmt$condition;
           condition_information: ^pmt$condition_information;
           stack_frame_save_area: ^ost$stack_frame_save_area;
       VAR handler_status: ost$status);

      CASE condition.selector OF

      = pmc$system_conditions =
        IF (condition.system_conditions * $pmt$system_conditions
              [pmc$instruction_specification, pmc$address_specification, pmc$access_violation,
              pmc$invalid_segment_ring_0, pmc$divide_fault, pmc$arithmetic_overflow, pmc$exponent_overflow,
              pmc$exponent_underflow, pmc$fp_significance_loss, pmc$fp_indefinite,
              pmc$arithmetic_significance, pmc$invalid_bdp_data]) <> $pmt$system_conditions [] THEN
          osp$set_status_abnormal (fdc$format_display_identifier, fde$bad_data_value, '', status);
          EXIT fdp$get_number_of_occurrences;
        IFEND;

      = pmc$user_defined_condition =
        IF condition.user_condition_name = cye$run_time_condition THEN
          osp$set_status_abnormal (fdc$format_display_identifier, fde$bad_data_value, '', status);
          EXIT fdp$get_number_of_occurrences;
        IFEND;

      ELSE
        ;
      CASEND;
      pmp$continue_to_cause (pmc$execute_standard_procedure, handler_status);
    PROCEND condition_handler;

?? OLDTITLE, EJECT ??
    osp$establish_condition_handler (^condition_handler, FALSE);
    status.normal := TRUE;

    fdp$find_form_status (form_identifier, p_form_status, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    #translate (osv$lower_to_upper, variable_name, valid_name);
    find_record_variable (p_form_status, valid_name, 1, p_form_variable_definition, object_exists,
          object_index, program_record_position, screen_record_position, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    IF p_form_variable_definition^.table_exists THEN
      table_member := TRUE;
      table_index := p_form_variable_definition^.table_index;
      occurrences := p_form_status^.p_form_table_definitions^ [table_index].stored_occurrence;
    ELSE
      table_member := FALSE;
      occurrences := 1;
    IFEND;

  PROCEND fdp$get_number_of_occurrences;

?? TITLE := 'fdp$get_real_variable', EJECT ??
*copyc fdh$get_real_variable

  PROCEDURE [XDCL] fdp$get_real_variable
    (    form_identifier: fdt$form_identifier;
         name: ost$name;
         occurrence: fdt$occurrence;
     VAR variable: real;
     VAR variable_status: fdt$variable_status;
     VAR status: ost$status);

    VAR
      object_exists: boolean,
      object_index: fdt$object_index,
      p_form_variable_definition: ^fdt$form_variable_definition,
      p_form_status: ^fdt$form_status,
      p_program_record: ^cell,
      program_record_position: fdt$record_position,
      screen_record_position: fdt$record_position,
      valid_name: ost$name;

?? NEWTITLE := 'condition_handler', EJECT ??

    PROCEDURE condition_handler
      (    condition: pmt$condition;
           condition_information: ^pmt$condition_information;
           stack_frame_save_area: ^ost$stack_frame_save_area;
       VAR handler_status: ost$status);

      CASE condition.selector OF

      = pmc$system_conditions =
        IF (condition.system_conditions * $pmt$system_conditions
              [pmc$instruction_specification, pmc$address_specification, pmc$access_violation,
              pmc$invalid_segment_ring_0, pmc$divide_fault, pmc$arithmetic_overflow, pmc$exponent_overflow,
              pmc$exponent_underflow, pmc$fp_significance_loss, pmc$fp_indefinite,
              pmc$arithmetic_significance, pmc$invalid_bdp_data]) <> $pmt$system_conditions [] THEN
          osp$set_status_abnormal (fdc$format_display_identifier, fde$bad_data_value, '', status);
          EXIT fdp$get_real_variable;
        IFEND;

      = pmc$user_defined_condition =
        IF condition.user_condition_name = cye$run_time_condition THEN
          osp$set_status_abnormal (fdc$format_display_identifier, fde$bad_data_value, '', status);
          EXIT fdp$get_real_variable;
        IFEND;

      ELSE
        ;
      CASEND;
      pmp$continue_to_cause (pmc$execute_standard_procedure, handler_status);
    PROCEND condition_handler;

?? OLDTITLE, EJECT ??
    osp$establish_condition_handler (^condition_handler, FALSE);
    fdp$find_form_status (form_identifier, p_form_status, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    #translate (osv$lower_to_upper, name, valid_name);
    find_record_variable (p_form_status, valid_name, occurrence, p_form_variable_definition, object_exists,
          object_index, program_record_position, screen_record_position, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    IF NOT (p_form_variable_definition^.program_data_type = fdc$program_real_type) THEN
      osp$set_status_abnormal (fdc$format_display_identifier, fde$wrong_variable_type, 'REAL', status);
      RETURN;
    IFEND;

    variable_status := p_form_status^.p_form_object_statuses^ [object_index].variable_input_status;
    IF variable_status = fdc$no_error THEN
      p_program_record := ^p_form_status^.p_program_record^ [program_record_position];
      i#move (p_program_record, ^variable, fdc$real_length);
    IFEND;

  PROCEND fdp$get_real_variable;

?? TITLE := 'fdp$get_record', EJECT ??
*copyc fdh$get_record

  PROCEDURE [XDCL] fdp$get_record
    (    form_identifier: fdt$form_identifier;
         p_work_area: ^cell;
         work_area_length: fdt$work_area_length;
     VAR variable_status: fdt$variable_status;
     VAR status: ost$status);

    VAR
      ignore_occurrence: fdt$occurrence,
      ignore_variable_name: ost$name,
      p_form_status: ^fdt$form_status,
      p_program_record: ^array [1 .. * ] of cell,
      p_user_record: ^cell,
      program_record_position: fdt$record_position,
      record_offset: integer,
      user_offset: integer,
      user_record_length: integer,
      user_ring: integer,
      user_segment: integer;

?? NEWTITLE := 'condition_handler', EJECT ??

    PROCEDURE condition_handler
      (    condition: pmt$condition;
           condition_information: ^pmt$condition_information;
           stack_frame_save_area: ^ost$stack_frame_save_area;
       VAR handler_status: ost$status);

      CASE condition.selector OF

      = pmc$system_conditions =
        IF (condition.system_conditions * $pmt$system_conditions
              [pmc$instruction_specification, pmc$address_specification, pmc$access_violation,
              pmc$invalid_segment_ring_0, pmc$divide_fault, pmc$arithmetic_overflow, pmc$exponent_overflow,
              pmc$exponent_underflow, pmc$fp_significance_loss, pmc$fp_indefinite,
              pmc$arithmetic_significance, pmc$invalid_bdp_data]) <> $pmt$system_conditions [] THEN
          osp$set_status_abnormal (fdc$format_display_identifier, fde$bad_data_value, '', status);
          EXIT fdp$get_record;
        IFEND;

      = pmc$user_defined_condition =
        IF condition.user_condition_name = cye$run_time_condition THEN
          osp$set_status_abnormal (fdc$format_display_identifier, fde$bad_data_value, '', status);
          EXIT fdp$get_record;
        IFEND;

      ELSE
        ;
      CASEND;
      pmp$continue_to_cause (pmc$execute_standard_procedure, handler_status);
    PROCEND condition_handler;

?? OLDTITLE, EJECT ??
    osp$establish_condition_handler (^condition_handler, FALSE);
    fdp$find_form_status (form_identifier, p_form_status, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

{ Validate that user work area can  hold  the  record.

    IF p_form_status^.p_form_record_definitions = NIL THEN
      osp$set_status_abnormal (fdc$format_display_identifier, fde$form_has_no_variables,
            p_form_status^.p_form_definition^.form_name, status);
      RETURN;
    IFEND;

    IF work_area_length <> #SIZE (p_form_status^.p_program_record^) THEN
      osp$set_status_abnormal (fdc$format_display_identifier, fde$work_area_invalid,
            p_form_status^.p_form_definition^.form_name, status);
      RETURN;
    IFEND;

    p_program_record := p_form_status^.p_program_record;

{ Check for any input errors.

    find_next_input_error (p_form_status, 1, ignore_variable_name, ignore_occurrence, variable_status);
    IF variable_status <> fdc$no_error THEN

{ Reset the search status so later calls to fdp$get_next_input_error will find the first error.

      p_form_status^.input_error_search.status := fdc$not_searched;
      RETURN;
    IFEND;

{ Move Screen Formatting record to user record.

    user_record_length := work_area_length;
    p_user_record := p_work_area;
    user_ring := #ring (p_work_area);
    user_segment := #segment (p_work_area);
    user_offset := #offset (p_work_area);
    record_offset := user_offset;
    program_record_position := 1;

    /move_record/
    WHILE TRUE DO
      p_user_record := #ADDRESS (user_ring, user_segment, record_offset);
      IF user_record_length > cyc$max_string_size THEN
        i#move (^p_program_record^ [program_record_position], p_user_record, cyc$max_string_size);
        record_offset := record_offset + cyc$max_string_size;
        program_record_position := program_record_position + cyc$max_string_size;
        user_record_length := user_record_length - cyc$max_string_size;
      ELSE
        i#move (^p_program_record^ [program_record_position], p_user_record, user_record_length);
        EXIT /move_record/;
      IFEND;
    WHILEND /move_record/;

  PROCEND fdp$get_record;

?? TITLE := 'fdp$get_screen_variable', EJECT ??
*copyc fdh$get_screen_variable

  PROCEDURE [XDCL] fdp$get_screen_variable
    (    form_identifier: fdt$form_identifier;
         name: ost$name;
         occurrence: fdt$occurrence;
     VAR screen_variable: fdt$text;
     VAR status: ost$status);

    VAR
      program_record_position: fdt$record_position,
      object_exists: boolean,
      object_index: fdt$object_index,
      p_form_object_status: ^fdt$form_object_status,
      p_form_variable_definition: ^fdt$form_variable_definition,
      p_form_status: ^fdt$form_status,
      p_screen_variable: ^fdt$text,
      screen_record_position: fdt$record_position,
      valid_name: ost$name;

?? NEWTITLE := 'condition_handler', EJECT ??

    PROCEDURE condition_handler
      (    condition: pmt$condition;
           condition_information: ^pmt$condition_information;
           stack_frame_save_area: ^ost$stack_frame_save_area;
       VAR handler_status: ost$status);

      CASE condition.selector OF

      = pmc$system_conditions =
        IF (condition.system_conditions * $pmt$system_conditions
              [pmc$instruction_specification, pmc$address_specification, pmc$access_violation,
              pmc$invalid_segment_ring_0, pmc$divide_fault, pmc$arithmetic_overflow, pmc$exponent_overflow,
              pmc$exponent_underflow, pmc$fp_significance_loss, pmc$fp_indefinite,
              pmc$arithmetic_significance, pmc$invalid_bdp_data]) <> $pmt$system_conditions [] THEN
          osp$set_status_abnormal (fdc$format_display_identifier, fde$bad_data_value, '', status);
          EXIT fdp$get_screen_variable;
        IFEND;

      = pmc$user_defined_condition =
        IF condition.user_condition_name = cye$run_time_condition THEN
          osp$set_status_abnormal (fdc$format_display_identifier, fde$bad_data_value, '', status);
          EXIT fdp$get_screen_variable;
        IFEND;

      ELSE
        ;
      CASEND;
      pmp$continue_to_cause (pmc$execute_standard_procedure, handler_status);

    PROCEND condition_handler;

?? OLDTITLE, EJECT ??
    osp$establish_condition_handler (^condition_handler, FALSE);
    fdp$find_form_status (form_identifier, p_form_status, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    #TRANSLATE (osv$lower_to_upper, name, valid_name);
    find_record_variable (p_form_status, valid_name, occurrence, p_form_variable_definition, object_exists,
          object_index, program_record_position, screen_record_position, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    p_form_object_status := ^p_form_status^.p_form_object_statuses^ [object_index];
    p_form_object_status^.variable_input_status := fdc$no_error;
    fdp$ptr_screen_variable (p_form_status^.p_screen_record, screen_record_position,
          p_form_variable_definition^.screen_variable_length, p_screen_variable);
    screen_variable := p_screen_variable^;

  PROCEND fdp$get_screen_variable;
?? TITLE := 'fdp$get_string_variable', EJECT ??
*copyc fdh$get_string_variable

  PROCEDURE [XDCL] fdp$get_string_variable
    (    form_identifier: fdt$form_identifier;
         name: ost$name;
         occurrence: fdt$occurrence;
     VAR variable: fdt$text;
     VAR variable_status: fdt$variable_status;
     VAR status: ost$status);

    VAR
      error: mlt$error,
      defined_variable_length: fdt$program_variable_length,
      object_exists: boolean,
      object_index: fdt$object_index,
      p_form_variable_definition: ^fdt$form_variable_definition,
      p_form_status: ^fdt$form_status,
      p_program_record: ^cell,
      program_record_position: fdt$record_position,
      program_variable_length: fdt$program_variable_length,
      screen_record_position: fdt$record_position,
      valid_name: ost$name;

?? NEWTITLE := 'condition_handler', EJECT ??

    PROCEDURE condition_handler
      (    condition: pmt$condition;
           condition_information: ^pmt$condition_information;
           stack_frame_save_area: ^ost$stack_frame_save_area;
       VAR handler_status: ost$status);

      CASE condition.selector OF

      = pmc$system_conditions =
        IF (condition.system_conditions * $pmt$system_conditions
              [pmc$instruction_specification, pmc$address_specification, pmc$access_violation,
              pmc$invalid_segment_ring_0, pmc$divide_fault, pmc$arithmetic_overflow, pmc$exponent_overflow,
              pmc$exponent_underflow, pmc$fp_significance_loss, pmc$fp_indefinite,
              pmc$arithmetic_significance, pmc$invalid_bdp_data]) <> $pmt$system_conditions [] THEN
          osp$set_status_abnormal (fdc$format_display_identifier, fde$bad_data_value, '', status);
          EXIT fdp$get_string_variable;
        IFEND;

      = pmc$user_defined_condition =
        IF condition.user_condition_name = cye$run_time_condition THEN
          osp$set_status_abnormal (fdc$format_display_identifier, fde$bad_data_value, '', status);
          EXIT fdp$get_string_variable;
        IFEND;

      ELSE
        ;
      CASEND;
      pmp$continue_to_cause (pmc$execute_standard_procedure, handler_status);
    PROCEND condition_handler;

?? OLDTITLE, EJECT ??
    osp$establish_condition_handler (^condition_handler, FALSE);
    fdp$find_form_status (form_identifier, p_form_status, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    #translate (osv$lower_to_upper, name, valid_name);
    find_record_variable (p_form_status, valid_name, occurrence, p_form_variable_definition, object_exists,
          object_index, program_record_position, screen_record_position, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    IF NOT ((p_form_variable_definition^.program_data_type = fdc$program_character_type) OR
          (p_form_variable_definition^.program_data_type = fdc$program_upper_case_type)) THEN
      osp$set_status_abnormal (fdc$format_display_identifier, fde$wrong_variable_type,
            'CHARACTER or UPPER_CASE', status);
      RETURN;
    IFEND;

    program_variable_length := STRLENGTH (variable);
    defined_variable_length := p_form_variable_definition^.program_variable_length;
    variable_status := p_form_status^.p_form_object_statuses^ [object_index].variable_input_status;
    IF variable_status = fdc$no_error THEN
      p_program_record := ^p_form_status^.p_program_record^ [program_record_position];
      mlp$move_bytes (p_program_record, defined_variable_length, ^variable, program_variable_length, error);
      IF defined_variable_length > program_variable_length THEN
        variable_status := fdc$variable_truncated;
      IFEND;
    IFEND;

  PROCEND fdp$get_string_variable;

?? TITLE := 'fdp$initialize_form_objects', EJECT ??
*copy fdh$initialize_form_objects

  PROCEDURE [XDCL] fdp$initialize_form_objects
    (    form_identifier: fdt$form_identifier;
         p_form_status: ^fdt$form_status;
         record_changes: boolean;
     VAR status: ost$status);

    VAR
      display_attribute_set: fdt$display_attribute_set,
      first_displayed_occurrence: fdt$occurrence,
      fragment_object_index: fdt$object_index,
      input: boolean,
      object_index: fdt$object_index,
      output: boolean,
      next_object_index: fdt$object_index,
      number_objects: fdt$number_objects,
      p_form_definition: ^fdt$form_definition,
      p_form_module: ^fdt$form_module,
      p_form_object_definition: ^fdt$form_object_definition,
      p_form_object_definitions: ^array [1 .. * ] of fdt$form_object_definition,
      p_form_object_statuses: ^array [1 .. * ] of fdt$form_object_status,
      p_form_table_definitions: ^array [1 .. * ] of fdt$form_table_definition,
      p_form_table_statuses: ^array [1 .. * ] of fdt$table_status,
      p_form_variable_definition: ^fdt$form_variable_definition,
      p_form_variable_definitions: ^array [1 .. * ] of fdt$form_variable_definition,
      p_text: ^fdt$text;

    status.normal := TRUE;
    p_form_module := p_form_status^.p_form_module;
    number_objects := p_form_status^.p_form_definition^.form_object_definitions.active_number;
    p_form_definition := p_form_status^.p_form_definition;
    p_form_object_statuses := p_form_status^.p_form_object_statuses;
    p_form_object_definitions := p_form_status^.p_form_object_definitions;
    p_form_table_definitions := p_form_status^.p_form_table_definitions;
    p_form_table_statuses := p_form_status^.p_form_table_statuses;
    p_form_variable_definitions := p_form_status^.p_form_variable_definitions;

{ Initialize display attributes and data character position.

    FOR object_index := 1 TO number_objects DO
      p_form_object_definition := ^p_form_object_definitions^ [object_index];
      CASE p_form_object_definition^.key OF

      = fdc$form_box =
        IF record_changes THEN
          record_attribute_change (form_identifier, object_index,
                p_form_object_definition^.display_attribute,
                p_form_object_statuses^ [object_index].display_attribute_set, status);
          IF NOT status.normal THEN
            RETURN;
          IFEND;
        IFEND;
        p_form_object_statuses^ [object_index].display_attribute_set :=
              p_form_object_definition^.display_attribute;

      = fdc$form_constant_text =
        IF record_changes THEN
          record_attribute_change (form_identifier, object_index,
                p_form_object_definition^.display_attribute,
                p_form_object_statuses^ [object_index].display_attribute_set, status);
          IF NOT status.normal THEN
            RETURN;
          IFEND;

          p_text := fdp$ptr_text (p_form_object_definition^.constant_text,
              p_form_status^.p_form_module);
          record_value_change (form_identifier, object_index, p_text, p_form_object_statuses, status);
          IF NOT status.normal THEN
            RETURN;
          IFEND;
        IFEND;

        p_form_object_statuses^ [object_index].display_attribute_set :=
              p_form_object_definition^.display_attribute;
        p_form_object_statuses^ [object_index].character_position := 1;
        p_form_object_statuses^ [object_index].user_changed_field := FALSE;
        p_form_object_statuses^ [object_index].user_entered_field := TRUE;

      = fdc$form_constant_text_box =
        IF record_changes THEN
          record_attribute_change (form_identifier, object_index,
                p_form_object_definition^.display_attribute,
                p_form_object_statuses^ [object_index].display_attribute_set, status);
          IF NOT status.normal THEN
            RETURN;
          IFEND;

          p_text := fdp$ptr_text (p_form_object_definition^.constant_box_text,
              p_form_status^.p_form_module);
          record_value_change (form_identifier, object_index, p_text, p_form_object_statuses, status);
          IF NOT status.normal THEN
            RETURN;
          IFEND;
        IFEND;

        p_form_object_statuses^ [object_index].display_attribute_set :=
              p_form_object_definition^.display_attribute;
        p_form_object_statuses^ [object_index].character_position := 1;
        p_form_object_statuses^ [object_index].user_changed_field := FALSE;
        p_form_object_statuses^ [object_index].user_entered_field := TRUE;

        fragment_object_index := p_form_object_definition^.constant_box_fragment_index;
        WHILE fragment_object_index <> 0 DO
          p_form_object_statuses^ [fragment_object_index].display_attribute_set :=
                p_form_object_definition^.display_attribute;
          p_form_object_statuses^ [fragment_object_index].character_position := 1;
          p_form_object_statuses^ [object_index].user_changed_field := FALSE;
        p_form_object_statuses^ [object_index].user_entered_field := TRUE;
          fragment_object_index := p_form_object_definitions^ [fragment_object_index].
                next_fragment_object_index;
        WHILEND;

      = fdc$form_line =
        IF record_changes THEN
          record_attribute_change (form_identifier, object_index,
                p_form_object_definition^.display_attribute,
                p_form_object_statuses^ [object_index].display_attribute_set, status);
          IF NOT status.normal THEN
            RETURN;
          IFEND;
        IFEND;

        p_form_object_statuses^ [object_index].display_attribute_set :=
              p_form_object_definition^.display_attribute;

      = fdc$form_table =
        IF record_changes THEN
          record_attribute_change (form_identifier, object_index,
                p_form_object_definition^.display_attribute,
                p_form_object_statuses^ [object_index].display_attribute_set, status);
          IF NOT status.normal THEN
            RETURN;
          IFEND;
        IFEND;

        p_form_object_statuses^ [object_index].display_attribute_set :=
              p_form_object_definition^.display_attribute;
        p_form_object_statuses^ [object_index].character_position := 1;
        p_form_object_statuses^ [object_index].user_changed_field := FALSE;
        p_form_object_statuses^ [object_index].user_entered_field := TRUE;

      = fdc$form_stored_variable =
        p_form_object_statuses^ [object_index].display_attribute_set :=
              p_form_object_definition^.display_attribute;
        p_form_object_statuses^ [object_index].user_changed_field := FALSE;
        p_form_object_statuses^ [object_index].user_entered_field := FALSE;
        p_form_object_statuses^ [object_index].character_position := 1;
        p_form_object_statuses^ [object_index].changed_by_read_forms_index := 0;

      = fdc$form_variable_text =
        p_form_object_statuses^ [object_index].display_attribute_set :=
              p_form_object_definition^.display_attribute;
        p_form_object_statuses^ [object_index].character_position := 1;
        p_form_object_statuses^ [object_index].user_changed_field := FALSE;
        p_form_object_statuses^ [object_index].user_entered_field := FALSE;
        p_form_object_statuses^ [object_index].changed_by_read_forms_index := 0;

      = fdc$form_variable_text_box =
        p_form_object_statuses^ [object_index].display_attribute_set :=
              p_form_object_definition^.display_attribute;
        p_form_object_statuses^ [object_index].character_position := 1;
        p_form_object_statuses^ [object_index].user_changed_field := FALSE;
        p_form_object_statuses^ [object_index].user_entered_field := FALSE;
        p_form_object_statuses^ [object_index].changed_by_read_forms_index := 0;

        fragment_object_index := p_form_object_definition^.variable_box_fragment_index;
        WHILE fragment_object_index <> 0 DO
          p_form_object_statuses^ [fragment_object_index].display_attribute_set :=
                p_form_object_definition^.display_attribute;
          p_form_object_statuses^ [fragment_object_index].character_position := 1;
          p_form_object_statuses^ [fragment_object_index].user_changed_field := FALSE;
          p_form_object_statuses^ [fragment_object_index].user_entered_field := FALSE;
          p_form_object_statuses^ [fragment_object_index].changed_by_read_forms_index := 0;
          fragment_object_index := p_form_object_definitions^ [fragment_object_index].
                next_fragment_object_index;
        WHILEND;

      ELSE

{ Ignore these objects.

      CASEND;
    FOREND;
  PROCEND fdp$initialize_form_objects;

?? TITLE := 'fdp$initialize_form_record', EJECT ??
*copy fdh$initialize_form_record

  PROCEDURE [XDCL] fdp$initialize_form_record
    (    form_identifier: fdt$form_identifier;
         p_form_status: ^fdt$form_status;
         record_change: boolean;
     VAR variable_status: fdt$variable_status;
     VAR status: ost$status);

    VAR
      ignore_record_screen_change: boolean,
      initial_value: [READ, STATIC] string (1) := ' ',
      object_index: fdt$object_index,
      p_form_module: ^fdt$form_module,
      p_form_object_definition: ^fdt$form_object_definition,
      p_form_object_definitions: ^array [1 .. * ] of fdt$form_object_definition,
      p_form_object_statuses: ^array [1 .. * ] of fdt$form_object_status,
      p_form_record_definitions: ^array [1 .. * ] of fdt$variable_record_definition,
      p_form_table_definition: ^fdt$form_table_definition,
      p_form_table_definitions: ^array [1 .. * ] of fdt$form_table_definition,
      p_form_table_statuses: ^array [1 .. * ] of fdt$table_status,
      p_form_variable_definition: ^fdt$form_variable_definition,
      p_old_screen_variable: ^fdt$text,
      p_program_record: ^array [1 .. * ] of cell,
      p_screen_variable: ^fdt$text,
      p_table_object: ^fdt$table_object,
      p_table_objects: ^array [1 .. * ] of fdt$table_object,
      p_table_variable: ^fdt$table_variable,
      p_table_variables: ^array [1 .. * ] of fdt$table_variable,
      p_text: ^fdt$text,
      p_variable_record_definition: ^fdt$variable_record_definition,
      p_work_area: ^cell,
      program_data_type: fdt$program_data_type,
      program_record_position: fdt$record_position,
      record_index: fdt$variable_index,
      program_variable_length: fdt$program_variable_length,
      screen_change: fdt$screen_change,
      screen_variable_length: fdt$text_length,
      table_index: fdt$table_index,
      table_object_index: fdt$object_index,
      text_length: fdt$text_length,
      variable_index: fdt$variable_index;

    status.normal := TRUE;
    variable_status := fdc$no_error;
    p_form_record_definitions := p_form_status^.p_form_record_definitions;

    IF p_form_record_definitions = NIL THEN
      RETURN;
    IFEND;

    p_form_table_definitions := p_form_status^.p_form_table_definitions;
    p_form_table_statuses := p_form_status^.p_form_table_statuses;
    p_form_object_statuses := p_form_status^.p_form_object_statuses;
    p_program_record := p_form_status^.p_program_record;
    p_form_module := p_form_status^.p_form_module;
    p_form_object_definitions := p_form_status^.p_form_object_definitions;

  /initialize_record/
    FOR record_index := 1 TO UPPERBOUND (p_form_record_definitions^) DO
      p_variable_record_definition := ^p_form_record_definitions^ [record_index];
      CASE p_variable_record_definition^.key OF

{ Initialize table in record.

      = fdc$record_table =
        table_index := p_variable_record_definition^.table_index;
        p_form_table_definition := ^p_form_table_definitions^ [table_index];
        IF NOT p_form_table_definition^.valid THEN
          CYCLE /initialize_record/;
        IFEND;

        p_table_variables := fdp$ptr_table_variables (p_form_table_definition^.table_variables,
              p_form_module);

        /initialize_table_variables/
        FOR variable_index := 1 TO p_form_table_definition^.table_variables.active_number DO
          p_table_variable := ^p_table_variables^ [variable_index];
          p_form_variable_definition := ^p_form_status^.p_form_variable_definitions^
                [p_table_variable^.variable_index];
          program_variable_length := p_form_variable_definition^.program_variable_length;
          program_data_type := p_form_variable_definition^.program_data_type;
          screen_variable_length := p_form_variable_definition^.screen_variable_length;
          p_table_objects := fdp$ptr_table_objects (p_table_variable^.table_objects, p_form_module);

          /initialize_variable_objects/
          FOR table_object_index := 1 TO p_form_table_definition^.stored_occurrence DO
            p_table_object := ^p_table_objects^ [table_object_index];
            program_record_position := p_table_object^.program_record_position;

            IF p_table_object^.object_exists THEN
              object_index := p_table_object^.object_index;
              p_form_object_definition := ^p_form_object_definitions^ [object_index];
              CASE p_form_object_definition^.key OF

              = fdc$form_variable_text =
                p_text := fdp$ptr_text (p_form_object_definition^.text_variable_text, p_form_module);

              = fdc$form_variable_text_box =
                p_text := fdp$ptr_text (p_form_object_definition^.variable_box_text, p_form_module);

              = fdc$form_stored_variable =
                p_text := fdp$ptr_text (p_form_object_definition^.stored_variable_text, p_form_module);

              ELSE

{ Invalid object.

                osp$set_status_abnormal (fdc$format_display_identifier, fde$system_error, 'invalid object',
                      status);
                RETURN;
              CASEND;

            ELSE
              p_text := ^initial_value;
            IFEND;

            p_work_area := ^p_program_record^ [program_record_position];
            fdp$ptr_screen_variable (p_form_status^.p_screen_record,
                  p_table_object^.screen_record_position, screen_variable_length, p_screen_variable);

{ Save old value if a screen change needs to be recorded.

            IF (record_change AND (table_object_index <=
                  p_form_table_definition^.visible_occurrence)) THEN
              ALLOCATE p_old_screen_variable: [screen_variable_length];
              IF p_old_screen_variable = NIL THEN
                osp$set_status_abnormal (fdc$format_display_identifier, fde$no_space_available, '', status);
                RETURN;
              IFEND;
              p_old_screen_variable^ := p_screen_variable^;
            IFEND;

            p_screen_variable^ := p_text^;
            fdp$move_to_program_variable (p_form_status, p_form_variable_definition,
                   p_screen_variable, p_work_area, p_form_object_statuses^ [object_index].
                   variable_input_status, status);
            fdp$move_to_screen_variable (p_form_status, p_form_variable_definition,
                  p_work_area, p_screen_variable, variable_status, status);
            p_form_object_statuses^ [object_index].variable_output_status := variable_status;
            IF variable_status <> fdc$no_error THEN

{ The invalid data character must be substituted even if the field is not currently visible.  Subsequent
{ updates may cause the field to displayed before the error is corrected.

              display_invalid_data_character (p_form_status,
                    p_form_variable_definition^.screen_variable_length, ignore_record_screen_change,
                    p_screen_variable^);
            IFEND;

            IF NOT record_change THEN
              CYCLE /initialize_variable_objects/;
            IFEND;

            IF (table_object_index > p_form_table_definition^.visible_occurrence) THEN
              CYCLE /initialize_variable_objects/;
            IFEND;

            IF ((p_old_screen_variable^ <> p_screen_variable^) OR
                 (p_form_table_statuses^ [table_index].first_displayed_occurrence <> 1) OR
                 (p_form_object_statuses^ [object_index].character_position <> 1)) THEN
              screen_change.key := fdc$replace_variable;
              screen_change.variable_form_identifier := form_identifier;
              screen_change.variable_object_index := object_index;
              screen_change.p_text := p_screen_variable;
              fdp$record_screen_change (screen_change, status);
              IF NOT status.normal THEN
                FREE p_old_screen_variable;
                RETURN;
              IFEND;
            IFEND;

            FREE p_old_screen_variable;

            IF ((p_form_object_definition^.display_attribute <>
                 p_form_object_statuses^ [object_index].display_attribute_set) OR
                (p_form_table_statuses^ [table_index].first_displayed_occurrence <> 1)) THEN
               screen_change.key := fdc$set_attribute;
               screen_change.attribute_form_identifier := form_identifier;
               screen_change.attribute_object_index := object_index;
               screen_change.attribute := p_form_object_definition^.display_attribute;
              fdp$record_screen_change (screen_change, status);
              IF NOT status.normal THEN
                RETURN;
              IFEND;
            IFEND;
          FOREND /initialize_variable_objects/;
        FOREND /initialize_table_variables/;

{ Initialize variable that does not belong to a table.

      = fdc$record_variable =
        p_form_variable_definition := ^p_form_status^.p_form_variable_definitions^ [
              p_variable_record_definition^.variable_index];
        IF NOT p_form_variable_definition^.object_exists THEN
          CYCLE /initialize_record/;
        IFEND;

        object_index := p_form_variable_definition^.object_index;
        p_form_object_definition := ^p_form_object_definitions^ [object_index];
        CASE p_form_object_definition^.key OF

        = fdc$form_variable_text =
          p_text := fdp$ptr_text (p_form_object_definition^.text_variable_text, p_form_module);

        = fdc$form_variable_text_box =
          p_text := fdp$ptr_text (p_form_object_definition^.variable_box_text, p_form_module);

        ELSE

{ Invalid object.

          osp$set_status_abnormal (fdc$format_display_identifier, fde$system_error, 'invalid object', status);
          RETURN;
        CASEND;

        program_variable_length := p_form_variable_definition^.program_variable_length;
        screen_variable_length := p_form_variable_definition^.screen_variable_length;
        program_record_position := p_form_variable_definition^.program_record_position;
        program_data_type := p_form_variable_definition^.program_data_type;
        p_work_area := ^p_program_record^ [program_record_position];
        fdp$ptr_screen_variable (p_form_status^.p_screen_record,
              p_form_variable_definition^.screen_record_position, screen_variable_length, p_screen_variable);

{ Save old value if a screen change needs to be recorded.

        IF record_change THEN
          ALLOCATE p_old_screen_variable: [screen_variable_length];
          IF p_old_screen_variable = NIL THEN
            osp$set_status_abnormal (fdc$format_display_identifier, fde$no_space_available, '', status);
            RETURN;
          IFEND;
          p_old_screen_variable^ := p_screen_variable^;
        IFEND;

        p_screen_variable^ := p_text^;
        fdp$move_to_program_variable (p_form_status, p_form_variable_definition,
                   p_screen_variable, p_work_area, p_form_object_statuses^ [object_index].
                   variable_input_status, status);
        fdp$move_to_screen_variable (p_form_status, p_form_variable_definition,
                  p_work_area, p_screen_variable, variable_status, status);
        p_form_object_statuses^ [object_index].variable_output_status := variable_status;
        IF variable_status <> fdc$no_error THEN

{ The invalid data character must be substituted even if the field is not currently visible.  Subsequent
{ updates may cause the field to displayed before the error is corrected.

          display_invalid_data_character (p_form_status, p_form_variable_definition^.screen_variable_length,
                ignore_record_screen_change, p_screen_variable^);
        IFEND;

        IF NOT record_change THEN
          CYCLE /initialize_record/;
        IFEND;

        IF ((p_old_screen_variable^ <> p_screen_variable^) OR
            (p_form_object_statuses^ [object_index].character_position <> 1)) THEN
          screen_change.key := fdc$replace_variable;
          screen_change.variable_form_identifier := form_identifier;
          screen_change.variable_object_index := object_index;
          screen_change.p_text := p_screen_variable;
          fdp$record_screen_change (screen_change, status);
          IF NOT status.normal THEN
            FREE p_old_screen_variable;
            RETURN;
          IFEND;
        IFEND;

        FREE p_old_screen_variable;

        IF ((p_form_object_definition^.display_attribute <>
             p_form_object_statuses^ [object_index].display_attribute_set)) THEN
          screen_change.key := fdc$set_attribute;
          screen_change.attribute_form_identifier := form_identifier;
          screen_change.attribute_object_index := object_index;
          screen_change.attribute := p_form_object_definition^.display_attribute;
          fdp$record_screen_change (screen_change, status);
          IF NOT status.normal THEN
            RETURN;
          IFEND;
        IFEND;

      ELSE

{ Invalid record definition key.

        osp$set_status_abnormal (fdc$format_display_identifier, fde$system_error, 'invalid record definition',
              status);
        RETURN;
      CASEND;
    FOREND /initialize_record/;

{ Set tables to display first occurrence.

    FOR object_index := 1 TO p_form_status^.p_form_definition^.form_table_definitions.active_number DO
      p_form_table_statuses^ [object_index].first_displayed_occurrence := 1;
      p_form_table_statuses^ [object_index].last_active_occurrence :=
            p_form_table_definitions^ [object_index].stored_occurrence;
    FOREND;
  PROCEND fdp$initialize_form_record;

?? OLDTITLE ??
?? NEWTITLE := 'fdp$move_to_program_variable', EJECT ??
*copyc fdh$move_to_program_variable

  PROCEDURE [XDCL] fdp$move_to_program_variable
    (    p_form_status: ^fdt$form_status;
         p_form_variable_definition: ^fdt$form_variable_definition;
         p_screen_variable: ^fdt$text;
         p_program_variable:{output} ^cell;
     VAR variable_status: fdt$variable_status;
     VAR status: ost$status);

    VAR
      cobol_description: fdt$cobol_description,
      cobol_status: ost$status,
      ignore_status: ost$status,
      p_added_variable_definition: ^fdt$added_variable_definition,
      p_program_variable_array: ^array [1 .. *] of cell,
      p_text: ^fdt$text,
      p_text_sequence: ^SEQ ( * );

    CASE p_form_variable_definition^.program_data_type OF

    = fdc$program_cobol_type =
      fdp$locate_added_variable_facts (p_form_status^.p_form_module,
            p_form_variable_definition, p_added_variable_definition);

{ Convert array of cells to string.

      i#build_adaptable_array_ptr (#RING (p_program_variable), #SEGMENT (p_program_variable),
            #OFFSET (p_program_variable), p_form_variable_definition^.program_variable_length,
            1, 1, #LOC (p_program_variable_array));
      p_text_sequence := #SEQ (p_program_variable_array^);
      RESET p_text_sequence;
      NEXT p_text: [p_form_variable_definition^.program_variable_length] IN p_text_sequence;

      IF p_form_variable_definition^.input_format.key = fdc$currency_input_format THEN
          fdp$change_currency_symbols (p_form_variable_definition^.input_format.
                input_currency_format.currency_sybmol,
                p_form_variable_definition^.input_format.
                input_currency_format.currency_sybmol, p_form_variable_definition^.input_format.
                input_currency_format.thousands_separator,
                p_form_variable_definition^.input_format.input_currency_format.decimal_point);
        ELSE
          fdp$change_currency_symbols (fdc$dollar_currency_symbol, fdc$pound_currency_symbol,
                fdc$thousands_currency_symbol, fdc$decimal_currency_symbol);
        IFEND;

      IF p_added_variable_definition^.program_cobol_description.cobol_usage <>
            fdc$cobol_usage_display  THEN

{ Allow terminal user to enter numeric data in a number of convenient ways through the free form.

        fdp$create_cobol_description ('', fdc$free_form_usage, cobol_description, ignore_status);
        CASE p_added_variable_definition^.display_cobol_description.cr_means OF
          = fdc$cobol_positive, fdc$cobol_negative =
          cobol_description.cr_means :=
                p_added_variable_definition^.display_cobol_description.cr_means;
          cobol_description.db_means :=
                p_added_variable_definition^.display_cobol_description.db_means;
        ELSE { CR/DB not valid input. }
        CASEND;

        fdp$move_cobol_data (cobol_description, p_screen_variable,
              p_added_variable_definition^.program_cobol_description, p_text, cobol_status);
      ELSE { COBOL usage is display.
        CASE p_added_variable_definition^.program_cobol_description.cobol_category OF

        = fdc$cobol_numeric_unsigned, fdc$cobol_numeric_signed, fdc$cobol_numeric_edited =
          fdp$create_cobol_description ('', fdc$free_form_usage, cobol_description, ignore_status);
          CASE p_added_variable_definition^.display_cobol_description.cr_means OF
            = fdc$cobol_positive, fdc$cobol_negative =
            cobol_description.cr_means :=
                  p_added_variable_definition^.display_cobol_description.cr_means;
            cobol_description.db_means :=
                  p_added_variable_definition^.display_cobol_description.db_means;
          ELSE { CR/DB not valid input. }
          CASEND;

          fdp$move_cobol_data (cobol_description, p_screen_variable,
                p_added_variable_definition^.program_cobol_description, p_text, cobol_status);
        ELSE
          fdp$move_cobol_data (p_added_variable_definition^.display_cobol_description, p_screen_variable,
                p_added_variable_definition^.program_cobol_description, p_text, cobol_status);
        CASEND;
      IFEND;

      IF cobol_status.normal THEN
        variable_status := fdc$no_error;
       ELSE
         convert_to_variable_status (cobol_status, variable_status, status);
      IFEND;

    ELSE { A non COBOL data type.
      fdp$convert_to_program_variable (p_form_variable_definition^.program_data_type,  p_program_variable,
            p_form_variable_definition^.program_variable_length, p_form_variable_definition^.input_format,
            p_screen_variable, STRLENGTH (p_screen_variable^), variable_status, status);
    CASEND;

  PROCEND fdp$move_to_program_variable;

?? OLDTITLE ??
?? NEWTITLE := 'fdp$move_to_screen_variable', EJECT ??
*copyc fdh$move_to_screen_variable

  PROCEDURE [XDCL] fdp$move_to_screen_variable
    (    p_form_status: ^fdt$form_status;
         p_form_variable_definition: ^fdt$form_variable_definition;
         p_program_variable: ^cell;
         p_screen_variable:{output} ^fdt$text;
     VAR variable_status: fdt$variable_status;
     VAR status: ost$status);

     VAR
      cobol_status: ost$status,
      p_added_variable_definition: ^fdt$added_variable_definition,
      p_program_variable_array: ^array [1 .. *] of cell,
      p_text: ^fdt$text,
      p_text_sequence: ^SEQ ( * );

     CASE p_form_variable_definition^.program_data_type OF

    = fdc$program_cobol_type =
      fdp$locate_added_variable_facts (p_form_status^.p_form_module,
            p_form_variable_definition, p_added_variable_definition);

{ Convert array of cells to string for fdp$move_cobol_data.

      i#build_adaptable_array_ptr (#RING (p_program_variable), #SEGMENT (p_program_variable),
            #OFFSET (p_program_variable), p_form_variable_definition^.program_variable_length,
            1, 1, #LOC (p_program_variable_array));
      p_text_sequence := #SEQ (p_program_variable_array^);
      RESET p_text_sequence;
      NEXT p_text: [p_form_variable_definition^.program_variable_length] IN p_text_sequence;

      IF p_form_variable_definition^.output_format.key = fdc$currency_output_format THEN
          fdp$change_currency_symbols (p_form_variable_definition^.output_format.
                output_currency_format.currency_sybmol,
                p_form_variable_definition^.output_format.
                output_currency_format.currency_sybmol, p_form_variable_definition^.output_format.
                output_currency_format.thousands_separator,
                p_form_variable_definition^.output_format.output_currency_format.decimal_point);
        ELSE
          fdp$change_currency_symbols (fdc$dollar_currency_symbol, fdc$pound_currency_symbol,
                fdc$thousands_currency_symbol, fdc$decimal_currency_symbol);
        IFEND;

      fdp$move_cobol_data (p_added_variable_definition^.program_cobol_description,
            p_text, p_added_variable_definition^.display_cobol_description,
            p_screen_variable, cobol_status);
      IF cobol_status.normal THEN
        variable_status := fdc$no_error;
       ELSE
         convert_to_variable_status (cobol_status, variable_status, status);
      IFEND;

    ELSE { Non COBOL data type.
      fdp$convert_to_screen_variable (p_form_variable_definition^.program_data_type, p_program_variable,
            p_form_variable_definition^.program_variable_length, p_form_variable_definition^.output_format,
            p_screen_variable, STRLENGTH (p_screen_variable^), variable_status, status);
    CASEND;

  PROCEND fdp$move_to_screen_variable;

?? TITLE := 'fdp$pop_forms', EJECT ??
*copyc fdh$pop_forms

  PROCEDURE [XDCL] fdp$pop_forms
    (VAR status: ost$status);

    VAR
      form_identifier: fdt$form_identifier,
      local_status: ost$status,
      p_form_status: ^fdt$form_status,
      screen_change: fdt$screen_change;

?? NEWTITLE := 'condition_handler', EJECT ??

    PROCEDURE condition_handler
      (    condition: pmt$condition;
           condition_information: ^pmt$condition_information;
           stack_frame_save_area: ^ost$stack_frame_save_area;
       VAR handler_status: ost$status);

      CASE condition.selector OF

      = pmc$system_conditions =
        IF (condition.system_conditions * $pmt$system_conditions
              [pmc$instruction_specification, pmc$address_specification, pmc$access_violation,
              pmc$invalid_segment_ring_0, pmc$divide_fault, pmc$arithmetic_overflow, pmc$exponent_overflow,
              pmc$exponent_underflow, pmc$fp_significance_loss, pmc$fp_indefinite,
              pmc$arithmetic_significance, pmc$invalid_bdp_data]) <> $pmt$system_conditions [] THEN
          osp$set_status_abnormal (fdc$format_display_identifier, fde$bad_data_value, '', status);
          EXIT fdp$pop_forms;
        IFEND;

      = pmc$user_defined_condition =
        IF condition.user_condition_name = cye$run_time_condition THEN
          osp$set_status_abnormal (fdc$format_display_identifier, fde$bad_data_value, '', status);
          EXIT fdp$pop_forms;
        IFEND;

      ELSE
        ;
      CASEND;
      pmp$continue_to_cause (pmc$execute_standard_procedure, handler_status);
    PROCEND condition_handler;

?? OLDTITLE, EJECT ??
    osp$establish_condition_handler (^condition_handler, FALSE);
    status.normal := TRUE;
    IF fdv$screen_status.current_push_count <> 0 THEN
      FOR form_identifier := LOWERBOUND (fdv$screen_status.p_forms_status^)
            TO UPPERBOUND (fdv$screen_status.p_forms_status^) DO
        p_form_status := ^fdv$screen_status.p_forms_status^ [form_identifier];
        IF p_form_status^.entry_used THEN
          IF p_form_status^.opened THEN
            IF p_form_status^.added OR p_form_status^.combined THEN
              IF p_form_status^.push_count = fdv$screen_status.current_push_count THEN

{ Make previous set of pushed forms active.

                p_form_status^.push_count := 0;
                p_form_status^.events_active := TRUE;

              ELSE

{ Delete currently scheduled forms.

                IF p_form_status^.push_count = 0 THEN
                  fdp$delete_form (form_identifier, local_status);
                  IF NOT local_status.normal THEN
                    IF status.normal THEN
                      status := local_status;
                    IFEND;
                  IFEND;
                IFEND;
              IFEND;
            IFEND;
          IFEND;
        IFEND;
      FOREND;

      fdv$screen_status.current_push_count := fdv$screen_status.current_push_count - 1;
      fdv$screen_status.last_cursor_position_valid := FALSE;

    ELSE

{ No forms are currently pushed.

      osp$set_status_abnormal (fdc$format_display_identifier, fde$no_forms_to_pop, '', status);
    IFEND;
  PROCEND fdp$pop_forms;

?? TITLE := 'fdp$position_form', EJECT ??
*copyc fdh$position_form

  PROCEDURE [XDCL] fdp$position_form
    (    form_identifier: fdt$form_identifier;
         screen_x_position: fdt$x_position;
         screen_y_position: fdt$y_position;
     VAR status: ost$status);

    VAR
      added_form_identifier: fdt$form_identifier,
      combined: BOOLEAN,
      p_form_definition: ^fdt$form_definition,
      p_form_status: ^fdt$form_status,
      screen_change: fdt$screen_change;

?? NEWTITLE := 'condition_handler', EJECT ??

    PROCEDURE condition_handler
      (    condition: pmt$condition;
           condition_information: ^pmt$condition_information;
           stack_frame_save_area: ^ost$stack_frame_save_area;
       VAR handler_status: ost$status);

      CASE condition.selector OF

      = pmc$system_conditions =
        IF (condition.system_conditions * $pmt$system_conditions
              [pmc$instruction_specification, pmc$address_specification, pmc$access_violation,
              pmc$invalid_segment_ring_0, pmc$divide_fault, pmc$arithmetic_overflow, pmc$exponent_overflow,
              pmc$exponent_underflow, pmc$fp_significance_loss, pmc$fp_indefinite,
              pmc$arithmetic_significance, pmc$invalid_bdp_data]) <> $pmt$system_conditions [] THEN
          osp$set_status_abnormal (fdc$format_display_identifier, fde$bad_data_value, '', status);
          EXIT fdp$position_form;
        IFEND;

      = pmc$user_defined_condition =
        IF condition.user_condition_name = cye$run_time_condition THEN
          osp$set_status_abnormal (fdc$format_display_identifier, fde$bad_data_value, '', status);
          EXIT fdp$position_form;
        IFEND;

      ELSE
        ;
      CASEND;
      pmp$continue_to_cause (pmc$execute_standard_procedure, handler_status);
    PROCEND condition_handler;

?? OLDTITLE, EJECT ??
    osp$establish_condition_handler (^condition_handler, FALSE);
    fdp$find_form_status (form_identifier, p_form_status, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    IF p_form_status^.push_count <> 0 THEN
      osp$set_status_abnormal (fdc$format_display_identifier, fde$form_pushed,
            p_form_status^.p_form_definition^.form_name, status);
      RETURN;
    IFEND;

    IF ((p_form_status^.form_x_position = screen_x_position) AND
          (p_form_status^.form_y_position = screen_y_position)) THEN
      RETURN;
    IFEND;

{ Form must fit on terminal screen at new position.

    p_form_definition := p_form_status^.p_form_definition;
    check_form_screen_fit (screen_x_position, screen_y_position, p_form_definition^.width,
          p_form_definition^.height, p_form_definition^.form_name, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    fdv$screen_status.compute_new_screen_size := TRUE;
    IF NOT p_form_status^.displayed_on_screen THEN

{ Plot the initial display of the form at the specified position.
{ The priority of the form is not affected since the form is not displayed on the screen.

      p_form_status^.form_x_position := screen_x_position;
      p_form_status^.form_y_position := screen_y_position;
      RETURN;
    IFEND;

    combined := p_form_status^.combined;
    IF combined THEN
      added_form_identifier := p_form_status^.added_form_identifier;
    IFEND;

{ The form is currently displayed. Delete the form from the screen at the current position
{ and then add/combine the form  at new position. The form will now have the highest priority.

      fdp$delete_form (form_identifier, status);
      IF NOT status.normal THEN
        RETURN;
      IFEND;

      p_form_status^.form_x_position := screen_x_position;
      p_form_status^.form_y_position := screen_y_position;

      IF combined THEN
        fdp$combine_form (added_form_identifier, form_identifier, status);
      ELSE
        fdp$add_form (form_identifier, status);
      IFEND;
  PROCEND fdp$position_form;

?? TITLE := 'fdp$push_forms', EJECT ??
*copyc fdh$push_forms

  PROCEDURE [XDCL] fdp$push_forms
    (VAR status: ost$status);

    VAR
      form_pushed: boolean,
      form_identifier: fdt$form_identifier,
      p_form_status: ^fdt$form_status,
      screen_change: fdt$screen_change;

?? NEWTITLE := 'condition_handler', EJECT ??

    PROCEDURE condition_handler
      (    condition: pmt$condition;
           condition_information: ^pmt$condition_information;
           stack_frame_save_area: ^ost$stack_frame_save_area;
       VAR handler_status: ost$status);

      CASE condition.selector OF

      = pmc$system_conditions =
        IF (condition.system_conditions * $pmt$system_conditions
              [pmc$instruction_specification, pmc$address_specification, pmc$access_violation,
              pmc$invalid_segment_ring_0, pmc$divide_fault, pmc$arithmetic_overflow, pmc$exponent_overflow,
              pmc$exponent_underflow, pmc$fp_significance_loss, pmc$fp_indefinite,
              pmc$arithmetic_significance, pmc$invalid_bdp_data]) <> $pmt$system_conditions [] THEN
          osp$set_status_abnormal (fdc$format_display_identifier, fde$bad_data_value, '', status);
          EXIT fdp$push_forms;
        IFEND;

      = pmc$user_defined_condition =
        IF condition.user_condition_name = cye$run_time_condition THEN
          osp$set_status_abnormal (fdc$format_display_identifier, fde$bad_data_value, '', status);
          EXIT fdp$push_forms;
        IFEND;

      ELSE
        ;
      CASEND;
      pmp$continue_to_cause (pmc$execute_standard_procedure, handler_status);
    PROCEND condition_handler;

?? OLDTITLE, EJECT ??
    osp$establish_condition_handler (^condition_handler, FALSE);
    status.normal := TRUE;
    form_pushed := FALSE;
    IF fdv$screen_status.p_forms_status = NIL THEN
      osp$set_status_abnormal (fdc$format_display_identifier, fde$no_forms_to_push, '', status);
      RETURN;
    IFEND;
    fdv$screen_status.current_push_count := fdv$screen_status.current_push_count + 1;
    FOR form_identifier := LOWERBOUND (fdv$screen_status.p_forms_status^)
          TO UPPERBOUND (fdv$screen_status.p_forms_status^) DO
      p_form_status := ^fdv$screen_status.p_forms_status^ [form_identifier];
      IF p_form_status^.entry_used THEN
        IF p_form_status^.opened THEN
          IF p_form_status^.added OR p_form_status^.combined THEN
            IF p_form_status^.push_count = 0 THEN
              form_pushed := TRUE;
              p_form_status^.push_count := fdv$screen_status.current_push_count;
              p_form_status^.events_active := FALSE;
            IFEND;
          IFEND;
        IFEND;
      IFEND;
    FOREND;

    IF NOT form_pushed THEN
      osp$set_status_abnormal (fdc$format_display_identifier, fde$no_forms_to_push, '', status);
      fdv$screen_status.current_push_count := fdv$screen_status.current_push_count - 1;
    IFEND;

  PROCEND fdp$push_forms;

?? TITLE := 'fdp$record_screen_change', EJECT ??
*copyc fdh$record_screen_change

  PROCEDURE [XDCL] fdp$record_screen_change
    (    screen_change: fdt$screen_change;
     VAR status: ost$status);

    VAR
      n: fdt$screen_change_index,
      p_new_screen_changes: ^fdt$screen_changes;

    status.normal := TRUE;

{ Try to use an existing free entry to record screen change.

    IF fdv$screen_status.number_screen_changes < UPPERBOUND (fdv$screen_status.p_screen_changes^) THEN
      fdv$screen_status.number_screen_changes := fdv$screen_status.number_screen_changes + 1;
      fdv$screen_status.p_screen_changes^ [fdv$screen_status.number_screen_changes] := screen_change;
      RETURN;
    IFEND;

{ Enlarge the array to hold screen changes.

    ALLOCATE p_new_screen_changes: [1 .. fdc$screen_changes_to_expand +
          fdv$screen_status.number_screen_changes];
    IF p_new_screen_changes <> NIL THEN

{ Copy current screen changes to new array.

      FOR n := 1 TO fdv$screen_status.number_screen_changes DO
        p_new_screen_changes^ [n] := fdv$screen_status.p_screen_changes^ [n];
      FOREND;
      FREE fdv$screen_status.p_screen_changes;

{ Add new screen change.

      fdv$screen_status.p_screen_changes := p_new_screen_changes;
      fdv$screen_status.number_screen_changes := fdv$screen_status.number_screen_changes + 1;
      fdv$screen_status.p_screen_changes^ [fdv$screen_status.number_screen_changes] := screen_change;

    ELSE { No space for screen changes. }
      osp$set_status_abnormal (fdc$format_display_identifier, fde$no_space_available, '', status);
    IFEND;

  PROCEND fdp$record_screen_change;

?? TITLE := 'fdp$replace_integer_variable', EJECT ??
*copyc fdh$replace_integer_variable

  PROCEDURE [XDCL] fdp$replace_integer_variable
    (    form_identifier: fdt$form_identifier;
         name: ost$name;
         occurrence: fdt$occurrence;
         variable: integer;
     VAR variable_status: fdt$variable_status;
     VAR status: ost$status);

    VAR
      error: mlt$error,
      compare: mlt$compare,
      new_value: fdt$variable_value,
      number_equal_bytes: mlt$string_length,
      object_exists: boolean,
      object_index: fdt$object_index,
      p_form_definition: ^fdt$form_definition,
      p_form_object_status: ^fdt$form_object_status,
      p_form_status: ^fdt$form_status,
      p_form_variable_definition: ^fdt$form_variable_definition,
      p_screen_variable: ^fdt$text,
      program_record_position: fdt$record_position,
      screen_change: fdt$screen_change,
      screen_record_position: fdt$record_position,
      screen_variable_length: fdt$text_length,
      valid: boolean,
      valid_name: ost$name;

?? NEWTITLE := 'condition_handler', EJECT ??

    PROCEDURE condition_handler
      (    condition: pmt$condition;
           condition_information: ^pmt$condition_information;
           stack_frame_save_area: ^ost$stack_frame_save_area;
       VAR handler_status: ost$status);

      CASE condition.selector OF

      = pmc$system_conditions =
        IF (condition.system_conditions * $pmt$system_conditions
              [pmc$instruction_specification, pmc$address_specification, pmc$access_violation,
              pmc$invalid_segment_ring_0, pmc$divide_fault, pmc$arithmetic_overflow, pmc$exponent_overflow,
              pmc$exponent_underflow, pmc$fp_significance_loss, pmc$fp_indefinite,
              pmc$arithmetic_significance, pmc$invalid_bdp_data]) <> $pmt$system_conditions [] THEN
          osp$set_status_abnormal (fdc$format_display_identifier, fde$bad_data_value, '', status);
          EXIT fdp$replace_integer_variable;
        IFEND;

      = pmc$user_defined_condition =
        IF condition.user_condition_name = cye$run_time_condition THEN
          osp$set_status_abnormal (fdc$format_display_identifier, fde$bad_data_value, '', status);
          EXIT fdp$replace_integer_variable;
        IFEND;

      ELSE
        ;
      CASEND;
      pmp$continue_to_cause (pmc$execute_standard_procedure, handler_status);
    PROCEND condition_handler;

?? OLDTITLE, EJECT ??
    osp$establish_condition_handler (^condition_handler, FALSE);
    variable_status := fdc$no_error;
    fdp$find_form_status (form_identifier, p_form_status, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    IF p_form_status^.push_count <> 0 THEN
      osp$set_status_abnormal (fdc$format_display_identifier, fde$form_pushed,
            p_form_status^.p_form_definition^.form_name, status);
      RETURN;
    IFEND;

    #translate (osv$lower_to_upper, name, valid_name);
    find_record_variable (p_form_status, valid_name, occurrence, p_form_variable_definition, object_exists,
          object_index, program_record_position, screen_record_position, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    IF NOT (p_form_variable_definition^.program_data_type = fdc$program_integer_type) THEN
      osp$set_status_abnormal (fdc$format_display_identifier, fde$wrong_variable_type, 'INTEGER', status);
      RETURN;
    IFEND;

    p_form_object_status := ^p_form_status^.p_form_object_statuses^ [object_index];

{ Check to see if the new value is the same as the existing value.  Skip this check if the existing value has
{ output errors because the value on the screen may be different.

    IF ((p_form_object_status^.variable_output_status = fdc$no_error) AND
            (p_form_object_status^.variable_input_status = fdc$no_error)) THEN
      mlp$compare_bytes (^p_form_status^.p_program_record^ [program_record_position], fdc$integer_length,
            ^variable, fdc$integer_length, compare, number_equal_bytes, error);
      IF (compare = mlc$equal) THEN
        RETURN;
      IFEND;
    IFEND;

{ Input status is now obsolete.

    p_form_object_status^.variable_input_status := fdc$no_error;
    new_value.program_data_type := fdc$program_integer_type;
    new_value.integer_value := variable;
    replace_variable (p_form_status, form_identifier, new_value, p_form_variable_definition, object_index,
          object_exists, program_record_position, screen_record_position,
          p_form_object_status^.variable_output_status, status);
    IF NOT p_form_status^.invalid_data_character.defined THEN

{ Return the variable status to the caller if the Invalid Data Character is not defined.

      variable_status := p_form_object_status^.variable_output_status;
    IFEND;

    IF variable_status <> fdc$no_error THEN
      p_form_status^.output_error_search.status := fdc$not_searched;
    IFEND;

  PROCEND fdp$replace_integer_variable;

?? TITLE := 'fdp$replace_real_variable', EJECT ??
*copyc fdh$replace_real_variable

  PROCEDURE [XDCL] fdp$replace_real_variable
    (    form_identifier: fdt$form_identifier;
         name: ost$name;
         occurrence: fdt$occurrence;
         variable: real;
     VAR variable_status: fdt$variable_status;
     VAR status: ost$status);

    VAR
      compare: mlt$compare,
      error: mlt$error,
      new_value: fdt$variable_value,
      number_equal_bytes: mlt$string_length,
      object_exists: boolean,
      object_index: fdt$object_index,
      p_form_object_status: ^fdt$form_object_status,
      p_form_variable_definition: ^fdt$form_variable_definition,
      p_form_status: ^fdt$form_status,
      p_screen_variable: ^fdt$text,
      program_record_position: fdt$record_position,
      program_variable_length: fdt$program_variable_length,
      screen_change: fdt$screen_change,
      screen_record_position: fdt$record_position,
      screen_variable_length: fdt$text_length,
      valid_name: ost$name;

?? NEWTITLE := 'condition_handler', EJECT ??

    PROCEDURE condition_handler
      (    condition: pmt$condition;
           condition_information: ^pmt$condition_information;
           stack_frame_save_area: ^ost$stack_frame_save_area;
       VAR handler_status: ost$status);

      CASE condition.selector OF

      = pmc$system_conditions =
        IF (condition.system_conditions * $pmt$system_conditions
              [pmc$instruction_specification, pmc$address_specification, pmc$access_violation,
              pmc$invalid_segment_ring_0, pmc$divide_fault, pmc$arithmetic_overflow, pmc$exponent_overflow,
              pmc$exponent_underflow, pmc$fp_significance_loss, pmc$fp_indefinite,
              pmc$arithmetic_significance, pmc$invalid_bdp_data]) <> $pmt$system_conditions [] THEN
          osp$set_status_abnormal (fdc$format_display_identifier, fde$bad_data_value, '', status);
          EXIT fdp$replace_real_variable;
        IFEND;

      = pmc$user_defined_condition =
        IF condition.user_condition_name = cye$run_time_condition THEN
          osp$set_status_abnormal (fdc$format_display_identifier, fde$bad_data_value, '', status);
          EXIT fdp$replace_real_variable;
        IFEND;

      ELSE
        ;
      CASEND;
      pmp$continue_to_cause (pmc$execute_standard_procedure, handler_status);
    PROCEND condition_handler;

?? OLDTITLE, EJECT ??
    osp$establish_condition_handler (^condition_handler, FALSE);
    variable_status := fdc$no_error;
    fdp$find_form_status (form_identifier, p_form_status, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    IF p_form_status^.push_count <> 0 THEN
      osp$set_status_abnormal (fdc$format_display_identifier, fde$form_pushed,
            p_form_status^.p_form_definition^.form_name, status);
      RETURN;
    IFEND;

    #translate (osv$lower_to_upper, name, valid_name);
    find_record_variable (p_form_status, valid_name, occurrence, p_form_variable_definition,
          object_exists, object_index, program_record_position, screen_record_position, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    IF NOT (p_form_variable_definition^.program_data_type = fdc$program_real_type) THEN
      osp$set_status_abnormal (fdc$format_display_identifier, fde$wrong_variable_type, 'REAL', status);
      RETURN;
    IFEND;

    p_form_object_status := ^p_form_status^.p_form_object_statuses^ [object_index];

{ Check to see if the new value is the same as the existing value.  Skip this check if the existing value has
{ output errors because the value on the screen may be different.

    IF ((p_form_object_status^.variable_output_status = fdc$no_error) AND
            (p_form_object_status^.variable_input_status = fdc$no_error)) THEN
      mlp$compare_bytes (^p_form_status^.p_program_record^ [program_record_position], fdc$real_length,
            ^variable, fdc$real_length, compare, number_equal_bytes, error);
      IF (compare = mlc$equal) THEN
        RETURN;
      IFEND;
    IFEND;

{ Input status is now obsolete.

    p_form_object_status^.variable_input_status := fdc$no_error;
    new_value.program_data_type := fdc$program_real_type;
    new_value.real_value := variable;
    replace_variable (p_form_status, form_identifier, new_value, p_form_variable_definition, object_index,
          object_exists, program_record_position, screen_record_position,
          p_form_object_status^.variable_output_status, status);
    IF NOT p_form_status^.invalid_data_character.defined THEN

{ Return the variable status to the caller if the Invalid Data Character is not defined.

      variable_status := p_form_object_status^.variable_output_status;
    IFEND;

    IF variable_status <> fdc$no_error THEN
      p_form_status^.output_error_search.status := fdc$not_searched;
    IFEND;

  PROCEND fdp$replace_real_variable;

?? TITLE := 'fdp$replace_record', EJECT ??
*copyc fdh$replace_record

  PROCEDURE [XDCL] fdp$replace_record
    (    form_identifier: fdt$form_identifier;
         p_work_area: ^cell;
         work_area_length: fdt$work_area_length;
     VAR variable_status: fdt$variable_status;
     VAR status: ost$status);

    VAR
      first_displayed_occurrence: fdt$occurrence,
      object_index: fdt$object_index,
      p_form_module: ^fdt$form_module,
      p_form_record_definitions: ^array [1 .. * ] of fdt$variable_record_definition,
      p_form_status: ^fdt$form_status,
      p_form_table_definition: ^fdt$form_table_definition,
      p_form_table_statuses: ^array [1 .. * ] of fdt$table_status,
      p_form_table_definitions: ^array [1 .. * ] of fdt$form_table_definition,
      p_form_variable_definition: ^fdt$form_variable_definition,
      p_program_record: ^array [1 .. * ] of cell,
      p_table_object: ^fdt$table_object,
      p_table_objects: ^array [1 .. * ] of fdt$table_object,
      p_table_variable: ^fdt$table_variable,
      p_table_variables: ^array [1 .. * ] of fdt$table_variable,
      p_variable_record_definition: ^fdt$variable_record_definition,
      program_variable_length: fdt$program_variable_length,
      record_index: fdt$variable_index,
      record_position: fdt$record_position,
      screen_change: fdt$screen_change,
      screen_record_position: fdt$record_position,
      screen_variable_length: fdt$text_length,
      table_index: fdt$table_index,
      table_object_index: fdt$object_index,
      update_screen: boolean,
      user_offset: integer,
      user_ring: integer,
      user_segment: integer,
      variable_index: fdt$variable_index;

?? NEWTITLE := 'condition_handler', EJECT ??

    PROCEDURE condition_handler
      (    condition: pmt$condition;
           condition_information: ^pmt$condition_information;
           stack_frame_save_area: ^ost$stack_frame_save_area;
       VAR handler_status: ost$status);

      CASE condition.selector OF

      = pmc$system_conditions =
        IF (condition.system_conditions * $pmt$system_conditions
              [pmc$instruction_specification, pmc$address_specification, pmc$access_violation,
              pmc$invalid_segment_ring_0, pmc$divide_fault, pmc$arithmetic_overflow, pmc$exponent_overflow,
              pmc$exponent_underflow, pmc$fp_significance_loss, pmc$fp_indefinite,
              pmc$arithmetic_significance, pmc$invalid_bdp_data]) <> $pmt$system_conditions [] THEN
          osp$set_status_abnormal (fdc$format_display_identifier, fde$bad_data_value, '', status);
          EXIT fdp$replace_record;
        IFEND;

      = pmc$user_defined_condition =
        IF condition.user_condition_name = cye$run_time_condition THEN
          osp$set_status_abnormal (fdc$format_display_identifier, fde$bad_data_value, '', status);
          EXIT fdp$replace_record;
        IFEND;

      ELSE
        ;
      CASEND;
      pmp$continue_to_cause (pmc$execute_standard_procedure, handler_status);
    PROCEND condition_handler;

?? OLDTITLE, EJECT ??
?? NEWTITLE := 'process_variable', EJECT ??

{ PURPOSE:
{   Do the common processing for all variable data types.
{

    PROCEDURE process_variable;

      VAR
        compare: mlt$compare,
        error: mlt$error,
        new_value: fdt$variable_value,
        number_equal_bytes: mlt$string_length,
        p_form_object_status: ^fdt$form_object_status,
        p_program_variable: ^cell,
        p_program_variable_array: ^array [1 .. * ] of cell,
        p_text_sequence: ^SEQ ( * ),
        variable_offset: integer;


      p_form_object_status := ^p_form_status^.p_form_object_statuses^ [object_index];
      variable_offset := user_offset + record_position - 1;
      p_program_variable := #ADDRESS (user_ring, user_segment, variable_offset);

{ Check to see if the new value is the same as the existing value.  Skip this check if the existing value has
{ output errors because the value on the screen may be different.

      IF ((p_form_object_status^.variable_output_status = fdc$no_error) AND
            (p_form_object_status^.variable_input_status = fdc$no_error)) THEN
        mlp$compare_bytes (p_program_variable, program_variable_length, ^p_program_record^ [record_position],
              program_variable_length, compare, number_equal_bytes, error);
        IF (compare = mlc$equal) THEN
          RETURN;
        IFEND;
      IFEND;

{ Input status is now obsolete.

      p_form_object_status^.variable_input_status := fdc$no_error;
      p_program_variable := #ADDRESS (user_ring, user_segment, (user_offset + record_position - 1));
      new_value.program_data_type := p_form_variable_definition^.program_data_type;

      CASE p_form_variable_definition^.program_data_type OF
      = fdc$program_character_type, fdc$program_upper_case_type =
        i#build_adaptable_array_ptr (#RING (p_program_variable), #SEGMENT (p_program_variable),
              #OFFSET (p_program_variable), program_variable_length, 1, 1, #LOC (p_program_variable_array));
        p_text_sequence := #SEQ (p_program_variable_array^);
        RESET p_text_sequence;
        NEXT new_value.p_text: [program_variable_length] IN p_text_sequence;
        new_value.text_length := program_variable_length;

      = fdc$program_integer_type =
        i#move (p_program_variable, ^new_value.integer_value, program_variable_length);

      = fdc$program_real_type =
        i#move (p_program_variable, ^new_value.real_value, program_variable_length);

      ELSE { fdc$program_cobol_type
        new_value.cobol_data_length := program_variable_length;
        new_value.p_cobol_data := p_program_variable;
      CASEND;

      replace_variable (p_form_status, form_identifier, new_value, p_form_variable_definition, object_index,
            update_screen, record_position, screen_record_position,
            p_form_object_status^.variable_output_status, status);
      IF NOT status.normal THEN
        RETURN;
      IFEND;
      IF (variable_status = fdc$no_error) AND
            (p_form_object_status^.variable_output_status <> fdc$no_error) THEN
        p_form_status^.output_error_search.status := fdc$not_searched;
        IF NOT p_form_status^.invalid_data_character.defined THEN

{ Return the variable status to the caller if the Invalid Data Character is not defined.

          variable_status := p_form_object_status^.variable_output_status;
        IFEND;
      IFEND;

    PROCEND process_variable;

?? OLDTITLE, EJECT ??

    osp$establish_condition_handler (^condition_handler, FALSE);
    status.normal := TRUE;

    fdp$find_form_status (form_identifier, p_form_status, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    IF p_form_status^.push_count <> 0 THEN
      osp$set_status_abnormal (fdc$format_display_identifier, fde$form_pushed,
            p_form_status^.p_form_definition^.form_name, status);
      RETURN;
    IFEND;

    p_form_record_definitions := p_form_status^.p_form_record_definitions;
    IF p_form_record_definitions = NIL THEN
      osp$set_status_abnormal (fdc$format_display_identifier, fde$form_has_no_variables,
            p_form_status^.p_form_definition^.form_name, status);
      RETURN;
    IFEND;

{ The program record storage must map exactly to the record held by Screen Formatting.

    p_program_record := p_form_status^.p_program_record;
    IF work_area_length <> #SIZE (p_program_record^) THEN
      osp$set_status_abnormal (fdc$format_display_identifier, fde$work_area_invalid,
            p_form_status^.p_form_definition^.form_name, status);
      RETURN;
    IFEND;

    variable_status := fdc$no_error;
    p_form_module := p_form_status^.p_form_module;
    p_form_table_definitions := p_form_status^.p_form_table_definitions;
    user_ring := #RING (p_work_area);
    user_segment := #SEGMENT (p_work_area);
    user_offset := #OFFSET (p_work_area);
    screen_change.key := fdc$replace_variable;
    screen_change.variable_form_identifier := form_identifier;
    p_form_status^.input_error_search.status := fdc$search_not_allowed;
    p_form_status^.output_error_search.status := fdc$search_completed;

{ Process all variables in the form record definition.

    FOR record_index := 1 TO UPPERBOUND (p_form_record_definitions^) DO
      p_variable_record_definition := ^p_form_record_definitions^ [record_index];
      CASE p_variable_record_definition^.key OF

      = fdc$record_table =
        table_index := p_variable_record_definition^.table_index;
        p_form_table_statuses := p_form_status^.p_form_table_statuses;
        first_displayed_occurrence := p_form_table_statuses^ [table_index].first_displayed_occurrence;
        p_form_table_definition := ^p_form_table_definitions^ [table_index];
        p_table_variables := fdp$ptr_table_variables (p_form_table_definition^.table_variables,
              p_form_module);

      /process_variables_in_table/
        FOR variable_index := 1 TO p_form_table_definition^.table_variables.active_number DO
          p_table_variable := ^p_table_variables^ [variable_index];
          IF NOT p_table_variable^.variable_exists THEN
            CYCLE /process_variables_in_table/;
          IFEND;

          p_form_variable_definition := ^p_form_status^.p_form_variable_definitions^
                [p_table_variable^.variable_index];
          program_variable_length := p_form_variable_definition^.program_variable_length;
          screen_variable_length := p_form_variable_definition^.screen_variable_length;
          p_table_objects := fdp$ptr_table_objects (p_table_variable^.table_objects, p_form_module);

        /process_variable_occurrences/
          FOR table_object_index := 1 TO p_form_table_definition^.stored_occurrence DO
            p_table_object := ^p_table_objects^ [table_object_index];
            IF NOT p_table_object^.object_exists THEN
              CYCLE /process_variable_occurrences/;
            IFEND;

            object_index := p_table_object^.object_index;
            record_position := p_table_object^.program_record_position;
            screen_record_position := p_table_object^.screen_record_position;
            update_screen := p_form_status^.displayed_on_screen AND
                  (p_form_status^.added OR p_form_status^.combined) AND
                  ((first_displayed_occurrence + p_form_table_definition^.visible_occurrence - 1) >=
                  table_object_index) AND (first_displayed_occurrence <= table_object_index);
            process_variable;
            IF NOT status.normal THEN
              RETURN;
            IFEND;
          FOREND /process_variable_occurrences/;
        FOREND /process_variables_in_table/;

      = fdc$record_variable =

{ Process variable that is not a member of a table.

        p_form_variable_definition := ^p_form_status^.p_form_variable_definitions^ [
              p_variable_record_definition^.variable_index];
        record_position := p_form_variable_definition^.program_record_position;
        program_variable_length := p_form_variable_definition^.program_variable_length;
        screen_variable_length := p_form_variable_definition^.screen_variable_length;
        object_index := p_form_variable_definition^.object_index;
        update_screen := p_form_status^.displayed_on_screen AND
              (p_form_status^.added OR p_form_status^.combined);
        screen_record_position := p_form_variable_definition^.screen_record_position;
        process_variable;
        IF NOT status.normal THEN
          RETURN;
        IFEND;
      CASEND;
    FOREND;

  PROCEND fdp$replace_record;

?? TITLE := 'fdp$replace_string_variable', EJECT ??
*copyc fdh$replace_string_variable

  PROCEDURE [XDCL] fdp$replace_string_variable
    (    form_identifier: fdt$form_identifier;
         name: ost$name;
         occurrence: fdt$occurrence;
         variable: fdt$text;
     VAR variable_status: fdt$variable_status;
     VAR status: ost$status);

    VAR
      error: mlt$error,
      compare: mlt$compare,
      new_value: fdt$variable_value,
      number_equal_bytes: mlt$string_length,
      program_record_position: fdt$record_position,
      object_exists: boolean,
      object_index: fdt$object_index,
      p_form_object_status: ^fdt$form_object_status,
      p_form_variable_definition: ^fdt$form_variable_definition,
      p_form_status: ^fdt$form_status,
      p_text: ^fdt$text,
      program_variable_length: fdt$program_variable_length,
      screen_change: fdt$screen_change,
      screen_record_position: fdt$record_position,
      valid_name: ost$name;

?? NEWTITLE := 'condition_handler', EJECT ??

    PROCEDURE condition_handler
      (    condition: pmt$condition;
           condition_information: ^pmt$condition_information;
           stack_frame_save_area: ^ost$stack_frame_save_area;
       VAR handler_status: ost$status);

      CASE condition.selector OF

      = pmc$system_conditions =
        IF (condition.system_conditions * $pmt$system_conditions
              [pmc$instruction_specification, pmc$address_specification, pmc$access_violation,
              pmc$invalid_segment_ring_0, pmc$divide_fault, pmc$arithmetic_overflow, pmc$exponent_overflow,
              pmc$exponent_underflow, pmc$fp_significance_loss, pmc$fp_indefinite,
              pmc$arithmetic_significance, pmc$invalid_bdp_data]) <> $pmt$system_conditions [] THEN
          osp$set_status_abnormal (fdc$format_display_identifier, fde$bad_data_value, '', status);
          EXIT fdp$replace_string_variable;
        IFEND;

      = pmc$user_defined_condition =
        IF condition.user_condition_name = cye$run_time_condition THEN
          osp$set_status_abnormal (fdc$format_display_identifier, fde$bad_data_value, '', status);
          EXIT fdp$replace_string_variable;
        IFEND;

      ELSE
        ;
      CASEND;
      pmp$continue_to_cause (pmc$execute_standard_procedure, handler_status);
    PROCEND condition_handler;

?? OLDTITLE, EJECT ??
    osp$establish_condition_handler (^condition_handler, FALSE);
    variable_status := fdc$no_error;
    fdp$find_form_status (form_identifier, p_form_status, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    IF p_form_status^.push_count <> 0 THEN
      osp$set_status_abnormal (fdc$format_display_identifier, fde$form_pushed,
            p_form_status^.p_form_definition^.form_name, status);
      RETURN;
    IFEND;

    #TRANSLATE (osv$lower_to_upper, name, valid_name);
    find_record_variable (p_form_status, valid_name, occurrence, p_form_variable_definition, object_exists,
          object_index, program_record_position, screen_record_position, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    CASE p_form_variable_definition^.program_data_type OF
    = fdc$program_character_type, fdc$program_upper_case_type =
    ELSE
      osp$set_status_abnormal (fdc$format_display_identifier, fde$wrong_variable_type,
            'CHARACTER or UPPER_CASE', status);
      RETURN;
    CASEND;

    p_form_object_status := ^p_form_status^.p_form_object_statuses^ [object_index];

{ Check to see if the new value is the same as the existing value.  Skip this check if the existing value has
{ output errors because the value on the screen may be different.

    IF ((p_form_object_status^.variable_output_status = fdc$no_error) AND
            (p_form_object_status^.variable_input_status = fdc$no_error)) THEN
      mlp$compare_bytes (^p_form_status^.p_program_record^ [program_record_position],
            p_form_variable_definition^.program_variable_length, ^variable,
            STRLENGTH (variable), compare, number_equal_bytes, error);
      IF (compare = mlc$equal) THEN
        RETURN;
      IFEND;
    IFEND;

{ Input status is now obsolete.

    p_form_object_status^.variable_input_status := fdc$no_error;
    new_value.program_data_type := p_form_variable_definition^.program_data_type;
    new_value.p_text := ^variable;
    new_value.text_length := STRLENGTH (variable);
    replace_variable (p_form_status, form_identifier, new_value, p_form_variable_definition, object_index,
          object_exists, program_record_position, screen_record_position,
          p_form_object_status^.variable_output_status, status);
    IF NOT p_form_status^.invalid_data_character.defined THEN

{ Return the variable status to the caller if the Invalid Data Character is not defined.

      variable_status := p_form_object_status^.variable_output_status;
    IFEND;
    IF variable_status <> fdc$no_error THEN
      p_form_status^.output_error_search.status := fdc$not_searched;
    IFEND;

  PROCEND fdp$replace_string_variable;

?? TITLE := 'fdp$reset_form', EJECT ??
*copyc fdh$reset_form

  PROCEDURE [XDCL] fdp$reset_form
    (    form_identifier: fdt$form_identifier;
     VAR status: ost$status);

    VAR
      p_form_status: ^fdt$form_status,
      record_changes: boolean,
      variable_status: fdt$variable_status;

?? NEWTITLE := 'condition_handler', EJECT ??

    PROCEDURE condition_handler
      (    condition: pmt$condition;
           condition_information: ^pmt$condition_information;
           stack_frame_save_area: ^ost$stack_frame_save_area;
       VAR handler_status: ost$status);

      CASE condition.selector OF

      = pmc$system_conditions =
        IF (condition.system_conditions * $pmt$system_conditions
              [pmc$instruction_specification, pmc$address_specification, pmc$access_violation,
              pmc$invalid_segment_ring_0, pmc$divide_fault, pmc$arithmetic_overflow, pmc$exponent_overflow,
              pmc$exponent_underflow, pmc$fp_significance_loss, pmc$fp_indefinite,
              pmc$arithmetic_significance, pmc$invalid_bdp_data]) <> $pmt$system_conditions [] THEN
          osp$set_status_abnormal (fdc$format_display_identifier, fde$bad_data_value, '', status);
          EXIT fdp$reset_form;
        IFEND;

      = pmc$user_defined_condition =
        IF condition.user_condition_name = cye$run_time_condition THEN
          osp$set_status_abnormal (fdc$format_display_identifier, fde$bad_data_value, '', status);
          EXIT fdp$reset_form;
        IFEND;

      ELSE
        ;
      CASEND;
      pmp$continue_to_cause (pmc$execute_standard_procedure, handler_status);
    PROCEND condition_handler;

?? OLDTITLE, EJECT ??

    osp$establish_condition_handler (^condition_handler, FALSE);
    fdp$find_form_status (form_identifier, p_form_status, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    IF p_form_status^.push_count <> 0 THEN
      osp$set_status_abnormal (fdc$format_display_identifier, fde$form_pushed,
            p_form_status^.p_form_definition^.form_name, status);
      RETURN;
    IFEND;

    p_form_status^.last_cursor_position_valid := FALSE;

{ Set all variables to initial values and display attributes.
{ If the form is displayed on the screen and currently added, then record the screen changes.

    record_changes := p_form_status^.displayed_on_screen AND
            (p_form_status^.added OR p_form_status^.combined);
    fdp$initialize_form_record (form_identifier, p_form_status, record_changes,
            variable_status, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

{ Set initial object attributes and character positions.

    fdp$initialize_form_objects (form_identifier, p_form_status, record_changes, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    IF p_form_status^.design_form THEN
      fdp$delete_area (form_identifier, 1, 1, p_form_status^.p_form_definition^.width,
            p_form_status^.p_form_definition^.height, status);
      RETURN;
    IFEND;

    IF ((fdv$screen_status.last_cursor_position_valid) AND
          (fdv$screen_status.last_cursor_form_identifier = form_identifier)) THEN
      fdv$screen_status.last_cursor_position_valid := FALSE;
    IFEND;

  PROCEND fdp$reset_form;

?? TITLE := 'fdp$reset_object_attribute', EJECT ??
*copyc fdh$reset_object_attribute

  PROCEDURE [XDCL] fdp$reset_object_attribute
    (    form_identifier: fdt$form_identifier;
         object_name: ost$name;
         occurrence: fdt$occurrence;
     VAR status: ost$status);

    VAR
      form_object_key: fdt$form_object_key,
      object_name_exists: boolean,
      object_occurrence_exists: boolean,
      object_index: fdt$object_index,
      p_form_object_definition: ^fdt$form_object_definition,
      p_form_status: ^fdt$form_status,
      p_form_variable_definition: ^fdt$form_variable_definition,
      screen_change: fdt$screen_change,
      valid_object_name: ost$name;

?? NEWTITLE := 'condition_handler', EJECT ??

    PROCEDURE condition_handler
      (    condition: pmt$condition;
           condition_information: ^pmt$condition_information;
           stack_frame_save_area: ^ost$stack_frame_save_area;
       VAR handler_status: ost$status);

      CASE condition.selector OF

      = pmc$system_conditions =
        IF (condition.system_conditions * $pmt$system_conditions
              [pmc$instruction_specification, pmc$address_specification, pmc$access_violation,
              pmc$invalid_segment_ring_0, pmc$divide_fault, pmc$arithmetic_overflow, pmc$exponent_overflow,
              pmc$exponent_underflow, pmc$fp_significance_loss, pmc$fp_indefinite,
              pmc$arithmetic_significance, pmc$invalid_bdp_data]) <> $pmt$system_conditions [] THEN
          osp$set_status_abnormal (fdc$format_display_identifier, fde$bad_data_value, '', status);
          EXIT fdp$reset_object_attribute;
        IFEND;

      = pmc$user_defined_condition =
        IF condition.user_condition_name = cye$run_time_condition THEN
          osp$set_status_abnormal (fdc$format_display_identifier, fde$bad_data_value, '', status);
          EXIT fdp$reset_object_attribute;
        IFEND;

      ELSE
        ;
      CASEND;
      pmp$continue_to_cause (pmc$execute_standard_procedure, handler_status);
    PROCEND condition_handler;

?? OLDTITLE, EJECT ??

    osp$establish_condition_handler (^condition_handler, FALSE);
    fdp$check_for_active_form (form_identifier, p_form_status, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    #translate (osv$lower_to_upper, object_name, valid_object_name);
    fdp$find_object_definition (valid_object_name, occurrence, p_form_status^.p_form_object_definitions,
          p_form_status^.p_form_definition^.form_object_definitions.active_number, p_form_object_definition,
          object_index, object_name_exists, object_occurrence_exists);
    IF NOT object_name_exists THEN
      osp$set_status_abnormal (fdc$format_display_identifier, fde$unknown_object_name, object_name, status);
      osp$append_status_parameter (osc$status_parameter_delimiter,
            p_form_status^.p_form_definition^.form_name, status);
      RETURN;
    IFEND;

    IF NOT object_occurrence_exists THEN
      osp$set_status_abnormal (fdc$format_display_identifier, fde$invalid_occurrence, '', status);
      osp$append_status_integer (osc$status_parameter_delimiter, $INTEGER (occurrence), 10, FALSE, status);
      osp$append_status_parameter (osc$status_parameter_delimiter, object_name, status);
      osp$append_status_parameter (osc$status_parameter_delimiter,
            p_form_status^.p_form_definition^.form_name, status);
      RETURN;
    IFEND;

    IF (p_form_object_definition^.display_attribute =
          p_form_status^.p_form_object_statuses^ [object_index].display_attribute_set) THEN
      RETURN;
    IFEND;

    p_form_status^.p_form_object_statuses^ [object_index].display_attribute_set :=
          p_form_object_definition^.display_attribute;

    IF p_form_status^.displayed_on_screen THEN
      screen_change.key := fdc$set_attribute;
      screen_change.attribute_form_identifier := form_identifier;
      screen_change.attribute := p_form_object_definition^.display_attribute;
      screen_change.attribute_object_index := object_index;
      fdp$record_screen_change (screen_change, status);
    IFEND;

  PROCEND fdp$reset_object_attribute;

?? TITLE := 'fdp$set_cursor_position', EJECT ??
*copyc fdh$set_cursor_position

  PROCEDURE [XDCL] fdp$set_cursor_position
    (    form_identifier: fdt$form_identifier;
         object_name: ost$name;
         occurrence: fdt$occurrence;
         character_position: fdt$character_position;
     VAR status: ost$status);

    VAR
      name_is_valid: boolean,
      object_index: fdt$object_index,
      object_name_exists: boolean,
      object_occurrence_exists: boolean,
      p_form_object_definition: ^fdt$form_object_definition,
      p_form_object_definitions: ^array [1 .. * ] of fdt$form_object_definition,
      p_form_module: ^fdt$form_module,
      p_form_status: ^fdt$form_status,
      p_form_variable_definition: ^fdt$form_variable_definition,
      p_form_variable_definitions: ^array [1 .. * ] of fdt$form_variable_definition,
      p_text: ^fdt$text,
      screen_change: fdt$screen_change,
      valid_object_name: ost$name;

?? NEWTITLE := 'condition_handler', EJECT ??

    PROCEDURE condition_handler
      (    condition: pmt$condition;
           condition_information: ^pmt$condition_information;
           stack_frame_save_area: ^ost$stack_frame_save_area;
       VAR handler_status: ost$status);

      CASE condition.selector OF

      = pmc$system_conditions =
        IF (condition.system_conditions * $pmt$system_conditions
              [pmc$instruction_specification, pmc$address_specification, pmc$access_violation,
              pmc$invalid_segment_ring_0, pmc$divide_fault, pmc$arithmetic_overflow, pmc$exponent_overflow,
              pmc$exponent_underflow, pmc$fp_significance_loss, pmc$fp_indefinite,
              pmc$arithmetic_significance, pmc$invalid_bdp_data]) <> $pmt$system_conditions [] THEN
          osp$set_status_abnormal (fdc$format_display_identifier, fde$bad_data_value, '', status);
          EXIT fdp$set_cursor_position;
        IFEND;

      = pmc$user_defined_condition =
        IF condition.user_condition_name = cye$run_time_condition THEN
          osp$set_status_abnormal (fdc$format_display_identifier, fde$bad_data_value, '', status);
          EXIT fdp$set_cursor_position;
        IFEND;

      ELSE
        ;
      CASEND;
      pmp$continue_to_cause (pmc$execute_standard_procedure, handler_status);
    PROCEND condition_handler;

?? OLDTITLE ??
?? NEWTITLE := 'cursor_outside_table', EJECT ??

    PROCEDURE cursor_inside_table;
      status.normal := TRUE;
      IF p_form_variable_definition^.table_exists THEN
        IF occurrence > p_form_status^.p_form_table_statuses^ [p_form_variable_definition^.table_index].
              last_active_occurrence THEN
          osp$set_status_abnormal (fdc$format_display_identifier, fde$unknown_occurrence, '', status);
          osp$append_status_integer (osc$status_parameter_delimiter, $INTEGER (occurrence), 10,
                FALSE, status);
          osp$append_status_parameter (osc$status_parameter_delimiter, object_name, status);
          osp$append_status_parameter (osc$status_parameter_delimiter,
                p_form_status^.p_form_definition^.form_name, status);
        IFEND;
      IFEND;
    PROCEND cursor_inside_table;

?? OLDTITLE ??
?? NEWTITLE := 'set_invalid_position', EJECT ??

    PROCEDURE [INLINE]  set_invalid_position;
        osp$set_status_abnormal (fdc$format_display_identifier, fde$invalid_character_position, '', status);
        osp$append_status_integer (osc$status_parameter_delimiter, $INTEGER (character_position), 10, FALSE,
              status);
        osp$append_status_parameter (osc$status_parameter_delimiter, object_name, status);
        osp$append_status_parameter (osc$status_parameter_delimiter,
              p_form_status^.p_form_definition^.form_name, status);
    PROCEND set_invalid_position;

?? OLDTITLE, EJECT ??
    osp$establish_condition_handler (^condition_handler, FALSE);
    fdp$check_for_active_form (form_identifier, p_form_status, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    #translate (osv$lower_to_upper, object_name, valid_object_name);
    fdp$find_object_definition (valid_object_name, occurrence, p_form_status^.p_form_object_definitions,
          p_form_status^.p_form_definition^.form_object_definitions.active_number, p_form_object_definition,
          object_index, object_name_exists, object_occurrence_exists);

    IF NOT object_name_exists THEN
      osp$set_status_abnormal (fdc$format_display_identifier, fde$unknown_object_name, object_name, status);
      osp$append_status_parameter (osc$status_parameter_delimiter,
            p_form_status^.p_form_definition^.form_name, status);
      RETURN;
    IFEND;

    IF NOT object_occurrence_exists THEN
      osp$set_status_abnormal (fdc$format_display_identifier, fde$unknown_occurrence, '', status);
      osp$append_status_integer (osc$status_parameter_delimiter, $INTEGER (occurrence), 10, FALSE, status);
      osp$append_status_parameter (osc$status_parameter_delimiter, object_name, status);
      osp$append_status_parameter (osc$status_parameter_delimiter,
            p_form_status^.p_form_definition^.form_name, status);
      RETURN;
    IFEND;

    p_form_variable_definitions := p_form_status^.p_form_variable_definitions;
    p_form_object_definitions := p_form_status^.p_form_object_definitions;
    screen_change.key := fdc$set_cursor;
    screen_change.cursor_form_identifier := form_identifier;
    screen_change.cursor_character_position := character_position;
    screen_change.cursor_object_index := object_index;

{ The cursor position must lie inside the data for an object.

    CASE p_form_object_definition^.key OF

    = fdc$form_constant_text =
      IF character_position > p_form_object_definition^.constant_text_width THEN
        set_invalid_position;
        RETURN;
      IFEND;

    = fdc$form_constant_text_box =
      IF (character_position > (p_form_object_definition^.constant_box_height *
            p_form_object_definition^.constant_box_width)) THEN
        set_invalid_position;
        RETURN;
      IFEND;

    = fdc$form_variable_text_box =
      IF p_form_object_definition^.variable_box_variable_exists THEN
        p_form_variable_definition := ^p_form_variable_definitions^
              [p_form_object_definition^.variable_box_variable_index];
        cursor_inside_table;
        IF NOT status.normal THEN
          RETURN;
        IFEND;
        IF ((p_form_variable_definition^.program_data_type = fdc$program_real_type) OR
              (p_form_variable_definition^.program_data_type = fdc$program_integer_type)) THEN
          IF character_position > p_form_variable_definition^.screen_variable_length THEN
            set_invalid_position;
            RETURN;
          IFEND;

        ELSE { The data type is character.}
          IF character_position > p_form_variable_definition^.program_variable_length THEN
            set_invalid_position;
            RETURN;
          IFEND;
        IFEND;

      ELSE

{ No variable defined.

        osp$set_status_abnormal (fdc$format_display_identifier, fde$no_object_variable_defined,
              valid_object_name, status);
        osp$append_status_parameter (osc$status_parameter_delimiter,
              p_form_status^.p_form_definition^.form_name, status);
        RETURN;
      IFEND;

    = fdc$form_variable_text =
      IF p_form_object_definition^.text_variable_exists THEN
        p_form_variable_definition := ^p_form_variable_definitions^
              [p_form_object_definition^.text_variable_index];
        cursor_inside_table;
        IF NOT status.normal THEN
          RETURN;
        IFEND;
        IF ((p_form_variable_definition^.program_data_type = fdc$program_real_type) OR
              (p_form_variable_definition^.program_data_type = fdc$program_integer_type)) THEN
          IF character_position > p_form_variable_definition^.screen_variable_length THEN
            set_invalid_position;
            RETURN;
          IFEND;

        ELSE { The data type is character.}
          IF character_position > p_form_variable_definition^.program_variable_length THEN
            set_invalid_position;
            RETURN;
          IFEND;
        IFEND;

      ELSE

{ No variable defined.

        osp$set_status_abnormal (fdc$format_display_identifier, fde$no_object_variable_defined,
              valid_object_name, status);
        osp$append_status_parameter (osc$status_parameter_delimiter,
              p_form_status^.p_form_definition^.form_name, status);
        RETURN;
      IFEND;

    = fdc$form_stored_variable =
      IF p_form_object_definition^.stored_variable_exists THEN
        p_form_variable_definition := ^p_form_variable_definitions^
              [p_form_object_definition^.stored_variable_index];
        cursor_inside_table;
        IF NOT status.normal THEN
          RETURN;
        IFEND;
        IF ((p_form_variable_definition^.program_data_type = fdc$program_real_type) OR
              (p_form_variable_definition^.program_data_type = fdc$program_integer_type)) THEN
          IF character_position > p_form_variable_definition^.screen_variable_length THEN
            set_invalid_position;
            RETURN;
          IFEND;

        ELSE { The data type is character.}
          IF character_position > p_form_variable_definition^.program_variable_length THEN
            set_invalid_position;
            RETURN;
          IFEND;
        IFEND;

      ELSE

{ No variable defined.

        osp$set_status_abnormal (fdc$format_display_identifier, fde$no_object_variable_defined,
              valid_object_name, status);
        osp$append_status_parameter (osc$status_parameter_delimiter,
              p_form_status^.p_form_definition^.form_name, status);
        RETURN;
      IFEND;

    = fdc$form_box, fdc$form_line =
      osp$set_status_abnormal (fdc$format_display_identifier, fde$no_object_variable_defined,
            valid_object_name, status);
      osp$append_status_parameter (osc$status_parameter_delimiter,
            p_form_status^.p_form_definition^.form_name, status);
      RETURN;

    ELSE

{ Invalid object definition key.

      osp$set_status_abnormal (fdc$format_display_identifier, fde$system_error, 'invalid object', status);
      RETURN;
    CASEND;
    fdp$record_screen_change (screen_change, status);

  PROCEND fdp$set_cursor_position;

?? TITLE := 'fdp$set_object_attribute', EJECT ??
*copyc fdh$set_object_attribute

  PROCEDURE [XDCL] fdp$set_object_attribute
    (    form_identifier: fdt$form_identifier;
         object_name: ost$name;
         occurrence: fdt$occurrence;
         attribute: ost$name;
     VAR status: ost$status);

    VAR
      name_exists: boolean,
      object_index: fdt$object_index,
      object_occurrence_exists: boolean,
      p_display_definition: ^fdt$display_definition,
      p_form_definition: ^fdt$form_definition,
      p_form_status: ^fdt$form_status,
      p_form_object_definition: ^fdt$form_object_definition,
      p_form_object_definitions: ^array [1 .. * ] of fdt$form_object_definition,
      screen_change: fdt$screen_change,
      valid_attribute_name: ost$name,
      valid_object_name: ost$name;

?? NEWTITLE := 'condition_handler', EJECT ??

    PROCEDURE condition_handler
      (    condition: pmt$condition;
           condition_information: ^pmt$condition_information;
           stack_frame_save_area: ^ost$stack_frame_save_area;
       VAR handler_status: ost$status);

      CASE condition.selector OF

      = pmc$system_conditions =
        IF (condition.system_conditions * $pmt$system_conditions
              [pmc$instruction_specification, pmc$address_specification, pmc$access_violation,
              pmc$invalid_segment_ring_0, pmc$divide_fault, pmc$arithmetic_overflow, pmc$exponent_overflow,
              pmc$exponent_underflow, pmc$fp_significance_loss, pmc$fp_indefinite,
              pmc$arithmetic_significance, pmc$invalid_bdp_data]) <> $pmt$system_conditions [] THEN
          osp$set_status_abnormal (fdc$format_display_identifier, fde$bad_data_value, '', status);
          EXIT fdp$set_object_attribute;
        IFEND;

      = pmc$user_defined_condition =
        IF condition.user_condition_name = cye$run_time_condition THEN
          osp$set_status_abnormal (fdc$format_display_identifier, fde$bad_data_value, '', status);
          EXIT fdp$set_object_attribute;
        IFEND;

      ELSE
        ;
      CASEND;
      pmp$continue_to_cause (pmc$execute_standard_procedure, handler_status);
    PROCEND condition_handler;

?? OLDTITLE, EJECT ??

    osp$establish_condition_handler (^condition_handler, FALSE);
    fdp$check_for_active_form (form_identifier, p_form_status, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    p_form_definition := p_form_status^.p_form_definition;
    #translate (osv$lower_to_upper, object_name, valid_object_name);

    #translate (osv$lower_to_upper, object_name, valid_object_name);
    p_form_object_definitions := p_form_status^.p_form_object_definitions;
    fdp$find_object_definition (valid_object_name, occurrence, p_form_object_definitions,
          p_form_definition^.form_object_definitions.active_number, p_form_object_definition, object_index,
          name_exists, object_occurrence_exists);
    IF NOT name_exists THEN
      osp$set_status_abnormal (fdc$format_display_identifier, fde$unknown_object_name, object_name, status);
      osp$append_status_parameter (osc$status_parameter_delimiter,
            p_form_status^.p_form_definition^.form_name, status);
      RETURN;
    IFEND;

    IF NOT object_occurrence_exists THEN
      osp$set_status_abnormal (fdc$format_display_identifier, fde$unknown_occurrence, '', status);
      osp$append_status_integer (osc$status_parameter_delimiter, $INTEGER (occurrence), 10, FALSE, status);
      osp$append_status_parameter (osc$status_parameter_delimiter, object_name, status);
      osp$append_status_parameter (osc$status_parameter_delimiter,
            p_form_status^.p_form_definition^.form_name, status);
      RETURN;
    IFEND;

    #translate (osv$lower_to_upper, attribute, valid_attribute_name);
    fdp$find_display_name (valid_attribute_name, p_form_status^.p_display_definitions,
          p_form_definition^.display_definitions.active_number, p_display_definition, name_exists);
    IF NOT name_exists THEN
      osp$set_status_abnormal (fdc$format_display_identifier, fde$unknown_display_name, valid_attribute_name,
            status);
      osp$append_status_parameter (osc$status_parameter_delimiter,
            p_form_status^.p_form_definition^.form_name, status);
      RETURN;
    IFEND;

    screen_change.key := fdc$set_attribute;
    screen_change.attribute_form_identifier := form_identifier;
    screen_change.attribute_object_index := object_index;

    CASE p_form_object_definition^.key OF

    = fdc$form_box, fdc$form_line =

{ Graphics must have line attribute and protection.

      screen_change.attribute := p_display_definition^.attribute + $fdt$display_attribute_set [fdc$protect];
      IF ((screen_change.attribute * fdv$line_attributes) = $fdt$display_attribute_set []) THEN
        screen_change.attribute := screen_change.attribute +
              (p_form_object_definition^.display_attribute * fdv$line_attributes);
      IFEND;

    = fdc$form_constant_text_box, fdc$form_constant_text =

{ Always protect constant text.

      screen_change.attribute := p_display_definition^.attribute + $fdt$display_attribute_set [fdc$protect];

    ELSE
      screen_change.attribute := p_display_definition^.attribute;
    CASEND;

    IF (p_form_status^.p_form_object_statuses^ [object_index].display_attribute_set =
          screen_change.attribute) THEN
      RETURN;
    IFEND;

    p_form_status^.p_form_object_statuses^ [object_index].display_attribute_set := screen_change.attribute;
    IF p_form_status^.displayed_on_screen THEN
      fdp$record_screen_change (screen_change, status);
    IFEND;

  PROCEND fdp$set_object_attribute;

?? TITLE := 'fdp$validate_cobol_data', EJECT ??
*copyc fdh$validate_cobol_data

  PROCEDURE [XDCL] fdp$validate_cobol_data
    (    p_form_status: ^fdt$form_status;
         p_form_variable_definition: ^fdt$form_variable_definition;
         p_program_variable: ^cell;
     VAR p_valid_string: ^fdt$valid_string;
     VAR variable_status: fdt$variable_status);

    TYPE
      data_converter = record
        case integer of
        = 1 =
          integer_cells: array [1 .. fdc$integer_length] of cell,
        = 2 =
          integer_number: integer,
        casend,
      recend;

    VAR
      data: data_converter,
      p_added_variable_definition: ^fdt$added_variable_definition,
      p_program_variable_array: ^array [1 .. *] of cell,
      p_text: ^fdt$text,
      p_text_sequence: ^SEQ ( * ),
      real_number: real;

    variable_status := fdc$no_error;
    p_valid_string := NIL;
    fdp$locate_added_variable_facts (p_form_status^.p_form_module,
          p_form_variable_definition, p_added_variable_definition);

    CASE p_added_variable_definition^.
          program_cobol_description.cobol_usage OF

    = fdc$cobol_usage_binary =
      data.integer_number := 0;
      i#move (p_program_variable,
            ^data.integer_cells [fdc$integer_length -
            p_form_variable_definition^.program_variable_length + 1],
            p_form_variable_definition^.program_variable_length);
      fdp$validate_integer (data.integer_number, p_form_variable_definition^.
            valid_integer_ranges, p_form_status,  variable_status);

    = fdc$cobol_usage_single =
      i#move (p_program_variable, ^real_number, p_form_variable_definition^.program_variable_length);
      fdp$validate_real (real_number, p_form_variable_definition^.valid_real_ranges, p_form_status,
            variable_status);

    = fdc$cobol_usage_display =
      CASE p_added_variable_definition^.program_cobol_description.cobol_category OF

      = fdc$cobol_alphanumeric, fdc$cobol_alphabetic =

{ Convert array of cells to string.

        i#build_adaptable_array_ptr (#RING (p_program_variable), #SEGMENT (p_program_variable),
              #OFFSET (p_program_variable), p_form_variable_definition^.program_variable_length,
              1, 1, #LOC (p_program_variable_array));
        p_text_sequence := #SEQ (p_program_variable_array^);
        RESET p_text_sequence;
        NEXT p_text: [p_form_variable_definition^.program_variable_length] IN p_text_sequence;
          fdp$validate_string (p_text, p_form_variable_definition^.program_variable_length,
                p_form_variable_definition^.valid_strings,
                p_form_status, p_valid_string, variable_status);

      ELSE { Other categories cannot be validated.
      CASEND;

    ELSE { Other usages cannot be validated.
    CASEND;
  PROCEND fdp$validate_cobol_data;

?? TITLE := 'fdp$validate_integer', EJECT ??

  PROCEDURE [XDCL] fdp$validate_integer
    (    integer_number: integer;
         valid_integer_ranges: fdt$valid_integer_ranges;
         p_form_status: ^fdt$form_status;
     VAR variable_status: fdt$variable_status);

    VAR
      n: fdt$valid_integer_index,
      p_valid_integer_range: ^fdt$valid_integer_range,
      p_valid_integer_ranges: ^array [1 .. * ] of fdt$valid_integer_range;

    IF valid_integer_ranges.active_number = 0 THEN

{ No valid integers were defined. All integers are valid.

      variable_status := fdc$no_error;
      RETURN;
    IFEND;

    p_valid_integer_ranges := fdp$ptr_valid_integers (valid_integer_ranges, p_form_status^.p_form_module);
    variable_status := fdc$invalid_integer;

  /find_integer/
    FOR n := 1 TO valid_integer_ranges.active_number DO
      p_valid_integer_range := ^p_valid_integer_ranges^ [n];
      IF integer_number >= p_valid_integer_range^.minimum_integer THEN
        IF integer_number <= p_valid_integer_range^.maximum_integer THEN
          variable_status := fdc$no_error;
          EXIT /find_integer/;
        IFEND;
      IFEND;
    FOREND /find_integer/;

  PROCEND fdp$validate_integer;

?? TITLE := 'fdp$validate_real', EJECT ??

  PROCEDURE [XDCL] fdp$validate_real
    (    real_number: real;
         valid_real_ranges: fdt$valid_real_ranges;
         p_form_status: ^fdt$form_status;
     VAR variable_status: fdt$variable_status);

    VAR
      n: fdt$valid_real_index,
      p_valid_real_range: ^fdt$valid_real_range,
      p_valid_real_ranges: ^array [1 .. * ] of fdt$valid_real_range;

    IF valid_real_ranges.active_number = 0 THEN

{ No valid real numbers were defined. All real valid numbers are valid.

      variable_status := fdc$no_error;
      RETURN;
    IFEND;

    p_valid_real_ranges := fdp$ptr_valid_reals (valid_real_ranges, p_form_status^.p_form_module);
    variable_status := fdc$invalid_real;

  /find_real/
    FOR n := 1 TO valid_real_ranges.active_number DO
      p_valid_real_range := ^p_valid_real_ranges^ [n];
      IF real_number >= p_valid_real_range^.minimum_real THEN
        IF real_number <= p_valid_real_range^.maximum_real THEN
          variable_status := fdc$no_error;
          EXIT /find_real/;
        IFEND;
      IFEND;
    FOREND /find_real/;

  PROCEND fdp$validate_real;

?? TITLE := 'fdp$validate_string', EJECT ??

  PROCEDURE [XDCL] fdp$validate_string
    (    p_text: ^fdt$text;
         text_length: fdt$text_length;
         valid_strings: fdt$valid_strings;
         p_form_status: ^fdt$form_status;
     VAR p_valid_string: ^fdt$valid_string;
     VAR variable_status: fdt$variable_status);

    VAR
      compare_length: fdt$text_length,
      n: fdt$valid_string_index,
      p_duplicate_string: ^fdt$valid_string,
      p_valid_strings: ^array [1 .. * ] of fdt$valid_string_definition,
      valid_string_length: fdt$text_length;

    IF valid_strings.active_number = 0 THEN

{ No strings to compare. All strings are valid.

      variable_status := fdc$no_error;
      p_valid_string := NIL;
      RETURN;
    IFEND;

    p_valid_strings := fdp$ptr_valid_strings (valid_strings, p_form_status^.p_form_module);

    compare_length := text_length;
    IF valid_strings.compare_to_unique_substring THEN

    /determine_compare_length/
      FOR compare_length := text_length DOWNTO 1 DO
        IF (p_text^ (compare_length, 1) <> ' ') THEN
          EXIT /determine_compare_length/;
        IFEND;
      FOREND /determine_compare_length/;
    IFEND;

   variable_status := fdc$invalid_string;

  /find_string/
    FOR n := 1 TO valid_strings.active_number DO
      p_valid_string := #PTR (p_valid_strings^ [n].p_valid_string, p_form_status^.p_form_module^);

      IF compare_length > STRLENGTH (p_valid_string^) THEN
        valid_string_length := STRLENGTH (p_valid_string^);
      ELSE
        valid_string_length := compare_length;
      IFEND;

      IF (p_text^ (1, compare_length) = p_valid_string^ (1, valid_string_length)) THEN
        variable_status := fdc$no_error;
        EXIT /find_string/;
      IFEND;
    FOREND /find_string/;

    IF NOT valid_strings.compare_to_unique_substring THEN
      RETURN;
    IFEND;

{ Only one valid string must match the terminal user input.

  /check_duplicate_string/
    FOR n := n + 1 TO valid_strings.active_number DO
      p_duplicate_string := #PTR (p_valid_strings^ [n].p_valid_string, p_form_status^.p_form_module^);

      IF compare_length > STRLENGTH (p_duplicate_string^) THEN
        valid_string_length := STRLENGTH (p_duplicate_string^);
      ELSE
        valid_string_length := compare_length;
      IFEND;

      IF (p_text^ (1, compare_length) = p_duplicate_string^ (1, valid_string_length)) THEN
        variable_status := fdc$invalid_string;
        EXIT /check_duplicate_string/;
      IFEND;
    FOREND /check_duplicate_string/;

  PROCEND fdp$validate_string;

?? TITLE := 'fdp$validate_variable', EJECT ??
*copyc fdh$validate_variable

  PROCEDURE [XDCL] fdp$validate_variable
    (    form_identifier: fdt$form_identifier;
         variable_name: ost$name;
         variable_value: fdt$variable_value;
     VAR variable_status: fdt$variable_status;
     VAR status: ost$status);

    VAR
      ignore_date_time: clt$date_time,
      name_exists: boolean,
      p_form_variable_definition: ^fdt$form_variable_definition,
      p_form_status: ^fdt$form_status,
      p_valid_string: ^fdt$valid_string,
      valid_name: ost$name,
      variable_index: fdt$variable_index;

?? NEWTITLE := 'condition_handler', EJECT ??

    PROCEDURE condition_handler
      (    condition: pmt$condition;
           condition_information: ^pmt$condition_information;
           stack_frame_save_area: ^ost$stack_frame_save_area;
       VAR handler_status: ost$status);

      CASE condition.selector OF

      = pmc$system_conditions =
        IF (condition.system_conditions * $pmt$system_conditions
              [pmc$instruction_specification, pmc$address_specification, pmc$access_violation,
              pmc$invalid_segment_ring_0, pmc$divide_fault, pmc$arithmetic_overflow, pmc$exponent_overflow,
              pmc$exponent_underflow, pmc$fp_significance_loss, pmc$fp_indefinite,
              pmc$arithmetic_significance, pmc$invalid_bdp_data]) <> $pmt$system_conditions [] THEN
          osp$set_status_abnormal (fdc$format_display_identifier, fde$bad_data_value, '', status);
          EXIT fdp$validate_variable;
        IFEND;

      = pmc$user_defined_condition =
        IF condition.user_condition_name = cye$run_time_condition THEN
          osp$set_status_abnormal (fdc$format_display_identifier, fde$bad_data_value, '', status);
          EXIT fdp$validate_variable;
        IFEND;

      ELSE
        ;
      CASEND;
      pmp$continue_to_cause (pmc$execute_standard_procedure, handler_status);
    PROCEND condition_handler;

?? OLDTITLE, EJECT ??
    osp$establish_condition_handler (^condition_handler, FALSE);
    status.normal := TRUE;
    variable_status := fdc$no_error;
    fdp$find_form_definition (form_identifier, p_form_status, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    #TRANSLATE (osv$lower_to_upper, variable_name, valid_name);
    fdp$find_variable_definition (valid_name, p_form_status^.p_form_variable_definitions,
           p_form_status^.p_form_definition^.form_variable_definitions.active_number,
           p_form_variable_definition, variable_index,name_exists);
    IF NOT name_exists THEN
      osp$set_status_abnormal (fdc$format_display_identifier, fde$unknown_variable_name,
            variable_name, status);
      osp$append_status_parameter( osc$status_parameter_delimiter, p_form_status^.
            p_form_definition^.form_name, status);
      RETURN;
    IFEND;

{ Do not validate value for variable with must enter to allow
{ entry of such values as passwords.  The application does not want to show
{ the terminal user any password on the initial display.

    IF (fdc$must_enter IN p_form_variable_definition^.terminal_user_entry) THEN
      RETURN;
    IFEND;

{ Check initial value against specified valid values.

    CASE variable_value.program_data_type OF

    = fdc$program_cobol_type =
      fdp$validate_cobol_data (p_form_status, p_form_variable_definition,
              variable_value.p_cobol_data, p_valid_string, variable_status);

    = fdc$program_character_type,  fdc$program_upper_case_type =
      fdp$validate_string (variable_value.p_text, variable_value.text_length,
              p_form_variable_definition^.valid_strings, p_form_status,
              p_valid_string, variable_status);

    = fdc$program_integer_type =
      IF fdp$date_variable(p_form_variable_definition) THEN
        fdp$convert_yymmdd_to_date_time (variable_value.integer_value, ignore_date_time, variable_status);
      ELSE
      fdp$validate_integer (variable_value.integer_value, p_form_variable_definition^.
              valid_integer_ranges, p_form_status, variable_status);
      IFEND;

    = fdc$program_real_type =
      fdp$validate_real (variable_value.real_value, p_form_variable_definition^.
              valid_real_ranges, p_form_status, variable_status);

    ELSE
      osp$set_status_abnormal (fdc$format_display_identifier, fde$program_data_type,
            p_form_status^.p_form_definition^.form_name, status);
    CASEND;

  PROCEND fdp$validate_variable;

?? TITLE := 'check_form_screen_fit', EJECT ??

  PROCEDURE [INLINE] check_form_screen_fit
    (    x_position: fdt$x_position;
         y_position: fdt$y_position;
         width: fdt$width;
         height: fdt$height;
         form_name: ost$name;
     VAR status: ost$status);

    VAR
      dimension_index: integer;

      FOR dimension_index := 1 TO fdv$screen_status.screen_dimensions.sets_of_dimensions DO
        IF (((x_position + width - 1) <= fdv$screen_status.screen_dimensions.
              screen_dimensions [dimension_index].x_screen_dimension) AND
              ((y_position + height - 1) <= fdv$screen_status.screen_dimensions.
              screen_dimensions [dimension_index].y_screen_dimension)) THEN
          status.normal := TRUE;
          RETURN;
        IFEND;
      FOREND;

      osp$set_status_abnormal (fdc$format_display_identifier, fde$form_too_large_for_screen, form_name,
            status);
      osp$append_status_integer (osc$status_parameter_delimiter, $INTEGER (x_position), 10, FALSE, status);
      osp$append_status_integer (osc$status_parameter_delimiter, $INTEGER (y_position), 10, FALSE, status);
      osp$append_status_integer (osc$status_parameter_delimiter, $INTEGER (width), 10, FALSE, status);
      osp$append_status_integer (osc$status_parameter_delimiter, $INTEGER (height), 10, FALSE, status);
  PROCEND check_form_screen_fit;

?? OLDTITLE ??
?? NEWTITLE := 'convert_to_variable_status', EJECT ??

  PROCEDURE convert_to_variable_status
    (    cobol_status: ost$status;
     VAR variable_status: fdt$variable_status;
     VAR status: ost$status);

    status.normal := TRUE;
    CASE  cobol_status.condition OF
    = fde$cobol_nonblk_outside_paren =
      variable_status := fdc$nonblk_outside_parentheses;
    = fde$cobol_no_scientific =
      variable_status := fdc$no_scientific_notation;
    = fde$cobol_illegal_char_entered =
      variable_status := fdc$invalid_character_entered;
    = fde$cobol_two_signs_entered =
      variable_status := fdc$too_many_signs;
    = fde$cobol_no_plus_or_minus_now =
      variable_status := fdc$no_plus_or_minus_now;
    = fde$cobol_c_without_r =
      variable_status := fdc$c_without_r;
    = fde$cobol_no_cr_or_db_now =
      variable_status := fdc$no_cr_or_db_now;
    = fde$cobol_d_without_b =
      variable_status := fdc$d_without_b;
    = fde$cobol_too_many_digits =
      variable_status := fdc$gr_18_digits;
    = fde$cobol_two_points_entered =
      variable_status := fdc$too_many_decimal_points;
    = fde$cobol_trailing_sign_nonblk =
      variable_status := fdc$nonblk_after_trailing_sign;
    = fde$cobol_float_too_big =
      variable_status := fdc$floating_number_too_big;
    = fde$cobol_bad_overpunch_sign =
      variable_status := fdc$invalid_overpunch_sign;
    = fde$cobol_bad_separate_sign =
      variable_status := fdc$invalid_separate_sign;
    = fde$cobol_destination_invalid =
      variable_status := fdc$output_format_bad;
    = fde$cobol_source_invalid =
      variable_status := fdc$variable_truncated;
    ELSE
      status := cobol_status;
    CASEND;

  PROCEND convert_to_variable_status;

?? TITLE := 'display_invalid_data_character', EJECT ??

{ PURPOSE:
{   This procedure converts the characters in a screen variable to the invalid data character, if it has been
{   defined for the variable.
{
{ DESIGN:
{   Forms created prior to FDC$IM_SMART_CAPABILITY will not display an invalid data Character.
{   Set UPDATE_SCREEN to FALSE if the invalid data character is not defined so that the screen value will
{   remain unchanged.
{
{ NOTE:
{   The caller of this procedure determines if the variable has errors.

  PROCEDURE [INLINE] display_invalid_data_character
    (    p_form_status: ^fdt$form_status;
         screen_variable_length: fdt$text_length;
     VAR update_screen: boolean;
     VAR screen_variable: fdt$text);

    VAR
      character_index: fdt$text_length;


    IF p_form_status^.invalid_data_character.defined THEN
      FOR character_index := 1 TO screen_variable_length DO
        screen_variable (character_index) := p_form_status^.invalid_data_character.character;
      FOREND;
    ELSE

{ Do not update the value on the screen.

      update_screen := FALSE;
    IFEND;

  PROCEND display_invalid_data_character;
?? TITLE := 'find_next_input_error', EJECT ??

{ PURPOSE:
{   This procedure finds the next variable with an input error in the form.
{
{ NOTE:
{   A value of FDC$NO_ERROR for VARIABLE_STATUS is returned if there are no more errors in the form.

  PROCEDURE find_next_input_error
    (    p_form_status: ^fdt$form_status;
         start_object_index: fdt$object_index;
     VAR variable_name: ost$name;
     VAR occurrence: fdt$occurrence;
     VAR variable_status: fdt$variable_status);

    VAR
      object_index: fdt$object_index,
      p_form_object_definitions: ^array [1 .. * ] of fdt$form_object_definition,
      p_form_object_statuses: ^array [1 .. * ] of fdt$form_object_status;


    p_form_object_definitions := p_form_status^.p_form_object_definitions;
    p_form_object_statuses := p_form_status^.p_form_object_statuses;
    variable_status := fdc$no_error;

    FOR object_index := start_object_index TO UPPERBOUND (p_form_object_statuses^) DO
      CASE p_form_object_definitions^ [object_index].key OF
      = fdc$form_stored_variable, fdc$form_variable_text, fdc$form_variable_text_box =
        IF p_form_object_statuses^ [object_index].variable_input_status <> fdc$no_error THEN

{ Found next input error.

          p_form_status^.input_error_search.status := fdc$searching;
          p_form_status^.input_error_search.object_index := object_index;
          variable_name := p_form_object_definitions^ [object_index].name;
          occurrence := p_form_object_definitions^ [object_index].occurrence;
          variable_status := p_form_object_statuses^ [object_index].variable_input_status;
          RETURN;
        IFEND;
      ELSE
      CASEND;
    FOREND;

    p_form_status^.input_error_search.status := fdc$search_completed;

  PROCEND find_next_input_error;
?? TITLE := 'find_record_variable', EJECT ??

  PROCEDURE find_record_variable
    (    p_form_status: ^fdt$form_status;
         name: ost$name;
         occurrence: fdt$occurrence;
     VAR p_form_variable_definition: ^fdt$form_variable_definition;
     VAR object_exists: boolean;
     VAR object_index: fdt$object_index;
     VAR program_record_position: fdt$record_position;
     VAR screen_record_position: fdt$record_position;
     VAR status: ost$status);

    VAR
      first_displayed_occurrence: fdt$occurrence,
      name_exists: boolean,
      p_form_module: ^fdt$form_module,
      p_form_table_definition: ^fdt$form_table_definition,
      p_form_table_definitions: ^array [1 .. * ] of fdt$form_table_definition,
      p_form_table_statuses: ^array [1 .. * ] of fdt$table_status,
      p_form_variable_definitions: ^array [1 .. * ] of fdt$form_variable_definition,
      p_record_definitions: ^array [1 .. * ] of fdt$variable_record_definition,
      p_table_object: ^fdt$table_object,
      p_table_objects: ^array [1 .. * ] of fdt$table_object,
      p_table_variable: ^fdt$table_variable,
      p_table_variables: ^array [1 .. * ] of fdt$table_variable,
      p_variable_record_definition: ^fdt$variable_record_definition,
      record_index: fdt$object_index,
      table_index: fdt$table_index,
      table_object_index: fdt$object_index,
      table_variable_index: fdt$variable_index;

?? NEWTITLE := 'condition_handler', EJECT ??

    PROCEDURE condition_handler
      (    condition: pmt$condition;
           condition_information: ^pmt$condition_information;
           stack_frame_save_area: ^ost$stack_frame_save_area;
       VAR handler_status: ost$status);

      CASE condition.selector OF

      = pmc$system_conditions =
        IF (condition.system_conditions * $pmt$system_conditions
              [pmc$instruction_specification, pmc$address_specification, pmc$access_violation,
              pmc$invalid_segment_ring_0, pmc$divide_fault, pmc$arithmetic_overflow, pmc$exponent_overflow,
              pmc$exponent_underflow, pmc$fp_significance_loss, pmc$fp_indefinite,
              pmc$arithmetic_significance, pmc$invalid_bdp_data]) <> $pmt$system_conditions [] THEN
          osp$set_status_abnormal (fdc$format_display_identifier, fde$bad_data_value, '', status);
          EXIT find_record_variable;
        IFEND;

      = pmc$user_defined_condition =
        IF condition.user_condition_name = cye$run_time_condition THEN
          osp$set_status_abnormal (fdc$format_display_identifier, fde$bad_data_value, '', status);
          EXIT find_record_variable;
        IFEND;

      ELSE
        ;
      CASEND;
      pmp$continue_to_cause (pmc$execute_standard_procedure, handler_status);
    PROCEND condition_handler;

?? OLDTITLE, EJECT ??
    osp$establish_condition_handler (^condition_handler, FALSE);
    status.normal := TRUE;
    object_exists := FALSE;
    name_exists := FALSE;
    p_form_variable_definitions := p_form_status^.p_form_variable_definitions;
    p_form_table_definitions := p_form_status^.p_form_table_definitions;
    p_form_table_statuses := p_form_status^.p_form_table_statuses;
    p_form_module := p_form_status^.p_form_module;
    p_record_definitions := p_form_status^.p_form_record_definitions;
    IF p_record_definitions = NIL THEN
      osp$set_status_condition (fde$unknown_occurrence, status);
      osp$append_status_integer (osc$status_parameter_delimiter, $INTEGER (occurrence), 10, FALSE, status);
      osp$append_status_parameter (osc$status_parameter_delimiter, name, status);
      osp$append_status_parameter (osc$status_parameter_delimiter,
            p_form_status^.p_form_definition^.form_name, status);
      RETURN;
    IFEND;

    FOR record_index := LOWERBOUND (p_record_definitions^) TO UPPERBOUND (p_record_definitions^) DO
      p_variable_record_definition := ^p_record_definitions^ [record_index];
      CASE p_variable_record_definition^.key OF

      = fdc$record_table =
        table_index := p_variable_record_definition^.table_index;
        p_form_table_definition := ^p_form_table_definitions^ [table_index];
        p_table_variables := fdp$ptr_table_variables (p_form_table_definition^.table_variables,
              p_form_module);
        FOR table_variable_index := 1 TO p_form_table_definition^.table_variables.active_number DO
          p_table_variable := ^p_table_variables^ [table_variable_index];
          p_form_variable_definition := ^p_form_variable_definitions^ [p_table_variable^.variable_index];

          IF p_form_variable_definition^.name = name THEN
            name_exists := TRUE;
            IF (occurrence > p_form_table_definition^.stored_occurrence) OR (occurrence < 1) THEN
              osp$set_status_condition (fde$unknown_occurrence, status);
              osp$append_status_integer (osc$status_parameter_delimiter, $INTEGER (occurrence), 10, FALSE,
                    status);
              osp$append_status_parameter (osc$status_parameter_delimiter, name, status);
              osp$append_status_parameter (osc$status_parameter_delimiter,
                    p_form_status^.p_form_definition^.form_name, status);
              RETURN;
            IFEND;

            p_table_objects := fdp$ptr_table_objects (p_table_variable^.table_objects, p_form_module);
            p_table_object := ^p_table_objects^ [occurrence];
            program_record_position := p_table_object^.program_record_position;
            screen_record_position := p_table_object^.screen_record_position;
            first_displayed_occurrence := p_form_table_statuses^ [table_index].first_displayed_occurrence;
            object_index := p_table_objects^ [occurrence].object_index;
            IF (p_form_status^.displayed_on_screen AND (p_form_status^.added OR p_form_status^.combined)) THEN
              IF ((first_displayed_occurrence + p_form_table_definition^.visible_occurrence - 1) >=
                    occurrence) AND (first_displayed_occurrence <= occurrence) THEN
                object_exists := TRUE;
              IFEND;
            IFEND;
            RETURN;

          IFEND;
        FOREND;

      = fdc$record_variable =
        p_form_variable_definition := ^p_form_variable_definitions^
              [p_variable_record_definition^.variable_index];
        IF p_form_variable_definition^.name = name THEN
          name_exists := TRUE;
          IF occurrence <> 1 THEN
            osp$set_status_abnormal (fdc$format_display_identifier, fde$unknown_occurrence, '', status);
            osp$append_status_integer (osc$status_parameter_delimiter, $INTEGER (occurrence), 10, FALSE,
                  status);
            osp$append_status_parameter (osc$status_parameter_delimiter, name, status);
            osp$append_status_parameter (osc$status_parameter_delimiter,
                  p_form_status^.p_form_definition^.form_name, status);
            RETURN;
          IFEND;

          program_record_position := p_form_variable_definition^.program_record_position;
          screen_record_position := p_form_variable_definition^.screen_record_position;
          object_index := p_form_variable_definition^.object_index;
          IF (p_form_status^.displayed_on_screen AND (p_form_status^.added OR p_form_status^.combined)) THEN
            object_exists := TRUE;
          IFEND;
          RETURN;
        IFEND;

      ELSE

{ Invalid record definition key.

        osp$set_status_abnormal (fdc$format_display_identifier, fde$system_error, 'invalid record definition',
              status);
        RETURN;
      CASEND;
    FOREND;

    IF name_exists THEN
      osp$set_status_abnormal (fdc$format_display_identifier, fde$unknown_occurrence, '', status);
      osp$append_status_integer (osc$status_parameter_delimiter, $INTEGER (occurrence), 10, FALSE, status);
      osp$append_status_parameter (osc$status_parameter_delimiter, name, status);
      osp$append_status_parameter (osc$status_parameter_delimiter,
            p_form_status^.p_form_definition^.form_name, status);

    ELSE

{ Variable name does not exist.

      osp$set_status_abnormal (fdc$format_display_identifier, fde$unknown_variable_name, '', status);
      osp$append_status_parameter (osc$status_parameter_delimiter, name, status);
      osp$append_status_parameter (osc$status_parameter_delimiter,
            p_form_status^.p_form_definition^.form_name, status);
    IFEND;
  PROCEND find_record_variable;


?? TITLE := 'record_attribute_change', EJECT ??
  PROCEDURE record_attribute_change
    (    form_identifier: fdt$form_identifier;
         object_index: fdt$object_index;
         new_display_attribute_set: fdt$display_attribute_set;
         old_display_attribute_set: fdt$display_attribute_set;
     VAR status: ost$status);

     VAR
       screen_change: fdt$screen_change;

     status.normal := TRUE;
     IF old_display_attribute_set = new_display_attribute_set THEN
       RETURN;
     IFEND;

     screen_change.key := fdc$set_attribute;
     screen_change.attribute_form_identifier := form_identifier;
     screen_change.attribute_object_index := object_index;
     screen_change.attribute := new_display_attribute_set;
     fdp$record_screen_change (screen_change, status);

  PROCEND record_attribute_change;

?? TITLE := 'record_value_change', EJECT ??
  PROCEDURE record_value_change
    (    form_identifier: fdt$form_identifier;
         object_index: fdt$object_index;
         p_text: ^fdt$text;
         p_form_object_statuses: ^array [1 .. *] of fdt$form_object_status;
     VAR status: ost$status);

     VAR
       screen_change: fdt$screen_change;

     status.normal := TRUE;
     IF p_form_object_statuses^ [object_index].character_position = 1 THEN
       RETURN;
     IFEND;

     screen_change.key := fdc$replace_variable;
     screen_change.variable_form_identifier := form_identifier;
     screen_change.variable_object_index := object_index;
     screen_change.p_text := p_text;
     fdp$record_screen_change (screen_change, status);

  PROCEND record_value_change;

?? OLDTITLE ??
?? NEWTITLE := 'replace_variable', EJECT ??

{ PURPOSE:
{   This procedure validates and replaces values supplied by the application for
{   Screen Formatting variables.  The program and screen records are updated
{   according to the results of the validation.

  PROCEDURE replace_variable
    (    p_form_status: ^fdt$form_status;
         form_identifier: fdt$form_identifier;
         new_value: fdt$variable_value;
         p_form_variable_definition: ^fdt$form_variable_definition;
         object_index: fdt$object_index;
         update_screen: boolean;
         program_record_position: fdt$record_position;
         screen_record_position: fdt$record_position;
     VAR variable_status: fdt$variable_status;
     VAR status: ost$status);

    VAR
      error: mlt$error,
      p_form_object_status: ^fdt$form_object_status,
      p_screen_variable: ^fdt$text,
      p_valid_string: ^fdt$valid_string,
      record_screen_change: boolean,
      screen_change: fdt$screen_change;

?? NEWTITLE := 'process_character_type', EJECT ??

    PROCEDURE process_character_type;

      fdp$validate_string (new_value.p_text, new_value.text_length,
            p_form_variable_definition^.valid_strings,
            p_form_status, p_valid_string, variable_status);
      IF variable_status <> fdc$no_error THEN
        IF fdc$must_enter IN p_form_variable_definition^.terminal_user_entry THEN
          p_form_object_status^.user_entered_field := FALSE;
          variable_status := fdc$no_error;
        ELSE
          RETURN;
        IFEND;
      IFEND;

      fdp$convert_to_screen_variable (p_form_variable_definition^.program_data_type, new_value.p_text,
            new_value.text_length, p_form_variable_definition^.output_format,
            p_screen_variable, p_form_variable_definition^.screen_variable_length,
            variable_status, status);
      IF NOT status.normal THEN
        EXIT replace_variable;
      IFEND;
      IF variable_status <> fdc$no_error THEN
        RETURN;
      IFEND;
      mlp$move_bytes (new_value.p_text, new_value.text_length, ^p_form_status^.p_program_record^
            [program_record_position], p_form_variable_definition^.program_variable_length, error);

    PROCEND process_character_type;

?? OLDTITLE, EJECT ??
?? NEWTITLE := 'process_cobol_type', EJECT ??

    PROCEDURE process_cobol_type;

      fdp$validate_cobol_data (p_form_status, p_form_variable_definition,
            new_value.p_cobol_data, p_valid_string, variable_status);
      IF variable_status <> fdc$no_error THEN
        IF fdc$must_enter IN p_form_variable_definition^.terminal_user_entry THEN
          p_form_object_status^.user_entered_field := FALSE;
          variable_status := fdc$no_error;
        ELSE
          RETURN;
        IFEND;
      IFEND;

      fdp$move_to_screen_variable (p_form_status, p_form_variable_definition,
            new_value.p_cobol_data, p_screen_variable, variable_status, status);
      IF NOT status.normal THEN
        EXIT replace_variable;
      IFEND;

      IF variable_status <> fdc$no_error THEN
        RETURN;
      IFEND;

      mlp$move_bytes (new_value.p_cobol_data, new_value.text_length, ^p_form_status^.p_program_record^
            [program_record_position], p_form_variable_definition^.program_variable_length, error);

    PROCEND process_cobol_type;

?? OLDTITLE, EJECT ??
?? NEWTITLE := 'process_integer_type', EJECT ??

    PROCEDURE process_integer_type;

      VAR
        ignore_date_time: clt$date_time;


      IF fdp$date_variable(p_form_variable_definition) THEN
        fdp$convert_yymmdd_to_date_time (new_value.integer_value, ignore_date_time, variable_status);
      ELSE
      fdp$validate_integer (new_value.integer_value,
            p_form_variable_definition^.valid_integer_ranges, p_form_status, variable_status);
      IFEND;
      IF variable_status <> fdc$no_error THEN
        IF fdc$must_enter IN p_form_variable_definition^.terminal_user_entry THEN
          p_form_object_status^.user_entered_field := FALSE;
          variable_status := fdc$no_error;
        ELSE
          RETURN;
        IFEND;
      IFEND;

      fdp$convert_to_screen_variable (p_form_variable_definition^.program_data_type, ^new_value.integer_value,
            p_form_variable_definition^.program_variable_length, p_form_variable_definition^.output_format,
            p_screen_variable, p_form_variable_definition^.screen_variable_length,
            variable_status, status);
      IF NOT status.normal THEN
        EXIT replace_variable;
      IFEND;
      IF variable_status <> fdc$no_error THEN
        RETURN;
      IFEND;

      i#move (^new_value.integer_value, ^p_form_status^.p_program_record^ [program_record_position],
            fdc$integer_length);

    PROCEND process_integer_type;

?? OLDTITLE, EJECT ??
?? NEWTITLE := 'process_real_type', EJECT ??

    PROCEDURE process_real_type;

      fdp$validate_real (new_value.real_value, p_form_variable_definition^.valid_real_ranges,
            p_form_status, variable_status);
      IF variable_status <> fdc$no_error THEN
        IF fdc$must_enter IN p_form_variable_definition^.terminal_user_entry THEN
          p_form_object_status^.user_entered_field := FALSE;
          variable_status := fdc$no_error;
        ELSE
          RETURN;
        IFEND;
      IFEND;

      fdp$convert_to_screen_variable (p_form_variable_definition^.program_data_type, ^new_value.real_value,
            p_form_variable_definition^.program_variable_length, p_form_variable_definition^.output_format,
            p_screen_variable, p_form_variable_definition^.screen_variable_length,
            variable_status, status);
      IF NOT status.normal THEN
        EXIT replace_variable;
      IFEND;
      IF variable_status <> fdc$no_error THEN
        RETURN;
      IFEND;

      i#move (^new_value.real_value, ^p_form_status^.p_program_record^ [program_record_position],
            fdc$real_length);

    PROCEND process_real_type;
?? OLDTITLE, EJECT ??
?? NEWTITLE := 'process_upper_case_type', EJECT ??

    PROCEDURE process_upper_case_type;

      fdp$validate_string (new_value.p_text, new_value.text_length,
              p_form_variable_definition^.valid_strings,
              p_form_status, p_valid_string, variable_status);
      IF variable_status <> fdc$no_error THEN
        IF fdc$must_enter IN p_form_variable_definition^.terminal_user_entry THEN
          p_form_object_status^.user_entered_field := FALSE;
          variable_status := fdc$no_error;
        ELSE
          RETURN;
        IFEND;
      IFEND;

      fdp$convert_to_screen_variable (p_form_variable_definition^.program_data_type, new_value.p_text,
            new_value.text_length, p_form_variable_definition^.output_format,
            p_screen_variable, p_form_variable_definition^.screen_variable_length,
            variable_status, status);
      IF NOT status.normal THEN
        EXIT replace_variable;
      IFEND;
      IF variable_status <> fdc$no_error THEN
        RETURN;
      IFEND;

{ The program data must be translated to uppercase, so that if the terminal
{ user does not enter any data the program will get the data in upper case.

      mlp$translate_bytes (new_value.p_text, new_value.text_length, ^p_form_status^.
            p_program_record^ [program_record_position],
            p_form_variable_definition^.program_variable_length, ^osv$lower_to_upper, error);

    PROCEND process_upper_case_type;

?? OLDTITLE, EJECT ??

    p_form_object_status := ^p_form_status^.p_form_object_statuses^ [object_index];
    p_form_object_status^.variable_input_status := fdc$no_error;
    fdp$ptr_screen_variable (p_form_status^.p_screen_record, screen_record_position,
          p_form_variable_definition^.screen_variable_length, p_screen_variable);

    CASE p_form_variable_definition^.program_data_type OF

    = fdc$program_character_type =
      process_character_type;

    = fdc$program_cobol_type =
      process_cobol_type;

    = fdc$program_integer_type =
      process_integer_type;

    = fdc$program_real_type =
      process_real_type;

    = fdc$program_upper_case_type =
      process_upper_case_type;

    ELSE

{ Invalid program data type.

      osp$set_status_abnormal (fdc$format_display_identifier, fde$program_data_type, '', status);
      RETURN;
    CASEND;

    record_screen_change := update_screen;
    IF variable_status <> fdc$no_error THEN

{ The invalid data character must be substituted even if the field is not currently visible.  Subsequent
{ updates may cause the field to be displayed before the error is corrected.

      display_invalid_data_character (p_form_status, p_form_variable_definition^.screen_variable_length,
            record_screen_change, p_screen_variable^);
    IFEND;

    IF record_screen_change THEN
      screen_change.key := fdc$replace_variable;
      screen_change.variable_form_identifier := form_identifier;
      screen_change.variable_object_index := object_index;
      screen_change.p_text := p_screen_variable;
      fdp$record_screen_change (screen_change, status);
    IFEND;

  PROCEND replace_variable;
?? TITLE := 'update_form_priorities', EJECT ??

  PROCEDURE [INLINE] update_form_priorities
    (    p_form_status: ^fdt$form_status);

    IF p_form_status^.next_higher_form <> 0 THEN
      fdv$screen_status.p_forms_status^ [p_form_status^.next_higher_form].next_lower_form :=
            p_form_status^.next_lower_form;

    ELSE

{ The highest priority form is being deleted.
{ Update pointer to highest priority form.

      fdv$screen_status.current_form_identifier := p_form_status^.next_lower_form;
    IFEND;
    IF p_form_status^.next_lower_form <> 0 THEN
      fdv$screen_status.p_forms_status^ [p_form_status^.next_lower_form].next_higher_form :=
            p_form_status^.next_higher_form;
    IFEND;
  PROCEND update_form_priorities;

MODEND fdm$process_program_requests;
