?? RIGHT := 110 ??
?? NEWTITLE := 'Manage Forms' ??
MODULE fdm$manage_forms;
?? NEWTITLE := '  Type and procedure declarations' ??

?? PUSH (LISTEXT := ON) ??
*copyc ost$status
*copyc fdc$maximum_x_position
*copyc fde$condition_identifiers
*copyc fdt$form_identifier
*copyc fdt$form_names
*copyc fdt$number_names
*copyc fdt$screen_variable_length
*copyc fdt$table_index
*copyc fdt$table_variable_index
*copyc fdt$variable_index
*copyc ost$name
*copyc ost$stack_frame_save_area
*copyc ost$status
?? POP ??

*copyc fdv$to_cobol
*copyc fdv$to_scl

*copyc clp$begin_utility
*copyc clp$create_procedure_variable
*copyc clp$delete_variable
*copyc clp$derive_type_spec_from_value
*copyc clp$end_include
*copyc clp$end_utility
*copyc clp$evaluate_parameters
*copyc clp$include_file
*copyc clp$make_boolean_value
*copyc clp$make_integer_value
*copyc clp$make_keyword_value
*copyc clp$make_name_value
*copyc clp$get_variable
*copyc clp$trimmed_string_size
*copyc clp$change_variable
*copyc fdp$add_form
*copyc fdp$change_table_size
*copyc fdp$close_form
*copyc fdp$combine_form
*copyc fdp$delete_form
*copyc fdp$get_form_attributes
*copyc fdp$get_form_names
*copyc fdp$get_integer_variable
*copyc fdp$get_next_event
*copyc fdp$get_next_changed_variable
*copyc fdp$get_next_input_error
*copyc fdp$get_next_output_error
*copyc fdp$get_number_of_occurrences
*copyc fdp$get_real_variable
*copyc fdp$get_screen_variable
*copyc fdp$get_string_variable
*copyc fdp$get_table_attributes
*copyc fdp$get_variable_attributes
*copyc fdp$open_form
*copyc fdp$pop_forms
*copyc fdp$position_form
*copyc fdp$push_forms
*copyc fdp$read_forms
*copyc fdp$replace_integer_variable
*copyc fdp$replace_real_variable
*copyc fdp$replace_string_variable
*copyc fdp$reset_form
*copyc fdp$reset_object_attribute
*copyc fdp$set_cursor_position
*copyc fdp$set_object_attribute
*copyc fdp$show_forms
*copyc fdp$tab_to_next_field
*copyc i#current_sequence_position
*copyc mlp$input_floating_number
*copyc mmp$create_scratch_segment
*copyc osp$append_status_parameter
*copyc osp$set_status_abnormal

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


  CONST
    fdc$real_number_of_digits = 14;

  TYPE
    fdt$event = record
      event_name: ost$name,
      normal: boolean,
      position: fdt$event_position,
    recend,

    fdt$form_information = record
      added: boolean,
      form_identifier: fdt$form_identifier,
      form_processor: fdt$form_processor,
      form_variable_created: boolean,
      name: ost$name,
      number_of_fields: integer,
      p_tables: ^array [1 .. * ] of fdt$table_information,
      p_variables: ^array [1 .. * ] of fdt$variable_information,
      push_index: 0 .. fdc$maximum_form_identifier,
    recend,

    fdt$scl_variable_reference = string (128),

    fdt$table_information = record
      name: ost$name,
      occurrence: fdt$occurrence,
      p_table_variables: ^array [1 .. * ] of fdt$table_variable_information,
    recend,

    fdt$table_variable_information = record
      p_variable_information: ^fdt$variable_information,
    recend,

    fdt$variable_information = record
      created: boolean,
      name: ost$name,
      occurrence: fdt$occurrence,
      program_data_type: fdt$program_data_type,
      table_member: boolean,
      variable_length: fdt$variable_length,
    recend,

    fdt$variable_creation = (fdc$form_variable, fdc$single, fdc$none),
    fdt$variable_evaluation = (fdc$automatic, fdc$manual);

  VAR
    fdv$event: fdt$event,
    fdv$form_index: fdt$form_identifier,
    fdv$p_form_list: ^array [1 .. * ] of fdt$form_information := NIL,
    fdv$high_form_index: 0 .. fdc$maximum_form_identifier := 0,
    fdv$push_index: 0 .. fdc$maximum_form_identifier := 0,
    fdv$real_type_qualifier: [READ, STATIC] clt$real_type_qualifier :=
          [[{-$INFINITY} 3, [[0D000(16), 0(16)], [0D000(16), 0(16)]]],
          [{$INFINITY} 3, [[5000(16), 0(16)], [5000(16), 0(16)]]]],
    fdv$utility_name: [STATIC] ost$name := 'MANAGE_FORM',
    fdv$variable_creation: fdt$variable_creation,
    fdv$variable_evaluation: fdt$variable_evaluation,
    fdv$work_area: amt$segment_pointer;

?? TITLE := '  Task command and function lists', EJECT ??

  SECTION
    fds$sub_commands_and_functions: READ;

  {Read-only sub-command and function list for SCL}

{ table fdv$sub_commands t=c sn=fds$sub_commands_and_functions s=local
{ command (add_form                       ,addf) fdp$_add_form cm=local
{ command (change_table_size              ,chats) fdp$_change_table_size ..
{   cm=local
{ command (close_form                     ,clof) fdp$_close_form cm=local
{ command (combine_form, combine_forms    ,comf) fdp$_combine_form cm=local
{ command (create_form_module             ,crefm) fdp$_create_form_module   ..
{                   cm=xref
{ command (delete_form                    ,delf) fdp$_delete_form cm=local
{ command (get_form_variable, get_form_variables, getfv) ..
{   fdp$_get_form_variable cm =   local
{ command (get_next_changed_variable      ,getncv) ..
{   fdp$_get_next_changed_variable cm=local a=hidden
{ command (get_next_input_error           ,getnie) ..
{   fdp$_get_next_input_error cm=local a=hidden
{ command (get_next_output_error          ,getnoe) ..
{   fdp$_get_next_output_error cm=local a=hidden
{ command (open_form                      ,opef) fdp$_open_form cm=local
{ command (pop_form, pop_forms            ,popf) fdp$_pop_forms cm=local
{ command (position_form                  ,posf) fdp$_position_form cm=local
{ command (push_form, push_forms          ,pusf) fdp$_push_forms cm=local
{ command (quit                           ,qui) fdp$_quit cm=local
{ command (read_form, read_forms          ,reaf) fdp$_read_forms cm=local
{ command (replace_form_variable, replace_form_variables, repfv) ..
{   fdp$_replace_form_variable     cm=local
{ command (reset_form                     ,resf) fdp$_reset_form cm=local
{ command (set_cursor_position            ,setcp) fdp$_set_cursor_position  ..
{   cm=local
{ command (set_object_attribute, set_object_attributes         ,setoa) ..
{   fdp$_set_object_attribute cm=local
{ command (show_form, show_forms          ,shof) fdp$_show_forms cm=local
{ command (tab_to_next_field              ,tabtnf) fdp$_tab_to_next_field ..
{   cm=local a=hidden
{ tablend

?? PUSH (LISTEXT := ON) ??

VAR
  fdv$sub_commands: [STATIC, READ, fds$sub_commands_and_functions]
      ^clt$command_table := ^fdv$sub_commands_entries,

  fdv$sub_commands_entries: [STATIC, READ,
      fds$sub_commands_and_functions] array [1 .. 52] of
      clt$command_table_entry := [
  {} ['ADDF                           ', clc$abbreviation_entry,
        clc$normal_usage_entry, 1, clc$automatically_log, clc$linked_call,
        ^fdp$_add_form],
  {} ['ADD_FORM                       ', clc$nominal_entry,
        clc$normal_usage_entry, 1, clc$automatically_log, clc$linked_call,
        ^fdp$_add_form],
  {} ['CHANGE_TABLE_SIZE              ', clc$nominal_entry,
        clc$normal_usage_entry, 2, clc$automatically_log, clc$linked_call,
        ^fdp$_change_table_size],
  {} ['CHATS                          ', clc$abbreviation_entry,
        clc$normal_usage_entry, 2, clc$automatically_log, clc$linked_call,
        ^fdp$_change_table_size],
  {} ['CLOF                           ', clc$abbreviation_entry,
        clc$normal_usage_entry, 3, clc$automatically_log, clc$linked_call,
        ^fdp$_close_form],
  {} ['CLOSE_FORM                     ', clc$nominal_entry,
        clc$normal_usage_entry, 3, clc$automatically_log, clc$linked_call,
        ^fdp$_close_form],
  {} ['COMBINE_FORM                   ', clc$nominal_entry,
        clc$normal_usage_entry, 4, clc$automatically_log, clc$linked_call,
        ^fdp$_combine_form],
  {} ['COMBINE_FORMS                  ', clc$alias_entry,
        clc$normal_usage_entry, 4, clc$automatically_log, clc$linked_call,
        ^fdp$_combine_form],
  {} ['COMF                           ', clc$abbreviation_entry,
        clc$normal_usage_entry, 4, clc$automatically_log, clc$linked_call,
        ^fdp$_combine_form],
  {} ['CREATE_FORM_MODULE             ', clc$nominal_entry,
        clc$normal_usage_entry, 5, clc$automatically_log, clc$linked_call,
        ^fdp$_create_form_module],
  {} ['CREFM                          ', clc$abbreviation_entry,
        clc$normal_usage_entry, 5, clc$automatically_log, clc$linked_call,
        ^fdp$_create_form_module],
  {} ['DELETE_FORM                    ', clc$nominal_entry,
        clc$normal_usage_entry, 6, clc$automatically_log, clc$linked_call,
        ^fdp$_delete_form],
  {} ['DELF                           ', clc$abbreviation_entry,
        clc$normal_usage_entry, 6, clc$automatically_log, clc$linked_call,
        ^fdp$_delete_form],
  {} ['GETFV                          ', clc$abbreviation_entry,
        clc$normal_usage_entry, 7, clc$automatically_log, clc$linked_call,
        ^fdp$_get_form_variable],
  {} ['GETNCV                         ', clc$abbreviation_entry,
        clc$hidden_entry, 8, clc$automatically_log, clc$linked_call,
        ^fdp$_get_next_changed_variable],
  {} ['GETNIE                         ', clc$abbreviation_entry,
        clc$hidden_entry, 9, clc$automatically_log, clc$linked_call,
        ^fdp$_get_next_input_error],
  {} ['GETNOE                         ', clc$abbreviation_entry,
        clc$hidden_entry, 10, clc$automatically_log, clc$linked_call,
        ^fdp$_get_next_output_error],
  {} ['GET_FORM_VARIABLE              ', clc$nominal_entry,
        clc$normal_usage_entry, 7, clc$automatically_log, clc$linked_call,
        ^fdp$_get_form_variable],
  {} ['GET_FORM_VARIABLES             ', clc$alias_entry,
        clc$normal_usage_entry, 7, clc$automatically_log, clc$linked_call,
        ^fdp$_get_form_variable],
  {} ['GET_NEXT_CHANGED_VARIABLE      ', clc$nominal_entry,
        clc$hidden_entry, 8, clc$automatically_log, clc$linked_call,
        ^fdp$_get_next_changed_variable],
  {} ['GET_NEXT_INPUT_ERROR           ', clc$nominal_entry,
        clc$hidden_entry, 9, clc$automatically_log, clc$linked_call,
        ^fdp$_get_next_input_error],
  {} ['GET_NEXT_OUTPUT_ERROR          ', clc$nominal_entry,
        clc$hidden_entry, 10, clc$automatically_log, clc$linked_call,
        ^fdp$_get_next_output_error],
  {} ['OPEF                           ', clc$abbreviation_entry,
        clc$normal_usage_entry, 11, clc$automatically_log, clc$linked_call,
        ^fdp$_open_form],
  {} ['OPEN_FORM                      ', clc$nominal_entry,
        clc$normal_usage_entry, 11, clc$automatically_log, clc$linked_call,
        ^fdp$_open_form],
  {} ['POPF                           ', clc$abbreviation_entry,
        clc$normal_usage_entry, 12, clc$automatically_log, clc$linked_call,
        ^fdp$_pop_forms],
  {} ['POP_FORM                       ', clc$nominal_entry,
        clc$normal_usage_entry, 12, clc$automatically_log, clc$linked_call,
        ^fdp$_pop_forms],
  {} ['POP_FORMS                      ', clc$alias_entry,
        clc$normal_usage_entry, 12, clc$automatically_log, clc$linked_call,
        ^fdp$_pop_forms],
  {} ['POSF                           ', clc$abbreviation_entry,
        clc$normal_usage_entry, 13, clc$automatically_log, clc$linked_call,
        ^fdp$_position_form],
  {} ['POSITION_FORM                  ', clc$nominal_entry,
        clc$normal_usage_entry, 13, clc$automatically_log, clc$linked_call,
        ^fdp$_position_form],
  {} ['PUSF                           ', clc$abbreviation_entry,
        clc$normal_usage_entry, 14, clc$automatically_log, clc$linked_call,
        ^fdp$_push_forms],
  {} ['PUSH_FORM                      ', clc$nominal_entry,
        clc$normal_usage_entry, 14, clc$automatically_log, clc$linked_call,
        ^fdp$_push_forms],
  {} ['PUSH_FORMS                     ', clc$alias_entry,
        clc$normal_usage_entry, 14, clc$automatically_log, clc$linked_call,
        ^fdp$_push_forms],
  {} ['QUI                            ', clc$abbreviation_entry,
        clc$normal_usage_entry, 15, clc$automatically_log, clc$linked_call,
        ^fdp$_quit],
  {} ['QUIT                           ', clc$nominal_entry,
        clc$normal_usage_entry, 15, clc$automatically_log, clc$linked_call,
        ^fdp$_quit],
  {} ['READ_FORM                      ', clc$nominal_entry,
        clc$normal_usage_entry, 16, clc$automatically_log, clc$linked_call,
        ^fdp$_read_forms],
  {} ['READ_FORMS                     ', clc$alias_entry,
        clc$normal_usage_entry, 16, clc$automatically_log, clc$linked_call,
        ^fdp$_read_forms],
  {} ['REAF                           ', clc$abbreviation_entry,
        clc$normal_usage_entry, 16, clc$automatically_log, clc$linked_call,
        ^fdp$_read_forms],
  {} ['REPFV                          ', clc$abbreviation_entry,
        clc$normal_usage_entry, 17, clc$automatically_log, clc$linked_call,
        ^fdp$_replace_form_variable],
  {} ['REPLACE_FORM_VARIABLE          ', clc$nominal_entry,
        clc$normal_usage_entry, 17, clc$automatically_log, clc$linked_call,
        ^fdp$_replace_form_variable],
  {} ['REPLACE_FORM_VARIABLES         ', clc$alias_entry,
        clc$normal_usage_entry, 17, clc$automatically_log, clc$linked_call,
        ^fdp$_replace_form_variable],
  {} ['RESET_FORM                     ', clc$nominal_entry,
        clc$normal_usage_entry, 18, clc$automatically_log, clc$linked_call,
        ^fdp$_reset_form],
  {} ['RESF                           ', clc$abbreviation_entry,
        clc$normal_usage_entry, 18, clc$automatically_log, clc$linked_call,
        ^fdp$_reset_form],
  {} ['SETCP                          ', clc$abbreviation_entry,
        clc$normal_usage_entry, 19, clc$automatically_log, clc$linked_call,
        ^fdp$_set_cursor_position],
  {} ['SETOA                          ', clc$abbreviation_entry,
        clc$normal_usage_entry, 20, clc$automatically_log, clc$linked_call,
        ^fdp$_set_object_attribute],
  {} ['SET_CURSOR_POSITION            ', clc$nominal_entry,
        clc$normal_usage_entry, 19, clc$automatically_log, clc$linked_call,
        ^fdp$_set_cursor_position],
  {} ['SET_OBJECT_ATTRIBUTE           ', clc$nominal_entry,
        clc$normal_usage_entry, 20, clc$automatically_log, clc$linked_call,
        ^fdp$_set_object_attribute],
  {} ['SET_OBJECT_ATTRIBUTES          ', clc$alias_entry,
        clc$normal_usage_entry, 20, clc$automatically_log, clc$linked_call,
        ^fdp$_set_object_attribute],
  {} ['SHOF                           ', clc$abbreviation_entry,
        clc$normal_usage_entry, 21, clc$automatically_log, clc$linked_call,
        ^fdp$_show_forms],
  {} ['SHOW_FORM                      ', clc$nominal_entry,
        clc$normal_usage_entry, 21, clc$automatically_log, clc$linked_call,
        ^fdp$_show_forms],
  {} ['SHOW_FORMS                     ', clc$alias_entry,
        clc$normal_usage_entry, 21, clc$automatically_log, clc$linked_call,
        ^fdp$_show_forms],
  {} ['TABTNF                         ', clc$abbreviation_entry,
        clc$hidden_entry, 22, clc$automatically_log, clc$linked_call,
        ^fdp$_tab_to_next_field],
  {} ['TAB_TO_NEXT_FIELD              ', clc$nominal_entry,
        clc$hidden_entry, 22, clc$automatically_log, clc$linked_call,
        ^fdp$_tab_to_next_field]];

  PROCEDURE [XREF] fdp$_create_form_module
    (    parameter_list: clt$parameter_list;
     VAR status: ost$status);

?? POP ??

{ table fdv$functions t=f sn=fds$sub_commands_and_functions s=local
{ function $event_name                    fdp$$event_name cm=local
{ function $event_normal                  fdp$$event_normal cm=local
{ function $event_position                fdp$$event_position cm=local
{ tablend

?? PUSH (LISTEXT := ON) ??

  VAR
    fdv$functions: [STATIC, READ, fds$sub_commands_and_functions]
          ^clt$function_processor_table := ^fdv$functions_entries,

    fdv$functions_entries: [STATIC, READ, fds$sub_commands_and_functions]
          array [1 .. 3] of clt$function_proc_table_entry := [
          {} ['$EVENT_NAME                    ', clc$nominal_entry,
          clc$normal_usage_entry, 1, clc$linked_call, ^fdp$$event_name],
          {} ['$EVENT_NORMAL                  ', clc$nominal_entry,
          clc$normal_usage_entry, 2, clc$linked_call, ^fdp$$event_normal],
          {} ['$EVENT_POSITION                ', clc$nominal_entry,
          clc$normal_usage_entry, 3, clc$linked_call, ^fdp$$event_position]];

?? POP ??

?? TITLE := '  [XDCL] fdp$_manage_forms', EJECT ??

  PROCEDURE [XDCL] fdp$_manage_forms
    (    parameter_list: clt$parameter_list;
     VAR status: ost$status);

{ PROCEDURE (fdm$manf) manage_form, manage_forms (
{   variable_creation, vc: key
{       form_variable, single, none
{     keyend = form_variable
{   variable_evaluation, ve: key
{       automatic, manual
{     keyend = manual
{   status)

?? PUSH (LISTEXT := ON) ??

  VAR
    pdt: [STATIC, READ, cls$declaration_section] record
      header: clt$pdt_header,
      names: array [1 .. 5] of clt$pdt_parameter_name,
      parameters: array [1 .. 3] of clt$pdt_parameter,
      type1: record
        header: clt$type_specification_header,
        qualifier: clt$keyword_type_qualifier,
        keyword_specs: array [1 .. 3] of clt$keyword_specification,
        default_value: string (13),
      recend,
      type2: record
        header: clt$type_specification_header,
        qualifier: clt$keyword_type_qualifier,
        keyword_specs: array [1 .. 2] of clt$keyword_specification,
        default_value: string (6),
      recend,
      type3: record
        header: clt$type_specification_header,
      recend,
    recend := [
    [1,
    [88, 9, 27, 13, 7, 51, 256],
    clc$command, 5, 3, 0, 0, 0, 0, 3, 'FDM$MANF'], [
    ['STATUS                         ',clc$nominal_entry, 3],
    ['VARIABLE_CREATION              ',clc$nominal_entry, 1],
    ['VARIABLE_EVALUATION            ',clc$nominal_entry, 2],
    ['VC                             ',clc$abbreviation_entry, 1],
    ['VE                             ',clc$abbreviation_entry, 2]],
    [
{ PARAMETER 1
    [2, clc$normal_usage_entry, clc$non_secure_parameter,
    $clt$parameter_spec_methods[clc$specify_by_name, clc$specify_positionally],
    clc$pass_by_value, clc$immediate_evaluation, clc$standard_parameter_checking, 118,
  clc$optional_default_parameter, 0, 13],
{ PARAMETER 2
    [3, clc$normal_usage_entry, clc$non_secure_parameter,
    $clt$parameter_spec_methods[clc$specify_by_name, clc$specify_positionally],
    clc$pass_by_value, clc$immediate_evaluation, clc$standard_parameter_checking, 81,
  clc$optional_default_parameter, 0, 6],
{ PARAMETER 3
    [1, clc$normal_usage_entry, clc$non_secure_parameter,
    $clt$parameter_spec_methods[clc$specify_by_name],
    clc$pass_by_reference, clc$immediate_evaluation, clc$standard_parameter_checking, 3,
  clc$optional_parameter, 0, 0]],
{ PARAMETER 1
    [[1, 0, clc$keyword_type], [3], [
    ['FORM_VARIABLE                  ', clc$nominal_entry, clc$normal_usage_entry, 1],
    ['NONE                           ', clc$nominal_entry, clc$normal_usage_entry, 3],
    ['SINGLE                         ', clc$nominal_entry, clc$normal_usage_entry, 2]]
    ,
    'form_variable'],
{ PARAMETER 2
    [[1, 0, clc$keyword_type], [2], [
    ['AUTOMATIC                      ', clc$nominal_entry, clc$normal_usage_entry, 1],
    ['MANUAL                         ', clc$nominal_entry, clc$normal_usage_entry, 2]]
    ,
    'manual'],
{ PARAMETER 3
    [[1, 0, clc$status_type]]];

?? POP ??

  CONST
    p$variable_creation = 1,
    p$variable_evaluation = 2,
    p$status = 3;

  VAR
    pvt: array [1 .. 3] of clt$parameter_value;

    VAR
      local_status: ost$status,
      prompt_string: string (3),
      utility_attributes: array [1 .. 6] of clt$utility_attribute;

    clp$evaluate_parameters (parameter_list, #SEQ (pdt), NIL, ^pvt, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    status.normal := TRUE;
    prompt_string := 'mf';
    IF pvt [p$variable_evaluation].value^.keyword_value = 'MANUAL' THEN
      fdv$variable_evaluation := fdc$manual;
    ELSE
      fdv$variable_evaluation := fdc$automatic;
    IFEND;

    IF pvt [p$variable_creation].value^.keyword_value = 'FORM_VARIABLE' THEN
      fdv$variable_creation := fdc$form_variable;
    ELSEIF pvt [p$variable_creation].value^.keyword_value = 'SINGLE' THEN
      fdv$variable_creation := fdc$single;
    ELSE
      fdv$variable_creation := fdc$none;
    IFEND;


{ Command language procedures need a unknown amount of storage to do their
{ work.  Use a segment to provide this storage.

    mmp$create_scratch_segment (amc$sequence_pointer, mmc$as_sequential,
          fdv$work_area, status);

    IF NOT status.normal THEN
      osp$set_status_abnormal (fdc$format_display_identifier,
            fde$no_space_available, '', status);
      RETURN;
    IFEND;

    utility_attributes [1].key := clc$utility_command_search_mode;
    utility_attributes [1].command_search_mode := clc$global_command_search;
    utility_attributes [2].key := clc$utility_command_table;
    utility_attributes [2].command_table := fdv$sub_commands;
    utility_attributes [3].key := clc$utility_function_proc_table;
    utility_attributes [3].function_processor_table := fdv$functions;
    utility_attributes [4].key := clc$utility_prompt;
    utility_attributes [4].prompt.value := prompt_string;
    utility_attributes [4].prompt.size := 2;
    utility_attributes [5].key := clc$utility_termination_command;
    utility_attributes [5].termination_command := 'quit';
    utility_attributes [6].key := clc$utility_subcmnd_log_enabled;
    utility_attributes [6].subcommand_logging_enabled := TRUE;
    clp$begin_utility (fdv$utility_name, utility_attributes, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    local_status.normal := TRUE;
    clp$include_file (clc$current_command_input, prompt_string, fdv$utility_name,
          status);

    local_status.normal := TRUE;
    clp$end_utility (fdv$utility_name, local_status);
    IF status.normal AND NOT local_status.normal THEN
      status := local_status;
    IFEND;

  PROCEND fdp$_manage_forms;
?? TITLE := '  [XDCL] fdp$_add_form', EJECT ??

  PROCEDURE [XDCL] fdp$_add_form
    (    parameter_list: clt$parameter_list;
     VAR status: ost$status);

{ PROCEDURE (fdm$manf_addf) add_form, addf (
{   form_name, fn: data_name = $required
{   status)

?? PUSH (LISTEXT := ON) ??

  VAR
    pdt: [STATIC, READ, cls$declaration_section] record
      header: clt$pdt_header,
      names: array [1 .. 3] of clt$pdt_parameter_name,
      parameters: array [1 .. 2] of clt$pdt_parameter,
      type1: record
        header: clt$type_specification_header,
      recend,
      type2: record
        header: clt$type_specification_header,
      recend,
    recend := [
    [1,
    [88, 9, 26, 16, 0, 34, 395],
    clc$command, 3, 2, 1, 0, 0, 0, 2, 'FDM$MANF_ADDF'], [
    ['FN                             ',clc$abbreviation_entry, 1],
    ['FORM_NAME                      ',clc$nominal_entry, 1],
    ['STATUS                         ',clc$nominal_entry, 2]],
    [
{ PARAMETER 1
    [2, clc$normal_usage_entry, clc$non_secure_parameter,
    $clt$parameter_spec_methods[clc$specify_by_name, clc$specify_positionally],
    clc$pass_by_value, clc$immediate_evaluation, clc$standard_parameter_checking, 3, clc$required_parameter, 0
  , 0],
{ PARAMETER 2
    [3, clc$normal_usage_entry, clc$non_secure_parameter,
    $clt$parameter_spec_methods[clc$specify_by_name],
    clc$pass_by_reference, clc$immediate_evaluation, clc$standard_parameter_checking, 3,
  clc$optional_parameter, 0, 0]],
{ PARAMETER 1
    [[1, 0, clc$data_name_type]],
{ PARAMETER 2
    [[1, 0, clc$status_type]]];

?? POP ??

  CONST
    p$form_name = 1,
    p$status = 2;

  VAR
    pvt: array [1 .. 2] of clt$parameter_value;

    VAR
      form_identifier: fdt$form_identifier;


    clp$evaluate_parameters (parameter_list, #SEQ (pdt), NIL, ^pvt, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    get_form_identifier (pvt [p$form_name].value^.data_name_value,
          form_identifier, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

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

    fdv$p_form_list^ [fdv$form_index].added := TRUE;

  PROCEND fdp$_add_form;

?? TITLE := '  [XDCL] fdp$_change_table_size', EJECT ??

  PROCEDURE [XDCL] fdp$_change_table_size
    (    parameter_list: clt$parameter_list;
     VAR status: ost$status);

{ PROCEDURE (fdm$manf_chats) change_table_size, chats (
{   form_name, fn: data_name = $required
{   table_name, tn: data_name = $required
{   table_size, ts: integer = 1
{   status)

?? PUSH (LISTEXT := ON) ??

  VAR
    pdt: [STATIC, READ, cls$declaration_section] record
      header: clt$pdt_header,
      names: array [1 .. 7] of clt$pdt_parameter_name,
      parameters: array [1 .. 4] of clt$pdt_parameter,
      type1: record
        header: clt$type_specification_header,
      recend,
      type2: record
        header: clt$type_specification_header,
      recend,
      type3: record
        header: clt$type_specification_header,
        qualifier: clt$integer_type_qualifier,
        default_value: string (1),
      recend,
      type4: record
        header: clt$type_specification_header,
      recend,
    recend := [
    [1,
    [88, 9, 26, 16, 2, 42, 774],
    clc$command, 7, 4, 2, 0, 0, 0, 4, 'FDM$MANF_CHATS'], [
    ['FN                             ',clc$abbreviation_entry, 1],
    ['FORM_NAME                      ',clc$nominal_entry, 1],
    ['STATUS                         ',clc$nominal_entry, 4],
    ['TABLE_NAME                     ',clc$nominal_entry, 2],
    ['TABLE_SIZE                     ',clc$nominal_entry, 3],
    ['TN                             ',clc$abbreviation_entry, 2],
    ['TS                             ',clc$abbreviation_entry, 3]],
    [
{ PARAMETER 1
    [2, clc$normal_usage_entry, clc$non_secure_parameter,
    $clt$parameter_spec_methods[clc$specify_by_name, clc$specify_positionally],
    clc$pass_by_value, clc$immediate_evaluation, clc$standard_parameter_checking, 3, clc$required_parameter, 0
  , 0],
{ PARAMETER 2
    [4, clc$normal_usage_entry, clc$non_secure_parameter,
    $clt$parameter_spec_methods[clc$specify_by_name, clc$specify_positionally],
    clc$pass_by_value, clc$immediate_evaluation, clc$standard_parameter_checking, 3, clc$required_parameter, 0
  , 0],
{ PARAMETER 3
    [5, clc$normal_usage_entry, clc$non_secure_parameter,
    $clt$parameter_spec_methods[clc$specify_by_name, clc$specify_positionally],
    clc$pass_by_value, clc$immediate_evaluation, clc$standard_parameter_checking, 20,
  clc$optional_default_parameter, 0, 1],
{ PARAMETER 4
    [3, clc$normal_usage_entry, clc$non_secure_parameter,
    $clt$parameter_spec_methods[clc$specify_by_name],
    clc$pass_by_reference, clc$immediate_evaluation, clc$standard_parameter_checking, 3,
  clc$optional_parameter, 0, 0]],
{ PARAMETER 1
    [[1, 0, clc$data_name_type]],
{ PARAMETER 2
    [[1, 0, clc$data_name_type]],
{ PARAMETER 3
    [[1, 0, clc$integer_type], [clc$min_integer, clc$max_integer, 10],
    '1'],
{ PARAMETER 4
    [[1, 0, clc$status_type]]];

?? POP ??

  CONST
    p$form_name = 1,
    p$table_name = 2,
    p$table_size = 3,
    p$status = 4;

  VAR
    pvt: array [1 .. 4] of clt$parameter_value;

    VAR
      form_identifier: fdt$form_identifier,
      table_name: ost$name;

    clp$evaluate_parameters (parameter_list, #SEQ (pdt), NIL, ^pvt, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    get_form_identifier (pvt [p$form_name].value^.data_name_value,
          form_identifier, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    convert_to_form_name (pvt [p$table_name].value^.data_name_value,
          fdv$p_form_list^ [fdv$form_index].form_processor, table_name);
    fdp$change_table_size (form_identifier, table_name, pvt [p$table_size].
          value^.integer_value.value, status);

  PROCEND fdp$_change_table_size;

?? TITLE := '  [XDCL] fdp$_close_form', EJECT ??

  PROCEDURE [XDCL] fdp$_close_form
    (    parameter_list: clt$parameter_list;
     VAR status: ost$status);

{ PROCEDURE (fdm$manf_clof) close_form, clof (
{   form_name, fn: data_name = $required
{   status)

?? PUSH (LISTEXT := ON) ??

  VAR
    pdt: [STATIC, READ, cls$declaration_section] record
      header: clt$pdt_header,
      names: array [1 .. 3] of clt$pdt_parameter_name,
      parameters: array [1 .. 2] of clt$pdt_parameter,
      type1: record
        header: clt$type_specification_header,
      recend,
      type2: record
        header: clt$type_specification_header,
      recend,
    recend := [
    [1,
    [88, 9, 26, 16, 7, 2, 557],
    clc$command, 3, 2, 1, 0, 0, 0, 2, 'FDM$MANF_CLOF'], [
    ['FN                             ',clc$abbreviation_entry, 1],
    ['FORM_NAME                      ',clc$nominal_entry, 1],
    ['STATUS                         ',clc$nominal_entry, 2]],
    [
{ PARAMETER 1
    [2, clc$normal_usage_entry, clc$non_secure_parameter,
    $clt$parameter_spec_methods[clc$specify_by_name, clc$specify_positionally],
    clc$pass_by_value, clc$immediate_evaluation, clc$standard_parameter_checking, 3, clc$required_parameter, 0
  , 0],
{ PARAMETER 2
    [3, clc$normal_usage_entry, clc$non_secure_parameter,
    $clt$parameter_spec_methods[clc$specify_by_name],
    clc$pass_by_reference, clc$immediate_evaluation, clc$standard_parameter_checking, 3,
  clc$optional_parameter, 0, 0]],
{ PARAMETER 1
    [[1, 0, clc$data_name_type]],
{ PARAMETER 2
    [[1, 0, clc$status_type]]];

?? POP ??

  CONST
    p$form_name = 1,
    p$status = 2;

  VAR
    pvt: array [1 .. 2] of clt$parameter_value;

    VAR
      form_identifier: fdt$form_identifier;


    clp$evaluate_parameters (parameter_list, #SEQ (pdt), NIL, ^pvt, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    get_form_identifier (pvt [p$form_name].value^.data_name_value,
          form_identifier, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

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

    delete_form_from_list (pvt [p$form_name].value^.data_name_value);

  PROCEND fdp$_close_form;

?? TITLE := '  [XDCL] fdp$_combine_form', EJECT ??

  PROCEDURE [XDCL] fdp$_combine_form
    (    parameter_list: clt$parameter_list;
     VAR status: ost$status);

{ PROCEDURE (fdm$manf_comf) combine_form, combine_forms, comf (
{   added_form_name, afn: data_name = $required
{   combine_form_name, cfn: data_name = $required
{   status)

?? PUSH (LISTEXT := ON) ??

  VAR
    pdt: [STATIC, READ, cls$declaration_section] record
      header: clt$pdt_header,
      names: array [1 .. 5] of clt$pdt_parameter_name,
      parameters: array [1 .. 3] of clt$pdt_parameter,
      type1: record
        header: clt$type_specification_header,
      recend,
      type2: record
        header: clt$type_specification_header,
      recend,
      type3: record
        header: clt$type_specification_header,
      recend,
    recend := [
    [1,
    [88, 9, 26, 16, 8, 53, 752],
    clc$command, 5, 3, 2, 0, 0, 0, 3, 'FDM$MANF_COMF'], [
    ['ADDED_FORM_NAME                ',clc$nominal_entry, 1],
    ['AFN                            ',clc$abbreviation_entry, 1],
    ['CFN                            ',clc$abbreviation_entry, 2],
    ['COMBINE_FORM_NAME              ',clc$nominal_entry, 2],
    ['STATUS                         ',clc$nominal_entry, 3]],
    [
{ PARAMETER 1
    [1, clc$normal_usage_entry, clc$non_secure_parameter,
    $clt$parameter_spec_methods[clc$specify_by_name, clc$specify_positionally],
    clc$pass_by_value, clc$immediate_evaluation, clc$standard_parameter_checking, 3, clc$required_parameter, 0
  , 0],
{ PARAMETER 2
    [4, clc$normal_usage_entry, clc$non_secure_parameter,
    $clt$parameter_spec_methods[clc$specify_by_name, clc$specify_positionally],
    clc$pass_by_value, clc$immediate_evaluation, clc$standard_parameter_checking, 3, clc$required_parameter, 0
  , 0],
{ PARAMETER 3
    [5, clc$normal_usage_entry, clc$non_secure_parameter,
    $clt$parameter_spec_methods[clc$specify_by_name],
    clc$pass_by_reference, clc$immediate_evaluation, clc$standard_parameter_checking, 3,
  clc$optional_parameter, 0, 0]],
{ PARAMETER 1
    [[1, 0, clc$data_name_type]],
{ PARAMETER 2
    [[1, 0, clc$data_name_type]],
{ PARAMETER 3
    [[1, 0, clc$status_type]]];

?? POP ??

  CONST
    p$added_form_name = 1,
    p$combine_form_name = 2,
    p$status = 3;

  VAR
    pvt: array [1 .. 3] of clt$parameter_value;

    VAR
      added_form_identifier: fdt$form_identifier,
      combine_form_identifier: fdt$form_identifier;


    clp$evaluate_parameters (parameter_list, #SEQ (pdt), NIL, ^pvt, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    get_form_identifier (pvt [p$added_form_name].value^.data_name_value,
          added_form_identifier, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    get_form_identifier (pvt [p$combine_form_name].value^.data_name_value,
          combine_form_identifier, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    fdp$combine_form (added_form_identifier, combine_form_identifier, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    fdv$p_form_list^ [fdv$form_index].added := TRUE;

  PROCEND fdp$_combine_form;

?? TITLE := '  [XDCL] fdp$_delete_form', EJECT ??

  PROCEDURE [XDCL] fdp$_delete_form
    (    parameter_list: clt$parameter_list;
     VAR status: ost$status);

{ PROCEDURE (fdm$manf_delf) delete_form, delf (
{   form_name, fn: data_name = $required
{   status)

?? PUSH (LISTEXT := ON) ??

  VAR
    pdt: [STATIC, READ, cls$declaration_section] record
      header: clt$pdt_header,
      names: array [1 .. 3] of clt$pdt_parameter_name,
      parameters: array [1 .. 2] of clt$pdt_parameter,
      type1: record
        header: clt$type_specification_header,
      recend,
      type2: record
        header: clt$type_specification_header,
      recend,
    recend := [
    [1,
    [88, 9, 26, 16, 28, 58, 72],
    clc$command, 3, 2, 1, 0, 0, 0, 2, 'FDM$MANF_DELF'], [
    ['FN                             ',clc$abbreviation_entry, 1],
    ['FORM_NAME                      ',clc$nominal_entry, 1],
    ['STATUS                         ',clc$nominal_entry, 2]],
    [
{ PARAMETER 1
    [2, clc$normal_usage_entry, clc$non_secure_parameter,
    $clt$parameter_spec_methods[clc$specify_by_name, clc$specify_positionally],
    clc$pass_by_value, clc$immediate_evaluation, clc$standard_parameter_checking, 3, clc$required_parameter, 0
  , 0],
{ PARAMETER 2
    [3, clc$normal_usage_entry, clc$non_secure_parameter,
    $clt$parameter_spec_methods[clc$specify_by_name],
    clc$pass_by_reference, clc$immediate_evaluation, clc$standard_parameter_checking, 3,
  clc$optional_parameter, 0, 0]],
{ PARAMETER 1
    [[1, 0, clc$data_name_type]],
{ PARAMETER 2
    [[1, 0, clc$status_type]]];

?? POP ??

  CONST
    p$form_name = 1,
    p$status = 2;

  VAR
    pvt: array [1 .. 2] of clt$parameter_value;

    VAR
      form_identifier: fdt$form_identifier;

    clp$evaluate_parameters (parameter_list, #SEQ (pdt), NIL, ^pvt, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    get_form_identifier (pvt [p$form_name].value^.data_name_value,
          form_identifier, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

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

    fdv$p_form_list^ [fdv$form_index].added := FALSE;

  PROCEND fdp$_delete_form;

?? TITLE := '[XDCL] fdp$$event_name', EJECT ??

  PROCEDURE [XDCL] fdp$$event_name
    (    parameter_list: clt$parameter_list;
     VAR work_area {input, output} : ^clt$work_area;
     VAR result: ^clt$data_value;
     VAR status: ost$status);

{ FUNCTION (fdm$$manf_event_name) $event_name

?? PUSH (LISTEXT := ON) ??

  VAR
    pdt: [STATIC, READ, cls$declaration_section] record
      header: clt$pdt_header,
    recend := [
    [1,
    [88, 9, 27, 11, 20, 38, 55],
    clc$function, 0, 0, 0, 0, 0, 0, 0, 'FDM$$MANF_EVENT_NAME']];

?? POP ??

    VAR
      event_name: ost$name,
      form_name: ost$name;

    clp$evaluate_parameters (parameter_list, #SEQ (pdt), NIL, NIL, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    get_form_name (fdv$event.position.form_identifier, form_name, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    convert_to_scl_name (fdv$event.event_name,
          fdv$p_form_list^ [fdv$form_index].form_processor, event_name);
    clp$make_name_value (event_name, work_area, result);
    IF result = NIL THEN
      osp$set_status_abnormal (fdc$format_display_identifier,
            fde$no_space_available, '', status);
    IFEND;

  PROCEND fdp$$event_name;

?? TITLE := '[XDCL] fdp$$event_normal', EJECT ??

  PROCEDURE [XDCL] fdp$$event_normal
    (    parameter_list: clt$parameter_list;
     VAR work_area {input, output} : ^clt$work_area;
     VAR result: ^clt$data_value;
     VAR status: ost$status);


{ FUNCTION (fdm$$manf_en) $event_normal

?? PUSH (LISTEXT := ON) ??

  VAR
    pdt: [STATIC, READ, cls$declaration_section] record
      header: clt$pdt_header,
    recend := [
    [1,
    [88, 9, 27, 11, 25, 9, 969],
    clc$function, 0, 0, 0, 0, 0, 0, 0, 'FDM$$MANF_EN']];

?? POP ??

    clp$evaluate_parameters (parameter_list, #SEQ (pdt), NIL, NIL, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    clp$make_boolean_value (fdv$event.normal, clc$true_false_boolean, work_area,
          result);
    IF result = NIL THEN
      osp$set_status_abnormal (fdc$format_display_identifier,
            fde$no_space_available, '', status);
    IFEND;

  PROCEND fdp$$event_normal;

?? TITLE := '[XDCL] fdp$$event_position', EJECT ??

  PROCEDURE [XDCL] fdp$$event_position
    (    parameter_list: clt$parameter_list;
     VAR work_area {input, output} : ^clt$work_area;
     VAR result: ^clt$data_value;
     VAR status: ost$status);


{ FUNCTION (fdm$$manf_ep) $event_position (
{   option: key
{       (character_position, cp)
{       (form_event, fe)
{       (form_name, fn)
{       (form_x_position, fxp)
{       (form_y_position, fyp)
{       (object_event, oe)
{       (object_name, on)
{       (object_type, ot)
{       (object_x_position, oxp)
{       (object_y_position, oyp)
{       (occurrence, o)
{       (screen_x_position, sxp)
{       (screen_y_position, syp)
{     keyend = $required
{   )

?? PUSH (LISTEXT := ON) ??

  VAR
    pdt: [STATIC, READ, cls$declaration_section] record
      header: clt$pdt_header,
      names: array [1 .. 1] of clt$pdt_parameter_name,
      parameters: array [1 .. 1] of clt$pdt_parameter,
      type1: record
        header: clt$type_specification_header,
        qualifier: clt$keyword_type_qualifier,
        keyword_specs: array [1 .. 26] of clt$keyword_specification,
      recend,
    recend := [
    [1,
    [88, 9, 27, 11, 26, 5, 208],
    clc$function, 1, 1, 1, 0, 0, 0, 0, 'FDM$$MANF_EP'], [
    ['OPTION                         ',clc$nominal_entry, 1]],
    [
{ PARAMETER 1
    [1, clc$normal_usage_entry, clc$non_secure_parameter,
    $clt$parameter_spec_methods[clc$specify_positionally],
    clc$pass_by_value, clc$immediate_evaluation, clc$standard_parameter_checking, 969,
  clc$required_parameter, 0, 0]],
{ PARAMETER 1
    [[1, 0, clc$keyword_type], [26], [
    ['CHARACTER_POSITION             ', clc$nominal_entry, clc$normal_usage_entry, 1],
    ['CP                             ', clc$abbreviation_entry, clc$normal_usage_entry, 1],
    ['FE                             ', clc$abbreviation_entry, clc$normal_usage_entry, 2],
    ['FN                             ', clc$abbreviation_entry, clc$normal_usage_entry, 3],
    ['FORM_EVENT                     ', clc$nominal_entry, clc$normal_usage_entry, 2],
    ['FORM_NAME                      ', clc$nominal_entry, clc$normal_usage_entry, 3],
    ['FORM_X_POSITION                ', clc$nominal_entry, clc$normal_usage_entry, 4],
    ['FORM_Y_POSITION                ', clc$nominal_entry, clc$normal_usage_entry, 5],
    ['FXP                            ', clc$abbreviation_entry, clc$normal_usage_entry, 4],
    ['FYP                            ', clc$abbreviation_entry, clc$normal_usage_entry, 5],
    ['O                              ', clc$abbreviation_entry, clc$normal_usage_entry, 11],
    ['OBJECT_EVENT                   ', clc$nominal_entry, clc$normal_usage_entry, 6],
    ['OBJECT_NAME                    ', clc$nominal_entry, clc$normal_usage_entry, 7],
    ['OBJECT_TYPE                    ', clc$nominal_entry, clc$normal_usage_entry, 8],
    ['OBJECT_X_POSITION              ', clc$nominal_entry, clc$normal_usage_entry, 9],
    ['OBJECT_Y_POSITION              ', clc$nominal_entry, clc$normal_usage_entry, 10],
    ['OCCURRENCE                     ', clc$nominal_entry, clc$normal_usage_entry, 11],
    ['OE                             ', clc$abbreviation_entry, clc$normal_usage_entry, 6],
    ['ON                             ', clc$abbreviation_entry, clc$normal_usage_entry, 7],
    ['OT                             ', clc$abbreviation_entry, clc$normal_usage_entry, 8],
    ['OXP                            ', clc$abbreviation_entry, clc$normal_usage_entry, 9],
    ['OYP                            ', clc$abbreviation_entry, clc$normal_usage_entry, 10],
    ['SCREEN_X_POSITION              ', clc$nominal_entry, clc$normal_usage_entry, 12],
    ['SCREEN_Y_POSITION              ', clc$nominal_entry, clc$normal_usage_entry, 13],
    ['SXP                            ', clc$abbreviation_entry, clc$normal_usage_entry, 12],
    ['SYP                            ', clc$abbreviation_entry, clc$normal_usage_entry, 13]]
    ]];

?? POP ??

  CONST
    p$option = 1;

  VAR
    pvt: array [1 .. 1] of clt$parameter_value;

    VAR
      form_name: ost$name,
      name: ost$name,
      object_name: ost$name,
      object_type: fdt$object_definition_key;

    result := NIL;
    clp$evaluate_parameters (parameter_list, #SEQ (pdt), NIL, ^pvt, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    name := pvt [p$option].value^.name_value;
    IF name = 'CHARACTER_POSITION' THEN
      clp$make_integer_value (fdv$event.position.character_position, 10, FALSE,
            work_area, result);

    ELSEIF name = 'FORM_EVENT' THEN
      clp$make_boolean_value ((fdv$event.position.key = fdc$form_event),
            clc$true_false_boolean, work_area, result);

    ELSEIF name = 'FORM_NAME' THEN
      get_form_name (fdv$event.position.form_identifier, form_name, status);
      IF NOT status.normal THEN
        RETURN;
      IFEND;
      clp$make_name_value (form_name, work_area, result);

    ELSEIF name = 'FORM_X_POSITION' THEN
      clp$make_integer_value (fdv$event.position.form_x_position, 10, FALSE,
            work_area, result);

    ELSEIF name = 'FORM_Y_POSITION' THEN
      clp$make_integer_value (fdv$event.position.form_y_position, 10, FALSE,
            work_area, result);

    ELSEIF name = 'OBJECT_EVENT' THEN
      clp$make_boolean_value ((fdv$event.position.key = fdc$object_event),
            clc$true_false_boolean, work_area, result);

    ELSEIF name = 'OBJECT_NAME' THEN
      convert_to_scl_name (fdv$event.position.object_name,
            fdv$p_form_list^ [fdv$form_index].form_processor, object_name);
      clp$make_name_value (object_name, work_area, result);

    ELSEIF name = 'OBJECT_TYPE' THEN
      object_type := fdv$event.position.object_definition_key;
      IF object_type = fdc$box THEN
        name := 'BOX';
      ELSEIF object_type = fdc$line THEN
        name := 'LINE';
      ELSEIF object_type = fdc$constant_text THEN
        name := 'CONSTANT_TEXT';
      ELSEIF object_type = fdc$constant_text_box THEN
        name := 'CONSTANT_TEXT_BOX';
      ELSEIF object_type = fdc$variable_text THEN
        name := 'VARIABLE_TEXT';
      ELSEIF object_type = fdc$variable_text_box THEN
        name := 'VARIABLE_TEXT_BOX';
      ELSE
        name := ' ';
      IFEND;

      clp$make_keyword_value (name, work_area, result);

    ELSEIF name = 'OBJECT_X_POSITION' THEN
      clp$make_integer_value (fdv$event.position.object_x_position, 10, FALSE,
            work_area, result);

    ELSEIF name = 'OBJECT_Y_POSITION' THEN
      clp$make_integer_value (fdv$event.position.object_y_position, 10, FALSE,
            work_area, result);

    ELSEIF name = 'OCCURRENCE' THEN
      IF fdv$event.position.key = fdc$object_event THEN
        clp$make_integer_value (fdv$event.position.object_occurrence, 10, FALSE,
              work_area, result);
      ELSE
        clp$make_integer_value (0, 10, FALSE, work_area, result);
      IFEND;

    ELSEIF name = 'SCREEN_X_POSITION' THEN
      clp$make_integer_value (fdv$event.position.screen_x_position, 10, FALSE,
            work_area, result);

    ELSEIF name = 'SCREEN_Y_POSITION' THEN
      clp$make_integer_value (fdv$event.position.screen_y_position, 10, FALSE,
            work_area, result);

    ELSE
      osp$set_status_abnormal (fdc$format_display_identifier, fde$system_error,
            'function parameter', status);
      RETURN;
    IFEND;

    IF result = NIL THEN
      osp$set_status_abnormal (fdc$format_display_identifier,
            fde$no_space_available, '', status);
    IFEND;

  PROCEND fdp$$event_position;

?? TITLE := '  [XDCL] fdp$_get_form_variable', EJECT ??

  PROCEDURE [XDCL] fdp$_get_form_variable
    (    parameter_list: clt$parameter_list;
     VAR status: ost$status);

{ PROCEDURE (fdm$manf_getfv) get_form_variable, get_form_variables, getfv (
{   form_name, fn: data_name = $required
{   variable_name, vn: data_name = $required
{   value, v: (VAR) any = $required
{   occurrence, o: integer 1..fdc$maximum_occurrence = 1
{   status)

?? PUSH (LISTEXT := ON) ??

  VAR
    pdt: [STATIC, READ, cls$declaration_section] record
      header: clt$pdt_header,
      names: array [1 .. 9] of clt$pdt_parameter_name,
      parameters: array [1 .. 5] of clt$pdt_parameter,
      type1: record
        header: clt$type_specification_header,
      recend,
      type2: record
        header: clt$type_specification_header,
      recend,
      type3: record
        header: clt$type_specification_header,
        qualifier: clt$union_type_qualifier,
      recend,
      type4: record
        header: clt$type_specification_header,
        qualifier: clt$integer_type_qualifier,
        default_value: string (1),
      recend,
      type5: record
        header: clt$type_specification_header,
      recend,
    recend := [
    [1,
    [88, 9, 27, 13, 38, 12, 515],
    clc$command, 9, 5, 3, 0, 0, 1, 5, 'FDM$MANF_GETFV'], [
    ['FN                             ',clc$abbreviation_entry, 1],
    ['FORM_NAME                      ',clc$nominal_entry, 1],
    ['O                              ',clc$abbreviation_entry, 4],
    ['OCCURRENCE                     ',clc$nominal_entry, 4],
    ['STATUS                         ',clc$nominal_entry, 5],
    ['V                              ',clc$abbreviation_entry, 3],
    ['VALUE                          ',clc$nominal_entry, 3],
    ['VARIABLE_NAME                  ',clc$nominal_entry, 2],
    ['VN                             ',clc$abbreviation_entry, 2]],
    [
{ PARAMETER 1
    [2, clc$normal_usage_entry, clc$non_secure_parameter,
    $clt$parameter_spec_methods[clc$specify_by_name, clc$specify_positionally],
    clc$pass_by_value, clc$immediate_evaluation, clc$standard_parameter_checking, 3, clc$required_parameter, 0
  , 0],
{ PARAMETER 2
    [8, clc$normal_usage_entry, clc$non_secure_parameter,
    $clt$parameter_spec_methods[clc$specify_by_name, clc$specify_positionally],
    clc$pass_by_value, clc$immediate_evaluation, clc$standard_parameter_checking, 3, clc$required_parameter, 0
  , 0],
{ PARAMETER 3
    [7, clc$normal_usage_entry, clc$non_secure_parameter,
    $clt$parameter_spec_methods[clc$specify_by_name, clc$specify_positionally],
    clc$pass_by_reference, clc$immediate_evaluation, clc$standard_parameter_checking, 12,
  clc$required_parameter, 0, 0],
{ PARAMETER 4
    [4, clc$normal_usage_entry, clc$non_secure_parameter,
    $clt$parameter_spec_methods[clc$specify_by_name, clc$specify_positionally],
    clc$pass_by_value, clc$immediate_evaluation, clc$standard_parameter_checking, 20,
  clc$optional_default_parameter, 0, 1],
{ PARAMETER 5
    [5, clc$normal_usage_entry, clc$non_secure_parameter,
    $clt$parameter_spec_methods[clc$specify_by_name],
    clc$pass_by_reference, clc$immediate_evaluation, clc$standard_parameter_checking, 3,
  clc$optional_parameter, 0, 0]],
{ PARAMETER 1
    [[1, 0, clc$data_name_type]],
{ PARAMETER 2
    [[1, 0, clc$data_name_type]],
{ PARAMETER 3
    [[1, 0, clc$union_type], [-$clt$type_kinds [],
    FALSE, 0]],
{ PARAMETER 4
    [[1, 0, clc$integer_type], [1, fdc$maximum_occurrence, 10],
    '1'],
{ PARAMETER 5
    [[1, 0, clc$status_type]]];

?? POP ??

  CONST
    p$form_name = 1,
    p$variable_name = 2,
    p$value = 3,
    p$occurrence = 4,
    p$status = 5;

  VAR
    pvt: array [1 .. 5] of clt$parameter_value;

    VAR
      data_value: clt$data_value,
      form_identifier: fdt$form_identifier,
      form_variable_name: ost$name,
      integer_value: integer,
      p_string_value: ^string ( * ),
      p_variable_information: ^fdt$variable_information,
      real_value: real,
      variable_status: fdt$variable_status;

    clp$evaluate_parameters (parameter_list, #SEQ (pdt), NIL, ^pvt, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    get_form_identifier (pvt [p$form_name].value^.data_name_value,
          form_identifier, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    convert_to_form_name (pvt [p$variable_name].value^.data_name_value,
          fdv$p_form_list^ [fdv$form_index].form_processor, form_variable_name);

    find_variable_name (form_variable_name, p_variable_information, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;


    CASE p_variable_information^.program_data_type OF

    = fdc$program_integer_type =
      fdp$get_integer_variable (form_identifier, form_variable_name,
            pvt [p$occurrence].value^.integer_value.value, integer_value,
            variable_status, status);
      IF NOT status.normal THEN
        RETURN;
      IFEND;

      IF variable_status <> fdc$no_error THEN
        osp$set_status_abnormal (fdc$format_display_identifier, fde$bad_data_value, '', status);
        RETURN;
      IFEND;

      data_value.kind := clc$integer;
      data_value.integer_value.radix := 10;
      data_value.integer_value.radix_specified := FALSE;
      data_value.integer_value.value := integer_value;

    = fdc$program_real_type =
      compute_scl_real(form_identifier, p_variable_information,
            pvt [p$occurrence].value^.integer_value.value, data_value, status);
      IF NOT status.normal THEN
        RETURN;
      IFEND;

    = fdc$program_character_type, fdc$program_upper_case_type =
      PUSH p_string_value: [p_variable_information^.variable_length];
      fdp$get_string_variable (form_identifier, form_variable_name,
            pvt [p$occurrence].value^.integer_value.value, p_string_value^,
            variable_status, status);
      IF NOT status.normal THEN
        RETURN;
      IFEND;

      IF variable_status <> fdc$no_error THEN
        osp$set_status_abnormal (fdc$format_display_identifier, fde$bad_data_value, '', status);
        RETURN;
      IFEND;

      data_value.kind := clc$string;
      data_value.string_value := p_string_value;

    ELSE {fdc$program_cobol_type}
      osp$set_status_abnormal (fdc$format_display_identifier, fde$cobol_invalid_manage_form,
            pvt [p$variable_name].value^.data_name_value, status);
      osp$append_status_parameter (osc$status_parameter_delimiter,
            pvt [p$form_name].value^.data_name_value, status);
      RETURN;
    CASEND;

    clp$change_variable (pvt [p$value].variable^, ^data_value, status);

  PROCEND fdp$_get_form_variable;

?? TITLE := '  [XDCL] fdp$_get_next_changed_variable', EJECT ??

  PROCEDURE [XDCL] fdp$_get_next_changed_variable
    (    parameter_list: clt$parameter_list;
     VAR status: ost$status);

{ PROCEDURE (fdm$manf_getncv) get_next_changed_variable, getncv (
{   form_name, fn: name = $required
{   variable_name, vn: (VAR) name = $required
{   occurrence, o: (VAR) integer = $optional
{   change_found, cf: (VAR) boolean = $required
{   status)

?? PUSH (LISTEXT := ON) ??
?? FMT (FORMAT := OFF) ??

  VAR
    pdt: [STATIC, READ, cls$declaration_section] record
      header: clt$pdt_header,
      names: array [1 .. 9] of clt$pdt_parameter_name,
      parameters: array [1 .. 5] of clt$pdt_parameter,
      type1: record
        header: clt$type_specification_header,
        qualifier: clt$name_type_qualifier,
      recend,
      type2: record
        header: clt$type_specification_header,
        qualifier: clt$name_type_qualifier,
      recend,
      type3: record
        header: clt$type_specification_header,
        qualifier: clt$integer_type_qualifier,
      recend,
      type4: record
        header: clt$type_specification_header,
      recend,
      type5: record
        header: clt$type_specification_header,
      recend,
    recend := [
    [1,
    [89, 4, 28, 10, 7, 6, 328],
    clc$command, 9, 5, 3, 0, 0, 3, 5, 'FDM$MANF_GETNCV'], [
    ['CF                             ',clc$abbreviation_entry, 4],
    ['CHANGE_FOUND                   ',clc$nominal_entry, 4],
    ['FN                             ',clc$abbreviation_entry, 1],
    ['FORM_NAME                      ',clc$nominal_entry, 1],
    ['O                              ',clc$abbreviation_entry, 3],
    ['OCCURRENCE                     ',clc$nominal_entry, 3],
    ['STATUS                         ',clc$nominal_entry, 5],
    ['VARIABLE_NAME                  ',clc$nominal_entry, 2],
    ['VN                             ',clc$abbreviation_entry, 2]],
    [
{ PARAMETER 1
    [4, clc$normal_usage_entry, clc$non_secure_parameter,
    $clt$parameter_spec_methods[clc$specify_by_name, clc$specify_positionally],
    clc$pass_by_value, clc$immediate_evaluation,
  clc$standard_parameter_checking, 5, clc$required_parameter, 0, 0],
{ PARAMETER 2
    [8, clc$normal_usage_entry, clc$non_secure_parameter,
    $clt$parameter_spec_methods[clc$specify_by_name, clc$specify_positionally],
    clc$pass_by_reference, clc$immediate_evaluation,
  clc$standard_parameter_checking, 5, clc$required_parameter, 0, 0],
{ PARAMETER 3
    [6, clc$normal_usage_entry, clc$non_secure_parameter,
    $clt$parameter_spec_methods[clc$specify_by_name, clc$specify_positionally],
    clc$pass_by_reference, clc$immediate_evaluation,
  clc$standard_parameter_checking, 20, clc$optional_parameter, 0, 0],
{ PARAMETER 4
    [2, clc$normal_usage_entry, clc$non_secure_parameter,
    $clt$parameter_spec_methods[clc$specify_by_name, clc$specify_positionally],
    clc$pass_by_reference, clc$immediate_evaluation,
  clc$standard_parameter_checking, 3, clc$required_parameter, 0, 0],
{ PARAMETER 5
    [7, clc$normal_usage_entry, clc$non_secure_parameter,
    $clt$parameter_spec_methods[clc$specify_by_name],
    clc$pass_by_reference, clc$immediate_evaluation,
  clc$standard_parameter_checking, 3, clc$optional_parameter, 0, 0]],
{ PARAMETER 1
    [[1, 0, clc$name_type], [1, osc$max_name_size]],
{ PARAMETER 2
    [[1, 0, clc$name_type], [1, osc$max_name_size]],
{ PARAMETER 3
    [[1, 0, clc$integer_type], [clc$min_integer, clc$max_integer, 10]],
{ PARAMETER 4
    [[1, 0, clc$boolean_type]],
{ PARAMETER 5
    [[1, 0, clc$status_type]]];

?? FMT (FORMAT := ON) ??
?? POP ??

    CONST
      p$form_name = 1,
      p$variable_name = 2,
      p$occurrence = 3,
      p$change_found = 4,
      p$status = 5;

    VAR
      pvt: array [1 .. 5] of clt$parameter_value;

    VAR
      change_found: boolean,
      form_identifier: fdt$form_identifier,
      occurrence: fdt$occurrence,
      value: ^clt$data_value,
      variable_name: ost$name,
      pointer: amt$segment_pointer;


    status.normal := TRUE;
    clp$evaluate_parameters (parameter_list, #SEQ (pdt), NIL, ^pvt, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    get_form_identifier (pvt [p$form_name].value^.data_name_value, form_identifier, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    fdp$get_next_changed_variable (form_identifier, variable_name, occurrence, change_found, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

{ Update VAR parameters.

    mmp$create_scratch_segment (amc$sequence_pointer, mmc$as_sequential, pointer, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    clp$make_boolean_value (change_found, clc$true_false_boolean, pointer.sequence_pointer, value);
    clp$change_variable (pvt [p$change_found].variable^, value, status);

    IF change_found THEN
      clp$make_name_value (variable_name, pointer.sequence_pointer, value);
      clp$change_variable (pvt [p$variable_name].variable^, value, status);
      IF NOT status.normal THEN
        RETURN;
      IFEND;

      IF pvt [p$occurrence].specified THEN
        clp$make_integer_value (occurrence, 10, FALSE, pointer.sequence_pointer, value);
        clp$change_variable (pvt [p$occurrence].variable^, value, status);
        IF NOT status.normal THEN
          RETURN;
        IFEND;
      IFEND;
    IFEND;

  PROCEND fdp$_get_next_changed_variable;
?? TITLE := '  [XDCL] fdp$_get_next_input_error', EJECT ??

  PROCEDURE [XDCL] fdp$_get_next_input_error
    (    parameter_list: clt$parameter_list;
     VAR status: ost$status);

{ PROCEDURE (fdm$manf_getnie) get_next_input_error, getnie (
{   form_name,fn : name =$required
{   variable_name, vn: (VAR) name = $required
{   occurrence, o: (VAR) integer = $optional
{   variable_status, vs: (VAR) integer = $required
{   status)

?? PUSH (LISTEXT := ON) ??
?? FMT (FORMAT := OFF) ??

  VAR
    pdt: [STATIC, READ, cls$declaration_section] record
      header: clt$pdt_header,
      names: array [1 .. 9] of clt$pdt_parameter_name,
      parameters: array [1 .. 5] of clt$pdt_parameter,
      type1: record
        header: clt$type_specification_header,
        qualifier: clt$name_type_qualifier,
      recend,
      type2: record
        header: clt$type_specification_header,
        qualifier: clt$name_type_qualifier,
      recend,
      type3: record
        header: clt$type_specification_header,
        qualifier: clt$integer_type_qualifier,
      recend,
      type4: record
        header: clt$type_specification_header,
        qualifier: clt$integer_type_qualifier,
      recend,
      type5: record
        header: clt$type_specification_header,
      recend,
    recend := [
    [1,
    [89, 4, 28, 10, 9, 51, 698],
    clc$command, 9, 5, 3, 0, 0, 3, 5, 'FDM$MANF_GETNIE'], [
    ['FN                             ',clc$abbreviation_entry, 1],
    ['FORM_NAME                      ',clc$nominal_entry, 1],
    ['O                              ',clc$abbreviation_entry, 3],
    ['OCCURRENCE                     ',clc$nominal_entry, 3],
    ['STATUS                         ',clc$nominal_entry, 5],
    ['VARIABLE_NAME                  ',clc$nominal_entry, 2],
    ['VARIABLE_STATUS                ',clc$nominal_entry, 4],
    ['VN                             ',clc$abbreviation_entry, 2],
    ['VS                             ',clc$abbreviation_entry, 4]],
    [
{ PARAMETER 1
    [2, clc$normal_usage_entry, clc$non_secure_parameter,
    $clt$parameter_spec_methods[clc$specify_by_name, clc$specify_positionally],
    clc$pass_by_value, clc$immediate_evaluation,
  clc$standard_parameter_checking, 5, clc$required_parameter, 0, 0],
{ PARAMETER 2
    [6, clc$normal_usage_entry, clc$non_secure_parameter,
    $clt$parameter_spec_methods[clc$specify_by_name, clc$specify_positionally],
    clc$pass_by_reference, clc$immediate_evaluation,
  clc$standard_parameter_checking, 5, clc$required_parameter, 0, 0],
{ PARAMETER 3
    [4, clc$normal_usage_entry, clc$non_secure_parameter,
    $clt$parameter_spec_methods[clc$specify_by_name, clc$specify_positionally],
    clc$pass_by_reference, clc$immediate_evaluation,
  clc$standard_parameter_checking, 20, clc$optional_parameter, 0, 0],
{ PARAMETER 4
    [7, clc$normal_usage_entry, clc$non_secure_parameter,
    $clt$parameter_spec_methods[clc$specify_by_name, clc$specify_positionally],
    clc$pass_by_reference, clc$immediate_evaluation,
  clc$standard_parameter_checking, 20, clc$required_parameter, 0, 0],
{ PARAMETER 5
    [5, clc$normal_usage_entry, clc$non_secure_parameter,
    $clt$parameter_spec_methods[clc$specify_by_name],
    clc$pass_by_reference, clc$immediate_evaluation,
  clc$standard_parameter_checking, 3, clc$optional_parameter, 0, 0]],
{ PARAMETER 1
    [[1, 0, clc$name_type], [1, osc$max_name_size]],
{ PARAMETER 2
    [[1, 0, clc$name_type], [1, osc$max_name_size]],
{ PARAMETER 3
    [[1, 0, clc$integer_type], [clc$min_integer, clc$max_integer, 10]],
{ PARAMETER 4
    [[1, 0, clc$integer_type], [clc$min_integer, clc$max_integer, 10]],
{ PARAMETER 5
    [[1, 0, clc$status_type]]];

?? FMT (FORMAT := ON) ??
?? POP ??

    CONST
      p$form_name = 1,
      p$variable_name = 2,
      p$occurrence = 3,
      p$variable_status = 4,
      p$status = 5;

    VAR
      pvt: array [1 .. 5] of clt$parameter_value;

    VAR
      form_identifier: fdt$form_identifier,
      occurrence: fdt$occurrence,
      value: ^clt$data_value,
      variable_name: ost$name,
      variable_status: fdt$variable_status,
      pointer: amt$segment_pointer;

    clp$evaluate_parameters (parameter_list, #SEQ (pdt), NIL, ^pvt, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    get_form_identifier (pvt [p$form_name].value^.data_name_value,
          form_identifier, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    fdp$get_next_input_error (form_identifier, variable_name, occurrence, variable_status, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

{ Update VAR parameters.

    mmp$create_scratch_segment (amc$sequence_pointer, mmc$as_sequential, pointer, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;


    clp$make_integer_value ($INTEGER (variable_status), 10, FALSE, pointer.sequence_pointer, value);
    clp$change_variable (pvt [p$variable_status].variable^, value, status);

    IF variable_status <> fdc$no_error THEN

{ Return information describing the variable error.

      clp$make_name_value (variable_name, pointer.sequence_pointer, value);
      clp$change_variable (pvt [p$variable_name].variable^, value, status);
      IF NOT status.normal THEN
        RETURN;
      IFEND;

      IF pvt [p$occurrence].specified THEN
        clp$make_integer_value (occurrence, 10, FALSE, pointer.sequence_pointer, value);
        clp$change_variable (pvt [p$occurrence].variable^, value, status);
        IF NOT status.normal THEN
          RETURN;
        IFEND;
      IFEND;
    IFEND;

  PROCEND fdp$_get_next_input_error;
?? TITLE := '  [XDCL] fdp$_get_next_output_error', EJECT ??

  PROCEDURE [XDCL] fdp$_get_next_output_error
    (    parameter_list: clt$parameter_list;
     VAR status: ost$status);

{ PROCEDURE (fdm$manf_getnoe) get_next_output_error, getnoe (
{   form_name,fn : name =$required
{   variable_name, vn: (VAR) name = $required
{   occurrence, o: (VAR) integer = $optional
{   variable_status, vs: (VAR) integer = $required
{   status)

?? PUSH (LISTEXT := ON) ??
?? FMT (FORMAT := OFF) ??

  VAR
    pdt: [STATIC, READ, cls$declaration_section] record
      header: clt$pdt_header,
      names: array [1 .. 9] of clt$pdt_parameter_name,
      parameters: array [1 .. 5] of clt$pdt_parameter,
      type1: record
        header: clt$type_specification_header,
        qualifier: clt$name_type_qualifier,
      recend,
      type2: record
        header: clt$type_specification_header,
        qualifier: clt$name_type_qualifier,
      recend,
      type3: record
        header: clt$type_specification_header,
        qualifier: clt$integer_type_qualifier,
      recend,
      type4: record
        header: clt$type_specification_header,
        qualifier: clt$integer_type_qualifier,
      recend,
      type5: record
        header: clt$type_specification_header,
      recend,
    recend := [
    [1,
    [89, 4, 28, 10, 11, 9, 192],
    clc$command, 9, 5, 3, 0, 0, 3, 5, 'FDM$MANF_GETNOE'], [
    ['FN                             ',clc$abbreviation_entry, 1],
    ['FORM_NAME                      ',clc$nominal_entry, 1],
    ['O                              ',clc$abbreviation_entry, 3],
    ['OCCURRENCE                     ',clc$nominal_entry, 3],
    ['STATUS                         ',clc$nominal_entry, 5],
    ['VARIABLE_NAME                  ',clc$nominal_entry, 2],
    ['VARIABLE_STATUS                ',clc$nominal_entry, 4],
    ['VN                             ',clc$abbreviation_entry, 2],
    ['VS                             ',clc$abbreviation_entry, 4]],
    [
{ PARAMETER 1
    [2, clc$normal_usage_entry, clc$non_secure_parameter,
    $clt$parameter_spec_methods[clc$specify_by_name, clc$specify_positionally],
    clc$pass_by_value, clc$immediate_evaluation,
  clc$standard_parameter_checking, 5, clc$required_parameter, 0, 0],
{ PARAMETER 2
    [6, clc$normal_usage_entry, clc$non_secure_parameter,
    $clt$parameter_spec_methods[clc$specify_by_name, clc$specify_positionally],
    clc$pass_by_reference, clc$immediate_evaluation,
  clc$standard_parameter_checking, 5, clc$required_parameter, 0, 0],
{ PARAMETER 3
    [4, clc$normal_usage_entry, clc$non_secure_parameter,
    $clt$parameter_spec_methods[clc$specify_by_name, clc$specify_positionally],
    clc$pass_by_reference, clc$immediate_evaluation,
  clc$standard_parameter_checking, 20, clc$optional_parameter, 0, 0],
{ PARAMETER 4
    [7, clc$normal_usage_entry, clc$non_secure_parameter,
    $clt$parameter_spec_methods[clc$specify_by_name, clc$specify_positionally],
    clc$pass_by_reference, clc$immediate_evaluation,
  clc$standard_parameter_checking, 20, clc$required_parameter, 0, 0],
{ PARAMETER 5
    [5, clc$normal_usage_entry, clc$non_secure_parameter,
    $clt$parameter_spec_methods[clc$specify_by_name],
    clc$pass_by_reference, clc$immediate_evaluation,
  clc$standard_parameter_checking, 3, clc$optional_parameter, 0, 0]],
{ PARAMETER 1
    [[1, 0, clc$name_type], [1, osc$max_name_size]],
{ PARAMETER 2
    [[1, 0, clc$name_type], [1, osc$max_name_size]],
{ PARAMETER 3
    [[1, 0, clc$integer_type], [clc$min_integer, clc$max_integer, 10]],
{ PARAMETER 4
    [[1, 0, clc$integer_type], [clc$min_integer, clc$max_integer, 10]],
{ PARAMETER 5
    [[1, 0, clc$status_type]]];

?? FMT (FORMAT := ON) ??
?? POP ??

    CONST
      p$form_name = 1,
      p$variable_name = 2,
      p$occurrence = 3,
      p$variable_status = 4,
      p$status = 5;

    VAR
      pvt: array [1 .. 5] of clt$parameter_value;

    VAR
      form_identifier: fdt$form_identifier,
      occurrence: fdt$occurrence,
      value: ^clt$data_value,
      variable_name: ost$name,
      variable_status: fdt$variable_status,
      pointer: amt$segment_pointer;


    clp$evaluate_parameters (parameter_list, #SEQ (pdt), NIL, ^pvt, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    get_form_identifier (pvt [p$form_name].value^.data_name_value, form_identifier, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    fdp$get_next_output_error (form_identifier, variable_name, occurrence, variable_status, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

{ Update VAR parameters.

    mmp$create_scratch_segment (amc$sequence_pointer, mmc$as_sequential, pointer, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    clp$make_integer_value ($INTEGER (variable_status), 10, FALSE, pointer.sequence_pointer, value);
    clp$change_variable (pvt [p$variable_status].variable^, value, status);

    IF variable_status <> fdc$no_error THEN

{ Return information describing the variable error.

      clp$make_name_value (variable_name, pointer.sequence_pointer, value);
      clp$change_variable (pvt [p$variable_name].variable^, value, status);
      IF NOT status.normal THEN
        RETURN;
      IFEND;

      IF pvt [p$occurrence].specified THEN
        clp$make_integer_value (occurrence, 10, FALSE, pointer.sequence_pointer, value);
        clp$change_variable (pvt [p$occurrence].variable^, value, status);
        IF NOT status.normal THEN
          RETURN;
        IFEND;
      IFEND;
    IFEND;

  PROCEND fdp$_get_next_output_error;
?? TITLE := '  [XDCL] fdp$_open_form', EJECT ??

  PROCEDURE [XDCL] fdp$_open_form
    (    parameter_list: clt$parameter_list;
     VAR status: ost$status);

{ PROCEDURE (fdm$manf_opef) open_form, opef (
{   form_name, fn: data_name = $required
{   status)

?? PUSH (LISTEXT := ON) ??

  VAR
    pdt: [STATIC, READ, cls$declaration_section] record
      header: clt$pdt_header,
      names: array [1 .. 3] of clt$pdt_parameter_name,
      parameters: array [1 .. 2] of clt$pdt_parameter,
      type1: record
        header: clt$type_specification_header,
      recend,
      type2: record
        header: clt$type_specification_header,
      recend,
    recend := [
    [1,
    [88, 9, 26, 16, 32, 26, 235],
    clc$command, 3, 2, 1, 0, 0, 0, 2, 'FDM$MANF_OPEF'], [
    ['FN                             ',clc$abbreviation_entry, 1],
    ['FORM_NAME                      ',clc$nominal_entry, 1],
    ['STATUS                         ',clc$nominal_entry, 2]],
    [
{ PARAMETER 1
    [2, clc$normal_usage_entry, clc$non_secure_parameter,
    $clt$parameter_spec_methods[clc$specify_by_name, clc$specify_positionally],
    clc$pass_by_value, clc$immediate_evaluation, clc$standard_parameter_checking, 3, clc$required_parameter, 0
  , 0],
{ PARAMETER 2
    [3, clc$normal_usage_entry, clc$non_secure_parameter,
    $clt$parameter_spec_methods[clc$specify_by_name],
    clc$pass_by_reference, clc$immediate_evaluation, clc$standard_parameter_checking, 3,
  clc$optional_parameter, 0, 0]],
{ PARAMETER 1
    [[1, 0, clc$data_name_type]],
{ PARAMETER 2
    [[1, 0, clc$status_type]]];

?? POP ??

  CONST
    p$form_name = 1,
    p$status = 2;

  VAR
    pvt: array [1 .. 2] of clt$parameter_value;

    VAR
      form_identifier: fdt$form_identifier,
      form_is_open: boolean,
      form_name: ost$name;

    clp$evaluate_parameters (parameter_list, #SEQ (pdt), NIL, ^pvt, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    form_name := pvt [p$form_name].value^.data_name_value;

    add_form_to_list (form_name, form_is_open, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    IF form_is_open THEN
      RETURN;
    IFEND;

    fdp$open_form (form_name, form_identifier, status);
    IF NOT status.normal THEN
      delete_form_from_list (form_name);
      RETURN;
    IFEND;

    fdv$p_form_list^ [fdv$form_index].form_identifier := form_identifier;


    CASE fdv$variable_creation OF

    = fdc$form_variable =

{ Create one record variable for the entire form. Variables on the form
{ are fields within the record variable.

      create_form_variable (^fdv$p_form_list^ [fdv$form_index], status);

    = fdc$none =

{ Do not create any variables.

    = fdc$single =

{ Create one SCL variable for each variable on the form.

      create_single_variables (form_identifier, status);

    ELSE
      osp$set_status_abnormal (fdc$format_display_identifier, fde$system_error,
            'invalid form creation', status);
    CASEND;

  PROCEND fdp$_open_form;

?? TITLE := '  [XDCL] fdp$_pop_forms', EJECT ??

  PROCEDURE [XDCL] fdp$_pop_forms
    (    parameter_list: clt$parameter_list;
     VAR status: ost$status);

{ PROCEDURE (fdm$manf_popf) pop_form, pop_forms, popf (
{   status)

?? PUSH (LISTEXT := ON) ??

  VAR
    pdt: [STATIC, READ, cls$declaration_section] record
      header: clt$pdt_header,
      names: array [1 .. 1] of clt$pdt_parameter_name,
      parameters: array [1 .. 1] of clt$pdt_parameter,
      type1: record
        header: clt$type_specification_header,
      recend,
    recend := [
    [1,
    [88, 9, 27, 13, 38, 58, 307],
    clc$command, 1, 1, 0, 0, 0, 0, 1, 'FDM$MANF_POPF'], [
    ['STATUS                         ',clc$nominal_entry, 1]],
    [
{ PARAMETER 1
    [1, clc$normal_usage_entry, clc$non_secure_parameter,
    $clt$parameter_spec_methods[clc$specify_by_name],
    clc$pass_by_reference, clc$immediate_evaluation, clc$standard_parameter_checking, 3,
  clc$optional_parameter, 0, 0]],
{ PARAMETER 1
    [[1, 0, clc$status_type]]];

?? POP ??

  CONST
    p$status = 1;

  VAR
    pvt: array [1 .. 1] of clt$parameter_value;

    VAR
      form_index: fdt$form_identifier;


    clp$evaluate_parameters (parameter_list, #SEQ (pdt), NIL, ^pvt, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    fdp$pop_forms (status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    IF fdv$push_index > 0 THEN
      FOR form_index := 1 TO fdv$high_form_index DO
        IF fdv$p_form_list^ [form_index].push_index = fdv$push_index THEN
          fdv$p_form_list^ [form_index].push_index := 0;
        IFEND;
      FOREND;

      fdv$push_index := fdv$push_index - 1;
    IFEND;

  PROCEND fdp$_pop_forms;

?? TITLE := '  [XDCL] fdp$_position_form', EJECT ??

  PROCEDURE [XDCL] fdp$_position_form
    (    parameter_list: clt$parameter_list;
     VAR status: ost$status);

{ PROCEDURE (fdm$manf_posf) position_form, posf (
{   form_name, fn: data_name = $required
{   x_position, xp: integer 1..fdc$maximum_x_position = 1
{   y_position, yp: integer 1..fdc$maximum_y_position = 1
{   status)

?? PUSH (LISTEXT := ON) ??

  VAR
    pdt: [STATIC, READ, cls$declaration_section] record
      header: clt$pdt_header,
      names: array [1 .. 7] of clt$pdt_parameter_name,
      parameters: array [1 .. 4] of clt$pdt_parameter,
      type1: record
        header: clt$type_specification_header,
      recend,
      type2: record
        header: clt$type_specification_header,
        qualifier: clt$integer_type_qualifier,
        default_value: string (1),
      recend,
      type3: record
        header: clt$type_specification_header,
        qualifier: clt$integer_type_qualifier,
        default_value: string (1),
      recend,
      type4: record
        header: clt$type_specification_header,
      recend,
    recend := [
    [1,
    [88, 9, 26, 16, 35, 2, 958],
    clc$command, 7, 4, 1, 0, 0, 0, 4, 'FDM$MANF_POSF'], [
    ['FN                             ',clc$abbreviation_entry, 1],
    ['FORM_NAME                      ',clc$nominal_entry, 1],
    ['STATUS                         ',clc$nominal_entry, 4],
    ['XP                             ',clc$abbreviation_entry, 2],
    ['X_POSITION                     ',clc$nominal_entry, 2],
    ['YP                             ',clc$abbreviation_entry, 3],
    ['Y_POSITION                     ',clc$nominal_entry, 3]],
    [
{ PARAMETER 1
    [2, clc$normal_usage_entry, clc$non_secure_parameter,
    $clt$parameter_spec_methods[clc$specify_by_name, clc$specify_positionally],
    clc$pass_by_value, clc$immediate_evaluation, clc$standard_parameter_checking, 3, clc$required_parameter, 0
  , 0],
{ PARAMETER 2
    [5, clc$normal_usage_entry, clc$non_secure_parameter,
    $clt$parameter_spec_methods[clc$specify_by_name, clc$specify_positionally],
    clc$pass_by_value, clc$immediate_evaluation, clc$standard_parameter_checking, 20,
  clc$optional_default_parameter, 0, 1],
{ PARAMETER 3
    [7, clc$normal_usage_entry, clc$non_secure_parameter,
    $clt$parameter_spec_methods[clc$specify_by_name, clc$specify_positionally],
    clc$pass_by_value, clc$immediate_evaluation, clc$standard_parameter_checking, 20,
  clc$optional_default_parameter, 0, 1],
{ PARAMETER 4
    [3, clc$normal_usage_entry, clc$non_secure_parameter,
    $clt$parameter_spec_methods[clc$specify_by_name],
    clc$pass_by_reference, clc$immediate_evaluation, clc$standard_parameter_checking, 3,
  clc$optional_parameter, 0, 0]],
{ PARAMETER 1
    [[1, 0, clc$data_name_type]],
{ PARAMETER 2
    [[1, 0, clc$integer_type], [1, fdc$maximum_x_position, 10],
    '1'],
{ PARAMETER 3
    [[1, 0, clc$integer_type], [1, fdc$maximum_y_position, 10],
    '1'],
{ PARAMETER 4
    [[1, 0, clc$status_type]]];

?? POP ??

  CONST
    p$form_name = 1,
    p$x_position = 2,
    p$y_position = 3,
    p$status = 4;

  VAR
    pvt: array [1 .. 4] of clt$parameter_value;

    VAR
      form_identifier: fdt$form_identifier;

    clp$evaluate_parameters (parameter_list, #SEQ (pdt), NIL, ^pvt, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    get_form_identifier (pvt [p$form_name].value^.data_name_value,
          form_identifier, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    fdp$position_form (form_identifier, pvt [p$x_position].value^.integer_value.
          value, pvt [p$y_position].value^.integer_value.value, status);

  PROCEND fdp$_position_form;

?? TITLE := '  [XDCL] fdp$_push_forms', EJECT ??

  PROCEDURE [XDCL] fdp$_push_forms
    (    parameter_list: clt$parameter_list;
     VAR status: ost$status);

{ PROCEDURE (fdm$manf_pusf) push_form, push_forms, pusf (
{   status)

?? PUSH (LISTEXT := ON) ??

  VAR
    pdt: [STATIC, READ, cls$declaration_section] record
      header: clt$pdt_header,
      names: array [1 .. 1] of clt$pdt_parameter_name,
      parameters: array [1 .. 1] of clt$pdt_parameter,
      type1: record
        header: clt$type_specification_header,
      recend,
    recend := [
    [1,
    [88, 9, 27, 13, 39, 30, 881],
    clc$command, 1, 1, 0, 0, 0, 0, 1, 'FDM$MANF_PUSF'], [
    ['STATUS                         ',clc$nominal_entry, 1]],
    [
{ PARAMETER 1
    [1, clc$normal_usage_entry, clc$non_secure_parameter,
    $clt$parameter_spec_methods[clc$specify_by_name],
    clc$pass_by_reference, clc$immediate_evaluation, clc$standard_parameter_checking, 3,
  clc$optional_parameter, 0, 0]],
{ PARAMETER 1
    [[1, 0, clc$status_type]]];

?? POP ??

  CONST
    p$status = 1;

  VAR
    pvt: array [1 .. 1] of clt$parameter_value;

    VAR
      form_index: fdt$form_identifier;


    clp$evaluate_parameters (parameter_list, #SEQ (pdt), NIL, ^pvt, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    fdp$push_forms (status);
    IF fdv$push_index < fdc$maximum_form_identifier THEN
      IF NOT status.normal THEN
        RETURN;
      IFEND;
      fdv$push_index := fdv$push_index + 1;
      FOR form_index := 1 TO fdv$high_form_index DO
        IF fdv$p_form_list^ [form_index].added AND
              (fdv$p_form_list^ [form_index].push_index = 0) THEN
          fdv$p_form_list^ [form_index].push_index := fdv$push_index;
        IFEND;
      FOREND;
    IFEND;

  PROCEND fdp$_push_forms;

?? TITLE := '  [XDCL] fdp$_quit', EJECT ??

  PROCEDURE [XDCL] fdp$_quit
    (    parameter_list: clt$parameter_list;
     VAR status: ost$status);

{ PROCEDURE (fdm$manf_qui) quit, qui (
{   status)

?? PUSH (LISTEXT := ON) ??

  VAR
    pdt: [STATIC, READ, cls$declaration_section] record
      header: clt$pdt_header,
      names: array [1 .. 1] of clt$pdt_parameter_name,
      parameters: array [1 .. 1] of clt$pdt_parameter,
      type1: record
        header: clt$type_specification_header,
      recend,
    recend := [
    [1,
    [88, 9, 26, 16, 37, 55, 567],
    clc$command, 1, 1, 0, 0, 0, 0, 1, 'FDM$MANF_QUI'], [
    ['STATUS                         ',clc$nominal_entry, 1]],
    [
{ PARAMETER 1
    [1, clc$normal_usage_entry, clc$non_secure_parameter,
    $clt$parameter_spec_methods[clc$specify_by_name],
    clc$pass_by_reference, clc$immediate_evaluation, clc$standard_parameter_checking, 3,
  clc$optional_parameter, 0, 0]],
{ PARAMETER 1
    [[1, 0, clc$status_type]]];

?? POP ??

  CONST
    p$status = 1;

  VAR
    pvt: array [1 .. 1] of clt$parameter_value;


    clp$evaluate_parameters (parameter_list, #SEQ (pdt), NIL, ^pvt, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    clp$end_include (fdv$utility_name, status);

  PROCEND fdp$_quit;

?? TITLE := '  [XDCL] fdp$_read_forms', EJECT ??

  PROCEDURE [XDCL] fdp$_read_forms
    (    parameter_list: clt$parameter_list;
     VAR status: ost$status);

{ PROCEDURE (fdm$manf_reaf) read_form, read_forms, reaf (
{   status)

?? PUSH (LISTEXT := ON) ??

  VAR
    pdt: [STATIC, READ, cls$declaration_section] record
      header: clt$pdt_header,
      names: array [1 .. 1] of clt$pdt_parameter_name,
      parameters: array [1 .. 1] of clt$pdt_parameter,
      type1: record
        header: clt$type_specification_header,
      recend,
    recend := [
    [1,
    [88, 9, 27, 13, 40, 6, 318],
    clc$command, 1, 1, 0, 0, 0, 0, 1, 'FDM$MANF_REAF'], [
    ['STATUS                         ',clc$nominal_entry, 1]],
    [
{ PARAMETER 1
    [1, clc$normal_usage_entry, clc$non_secure_parameter,
    $clt$parameter_spec_methods[clc$specify_by_name],
    clc$pass_by_reference, clc$immediate_evaluation, clc$standard_parameter_checking, 3,
  clc$optional_parameter, 0, 0]],
{ PARAMETER 1
    [[1, 0, clc$status_type]]];

?? POP ??

  CONST
    p$status = 1;

  VAR
    pvt: array [1 .. 1] of clt$parameter_value;

    VAR
      last_event: boolean;


    clp$evaluate_parameters (parameter_list, #SEQ (pdt), NIL, ^pvt, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    IF fdv$variable_evaluation = fdc$automatic THEN

{ Transfer values of SCL variables to Screen Formatting.

      replace_variables (status);
      IF NOT status.normal THEN
        RETURN;
      IFEND;
    IFEND;

    fdp$read_forms (status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    fdp$get_next_event (fdv$event.event_name, fdv$event.normal,
          fdv$event.position, last_event, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    IF ((fdv$variable_evaluation = fdc$automatic) AND fdv$event.normal) THEN

{ Transfer values the terminal user entered on the form to SCL variables.

      get_variables (status);
    IFEND;

  PROCEND fdp$_read_forms;

?? TITLE := '  [XDCL] fdp$_replace_form_variable', EJECT ??

  PROCEDURE [XDCL] fdp$_replace_form_variable
    (    parameter_list: clt$parameter_list;
     VAR status: ost$status);

{ PROCEDURE (fdm$manf_repfv) replace_form_variable, replace_form_variables, repfv (
{   form_name, fn: data_name = $required
{   variable_name, vn: data_name = $required
{   value, v: any = $required
{   occurrence, o: integer 1..fdc$maximum_occurrence = 1
{   status)

?? PUSH (LISTEXT := ON) ??

  VAR
    pdt: [STATIC, READ, cls$declaration_section] record
      header: clt$pdt_header,
      names: array [1 .. 9] of clt$pdt_parameter_name,
      parameters: array [1 .. 5] of clt$pdt_parameter,
      type1: record
        header: clt$type_specification_header,
      recend,
      type2: record
        header: clt$type_specification_header,
      recend,
      type3: record
        header: clt$type_specification_header,
        qualifier: clt$union_type_qualifier,
      recend,
      type4: record
        header: clt$type_specification_header,
        qualifier: clt$integer_type_qualifier,
        default_value: string (1),
      recend,
      type5: record
        header: clt$type_specification_header,
      recend,
    recend := [
    [1,
    [88, 9, 27, 13, 41, 26, 957],
    clc$command, 9, 5, 3, 0, 0, 0, 5, 'FDM$MANF_REPFV'], [
    ['FN                             ',clc$abbreviation_entry, 1],
    ['FORM_NAME                      ',clc$nominal_entry, 1],
    ['O                              ',clc$abbreviation_entry, 4],
    ['OCCURRENCE                     ',clc$nominal_entry, 4],
    ['STATUS                         ',clc$nominal_entry, 5],
    ['V                              ',clc$abbreviation_entry, 3],
    ['VALUE                          ',clc$nominal_entry, 3],
    ['VARIABLE_NAME                  ',clc$nominal_entry, 2],
    ['VN                             ',clc$abbreviation_entry, 2]],
    [
{ PARAMETER 1
    [2, clc$normal_usage_entry, clc$non_secure_parameter,
    $clt$parameter_spec_methods[clc$specify_by_name, clc$specify_positionally],
    clc$pass_by_value, clc$immediate_evaluation, clc$standard_parameter_checking, 3, clc$required_parameter, 0
  , 0],
{ PARAMETER 2
    [8, clc$normal_usage_entry, clc$non_secure_parameter,
    $clt$parameter_spec_methods[clc$specify_by_name, clc$specify_positionally],
    clc$pass_by_value, clc$immediate_evaluation, clc$standard_parameter_checking, 3, clc$required_parameter, 0
  , 0],
{ PARAMETER 3
    [7, clc$normal_usage_entry, clc$non_secure_parameter,
    $clt$parameter_spec_methods[clc$specify_by_name, clc$specify_positionally],
    clc$pass_by_value, clc$immediate_evaluation, clc$standard_parameter_checking, 12, clc$required_parameter,
  0, 0],
{ PARAMETER 4
    [4, clc$normal_usage_entry, clc$non_secure_parameter,
    $clt$parameter_spec_methods[clc$specify_by_name, clc$specify_positionally],
    clc$pass_by_value, clc$immediate_evaluation, clc$standard_parameter_checking, 20,
  clc$optional_default_parameter, 0, 1],
{ PARAMETER 5
    [5, clc$normal_usage_entry, clc$non_secure_parameter,
    $clt$parameter_spec_methods[clc$specify_by_name],
    clc$pass_by_reference, clc$immediate_evaluation, clc$standard_parameter_checking, 3,
  clc$optional_parameter, 0, 0]],
{ PARAMETER 1
    [[1, 0, clc$data_name_type]],
{ PARAMETER 2
    [[1, 0, clc$data_name_type]],
{ PARAMETER 3
    [[1, 0, clc$union_type], [-$clt$type_kinds [],
    FALSE, 0]],
{ PARAMETER 4
    [[1, 0, clc$integer_type], [1, fdc$maximum_occurrence, 10],
    '1'],
{ PARAMETER 5
    [[1, 0, clc$status_type]]];

?? POP ??

  CONST
    p$form_name = 1,
    p$variable_name = 2,
    p$value = 3,
    p$occurrence = 4,
    p$status = 5;

  VAR
    pvt: array [1 .. 5] of clt$parameter_value;

    VAR
      form_identifier: fdt$form_identifier,
      form_variable_name: ost$name,
      real_value: real,
      variable_status: fdt$variable_status;

    clp$evaluate_parameters (parameter_list, #SEQ (pdt), NIL, ^pvt, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    get_form_identifier (pvt [p$form_name].value^.data_name_value,
          form_identifier, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    convert_to_form_name (pvt [p$variable_name].value^.data_name_value,
          fdv$p_form_list^ [fdv$form_index].form_processor, form_variable_name);

    CASE pvt [p$value].value^.kind OF

    = clc$integer =
      fdp$replace_integer_variable (form_identifier, form_variable_name,
            pvt [p$occurrence].value^.integer_value.value,
            pvt [p$value].value^.integer_value.value, variable_status, status);

    = clc$real =

{ The command language uses double precision for real numbers.
{ Screen Formatting and CYBIL use single precision for real  numbers.  Use
{ the most significant part of the double precision command language real
{ for CYBIL.

      real_value := $REAL (pvt [p$value].value^.real_value.value);
      fdp$replace_real_variable (form_identifier, form_variable_name,
            pvt [p$occurrence].value^.integer_value.value, real_value,
            variable_status, status);

    = clc$string =
      fdp$replace_string_variable (form_identifier, form_variable_name,
            pvt [p$occurrence].value^.integer_value.value,
            pvt [p$value].value^.string_value^, variable_status, status);

    ELSE
      osp$set_status_abnormal (fdc$format_display_identifier, fde$bad_data_value, '', status);
      RETURN;
    CASEND;

    IF status.normal THEN
      IF variable_status <> fdc$no_error THEN
        osp$set_status_abnormal (fdc$format_display_identifier, fde$bad_data_value, '', status);
      IFEND;
    IFEND;

  PROCEND fdp$_replace_form_variable;

?? TITLE := '  [XDCL] fdp$_reset_form', EJECT ??

  PROCEDURE [XDCL] fdp$_reset_form
    (    parameter_list: clt$parameter_list;
     VAR status: ost$status);


{ PROCEDURE (fdm$manf_resf) reset_form, resf (
{   form_name, fn: data_name = $required
{   status)

?? PUSH (LISTEXT := ON) ??

  VAR
    pdt: [STATIC, READ, cls$declaration_section] record
      header: clt$pdt_header,
      names: array [1 .. 3] of clt$pdt_parameter_name,
      parameters: array [1 .. 2] of clt$pdt_parameter,
      type1: record
        header: clt$type_specification_header,
      recend,
      type2: record
        header: clt$type_specification_header,
      recend,
    recend := [
    [1,
    [88, 9, 26, 16, 44, 23, 469],
    clc$command, 3, 2, 1, 0, 0, 0, 2, 'FDM$MANF_RESF'], [
    ['FN                             ',clc$abbreviation_entry, 1],
    ['FORM_NAME                      ',clc$nominal_entry, 1],
    ['STATUS                         ',clc$nominal_entry, 2]],
    [
{ PARAMETER 1
    [2, clc$normal_usage_entry, clc$non_secure_parameter,
    $clt$parameter_spec_methods[clc$specify_by_name, clc$specify_positionally],
    clc$pass_by_value, clc$immediate_evaluation, clc$standard_parameter_checking, 3, clc$required_parameter, 0
  , 0],
{ PARAMETER 2
    [3, clc$normal_usage_entry, clc$non_secure_parameter,
    $clt$parameter_spec_methods[clc$specify_by_name],
    clc$pass_by_reference, clc$immediate_evaluation, clc$standard_parameter_checking, 3,
  clc$optional_parameter, 0, 0]],
{ PARAMETER 1
    [[1, 0, clc$data_name_type]],
{ PARAMETER 2
    [[1, 0, clc$status_type]]];

?? POP ??

  CONST
    p$form_name = 1,
    p$status = 2;

  VAR
    pvt: array [1 .. 2] of clt$parameter_value;

    VAR
      form_identifier: fdt$form_identifier,
      form_processor: fdt$form_processor,
      p_form_information: ^fdt$form_information,
      p_variable_information: ^fdt$variable_information,
      p_variables: ^array [1 .. *] of fdt$variable_information,
      variable_index: fdt$variable_index;

    clp$evaluate_parameters (parameter_list, #SEQ (pdt), NIL, ^pvt, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    get_form_identifier (pvt [p$form_name].value^.data_name_value,
          form_identifier, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

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

    IF fdv$variable_evaluation = fdc$automatic THEN

{ Transfer initial values set in the form to SCL variables.

      p_form_information := ^fdv$p_form_list^ [fdv$form_index];
      p_variables := p_form_information^.p_variables;
      IF p_variables <> NIL THEN
        IF fdv$variable_creation = fdc$form_variable THEN
          get_form_variable (p_form_information, status);
        ELSE
          form_processor := p_form_information^.form_processor;
          FOR variable_index := 1 TO UPPERBOUND (p_variables^) DO
            p_variable_information := ^p_variables^ [variable_index];
            get_single_variable (p_variable_information,
                  p_variable_information^.occurrence, form_identifier,
                  form_processor, status);
            IF NOT status.normal THEN
              RETURN;
            IFEND;
          FOREND;
        IFEND;
      IFEND;
    IFEND;

  PROCEND fdp$_reset_form;

?? TITLE := '  [XDCL] fdp$_set_cursor_position', EJECT ??

  PROCEDURE [XDCL] fdp$_set_cursor_position
    (    parameter_list: clt$parameter_list;
     VAR status: ost$status);


{ PROCEDURE (fdm$manf_setcp) set_cursor_position, setcp (
{   form_name, fn: data_name = $required
{   object_name, on: data_name = $required
{   occurrence, o: integer 1..1000 = 1
{   character_position, cp: integer 1..4096 = 1
{   status)

?? PUSH (LISTEXT := ON) ??

  VAR
    pdt: [STATIC, READ, cls$declaration_section] record
      header: clt$pdt_header,
      names: array [1 .. 9] of clt$pdt_parameter_name,
      parameters: array [1 .. 5] of clt$pdt_parameter,
      type1: record
        header: clt$type_specification_header,
      recend,
      type2: record
        header: clt$type_specification_header,
      recend,
      type3: record
        header: clt$type_specification_header,
        qualifier: clt$integer_type_qualifier,
        default_value: string (1),
      recend,
      type4: record
        header: clt$type_specification_header,
        qualifier: clt$integer_type_qualifier,
        default_value: string (1),
      recend,
      type5: record
        header: clt$type_specification_header,
      recend,
    recend := [
    [1,
    [88, 9, 26, 16, 45, 47, 597],
    clc$command, 9, 5, 2, 0, 0, 0, 5, 'FDM$MANF_SETCP'], [
    ['CHARACTER_POSITION             ',clc$nominal_entry, 4],
    ['CP                             ',clc$abbreviation_entry, 4],
    ['FN                             ',clc$abbreviation_entry, 1],
    ['FORM_NAME                      ',clc$nominal_entry, 1],
    ['O                              ',clc$abbreviation_entry, 3],
    ['OBJECT_NAME                    ',clc$nominal_entry, 2],
    ['OCCURRENCE                     ',clc$nominal_entry, 3],
    ['ON                             ',clc$abbreviation_entry, 2],
    ['STATUS                         ',clc$nominal_entry, 5]],
    [
{ PARAMETER 1
    [4, clc$normal_usage_entry, clc$non_secure_parameter,
    $clt$parameter_spec_methods[clc$specify_by_name, clc$specify_positionally],
    clc$pass_by_value, clc$immediate_evaluation, clc$standard_parameter_checking, 3, clc$required_parameter, 0
  , 0],
{ PARAMETER 2
    [6, clc$normal_usage_entry, clc$non_secure_parameter,
    $clt$parameter_spec_methods[clc$specify_by_name, clc$specify_positionally],
    clc$pass_by_value, clc$immediate_evaluation, clc$standard_parameter_checking, 3, clc$required_parameter, 0
  , 0],
{ PARAMETER 3
    [7, clc$normal_usage_entry, clc$non_secure_parameter,
    $clt$parameter_spec_methods[clc$specify_by_name, clc$specify_positionally],
    clc$pass_by_value, clc$immediate_evaluation, clc$standard_parameter_checking, 20,
  clc$optional_default_parameter, 0, 1],
{ PARAMETER 4
    [1, clc$normal_usage_entry, clc$non_secure_parameter,
    $clt$parameter_spec_methods[clc$specify_by_name, clc$specify_positionally],
    clc$pass_by_value, clc$immediate_evaluation, clc$standard_parameter_checking, 20,
  clc$optional_default_parameter, 0, 1],
{ PARAMETER 5
    [9, clc$normal_usage_entry, clc$non_secure_parameter,
    $clt$parameter_spec_methods[clc$specify_by_name],
    clc$pass_by_reference, clc$immediate_evaluation, clc$standard_parameter_checking, 3,
  clc$optional_parameter, 0, 0]],
{ PARAMETER 1
    [[1, 0, clc$data_name_type]],
{ PARAMETER 2
    [[1, 0, clc$data_name_type]],
{ PARAMETER 3
    [[1, 0, clc$integer_type], [1, 1000, 10],
    '1'],
{ PARAMETER 4
    [[1, 0, clc$integer_type], [1, 4096, 10],
    '1'],
{ PARAMETER 5
    [[1, 0, clc$status_type]]];

?? POP ??

  CONST
    p$form_name = 1,
    p$object_name = 2,
    p$occurrence = 3,
    p$character_position = 4,
    p$status = 5;

  VAR
    pvt: array [1 .. 5] of clt$parameter_value;

    VAR
      form_identifier: fdt$form_identifier,
      object_name: ost$name;

    clp$evaluate_parameters (parameter_list, #SEQ (pdt), NIL, ^pvt, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    get_form_identifier (pvt [p$form_name].value^.data_name_value,
          form_identifier, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    convert_to_form_name (pvt [p$object_name].value^.data_name_value,
          fdv$p_form_list^ [fdv$form_index].form_processor, object_name);
    fdp$set_cursor_position (form_identifier, object_name,
          pvt [p$occurrence].value^.integer_value.value,
          pvt [p$character_position].value^.integer_value.value, status);

  PROCEND fdp$_set_cursor_position;

?? TITLE := '  [XDCL] fdp$_set_object_attribute', EJECT ??

  PROCEDURE [XDCL] fdp$_set_object_attribute
    (    parameter_list: clt$parameter_list;
     VAR status: ost$status);

{ PROCEDURE (fdm$manf_setoa) set_object_attribute, setoa (
{   form_name, fn: data_name = $required
{   object_name, on: data_name = $required
{   attribute, a: any of
{       key
{         initial
{       keyend
{       data_name
{     anyend = initial
{   occurrence, o: integer 1..fdc$maximum_occurrence = 1
{   status)

?? PUSH (LISTEXT := ON) ??

  VAR
    pdt: [STATIC, READ, cls$declaration_section] record
      header: clt$pdt_header,
      names: array [1 .. 9] of clt$pdt_parameter_name,
      parameters: array [1 .. 5] of clt$pdt_parameter,
      type1: record
        header: clt$type_specification_header,
      recend,
      type2: record
        header: clt$type_specification_header,
      recend,
      type3: record
        header: clt$type_specification_header,
        qualifier: clt$union_type_qualifier,
        type_size_1: clt$type_specification_size,
        element_type_spec_1: record
          header: clt$type_specification_header,
          qualifier: clt$keyword_type_qualifier,
          keyword_specs: array [1 .. 1] of clt$keyword_specification,
        recend,
        type_size_2: clt$type_specification_size,
        element_type_spec_2: record
          header: clt$type_specification_header,
        recend,
        default_value: string (7),
      recend,
      type4: record
        header: clt$type_specification_header,
        qualifier: clt$integer_type_qualifier,
        default_value: string (1),
      recend,
      type5: record
        header: clt$type_specification_header,
      recend,
    recend := [
    [1,
    [88, 9, 26, 16, 47, 9, 686],
    clc$command, 9, 5, 2, 0, 0, 0, 5, 'FDM$MANF_SETOA'], [
    ['A                              ',clc$abbreviation_entry, 3],
    ['ATTRIBUTE                      ',clc$nominal_entry, 3],
    ['FN                             ',clc$abbreviation_entry, 1],
    ['FORM_NAME                      ',clc$nominal_entry, 1],
    ['O                              ',clc$abbreviation_entry, 4],
    ['OBJECT_NAME                    ',clc$nominal_entry, 2],
    ['OCCURRENCE                     ',clc$nominal_entry, 4],
    ['ON                             ',clc$abbreviation_entry, 2],
    ['STATUS                         ',clc$nominal_entry, 5]],
    [
{ PARAMETER 1
    [4, clc$normal_usage_entry, clc$non_secure_parameter,
    $clt$parameter_spec_methods[clc$specify_by_name, clc$specify_positionally],
    clc$pass_by_value, clc$immediate_evaluation, clc$standard_parameter_checking, 3, clc$required_parameter, 0
  , 0],
{ PARAMETER 2
    [6, clc$normal_usage_entry, clc$non_secure_parameter,
    $clt$parameter_spec_methods[clc$specify_by_name, clc$specify_positionally],
    clc$pass_by_value, clc$immediate_evaluation, clc$standard_parameter_checking, 3, clc$required_parameter, 0
  , 0],
{ PARAMETER 3
    [2, clc$normal_usage_entry, clc$non_secure_parameter,
    $clt$parameter_spec_methods[clc$specify_by_name, clc$specify_positionally],
    clc$pass_by_value, clc$immediate_evaluation, clc$standard_parameter_checking, 67,
  clc$optional_default_parameter, 0, 7],
{ PARAMETER 4
    [7, clc$normal_usage_entry, clc$non_secure_parameter,
    $clt$parameter_spec_methods[clc$specify_by_name, clc$specify_positionally],
    clc$pass_by_value, clc$immediate_evaluation, clc$standard_parameter_checking, 20,
  clc$optional_default_parameter, 0, 1],
{ PARAMETER 5
    [9, clc$normal_usage_entry, clc$non_secure_parameter,
    $clt$parameter_spec_methods[clc$specify_by_name],
    clc$pass_by_reference, clc$immediate_evaluation, clc$standard_parameter_checking, 3,
  clc$optional_parameter, 0, 0]],
{ PARAMETER 1
    [[1, 0, clc$data_name_type]],
{ PARAMETER 2
    [[1, 0, clc$data_name_type]],
{ PARAMETER 3
    [[1, 0, clc$union_type], [[clc$data_name_type, clc$keyword_type],
    FALSE, 2],
    44, [[1, 0, clc$keyword_type], [1], [
      ['INITIAL                        ', clc$nominal_entry, clc$normal_usage_entry, 1]]
      ],
    3, [[1, 0, clc$data_name_type]]
    ,
    'initial'],
{ PARAMETER 4
    [[1, 0, clc$integer_type], [1, fdc$maximum_occurrence, 10],
    '1'],
{ PARAMETER 5
    [[1, 0, clc$status_type]]];

?? POP ??

  CONST
    p$form_name = 1,
    p$object_name = 2,
    p$attribute = 3,
    p$occurrence = 4,
    p$status = 5;

  VAR
    pvt: array [1 .. 5] of clt$parameter_value;

    VAR
      attribute_name: ost$name,
      form_identifier: fdt$form_identifier,
      object_name: ost$name;

    clp$evaluate_parameters (parameter_list, #SEQ (pdt), NIL, ^pvt, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    get_form_identifier (pvt [p$form_name].value^.data_name_value,
          form_identifier, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    convert_to_form_name (pvt [p$object_name].value^.data_name_value,
          fdv$p_form_list^ [fdv$form_index].form_processor, object_name);
    IF pvt [p$attribute].value^.kind = clc$keyword THEN

{ On the INITIAL key word reset the object attributes to those specified
{ when the form was defined.

      fdp$reset_object_attribute (form_identifier, object_name,
            pvt [p$occurrence].value^.integer_value.value, status);
    ELSE

      convert_to_form_name (pvt [p$attribute].value^.data_name_value,
            fdv$p_form_list^ [fdv$form_index].form_processor, attribute_name);
      fdp$set_object_attribute (form_identifier, object_name,
            pvt [p$occurrence].value^.integer_value.value, attribute_name,
            status);
    IFEND;
  PROCEND fdp$_set_object_attribute;

?? TITLE := '  [XDCL] fdp$_show_forms', EJECT ??

  PROCEDURE [XDCL] fdp$_show_forms
    (    parameter_list: clt$parameter_list;
     VAR status: ost$status);


{ PROCEDURE (fdm$manf_shof) show_form, show_forms, shof (
{   status)

?? PUSH (LISTEXT := ON) ??

  VAR
    pdt: [STATIC, READ, cls$declaration_section] record
      header: clt$pdt_header,
      names: array [1 .. 1] of clt$pdt_parameter_name,
      parameters: array [1 .. 1] of clt$pdt_parameter,
      type1: record
        header: clt$type_specification_header,
      recend,
    recend := [
    [1,
    [88, 9, 27, 13, 36, 25, 610],
    clc$command, 1, 1, 0, 0, 0, 0, 1, 'FDM$MANF_SHOF'], [
    ['STATUS                         ',clc$nominal_entry, 1]],
    [
{ PARAMETER 1
    [1, clc$normal_usage_entry, clc$non_secure_parameter,
    $clt$parameter_spec_methods[clc$specify_by_name],
    clc$pass_by_reference, clc$immediate_evaluation, clc$standard_parameter_checking, 3,
  clc$optional_parameter, 0, 0]],
{ PARAMETER 1
    [[1, 0, clc$status_type]]];

?? POP ??

  CONST
    p$status = 1;

  VAR
    pvt: array [1 .. 1] of clt$parameter_value;

    clp$evaluate_parameters (parameter_list, #SEQ (pdt), NIL, ^pvt, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    IF fdv$variable_evaluation = fdc$automatic THEN

{ Transfer values of SCL variables to Screen Formatting variables.

      replace_variables (status);
      IF NOT status.normal THEN
        RETURN;
      IFEND;
    IFEND;

    fdp$show_forms (status);

  PROCEND fdp$_show_forms;
?? TITLE := '  [XDCL] fdp$_tab_to_next_field', EJECT ??

  PROCEDURE [XDCL] fdp$_tab_to_next_field
    (    parameter_list: clt$parameter_list;
     VAR status: ost$status);

{ PROCEDURE (fdm$manf_tabtnf) tab_to_next_field, tabtnf (
{   status)

?? PUSH (LISTEXT := ON) ??
?? FMT (FORMAT := OFF) ??

  VAR
    pdt: [STATIC, READ, cls$declaration_section] record
      header: clt$pdt_header,
      names: array [1 .. 1] of clt$pdt_parameter_name,
      parameters: array [1 .. 1] of clt$pdt_parameter,
      type1: record
        header: clt$type_specification_header,
      recend,
    recend := [
    [1,
    [89, 4, 28, 10, 16, 8, 901],
    clc$command, 1, 1, 0, 0, 0, 0, 1, 'FDM$MANF_TABTNF'], [
    ['STATUS                         ',clc$nominal_entry, 1]],
    [
{ PARAMETER 1
    [1, clc$normal_usage_entry, clc$non_secure_parameter,
    $clt$parameter_spec_methods[clc$specify_by_name],
    clc$pass_by_reference, clc$immediate_evaluation,
  clc$standard_parameter_checking, 3, clc$optional_parameter, 0, 0]],
{ PARAMETER 1
    [[1, 0, clc$status_type]]];

?? FMT (FORMAT := ON) ??
?? POP ??

    CONST
      p$status = 1;

    VAR
      pvt: array [1 .. 1] of clt$parameter_value;


    clp$evaluate_parameters (parameter_list, #SEQ (pdt), NIL, ^pvt, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    fdp$tab_to_next_field (status);

  PROCEND fdp$_tab_to_next_field;
?? TITLE := '  add_form_to_list', EJECT ??

  PROCEDURE add_form_to_list
    (    form_name: ost$name;
     VAR form_is_open: boolean;
     VAR status: ost$status);

    CONST
      fdc$forms_to_expand = 7;

    VAR
      form_index: fdt$form_identifier,
      number_entries: 1 .. fdc$maximum_form_identifier,
      p_temporary_form_list: ^array [1 .. fdc$maximum_form_identifier] of
            fdt$form_information;

    form_is_open := FALSE;

{ If form is open, use current entry.

    FOR form_index := 1 TO fdv$high_form_index DO
      IF form_name = fdv$p_form_list^ [form_index].name THEN
        form_is_open := TRUE;
        fdv$form_index := form_index;
        RETURN;
      IFEND;
    FOREND;


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

      FOR form_index := 1 TO fdc$forms_to_expand DO
        fdv$p_form_list^ [form_index].name := ' ';
      FOREND;

      fdv$high_form_index := fdv$high_form_index + 1;
      fdv$p_form_list^ [fdv$high_form_index].added := FALSE;
      fdv$p_form_list^ [fdv$high_form_index].name := form_name;
      fdv$p_form_list^ [fdv$high_form_index].push_index := 0;
      fdv$p_form_list^ [fdv$high_form_index].p_variables := NIL;
      fdv$p_form_list^ [fdv$high_form_index].p_tables := NIL;
      fdv$p_form_list^ [fdv$high_form_index].form_variable_created := FALSE;
      fdv$form_index := fdv$high_form_index;
      RETURN;
    IFEND;

{ If any unused entry exits, assign it to form.

    number_entries := UPPERBOUND (fdv$p_form_list^);
    FOR form_index := 1 TO number_entries DO
      IF fdv$p_form_list^ [form_index].name = ' ' THEN
        fdv$form_index := form_index;
        fdv$p_form_list^ [form_index].added := FALSE;
        fdv$p_form_list^ [form_index].name := form_name;
        fdv$p_form_list^ [form_index].push_index := 0;
        fdv$p_form_list^ [form_index].p_variables := NIL;
        fdv$p_form_list^ [form_index].p_tables := NIL;
        fdv$p_form_list^ [form_index].form_variable_created := FALSE;
        IF form_index > fdv$high_form_index THEN
          fdv$high_form_index := form_index;
        IFEND;
        RETURN;
      IFEND;
    FOREND;

    IF fdv$high_form_index >= number_entries THEN
      IF (number_entries + fdc$forms_to_expand) >
            fdc$maximum_form_identifier THEN
        osp$set_status_abnormal (fdc$format_display_identifier,
              fde$no_space_available, '', status);
        RETURN;
      IFEND;
    IFEND;

{ Expand the list for opened forms.

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

      FOR form_index := 1 TO number_entries DO
        fdv$p_form_list^ [form_index] :=
              p_temporary_form_list^ [form_index];
      FOREND;

      FOR form_index := number_entries + 1 TO number_entries +
            fdc$forms_to_expand DO
        fdv$p_form_list^ [form_index].name := ' ';
      FOREND;

    fdv$high_form_index := fdv$high_form_index + 1;
    fdv$p_form_list^ [fdv$high_form_index].added := FALSE;
    fdv$p_form_list^ [fdv$high_form_index].name := form_name;
    fdv$p_form_list^ [fdv$high_form_index].push_index := 0;
    fdv$p_form_list^ [fdv$high_form_index].p_variables := NIL;
    fdv$p_form_list^ [fdv$high_form_index].p_tables := NIL;
    fdv$p_form_list^ [fdv$high_form_index].form_variable_created := FALSE;
    fdv$form_index := fdv$high_form_index;

  PROCEND add_form_to_list;

?? TITLE := '  compute_scl_real', EJECT ??

  PROCEDURE compute_scl_real
    (    form_identifier: fdt$form_identifier;
         p_variable_information: ^fdt$variable_information;
         occurrence: fdt$occurrence;
     VAR data_value: clt$data_value;
     VAR status: ost$status);

    VAR
      actual_text_length: mlt$string_length,
      character_found: boolean,
      error: mlt$error,
      non_space: [READ, STATIC] packed array [char] of boolean := [
            {---} REP 32 of TRUE,
            {- -} FALSE,
            {---} REP 223 of TRUE],
      real_value: real,
      scan_index: integer,
      screen_variable_length: fdt$screen_variable_length,
      start_index: integer,
      string_value: string (fdc$maximum_x_position + 1),
      variable_status: fdt$variable_status;

{ SCL supports only double precision real numbers.  Screen Formatting
{ currently only supports single precision real numbers. In order to
{ compare a number assigned value in SCL with a number assigned a value
{ in Screen Formatting, the text entered by the terminal user must
{ be converted to a double precision real number.

{ Get the real number from Screen Formatting to make sure the number is valid.

      fdp$get_real_variable (form_identifier, p_variable_information^.name,
            occurrence, real_value, variable_status, status);
      IF NOT status.normal THEN
        RETURN;
      IFEND;

      IF variable_status <> fdc$no_error THEN
        osp$set_status_abnormal (fdc$format_display_identifier, fde$bad_data_value, '', status);
        RETURN;
      IFEND;

{ Convert the text entered by the terminal user to a double precision real number.

      fdp$get_screen_variable (form_identifier, p_variable_information^.name,
            occurrence, string_value, status);
      IF NOT status.normal THEN
        RETURN;
      IFEND;

      data_value.kind := clc$real;
      data_value.real_value.number_of_digits := fdc$real_number_of_digits;

{ Ignore leading spaces.

      screen_variable_length := fdc$maximum_x_position + 1;
      #SCAN (non_space, string_value, start_index, character_found);
      IF start_index > screen_variable_length THEN
        data_value.real_value.value := 0.0D1;
        RETURN;
      IFEND;

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

      mlp$input_floating_number (^string_value (start_index, *) ,
      screen_variable_length - start_index + 1, ^data_value.real_value.value,
            mlc$double_precision, mlc$stop_on_blank, actual_text_length, error);

  PROCEND compute_scl_real;

?? TITLE := '  compute_string_size', EJECT ??

  PROCEDURE [INLINE] compute_string_size
    (VAR value: clt$value);

    WHILE value.str.size > 0 DO
      IF value.str.value (value.str.size) = ' ' THEN
        value.str.size := value.str.size - 1;
      ELSE
        RETURN;
      IFEND;
    WHILEND;

  PROCEND compute_string_size;

?? TITLE := '  convert_to_form_name', EJECT ??

  PROCEDURE [INLINE] convert_to_form_name
    (    name: ost$name;
         form_processor: fdt$form_processor;
     VAR form_name: ost$name);

{ Allow forms with a COBOL processor to be used under the SCL interface.
{ The SCL interface allows users to quickly prototype applications.
{ Convert the SCL name to the name used on the form.

    IF form_processor = fdc$cobol_processor THEN
      #TRANSLATE (fdv$to_cobol, name, form_name);
    ELSE
      form_name := name;
    IFEND;

  PROCEND convert_to_form_name;

?? TITLE := '  convert_to_scl_name', EJECT ??

  PROCEDURE [INLINE] convert_to_scl_name
    (    name: ost$name;
         form_processor: fdt$form_processor;
     VAR scl_name: ost$name);


{ Allow forms with a COBOL processor to be used under the SCL interface.
{ The SCL interface allows users to quickly prototype applications.
{ Convert the name used on the form to an SCL name.

    IF form_processor = fdc$cobol_processor THEN
      #TRANSLATE (fdv$to_scl, name, scl_name);
    ELSE
      scl_name := name;
    IFEND;

  PROCEND convert_to_scl_name;

?? TITLE := '  create_form_variable', EJECT ??

  PROCEDURE create_form_variable
    (    p_form_information: ^fdt$form_information;
     VAR status: ost$status);

    VAR
      data_value: clt$data_value,
      field_index: integer,
      form_identifier: fdt$form_identifier,
      form_name: ost$name,
      form_processor: fdt$form_processor,
      get_form_attributes: array [1 .. 3] of fdt$get_form_attribute,
      number_of_fields: integer,
      number_tables: fdt$number_tables,
      number_variables: fdt$number_variables,
      occurrence: fdt$occurrence,
      p_array_values: ^array [ * ] of clt$data_value,
      p_data_value: ^clt$data_value,
      p_form_field_values: ^array [1 .. * ] of clt$field_value,
      p_table_data_values: ^array [1 .. * ] of clt$data_value,
      p_table_field_values: ^array [1 .. * ] of clt$field_value,
      p_table_array_values: ^array [1 .. * ] of ^clt$data_value,
      p_table_information: ^fdt$table_information,
      p_table_names: ^fdt$form_names,
      p_table_variables: ^array [1 .. * ] of fdt$table_variable_information,
      p_tables: ^array [1 .. * ] of fdt$table_information,
      p_type_specification: ^clt$type_specification,
      p_variable_information: ^fdt$variable_information,
      p_variable_names: ^fdt$form_names,
      p_variables: ^array [1 .. * ] of fdt$variable_information,
      p_work_area: ^clt$work_area,
      program_data_type: fdt$program_data_type,
      scl_variable_name: ost$name,
      sequence_length: integer,
      table_index: fdt$table_index,
      table_variable_index: fdt$table_index,
      table_type_specification_size: clt$type_specification_size,
      total_sequence_length: integer,
      variable_index: fdt$variable_index,
      variable_length: integer,
      variable_name: ost$name,
      variable_number: fdt$number_names;

    form_identifier := p_form_information^.form_identifier;
    form_name := p_form_information^.name;

{ Get the information about variables and tables held by Screen Formatting.
{ This allows generation of SCL variables of the proper data type and length.

    get_form_attributes [1].key := fdc$get_number_variables;
    get_form_attributes [2].key := fdc$get_form_processor;
    get_form_attributes [3].key := fdc$get_number_tables;
    fdp$get_form_attributes (form_identifier, get_form_attributes, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    form_processor := get_form_attributes [2].form_processor;
    fdv$p_form_list^ [fdv$form_index].form_processor := form_processor;
    number_variables := get_form_attributes [1].number_variables;
    number_tables := get_form_attributes [3].number_tables;
    IF number_variables = 0 THEN
      RETURN;
    IFEND;

{ Get the attributes of the form variables from Screen Formatting and
{ store them for latter processing of the form.

    store_variables (form_identifier, number_variables, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    p_variables := fdv$p_form_list^ [fdv$form_index].p_variables;
    IF number_tables <> 0 THEN

{ Get the attributes of the form tables from Screen Formatting and
{ store them for latter processing of the form.

      store_tables (form_identifier, number_tables, p_variables, status);
      IF NOT status.normal THEN
        RETURN;
      IFEND;
    IFEND;

    RESET fdv$work_area.sequence_pointer;
    total_sequence_length := #SIZE (fdv$work_area.sequence_pointer^);
    number_of_fields := number_tables;
    FOR variable_index := 1 TO number_variables DO
      IF NOT p_variables^ [variable_index].table_member THEN
        number_of_fields := number_of_fields + 1;
      IFEND;
    FOREND;
    p_form_information^.number_of_fields := number_of_fields;

{ Record  all fields in the form record.  Each table and  each variable that
{ does not belong to a table is a field for the form record.

    NEXT p_form_field_values: [1 .. number_of_fields] IN
          fdv$work_area.sequence_pointer;
    IF p_form_field_values = NIL THEN
      osp$set_status_abnormal (fdc$format_display_identifier,
            fde$no_space_available, '', status);
      RETURN;
    IFEND;

    field_index := 0;
    data_value.kind := clc$record;
    data_value.field_values := p_form_field_values;
    p_tables := fdv$p_form_list^ [fdv$form_index].p_tables;

    IF p_tables <> NIL THEN

    /process_tables/
      FOR table_index := 1 TO UPPERBOUND (p_tables^) DO
        p_table_information := ^p_tables^ [table_index];
        convert_to_scl_name (p_table_information^.name, form_processor,
              scl_variable_name);
        p_table_variables := p_table_information^.p_table_variables;

{ A table is an array of records.

        NEXT p_data_value IN fdv$work_area.sequence_pointer;
        IF p_data_value = NIL THEN
          osp$set_status_abnormal (fdc$format_display_identifier,
                fde$no_space_available, '', status);
          RETURN;
        IFEND;

        NEXT p_table_array_values: [1 .. p_table_information^.occurrence] IN
              fdv$work_area.sequence_pointer;
        IF p_table_array_values = NIL THEN
          osp$set_status_abnormal (fdc$format_display_identifier,
                fde$no_space_available, '', status);
          RETURN;
        IFEND;

        p_data_value^.kind := clc$array;
        p_data_value^.array_value := p_table_array_values;
        field_index := field_index + 1;
        p_form_field_values^ [field_index].name := scl_variable_name;
        p_form_field_values^ [field_index].value := p_data_value;

        NEXT p_table_data_values: [1 .. p_table_information^.occurrence] IN
              fdv$work_area.sequence_pointer;
        IF p_table_data_values = NIL THEN
          osp$set_status_abnormal (fdc$format_display_identifier,
                fde$no_space_available, '', status);
          RETURN;
        IFEND;

      /process_table_array/
        FOR occurrence := 1 TO p_table_information^.occurrence DO

{ The variables belonging to the table are fields.

          NEXT p_table_field_values: [1 .. UPPERBOUND (p_table_variables^)] IN
                fdv$work_area.sequence_pointer;
          IF p_table_field_values = NIL THEN
            osp$set_status_abnormal (fdc$format_display_identifier,
                  fde$no_space_available, '', status);
            RETURN;
          IFEND;

          p_table_array_values^ [occurrence] :=
                ^p_table_data_values^ [occurrence];
          p_table_data_values^ [occurrence].kind := clc$record;
          p_table_data_values^ [occurrence].field_values :=
                p_table_field_values;

        /process_table_variables/
          FOR table_variable_index := 1 TO UPPERBOUND (p_table_variables^) DO
            p_variable_information := p_table_variables^ [table_variable_index].
                  p_variable_information;
            convert_to_scl_name (p_variable_information^.name, form_processor,
                  scl_variable_name);

            NEXT p_data_value IN fdv$work_area.sequence_pointer;
            IF p_data_value = NIL THEN
              osp$set_status_abnormal (fdc$format_display_identifier,
                    fde$no_space_available, '', status);
              RETURN;
            IFEND;

            p_table_field_values^ [table_variable_index].name :=
                  scl_variable_name;
            p_table_field_values^ [table_variable_index].value := p_data_value;


{ Create the fields of the data_value.  Get the initial value of the
{ variable from Screen Formatting.

            get_data_value (form_identifier, p_variable_information, occurrence,
                  p_data_value^, status);
            IF NOT status.normal THEN
              RETURN;
            IFEND;
          FOREND /process_table_variables/;
        FOREND /process_table_array/;
      FOREND /process_tables/;
    IFEND;

{ Process variables that do not belong to a table.
{ Each variable is a field in the form record.

  /process_single_variables/
    FOR variable_index := 1 TO number_variables DO
      IF p_variables^ [variable_index].table_member THEN
        CYCLE /process_single_variables/;
      IFEND;

      convert_to_scl_name (p_variables^ [variable_index].name, form_processor,
            scl_variable_name);
      NEXT p_data_value IN fdv$work_area.sequence_pointer;
      IF p_data_value = NIL THEN
        osp$set_status_abnormal (fdc$format_display_identifier,
              fde$no_space_available, '', status);
        RETURN;
      IFEND;

      field_index := field_index + 1;
      p_form_field_values^ [field_index].name := scl_variable_name;
      p_form_field_values^ [field_index].value := p_data_value;

{ Create the fields of the data_value.  Get the initial value of the
{ variable from Screen Formatting.

      get_data_value (form_identifier, ^p_variables^ [variable_index], 1,
            p_data_value^, status);
      IF NOT status.normal THEN
        RETURN;
      IFEND;
    FOREND /process_single_variables/;

    sequence_length := i#current_sequence_position
          (fdv$work_area.sequence_pointer);
    RESET fdv$work_area.sequence_pointer;
    NEXT p_work_area: [[REP sequence_length OF cell]] IN
          fdv$work_area.sequence_pointer;
    NEXT p_work_area: [[REP (total_sequence_length - sequence_length) OF
          cell]] IN fdv$work_area.sequence_pointer;
    RESET p_work_area;
    clp$derive_type_spec_from_value (^data_value, p_work_area,
          p_type_specification, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    clp$create_procedure_variable (form_name, clc$local_scope, clc$read_write,
          clc$immediate_evaluation, p_type_specification, ^data_value, status);
    fdv$p_form_list^ [fdv$form_index].form_variable_created := status.normal;
    IF NOT status.normal THEN
      IF status.condition = cle$var_already_created THEN
        status.normal := TRUE;
        IF fdv$variable_evaluation = fdc$automatic THEN
          replace_form_variable (^fdv$p_form_list^ [fdv$form_index], status);
        IFEND;
      IFEND;
    IFEND;

  PROCEND create_form_variable;

?? TITLE := '  create_single_variables', EJECT ??

  PROCEDURE create_single_variables
    (    form_identifier: fdt$form_identifier;
     VAR status: ost$status);

    VAR
      data_value: clt$data_value,
      form_processor: fdt$form_processor,
      get_form_attributes: array [1 .. 2] of fdt$get_form_attribute,
      number_of_occurrences: fdt$occurrence,
      number_variables: fdt$number_variables,
      occurrence: fdt$occurrence,
      p_array_values: ^array [1 .. * ] of ^clt$data_value,
      p_data_values: ^array [1 .. * ] of clt$data_value,
      p_form_information: ^fdt$form_information,
      p_type_specification: ^clt$type_specification,
      p_variable_information: ^fdt$variable_information,
      p_variables: ^array [1 .. * ] of fdt$variable_information,
      p_work_area: ^clt$work_area,
      scl_variable_name: ost$name,
      scl_variable_reference: fdt$scl_variable_reference,
      sequence_length: integer,
      string_length: integer,
      total_sequence_length: integer,
      variable_index: fdt$variable_index,
      variable_status: fdt$variable_status;

{ Get information about form variables from Screen Formatting.
{ This information gives the name, data type and data length for all variables.

    get_form_attributes [1].key := fdc$get_number_variables;
    get_form_attributes [2].key := fdc$get_form_processor;
    fdp$get_form_attributes (form_identifier, get_form_attributes, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    form_processor := get_form_attributes [2].form_processor;
    p_form_information := ^fdv$p_form_list^ [fdv$form_index];
    p_form_information^.form_processor := form_processor;
    number_variables := get_form_attributes [1].number_variables;
    IF number_variables = 0 THEN
      RETURN;
    IFEND;

{ Get the attributes of the form variables from Screen Formatting and
{ store them for latter processing of the form. These variables do not
{ belong to a table.

    store_variables (form_identifier, number_variables, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    p_variables := p_form_information^.p_variables;

  /create_variable/
    FOR variable_index := 1 TO UPPERBOUND (p_variables^) DO
      p_variable_information := ^p_form_information^.
            p_variables^ [variable_index];

      RESET fdv$work_area.sequence_pointer;
      total_sequence_length := #SIZE (fdv$work_area.sequence_pointer^);
      IF p_variable_information^.occurrence < 2 THEN

{ Create a variable with no indexing.

        get_data_value (form_identifier, p_variable_information, 1, data_value,
              status);
        IF NOT status.normal THEN
          RETURN;
        IFEND;

      ELSE { An array type specification is required. }
        NEXT p_array_values: [1 .. p_variable_information^.occurrence] IN
              fdv$work_area.sequence_pointer;
        IF p_array_values = NIL THEN
          osp$set_status_abnormal (fdc$format_display_identifier,
                fde$no_space_available, '', status);
          RETURN;
        IFEND;

        NEXT p_data_values: [1 .. p_variable_information^.occurrence] IN
              fdv$work_area.sequence_pointer;
        IF p_data_values = NIL THEN
          osp$set_status_abnormal (fdc$format_display_identifier,
                fde$no_space_available, '', status);
          RETURN;
        IFEND;

        data_value.kind := clc$array;
        data_value.array_value := p_array_values;

        FOR occurrence := 1 TO p_variable_information^.occurrence DO
          get_data_value (form_identifier, p_variable_information, occurrence,
                p_data_values^ [occurrence], status);
          IF NOT status.normal THEN
            RETURN;
          IFEND;
          p_array_values^ [occurrence] := ^p_data_values^ [occurrence];
        FOREND;
      IFEND;

      convert_to_scl_name (p_variable_information^.name, form_processor,
            scl_variable_name);
      sequence_length := i#current_sequence_position
            (fdv$work_area.sequence_pointer);
      RESET fdv$work_area.sequence_pointer;
      IF sequence_length > 0 THEN
        NEXT p_work_area: [[REP sequence_length OF cell]] IN
              fdv$work_area.sequence_pointer;
      IFEND;
      NEXT p_work_area: [[REP (total_sequence_length -
            i#current_sequence_position (fdv$work_area.sequence_pointer)) OF
            cell]] IN fdv$work_area.sequence_pointer;
      RESET p_work_area;
      clp$derive_type_spec_from_value (^data_value, p_work_area,
            p_type_specification, status);
      IF NOT status.normal THEN
        RETURN;
      IFEND;

      clp$create_procedure_variable (scl_variable_name, clc$local_scope,
            clc$read_write, clc$immediate_evaluation, p_type_specification,
            ^data_value, status);
      p_variable_information^.created := status.normal;
      IF NOT status.normal THEN
        IF status.condition = cle$var_already_created THEN
          status.normal := TRUE;
          IF fdv$variable_evaluation = fdc$automatic THEN

{ Transfer value of SCL variable to Screen Formatting.

            replace_single_variable (p_variable_information, form_identifier,
                  form_processor, status);
            IF NOT status.normal THEN
              RETURN;
            IFEND;
          IFEND;
        IFEND;
      IFEND;
    FOREND /create_variable/;

  PROCEND create_single_variables;

?? TITLE := '  delete_form_from_list', EJECT ??

  PROCEDURE delete_form_from_list
    (    form_name: ost$name);

    VAR
      form_index: fdt$form_identifier,
      local_status: ost$status,
      p_form_information: ^fdt$form_information,
      p_variables: ^array [1 .. * ] of fdt$variable_information,
      table_index: fdt$table_index,
      variable_index: fdt$variable_index,
      variable_name: ost$name;

    FOR form_index := 1 TO fdv$high_form_index DO
      p_form_information := ^fdv$p_form_list^ [form_index];
      IF form_name = p_form_information^.name THEN
        p_form_information^.name := ' ';
        p_form_information^.added := FALSE;
        p_form_information^.push_index := 0;
        p_variables := p_form_information^.p_variables;

        IF p_variables <> NIL THEN
          IF p_form_information^.form_variable_created THEN
            clp$delete_variable (form_name, local_status);
            IF p_form_information^.p_tables <> NIL THEN
              FOR table_index := LOWERBOUND (p_form_information^.p_tables^)
                    TO UPPERBOUND (p_form_information^.p_tables^) DO
                IF p_form_information^.p_tables^ [table_index].
                      p_table_variables <> NIL THEN
                  FREE p_form_information^.p_tables^ [table_index].
                        p_table_variables;
                IFEND;
              FOREND;
              FREE p_form_information^.p_tables;
            IFEND;
            FREE p_form_information^.p_variables;

          ELSE { Single variables were created. Delete each variable. }

            FOR variable_index := 1 TO UPPERBOUND (p_variables^) DO
              IF p_variables^ [variable_index].created THEN
                convert_to_scl_name (p_variables^ [variable_index].name,
                      p_form_information^.form_processor, variable_name);
                clp$delete_variable (variable_name, local_status);
              IFEND;
            FOREND;

            FREE p_form_information^.p_variables;
          IFEND;
        IFEND;
      IFEND;
    FOREND;

  PROCEND delete_form_from_list;

?? TITLE := '  find_form_name', EJECT ??

  PROCEDURE [INLINE] find_variable_name
    (    name: ost$name;
     VAR p_variable_information: ^fdt$variable_information;
     VAR status: ost$status);

    VAR
      p_variables: ^array [1 .. * ] of fdt$variable_information,
      variable_index: fdt$variable_index;

    p_variables := fdv$p_form_list^ [fdv$form_index].p_variables;
    IF p_variables <> NIL THEN
      FOR variable_index := 1 TO UPPERBOUND (p_variables^) DO
        p_variable_information := ^p_variables^ [variable_index];
        IF name = p_variable_information^.name THEN
          status.normal := TRUE;
          RETURN;
        IFEND;
      FOREND;
    IFEND;

    osp$set_status_abnormal (fdc$format_display_identifier,
          fde$unknown_variable_name, '', status);
    osp$append_status_parameter (osc$status_parameter_delimiter, name, status);

  PROCEND find_variable_name;

?? TITLE := '  get_data_value', EJECT ??

  PROCEDURE get_data_value
    (    form_identifier: fdt$form_identifier;
         p_variable_information: ^fdt$variable_information;
         occurrence: fdt$occurrence;
     VAR data_value: clt$data_value;
     VAR status: ost$status);

    VAR
      form_name: ost$name,
      ignore_status: ost$status,
      p_string_value: ^string ( * ),
      real_value: real,
      variable_status: fdt$variable_status;

{ Get value of variable from Screen Formatting.

    status.normal := TRUE;
    CASE p_variable_information^.program_data_type OF

    = fdc$program_character_type, fdc$program_upper_case_type =
      NEXT p_string_value: [p_variable_information^.variable_length] IN
            fdv$work_area.sequence_pointer;
      IF p_string_value = NIL THEN
        osp$set_status_abnormal (fdc$format_display_identifier,
              fde$no_space_available, '', status);
        RETURN;
      IFEND;

      fdp$get_string_variable (form_identifier, p_variable_information^.name,
            occurrence, p_string_value^, variable_status, status);
      IF NOT status.normal THEN
        RETURN;
      IFEND;
      IF variable_status <> fdc$no_error THEN
        osp$set_status_abnormal (fdc$format_display_identifier, fde$bad_data_value, '', status);
        RETURN;
      IFEND;

      data_value.kind := clc$string;
      data_value.string_value := p_string_value;

    = fdc$program_integer_type =
      fdp$get_integer_variable (form_identifier, p_variable_information^.name,
            occurrence, data_value.integer_value.value, variable_status,
            status);
      IF NOT status.normal THEN
        RETURN;
      IFEND;
      IF variable_status <> fdc$no_error THEN
        osp$set_status_abnormal (fdc$format_display_identifier, fde$bad_data_value, '', status);
        RETURN;
      IFEND;

      data_value.kind := clc$integer;
      data_value.integer_value.radix := 10;
      data_value.integer_value.radix_specified := FALSE;

    = fdc$program_real_type =
      compute_scl_real(form_identifier, p_variable_information, occurrence,
            data_value, status);

    ELSE {fdc$program_cobol_type}
      osp$set_status_abnormal (fdc$format_display_identifier, fde$cobol_invalid_manage_form,
            p_variable_information^.name, status);
      get_form_name (form_identifier, form_name, ignore_status);
      osp$append_status_parameter (osc$status_parameter_delimiter, form_name, status);
    CASEND;

  PROCEND get_data_value;

?? TITLE := '  get_form_identifier', EJECT ??

  PROCEDURE [INLINE] get_form_identifier
    (    form_name: ost$name;
     VAR form_identifier: fdt$form_identifier;
     VAR status: ost$status);

    VAR
      form_index: fdt$form_identifier;

    FOR form_index := 1 TO fdv$high_form_index DO
      IF form_name = fdv$p_form_list^ [form_index].name THEN
        form_identifier := fdv$p_form_list^ [form_index].form_identifier;
        fdv$form_index := form_index;
        RETURN;
      IFEND;
    FOREND;

    osp$set_status_abnormal (fdc$format_display_identifier, fde$form_closed,
          form_name, status);

  PROCEND get_form_identifier;

?? TITLE := '  get_form_name', EJECT ??

  PROCEDURE [INLINE] get_form_name
    (    form_identifier: fdt$form_identifier;
     VAR form_name: ost$name;
     VAR status: ost$status);

    VAR
      form_index: fdt$form_identifier;

    FOR form_index := 1 TO fdv$high_form_index DO
      IF form_identifier = fdv$p_form_list^ [form_index].form_identifier THEN
        form_name := fdv$p_form_list^ [form_index].name;
        fdv$form_index := form_index;
        RETURN;
      IFEND;
    FOREND;

    osp$set_status_abnormal (fdc$format_display_identifier, fde$form_closed,
          form_name, status);

  PROCEND get_form_name;

?? TITLE := '  get_form_variable', EJECT ??

  PROCEDURE get_form_variable
    (    p_form_information: ^fdt$form_information;
     VAR status: ost$status);

    VAR
      data_value: clt$data_value,
      field_index: integer,
      form_identifier: fdt$form_identifier,
      form_processor: fdt$form_processor,
      occurrence: fdt$occurrence,
      p_array_values: ^array [ * ] of clt$data_value,
      p_data_value: ^clt$data_value,
      p_form_field_values: ^array [1 .. * ] of clt$field_value,
      p_table_data_values: ^array [1 .. * ] of clt$data_value,
      p_table_field_values: ^array [1 .. * ] of clt$field_value,
      p_table_array_values: ^array [1 .. * ] of ^clt$data_value,
      p_table_information: ^fdt$table_information,
      p_table_names: ^fdt$form_names,
      p_table_variables: ^array [1 .. * ] of fdt$table_variable_information,
      p_tables: ^array [1 .. * ] of fdt$table_information,
      p_type_specification: ^clt$type_specification,
      p_variable_information: ^fdt$variable_information,
      p_variable_names: ^fdt$form_names,
      p_variables: ^array [1 .. * ] of fdt$variable_information,
      p_work_area: ^clt$work_area,
      program_data_type: fdt$program_data_type,
      scl_variable_name: ost$name,
      sequence_length: integer,
      string_length: integer,
      string_value: string (256),
      table_index: fdt$table_index,
      table_variable_index: fdt$table_index,
      table_type_specification_size: clt$type_specification_size,
      total_sequence_length: integer,
      variable_index: fdt$variable_index,
      variable_length: integer,
      variable_name: ost$name,
      variable_number: fdt$number_names;

{ Transfer Screen Formatting variables to SCL form record.

    RESET fdv$work_area.sequence_pointer;
    total_sequence_length := #SIZE (fdv$work_area.sequence_pointer^);

{ Get all fields in the form record.  Each table and  each variable that
{ does not belong to a table is a field for the form record.

    NEXT p_form_field_values: [1 .. p_form_information^.number_of_fields] IN
          fdv$work_area.sequence_pointer;
    IF p_form_field_values = NIL THEN
      osp$set_status_abnormal (fdc$format_display_identifier,
            fde$no_space_available, '', status);
      RETURN;
    IFEND;

    field_index := 0;
    data_value.kind := clc$record;
    data_value.field_values := p_form_field_values;
    p_tables := p_form_information^.p_tables;
    p_variables := p_form_information^.p_variables;
    form_identifier := p_form_information^.form_identifier;
    form_processor := p_form_information^.form_processor;

    IF p_tables <> NIL THEN

    /process_tables/
      FOR table_index := 1 TO UPPERBOUND (p_tables^) DO
        p_table_information := ^p_tables^ [table_index];
        convert_to_scl_name (p_table_information^.name, form_processor,
              scl_variable_name);
        p_table_variables := p_table_information^.p_table_variables;

{ A table is an array of records.

        NEXT p_data_value IN fdv$work_area.sequence_pointer;
        IF p_data_value = NIL THEN
          osp$set_status_abnormal (fdc$format_display_identifier,
                fde$no_space_available, '', status);
          RETURN;
        IFEND;

        NEXT p_table_array_values: [1 .. p_table_information^.occurrence] IN
              fdv$work_area.sequence_pointer;
        IF p_table_array_values = NIL THEN
          osp$set_status_abnormal (fdc$format_display_identifier,
                fde$no_space_available, '', status);
          RETURN;
        IFEND;

        p_data_value^.kind := clc$array;
        p_data_value^.array_value := p_table_array_values;
        field_index := field_index + 1;
        p_form_field_values^ [field_index].name := scl_variable_name;
        p_form_field_values^ [field_index].value := p_data_value;

        NEXT p_table_data_values: [1 .. p_table_information^.occurrence] IN
              fdv$work_area.sequence_pointer;
        IF p_table_data_values = NIL THEN
          osp$set_status_abnormal (fdc$format_display_identifier,
                fde$no_space_available, '', status);
          RETURN;
        IFEND;

      /process_table_array/
        FOR occurrence := 1 TO p_table_information^.occurrence DO

{ The variables belonging to the table are fields.

          NEXT p_table_field_values: [1 .. UPPERBOUND (p_table_variables^)] IN
                fdv$work_area.sequence_pointer;
          IF p_table_field_values = NIL THEN
            osp$set_status_abnormal (fdc$format_display_identifier,
                  fde$no_space_available, '', status);
            RETURN;
          IFEND;

          p_table_array_values^ [occurrence] :=
                ^p_table_data_values^ [occurrence];
          p_table_data_values^ [occurrence].kind := clc$record;
          p_table_data_values^ [occurrence].field_values :=
                p_table_field_values;

        /process_table_variables/
          FOR table_variable_index := 1 TO UPPERBOUND (p_table_variables^) DO
            p_variable_information := p_table_variables^ [table_variable_index].
                  p_variable_information;
            convert_to_scl_name (p_variable_information^.name, form_processor,
                  scl_variable_name);

            NEXT p_data_value IN fdv$work_area.sequence_pointer;
            IF p_data_value = NIL THEN
              osp$set_status_abnormal (fdc$format_display_identifier,
                    fde$no_space_available, '', status);
              RETURN;
            IFEND;

            p_table_field_values^ [table_variable_index].name :=
                  scl_variable_name;
            p_table_field_values^ [table_variable_index].value := p_data_value;


{ Get the current value of the data value from Screen Formatting.

            get_data_value (form_identifier, p_variable_information, occurrence,
                  p_data_value^, status);
            IF NOT status.normal THEN
              RETURN;
            IFEND;
          FOREND /process_table_variables/;
        FOREND /process_table_array/;
      FOREND /process_tables/;
    IFEND;

{ Process variables that do not belong to a table.
{ Each variable is a field in the form record.

  /process_single_variables/
    FOR variable_index := 1 TO UPPERBOUND (p_variables^) DO
      IF p_variables^ [variable_index].table_member THEN
        CYCLE /process_single_variables/;
      IFEND;

      convert_to_scl_name (p_variables^ [variable_index].name, form_processor,
            scl_variable_name);
      NEXT p_data_value IN fdv$work_area.sequence_pointer;
      IF p_data_value = NIL THEN
        osp$set_status_abnormal (fdc$format_display_identifier,
              fde$no_space_available, '', status);
        RETURN;
      IFEND;

      field_index := field_index + 1;
      p_form_field_values^ [field_index].name := scl_variable_name;
      p_form_field_values^ [field_index].value := p_data_value;

{ Get the data value from Screen Formatting.

      get_data_value (form_identifier, ^p_variables^ [variable_index], 1,
            p_data_value^, status);
      IF NOT status.normal THEN
        RETURN;
      IFEND;
    FOREND /process_single_variables/;

    sequence_length := i#current_sequence_position
          (fdv$work_area.sequence_pointer);
    RESET fdv$work_area.sequence_pointer;
    NEXT p_work_area: [[REP sequence_length OF cell]] IN
          fdv$work_area.sequence_pointer;
    NEXT p_work_area: [[REP (total_sequence_length - sequence_length) OF
          cell]] IN fdv$work_area.sequence_pointer;
    RESET p_work_area;
    clp$change_variable (p_form_information^.name, ^data_value, status);
  PROCEND get_form_variable;

?? TITLE := '  get_single_variable', EJECT ??

  PROCEDURE get_single_variable
    (    p_variable_information: ^fdt$variable_information;
         number_of_occurrences: fdt$occurrence;
         form_identifier: fdt$form_identifier;
         form_processor: fdt$form_processor;
     VAR status: ost$status);

    VAR
      data_value: clt$data_value,
      occurrence: fdt$occurrence,
      p_array_values: ^array [1 .. * ] of ^clt$data_value,
      p_data_values: ^array [1 .. * ] of clt$data_value,
      p_type_specification: ^clt$type_specification,
      p_work_area: ^clt$work_area,
      scl_variable_name: ost$name,
      scl_variable_reference: fdt$scl_variable_reference,
      sequence_length: integer,
      total_sequence_length: integer,
      variable_status: fdt$variable_status;

{ Transfer a variable from Screen Formatting to SCL.

    RESET fdv$work_area.sequence_pointer;
    total_sequence_length := #SIZE (fdv$work_area.sequence_pointer^);
    IF number_of_occurrences < 2 THEN

{ The variable has only 1 occurrence. Get value of variable from
{ Screen Formatting.

      get_data_value (form_identifier, p_variable_information, 1, data_value,
            status);
      IF NOT status.normal THEN
        RETURN;
      IFEND;

    ELSE

{ The variable is an array. Get the value of each occurrence of the variable.

      NEXT p_array_values: [1 .. number_of_occurrences] IN
            fdv$work_area.sequence_pointer;
      IF p_array_values = NIL THEN
        osp$set_status_abnormal (fdc$format_display_identifier,
              fde$no_space_available, '', status);
        RETURN;
      IFEND;

      NEXT p_data_values: [1 .. number_of_occurrences] IN
            fdv$work_area.sequence_pointer;
      IF p_data_values = NIL THEN
        osp$set_status_abnormal (fdc$format_display_identifier,
              fde$no_space_available, '', status);
        RETURN;
      IFEND;

      data_value.kind := clc$array;
      data_value.array_value := p_array_values;

      FOR occurrence := 1 TO number_of_occurrences DO
        get_data_value (form_identifier, p_variable_information, occurrence,
              p_data_values^ [occurrence], status);
        IF NOT status.normal THEN
          RETURN;
        IFEND;
        p_array_values^ [occurrence] := ^p_data_values^ [occurrence];
      FOREND;
    IFEND;

    convert_to_scl_name (p_variable_information^.name, form_processor,
          scl_variable_name);
    sequence_length := i#current_sequence_position
          (fdv$work_area.sequence_pointer);
    RESET fdv$work_area.sequence_pointer;
    IF sequence_length > 0 THEN
      NEXT p_work_area: [[REP sequence_length OF cell]] IN
            fdv$work_area.sequence_pointer;
    IFEND;
    NEXT p_work_area: [[REP (total_sequence_length -
          i#current_sequence_position (fdv$work_area.sequence_pointer)) OF
          cell]] IN fdv$work_area.sequence_pointer;
    RESET p_work_area;
    clp$change_variable (scl_variable_name, ^data_value, status);

  PROCEND get_single_variable;

?? TITLE := '  get_variables', EJECT ??

  PROCEDURE get_variables
    (VAR status: ost$status);

    VAR
      form_identifier: fdt$form_identifier,
      form_index: fdt$form_identifier,
      form_processor: fdt$form_processor,
      p_form_information: ^fdt$form_information,
      p_variable_information: ^fdt$variable_information,
      p_variables: ^array [1 .. * ] of fdt$variable_information,
      variable_index: fdt$variable_index;

  /update_active_forms/
    FOR form_index := 1 TO fdv$high_form_index DO
      p_form_information := ^fdv$p_form_list^ [form_index];
      IF p_form_information^.added AND (p_form_information^.push_index = 0) AND
            (p_form_information^.p_variables <> NIL) THEN
        form_identifier := p_form_information^.form_identifier;
        IF fdv$variable_creation = fdc$form_variable THEN

{ Transfer Screen Formatting variables to SCL form variable.

          get_form_variable (p_form_information, status);
          IF NOT status.normal THEN
            RETURN;
          IFEND;
        ELSE

{ Transfer Screen Formatting variables to SCL single variables.

          p_variables := p_form_information^.p_variables;
          form_identifier := p_form_information^.form_identifier;
          form_processor := p_form_information^.form_processor;
          FOR variable_index := 1 TO UPPERBOUND (p_variables^) DO
            p_variable_information := ^p_variables^ [variable_index];
            get_single_variable (p_variable_information,
                  p_variable_information^.occurrence, form_identifier,
                  form_processor, status);
            IF NOT status.normal THEN
              RETURN;
            IFEND;
          FOREND;
        IFEND;
      IFEND;
    FOREND /update_active_forms/;

  PROCEND get_variables;

?? TITLE := '  replace_data_value', EJECT ??

  PROCEDURE replace_data_value
    (    form_identifier: fdt$form_identifier;
         variable_name: ost$name;
         occurrence: fdt$occurrence;
     VAR data_value: clt$data_value;
     VAR status: ost$status);

    VAR
      p_string_value: ^string ( * ),
      real_value: real,
      variable_status: fdt$variable_status;

    status.normal := TRUE;
    CASE data_value.kind OF

    = clc$string =
      fdp$replace_string_variable (form_identifier, variable_name, occurrence,
            data_value.string_value^, variable_status, status);
      IF NOT status.normal THEN
        RETURN;
      IFEND;
      IF variable_status <> fdc$no_error THEN
        osp$set_status_abnormal (fdc$format_display_identifier, fde$bad_data_value, '', status);
        RETURN;
      IFEND;

    = clc$integer =
      fdp$replace_integer_variable (form_identifier, variable_name, occurrence,
            data_value.integer_value.value, variable_status, status);
      IF NOT status.normal THEN
        RETURN;
      IFEND;
      IF variable_status <> fdc$no_error THEN
        osp$set_status_abnormal (fdc$format_display_identifier, fde$bad_data_value, '', status);
        RETURN;
      IFEND;

    = clc$real =

{ SCL uses double precision real numbers while  CYBIL and Screen Formatting
{ use single precision real numbers.  Transfer only the most significant
{ part of the double precision number to Screen Formatting.

      real_value := $REAL (data_value.real_value.value);
      fdp$replace_real_variable (form_identifier, variable_name, occurrence,
            real_value, variable_status, status);
      IF NOT status.normal THEN
        RETURN;
      IFEND;
      IF variable_status <> fdc$no_error THEN
        osp$set_status_abnormal (fdc$format_display_identifier, fde$bad_data_value, '', status);
        RETURN;
      IFEND;

    ELSE
      osp$set_status_abnormal (fdc$format_display_identifier, fde$system_error,
            'invalid program_data_type', status);
    CASEND;

  PROCEND replace_data_value;

?? TITLE := '  replace_form_variable', EJECT ??

  PROCEDURE replace_form_variable
    (    p_form_information: ^fdt$form_information;
     VAR status: ost$status);

    VAR
      data_access_mode: clt$data_access_mode,
      data_value: clt$data_value,
      expression_eval_method: clt$expression_eval_method,
      field_index: integer,
      form_identifier: fdt$form_identifier,
      form_processor: fdt$form_processor,
      form_variable_name: ost$name,
      occurrence: fdt$occurrence,
      p_data_value: ^clt$data_value,
      p_form_field_values: ^array [1 .. * ] of clt$field_value,
      p_table_array_values: ^array [ * ] of ^clt$data_value,
      p_table_data_value: ^clt$data_value,
      p_table_field_values: ^array [1 .. * ] of clt$field_value,
      p_type_specification: ^clt$type_specification,
      table_variable_index: fdt$table_variable_index,
      variable_class: clt$variable_class;

{ Get SCL form record.

    RESET fdv$work_area.sequence_pointer;
    clp$get_variable (p_form_information^.name, fdv$work_area.sequence_pointer,
          variable_class, data_access_mode, expression_eval_method,
          p_type_specification, p_data_value, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    IF p_data_value = NIL THEN
      RETURN;
    IFEND;

    form_processor := p_form_information^.form_processor;
    form_identifier := p_form_information^.form_identifier;
    IF p_data_value^.kind <> clc$record THEN
      osp$set_status_abnormal (fdc$format_display_identifier, fde$system_error,
            'SCL returned unexpected data type', status);
      RETURN;
    IFEND;

{ Transfer values of record fields to Screen Formatting.

    p_form_field_values := p_data_value^.field_values;

  /process_form_fields/
    FOR field_index := LOWERBOUND (p_form_field_values^)
          TO UPPERBOUND (p_form_field_values^) DO
      p_data_value := p_form_field_values^ [field_index].value;
      CASE p_data_value^.kind OF

      = clc$string, clc$real, clc$integer =
        convert_to_form_name (p_form_field_values^ [field_index].name,
              form_processor, form_variable_name);
        replace_data_value (form_identifier, form_variable_name, 1,
              p_data_value^, status);

      = clc$array =

{ The field is a Screen Formatting table.
{ A Screen Formatting table is an array of records.  Each record has
{ one or more fields.

      /process_table_array/
        FOR occurrence := LOWERBOUND (p_data_value^.array_value^)
              TO UPPERBOUND (p_data_value^.array_value^) DO
          p_table_array_values := p_data_value^.array_value;
          p_table_data_value := p_table_array_values^ [occurrence];
          p_table_field_values := p_table_data_value^.field_values;

        /process_table_fields/
          FOR table_variable_index := LOWERBOUND (p_table_field_values^)
                TO UPPERBOUND (p_table_field_values^) DO

{ Convert the SCL name for a field to the name used by the processor of the
{ form.  This allows COBOL forms to be prototyped using SCL.

            convert_to_form_name (p_table_field_values^ [table_variable_index].name,
                  form_processor, form_variable_name);
            replace_data_value (form_identifier, form_variable_name, occurrence,
                  p_table_field_values^ [table_variable_index].value^, status);
            IF NOT status.normal THEN
              RETURN;
            IFEND;
          FOREND /process_table_fields/;
        FOREND /process_table_array/;

      ELSE
        osp$set_status_abnormal (fdc$format_display_identifier,
              fde$system_error, 'SCL returned unexpected data type', status);
        RETURN;

      CASEND;
    FOREND /process_form_fields/;
  PROCEND replace_form_variable;

?? TITLE := '  replace_single_variable', EJECT ??

  PROCEDURE replace_single_variable
    (    p_variable_information: ^fdt$variable_information;
         form_identifier: fdt$form_identifier;
         form_processor: fdt$form_processor;
     VAR status: ost$status);

    VAR
      data_access_mode: clt$data_access_mode,
      expression_eval_method: clt$expression_eval_method,
      occurrence: fdt$occurrence,
      p_array_data_value: ^clt$data_value,
      p_data_value: ^clt$data_value,
      p_type_specification: ^clt$type_specification,
      scl_variable_name: ost$name,
      variable_class: clt$variable_class;

    RESET fdv$work_area.sequence_pointer;

{ Use an SCL name rather than the form name for a variable.
{ This allows COBOL forms to be protyped through SCL.

    convert_to_scl_name (p_variable_information^.name, form_processor,
          scl_variable_name);

{ Get value of SCL variable and transfer it to Screen Formatting.

    clp$get_variable (scl_variable_name, fdv$work_area.sequence_pointer,
          variable_class, data_access_mode, expression_eval_method,
          p_type_specification, p_data_value, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    IF p_data_value = NIL THEN
      RETURN;
    IFEND;

    IF p_data_value^.kind <> clc$array THEN

{ Process a single occurrence of a variable.

      replace_data_value (form_identifier, p_variable_information^.name, 1,
            p_data_value^, status);
      RETURN;
    IFEND;

{ Process a variable that has more than one occurrence.

  /process_next_occurrence/
    FOR occurrence := LOWERBOUND (p_data_value^.array_value^)
          TO UPPERBOUND (p_data_value^.array_value^) DO
      p_array_data_value := p_data_value^.array_value^ [occurrence];
      replace_data_value (form_identifier, p_variable_information^.name,
            occurrence, p_array_data_value^, status);
      IF NOT status.normal THEN
        RETURN;
      IFEND;
    FOREND /process_next_occurrence/;
  PROCEND replace_single_variable;

?? TITLE := '  replace_variables', EJECT ??

  PROCEDURE replace_variables
    (VAR status: ost$status);

    VAR
      form_identifier: fdt$form_identifier,
      form_index: fdt$form_identifier,
      form_processor: fdt$form_processor,
      p_form_information: ^fdt$form_information,
      p_variable_information: ^fdt$variable_information,
      p_variables: ^array [1 .. * ] of fdt$variable_information,
      variable_index: fdt$variable_index;

  /process_active_forms/
    FOR form_index := 1 TO fdv$high_form_index DO
      p_form_information := ^fdv$p_form_list^ [form_index];
      IF p_form_information^.added AND (p_form_information^.push_index = 0) AND
            (p_form_information^.p_variables <> NIL) THEN
        IF fdv$variable_creation = fdc$form_variable THEN

{ Transfer SCL form variable to Screen Formatting.

          replace_form_variable (p_form_information, status);

        ELSE

{ Transfer SCL single variables to Screen Formatting.

          p_variables := p_form_information^.p_variables;
          form_identifier := p_form_information^.form_identifier;
          form_processor := p_form_information^.form_processor;
          FOR variable_index := 1 TO UPPERBOUND (p_variables^) DO
            p_variable_information := ^p_variables^ [variable_index];
            replace_single_variable (p_variable_information, form_identifier,
                  form_processor, status);
            IF NOT status.normal THEN
              RETURN;
            IFEND;
          FOREND;
        IFEND;
      IFEND;
    FOREND /process_active_forms/;

  PROCEND replace_variables;

?? TITLE := '  store_tables', EJECT ??

  PROCEDURE store_tables
    (    form_identifier: fdt$form_identifier;
         number_tables: fdt$number_names;
         p_variables: ^array [1 .. * ] of fdt$variable_information;
     VAR status: ost$status);

    VAR
      get_table_attributes: array [1 .. 3] of fdt$get_table_attribute,
      number_names: fdt$number_names,
      number_table_variables: fdt$number_table_variables,
      p_get_table_attributes: ^array [1 .. * ] of fdt$get_table_attribute,
      p_table_information: ^fdt$table_information,
      p_table_names: ^fdt$form_names,
      p_table_variables: ^array [1 .. * ] of fdt$table_variable_information,
      p_tables: ^array [1 .. * ] of fdt$table_information,
      table_index: fdt$table_index,
      table_name: ost$name,
      table_variable_index: fdt$table_variable_index,
      variable_index: fdt$variable_index;

{ Get the names of tables for the form.

    PUSH p_table_names: [1 .. number_tables];
    IF p_table_names = NIL THEN
      osp$set_status_abnormal (fdc$format_display_identifier,
            fde$no_space_available, '', status);
      RETURN;
    IFEND;

    fdp$get_form_names (form_identifier, $fdt$name_selections
          [fdc$select_table], p_table_names^, number_names, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

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

    fdv$p_form_list^ [fdv$form_index].p_tables := p_tables;

{ Get information about the variables that belong to each table.

    FOR table_index := 1 TO number_names DO
      get_table_attributes [1].key := fdc$get_number_table_variables;
      get_table_attributes [2].key := fdc$get_stored_occurrence;
      get_table_attributes [3].key := fdc$get_number_table_variables;
      table_name := p_table_names^ [table_index].name;
      fdp$get_table_attributes (form_identifier, table_name,
            get_table_attributes, status);
      IF NOT status.normal THEN
        RETURN;
      IFEND;

      p_tables^ [table_index].name := table_name;
      p_tables^ [table_index].occurrence :=
            get_table_attributes [2].stored_occurrence;
      store_table_variables (form_identifier, table_name,
            get_table_attributes [3].number_table_variables,
            ^p_tables^ [table_index], p_variables, status);
      IF NOT status.normal THEN
        RETURN;
      IFEND;
    FOREND;
  PROCEND store_tables;

?? TITLE := '  store_table_variables', EJECT ??

  PROCEDURE store_table_variables
    (    form_identifier: fdt$form_identifier;
         table_name: ost$name;
         number_table_variables: fdt$number_table_variables;
         p_table_information: ^fdt$table_information;
         p_variables: ^array [1 .. * ] of fdt$variable_information;
     VAR status: ost$status);

    VAR
      p_get_table_attributes: ^array [1 .. * ] of fdt$get_table_attribute,
      p_table_variables: ^array [1 .. * ] of fdt$table_variable_information,
      p_tables: ^array [1 .. * ] of fdt$table_information,
      table_variable_index: fdt$table_variable_index,
      variable_index: fdt$variable_index;

    ALLOCATE p_table_information^.p_table_variables:
          [1 .. number_table_variables];
    IF p_table_information^.p_table_variables = NIL THEN
      osp$set_status_abnormal (fdc$format_display_identifier,
            fde$no_space_available, '', status);
      RETURN;
    IFEND;

    FOR table_variable_index := 1 TO number_table_variables DO
      p_table_information^.p_table_variables^ [table_variable_index].
            p_variable_information := NIL;
    FOREND;

{ Get the attributes of tables.  Manage_forms must know the variables
{ associated with a table.

    PUSH p_get_table_attributes: [1 .. number_table_variables];
    IF p_get_table_attributes = NIL THEN
      osp$set_status_abnormal (fdc$format_display_identifier,
            fde$no_space_available, '', status);
      RETURN;
    IFEND;

    FOR table_variable_index := 1 TO number_table_variables DO
      p_get_table_attributes^ [table_variable_index].key :=
            fdc$get_next_table_variable;
    FOREND;

    fdp$get_table_attributes (form_identifier, table_name,
          p_get_table_attributes^, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    FOR table_variable_index := 1 TO number_table_variables DO

    /link_variables/
      FOR variable_index := 1 TO UPPERBOUND (p_variables^) DO
        IF (p_variables^ [variable_index].name =
              p_get_table_attributes^ [table_variable_index].variable_name) THEN
          p_table_information^.p_table_variables^ [table_variable_index].
                p_variable_information := ^p_variables^ [variable_index];
          EXIT /link_variables/;
        IFEND;
      FOREND /link_variables/;
    FOREND;
  PROCEND store_table_variables;

?? TITLE := '  store_variables', EJECT ??

  PROCEDURE store_variables
    (    form_identifier: fdt$form_identifier;
         number_variables: fdt$number_variables;
     VAR status: ost$status);

    VAR
      name_selections: fdt$name_selections,
      number_names: fdt$number_names,
      p_variable_information: ^fdt$variable_information,
      p_variable_names: ^fdt$form_names,
      p_variables: ^array [1 .. * ] of fdt$variable_information,
      variable_attributes: array [1 .. 2] of fdt$get_variable_attribute,
      variable_index: fdt$variable_index;

    PUSH p_variable_names: [1 .. number_variables];
    IF p_variable_names = NIL THEN
      osp$set_status_abnormal (fdc$format_display_identifier,
            fde$no_space_available, '', status);
      RETURN;
    IFEND;

{ Get names of all variables on form.

    name_selections := $fdt$name_selections [fdc$select_variable];
    fdp$get_form_names (form_identifier, name_selections, p_variable_names^,
          number_names, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    ALLOCATE fdv$p_form_list^ [fdv$form_index].p_variables: [1 .. number_names];
    p_variables := fdv$p_form_list^ [fdv$form_index].p_variables;
    IF p_variables = NIL THEN
      osp$set_status_abnormal (fdc$format_display_identifier,
            fde$no_space_available, '', status);
      RETURN;
    IFEND;

{ Get attributes of variables.  Manage_forms will need the variable data type,
{ variable length, and number of occurrences.

    FOR variable_index := 1 TO number_names DO
      p_variable_information := ^p_variables^ [variable_index];
      p_variable_information^.name := p_variable_names^ [variable_index].name;
      variable_attributes [1].key := fdc$get_program_data_type;
      variable_attributes [2].key := fdc$get_variable_length;
      fdp$get_variable_attributes (form_identifier,
            p_variable_information^.name, variable_attributes, status);
      IF NOT status.normal THEN
        RETURN;
      IFEND;


      p_variable_information^.program_data_type :=
            variable_attributes [1].program_data_type;
      p_variable_information^.variable_length :=
            variable_attributes [2].variable_length;
      fdp$get_number_of_occurrences (form_identifier,
            p_variable_information^.name, p_variable_information^.table_member,
            p_variable_information^.occurrence, status);
      IF NOT status.normal THEN
        RETURN;
      IFEND;

    FOREND;

  PROCEND store_variables;



MODEND fdm$manage_forms;

