
?? RIGHT := 110 ??
?? NEWTITLE := 'NOS/VE Screen Formatting : Create Form Module' ??
MODULE fdm$create_form_module;

{ PURPOSE:
{   This module creates a form binary from a form source language definition.
{   The form definition language uses SCL.
{
{ DESIGN:
{   This modules uses procedures furnished by SCL to do most of the processing.

?? NEWTITLE := 'Global Declarations Referenced by this Module', EJECT ??
?? PUSH (LISTEXT := ON) ??
*copyc fdc$maximum_valid_ranges
*copyc fdc$system_currency_sign
*copyc fdc$system_decimal_point
*copyc fdc$system_thousands_separator
*copyc fdt$form_module
*copyc fdt$sign_treatment
*copyc fdv$screen_status
*copyc ost$stack_frame_save_area
?? POP ??

*copyc amp$get_segment_pointer
*copyc amp$set_segment_eoi

*copyc clp$begin_utility
*copyc clp$count_list_elements
*copyc clp$end_include
*copyc clp$end_utility
*copyc clp$evaluate_parameters
*copyc clp$include_file
*copyc clp$trimmed_string_size

*copyc fdp$change_form
*copyc fdp$change_form_record
*copyc fdp$change_variable
*copyc fdp$close_form
*copyc fdp$create_form
*copyc fdp$create_object
*copyc fdp$create_stored_object
*copyc fdp$create_table
*copyc fdp$create_variable
*copyc fdp$end_form
*copyc fdp$write_form_definition

*copyc fsp$close_file
*copyc fsp$open_file

*copyc i#current_sequence_position

*copyc mmp$create_scratch_segment
*copyc mmp$delete_scratch_segment

*copyc osp$append_status_integer
*copyc osp$append_status_parameter
*copyc osp$generate_error_message
*copyc osp$set_status_abnormal
?? OLDTITLE ??
?? NEWTITLE := 'Global Declarations Declared by This Module', EJECT ??

  TYPE
    fdt$long_real_record = record
      first_real: real,
      second_real: real,
    recend;

  VAR
    create_form: boolean,
    current_form_name: ost$name,
    current_form_identifier: fdt$form_identifier,
    form_ended: boolean := TRUE,
    form_processor: fdt$form_processor;

?? OLDTITLE ??
?? NEWTITLE := 'Gobal Read Storage', EJECT ??

  SECTION
    global_storage: READ;

  VAR
    one_blank: [READ, STATIC, global_storage] string (1) := ' ',
    to_cobol: [READ, STATIC, global_storage] string (256) :=
          '???????????????????????????????' CAT
          '? ????????????-??0123456789???????ABCDEFGHIJKLMNOPQRSTUVWXYZ' CAT
          '????-?abcdefghijklmnopqrstuvwxyz' CAT '??????????????????????????????????????????????????????????'
          CAT '??????????????????????????' CAT '?????????????????????????????????????????????????',
    to_scl: [READ, STATIC, global_storage] string (256) :=
          '???????????????????????????????' CAT
          '? ????????????_??0123456789???????ABCDEFGHIJKLMNOPQRSTUVWXYZ' CAT
          '????-?abcdefghijklmnopqrstuvwxyz' CAT '??????????????????????????????????????????????????????????'
          CAT '??????????????????????????' CAT '?????????????????????????????????????????????????',
    utility_name: [READ, STATIC, global_storage] ost$name := 'CREATE_FORM_MODULE',
    utility_prompt: [READ, STATIC, global_storage] string (3) := 'CFM';

?? OLDTITLE ??
?? NEWTITLE := 'Command List', EJECT ??

  SECTION
    fds$sub_commands_and_functions: READ;

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

{ table sub_commands type=command section_name=fds$sub_commands_and_functions scope=local
{ command (add_box,                addb)   add_box
{ command (add_constant_text,      addct)  add_constant_text
{ command (add_constant_text_box,  addctb) add_constant_text_box
{ command (add_display,            addd)   add_display
{ command (add_event,              adde)   add_event
{ command (add_line,               addl)   add_line
{ command (add_stored_text,        addst)  add_stored_text
{ command (add_table,              addt)   add_table
{ command (add_variable,           addv)   add_variable
{ command (add_variable_text,      addvt)  add_variable_text
{ command (add_variable_text_box,  addvtb) add_variable_text_box
{ command (set_character_input,    setci)  set_character_input
{ command (set_cobol_data,         setcd)  set_cobol_data
{ command (set_cobol_output        setco)  set_cobol_output
{ command (set_date_input,         setdi)  set_date_input
{ command (set_date_output,        setdo)  set_date_output
{ command (set_exponent_output,    seteo)  set_exponent_output
{ command (set_float_output,       setfo)  set_float_output
{ command (set_form,               setf)   set_form cm=local
{ command (set_integer_input,      setii)  set_integer_input
{ command (set_integer_output,     setio)  set_integer_output
{ command (set_money_input,        setmi)  set_money_input
{ command (set_money_output,       setmo)  set_money_output
{ command (set_real_input,         setri)  set_real_input
{ command (end_form_module,        quit,qui,endfm) end_form_module
{ tablend

?? PUSH (LISTEXT := ON) ??

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

  sub_commands_entries: [STATIC, READ, fds$sub_commands_and_functions] array [1 .. 52] of
      clt$command_table_entry := [
  {} ['ADDB                           ', clc$abbreviation_entry, clc$normal_usage_entry, 1,
        clc$automatically_log, clc$linked_call, ^add_box],
  {} ['ADDCT                          ', clc$abbreviation_entry, clc$normal_usage_entry, 2,
        clc$automatically_log, clc$linked_call, ^add_constant_text],
  {} ['ADDCTB                         ', clc$abbreviation_entry, clc$normal_usage_entry, 3,
        clc$automatically_log, clc$linked_call, ^add_constant_text_box],
  {} ['ADDD                           ', clc$abbreviation_entry, clc$normal_usage_entry, 4,
        clc$automatically_log, clc$linked_call, ^add_display],
  {} ['ADDE                           ', clc$abbreviation_entry, clc$normal_usage_entry, 5,
        clc$automatically_log, clc$linked_call, ^add_event],
  {} ['ADDL                           ', clc$abbreviation_entry, clc$normal_usage_entry, 6,
        clc$automatically_log, clc$linked_call, ^add_line],
  {} ['ADDST                          ', clc$abbreviation_entry, clc$normal_usage_entry, 7,
        clc$automatically_log, clc$linked_call, ^add_stored_text],
  {} ['ADDT                           ', clc$abbreviation_entry, clc$normal_usage_entry, 8,
        clc$automatically_log, clc$linked_call, ^add_table],
  {} ['ADDV                           ', clc$abbreviation_entry, clc$normal_usage_entry, 9,
        clc$automatically_log, clc$linked_call, ^add_variable],
  {} ['ADDVT                          ', clc$abbreviation_entry, clc$normal_usage_entry, 10,
        clc$automatically_log, clc$linked_call, ^add_variable_text],
  {} ['ADDVTB                         ', clc$abbreviation_entry, clc$normal_usage_entry, 11,
        clc$automatically_log, clc$linked_call, ^add_variable_text_box],
  {} ['ADD_BOX                        ', clc$nominal_entry, clc$normal_usage_entry, 1,
        clc$automatically_log, clc$linked_call, ^add_box],
  {} ['ADD_CONSTANT_TEXT              ', clc$nominal_entry, clc$normal_usage_entry, 2,
        clc$automatically_log, clc$linked_call, ^add_constant_text],
  {} ['ADD_CONSTANT_TEXT_BOX          ', clc$nominal_entry, clc$normal_usage_entry, 3,
        clc$automatically_log, clc$linked_call, ^add_constant_text_box],
  {} ['ADD_DISPLAY                    ', clc$nominal_entry, clc$normal_usage_entry, 4,
        clc$automatically_log, clc$linked_call, ^add_display],
  {} ['ADD_EVENT                      ', clc$nominal_entry, clc$normal_usage_entry, 5,
        clc$automatically_log, clc$linked_call, ^add_event],
  {} ['ADD_LINE                       ', clc$nominal_entry, clc$normal_usage_entry, 6,
        clc$automatically_log, clc$linked_call, ^add_line],
  {} ['ADD_STORED_TEXT                ', clc$nominal_entry, clc$normal_usage_entry, 7,
        clc$automatically_log, clc$linked_call, ^add_stored_text],
  {} ['ADD_TABLE                      ', clc$nominal_entry, clc$normal_usage_entry, 8,
        clc$automatically_log, clc$linked_call, ^add_table],
  {} ['ADD_VARIABLE                   ', clc$nominal_entry, clc$normal_usage_entry, 9,
        clc$automatically_log, clc$linked_call, ^add_variable],
  {} ['ADD_VARIABLE_TEXT              ', clc$nominal_entry, clc$normal_usage_entry, 10,
        clc$automatically_log, clc$linked_call, ^add_variable_text],
  {} ['ADD_VARIABLE_TEXT_BOX          ', clc$nominal_entry, clc$normal_usage_entry, 11,
        clc$automatically_log, clc$linked_call, ^add_variable_text_box],
  {} ['ENDFM                          ', clc$abbreviation_entry, clc$normal_usage_entry, 25,
        clc$automatically_log, clc$linked_call, ^end_form_module],
  {} ['END_FORM_MODULE                ', clc$nominal_entry, clc$normal_usage_entry, 25,
        clc$automatically_log, clc$linked_call, ^end_form_module],
  {} ['QUI                            ', clc$alias_entry, clc$normal_usage_entry, 25,
        clc$automatically_log, clc$linked_call, ^end_form_module],
  {} ['QUIT                           ', clc$alias_entry, clc$normal_usage_entry, 25,
        clc$automatically_log, clc$linked_call, ^end_form_module],
  {} ['SETCD                          ', clc$abbreviation_entry, clc$normal_usage_entry, 13,
        clc$automatically_log, clc$linked_call, ^set_cobol_data],
  {} ['SETCI                          ', clc$abbreviation_entry, clc$normal_usage_entry, 12,
        clc$automatically_log, clc$linked_call, ^set_character_input],
  {} ['SETCO                          ', clc$abbreviation_entry, clc$normal_usage_entry, 14,
        clc$automatically_log, clc$linked_call, ^set_cobol_output],
  {} ['SETDI                          ', clc$abbreviation_entry, clc$normal_usage_entry, 15,
        clc$automatically_log, clc$linked_call, ^set_date_input],
  {} ['SETDO                          ', clc$abbreviation_entry, clc$normal_usage_entry, 16,
        clc$automatically_log, clc$linked_call, ^set_date_output],
  {} ['SETEO                          ', clc$abbreviation_entry, clc$normal_usage_entry, 17,
        clc$automatically_log, clc$linked_call, ^set_exponent_output],
  {} ['SETF                           ', clc$abbreviation_entry, clc$normal_usage_entry, 19,
        clc$automatically_log, clc$linked_call, ^set_form],
  {} ['SETFO                          ', clc$abbreviation_entry, clc$normal_usage_entry, 18,
        clc$automatically_log, clc$linked_call, ^set_float_output],
  {} ['SETII                          ', clc$abbreviation_entry, clc$normal_usage_entry, 20,
        clc$automatically_log, clc$linked_call, ^set_integer_input],
  {} ['SETIO                          ', clc$abbreviation_entry, clc$normal_usage_entry, 21,
        clc$automatically_log, clc$linked_call, ^set_integer_output],
  {} ['SETMI                          ', clc$abbreviation_entry, clc$normal_usage_entry, 22,
        clc$automatically_log, clc$linked_call, ^set_money_input],
  {} ['SETMO                          ', clc$abbreviation_entry, clc$normal_usage_entry, 23,
        clc$automatically_log, clc$linked_call, ^set_money_output],
  {} ['SETRI                          ', clc$abbreviation_entry, clc$normal_usage_entry, 24,
        clc$automatically_log, clc$linked_call, ^set_real_input],
  {} ['SET_CHARACTER_INPUT            ', clc$nominal_entry, clc$normal_usage_entry, 12,
        clc$automatically_log, clc$linked_call, ^set_character_input],
  {} ['SET_COBOL_DATA                 ', clc$nominal_entry, clc$normal_usage_entry, 13,
        clc$automatically_log, clc$linked_call, ^set_cobol_data],
  {} ['SET_COBOL_OUTPUT               ', clc$nominal_entry, clc$normal_usage_entry, 14,
        clc$automatically_log, clc$linked_call, ^set_cobol_output],
  {} ['SET_DATE_INPUT                 ', clc$nominal_entry, clc$normal_usage_entry, 15,
        clc$automatically_log, clc$linked_call, ^set_date_input],
  {} ['SET_DATE_OUTPUT                ', clc$nominal_entry, clc$normal_usage_entry, 16,
        clc$automatically_log, clc$linked_call, ^set_date_output],
  {} ['SET_EXPONENT_OUTPUT            ', clc$nominal_entry, clc$normal_usage_entry, 17,
        clc$automatically_log, clc$linked_call, ^set_exponent_output],
  {} ['SET_FLOAT_OUTPUT               ', clc$nominal_entry, clc$normal_usage_entry, 18,
        clc$automatically_log, clc$linked_call, ^set_float_output],
  {} ['SET_FORM                       ', clc$nominal_entry, clc$normal_usage_entry, 19,
        clc$automatically_log, clc$linked_call, ^set_form],
  {} ['SET_INTEGER_INPUT              ', clc$nominal_entry, clc$normal_usage_entry, 20,
        clc$automatically_log, clc$linked_call, ^set_integer_input],
  {} ['SET_INTEGER_OUTPUT             ', clc$nominal_entry, clc$normal_usage_entry, 21,
        clc$automatically_log, clc$linked_call, ^set_integer_output],
  {} ['SET_MONEY_INPUT                ', clc$nominal_entry, clc$normal_usage_entry, 22,
        clc$automatically_log, clc$linked_call, ^set_money_input],
  {} ['SET_MONEY_OUTPUT               ', clc$nominal_entry, clc$normal_usage_entry, 23,
        clc$automatically_log, clc$linked_call, ^set_money_output],
  {} ['SET_REAL_INPUT                 ', clc$nominal_entry, clc$normal_usage_entry, 24,
        clc$automatically_log, clc$linked_call, ^set_real_input]];

?? POP ??

?? OLDTITLE ??
?? NEWTITLE := '[XDCL] fdp$begin_create_form_module', EJECT ??
*copy fdh$begin_create_form_module

  PROCEDURE [XDCL] fdp$begin_create_form_module
    (    form_name: ost$name;
     VAR form_identifier: fdt$form_identifier;
     VAR create_module: boolean;
     VAR status: ost$status);

    VAR
      errors_p: ^SEQ ( * ),
      form_attributes: array [1 .. 3] of fdt$form_attribute,
      form_errors: amt$segment_pointer,
      local_status: ost$status,
      number_errors: integer,
      utility_attributes: array [1 .. 5] of clt$utility_attribute;

    status.normal := TRUE;
    IF NOT form_ended THEN
      osp$set_status_abnormal (fdc$format_display_identifier, fde$form_not_ended, current_form_name, status);
      RETURN;
    IFEND;

    form_ended := FALSE;
    form_attributes [1].key := fdc$form_name;
    form_attributes [1].form_name := form_name;
    form_attributes [2].key := fdc$form_processor;
    form_attributes [2].form_processor := fdc$cobol_processor;
    form_attributes [3].key := fdc$validate_variable_values;
    form_attributes [3].validate_variable_values := TRUE;
    current_form_name := form_name;
    form_processor := fdc$cobol_processor;
    fdp$create_form (form_identifier, form_attributes, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    current_form_identifier := form_identifier;
    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 := sub_commands;
    utility_attributes [3].key := clc$utility_prompt;
    utility_attributes [3].prompt.value := utility_prompt;
    utility_attributes [3].prompt.size := 3;
    utility_attributes [4].key := clc$utility_termination_command;
    utility_attributes [4].termination_command := 'end_form_module';
    utility_attributes [5].key := clc$utility_subcmnd_log_enabled;
    utility_attributes [5].subcommand_logging_enabled := TRUE;
    clp$begin_utility (utility_name, utility_attributes, status);
    IF NOT status.normal THEN
      fdp$close_form (current_form_identifier, local_status);
      RETURN;
    IFEND;

    clp$include_file (clc$current_command_input, utility_prompt, utility_name, status);
    form_ended := TRUE;
    IF NOT status.normal THEN
      fdp$close_form (current_form_identifier, local_status);
      RETURN;
    IFEND;

    clp$end_utility (utility_name, status);
    IF NOT status.normal THEN
      fdp$close_form (current_form_identifier, local_status);
      RETURN;
    IFEND;

    create_module := create_form;

{ Create storage to place form errors.

    mmp$create_scratch_segment (amc$sequence_pointer, mmc$as_sequential, form_errors, status);
    IF NOT status.normal THEN
      fdp$close_form (current_form_identifier, local_status);
      RETURN;
    IFEND;

    RESET form_errors.sequence_pointer;

{ Check form for errors.

    fdp$end_form (current_form_identifier, form_errors.sequence_pointer, number_errors, errors_p, status);
    IF NOT status.normal THEN
      mmp$delete_scratch_segment (form_errors, local_status);
      fdp$close_form (current_form_identifier, local_status);
      RETURN;
    IFEND;

    IF number_errors = 0 THEN
      mmp$delete_scratch_segment (form_errors, local_status);
      RETURN;
    IFEND;

    display_form_errors (errors_p, status);
    mmp$delete_scratch_segment (form_errors, local_status);
    fdp$close_form (current_form_identifier, local_status);
    osp$set_status_abnormal (fdc$format_display_identifier,fde$form_compilation_errors,
          form_name, status);

  PROCEND fdp$begin_create_form_module;

?? OLDTITLE ??
?? NEWTITLE := '[XDCL] fdp$_create_form_module', EJECT ??

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

{ PROCEDURE (fdm$crefm) create_form_module, crefm (
{   form_name, fn: name = $required
{   binary, b: file = $optional
{   status)

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

  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$name_type_qualifier,
      recend,
      type2: record
        header: clt$type_specification_header,
      recend,
      type3: record
        header: clt$type_specification_header,
      recend,
    recend := [
    [1,
    [89, 5, 18, 16, 5, 31, 656],
    clc$command, 5, 3, 1, 0, 0, 0, 3, 'FDM$CREFM'], [
    ['B                              ',clc$abbreviation_entry, 2],
    ['BINARY                         ',clc$nominal_entry, 2],
    ['FN                             ',clc$abbreviation_entry, 1],
    ['FORM_NAME                      ',clc$nominal_entry, 1],
    ['STATUS                         ',clc$nominal_entry, 3]],
    [
{ 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
    [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$optional_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$name_type], [1, osc$max_name_size]],
{ PARAMETER 2
    [[1, 0, clc$file_type]],
{ PARAMETER 3
    [[1, 0, clc$status_type]]];

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

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

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

    VAR
      attribute_validation: array [1 .. 1] of fst$file_cycle_attribute,
      create: boolean,
      file_identifier: amt$file_identifier,
      local_status: ost$status,
      mandated_creation_attributes: array [1 .. 1] of fst$file_cycle_attribute,
      segment_pointer: amt$segment_pointer;

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

    fdp$begin_create_form_module (pvt [p$form_name].value^.name_value, current_form_identifier, create,
          status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    IF NOT pvt [p$binary].specified THEN
      RETURN;
    IFEND;

    attribute_validation [1].selector := fsc$file_contents_and_processor;
    attribute_validation [1].file_contents := fsc$screen_form;
    attribute_validation [1].file_processor := osc$null_name;

    mandated_creation_attributes [1].selector := fsc$file_contents_and_processor;
    mandated_creation_attributes [1].file_contents := fsc$screen_form;
    mandated_creation_attributes [1].file_processor := osc$null_name;

    fsp$open_file (pvt [p$binary].value^.file_value^, amc$segment, NIL, NIL, ^mandated_creation_attributes,
          ^attribute_validation, NIL, file_identifier, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    amp$get_segment_pointer (file_identifier, amc$sequence_pointer, segment_pointer, status);
    IF NOT status.normal THEN
      fsp$close_file (file_identifier, local_status);
      RETURN;
    IFEND;

    fdp$write_form_definition (current_form_identifier, segment_pointer.sequence_pointer, status);
    IF NOT status.normal THEN
      fsp$close_file (file_identifier, local_status);
      RETURN;
    IFEND;

    amp$set_segment_eoi (file_identifier, segment_pointer, local_status);
    IF NOT status.normal THEN
      fsp$close_file (file_identifier, local_status);
      RETURN;
    IFEND;

    fsp$close_file (file_identifier, status);

  PROCEND fdp$_create_form_module;

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

{ PURPOSE:
{   This procedure processes the add_box command.

  PROCEDURE add_box
    (    parameter_list: clt$parameter_list;
     VAR status: ost$status);

{ PROCEDURE (fdm$crefm_addb) add_box, addb (
{   column, c: integer 1..fdc$maximum_x_position = $required
{   line, l: integer 1..fdc$maximum_y_position = $required
{   width, w: integer 1..fdc$maximum_x_position = $required
{   height, h: integer 1..fdc$maximum_y_position = $required
{   display, displays, d: list of key
{       inverse, low_intensity, high_intensity, blink, black_background, blue_background, green_background
{       magenta_background, red_background, cyan_background, yellow_background, white_background
{       black_foreground, blue_foreground, green_foreground, magenta_foreground, red_foreground
{       cyan_foreground, yellow_foreground, white_foreground, fine_line, medium_line, bold_line
{     keyend = $optional
{   name, n: any of
{       name
{       cobol_name
{     anyend = $optional
{   occurrence, o: integer 1..fdc$maximum_occurrence = 1
{   status)

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

  VAR
    pdt: [STATIC, READ, cls$declaration_section] record
      header: clt$pdt_header,
      names: array [1 .. 16] of clt$pdt_parameter_name,
      parameters: array [1 .. 8] of clt$pdt_parameter,
      type1: record
        header: clt$type_specification_header,
        qualifier: clt$integer_type_qualifier,
      recend,
      type2: record
        header: clt$type_specification_header,
        qualifier: clt$integer_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,
        qualifier: clt$list_type_qualifier,
        element_type_spec: record
          header: clt$type_specification_header,
          qualifier: clt$keyword_type_qualifier,
          keyword_specs: array [1 .. 23] of clt$keyword_specification,
        recend,
      recend,
      type6: 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$name_type_qualifier,
        recend,
        type_size_2: clt$type_specification_size,
        element_type_spec_2: record
          header: clt$type_specification_header,
        recend,
      recend,
      type7: record
        header: clt$type_specification_header,
        qualifier: clt$integer_type_qualifier,
        default_value: string (1),
      recend,
      type8: record
        header: clt$type_specification_header,
      recend,
    recend := [
    [1,
    [89, 5, 18, 16, 6, 21, 586],
    clc$command, 16, 8, 4, 0, 0, 0, 8, 'FDM$CREFM_ADDB'], [
    ['C                              ',clc$abbreviation_entry, 1],
    ['COLUMN                         ',clc$nominal_entry, 1],
    ['D                              ',clc$abbreviation_entry, 5],
    ['DISPLAY                        ',clc$nominal_entry, 5],
    ['DISPLAYS                       ',clc$alias_entry, 5],
    ['H                              ',clc$abbreviation_entry, 4],
    ['HEIGHT                         ',clc$nominal_entry, 4],
    ['L                              ',clc$abbreviation_entry, 2],
    ['LINE                           ',clc$nominal_entry, 2],
    ['N                              ',clc$abbreviation_entry, 6],
    ['NAME                           ',clc$nominal_entry, 6],
    ['O                              ',clc$abbreviation_entry, 7],
    ['OCCURRENCE                     ',clc$nominal_entry, 7],
    ['STATUS                         ',clc$nominal_entry, 8],
    ['W                              ',clc$abbreviation_entry, 3],
    ['WIDTH                          ',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, 20, clc$required_parameter,
  0, 0],
{ PARAMETER 2
    [9, 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$required_parameter,
  0, 0],
{ PARAMETER 3
    [16, 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$required_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_value, clc$immediate_evaluation, clc$standard_parameter_checking, 20, clc$required_parameter,
  0, 0],
{ PARAMETER 5
    [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, 874,
  clc$optional_parameter, 0, 0],
{ PARAMETER 6
    [11, 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, 28, clc$optional_parameter,
  0, 0],
{ PARAMETER 7
    [13, 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 8
    [14, 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$integer_type], [1, fdc$maximum_x_position, 10]],
{ PARAMETER 2
    [[1, 0, clc$integer_type], [1, fdc$maximum_y_position, 10]],
{ PARAMETER 3
    [[1, 0, clc$integer_type], [1, fdc$maximum_x_position, 10]],
{ PARAMETER 4
    [[1, 0, clc$integer_type], [1, fdc$maximum_y_position, 10]],
{ PARAMETER 5
    [[1, 0, clc$list_type], [858, 1, clc$max_list_size, FALSE],
      [[1, 0, clc$keyword_type], [23], [
      ['BLACK_BACKGROUND               ', clc$nominal_entry, clc$normal_usage_entry, 5],
      ['BLACK_FOREGROUND               ', clc$nominal_entry, clc$normal_usage_entry, 13],
      ['BLINK                          ', clc$nominal_entry, clc$normal_usage_entry, 4],
      ['BLUE_BACKGROUND                ', clc$nominal_entry, clc$normal_usage_entry, 6],
      ['BLUE_FOREGROUND                ', clc$nominal_entry, clc$normal_usage_entry, 14],
      ['BOLD_LINE                      ', clc$nominal_entry, clc$normal_usage_entry, 23],
      ['CYAN_BACKGROUND                ', clc$nominal_entry, clc$normal_usage_entry, 10],
      ['CYAN_FOREGROUND                ', clc$nominal_entry, clc$normal_usage_entry, 18],
      ['FINE_LINE                      ', clc$nominal_entry, clc$normal_usage_entry, 21],
      ['GREEN_BACKGROUND               ', clc$nominal_entry, clc$normal_usage_entry, 7],
      ['GREEN_FOREGROUND               ', clc$nominal_entry, clc$normal_usage_entry, 15],
      ['HIGH_INTENSITY                 ', clc$nominal_entry, clc$normal_usage_entry, 3],
      ['INVERSE                        ', clc$nominal_entry, clc$normal_usage_entry, 1],
      ['LOW_INTENSITY                  ', clc$nominal_entry, clc$normal_usage_entry, 2],
      ['MAGENTA_BACKGROUND             ', clc$nominal_entry, clc$normal_usage_entry, 8],
      ['MAGENTA_FOREGROUND             ', clc$nominal_entry, clc$normal_usage_entry, 16],
      ['MEDIUM_LINE                    ', clc$nominal_entry, clc$normal_usage_entry, 22],
      ['RED_BACKGROUND                 ', clc$nominal_entry, clc$normal_usage_entry, 9],
      ['RED_FOREGROUND                 ', clc$nominal_entry, clc$normal_usage_entry, 17],
      ['WHITE_BACKGROUND               ', clc$nominal_entry, clc$normal_usage_entry, 12],
      ['WHITE_FOREGROUND               ', clc$nominal_entry, clc$normal_usage_entry, 20],
      ['YELLOW_BACKGROUND              ', clc$nominal_entry, clc$normal_usage_entry, 11],
      ['YELLOW_FOREGROUND              ', clc$nominal_entry, clc$normal_usage_entry, 19]]
      ]
    ],
{ PARAMETER 6
    [[1, 0, clc$union_type], [[clc$cobol_name_type, clc$name_type],
    FALSE, 2],
    5, [[1, 0, clc$name_type], [1, osc$max_name_size]],
    3, [[1, 0, clc$cobol_name_type]]
    ],
{ PARAMETER 7
    [[1, 0, clc$integer_type], [1, fdc$maximum_occurrence, 10],
    '1'],
{ PARAMETER 8
    [[1, 0, clc$status_type]]];

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

    CONST
      p$column = 1,
      p$line = 2,
      p$width = 3,
      p$height = 4,
      p$display = 5,
      p$name = 6,
      p$occurrence = 7,
      p$status = 8;

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

    VAR
      object_attributes: array [1 .. 2] of fdt$object_attribute,
      object_definition: fdt$object_definition;

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

    object_definition.key := fdc$box;
    object_definition.box_width := pvt [p$width].value^.integer_value.value;
    object_definition.box_height := pvt [p$height].value^.integer_value.value;

    IF pvt [p$display].specified THEN
      object_attributes [1].key := fdc$object_display;
      process_attributes (pvt [p$display].value, object_attributes [1].display_attribute, status);
      IF NOT status.normal THEN
        RETURN;
      IFEND;
    ELSE
      object_attributes [1].key := fdc$unused_object_entry;
    IFEND;


    IF pvt [p$name].specified THEN
      object_attributes [2].key := fdc$object_name;
      object_attributes [2].occurrence := pvt [p$occurrence].value^.integer_value.value;
      IF pvt [p$name].value^.kind = clc$name THEN
        convert_to_form_name (pvt [p$name].value^.name_value, form_processor,
              object_attributes [2].object_name);
      ELSE
        object_attributes [2].object_name := pvt [p$name].value^.cobol_name_value;
      IFEND;

    ELSE
      object_attributes [2].key := fdc$unused_object_entry;
    IFEND;

    fdp$create_object (current_form_identifier, pvt [p$column].value^.integer_value.value, pvt [p$line].
          value^.integer_value.value, object_definition, object_attributes, status);

  PROCEND add_box;

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

{ PURPOSE:
{   This procedure processes the add_constant_text command.

  PROCEDURE add_constant_text
    (    parameter_list: clt$parameter_list;
     VAR status: ost$status);

{ PROCEDURE (fdm$crefm_addct) add_constant_text, addct (
{   column, c: integer 1..fdc$maximum_x_position = $required
{   line, l: integer 1..fdc$maximum_y_position = $required
{   text, t: string 0..fdc$maximum_text_length = $required
{   display, displays, d: list of key
{       inverse, low_intensity, high_intensity, blink, hidden, underline, black_background, blue_background
{       green_background, magenta_background, red_background, cyan_background, yellow_background
{       white_background, black_foreground, blue_foreground, green_foreground, magenta_foreground
{       red_foreground, cyan_foreground, yellow_foreground, white_foreground, italic, title, input, error
{       message, display_left_to_right, display_right_to_left
{     keyend = $optional
{   name, n: any of
{       name
{       cobol_name
{     anyend = $optional
{   occurrence, o: integer 1..fdc$maximum_occurrence = 1
{   width, w: integer 1..fdc$maximum_y_position = $optional
{   status)

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

  VAR
    pdt: [STATIC, READ, cls$declaration_section] record
      header: clt$pdt_header,
      names: array [1 .. 16] of clt$pdt_parameter_name,
      parameters: array [1 .. 8] of clt$pdt_parameter,
      type1: record
        header: clt$type_specification_header,
        qualifier: clt$integer_type_qualifier,
      recend,
      type2: record
        header: clt$type_specification_header,
        qualifier: clt$integer_type_qualifier,
      recend,
      type3: record
        header: clt$type_specification_header,
        qualifier: clt$string_type_qualifier,
      recend,
      type4: record
        header: clt$type_specification_header,
        qualifier: clt$list_type_qualifier,
        element_type_spec: record
          header: clt$type_specification_header,
          qualifier: clt$keyword_type_qualifier,
          keyword_specs: array [1 .. 29] of clt$keyword_specification,
        recend,
      recend,
      type5: 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$name_type_qualifier,
        recend,
        type_size_2: clt$type_specification_size,
        element_type_spec_2: record
          header: clt$type_specification_header,
        recend,
      recend,
      type6: record
        header: clt$type_specification_header,
        qualifier: clt$integer_type_qualifier,
        default_value: string (1),
      recend,
      type7: record
        header: clt$type_specification_header,
        qualifier: clt$integer_type_qualifier,
      recend,
      type8: record
        header: clt$type_specification_header,
      recend,
    recend := [
    [1,
    [89, 5, 18, 16, 6, 53, 776],
    clc$command, 16, 8, 3, 0, 0, 0, 8, 'FDM$CREFM_ADDCT'], [
    ['C                              ',clc$abbreviation_entry, 1],
    ['COLUMN                         ',clc$nominal_entry, 1],
    ['D                              ',clc$abbreviation_entry, 4],
    ['DISPLAY                        ',clc$nominal_entry, 4],
    ['DISPLAYS                       ',clc$alias_entry, 4],
    ['L                              ',clc$abbreviation_entry, 2],
    ['LINE                           ',clc$nominal_entry, 2],
    ['N                              ',clc$abbreviation_entry, 5],
    ['NAME                           ',clc$nominal_entry, 5],
    ['O                              ',clc$abbreviation_entry, 6],
    ['OCCURRENCE                     ',clc$nominal_entry, 6],
    ['STATUS                         ',clc$nominal_entry, 8],
    ['T                              ',clc$abbreviation_entry, 3],
    ['TEXT                           ',clc$nominal_entry, 3],
    ['W                              ',clc$abbreviation_entry, 7],
    ['WIDTH                          ',clc$nominal_entry, 7]],
    [
{ 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, 20, clc$required_parameter,
  0, 0],
{ PARAMETER 2
    [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$required_parameter,
  0, 0],
{ PARAMETER 3
    [14, 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, 8, 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, 1096,
  clc$optional_parameter, 0, 0],
{ PARAMETER 5
    [9, 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, 28, clc$optional_parameter,
  0, 0],
{ PARAMETER 6
    [11, 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 7
    [16, 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_parameter,
  0, 0],
{ PARAMETER 8
    [12, 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$integer_type], [1, fdc$maximum_x_position, 10]],
{ PARAMETER 2
    [[1, 0, clc$integer_type], [1, fdc$maximum_y_position, 10]],
{ PARAMETER 3
    [[1, 0, clc$string_type], [0, fdc$maximum_text_length, FALSE]],
{ PARAMETER 4
    [[1, 0, clc$list_type], [1080, 1, clc$max_list_size, FALSE],
      [[1, 0, clc$keyword_type], [29], [
      ['BLACK_BACKGROUND               ', clc$nominal_entry, clc$normal_usage_entry, 7],
      ['BLACK_FOREGROUND               ', clc$nominal_entry, clc$normal_usage_entry, 15],
      ['BLINK                          ', clc$nominal_entry, clc$normal_usage_entry, 4],
      ['BLUE_BACKGROUND                ', clc$nominal_entry, clc$normal_usage_entry, 8],
      ['BLUE_FOREGROUND                ', clc$nominal_entry, clc$normal_usage_entry, 16],
      ['CYAN_BACKGROUND                ', clc$nominal_entry, clc$normal_usage_entry, 12],
      ['CYAN_FOREGROUND                ', clc$nominal_entry, clc$normal_usage_entry, 20],
      ['DISPLAY_LEFT_TO_RIGHT          ', clc$nominal_entry, clc$normal_usage_entry, 28],
      ['DISPLAY_RIGHT_TO_LEFT          ', clc$nominal_entry, clc$normal_usage_entry, 29],
      ['ERROR                          ', clc$nominal_entry, clc$normal_usage_entry, 26],
      ['GREEN_BACKGROUND               ', clc$nominal_entry, clc$normal_usage_entry, 9],
      ['GREEN_FOREGROUND               ', clc$nominal_entry, clc$normal_usage_entry, 17],
      ['HIDDEN                         ', clc$nominal_entry, clc$normal_usage_entry, 5],
      ['HIGH_INTENSITY                 ', clc$nominal_entry, clc$normal_usage_entry, 3],
      ['INPUT                          ', clc$nominal_entry, clc$normal_usage_entry, 25],
      ['INVERSE                        ', clc$nominal_entry, clc$normal_usage_entry, 1],
      ['ITALIC                         ', clc$nominal_entry, clc$normal_usage_entry, 23],
      ['LOW_INTENSITY                  ', clc$nominal_entry, clc$normal_usage_entry, 2],
      ['MAGENTA_BACKGROUND             ', clc$nominal_entry, clc$normal_usage_entry, 10],
      ['MAGENTA_FOREGROUND             ', clc$nominal_entry, clc$normal_usage_entry, 18],
      ['MESSAGE                        ', clc$nominal_entry, clc$normal_usage_entry, 27],
      ['RED_BACKGROUND                 ', clc$nominal_entry, clc$normal_usage_entry, 11],
      ['RED_FOREGROUND                 ', clc$nominal_entry, clc$normal_usage_entry, 19],
      ['TITLE                          ', clc$nominal_entry, clc$normal_usage_entry, 24],
      ['UNDERLINE                      ', clc$nominal_entry, clc$normal_usage_entry, 6],
      ['WHITE_BACKGROUND               ', clc$nominal_entry, clc$normal_usage_entry, 14],
      ['WHITE_FOREGROUND               ', clc$nominal_entry, clc$normal_usage_entry, 22],
      ['YELLOW_BACKGROUND              ', clc$nominal_entry, clc$normal_usage_entry, 13],
      ['YELLOW_FOREGROUND              ', clc$nominal_entry, clc$normal_usage_entry, 21]]
      ]
    ],
{ PARAMETER 5
    [[1, 0, clc$union_type], [[clc$cobol_name_type, clc$name_type],
    FALSE, 2],
    5, [[1, 0, clc$name_type], [1, osc$max_name_size]],
    3, [[1, 0, clc$cobol_name_type]]
    ],
{ PARAMETER 6
    [[1, 0, clc$integer_type], [1, fdc$maximum_occurrence, 10],
    '1'],
{ PARAMETER 7
    [[1, 0, clc$integer_type], [1, fdc$maximum_y_position, 10]],
{ PARAMETER 8
    [[1, 0, clc$status_type]]];

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

    CONST
      p$column = 1,
      p$line = 2,
      p$text = 3,
      p$display = 4,
      p$name = 5,
      p$occurrence = 6,
      p$width = 7,
      p$status = 8;

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

    VAR
      object_attributes: array [1 .. 2] of fdt$object_attribute,
      object_definition: fdt$object_definition;

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

    object_definition.key := fdc$constant_text;
    object_definition.p_constant_text := pvt [p$text].value^.string_value;
    IF pvt [p$width].specified THEN
      object_definition.constant_text_width := pvt [p$width].value^.integer_value.value;
    ELSE
      IF STRLENGTH (pvt [p$text].value^.string_value^) <> 0 THEN
        object_definition.constant_text_width := STRLENGTH (pvt [p$text].value^.string_value^);
      ELSE
        osp$set_status_abnormal (fdc$format_display_identifier, fde$object_width_required, current_form_name,
              status);
        IF pvt [p$name].specified THEN
          osp$append_status_parameter (osc$status_parameter_delimiter, pvt [p$name].
                value^.name_value, status);
        IFEND;
        RETURN;
      IFEND;
    IFEND;

    IF pvt [p$display].specified THEN
      object_attributes [1].key := fdc$object_display;
      process_attributes (pvt [p$display].value, object_attributes [1].display_attribute, status);
      IF NOT status.normal THEN
        RETURN;
      IFEND;
    ELSE
      object_attributes [1].key := fdc$unused_object_entry;
    IFEND;

    IF pvt [p$name].specified THEN
      object_attributes [2].key := fdc$object_name;
      object_attributes [2].occurrence := pvt [p$occurrence].value^.integer_value.value;
      IF pvt [p$name].value^.kind = clc$name THEN
        convert_to_form_name (pvt [p$name].value^.name_value, form_processor,
              object_attributes [2].object_name);
      ELSE
        object_attributes [2].object_name := pvt [p$name].value^.cobol_name_value;
      IFEND;

    ELSE
      object_attributes [2].key := fdc$unused_object_entry;
    IFEND;

    fdp$create_object (current_form_identifier, pvt [p$column].value^.integer_value.value, pvt [p$line].
          value^.integer_value.value, object_definition, object_attributes, status);

  PROCEND add_constant_text;

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

{ PURPOSE:
{   This procedure processes the add_constant_text_box  command.

  PROCEDURE add_constant_text_box
    (    parameter_list: clt$parameter_list;
     VAR status: ost$status);

{ PROCEDURE (fdm$crefm_addctb) add_constant_text_box, addctb (
{   column, c: integer 1..fdc$maximum_x_position = $required
{   line, l: integer 1..fdc$maximum_y_position = $required
{   text, t: string 0..fdc$maximum_text_length = $required
{   width, w: integer 1..fdc$maximum_x_position = $required
{   height, h: integer 1..fdc$maximum_y_position = $required
{   display, displays, d: list of key
{       inverse, low_intensity, high_intensity, blink, hidden, underline, black_background, blue_background
{       green_background, magenta_background, red_background, cyan_background, yellow_background
{       white_background, black_foreground, blue_foreground, green_foreground, magenta_foreground
{       red_foreground, cyan_foreground, yellow_foreground, white_foreground, italic, title, input, error
{       message, display_left_to_right, display_right_to_left
{     keyend = $optional
{   name, n: any of
{       name
{       cobol_name
{     anyend = $optional
{   occurrence, o: integer 1..fdc$maximum_occurrence = 1
{   text_format, tf: key
{       wrap_words, wrap_characters
{     keyend = wrap_words
{   status)

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

  VAR
    pdt: [STATIC, READ, cls$declaration_section] record
      header: clt$pdt_header,
      names: array [1 .. 20] of clt$pdt_parameter_name,
      parameters: array [1 .. 10] of clt$pdt_parameter,
      type1: record
        header: clt$type_specification_header,
        qualifier: clt$integer_type_qualifier,
      recend,
      type2: record
        header: clt$type_specification_header,
        qualifier: clt$integer_type_qualifier,
      recend,
      type3: record
        header: clt$type_specification_header,
        qualifier: clt$string_type_qualifier,
      recend,
      type4: record
        header: clt$type_specification_header,
        qualifier: clt$integer_type_qualifier,
      recend,
      type5: record
        header: clt$type_specification_header,
        qualifier: clt$integer_type_qualifier,
      recend,
      type6: record
        header: clt$type_specification_header,
        qualifier: clt$list_type_qualifier,
        element_type_spec: record
          header: clt$type_specification_header,
          qualifier: clt$keyword_type_qualifier,
          keyword_specs: array [1 .. 29] of clt$keyword_specification,
        recend,
      recend,
      type7: 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$name_type_qualifier,
        recend,
        type_size_2: clt$type_specification_size,
        element_type_spec_2: record
          header: clt$type_specification_header,
        recend,
      recend,
      type8: record
        header: clt$type_specification_header,
        qualifier: clt$integer_type_qualifier,
        default_value: string (1),
      recend,
      type9: record
        header: clt$type_specification_header,
        qualifier: clt$keyword_type_qualifier,
        keyword_specs: array [1 .. 2] of clt$keyword_specification,
        default_value: string (10),
      recend,
      type10: record
        header: clt$type_specification_header,
      recend,
    recend := [
    [1,
    [89, 5, 18, 16, 7, 15, 502],
    clc$command, 20, 10, 5, 0, 0, 0, 10, 'FDM$CREFM_ADDCTB'], [
    ['C                              ',clc$abbreviation_entry, 1],
    ['COLUMN                         ',clc$nominal_entry, 1],
    ['D                              ',clc$abbreviation_entry, 6],
    ['DISPLAY                        ',clc$nominal_entry, 6],
    ['DISPLAYS                       ',clc$alias_entry, 6],
    ['H                              ',clc$abbreviation_entry, 5],
    ['HEIGHT                         ',clc$nominal_entry, 5],
    ['L                              ',clc$abbreviation_entry, 2],
    ['LINE                           ',clc$nominal_entry, 2],
    ['N                              ',clc$abbreviation_entry, 7],
    ['NAME                           ',clc$nominal_entry, 7],
    ['O                              ',clc$abbreviation_entry, 8],
    ['OCCURRENCE                     ',clc$nominal_entry, 8],
    ['STATUS                         ',clc$nominal_entry, 10],
    ['T                              ',clc$abbreviation_entry, 3],
    ['TEXT                           ',clc$nominal_entry, 3],
    ['TEXT_FORMAT                    ',clc$nominal_entry, 9],
    ['TF                             ',clc$abbreviation_entry, 9],
    ['W                              ',clc$abbreviation_entry, 4],
    ['WIDTH                          ',clc$nominal_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, 20, clc$required_parameter,
  0, 0],
{ PARAMETER 2
    [9, 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$required_parameter,
  0, 0],
{ PARAMETER 3
    [16, 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, 8, clc$required_parameter, 0
  , 0],
{ PARAMETER 4
    [20, 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$required_parameter,
  0, 0],
{ PARAMETER 5
    [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$required_parameter,
  0, 0],
{ PARAMETER 6
    [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, 1096,
  clc$optional_parameter, 0, 0],
{ PARAMETER 7
    [11, 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, 28, clc$optional_parameter,
  0, 0],
{ PARAMETER 8
    [13, 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 9
    [17, 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, 10],
{ PARAMETER 10
    [14, 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$integer_type], [1, fdc$maximum_x_position, 10]],
{ PARAMETER 2
    [[1, 0, clc$integer_type], [1, fdc$maximum_y_position, 10]],
{ PARAMETER 3
    [[1, 0, clc$string_type], [0, fdc$maximum_text_length, FALSE]],
{ PARAMETER 4
    [[1, 0, clc$integer_type], [1, fdc$maximum_x_position, 10]],
{ PARAMETER 5
    [[1, 0, clc$integer_type], [1, fdc$maximum_y_position, 10]],
{ PARAMETER 6
    [[1, 0, clc$list_type], [1080, 1, clc$max_list_size, FALSE],
      [[1, 0, clc$keyword_type], [29], [
      ['BLACK_BACKGROUND               ', clc$nominal_entry, clc$normal_usage_entry, 7],
      ['BLACK_FOREGROUND               ', clc$nominal_entry, clc$normal_usage_entry, 15],
      ['BLINK                          ', clc$nominal_entry, clc$normal_usage_entry, 4],
      ['BLUE_BACKGROUND                ', clc$nominal_entry, clc$normal_usage_entry, 8],
      ['BLUE_FOREGROUND                ', clc$nominal_entry, clc$normal_usage_entry, 16],
      ['CYAN_BACKGROUND                ', clc$nominal_entry, clc$normal_usage_entry, 12],
      ['CYAN_FOREGROUND                ', clc$nominal_entry, clc$normal_usage_entry, 20],
      ['DISPLAY_LEFT_TO_RIGHT          ', clc$nominal_entry, clc$normal_usage_entry, 28],
      ['DISPLAY_RIGHT_TO_LEFT          ', clc$nominal_entry, clc$normal_usage_entry, 29],
      ['ERROR                          ', clc$nominal_entry, clc$normal_usage_entry, 26],
      ['GREEN_BACKGROUND               ', clc$nominal_entry, clc$normal_usage_entry, 9],
      ['GREEN_FOREGROUND               ', clc$nominal_entry, clc$normal_usage_entry, 17],
      ['HIDDEN                         ', clc$nominal_entry, clc$normal_usage_entry, 5],
      ['HIGH_INTENSITY                 ', clc$nominal_entry, clc$normal_usage_entry, 3],
      ['INPUT                          ', clc$nominal_entry, clc$normal_usage_entry, 25],
      ['INVERSE                        ', clc$nominal_entry, clc$normal_usage_entry, 1],
      ['ITALIC                         ', clc$nominal_entry, clc$normal_usage_entry, 23],
      ['LOW_INTENSITY                  ', clc$nominal_entry, clc$normal_usage_entry, 2],
      ['MAGENTA_BACKGROUND             ', clc$nominal_entry, clc$normal_usage_entry, 10],
      ['MAGENTA_FOREGROUND             ', clc$nominal_entry, clc$normal_usage_entry, 18],
      ['MESSAGE                        ', clc$nominal_entry, clc$normal_usage_entry, 27],
      ['RED_BACKGROUND                 ', clc$nominal_entry, clc$normal_usage_entry, 11],
      ['RED_FOREGROUND                 ', clc$nominal_entry, clc$normal_usage_entry, 19],
      ['TITLE                          ', clc$nominal_entry, clc$normal_usage_entry, 24],
      ['UNDERLINE                      ', clc$nominal_entry, clc$normal_usage_entry, 6],
      ['WHITE_BACKGROUND               ', clc$nominal_entry, clc$normal_usage_entry, 14],
      ['WHITE_FOREGROUND               ', clc$nominal_entry, clc$normal_usage_entry, 22],
      ['YELLOW_BACKGROUND              ', clc$nominal_entry, clc$normal_usage_entry, 13],
      ['YELLOW_FOREGROUND              ', clc$nominal_entry, clc$normal_usage_entry, 21]]
      ]
    ],
{ PARAMETER 7
    [[1, 0, clc$union_type], [[clc$cobol_name_type, clc$name_type],
    FALSE, 2],
    5, [[1, 0, clc$name_type], [1, osc$max_name_size]],
    3, [[1, 0, clc$cobol_name_type]]
    ],
{ PARAMETER 8
    [[1, 0, clc$integer_type], [1, fdc$maximum_occurrence, 10],
    '1'],
{ PARAMETER 9
    [[1, 0, clc$keyword_type], [2], [
    ['WRAP_CHARACTERS                ', clc$nominal_entry, clc$normal_usage_entry, 2],
    ['WRAP_WORDS                     ', clc$nominal_entry, clc$normal_usage_entry, 1]]
    ,
    'wrap_words'],
{ PARAMETER 10
    [[1, 0, clc$status_type]]];

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

    CONST
      p$column = 1,
      p$line = 2,
      p$text = 3,
      p$width = 4,
      p$height = 5,
      p$display = 6,
      p$name = 7,
      p$occurrence = 8,
      p$text_format = 9,
      p$status = 10;

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

    VAR
      object_attributes: array [1 .. 2] of fdt$object_attribute,
      object_definition: fdt$object_definition;

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

    object_definition.key := fdc$constant_text_box;
    object_definition.p_constant_box_text := pvt [p$text].value^.string_value;
    object_definition.constant_box_width := pvt [p$width].value^.integer_value.value;
    object_definition.constant_box_height := pvt [p$height].value^.integer_value.value;
    IF (pvt [p$text_format].value^.keyword_value = 'WRAP_WORDS') THEN
      object_definition.constant_box_processing := fdc$wrap_words;
    ELSE
      object_definition.constant_box_processing := fdc$wrap_characters;
    IFEND;

    IF pvt [p$display].specified THEN
      object_attributes [1].key := fdc$object_display;
      process_attributes (pvt [p$display].value, object_attributes [1].display_attribute, status);
      IF NOT status.normal THEN
        RETURN;
      IFEND;
    ELSE
      object_attributes [1].key := fdc$unused_object_entry;
    IFEND;

    IF pvt [p$name].specified THEN
      object_attributes [2].key := fdc$object_name;
      object_attributes [2].occurrence := pvt [p$occurrence].value^.integer_value.value;
      IF pvt [p$name].value^.kind = clc$name THEN
        convert_to_form_name (pvt [p$name].value^.name_value, form_processor,
              object_attributes [2].object_name);
      ELSE
        object_attributes [2].object_name := pvt [p$name].value^.cobol_name_value;
      IFEND;

    ELSE
      object_attributes [2].key := fdc$unused_object_entry;
    IFEND;

    fdp$create_object (current_form_identifier, pvt [p$column].value^.integer_value.value, pvt [p$line].
          value^.integer_value.value, object_definition, object_attributes, status);

  PROCEND add_constant_text_box;

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

{ PURPOSE:
{   This procedure processes the add_display_attribute command.

  PROCEDURE add_display
    (    parameter_list: clt$parameter_list;
     VAR status: ost$status);

{ PROCEDURE (fdm$crefm_addd) add_display, addd (
{   name, n: any of
{       name
{       cobol_name
{     anyend = $required
{   display, displays, d: list of key
{       inverse, low_intensity, high_intensity, blink, underline, protect, hidden, black_background
{       blue_background, green_background, magenta_background, red_background, cyan_background
{       yellow_background, white_background, black_foreground, blue_foreground, green_foreground
{       magenta_foreground, red_foreground, cyan_foreground, yellow_foreground, white_foreground, fine_line
{       medium_line, bold_line, italic, title, input, error, message, display_left_to_right
{       display_right_to_left
{     keyend = $required
{   status)

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

  VAR
    pdt: [STATIC, READ, cls$declaration_section] record
      header: clt$pdt_header,
      names: array [1 .. 6] of clt$pdt_parameter_name,
      parameters: array [1 .. 3] of clt$pdt_parameter,
      type1: 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$name_type_qualifier,
        recend,
        type_size_2: clt$type_specification_size,
        element_type_spec_2: record
          header: clt$type_specification_header,
        recend,
      recend,
      type2: record
        header: clt$type_specification_header,
        qualifier: clt$list_type_qualifier,
        element_type_spec: record
          header: clt$type_specification_header,
          qualifier: clt$keyword_type_qualifier,
          keyword_specs: array [1 .. 33] of clt$keyword_specification,
        recend,
      recend,
      type3: record
        header: clt$type_specification_header,
      recend,
    recend := [
    [1,
    [89, 5, 18, 16, 7, 35, 314],
    clc$command, 6, 3, 2, 0, 0, 0, 3, 'FDM$CREFM_ADDDA'], [
    ['D                              ',clc$abbreviation_entry, 2],
    ['DISPLAY                        ',clc$nominal_entry, 2],
    ['DISPLAYS                       ',clc$alias_entry, 2],
    ['N                              ',clc$abbreviation_entry, 1],
    ['NAME                           ',clc$nominal_entry, 1],
    ['STATUS                         ',clc$nominal_entry, 3]],
    [
{ PARAMETER 1
    [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, 28, clc$required_parameter,
  0, 0],
{ PARAMETER 2
    [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, 1244,
  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$pass_by_reference, clc$immediate_evaluation, clc$standard_parameter_checking, 3,
  clc$optional_parameter, 0, 0]],
{ PARAMETER 1
    [[1, 0, clc$union_type], [[clc$cobol_name_type, clc$name_type],
    FALSE, 2],
    5, [[1, 0, clc$name_type], [1, osc$max_name_size]],
    3, [[1, 0, clc$cobol_name_type]]
    ],
{ PARAMETER 2
    [[1, 0, clc$list_type], [1228, 1, clc$max_list_size, FALSE],
      [[1, 0, clc$keyword_type], [33], [
      ['BLACK_BACKGROUND               ', clc$nominal_entry, clc$normal_usage_entry, 8],
      ['BLACK_FOREGROUND               ', clc$nominal_entry, clc$normal_usage_entry, 16],
      ['BLINK                          ', clc$nominal_entry, clc$normal_usage_entry, 4],
      ['BLUE_BACKGROUND                ', clc$nominal_entry, clc$normal_usage_entry, 9],
      ['BLUE_FOREGROUND                ', clc$nominal_entry, clc$normal_usage_entry, 17],
      ['BOLD_LINE                      ', clc$nominal_entry, clc$normal_usage_entry, 26],
      ['CYAN_BACKGROUND                ', clc$nominal_entry, clc$normal_usage_entry, 13],
      ['CYAN_FOREGROUND                ', clc$nominal_entry, clc$normal_usage_entry, 21],
      ['DISPLAY_LEFT_TO_RIGHT          ', clc$nominal_entry, clc$normal_usage_entry, 32],
      ['DISPLAY_RIGHT_TO_LEFT          ', clc$nominal_entry, clc$normal_usage_entry, 33],
      ['ERROR                          ', clc$nominal_entry, clc$normal_usage_entry, 30],
      ['FINE_LINE                      ', clc$nominal_entry, clc$normal_usage_entry, 24],
      ['GREEN_BACKGROUND               ', clc$nominal_entry, clc$normal_usage_entry, 10],
      ['GREEN_FOREGROUND               ', clc$nominal_entry, clc$normal_usage_entry, 18],
      ['HIDDEN                         ', clc$nominal_entry, clc$normal_usage_entry, 7],
      ['HIGH_INTENSITY                 ', clc$nominal_entry, clc$normal_usage_entry, 3],
      ['INPUT                          ', clc$nominal_entry, clc$normal_usage_entry, 29],
      ['INVERSE                        ', clc$nominal_entry, clc$normal_usage_entry, 1],
      ['ITALIC                         ', clc$nominal_entry, clc$normal_usage_entry, 27],
      ['LOW_INTENSITY                  ', clc$nominal_entry, clc$normal_usage_entry, 2],
      ['MAGENTA_BACKGROUND             ', clc$nominal_entry, clc$normal_usage_entry, 11],
      ['MAGENTA_FOREGROUND             ', clc$nominal_entry, clc$normal_usage_entry, 19],
      ['MEDIUM_LINE                    ', clc$nominal_entry, clc$normal_usage_entry, 25],
      ['MESSAGE                        ', clc$nominal_entry, clc$normal_usage_entry, 31],
      ['PROTECT                        ', clc$nominal_entry, clc$normal_usage_entry, 6],
      ['RED_BACKGROUND                 ', clc$nominal_entry, clc$normal_usage_entry, 12],
      ['RED_FOREGROUND                 ', clc$nominal_entry, clc$normal_usage_entry, 20],
      ['TITLE                          ', clc$nominal_entry, clc$normal_usage_entry, 28],
      ['UNDERLINE                      ', clc$nominal_entry, clc$normal_usage_entry, 5],
      ['WHITE_BACKGROUND               ', clc$nominal_entry, clc$normal_usage_entry, 15],
      ['WHITE_FOREGROUND               ', clc$nominal_entry, clc$normal_usage_entry, 23],
      ['YELLOW_BACKGROUND              ', clc$nominal_entry, clc$normal_usage_entry, 14],
      ['YELLOW_FOREGROUND              ', clc$nominal_entry, clc$normal_usage_entry, 22]]
      ]
    ],
{ PARAMETER 3
    [[1, 0, clc$status_type]]];

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

    CONST
      p$name = 1,
      p$display = 2,
      p$status = 3;

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

    VAR
      form_attributes: array [1 .. 1] of fdt$form_attribute;

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

    form_attributes [1].key := fdc$add_display_definition;
    process_attributes (pvt [p$display].value, form_attributes [1].display_attribute, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    IF pvt [p$name].value^.kind = clc$name THEN
      convert_to_form_name (pvt [p$name].value^.name_value, form_processor, form_attributes [1].display_name);
    ELSE
      form_attributes [1].display_name := pvt [p$name].value^.cobol_name_value;
    IFEND;

    fdp$change_form (current_form_identifier, form_attributes, status);

  PROCEND add_display;

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

{ PURPOSE:
{   This procedure processes the add_event command.

  PROCEDURE add_event
    (    parameter_list: clt$parameter_list;
     VAR status: ost$status);

{ PROCEDURE (fdm$crefm_adde) add_event, adde (
{   program_event, pe: any of
{       name
{       cobol_name
{     anyend = $required
{   terminal_event, te: key
{       next, help, stop, back, up, down, forward, backward, undo, redo, quit, exit, first, last, edit, data
{       f1, f2, f3, f4, f5, f6, f7, f8, f9, f10, f11, f12, f13, f14, f15, f16, shift_next, shift_help
{       shift_stop, shift_back, shift_up, shift_down, shift_forward, shift_backward, shift_edit, shift_data
{       shift_f1, shift_f2, shift_f3, shift_f4, shift_f5, shift_f6, shift_f7, shift_f8, shift_f9, shift_f10
{       shift_f11, shift_f12, shift_f13, shift_f14, shift_f15, shift_f16, pick, insert_line, delete_line, home
{     keyend = $required
{   action, a: key
{       return_normal, return_abnormal, page_table_forward, page_table_backward, scroll_table_forward
{       scroll_table_backward, display_help, erase_help, ignore, tab_next, tab_previous
{       scroll_variable_forward, scroll_variable_backward, page_variable_forward, page_variable_backward
{       page_variable_first, page_variable_last, page_table_first, page_table_last, insert_variable_line
{       delete_variable_line
{     keyend = $required
{   label, l: string 0..6 = ''
{   reassign_terminal_event, rte: (BY_NAME) boolean = TRUE
{   status)

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

  VAR
    pdt: [STATIC, READ, cls$declaration_section] record
      header: clt$pdt_header,
      names: array [1 .. 11] of clt$pdt_parameter_name,
      parameters: array [1 .. 6] of clt$pdt_parameter,
      type1: 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$name_type_qualifier,
        recend,
        type_size_2: clt$type_specification_size,
        element_type_spec_2: record
          header: clt$type_specification_header,
        recend,
      recend,
      type2: record
        header: clt$type_specification_header,
        qualifier: clt$keyword_type_qualifier,
        keyword_specs: array [1 .. 62] of clt$keyword_specification,
      recend,
      type3: record
        header: clt$type_specification_header,
        qualifier: clt$keyword_type_qualifier,
        keyword_specs: array [1 .. 21] of clt$keyword_specification,
      recend,
      type4: record
        header: clt$type_specification_header,
        qualifier: clt$string_type_qualifier,
        default_value: string (2),
      recend,
      type5: record
        header: clt$type_specification_header,
        default_value: string (4),
      recend,
      type6: record
        header: clt$type_specification_header,
      recend,
    recend := [
    [1,
    [92, 9, 10, 13, 42, 18, 727],
    clc$command, 11, 6, 3, 0, 0, 0, 6, 'FDM$CREFM_ADDE'], [
    ['A                              ',clc$abbreviation_entry, 3],
    ['ACTION                         ',clc$nominal_entry, 3],
    ['L                              ',clc$abbreviation_entry, 4],
    ['LABEL                          ',clc$nominal_entry, 4],
    ['PE                             ',clc$abbreviation_entry, 1],
    ['PROGRAM_EVENT                  ',clc$nominal_entry, 1],
    ['REASSIGN_TERMINAL_EVENT        ',clc$nominal_entry, 5],
    ['RTE                            ',clc$abbreviation_entry, 5],
    ['STATUS                         ',clc$nominal_entry, 6],
    ['TE                             ',clc$abbreviation_entry, 2],
    ['TERMINAL_EVENT                 ',clc$nominal_entry, 2]],
    [
{ PARAMETER 1
    [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, 28, clc$required_parameter,
  0, 0],
{ PARAMETER 2
    [11, 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, 2301,
  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, 784,
  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, 8,
  clc$optional_default_parameter, 0, 2],
{ PARAMETER 5
    [7, clc$normal_usage_entry, clc$non_secure_parameter,
    $clt$parameter_spec_methods[clc$specify_by_name],
    clc$pass_by_value, clc$immediate_evaluation, clc$standard_parameter_checking, 3,
  clc$optional_default_parameter, 0, 4],
{ PARAMETER 6
    [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$union_type], [[clc$cobol_name_type, clc$name_type],
    FALSE, 2],
    5, [[1, 0, clc$name_type], [1, osc$max_name_size]],
    3, [[1, 0, clc$cobol_name_type]]
    ],
{ PARAMETER 2
    [[1, 0, clc$keyword_type], [62], [
    ['BACK                           ', clc$nominal_entry, clc$normal_usage_entry, 4],
    ['BACKWARD                       ', clc$nominal_entry, clc$normal_usage_entry, 8],
    ['DATA                           ', clc$nominal_entry, clc$normal_usage_entry, 16],
    ['DELETE_LINE                    ', clc$nominal_entry, clc$normal_usage_entry, 61],
    ['DOWN                           ', clc$nominal_entry, clc$normal_usage_entry, 6],
    ['EDIT                           ', clc$nominal_entry, clc$normal_usage_entry, 15],
    ['EXIT                           ', clc$nominal_entry, clc$normal_usage_entry, 12],
    ['F1                             ', clc$nominal_entry, clc$normal_usage_entry, 17],
    ['F10                            ', clc$nominal_entry, clc$normal_usage_entry, 26],
    ['F11                            ', clc$nominal_entry, clc$normal_usage_entry, 27],
    ['F12                            ', clc$nominal_entry, clc$normal_usage_entry, 28],
    ['F13                            ', clc$nominal_entry, clc$normal_usage_entry, 29],
    ['F14                            ', clc$nominal_entry, clc$normal_usage_entry, 30],
    ['F15                            ', clc$nominal_entry, clc$normal_usage_entry, 31],
    ['F16                            ', clc$nominal_entry, clc$normal_usage_entry, 32],
    ['F2                             ', clc$nominal_entry, clc$normal_usage_entry, 18],
    ['F3                             ', clc$nominal_entry, clc$normal_usage_entry, 19],
    ['F4                             ', clc$nominal_entry, clc$normal_usage_entry, 20],
    ['F5                             ', clc$nominal_entry, clc$normal_usage_entry, 21],
    ['F6                             ', clc$nominal_entry, clc$normal_usage_entry, 22],
    ['F7                             ', clc$nominal_entry, clc$normal_usage_entry, 23],
    ['F8                             ', clc$nominal_entry, clc$normal_usage_entry, 24],
    ['F9                             ', clc$nominal_entry, clc$normal_usage_entry, 25],
    ['FIRST                          ', clc$nominal_entry, clc$normal_usage_entry, 13],
    ['FORWARD                        ', clc$nominal_entry, clc$normal_usage_entry, 7],
    ['HELP                           ', clc$nominal_entry, clc$normal_usage_entry, 2],
    ['HOME                           ', clc$nominal_entry, clc$normal_usage_entry, 62],
    ['INSERT_LINE                    ', clc$nominal_entry, clc$normal_usage_entry, 60],
    ['LAST                           ', clc$nominal_entry, clc$normal_usage_entry, 14],
    ['NEXT                           ', clc$nominal_entry, clc$normal_usage_entry, 1],
    ['PICK                           ', clc$nominal_entry, clc$normal_usage_entry, 59],
    ['QUIT                           ', clc$nominal_entry, clc$normal_usage_entry, 11],
    ['REDO                           ', clc$nominal_entry, clc$normal_usage_entry, 10],
    ['SHIFT_BACK                     ', clc$nominal_entry, clc$normal_usage_entry, 36],
    ['SHIFT_BACKWARD                 ', clc$nominal_entry, clc$normal_usage_entry, 40],
    ['SHIFT_DATA                     ', clc$nominal_entry, clc$normal_usage_entry, 42],
    ['SHIFT_DOWN                     ', clc$nominal_entry, clc$normal_usage_entry, 38],
    ['SHIFT_EDIT                     ', clc$nominal_entry, clc$normal_usage_entry, 41],
    ['SHIFT_F1                       ', clc$nominal_entry, clc$normal_usage_entry, 43],
    ['SHIFT_F10                      ', clc$nominal_entry, clc$normal_usage_entry, 52],
    ['SHIFT_F11                      ', clc$nominal_entry, clc$normal_usage_entry, 53],
    ['SHIFT_F12                      ', clc$nominal_entry, clc$normal_usage_entry, 54],
    ['SHIFT_F13                      ', clc$nominal_entry, clc$normal_usage_entry, 55],
    ['SHIFT_F14                      ', clc$nominal_entry, clc$normal_usage_entry, 56],
    ['SHIFT_F15                      ', clc$nominal_entry, clc$normal_usage_entry, 57],
    ['SHIFT_F16                      ', clc$nominal_entry, clc$normal_usage_entry, 58],
    ['SHIFT_F2                       ', clc$nominal_entry, clc$normal_usage_entry, 44],
    ['SHIFT_F3                       ', clc$nominal_entry, clc$normal_usage_entry, 45],
    ['SHIFT_F4                       ', clc$nominal_entry, clc$normal_usage_entry, 46],
    ['SHIFT_F5                       ', clc$nominal_entry, clc$normal_usage_entry, 47],
    ['SHIFT_F6                       ', clc$nominal_entry, clc$normal_usage_entry, 48],
    ['SHIFT_F7                       ', clc$nominal_entry, clc$normal_usage_entry, 49],
    ['SHIFT_F8                       ', clc$nominal_entry, clc$normal_usage_entry, 50],
    ['SHIFT_F9                       ', clc$nominal_entry, clc$normal_usage_entry, 51],
    ['SHIFT_FORWARD                  ', clc$nominal_entry, clc$normal_usage_entry, 39],
    ['SHIFT_HELP                     ', clc$nominal_entry, clc$normal_usage_entry, 34],
    ['SHIFT_NEXT                     ', clc$nominal_entry, clc$normal_usage_entry, 33],
    ['SHIFT_STOP                     ', clc$nominal_entry, clc$normal_usage_entry, 35],
    ['SHIFT_UP                       ', clc$nominal_entry, clc$normal_usage_entry, 37],
    ['STOP                           ', clc$nominal_entry, clc$normal_usage_entry, 3],
    ['UNDO                           ', clc$nominal_entry, clc$normal_usage_entry, 9],
    ['UP                             ', clc$nominal_entry, clc$normal_usage_entry, 5]]
    ],
{ PARAMETER 3
    [[1, 0, clc$keyword_type], [21], [
    ['DELETE_VARIABLE_LINE           ', clc$nominal_entry, clc$normal_usage_entry, 21],
    ['DISPLAY_HELP                   ', clc$nominal_entry, clc$normal_usage_entry, 7],
    ['ERASE_HELP                     ', clc$nominal_entry, clc$normal_usage_entry, 8],
    ['IGNORE                         ', clc$nominal_entry, clc$normal_usage_entry, 9],
    ['INSERT_VARIABLE_LINE           ', clc$nominal_entry, clc$normal_usage_entry, 20],
    ['PAGE_TABLE_BACKWARD            ', clc$nominal_entry, clc$normal_usage_entry, 4],
    ['PAGE_TABLE_FIRST               ', clc$nominal_entry, clc$normal_usage_entry, 18],
    ['PAGE_TABLE_FORWARD             ', clc$nominal_entry, clc$normal_usage_entry, 3],
    ['PAGE_TABLE_LAST                ', clc$nominal_entry, clc$normal_usage_entry, 19],
    ['PAGE_VARIABLE_BACKWARD         ', clc$nominal_entry, clc$normal_usage_entry, 15],
    ['PAGE_VARIABLE_FIRST            ', clc$nominal_entry, clc$normal_usage_entry, 16],
    ['PAGE_VARIABLE_FORWARD          ', clc$nominal_entry, clc$normal_usage_entry, 14],
    ['PAGE_VARIABLE_LAST             ', clc$nominal_entry, clc$normal_usage_entry, 17],
    ['RETURN_ABNORMAL                ', clc$nominal_entry, clc$normal_usage_entry, 2],
    ['RETURN_NORMAL                  ', clc$nominal_entry, clc$normal_usage_entry, 1],
    ['SCROLL_TABLE_BACKWARD          ', clc$nominal_entry, clc$normal_usage_entry, 6],
    ['SCROLL_TABLE_FORWARD           ', clc$nominal_entry, clc$normal_usage_entry, 5],
    ['SCROLL_VARIABLE_BACKWARD       ', clc$nominal_entry, clc$normal_usage_entry, 13],
    ['SCROLL_VARIABLE_FORWARD        ', clc$nominal_entry, clc$normal_usage_entry, 12],
    ['TAB_NEXT                       ', clc$nominal_entry, clc$normal_usage_entry, 10],
    ['TAB_PREVIOUS                   ', clc$nominal_entry, clc$normal_usage_entry, 11]]
    ],
{ PARAMETER 4
    [[1, 0, clc$string_type], [0, 6, FALSE],
    ''''''],
{ PARAMETER 5
    [[1, 0, clc$boolean_type],
    'TRUE'],
{ PARAMETER 6
    [[1, 0, clc$status_type]]];

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

    CONST
      p$program_event = 1,
      p$terminal_event = 2,
      p$action = 3,
      p$label = 4,
      p$reassign_terminal_event = 5,
      p$status = 6;

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

    TYPE
      event_translation = record
        event_name: ost$name,
        event_trigger: fdt$event_trigger,
      recend;

    TYPE
      action_translation = record
        action_name: ost$name,
        event_action: fdt$event_action,
      recend;

    CONST
      action_maximum = 21,
      trigger_maximum = 65;

    VAR
      action: 1 .. action_maximum,
      convert_action: [READ] array [1 .. action_maximum] of action_translation :=
            [['RETURN_NORMAL', fdc$return_program_normal],
             ['RETURN_ABNORMAL', fdc$return_program_abnormal],
             ['PAGE_TABLE_FORWARD', fdc$page_table_forward],
             ['PAGE_TABLE_BACKWARD', fdc$page_table_backward],
             ['SCROLL_TABLE_FORWARD', fdc$scroll_table_forward],
             ['SCROLL_TABLE_BACKWARD', fdc$scroll_table_backward],
             ['DISPLAY_HELP', fdc$display_help],
             ['IGNORE', fdc$ignore_event],
             ['ERASE_HELP', fdc$erase_help],
             ['TAB_NEXT', fdc$tab_to_next_form_field],
             ['TAB_PREVIOUS', fdc$tab_to_previous_form_field],
             ['SCROLL_VARIABLE_FORWARD', fdc$scroll_variable_forward],
             ['SCROLL_VARIABLE_BACKWARD', fdc$scroll_variable_backward],
             ['PAGE_VARIABLE_FORWARD', fdc$page_variable_forward],
             ['PAGE_VARIABLE_BACKWARD', fdc$page_variable_backward],
             ['PAGE_VARIABLE_FIRST', fdc$page_variable_first],
             ['PAGE_VARIABLE_LAST', fdc$page_variable_last],
             ['PAGE_TABLE_FIRST', fdc$page_table_first],
             ['PAGE_TABLE_LAST', fdc$page_table_last],
             ['INSERT_VARIABLE_LINE', fdc$insert_variable_line],
             ['DELETE_VARIABLE_LINE', fdc$delete_variable_line]],

      convert_terminal_event: [READ] array [1 .. trigger_maximum] of event_translation :=
            [['NEXT', fdc$next], ['HELP', fdc$help], ['STOP', fdc$stop], ['BACK', fdc$back], ['UP', fdc$up],
            ['DOWN', fdc$down], ['FORWARD', fdc$forward], ['BACKWARD', fdc$backward], ['UNDO', fdc$undo],
            ['REDO', fdc$redo], ['QUIT', fdc$quit], ['EXIT', fdc$exit], ['FIRST', fdc$first],
            ['LAST', fdc$last], ['EDIT', fdc$edit], ['DATA', fdc$data], ['F1', fdc$function_1],
            ['F2', fdc$function_2], ['F3', fdc$function_3], ['F4', fdc$function_4], ['F5', fdc$function_5],
            ['F6', fdc$function_6], ['F7', fdc$function_7], ['F8', fdc$function_8], ['F9', fdc$function_9],
            ['F10', fdc$function_10], ['F11', fdc$function_11], ['F12', fdc$function_12],
            ['F13', fdc$function_13], ['F14', fdc$function_14], ['F15', fdc$function_15],
            ['F16', fdc$function_16], ['SHIFT_NEXT', fdc$shift_next], ['SHIFT_HELP', fdc$shift_help],
            ['SHIFT_STOP', fdc$shift_stop], ['SHIFT_BACK', fdc$shift_back], ['SHIFT_UP', fdc$shift_up],
            ['SHIFT_DOWN', fdc$shift_down], ['SHIFT_FORWARD', fdc$shift_forward],
            ['SHIFT_BACKWARD', fdc$shift_backward], ['SHIFT_EDIT', fdc$shift_edit],
            ['SHIFT_DATA', fdc$shift_data], ['SHIFT_F1', fdc$shift_function_1],
            ['SHIFT_F2', fdc$shift_function_2], ['SHIFT_F3', fdc$shift_function_3],
            ['SHIFT_F4', fdc$shift_function_4], ['SHIFT_F5', fdc$shift_function_5],
            ['SHIFT_F6', fdc$shift_function_6], ['SHIFT_F7', fdc$shift_function_7],
            ['SHIFT_F8', fdc$shift_function_8], ['SHIFT_F9', fdc$shift_function_9],
            ['SHIFT_F10', fdc$shift_function_10], ['SHIFT_F11', fdc$shift_function_11],
            ['SHIFT_F12', fdc$shift_function_12], ['SHIFT_F13', fdc$shift_function_13],
            ['SHIFT_F14', fdc$shift_function_14], ['SHIFT_F15', fdc$shift_function_15],
            ['SHIFT_F16', fdc$shift_function_16], ['PICK', fdc$pick], ['INSERT_LINE', fdc$insert_line],
            ['DELETE_LINE', fdc$delete_line], ['HOME', fdc$home_cursor], ['CLEAR_SCREEN', fdc$clear_screen],
            ['TIME_OUT', fdc$time_out], ['VARIABLE_TRIGGER', fdc$variable_trigger]],
      form_attributes: array [1 .. 1] of fdt$form_attribute,
      trigger: 1 .. trigger_maximum;

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

    form_attributes [1].key := fdc$add_event_v1;
    IF pvt [p$program_event].value^.kind = clc$name THEN
      convert_to_form_name (pvt [p$program_event].value^.name_value, form_processor,
            form_attributes [1].event_name_v1);
    ELSE
      form_attributes [1].event_name_v1 := pvt [p$program_event].value^.cobol_name_value;
    IFEND;

    form_attributes [1].event_label_v1 := pvt [p$label].value^.string_value^;

  /find_event_trigger/
    FOR trigger := LOWERBOUND (convert_terminal_event) TO UPPERBOUND (convert_terminal_event) DO
      IF (convert_terminal_event [trigger].event_name = pvt [p$terminal_event].value^.keyword_value) THEN
        form_attributes [1].event_trigger_v1 := convert_terminal_event [trigger].event_trigger;
        EXIT /find_event_trigger/;
      IFEND;
    FOREND /find_event_trigger/;

  /find_event_action/
    FOR action := LOWERBOUND (convert_action) TO UPPERBOUND (convert_action) DO
      IF (convert_action [action].action_name = pvt [p$action].value^.keyword_value) THEN
        form_attributes [1].event_action_v1 := convert_action [action].event_action;
        EXIT /find_event_action/;
      IFEND;
    FOREND /find_event_action/;

    form_attributes [1].event_trigger_reassignment_v1 := pvt [p$reassign_terminal_event].
          value^.boolean_value.value;
    fdp$change_form (current_form_identifier, form_attributes, status);

  PROCEND add_event;

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

{ PURPOSE:
{   This procedure processes the add_line command.

  PROCEDURE add_line
    (    parameter_list: clt$parameter_list;
     VAR status: ost$status);

{ PROCEDURE (fdm$crefm_addl) add_line, addl (
{   start_column, sc: integer 1..fdc$maximum_x_position = $required
{   start_line, sl: integer 1..fdc$maximum_y_position = $required
{   end_column, ec: integer 1..fdc$maximum_x_position = $required
{   end_line, el: integer 1..fdc$maximum_y_position = $required
{   display, displays, d: list of key
{       inverse, low_intensity, high_intensity, blink, black_background, blue_background, green_background
{       magenta_background, red_background, cyan_background, yellow_background, white_background
{       black_foreground, blue_foreground, green_foreground, magenta_foreground, red_foreground
{       cyan_foreground, yellow_foreground, white_foreground, fine_line, medium_line, bold_line
{     keyend = $optional
{   name, n: any of
{       name
{       cobol_name
{     anyend = $optional
{   occurrence, o: integer 1..fdc$maximum_occurrence = 1
{   status)

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

  VAR
    pdt: [STATIC, READ, cls$declaration_section] record
      header: clt$pdt_header,
      names: array [1 .. 16] of clt$pdt_parameter_name,
      parameters: array [1 .. 8] of clt$pdt_parameter,
      type1: record
        header: clt$type_specification_header,
        qualifier: clt$integer_type_qualifier,
      recend,
      type2: record
        header: clt$type_specification_header,
        qualifier: clt$integer_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,
        qualifier: clt$list_type_qualifier,
        element_type_spec: record
          header: clt$type_specification_header,
          qualifier: clt$keyword_type_qualifier,
          keyword_specs: array [1 .. 23] of clt$keyword_specification,
        recend,
      recend,
      type6: 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$name_type_qualifier,
        recend,
        type_size_2: clt$type_specification_size,
        element_type_spec_2: record
          header: clt$type_specification_header,
        recend,
      recend,
      type7: record
        header: clt$type_specification_header,
        qualifier: clt$integer_type_qualifier,
        default_value: string (1),
      recend,
      type8: record
        header: clt$type_specification_header,
      recend,
    recend := [
    [1,
    [89, 5, 18, 13, 24, 22, 342],
    clc$command, 16, 8, 4, 0, 0, 0, 8, 'FDM$CREFM_ADDL'], [
    ['D                              ',clc$abbreviation_entry, 5],
    ['DISPLAY                        ',clc$nominal_entry, 5],
    ['DISPLAYS                       ',clc$alias_entry, 5],
    ['EC                             ',clc$abbreviation_entry, 3],
    ['EL                             ',clc$abbreviation_entry, 4],
    ['END_COLUMN                     ',clc$nominal_entry, 3],
    ['END_LINE                       ',clc$nominal_entry, 4],
    ['N                              ',clc$abbreviation_entry, 6],
    ['NAME                           ',clc$nominal_entry, 6],
    ['O                              ',clc$abbreviation_entry, 7],
    ['OCCURRENCE                     ',clc$nominal_entry, 7],
    ['SC                             ',clc$abbreviation_entry, 1],
    ['SL                             ',clc$abbreviation_entry, 2],
    ['START_COLUMN                   ',clc$nominal_entry, 1],
    ['START_LINE                     ',clc$nominal_entry, 2],
    ['STATUS                         ',clc$nominal_entry, 8]],
    [
{ PARAMETER 1
    [14, 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$required_parameter,
  0, 0],
{ PARAMETER 2
    [15, 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$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_value, clc$immediate_evaluation, clc$standard_parameter_checking, 20, clc$required_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_value, clc$immediate_evaluation, clc$standard_parameter_checking, 20, clc$required_parameter,
  0, 0],
{ PARAMETER 5
    [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, 874,
  clc$optional_parameter, 0, 0],
{ PARAMETER 6
    [9, 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, 28, clc$optional_parameter,
  0, 0],
{ PARAMETER 7
    [11, 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 8
    [16, 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$integer_type], [1, fdc$maximum_x_position, 10]],
{ PARAMETER 2
    [[1, 0, clc$integer_type], [1, fdc$maximum_y_position, 10]],
{ PARAMETER 3
    [[1, 0, clc$integer_type], [1, fdc$maximum_x_position, 10]],
{ PARAMETER 4
    [[1, 0, clc$integer_type], [1, fdc$maximum_y_position, 10]],
{ PARAMETER 5
    [[1, 0, clc$list_type], [858, 1, clc$max_list_size, FALSE],
      [[1, 0, clc$keyword_type], [23], [
      ['BLACK_BACKGROUND               ', clc$nominal_entry, clc$normal_usage_entry, 5],
      ['BLACK_FOREGROUND               ', clc$nominal_entry, clc$normal_usage_entry, 13],
      ['BLINK                          ', clc$nominal_entry, clc$normal_usage_entry, 4],
      ['BLUE_BACKGROUND                ', clc$nominal_entry, clc$normal_usage_entry, 6],
      ['BLUE_FOREGROUND                ', clc$nominal_entry, clc$normal_usage_entry, 14],
      ['BOLD_LINE                      ', clc$nominal_entry, clc$normal_usage_entry, 23],
      ['CYAN_BACKGROUND                ', clc$nominal_entry, clc$normal_usage_entry, 10],
      ['CYAN_FOREGROUND                ', clc$nominal_entry, clc$normal_usage_entry, 18],
      ['FINE_LINE                      ', clc$nominal_entry, clc$normal_usage_entry, 21],
      ['GREEN_BACKGROUND               ', clc$nominal_entry, clc$normal_usage_entry, 7],
      ['GREEN_FOREGROUND               ', clc$nominal_entry, clc$normal_usage_entry, 15],
      ['HIGH_INTENSITY                 ', clc$nominal_entry, clc$normal_usage_entry, 3],
      ['INVERSE                        ', clc$nominal_entry, clc$normal_usage_entry, 1],
      ['LOW_INTENSITY                  ', clc$nominal_entry, clc$normal_usage_entry, 2],
      ['MAGENTA_BACKGROUND             ', clc$nominal_entry, clc$normal_usage_entry, 8],
      ['MAGENTA_FOREGROUND             ', clc$nominal_entry, clc$normal_usage_entry, 16],
      ['MEDIUM_LINE                    ', clc$nominal_entry, clc$normal_usage_entry, 22],
      ['RED_BACKGROUND                 ', clc$nominal_entry, clc$normal_usage_entry, 9],
      ['RED_FOREGROUND                 ', clc$nominal_entry, clc$normal_usage_entry, 17],
      ['WHITE_BACKGROUND               ', clc$nominal_entry, clc$normal_usage_entry, 12],
      ['WHITE_FOREGROUND               ', clc$nominal_entry, clc$normal_usage_entry, 20],
      ['YELLOW_BACKGROUND              ', clc$nominal_entry, clc$normal_usage_entry, 11],
      ['YELLOW_FOREGROUND              ', clc$nominal_entry, clc$normal_usage_entry, 19]]
      ]
    ],
{ PARAMETER 6
    [[1, 0, clc$union_type], [[clc$cobol_name_type, clc$name_type],
    FALSE, 2],
    5, [[1, 0, clc$name_type], [1, osc$max_name_size]],
    3, [[1, 0, clc$cobol_name_type]]
    ],
{ PARAMETER 7
    [[1, 0, clc$integer_type], [1, fdc$maximum_occurrence, 10],
    '1'],
{ PARAMETER 8
    [[1, 0, clc$status_type]]];

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

    CONST
      p$start_column = 1,
      p$start_line = 2,
      p$end_column = 3,
      p$end_line = 4,
      p$display = 5,
      p$name = 6,
      p$occurrence = 7,
      p$status = 8;

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

    VAR
      object_attributes: array [1 .. 2] of fdt$object_attribute,
      object_definition: fdt$object_definition;

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

    object_definition.key := fdc$line;
    IF (pvt [p$end_column].value^.integer_value.value > pvt [p$start_column].value^.integer_value.value) THEN
      object_definition.x_increment := pvt [p$end_column].value^.integer_value.value -
            pvt [p$start_column].value^.integer_value.value;
    ELSE
      object_definition.x_increment := pvt [p$start_column].value^.integer_value.value -
            pvt [p$end_column].value^.integer_value.value;
    IFEND;

    IF (pvt [p$end_line].value^.integer_value.value > pvt [p$start_line].value^.integer_value.value) THEN
      object_definition.y_increment := pvt [p$end_line].value^.integer_value.value - pvt [p$start_line].
            value^.integer_value.value;
    ELSE
      object_definition.y_increment := pvt [p$start_line].value^.integer_value.value - pvt [p$end_line].
            value^.integer_value.value;
    IFEND;

    IF pvt [p$display].specified THEN
      object_attributes [1].key := fdc$object_display;
      process_attributes (pvt [p$display].value, object_attributes [1].display_attribute, status);
      IF NOT status.normal THEN
        RETURN;
      IFEND;
    ELSE
      object_attributes [1].key := fdc$unused_object_entry;
    IFEND;

    IF pvt [p$name].specified THEN
      object_attributes [2].key := fdc$object_name;
      object_attributes [2].occurrence := pvt [p$occurrence].value^.integer_value.value;
      IF pvt [p$name].value^.kind = clc$name THEN
        convert_to_form_name (pvt [p$name].value^.name_value, form_processor,
              object_attributes [2].object_name);
      ELSE
        object_attributes [2].object_name := pvt [p$name].value^.cobol_name_value;
      IFEND;

    ELSE
      object_attributes [2].key := fdc$unused_object_entry;
    IFEND;

    fdp$create_object (current_form_identifier, pvt [p$start_column].
          value^.integer_value.value, pvt [p$start_line].value^.integer_value.value, object_definition,
          object_attributes, status);

  PROCEND add_line;

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

{ PURPOSE:
{   This procedure processes the add_stored_text command.

  PROCEDURE add_stored_text
    (    parameter_list: clt$parameter_list;
     VAR status: ost$status);

{ PROCEDURE (fdm$crefm_addst) add_stored_text, addst (
{   variable_name, vn: any of
{       name
{       cobol_name
{     anyend = $required
{   occurrence, o: integer 1..fdc$maximum_occurrence = $required
{   text, t: string 0..fdc$maximum_text_length = ''
{   display, displays, d: list of key
{       inverse, low_intensity, high_intensity, blink, underline, protect, hidden, black_background
{       blue_background, green_background, magenta_background, red_background, cyan_background
{       yellow_background, white_background, black_foreground, blue_foreground, green_foreground
{       magenta_foreground, red_foreground, cyan_foreground, yellow_foreground, white_foreground, italic
{       title, input, error, message, display_left_to_right, display_right_to_left
{     keyend = $optional
{   status)

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

  VAR
    pdt: [STATIC, READ, cls$declaration_section] record
      header: clt$pdt_header,
      names: array [1 .. 10] of clt$pdt_parameter_name,
      parameters: array [1 .. 5] of clt$pdt_parameter,
      type1: 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$name_type_qualifier,
        recend,
        type_size_2: clt$type_specification_size,
        element_type_spec_2: record
          header: clt$type_specification_header,
        recend,
      recend,
      type2: record
        header: clt$type_specification_header,
        qualifier: clt$integer_type_qualifier,
      recend,
      type3: record
        header: clt$type_specification_header,
        qualifier: clt$string_type_qualifier,
        default_value: string (2),
      recend,
      type4: record
        header: clt$type_specification_header,
        qualifier: clt$list_type_qualifier,
        element_type_spec: record
          header: clt$type_specification_header,
          qualifier: clt$keyword_type_qualifier,
          keyword_specs: array [1 .. 30] of clt$keyword_specification,
        recend,
      recend,
      type5: record
        header: clt$type_specification_header,
      recend,
    recend := [
    [1,
    [89, 5, 18, 16, 8, 25, 589],
    clc$command, 10, 5, 2, 0, 0, 0, 5, 'FDM$CREFM_ADDST'], [
    ['D                              ',clc$abbreviation_entry, 4],
    ['DISPLAY                        ',clc$nominal_entry, 4],
    ['DISPLAYS                       ',clc$alias_entry, 4],
    ['O                              ',clc$abbreviation_entry, 2],
    ['OCCURRENCE                     ',clc$nominal_entry, 2],
    ['STATUS                         ',clc$nominal_entry, 5],
    ['T                              ',clc$abbreviation_entry, 3],
    ['TEXT                           ',clc$nominal_entry, 3],
    ['VARIABLE_NAME                  ',clc$nominal_entry, 1],
    ['VN                             ',clc$abbreviation_entry, 1]],
    [
{ PARAMETER 1
    [9, 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, 28, 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$required_parameter,
  0, 0],
{ PARAMETER 3
    [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, 8,
  clc$optional_default_parameter, 0, 2],
{ 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_value, clc$immediate_evaluation, clc$standard_parameter_checking, 1133,
  clc$optional_parameter, 0, 0],
{ PARAMETER 5
    [6, 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$union_type], [[clc$cobol_name_type, clc$name_type],
    FALSE, 2],
    5, [[1, 0, clc$name_type], [1, osc$max_name_size]],
    3, [[1, 0, clc$cobol_name_type]]
    ],
{ PARAMETER 2
    [[1, 0, clc$integer_type], [1, fdc$maximum_occurrence, 10]],
{ PARAMETER 3
    [[1, 0, clc$string_type], [0, fdc$maximum_text_length, FALSE],
    ''''''],
{ PARAMETER 4
    [[1, 0, clc$list_type], [1117, 1, clc$max_list_size, FALSE],
      [[1, 0, clc$keyword_type], [30], [
      ['BLACK_BACKGROUND               ', clc$nominal_entry, clc$normal_usage_entry, 8],
      ['BLACK_FOREGROUND               ', clc$nominal_entry, clc$normal_usage_entry, 16],
      ['BLINK                          ', clc$nominal_entry, clc$normal_usage_entry, 4],
      ['BLUE_BACKGROUND                ', clc$nominal_entry, clc$normal_usage_entry, 9],
      ['BLUE_FOREGROUND                ', clc$nominal_entry, clc$normal_usage_entry, 17],
      ['CYAN_BACKGROUND                ', clc$nominal_entry, clc$normal_usage_entry, 13],
      ['CYAN_FOREGROUND                ', clc$nominal_entry, clc$normal_usage_entry, 21],
      ['DISPLAY_LEFT_TO_RIGHT          ', clc$nominal_entry, clc$normal_usage_entry, 29],
      ['DISPLAY_RIGHT_TO_LEFT          ', clc$nominal_entry, clc$normal_usage_entry, 30],
      ['ERROR                          ', clc$nominal_entry, clc$normal_usage_entry, 27],
      ['GREEN_BACKGROUND               ', clc$nominal_entry, clc$normal_usage_entry, 10],
      ['GREEN_FOREGROUND               ', clc$nominal_entry, clc$normal_usage_entry, 18],
      ['HIDDEN                         ', clc$nominal_entry, clc$normal_usage_entry, 7],
      ['HIGH_INTENSITY                 ', clc$nominal_entry, clc$normal_usage_entry, 3],
      ['INPUT                          ', clc$nominal_entry, clc$normal_usage_entry, 26],
      ['INVERSE                        ', clc$nominal_entry, clc$normal_usage_entry, 1],
      ['ITALIC                         ', clc$nominal_entry, clc$normal_usage_entry, 24],
      ['LOW_INTENSITY                  ', clc$nominal_entry, clc$normal_usage_entry, 2],
      ['MAGENTA_BACKGROUND             ', clc$nominal_entry, clc$normal_usage_entry, 11],
      ['MAGENTA_FOREGROUND             ', clc$nominal_entry, clc$normal_usage_entry, 19],
      ['MESSAGE                        ', clc$nominal_entry, clc$normal_usage_entry, 28],
      ['PROTECT                        ', clc$nominal_entry, clc$normal_usage_entry, 6],
      ['RED_BACKGROUND                 ', clc$nominal_entry, clc$normal_usage_entry, 12],
      ['RED_FOREGROUND                 ', clc$nominal_entry, clc$normal_usage_entry, 20],
      ['TITLE                          ', clc$nominal_entry, clc$normal_usage_entry, 25],
      ['UNDERLINE                      ', clc$nominal_entry, clc$normal_usage_entry, 5],
      ['WHITE_BACKGROUND               ', clc$nominal_entry, clc$normal_usage_entry, 15],
      ['WHITE_FOREGROUND               ', clc$nominal_entry, clc$normal_usage_entry, 23],
      ['YELLOW_BACKGROUND              ', clc$nominal_entry, clc$normal_usage_entry, 14],
      ['YELLOW_FOREGROUND              ', clc$nominal_entry, clc$normal_usage_entry, 22]]
      ]
    ],
{ PARAMETER 5
    [[1, 0, clc$status_type]]];

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

    CONST
      p$variable_name = 1,
      p$occurrence = 2,
      p$text = 3,
      p$display = 4,
      p$status = 5;

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

    VAR
      display_attribute_set: fdt$display_attribute_set,
      variable_name: ost$name;

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

    process_attributes (pvt [p$display].value, display_attribute_set, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    IF pvt [p$variable_name].value^.kind = clc$name THEN
      convert_to_form_name (pvt [p$variable_name].value^.name_value, form_processor, variable_name);
    ELSE
      variable_name := pvt [p$variable_name].value^.cobol_name_value;
    IFEND;

    fdp$create_stored_object (current_form_identifier, variable_name,
          pvt [p$occurrence].value^.integer_value.value, pvt [p$text].value^.string_value^,
          display_attribute_set, status);

  PROCEND add_stored_text;

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

{ PURPOSE:
{   This procedure processes the add_table command.

  PROCEDURE add_table
    (    parameter_list: clt$parameter_list;
     VAR status: ost$status);

{ PROCEDURE (fdm$crefm_addt) add_table, addt (
{   table_name, tn: any of
{       name
{       cobol_name
{     anyend = $required
{   variable_name, variable_names, vn: list of any of
{       name
{       cobol_name
{     anyend = $required
{   stored_occurrence, stored_occurrences, so: integer 1..fdc$maximum_occurrence = $required
{   visible_occurrence, visible_occurrences, vo: integer 1..fdc$maximum_occurrence = $optional
{   status)

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

  VAR
    pdt: [STATIC, READ, cls$declaration_section] record
      header: clt$pdt_header,
      names: array [1 .. 12] of clt$pdt_parameter_name,
      parameters: array [1 .. 5] of clt$pdt_parameter,
      type1: 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$name_type_qualifier,
        recend,
        type_size_2: clt$type_specification_size,
        element_type_spec_2: record
          header: clt$type_specification_header,
        recend,
      recend,
      type2: record
        header: clt$type_specification_header,
        qualifier: clt$list_type_qualifier,
        element_type_spec: 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$name_type_qualifier,
          recend,
          type_size_2: clt$type_specification_size,
          element_type_spec_2: record
            header: clt$type_specification_header,
          recend,
        recend,
      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, 5, 18, 16, 8, 44, 615],
    clc$command, 12, 5, 3, 0, 0, 0, 5, 'FDM$CREFM_ADDT'], [
    ['SO                             ',clc$abbreviation_entry, 3],
    ['STATUS                         ',clc$nominal_entry, 5],
    ['STORED_OCCURRENCE              ',clc$nominal_entry, 3],
    ['STORED_OCCURRENCES             ',clc$alias_entry, 3],
    ['TABLE_NAME                     ',clc$nominal_entry, 1],
    ['TN                             ',clc$abbreviation_entry, 1],
    ['VARIABLE_NAME                  ',clc$nominal_entry, 2],
    ['VARIABLE_NAMES                 ',clc$alias_entry, 2],
    ['VISIBLE_OCCURRENCE             ',clc$nominal_entry, 4],
    ['VISIBLE_OCCURRENCES            ',clc$alias_entry, 4],
    ['VN                             ',clc$abbreviation_entry, 2],
    ['VO                             ',clc$abbreviation_entry, 4]],
    [
{ PARAMETER 1
    [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, 28, clc$required_parameter,
  0, 0],
{ PARAMETER 2
    [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, 44, clc$required_parameter,
  0, 0],
{ PARAMETER 3
    [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, 20, clc$required_parameter,
  0, 0],
{ PARAMETER 4
    [9, 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_parameter,
  0, 0],
{ PARAMETER 5
    [2, 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$union_type], [[clc$cobol_name_type, clc$name_type],
    FALSE, 2],
    5, [[1, 0, clc$name_type], [1, osc$max_name_size]],
    3, [[1, 0, clc$cobol_name_type]]
    ],
{ PARAMETER 2
    [[1, 0, clc$list_type], [28, 1, clc$max_list_size, FALSE],
      [[1, 0, clc$union_type], [[clc$cobol_name_type, clc$name_type],
      FALSE, 2],
      5, [[1, 0, clc$name_type], [1, osc$max_name_size]],
      3, [[1, 0, clc$cobol_name_type]]
      ]
    ],
{ PARAMETER 3
    [[1, 0, clc$integer_type], [1, fdc$maximum_occurrence, 10]],
{ PARAMETER 4
    [[1, 0, clc$integer_type], [1, fdc$maximum_occurrence, 10]],
{ PARAMETER 5
    [[1, 0, clc$status_type]]];

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

    CONST
      p$table_name = 1,
      p$variable_name = 2,
      p$stored_occurrence = 3,
      p$visible_occurrence = 4,
      p$status = 5;

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

    CONST
      stored_attribute = 1,
      visible_attribute = 2;

    VAR
      list_size: clt$list_size,

      data_value_p: ^clt$data_value,
      table_attributes_p: ^array [1 .. * ] of fdt$table_attribute,
      table_name: ost$name,
      variable_attribute: visible_attribute + 1 .. clc$max_list_size + visible_attribute;

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

    IF pvt [p$table_name].value^.kind = clc$name THEN
      convert_to_form_name (pvt [p$table_name].value^.name_value, form_processor, table_name);
    ELSE
      table_name := pvt [p$table_name].value^.cobol_name_value;
    IFEND;

    list_size := clp$count_list_elements (pvt [p$variable_name].value);
    PUSH table_attributes_p: [1 .. list_size + visible_attribute];
    table_attributes_p^ [stored_attribute].key := fdc$stored_occurrence;
    table_attributes_p^ [stored_attribute].stored_occurrence := pvt [p$stored_occurrence].value^.
          integer_value.value;

    table_attributes_p^ [visible_attribute].key := fdc$visible_occurrence;
    IF pvt [p$visible_occurrence].specified THEN
      table_attributes_p^ [visible_attribute].visible_occurrence :=
            pvt [p$visible_occurrence].value^.integer_value.value;
    ELSE
      table_attributes_p^ [visible_attribute].visible_occurrence :=
            pvt [p$stored_occurrence].value^.integer_value.value;
    IFEND;

    data_value_p := pvt [p$variable_name].value;

    FOR variable_attribute := (visible_attribute + 1) TO visible_attribute + list_size DO
      table_attributes_p^ [variable_attribute].key := fdc$add_table_variable;
      IF data_value_p^.element_value^.kind = clc$name THEN
        convert_to_form_name (data_value_p^.element_value^.name_value, form_processor,
              table_attributes_p^ [variable_attribute].variable_name);
      ELSE
        table_attributes_p^ [variable_attribute].variable_name :=
              data_value_p^.element_value^.cobol_name_value;
      IFEND;

      data_value_p := data_value_p^.link;
    FOREND;

    fdp$create_table (current_form_identifier, table_name, table_attributes_p^, status);

  PROCEND add_table;

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

{ PURPOSE:
{   This procedure processes the add_variable command.

  PROCEDURE add_variable
    (    parameter_list: clt$parameter_list;
     VAR status: ost$status);

{ PROCEDURE (fdm$crefm_addv) add_variable, addv (
{   variable_name, vn: any of
{       name
{       cobol_name
{     anyend = $required
{   io_mode, im: key
{       input, input_output, output, program
{     keyend = input_output
{   data_type, dt: key
{       character, integer, real, uppercase, cobol
{     keyend = character
{   error_processing, ep: any of
{       key
{         none, system
{       keyend
{       name
{       string 0..fdc$maximum_y_position
{     anyend = none
{   error_display, error_displays, ed: list of key
{       inverse, low_intensity, high_intensity, blink, underline, protect, hidden, black_background
{       blue_background, green_background, magenta_background, red_background, cyan_background
{       yellow_background, white_background, black_foreground, blue_foreground, green_foreground
{       magenta_foreground, red_foreground, cyan_foreground, yellow_foreground, white_foreground, error
{       italic, title, input, message
{     keyend = $optional
{   help_processing, hp: any of
{       key
{         none, system
{       keyend
{       name
{       string 0..fdc$maximum_y_position
{     anyend = none
{   length, l: integer 1..fdc$maximum_text_length = $optional
{   user_entry, user_entries, ue: list of key
{       optional, must_enter
{     keyend = optional
{   comment, comments, c: list of string 1..fdc$maximum_comment_length = $optional
{   status)

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

  VAR
    pdt: [STATIC, READ, cls$declaration_section] record
      header: clt$pdt_header,
      names: array [1 .. 22] of clt$pdt_parameter_name,
      parameters: array [1 .. 10] of clt$pdt_parameter,
      type1: 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$name_type_qualifier,
        recend,
        type_size_2: clt$type_specification_size,
        element_type_spec_2: record
          header: clt$type_specification_header,
        recend,
      recend,
      type2: record
        header: clt$type_specification_header,
        qualifier: clt$keyword_type_qualifier,
        keyword_specs: array [1 .. 4] of clt$keyword_specification,
        default_value: string (12),
      recend,
      type3: record
        header: clt$type_specification_header,
        qualifier: clt$keyword_type_qualifier,
        keyword_specs: array [1 .. 5] of clt$keyword_specification,
        default_value: string (9),
      recend,
      type4: 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 .. 2] of clt$keyword_specification,
        recend,
        type_size_2: clt$type_specification_size,
        element_type_spec_2: record
          header: clt$type_specification_header,
          qualifier: clt$name_type_qualifier,
        recend,
        type_size_3: clt$type_specification_size,
        element_type_spec_3: record
          header: clt$type_specification_header,
          qualifier: clt$string_type_qualifier,
        recend,
        default_value: string (4),
      recend,
      type5: record
        header: clt$type_specification_header,
        qualifier: clt$list_type_qualifier,
        element_type_spec: record
          header: clt$type_specification_header,
          qualifier: clt$keyword_type_qualifier,
          keyword_specs: array [1 .. 28] of clt$keyword_specification,
        recend,
      recend,
      type6: 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 .. 2] of clt$keyword_specification,
        recend,
        type_size_2: clt$type_specification_size,
        element_type_spec_2: record
          header: clt$type_specification_header,
          qualifier: clt$name_type_qualifier,
        recend,
        type_size_3: clt$type_specification_size,
        element_type_spec_3: record
          header: clt$type_specification_header,
          qualifier: clt$string_type_qualifier,
        recend,
        default_value: string (4),
      recend,
      type7: record
        header: clt$type_specification_header,
        qualifier: clt$integer_type_qualifier,
      recend,
      type8: record
        header: clt$type_specification_header,
        qualifier: clt$list_type_qualifier,
        element_type_spec: record
          header: clt$type_specification_header,
          qualifier: clt$keyword_type_qualifier,
          keyword_specs: array [1 .. 2] of clt$keyword_specification,
        recend,
        default_value: string (8),
      recend,
      type9: record
        header: clt$type_specification_header,
        qualifier: clt$list_type_qualifier,
        element_type_spec: record
          header: clt$type_specification_header,
          qualifier: clt$string_type_qualifier,
        recend,
      recend,
      type10: record
        header: clt$type_specification_header,
      recend,
    recend := [
    [1,
    [89, 5, 26, 15, 23, 3, 998],
    clc$command, 22, 10, 1, 0, 0, 0, 10, 'FDM$CREFM_ADDV'], [
    ['C                              ',clc$abbreviation_entry, 9],
    ['COMMENT                        ',clc$nominal_entry, 9],
    ['COMMENTS                       ',clc$alias_entry, 9],
    ['DATA_TYPE                      ',clc$nominal_entry, 3],
    ['DT                             ',clc$abbreviation_entry, 3],
    ['ED                             ',clc$abbreviation_entry, 5],
    ['EP                             ',clc$abbreviation_entry, 4],
    ['ERROR_DISPLAY                  ',clc$nominal_entry, 5],
    ['ERROR_DISPLAYS                 ',clc$alias_entry, 5],
    ['ERROR_PROCESSING               ',clc$nominal_entry, 4],
    ['HELP_PROCESSING                ',clc$nominal_entry, 6],
    ['HP                             ',clc$abbreviation_entry, 6],
    ['IM                             ',clc$abbreviation_entry, 2],
    ['IO_MODE                        ',clc$nominal_entry, 2],
    ['L                              ',clc$abbreviation_entry, 7],
    ['LENGTH                         ',clc$nominal_entry, 7],
    ['STATUS                         ',clc$nominal_entry, 10],
    ['UE                             ',clc$abbreviation_entry, 8],
    ['USER_ENTRIES                   ',clc$alias_entry, 8],
    ['USER_ENTRY                     ',clc$nominal_entry, 8],
    ['VARIABLE_NAME                  ',clc$nominal_entry, 1],
    ['VN                             ',clc$abbreviation_entry, 1]],
    [
{ PARAMETER 1
    [21, 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, 28, clc$required_parameter,
  0, 0],
{ PARAMETER 2
    [14, 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, 155,
  clc$optional_default_parameter, 0, 12],
{ 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_value, clc$immediate_evaluation, clc$standard_parameter_checking, 192,
  clc$optional_default_parameter, 0, 9],
{ PARAMETER 4
    [10, 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, 4],
{ PARAMETER 5
    [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, 1059,
  clc$optional_parameter, 0, 0],
{ PARAMETER 6
    [11, 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, 4],
{ PARAMETER 7
    [16, 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_parameter,
  0, 0],
{ PARAMETER 8
    [20, 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, 97,
  clc$optional_default_parameter, 0, 8],
{ PARAMETER 9
    [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, 24, clc$optional_parameter,
  0, 0],
{ PARAMETER 10
    [17, 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$union_type], [[clc$cobol_name_type, clc$name_type],
    FALSE, 2],
    5, [[1, 0, clc$name_type], [1, osc$max_name_size]],
    3, [[1, 0, clc$cobol_name_type]]
    ],
{ PARAMETER 2
    [[1, 0, clc$keyword_type], [4], [
    ['INPUT                          ', clc$nominal_entry, clc$normal_usage_entry, 1],
    ['INPUT_OUTPUT                   ', clc$nominal_entry, clc$normal_usage_entry, 2],
    ['OUTPUT                         ', clc$nominal_entry, clc$normal_usage_entry, 3],
    ['PROGRAM                        ', clc$nominal_entry, clc$normal_usage_entry, 4]]
    ,
    'input_output'],
{ PARAMETER 3
    [[1, 0, clc$keyword_type], [5], [
    ['CHARACTER                      ', clc$nominal_entry, clc$normal_usage_entry, 1],
    ['COBOL                          ', clc$nominal_entry, clc$normal_usage_entry, 5],
    ['INTEGER                        ', clc$nominal_entry, clc$normal_usage_entry, 2],
    ['REAL                           ', clc$nominal_entry, clc$normal_usage_entry, 3],
    ['UPPERCASE                      ', clc$nominal_entry, clc$normal_usage_entry, 4]]
    ,
    'character'],
{ PARAMETER 4
    [[1, 0, clc$union_type], [[clc$keyword_type, clc$name_type, clc$string_type],
    FALSE, 3],
    81, [[1, 0, clc$keyword_type], [2], [
      ['NONE                           ', clc$nominal_entry, clc$normal_usage_entry, 1],
      ['SYSTEM                         ', clc$nominal_entry, clc$normal_usage_entry, 2]]
      ],
    5, [[1, 0, clc$name_type], [1, osc$max_name_size]],
    8, [[1, 0, clc$string_type], [0, fdc$maximum_y_position, FALSE]]
    ,
    'none'],
{ PARAMETER 5
    [[1, 0, clc$list_type], [1043, 1, clc$max_list_size, FALSE],
      [[1, 0, clc$keyword_type], [28], [
      ['BLACK_BACKGROUND               ', clc$nominal_entry, clc$normal_usage_entry, 8],
      ['BLACK_FOREGROUND               ', clc$nominal_entry, clc$normal_usage_entry, 16],
      ['BLINK                          ', clc$nominal_entry, clc$normal_usage_entry, 4],
      ['BLUE_BACKGROUND                ', clc$nominal_entry, clc$normal_usage_entry, 9],
      ['BLUE_FOREGROUND                ', clc$nominal_entry, clc$normal_usage_entry, 17],
      ['CYAN_BACKGROUND                ', clc$nominal_entry, clc$normal_usage_entry, 13],
      ['CYAN_FOREGROUND                ', clc$nominal_entry, clc$normal_usage_entry, 21],
      ['ERROR                          ', clc$nominal_entry, clc$normal_usage_entry, 24],
      ['GREEN_BACKGROUND               ', clc$nominal_entry, clc$normal_usage_entry, 10],
      ['GREEN_FOREGROUND               ', clc$nominal_entry, clc$normal_usage_entry, 18],
      ['HIDDEN                         ', clc$nominal_entry, clc$normal_usage_entry, 7],
      ['HIGH_INTENSITY                 ', clc$nominal_entry, clc$normal_usage_entry, 3],
      ['INPUT                          ', clc$nominal_entry, clc$normal_usage_entry, 27],
      ['INVERSE                        ', clc$nominal_entry, clc$normal_usage_entry, 1],
      ['ITALIC                         ', clc$nominal_entry, clc$normal_usage_entry, 25],
      ['LOW_INTENSITY                  ', clc$nominal_entry, clc$normal_usage_entry, 2],
      ['MAGENTA_BACKGROUND             ', clc$nominal_entry, clc$normal_usage_entry, 11],
      ['MAGENTA_FOREGROUND             ', clc$nominal_entry, clc$normal_usage_entry, 19],
      ['MESSAGE                        ', clc$nominal_entry, clc$normal_usage_entry, 28],
      ['PROTECT                        ', clc$nominal_entry, clc$normal_usage_entry, 6],
      ['RED_BACKGROUND                 ', clc$nominal_entry, clc$normal_usage_entry, 12],
      ['RED_FOREGROUND                 ', clc$nominal_entry, clc$normal_usage_entry, 20],
      ['TITLE                          ', clc$nominal_entry, clc$normal_usage_entry, 26],
      ['UNDERLINE                      ', clc$nominal_entry, clc$normal_usage_entry, 5],
      ['WHITE_BACKGROUND               ', clc$nominal_entry, clc$normal_usage_entry, 15],
      ['WHITE_FOREGROUND               ', clc$nominal_entry, clc$normal_usage_entry, 23],
      ['YELLOW_BACKGROUND              ', clc$nominal_entry, clc$normal_usage_entry, 14],
      ['YELLOW_FOREGROUND              ', clc$nominal_entry, clc$normal_usage_entry, 22]]
      ]
    ],
{ PARAMETER 6
    [[1, 0, clc$union_type], [[clc$keyword_type, clc$name_type, clc$string_type],
    FALSE, 3],
    81, [[1, 0, clc$keyword_type], [2], [
      ['NONE                           ', clc$nominal_entry, clc$normal_usage_entry, 1],
      ['SYSTEM                         ', clc$nominal_entry, clc$normal_usage_entry, 2]]
      ],
    5, [[1, 0, clc$name_type], [1, osc$max_name_size]],
    8, [[1, 0, clc$string_type], [0, fdc$maximum_y_position, FALSE]]
    ,
    'none'],
{ PARAMETER 7
    [[1, 0, clc$integer_type], [1, fdc$maximum_text_length, 10]],
{ PARAMETER 8
    [[1, 0, clc$list_type], [81, 1, clc$max_list_size, FALSE],
      [[1, 0, clc$keyword_type], [2], [
      ['MUST_ENTER                     ', clc$nominal_entry, clc$normal_usage_entry, 2],
      ['OPTIONAL                       ', clc$nominal_entry, clc$normal_usage_entry, 1]]
      ]
    ,
    'optional'],
{ PARAMETER 9
    [[1, 0, clc$list_type], [8, 1, clc$max_list_size, FALSE],
      [[1, 0, clc$string_type], [1, fdc$maximum_comment_length, FALSE]]
    ],
{ PARAMETER 10
    [[1, 0, clc$status_type]]];

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

    CONST
      p$variable_name = 1,
      p$io_mode = 2,
      p$data_type = 3,
      p$error_processing = 4,
      p$error_display = 5,
      p$help_processing = 6,
      p$length = 7,
      p$user_entry = 8,
      p$comment = 9,
      p$status = 10;

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

    CONST
      io_attribute = 1,
      data_type_attribute = 2,
      error_processing_attribute = 3,
      help_attribute = 4,
      error_display_attribute = 5,
      length_attribute = 6,
      user_entry_attribute = 7,
      comment_attribute = 8;

    VAR
      comment_list_size: clt$list_size,
      keyword: clt$keyword,
      user_entry_list_size: clt$list_size,
      n: integer,
      data_value_p: ^clt$data_value,
      variable_attributes_p: ^array [1 .. * ] of fdt$variable_attribute,
      variable_name: ost$name;

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

    IF pvt [p$variable_name].value^.kind = clc$name THEN
      convert_to_form_name (pvt [p$variable_name].value^.name_value, form_processor, variable_name);
    ELSE
      variable_name := pvt [p$variable_name].value^.cobol_name_value;
    IFEND;

    comment_list_size := clp$count_list_elements (pvt [p$comment].value);
    PUSH variable_attributes_p: [1 .. comment_list_size + user_entry_attribute];
    variable_attributes_p^ [io_attribute].key := fdc$io_mode;
    IF (pvt [p$io_mode].value^.keyword_value = 'INPUT') THEN
      variable_attributes_p^ [io_attribute].io_mode := fdc$terminal_input;
    ELSEIF (pvt [p$io_mode].value^.keyword_value = 'INPUT_OUTPUT') THEN
      variable_attributes_p^ [io_attribute].io_mode := fdc$terminal_input_output;
    ELSEIF (pvt [p$io_mode].value^.keyword_value = 'OUTPUT') THEN
      variable_attributes_p^ [io_attribute].io_mode := fdc$terminal_output;
    ELSEIF (pvt [p$io_mode].value^.keyword_value = 'PROGRAM') THEN
      variable_attributes_p^ [io_attribute].io_mode := fdc$program_input_output;
    IFEND;

    variable_attributes_p^ [data_type_attribute].key := fdc$program_data_type;
    IF (pvt [p$data_type].value^.keyword_value = 'CHARACTER') THEN
      variable_attributes_p^ [data_type_attribute].program_data_type := fdc$program_character_type;
    ELSEIF (pvt [p$data_type].value^.keyword_value = 'INTEGER') THEN
      variable_attributes_p^ [data_type_attribute].program_data_type := fdc$program_integer_type;
    ELSEIF (pvt [p$data_type].value^.keyword_value = 'REAL') THEN
      variable_attributes_p^ [data_type_attribute].program_data_type := fdc$program_real_type;
    ELSEIF (pvt [p$data_type].value^.keyword_value = 'UPPERCASE') THEN
      variable_attributes_p^ [data_type_attribute].program_data_type := fdc$program_upper_case_type;
    ELSEIF (pvt [p$data_type].value^.keyword_value = 'COBOL') THEN
      variable_attributes_p^ [data_type_attribute].program_data_type := fdc$program_cobol_type;
    IFEND;

    variable_attributes_p^ [error_processing_attribute].key := fdc$variable_error;
    CASE pvt [p$error_processing].value^.kind OF

    = clc$keyword =
      IF (pvt [p$error_processing].value^.keyword_value = 'SYSTEM') THEN
        variable_attributes_p^ [error_processing_attribute].variable_error.key := fdc$system_default_error;
      ELSEIF (pvt [p$error_processing].value^.keyword_value = 'NONE') THEN
        variable_attributes_p^ [error_processing_attribute].variable_error.key := fdc$no_error_response;
      IFEND;

    = clc$name =
      variable_attributes_p^ [error_processing_attribute].variable_error.key := fdc$error_form;
      variable_attributes_p^ [error_processing_attribute].variable_error.error_form :=
            pvt [p$error_processing].value^.name_value;
    ELSE
      variable_attributes_p^ [error_processing_attribute].variable_error.key := fdc$error_message;
      variable_attributes_p^ [error_processing_attribute].variable_error.p_error_message :=
            pvt [p$error_processing].value^.string_value;
    CASEND;

    variable_attributes_p^ [help_attribute].key := fdc$variable_help;
    CASE pvt [p$help_processing].value^.kind OF

    = clc$keyword =
      IF (pvt [p$help_processing].value^.keyword_value = 'SYSTEM') THEN
        variable_attributes_p^ [help_attribute].variable_help.key := fdc$system_default_help;
      ELSE
        variable_attributes_p^ [help_attribute].variable_help.key := fdc$no_help_response;
      IFEND;

    = clc$name =
      variable_attributes_p^ [help_attribute].variable_help.key := fdc$help_form;
      variable_attributes_p^ [help_attribute].variable_help.help_form :=
            pvt [p$help_processing].value^.name_value;

    ELSE
      variable_attributes_p^ [help_attribute].variable_help.key := fdc$help_message;
      variable_attributes_p^ [help_attribute].variable_help.p_help_message :=
            pvt [p$help_processing].value^.string_value;
    CASEND;

    IF pvt [p$error_display].specified THEN
      variable_attributes_p^ [error_display_attribute].key := fdc$error_display;
      process_attributes (pvt [p$error_display].value, variable_attributes_p^ [error_display_attribute].
            display_attribute, status);
      IF NOT status.normal THEN
       RETURN;
      IFEND;
    ELSE
      variable_attributes_p^ [error_display_attribute].key := fdc$unused_variable_entry;
    IFEND;

    IF pvt [p$length].specified THEN
      variable_attributes_p^ [length_attribute].key := fdc$variable_length;
      variable_attributes_p^ [length_attribute].variable_length := pvt [p$length].value^.integer_value.value;
    ELSE
      variable_attributes_p^ [length_attribute].key := fdc$unused_variable_entry;
    IFEND;

    variable_attributes_p^ [user_entry_attribute].key := fdc$terminal_user_entry;
    variable_attributes_p^ [user_entry_attribute].terminal_user_entry := $fdt$terminal_user_entry [];

    data_value_p := pvt [p$user_entry].value;
    user_entry_list_size := clp$count_list_elements (data_value_p);

  /get_next_entry/
    FOR n := 1 TO user_entry_list_size DO
      keyword := data_value_p^.element_value^.keyword_value;
      IF (keyword = 'OPTIONAL') THEN
        variable_attributes_p^ [user_entry_attribute].terminal_user_entry :=
              variable_attributes_p^ [user_entry_attribute].terminal_user_entry +
              $fdt$terminal_user_entry [fdc$entry_optional];
      ELSE
        variable_attributes_p^ [user_entry_attribute].terminal_user_entry :=
              variable_attributes_p^ [user_entry_attribute].terminal_user_entry +
              $fdt$terminal_user_entry [fdc$must_enter];
      IFEND;

      data_value_p := data_value_p^.link;

    FOREND /get_next_entry/;

    data_value_p := pvt [p$comment].value;

  /get_comment/
    FOR n := comment_attribute TO comment_list_size + user_entry_attribute DO
      variable_attributes_p^ [n].key := fdc$add_var_comment;
      variable_attributes_p^ [n].p_var_comment := data_value_p^.element_value^.string_value;
      data_value_p := data_value_p^.link;
    FOREND /get_comment/;

    fdp$create_variable (current_form_identifier, variable_name, variable_attributes_p^, status);

  PROCEND add_variable;

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

{ PURPOSE:
{   This procedure processes the add_variable_text command.

  PROCEDURE add_variable_text
    (    parameter_list: clt$parameter_list;
     VAR status: ost$status);


{ PROCEDURE (fdm$crefm_addvt) add_variable_text, addvt (
{   column, c: integer 1..fdc$maximum_x_position = $required
{   line, l: integer 1..fdc$maximum_y_position = $required
{   text, t: string 0..fdc$maximum_text_length = $required
{   variable_name, vn: any of
{       name
{       cobol_name
{     anyend = $required
{   occurrence, o: integer 1..fdc$maximum_occurrence = 1
{   display, displays, d: list of key
{       inverse, low_intensity, high_intensity, blink, underline, protect, hidden, black_background
{       blue_background, green_background, magenta_background, red_background, cyan_background
{       yellow_background, white_background, black_foreground, blue_foreground, green_foreground
{       magenta_foreground, red_foreground, cyan_foreground, yellow_foreground, white_foreground, italic
{       title, input, error, message, display_left_to_right, display_right_to_left
{     keyend = $optional
{   width, w: integer 1..fdc$maximum_y_position = $optional
{   status)

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

  VAR
    pdt: [STATIC, READ, cls$declaration_section] record
      header: clt$pdt_header,
      names: array [1 .. 16] of clt$pdt_parameter_name,
      parameters: array [1 .. 8] of clt$pdt_parameter,
      type1: record
        header: clt$type_specification_header,
        qualifier: clt$integer_type_qualifier,
      recend,
      type2: record
        header: clt$type_specification_header,
        qualifier: clt$integer_type_qualifier,
      recend,
      type3: record
        header: clt$type_specification_header,
        qualifier: clt$string_type_qualifier,
      recend,
      type4: 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$name_type_qualifier,
        recend,
        type_size_2: clt$type_specification_size,
        element_type_spec_2: record
          header: clt$type_specification_header,
        recend,
      recend,
      type5: record
        header: clt$type_specification_header,
        qualifier: clt$integer_type_qualifier,
        default_value: string (1),
      recend,
      type6: record
        header: clt$type_specification_header,
        qualifier: clt$list_type_qualifier,
        element_type_spec: record
          header: clt$type_specification_header,
          qualifier: clt$keyword_type_qualifier,
          keyword_specs: array [1 .. 30] of clt$keyword_specification,
        recend,
      recend,
      type7: record
        header: clt$type_specification_header,
        qualifier: clt$integer_type_qualifier,
      recend,
      type8: record
        header: clt$type_specification_header,
      recend,
    recend := [
    [1,
    [89, 5, 18, 16, 9, 26, 715],
    clc$command, 16, 8, 4, 0, 0, 0, 8, 'FDM$CREFM_ADDVT'], [
    ['C                              ',clc$abbreviation_entry, 1],
    ['COLUMN                         ',clc$nominal_entry, 1],
    ['D                              ',clc$abbreviation_entry, 6],
    ['DISPLAY                        ',clc$nominal_entry, 6],
    ['DISPLAYS                       ',clc$alias_entry, 6],
    ['L                              ',clc$abbreviation_entry, 2],
    ['LINE                           ',clc$nominal_entry, 2],
    ['O                              ',clc$abbreviation_entry, 5],
    ['OCCURRENCE                     ',clc$nominal_entry, 5],
    ['STATUS                         ',clc$nominal_entry, 8],
    ['T                              ',clc$abbreviation_entry, 3],
    ['TEXT                           ',clc$nominal_entry, 3],
    ['VARIABLE_NAME                  ',clc$nominal_entry, 4],
    ['VN                             ',clc$abbreviation_entry, 4],
    ['W                              ',clc$abbreviation_entry, 7],
    ['WIDTH                          ',clc$nominal_entry, 7]],
    [
{ 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, 20, clc$required_parameter,
  0, 0],
{ PARAMETER 2
    [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$required_parameter,
  0, 0],
{ PARAMETER 3
    [12, 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, 8, clc$required_parameter, 0
  , 0],
{ PARAMETER 4
    [13, 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, 28, clc$required_parameter,
  0, 0],
{ PARAMETER 5
    [9, 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 6
    [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, 1133,
  clc$optional_parameter, 0, 0],
{ PARAMETER 7
    [16, 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_parameter,
  0, 0],
{ PARAMETER 8
    [10, 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$integer_type], [1, fdc$maximum_x_position, 10]],
{ PARAMETER 2
    [[1, 0, clc$integer_type], [1, fdc$maximum_y_position, 10]],
{ PARAMETER 3
    [[1, 0, clc$string_type], [0, fdc$maximum_text_length, FALSE]],
{ PARAMETER 4
    [[1, 0, clc$union_type], [[clc$cobol_name_type, clc$name_type],
    FALSE, 2],
    5, [[1, 0, clc$name_type], [1, osc$max_name_size]],
    3, [[1, 0, clc$cobol_name_type]]
    ],
{ PARAMETER 5
    [[1, 0, clc$integer_type], [1, fdc$maximum_occurrence, 10],
    '1'],
{ PARAMETER 6
    [[1, 0, clc$list_type], [1117, 1, clc$max_list_size, FALSE],
      [[1, 0, clc$keyword_type], [30], [
      ['BLACK_BACKGROUND               ', clc$nominal_entry, clc$normal_usage_entry, 8],
      ['BLACK_FOREGROUND               ', clc$nominal_entry, clc$normal_usage_entry, 16],
      ['BLINK                          ', clc$nominal_entry, clc$normal_usage_entry, 4],
      ['BLUE_BACKGROUND                ', clc$nominal_entry, clc$normal_usage_entry, 9],
      ['BLUE_FOREGROUND                ', clc$nominal_entry, clc$normal_usage_entry, 17],
      ['CYAN_BACKGROUND                ', clc$nominal_entry, clc$normal_usage_entry, 13],
      ['CYAN_FOREGROUND                ', clc$nominal_entry, clc$normal_usage_entry, 21],
      ['DISPLAY_LEFT_TO_RIGHT          ', clc$nominal_entry, clc$normal_usage_entry, 29],
      ['DISPLAY_RIGHT_TO_LEFT          ', clc$nominal_entry, clc$normal_usage_entry, 30],
      ['ERROR                          ', clc$nominal_entry, clc$normal_usage_entry, 27],
      ['GREEN_BACKGROUND               ', clc$nominal_entry, clc$normal_usage_entry, 10],
      ['GREEN_FOREGROUND               ', clc$nominal_entry, clc$normal_usage_entry, 18],
      ['HIDDEN                         ', clc$nominal_entry, clc$normal_usage_entry, 7],
      ['HIGH_INTENSITY                 ', clc$nominal_entry, clc$normal_usage_entry, 3],
      ['INPUT                          ', clc$nominal_entry, clc$normal_usage_entry, 26],
      ['INVERSE                        ', clc$nominal_entry, clc$normal_usage_entry, 1],
      ['ITALIC                         ', clc$nominal_entry, clc$normal_usage_entry, 24],
      ['LOW_INTENSITY                  ', clc$nominal_entry, clc$normal_usage_entry, 2],
      ['MAGENTA_BACKGROUND             ', clc$nominal_entry, clc$normal_usage_entry, 11],
      ['MAGENTA_FOREGROUND             ', clc$nominal_entry, clc$normal_usage_entry, 19],
      ['MESSAGE                        ', clc$nominal_entry, clc$normal_usage_entry, 28],
      ['PROTECT                        ', clc$nominal_entry, clc$normal_usage_entry, 6],
      ['RED_BACKGROUND                 ', clc$nominal_entry, clc$normal_usage_entry, 12],
      ['RED_FOREGROUND                 ', clc$nominal_entry, clc$normal_usage_entry, 20],
      ['TITLE                          ', clc$nominal_entry, clc$normal_usage_entry, 25],
      ['UNDERLINE                      ', clc$nominal_entry, clc$normal_usage_entry, 5],
      ['WHITE_BACKGROUND               ', clc$nominal_entry, clc$normal_usage_entry, 15],
      ['WHITE_FOREGROUND               ', clc$nominal_entry, clc$normal_usage_entry, 23],
      ['YELLOW_BACKGROUND              ', clc$nominal_entry, clc$normal_usage_entry, 14],
      ['YELLOW_FOREGROUND              ', clc$nominal_entry, clc$normal_usage_entry, 22]]
      ]
    ],
{ PARAMETER 7
    [[1, 0, clc$integer_type], [1, fdc$maximum_y_position, 10]],
{ PARAMETER 8
    [[1, 0, clc$status_type]]];

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

    CONST
      p$column = 1,
      p$line = 2,
      p$text = 3,
      p$variable_name = 4,
      p$occurrence = 5,
      p$display = 6,
      p$width = 7,
      p$status = 8;

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

    VAR
      object_attributes: array [1 .. 2] of fdt$object_attribute,
      object_definition: fdt$object_definition;

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

    object_definition.key := fdc$variable_text;
    object_definition.p_variable_text := pvt [p$text].value^.string_value;
    IF pvt [p$width].specified THEN
      object_definition.variable_text_width := pvt [p$width].value^.integer_value.value;
    ELSE

{ If user does not specify the width, then the length of the text is used.

      IF STRLENGTH (pvt [p$text].value^.string_value^) <> 0 THEN
        object_definition.variable_text_width := STRLENGTH (pvt [p$text].value^.string_value^);
      ELSE
        osp$set_status_abnormal (fdc$format_display_identifier, fde$object_width_required, current_form_name,
              status);
        osp$append_status_parameter (osc$status_parameter_delimiter, pvt [p$variable_name].value^.name_value,
              status);
        RETURN;
      IFEND;
    IFEND;

    IF pvt [p$display].specified THEN
      object_attributes [1].key := fdc$object_display;
      process_attributes (pvt [p$display].value, object_attributes [1].display_attribute, status);
      IF NOT status.normal THEN
        RETURN;
      IFEND;
    ELSE
      object_attributes [1].key := fdc$unused_object_entry;
    IFEND;

    object_attributes [2].key := fdc$object_name;
    object_attributes [2].occurrence := pvt [p$occurrence].value^.integer_value.value;
    IF pvt [p$variable_name].value^.kind = clc$name THEN
      convert_to_form_name (pvt [p$variable_name].value^.name_value, form_processor,
            object_attributes [2].object_name);
    ELSE
      object_attributes [2].object_name := pvt [p$variable_name].value^.cobol_name_value;
    IFEND;

{ Special fix for Screen Design Facility.  SDF cannot handle zero length strings.

    IF STRLENGTH (object_definition.p_variable_text^) = 0 THEN
      object_definition.p_variable_text := ^one_blank;
    IFEND;

    fdp$create_object (current_form_identifier, pvt [p$column].value^.integer_value.value, pvt [p$line].
          value^.integer_value.value, object_definition, object_attributes, status);

  PROCEND add_variable_text;

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

{ PURPOSE:
{   This procedure processes the add_variable_text_box command.

  PROCEDURE add_variable_text_box
    (    parameter_list: clt$parameter_list;
     VAR status: ost$status);

{ PROCEDURE (fdm$crefm_addvtb) add_variable_text_box, addvtb (
{   column, c: integer 1..fdc$maximum_x_position = $required
{   line, l: integer 1..fdc$maximum_y_position = $required
{   text, t: string 0..fdc$maximum_text_length = $required
{   width, w: integer 1..fdc$maximum_x_position = $required
{   height, h: integer 1..fdc$maximum_y_position = $required
{   variable_name, vn: any of
{       name
{       cobol_name
{     anyend = $required
{   occurrence, o: integer 1..fdc$maximum_occurrence = 1
{   display, displays, d: list of key
{       inverse, low_intensity, high_intensity, blink, underline, protect, hidden, black_background
{       blue_background, green_background, magenta_background, red_background, cyan_background
{       yellow_background, white_background, black_foreground, blue_foreground, green_foreground
{       magenta_foreground, red_foreground, cyan_foreground, yellow_foreground, white_foreground, italic
{       title, input, error, message, display_left_to_right, display_right_to_left
{     keyend = $optional
{   text_format, tf: key
{       wrap_words, wrap_characters
{     keyend = wrap_words
{   status)

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

  VAR
    pdt: [STATIC, READ, cls$declaration_section] record
      header: clt$pdt_header,
      names: array [1 .. 20] of clt$pdt_parameter_name,
      parameters: array [1 .. 10] of clt$pdt_parameter,
      type1: record
        header: clt$type_specification_header,
        qualifier: clt$integer_type_qualifier,
      recend,
      type2: record
        header: clt$type_specification_header,
        qualifier: clt$integer_type_qualifier,
      recend,
      type3: record
        header: clt$type_specification_header,
        qualifier: clt$string_type_qualifier,
      recend,
      type4: record
        header: clt$type_specification_header,
        qualifier: clt$integer_type_qualifier,
      recend,
      type5: record
        header: clt$type_specification_header,
        qualifier: clt$integer_type_qualifier,
      recend,
      type6: 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$name_type_qualifier,
        recend,
        type_size_2: clt$type_specification_size,
        element_type_spec_2: record
          header: clt$type_specification_header,
        recend,
      recend,
      type7: record
        header: clt$type_specification_header,
        qualifier: clt$integer_type_qualifier,
        default_value: string (1),
      recend,
      type8: record
        header: clt$type_specification_header,
        qualifier: clt$list_type_qualifier,
        element_type_spec: record
          header: clt$type_specification_header,
          qualifier: clt$keyword_type_qualifier,
          keyword_specs: array [1 .. 30] of clt$keyword_specification,
        recend,
      recend,
      type9: record
        header: clt$type_specification_header,
        qualifier: clt$keyword_type_qualifier,
        keyword_specs: array [1 .. 2] of clt$keyword_specification,
        default_value: string (10),
      recend,
      type10: record
        header: clt$type_specification_header,
      recend,
    recend := [
    [1,
    [89, 5, 18, 16, 9, 43, 812],
    clc$command, 20, 10, 6, 0, 0, 0, 10, 'FDM$CREFM_ADDVTB'], [
    ['C                              ',clc$abbreviation_entry, 1],
    ['COLUMN                         ',clc$nominal_entry, 1],
    ['D                              ',clc$abbreviation_entry, 8],
    ['DISPLAY                        ',clc$nominal_entry, 8],
    ['DISPLAYS                       ',clc$alias_entry, 8],
    ['H                              ',clc$abbreviation_entry, 5],
    ['HEIGHT                         ',clc$nominal_entry, 5],
    ['L                              ',clc$abbreviation_entry, 2],
    ['LINE                           ',clc$nominal_entry, 2],
    ['O                              ',clc$abbreviation_entry, 7],
    ['OCCURRENCE                     ',clc$nominal_entry, 7],
    ['STATUS                         ',clc$nominal_entry, 10],
    ['T                              ',clc$abbreviation_entry, 3],
    ['TEXT                           ',clc$nominal_entry, 3],
    ['TEXT_FORMAT                    ',clc$nominal_entry, 9],
    ['TF                             ',clc$abbreviation_entry, 9],
    ['VARIABLE_NAME                  ',clc$nominal_entry, 6],
    ['VN                             ',clc$abbreviation_entry, 6],
    ['W                              ',clc$abbreviation_entry, 4],
    ['WIDTH                          ',clc$nominal_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, 20, clc$required_parameter,
  0, 0],
{ PARAMETER 2
    [9, 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$required_parameter,
  0, 0],
{ PARAMETER 3
    [14, 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, 8, clc$required_parameter, 0
  , 0],
{ PARAMETER 4
    [20, 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$required_parameter,
  0, 0],
{ PARAMETER 5
    [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$required_parameter,
  0, 0],
{ PARAMETER 6
    [17, 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, 28, clc$required_parameter,
  0, 0],
{ PARAMETER 7
    [11, 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 8
    [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, 1133,
  clc$optional_parameter, 0, 0],
{ PARAMETER 9
    [15, 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, 10],
{ PARAMETER 10
    [12, 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$integer_type], [1, fdc$maximum_x_position, 10]],
{ PARAMETER 2
    [[1, 0, clc$integer_type], [1, fdc$maximum_y_position, 10]],
{ PARAMETER 3
    [[1, 0, clc$string_type], [0, fdc$maximum_text_length, FALSE]],
{ PARAMETER 4
    [[1, 0, clc$integer_type], [1, fdc$maximum_x_position, 10]],
{ PARAMETER 5
    [[1, 0, clc$integer_type], [1, fdc$maximum_y_position, 10]],
{ PARAMETER 6
    [[1, 0, clc$union_type], [[clc$cobol_name_type, clc$name_type],
    FALSE, 2],
    5, [[1, 0, clc$name_type], [1, osc$max_name_size]],
    3, [[1, 0, clc$cobol_name_type]]
    ],
{ PARAMETER 7
    [[1, 0, clc$integer_type], [1, fdc$maximum_occurrence, 10],
    '1'],
{ PARAMETER 8
    [[1, 0, clc$list_type], [1117, 1, clc$max_list_size, FALSE],
      [[1, 0, clc$keyword_type], [30], [
      ['BLACK_BACKGROUND               ', clc$nominal_entry, clc$normal_usage_entry, 8],
      ['BLACK_FOREGROUND               ', clc$nominal_entry, clc$normal_usage_entry, 16],
      ['BLINK                          ', clc$nominal_entry, clc$normal_usage_entry, 4],
      ['BLUE_BACKGROUND                ', clc$nominal_entry, clc$normal_usage_entry, 9],
      ['BLUE_FOREGROUND                ', clc$nominal_entry, clc$normal_usage_entry, 17],
      ['CYAN_BACKGROUND                ', clc$nominal_entry, clc$normal_usage_entry, 13],
      ['CYAN_FOREGROUND                ', clc$nominal_entry, clc$normal_usage_entry, 21],
      ['DISPLAY_LEFT_TO_RIGHT          ', clc$nominal_entry, clc$normal_usage_entry, 29],
      ['DISPLAY_RIGHT_TO_LEFT          ', clc$nominal_entry, clc$normal_usage_entry, 30],
      ['ERROR                          ', clc$nominal_entry, clc$normal_usage_entry, 27],
      ['GREEN_BACKGROUND               ', clc$nominal_entry, clc$normal_usage_entry, 10],
      ['GREEN_FOREGROUND               ', clc$nominal_entry, clc$normal_usage_entry, 18],
      ['HIDDEN                         ', clc$nominal_entry, clc$normal_usage_entry, 7],
      ['HIGH_INTENSITY                 ', clc$nominal_entry, clc$normal_usage_entry, 3],
      ['INPUT                          ', clc$nominal_entry, clc$normal_usage_entry, 26],
      ['INVERSE                        ', clc$nominal_entry, clc$normal_usage_entry, 1],
      ['ITALIC                         ', clc$nominal_entry, clc$normal_usage_entry, 24],
      ['LOW_INTENSITY                  ', clc$nominal_entry, clc$normal_usage_entry, 2],
      ['MAGENTA_BACKGROUND             ', clc$nominal_entry, clc$normal_usage_entry, 11],
      ['MAGENTA_FOREGROUND             ', clc$nominal_entry, clc$normal_usage_entry, 19],
      ['MESSAGE                        ', clc$nominal_entry, clc$normal_usage_entry, 28],
      ['PROTECT                        ', clc$nominal_entry, clc$normal_usage_entry, 6],
      ['RED_BACKGROUND                 ', clc$nominal_entry, clc$normal_usage_entry, 12],
      ['RED_FOREGROUND                 ', clc$nominal_entry, clc$normal_usage_entry, 20],
      ['TITLE                          ', clc$nominal_entry, clc$normal_usage_entry, 25],
      ['UNDERLINE                      ', clc$nominal_entry, clc$normal_usage_entry, 5],
      ['WHITE_BACKGROUND               ', clc$nominal_entry, clc$normal_usage_entry, 15],
      ['WHITE_FOREGROUND               ', clc$nominal_entry, clc$normal_usage_entry, 23],
      ['YELLOW_BACKGROUND              ', clc$nominal_entry, clc$normal_usage_entry, 14],
      ['YELLOW_FOREGROUND              ', clc$nominal_entry, clc$normal_usage_entry, 22]]
      ]
    ],
{ PARAMETER 9
    [[1, 0, clc$keyword_type], [2], [
    ['WRAP_CHARACTERS                ', clc$nominal_entry, clc$normal_usage_entry, 2],
    ['WRAP_WORDS                     ', clc$nominal_entry, clc$normal_usage_entry, 1]]
    ,
    'wrap_words'],
{ PARAMETER 10
    [[1, 0, clc$status_type]]];

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

    CONST
      p$column = 1,
      p$line = 2,
      p$text = 3,
      p$width = 4,
      p$height = 5,
      p$variable_name = 6,
      p$occurrence = 7,
      p$display = 8,
      p$text_format = 9,
      p$status = 10;

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

    VAR
      fix_string_p: ^string(*),
      object_attributes: array [1 .. 2] of fdt$object_attribute,
      object_definition: fdt$object_definition;

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

    object_definition.key := fdc$variable_text_box;
    object_definition.p_variable_box_text := pvt [p$text].value^.string_value;
    object_definition.variable_box_width := pvt [p$width].value^.integer_value.value;
    object_definition.variable_box_height := pvt [p$height].value^.integer_value.value;
    IF (pvt [p$text_format].value^.keyword_value = 'WRAP_WORDS') THEN
      object_definition.variable_box_processing := fdc$wrap_words;
    ELSE
      object_definition.variable_box_processing := fdc$wrap_characters;
    IFEND;

    IF pvt [p$display].specified THEN
      object_attributes [1].key := fdc$object_display;
      process_attributes (pvt [p$display].value, object_attributes [1].display_attribute, status);
      IF NOT status.normal THEN
        RETURN;
      IFEND;
    ELSE
      object_attributes [1].key := fdc$unused_object_entry;
    IFEND;

    object_attributes [2].key := fdc$object_name;
    object_attributes [2].occurrence := pvt [p$occurrence].value^.integer_value.value;
    IF pvt [p$variable_name].value^.kind = clc$name THEN
      convert_to_form_name (pvt [p$variable_name].value^.name_value, form_processor,
            object_attributes [2].object_name);
    ELSE
      object_attributes [2].object_name := pvt [p$variable_name].value^.cobol_name_value;
    IFEND;

{ Fix for Screen Design Facility. SDF cannot process zero length strings.

    IF STRLENGTH (object_definition.p_variable_box_text^) = 0 THEN
      object_definition.p_variable_box_text := ^one_blank;
    IFEND;

    fdp$create_object (current_form_identifier, pvt [p$column].value^.integer_value.value, pvt [p$line].
          value^.integer_value.value, object_definition, object_attributes, status);

  PROCEND add_variable_text_box;

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

{ PURPOSE:
{   This procedure processes the set_character_input command.

  PROCEDURE set_character_input
    (    parameter_list: clt$parameter_list;
     VAR status: ost$status);

{ PROCEDURE (fdm$crefm_setci) set_character_input, setci (
{   variable_name, vn: any of
{       name
{       cobol_name
{     anyend = $required
{   valid_value, valid_values, vv: list of string 0..fdc$maximum_valid_string = $optional
{   compare_to_substring, cts: boolean = TRUE
{   entry_format, ef: key
{       character, alphabetic, digits, signed
{     keyend = $optional
{   status)

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

  VAR
    pdt: [STATIC, READ, cls$declaration_section] record
      header: clt$pdt_header,
      names: array [1 .. 10] of clt$pdt_parameter_name,
      parameters: array [1 .. 5] of clt$pdt_parameter,
      type1: 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$name_type_qualifier,
        recend,
        type_size_2: clt$type_specification_size,
        element_type_spec_2: record
          header: clt$type_specification_header,
        recend,
      recend,
      type2: record
        header: clt$type_specification_header,
        qualifier: clt$list_type_qualifier,
        element_type_spec: record
          header: clt$type_specification_header,
          qualifier: clt$string_type_qualifier,
        recend,
      recend,
      type3: record
        header: clt$type_specification_header,
        default_value: string (4),
      recend,
      type4: record
        header: clt$type_specification_header,
        qualifier: clt$keyword_type_qualifier,
        keyword_specs: array [1 .. 4] of clt$keyword_specification,
      recend,
      type5: record
        header: clt$type_specification_header,
      recend,
    recend := [
    [1,
    [89, 7, 27, 9, 26, 27, 400],
    clc$command, 10, 5, 1, 0, 0, 0, 5, 'FDM$CREFM_SETCI'], [
    ['COMPARE_TO_SUBSTRING           ',clc$nominal_entry, 3],
    ['CTS                            ',clc$abbreviation_entry, 3],
    ['EF                             ',clc$abbreviation_entry, 4],
    ['ENTRY_FORMAT                   ',clc$nominal_entry, 4],
    ['STATUS                         ',clc$nominal_entry, 5],
    ['VALID_VALUE                    ',clc$nominal_entry, 2],
    ['VALID_VALUES                   ',clc$alias_entry, 2],
    ['VARIABLE_NAME                  ',clc$nominal_entry, 1],
    ['VN                             ',clc$abbreviation_entry, 1],
    ['VV                             ',clc$abbreviation_entry, 2]],
    [
{ PARAMETER 1
    [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, 28, 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, 24, clc$optional_parameter,
  0, 0],
{ PARAMETER 3
    [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$optional_default_parameter, 0, 4],
{ 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, 155,
  clc$optional_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$union_type], [[clc$cobol_name_type, clc$name_type],
    FALSE, 2],
    5, [[1, 0, clc$name_type], [1, osc$max_name_size]],
    3, [[1, 0, clc$cobol_name_type]]
    ],
{ PARAMETER 2
    [[1, 0, clc$list_type], [8, 1, clc$max_list_size, FALSE],
      [[1, 0, clc$string_type], [0, fdc$maximum_valid_string, FALSE]]
    ],
{ PARAMETER 3
    [[1, 0, clc$boolean_type],
    'TRUE'],
{ PARAMETER 4
    [[1, 0, clc$keyword_type], [4], [
    ['ALPHABETIC                     ', clc$nominal_entry, clc$normal_usage_entry, 2],
    ['CHARACTER                      ', clc$nominal_entry, clc$normal_usage_entry, 1],
    ['DIGITS                         ', clc$nominal_entry, clc$normal_usage_entry, 3],
    ['SIGNED                         ', clc$nominal_entry, clc$normal_usage_entry, 4]]
    ],
{ PARAMETER 5
    [[1, 0, clc$status_type]]];

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

    CONST
      p$variable_name = 1,
      p$valid_value = 2,
      p$compare_to_substring = 3,
      p$entry_format = 4,
      p$status = 5;

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

    CONST
      compare_attribute = 1,
      format_attribute = 2,
      value_attribute = 3;

    VAR
      list_size: clt$list_size,
      next_data_value_p: ^clt$data_value,
      variable_attributes_p: ^array [1 .. * ] of fdt$variable_attribute,
      valid_value: value_attribute .. clc$max_list_size + value_attribute,
      variable_name: ost$name;

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

    list_size := clp$count_list_elements (pvt [p$valid_value].value);
    PUSH variable_attributes_p: [1 .. list_size + format_attribute];

    variable_attributes_p^ [compare_attribute].key := fdc$string_compare_rules;
    variable_attributes_p^ [compare_attribute].compare_to_unique_substring :=
          pvt [p$compare_to_substring].value^.boolean_value.value;
    variable_attributes_p^ [compare_attribute].compare_in_upper_case := FALSE;

    IF pvt [p$entry_format].specified THEN
      variable_attributes_p^ [format_attribute].key := fdc$input_format;
      IF pvt [p$entry_format].value^.keyword_value = 'CHARACTER' THEN
        variable_attributes_p^ [format_attribute].input_format.key := fdc$character_input_format;
      ELSEIF pvt [p$entry_format].value^.keyword_value = 'ALPHABETIC' THEN
        variable_attributes_p^ [format_attribute].input_format.key := fdc$alphabetic_input_format;
      ELSEIF pvt [p$entry_format].value^.keyword_value = 'DIGITS' THEN
        variable_attributes_p^ [format_attribute].input_format.key := fdc$digits_input_format;
      ELSE
        variable_attributes_p^ [format_attribute].input_format.key := fdc$signed_input_format;
      IFEND;
    ELSE
       variable_attributes_p^ [format_attribute].key := fdc$unused_variable_entry;
    IFEND;

    next_data_value_p := pvt [p$valid_value].value;

  /get_valid_string/
    FOR valid_value := value_attribute TO list_size + format_attribute DO
      variable_attributes_p^ [valid_value].key := fdc$add_valid_string;
      variable_attributes_p^ [valid_value].p_valid_string := next_data_value_p^.element_value^.string_value;
      next_data_value_p := next_data_value_p^.link;
    FOREND /get_valid_string/;

    IF pvt [p$variable_name].value^.kind = clc$name THEN
      convert_to_form_name (pvt [p$variable_name].value^.name_value, form_processor, variable_name);
    ELSE
      variable_name := pvt [p$variable_name].value^.cobol_name_value;
    IFEND;

    fdp$change_variable (current_form_identifier, variable_name, variable_attributes_p^, status);

  PROCEND set_character_input;

?? OLDTITLE ??
?? NEWTITLE := 'set_cobol_data', EJECT ??
{ PURPOSE:
{   This procedure processes the set_cobol_data command.

  PROCEDURE set_cobol_data
    (    parameter_list: clt$parameter_list;
     VAR status: ost$status);

{ PROCEDURE (fdm$crefm_setcd) set_cobol_data, setcd (
{   variable_name, vn: any of
{       name
{       cobol_name
{     anyend = $required
{   usage, u: key
{       binary, computational, comp, computational_1, comp_1, computational_3, comp_3, display, packed_decimal
{     keyend = display
{   picture, p: string 0..fdc$maximum_picture_length = ''
{   status)

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

  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,
        qualifier: clt$union_type_qualifier,
        type_size_1: clt$type_specification_size,
        element_type_spec_1: record
          header: clt$type_specification_header,
          qualifier: clt$name_type_qualifier,
        recend,
        type_size_2: clt$type_specification_size,
        element_type_spec_2: record
          header: clt$type_specification_header,
        recend,
      recend,
      type2: record
        header: clt$type_specification_header,
        qualifier: clt$keyword_type_qualifier,
        keyword_specs: array [1 .. 9] of clt$keyword_specification,
        default_value: string (7),
      recend,
      type3: record
        header: clt$type_specification_header,
        qualifier: clt$string_type_qualifier,
        default_value: string (2),
      recend,
      type4: record
        header: clt$type_specification_header,
      recend,
    recend := [
    [1,
    [89, 8, 14, 16, 38, 28, 515],
    clc$command, 7, 4, 1, 0, 0, 0, 4, 'FDM$CREFM_SETCD'], [
    ['P                              ',clc$abbreviation_entry, 3],
    ['PICTURE                        ',clc$nominal_entry, 3],
    ['STATUS                         ',clc$nominal_entry, 4],
    ['U                              ',clc$abbreviation_entry, 2],
    ['USAGE                          ',clc$nominal_entry, 2],
    ['VARIABLE_NAME                  ',clc$nominal_entry, 1],
    ['VN                             ',clc$abbreviation_entry, 1]],
    [
{ PARAMETER 1
    [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, 28, 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, 340,
  clc$optional_default_parameter, 0, 7],
{ 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, 8,
  clc$optional_default_parameter, 0, 2],
{ 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$union_type], [[clc$cobol_name_type, clc$name_type],
    FALSE, 2],
    5, [[1, 0, clc$name_type], [1, osc$max_name_size]],
    3, [[1, 0, clc$cobol_name_type]]
    ],
{ PARAMETER 2
    [[1, 0, clc$keyword_type], [9], [
    ['BINARY                         ', clc$nominal_entry, clc$normal_usage_entry, 1],
    ['COMP                           ', clc$nominal_entry, clc$normal_usage_entry, 3],
    ['COMPUTATIONAL                  ', clc$nominal_entry, clc$normal_usage_entry, 2],
    ['COMPUTATIONAL_1                ', clc$nominal_entry, clc$normal_usage_entry, 4],
    ['COMPUTATIONAL_3                ', clc$nominal_entry, clc$normal_usage_entry, 6],
    ['COMP_1                         ', clc$nominal_entry, clc$normal_usage_entry, 5],
    ['COMP_3                         ', clc$nominal_entry, clc$normal_usage_entry, 7],
    ['DISPLAY                        ', clc$nominal_entry, clc$normal_usage_entry, 8],
    ['PACKED_DECIMAL                 ', clc$nominal_entry, clc$normal_usage_entry, 9]]
    ,
    'display'],
{ PARAMETER 3
    [[1, 0, clc$string_type], [0, fdc$maximum_picture_length, FALSE],
    ''''''],
{ PARAMETER 4
    [[1, 0, clc$status_type]]];

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

    CONST
      p$variable_name = 1,
      p$usage = 2,
      p$picture = 3,
      p$status = 4;

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

    VAR
      cobol_program_clause : fdt$cobol_program_clause,
      variable_attributes: array [1 .. 2] of fdt$variable_attribute,
      variable_name: ost$name;

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

    cobol_program_clause.picture := pvt[p$picture].value^.string_value^;
    IF pvt [p$usage].value^.keyword_value = 'BINARY' THEN
      cobol_program_clause.usage := fdc$binary_usage;
    ELSEIF pvt [p$usage].value^.keyword_value = 'COMPUTATIONAL' THEN
      cobol_program_clause.usage := fdc$computational_usage;
    ELSEIF pvt [p$usage].value^.keyword_value = 'COMP' THEN
      cobol_program_clause.usage := fdc$comp_usage;
    ELSEIF pvt [p$usage].value^.keyword_value = 'COMPUTATIONAL_1' THEN
      cobol_program_clause.usage := fdc$computational_1_usage;
    ELSEIF pvt [p$usage].value^.keyword_value = 'COMP_1' THEN
      cobol_program_clause.usage := fdc$comp_1_usage;
    ELSEIF pvt [p$usage].value^.keyword_value = 'COMPUTATIONAL_3' THEN
      cobol_program_clause.usage := fdc$computational_3_usage;
    ELSEIF pvt [p$usage].value^.keyword_value = 'COMP_3' THEN
      cobol_program_clause.usage := fdc$comp_3_usage;
    ELSEIF pvt [p$usage].value^.keyword_value = 'DISPLAY' THEN
      cobol_program_clause.usage := fdc$display_usage;
    ELSE { PACKED_DECIMAL
       cobol_program_clause.usage := fdc$packed_decimal_usage;
    IFEND;

    variable_attributes [1].key := fdc$program_data_type;
    variable_attributes [1].program_data_type := fdc$program_cobol_type;
    variable_attributes [2].key := fdc$cobol_program_clause;
    variable_attributes [2].p_cobol_program_clause := ^cobol_program_clause;

    IF pvt [p$variable_name].value^.kind = clc$name THEN
      convert_to_form_name (pvt [p$variable_name].value^.name_value,
            form_processor, variable_name);
    ELSE
      variable_name := pvt [p$variable_name].value^.cobol_name_value;
    IFEND;

    fdp$change_variable (current_form_identifier, variable_name,
          variable_attributes, status);

  PROCEND set_cobol_data;

?? OLDTITLE ??
?? NEWTITLE := 'set_cobol_output', EJECT ??
{ PURPOSE:
{   This procedure processes the set_cobol_output command.

  PROCEDURE set_cobol_output
    (    parameter_list: clt$parameter_list;
     VAR status: ost$status);

{ PROCEDURE (fdm$crefm_setco) set_cobol_output, setco (
{   variable_name, vn: any of
{       name
{       cobol_name
{     anyend = $required
{   picture, p: string 0..fdc$maximum_picture_length = ''
{   status)

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

  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$union_type_qualifier,
        type_size_1: clt$type_specification_size,
        element_type_spec_1: record
          header: clt$type_specification_header,
          qualifier: clt$name_type_qualifier,
        recend,
        type_size_2: clt$type_specification_size,
        element_type_spec_2: record
          header: clt$type_specification_header,
        recend,
      recend,
      type2: record
        header: clt$type_specification_header,
        qualifier: clt$string_type_qualifier,
        default_value: string (2),
      recend,
      type3: record
        header: clt$type_specification_header,
      recend,
    recend := [
    [1,
    [89, 8, 14, 16, 39, 42, 673],
    clc$command, 5, 3, 1, 0, 0, 0, 3, 'FDM$CREFM_SETCO'], [
    ['P                              ',clc$abbreviation_entry, 2],
    ['PICTURE                        ',clc$nominal_entry, 2],
    ['STATUS                         ',clc$nominal_entry, 3],
    ['VARIABLE_NAME                  ',clc$nominal_entry, 1],
    ['VN                             ',clc$abbreviation_entry, 1]],
    [
{ 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, 28, clc$required_parameter,
  0, 0],
{ PARAMETER 2
    [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, 8,
  clc$optional_default_parameter, 0, 2],
{ PARAMETER 3
    [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$union_type], [[clc$cobol_name_type, clc$name_type],
    FALSE, 2],
    5, [[1, 0, clc$name_type], [1, osc$max_name_size]],
    3, [[1, 0, clc$cobol_name_type]]
    ],
{ PARAMETER 2
    [[1, 0, clc$string_type], [0, fdc$maximum_picture_length, FALSE],
    ''''''],
{ PARAMETER 3
    [[1, 0, clc$status_type]]];

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

    CONST
      p$variable_name = 1,
      p$picture = 2,
      p$status = 3;

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

    VAR
      cobol_display_clause: fdt$cobol_display_clause,
      variable_attributes: array [1 .. 2] of fdt$variable_attribute,
      variable_name: ost$name;

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

    cobol_display_clause.picture := pvt[p$picture].value^.string_value^;
    variable_attributes [1].key := fdc$program_data_type;
    variable_attributes [1].program_data_type := fdc$program_cobol_type;
    variable_attributes [2].key := fdc$cobol_display_clause;
    variable_attributes [2].p_cobol_display_clause := ^cobol_display_clause;

    IF pvt [p$variable_name].value^.kind = clc$name THEN
      convert_to_form_name (pvt [p$variable_name].value^.name_value,
            form_processor, variable_name);
    ELSE
      variable_name := pvt [p$variable_name].value^.cobol_name_value;
    IFEND;

 fdp$change_variable (current_form_identifier, variable_name,
          variable_attributes, status);

  PROCEND set_cobol_output;

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

{ PURPOSE:
{   This procedure processes the set_date_input command.

  PROCEDURE set_date_input
    (    parameter_list: clt$parameter_list;
     VAR status: ost$status);

{ PROCEDURE (fdm$crefm_setdi) set_date_input, setdi (
{   variable_name, vn: any of
{       name
{       cobol_name
{     anyend = $required
{   format, f: key
{       dmy, mdy, ydm, isod, month
{     keyend = mdy
{   status)

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

  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$union_type_qualifier,
        type_size_1: clt$type_specification_size,
        element_type_spec_1: record
          header: clt$type_specification_header,
          qualifier: clt$name_type_qualifier,
        recend,
        type_size_2: clt$type_specification_size,
        element_type_spec_2: record
          header: clt$type_specification_header,
        recend,
      recend,
      type2: record
        header: clt$type_specification_header,
        qualifier: clt$keyword_type_qualifier,
        keyword_specs: array [1 .. 5] of clt$keyword_specification,
        default_value: string (3),
      recend,
      type3: record
        header: clt$type_specification_header,
      recend,
    recend := [
    [1,
    [91, 5, 6, 14, 26, 28, 94],
    clc$command, 5, 3, 1, 0, 0, 0, 3, 'FDM$CREFM_SETDI'], [
    ['F                              ',clc$abbreviation_entry, 2],
    ['FORMAT                         ',clc$nominal_entry, 2],
    ['STATUS                         ',clc$nominal_entry, 3],
    ['VARIABLE_NAME                  ',clc$nominal_entry, 1],
    ['VN                             ',clc$abbreviation_entry, 1]],
    [
{ 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, 28, clc$required_parameter,
  0, 0],
{ PARAMETER 2
    [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, 192,
  clc$optional_default_parameter, 0, 3],
{ PARAMETER 3
    [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$union_type], [[clc$cobol_name_type, clc$name_type],
    FALSE, 2],
    5, [[1, 0, clc$name_type], [1, osc$max_name_size]],
    3, [[1, 0, clc$cobol_name_type]]
    ],
{ PARAMETER 2
    [[1, 0, clc$keyword_type], [5], [
    ['DMY                            ', clc$nominal_entry, clc$normal_usage_entry, 1],
    ['ISOD                           ', clc$nominal_entry, clc$normal_usage_entry, 4],
    ['MDY                            ', clc$nominal_entry, clc$normal_usage_entry, 2],
    ['MONTH                          ', clc$nominal_entry, clc$normal_usage_entry, 5],
    ['YDM                            ', clc$nominal_entry, clc$normal_usage_entry, 3]]
    ,
    'mdy'],
{ PARAMETER 3
    [[1, 0, clc$status_type]]];

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

    CONST
      p$variable_name = 1,
      p$format = 2,
      p$status = 3;

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

    VAR
      variable_attributes: array [1 .. 1] of fdt$variable_attribute,
      variable_name: ost$name;


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

    variable_attributes [1].key := fdc$input_format;
    IF pvt [p$format].value^.keyword_value = 'MDY' THEN
      variable_attributes [1].input_format.key := fdc$mdy_format;
    ELSEIF pvt [p$format].value^.keyword_value = 'YDM' THEN
      variable_attributes [1].input_format.key := fdc$ydm_format;
    ELSEIF pvt [p$format].value^.keyword_value = 'ISOD' THEN
      variable_attributes [1].input_format.key := fdc$iso_date_format;
    ELSEIF pvt [p$format].value^.keyword_value = 'MONTH' THEN
      variable_attributes [1].input_format.key := fdc$month_dd_yyyy_format;
    ELSE { pvt [p$format].value^.keyword_value = 'DMY'
      variable_attributes [1].input_format.key := fdc$dmy_format;
    IFEND;

    IF pvt [p$variable_name].value^.kind = clc$name THEN
      convert_to_form_name (pvt [p$variable_name].value^.name_value, form_processor, variable_name);
    ELSE
      variable_name := pvt [p$variable_name].value^.cobol_name_value;
    IFEND;

    fdp$change_variable (current_form_identifier, variable_name, variable_attributes, status);

  PROCEND set_date_input;

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

{ PURPOSE:
{   This procedure processes the set_date_output command.

  PROCEDURE set_date_output
    (    parameter_list: clt$parameter_list;
     VAR status: ost$status);

{ PROCEDURE (fdm$crefm_setdo) set_date_output, setdo (
{   variable_name, vn: any of
{       name
{       cobol_name
{     anyend = $required
{   format, f: key
{       dmy, mdy, ydm, isod, month
{     keyend = mdy
{   status)

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

  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$union_type_qualifier,
        type_size_1: clt$type_specification_size,
        element_type_spec_1: record
          header: clt$type_specification_header,
          qualifier: clt$name_type_qualifier,
        recend,
        type_size_2: clt$type_specification_size,
        element_type_spec_2: record
          header: clt$type_specification_header,
        recend,
      recend,
      type2: record
        header: clt$type_specification_header,
        qualifier: clt$keyword_type_qualifier,
        keyword_specs: array [1 .. 5] of clt$keyword_specification,
        default_value: string (3),
      recend,
      type3: record
        header: clt$type_specification_header,
      recend,
    recend := [
    [1,
    [91, 5, 9, 9, 51, 42, 651],
    clc$command, 5, 3, 1, 0, 0, 0, 3, 'FDM$CREFM_SETDO'], [
    ['F                              ',clc$abbreviation_entry, 2],
    ['FORMAT                         ',clc$nominal_entry, 2],
    ['STATUS                         ',clc$nominal_entry, 3],
    ['VARIABLE_NAME                  ',clc$nominal_entry, 1],
    ['VN                             ',clc$abbreviation_entry, 1]],
    [
{ 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, 28, clc$required_parameter,
  0, 0],
{ PARAMETER 2
    [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, 192,
  clc$optional_default_parameter, 0, 3],
{ PARAMETER 3
    [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$union_type], [[clc$cobol_name_type, clc$name_type],
    FALSE, 2],
    5, [[1, 0, clc$name_type], [1, osc$max_name_size]],
    3, [[1, 0, clc$cobol_name_type]]
    ],
{ PARAMETER 2
    [[1, 0, clc$keyword_type], [5], [
    ['DMY                            ', clc$nominal_entry, clc$normal_usage_entry, 1],
    ['ISOD                           ', clc$nominal_entry, clc$normal_usage_entry, 4],
    ['MDY                            ', clc$nominal_entry, clc$normal_usage_entry, 2],
    ['MONTH                          ', clc$nominal_entry, clc$normal_usage_entry, 5],
    ['YDM                            ', clc$nominal_entry, clc$normal_usage_entry, 3]]
    ,
    'mdy'],
{ PARAMETER 3
    [[1, 0, clc$status_type]]];

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

    CONST
      p$variable_name = 1,
      p$format = 2,
      p$status = 3;

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

    VAR
      variable_attributes: array [1 .. 1] of fdt$variable_attribute,
      variable_name: ost$name;


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

    variable_attributes [1].key := fdc$output_format;
    IF pvt [p$format].value^.keyword_value = 'MDY' THEN
      variable_attributes [1].output_format.key := fdc$mdy_output_format;
    ELSEIF pvt [p$format].value^.keyword_value = 'YDM' THEN
      variable_attributes [1].output_format.key := fdc$ydm_output_format;
    ELSEIF pvt [p$format].value^.keyword_value = 'MONTH' THEN
      variable_attributes [1].output_format.key := fdc$month_dd_yyyy_out_format;
    ELSEIF pvt [p$format].value^.keyword_value = 'ISOD' THEN
      variable_attributes [1].output_format.key := fdc$iso_output_format;
    ELSE { pvt [p$format].value^.keyword_value = 'DMY'
      variable_attributes [1].output_format.key := fdc$dmy_output_format;
    IFEND;

    IF pvt [p$variable_name].value^.kind = clc$name THEN
      convert_to_form_name (pvt [p$variable_name].value^.name_value, form_processor, variable_name);
    ELSE
      variable_name := pvt [p$variable_name].value^.cobol_name_value;
    IFEND;

    fdp$change_variable (current_form_identifier, variable_name, variable_attributes, status);

  PROCEND set_date_output;

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

{ PURPOSE:
{   This procedure processes the set_exponent_output command.

  PROCEDURE set_exponent_output
    (    parameter_list: clt$parameter_list;
     VAR status: ost$status);

{ PROCEDURE (fdm$crefm_seteo) set_exponent_output, seteo (
{   variable_name, vn: any of
{       name
{       cobol_name
{     anyend = $required
{   format, f: key
{       ee, ge
{     keyend = $required
{   width, w: integer 1..19 = $required
{   digits_right_of_decimal, drod: integer 0..19 = $required
{   digits_in_exponent, die: integer 0..19 = $required
{   sign, s: key
{       minus_if_negative, always_signed
{     keyend = minus_if_negative
{   suppress_zero, sz: boolean = TRUE
{   status)

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

  VAR
    pdt: [STATIC, READ, cls$declaration_section] record
      header: clt$pdt_header,
      names: array [1 .. 15] of clt$pdt_parameter_name,
      parameters: array [1 .. 8] of clt$pdt_parameter,
      type1: 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$name_type_qualifier,
        recend,
        type_size_2: clt$type_specification_size,
        element_type_spec_2: record
          header: clt$type_specification_header,
        recend,
      recend,
      type2: record
        header: clt$type_specification_header,
        qualifier: clt$keyword_type_qualifier,
        keyword_specs: array [1 .. 2] of clt$keyword_specification,
      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,
        qualifier: clt$integer_type_qualifier,
      recend,
      type6: record
        header: clt$type_specification_header,
        qualifier: clt$keyword_type_qualifier,
        keyword_specs: array [1 .. 2] of clt$keyword_specification,
        default_value: string (17),
      recend,
      type7: record
        header: clt$type_specification_header,
        default_value: string (4),
      recend,
      type8: record
        header: clt$type_specification_header,
      recend,
    recend := [
    [1,
    [89, 5, 18, 16, 10, 40, 538],
    clc$command, 15, 8, 5, 0, 0, 0, 8, 'FDM$CREFM_SETEO'], [
    ['DIE                            ',clc$abbreviation_entry, 5],
    ['DIGITS_IN_EXPONENT             ',clc$nominal_entry, 5],
    ['DIGITS_RIGHT_OF_DECIMAL        ',clc$nominal_entry, 4],
    ['DROD                           ',clc$abbreviation_entry, 4],
    ['F                              ',clc$abbreviation_entry, 2],
    ['FORMAT                         ',clc$nominal_entry, 2],
    ['S                              ',clc$abbreviation_entry, 6],
    ['SIGN                           ',clc$nominal_entry, 6],
    ['STATUS                         ',clc$nominal_entry, 8],
    ['SUPPRESS_ZERO                  ',clc$nominal_entry, 7],
    ['SZ                             ',clc$abbreviation_entry, 7],
    ['VARIABLE_NAME                  ',clc$nominal_entry, 1],
    ['VN                             ',clc$abbreviation_entry, 1],
    ['W                              ',clc$abbreviation_entry, 3],
    ['WIDTH                          ',clc$nominal_entry, 3]],
    [
{ PARAMETER 1
    [12, 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, 28, 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, 81, clc$required_parameter,
  0, 0],
{ PARAMETER 3
    [15, 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$required_parameter,
  0, 0],
{ PARAMETER 4
    [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, 20, clc$required_parameter,
  0, 0],
{ PARAMETER 5
    [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, 20, clc$required_parameter,
  0, 0],
{ PARAMETER 6
    [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, 81,
  clc$optional_default_parameter, 0, 17],
{ PARAMETER 7
    [10, 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$optional_default_parameter, 0, 4],
{ PARAMETER 8
    [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$union_type], [[clc$cobol_name_type, clc$name_type],
    FALSE, 2],
    5, [[1, 0, clc$name_type], [1, osc$max_name_size]],
    3, [[1, 0, clc$cobol_name_type]]
    ],
{ PARAMETER 2
    [[1, 0, clc$keyword_type], [2], [
    ['EE                             ', clc$nominal_entry, clc$normal_usage_entry, 1],
    ['GE                             ', clc$nominal_entry, clc$normal_usage_entry, 2]]
    ],
{ PARAMETER 3
    [[1, 0, clc$integer_type], [1, 19, 10]],
{ PARAMETER 4
    [[1, 0, clc$integer_type], [0, 19, 10]],
{ PARAMETER 5
    [[1, 0, clc$integer_type], [0, 19, 10]],
{ PARAMETER 6
    [[1, 0, clc$keyword_type], [2], [
    ['ALWAYS_SIGNED                  ', clc$nominal_entry, clc$normal_usage_entry, 2],
    ['MINUS_IF_NEGATIVE              ', clc$nominal_entry, clc$normal_usage_entry, 1]]
    ,
    'minus_if_negative'],
{ PARAMETER 7
    [[1, 0, clc$boolean_type],
    'TRUE'],
{ PARAMETER 8
    [[1, 0, clc$status_type]]];

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

    CONST
      p$variable_name = 1,
      p$format = 2,
      p$width = 3,
      p$digits_right_of_decimal = 4,
      p$digits_in_exponent = 5,
      p$sign = 6,
      p$suppress_zero = 7,
      p$status = 8;

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

    VAR
      variable_attributes: array [1 .. 1] of fdt$variable_attribute,
      variable_name: ost$name;

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

    variable_attributes [1].key := fdc$output_format;
    IF pvt [p$format].value^.keyword_value = 'EE' THEN
      variable_attributes [1].output_format.key := fdc$e_e_output_format;
    ELSE
      variable_attributes [1].output_format.key := fdc$g_e_output_format;
    IFEND;

    variable_attributes [1].output_format.exponent_output_format.field_width :=
          pvt [p$width].value^.integer_value.value;
    variable_attributes [1].output_format.exponent_output_format.digits_in_exponent :=
          pvt [p$digits_in_exponent].value^.integer_value.value;
    variable_attributes [1].output_format.exponent_output_format.digits_right_decimal :=
          pvt [p$digits_right_of_decimal].value^.integer_value.value;
    IF pvt [p$sign].value^.keyword_value = 'MINUS_IF_NEGATIVE' THEN
      variable_attributes [1].output_format.exponent_output_format.sign_treatment := mlc$minus_if_negative;
    ELSE
      variable_attributes [1].output_format.exponent_output_format.sign_treatment := mlc$always_signed;
    IFEND;

    variable_attributes [1].output_format.exponent_output_format.suppress_zero := pvt [p$suppress_zero].
          value^.boolean_value.value;

    IF pvt [p$variable_name].value^.kind = clc$name THEN
      convert_to_form_name (pvt [p$variable_name].value^.name_value, form_processor, variable_name);
    ELSE
      variable_name := pvt [p$variable_name].value^.cobol_name_value;
    IFEND;

    fdp$change_variable (current_form_identifier, variable_name, variable_attributes, status);

  PROCEND set_exponent_output;

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

{ PURPOSE:
{   This procedure processes the set_float_output command.

  PROCEDURE set_float_output
    (    parameter_list: clt$parameter_list;
     VAR status: ost$status);

{ PROCEDURE (fdm$crefm_setfo) set_float_output, setfo (
{   variable_name, vn: any of
{       name
{       cobol_name
{     anyend = $required
{   format, f: key
{       f, g, e
{     keyend = $required
{   width, w: integer 1..19 = $required
{   digits_right_of_decimal, drod: integer 0..19 = $required
{   sign, s: key
{       minus_if_negative, always_signed
{     keyend = minus_if_negative
{   suppress_zero, sz: boolean = TRUE
{   status)

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

  VAR
    pdt: [STATIC, READ, cls$declaration_section] record
      header: clt$pdt_header,
      names: array [1 .. 13] of clt$pdt_parameter_name,
      parameters: array [1 .. 7] of clt$pdt_parameter,
      type1: 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$name_type_qualifier,
        recend,
        type_size_2: clt$type_specification_size,
        element_type_spec_2: record
          header: clt$type_specification_header,
        recend,
      recend,
      type2: record
        header: clt$type_specification_header,
        qualifier: clt$keyword_type_qualifier,
        keyword_specs: array [1 .. 3] of clt$keyword_specification,
      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,
        qualifier: clt$keyword_type_qualifier,
        keyword_specs: array [1 .. 2] of clt$keyword_specification,
        default_value: string (17),
      recend,
      type6: record
        header: clt$type_specification_header,
        default_value: string (4),
      recend,
      type7: record
        header: clt$type_specification_header,
      recend,
    recend := [
    [1,
    [89, 5, 18, 16, 10, 59, 755],
    clc$command, 13, 7, 4, 0, 0, 0, 7, 'FDM$CREFM_SETFO'], [
    ['DIGITS_RIGHT_OF_DECIMAL        ',clc$nominal_entry, 4],
    ['DROD                           ',clc$abbreviation_entry, 4],
    ['F                              ',clc$abbreviation_entry, 2],
    ['FORMAT                         ',clc$nominal_entry, 2],
    ['S                              ',clc$abbreviation_entry, 5],
    ['SIGN                           ',clc$nominal_entry, 5],
    ['STATUS                         ',clc$nominal_entry, 7],
    ['SUPPRESS_ZERO                  ',clc$nominal_entry, 6],
    ['SZ                             ',clc$abbreviation_entry, 6],
    ['VARIABLE_NAME                  ',clc$nominal_entry, 1],
    ['VN                             ',clc$abbreviation_entry, 1],
    ['W                              ',clc$abbreviation_entry, 3],
    ['WIDTH                          ',clc$nominal_entry, 3]],
    [
{ PARAMETER 1
    [10, 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, 28, 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, 118,
  clc$required_parameter, 0, 0],
{ PARAMETER 3
    [13, 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$required_parameter,
  0, 0],
{ 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$required_parameter,
  0, 0],
{ PARAMETER 5
    [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, 81,
  clc$optional_default_parameter, 0, 17],
{ PARAMETER 6
    [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$optional_default_parameter, 0, 4],
{ PARAMETER 7
    [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$union_type], [[clc$cobol_name_type, clc$name_type],
    FALSE, 2],
    5, [[1, 0, clc$name_type], [1, osc$max_name_size]],
    3, [[1, 0, clc$cobol_name_type]]
    ],
{ PARAMETER 2
    [[1, 0, clc$keyword_type], [3], [
    ['E                              ', clc$nominal_entry, clc$normal_usage_entry, 3],
    ['F                              ', clc$nominal_entry, clc$normal_usage_entry, 1],
    ['G                              ', clc$nominal_entry, clc$normal_usage_entry, 2]]
    ],
{ PARAMETER 3
    [[1, 0, clc$integer_type], [1, 19, 10]],
{ PARAMETER 4
    [[1, 0, clc$integer_type], [0, 19, 10]],
{ PARAMETER 5
    [[1, 0, clc$keyword_type], [2], [
    ['ALWAYS_SIGNED                  ', clc$nominal_entry, clc$normal_usage_entry, 2],
    ['MINUS_IF_NEGATIVE              ', clc$nominal_entry, clc$normal_usage_entry, 1]]
    ,
    'minus_if_negative'],
{ PARAMETER 6
    [[1, 0, clc$boolean_type],
    'TRUE'],
{ PARAMETER 7
    [[1, 0, clc$status_type]]];

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

    CONST
      p$variable_name = 1,
      p$format = 2,
      p$width = 3,
      p$digits_right_of_decimal = 4,
      p$sign = 5,
      p$suppress_zero = 6,
      p$status = 7;

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

    VAR
      variable_attributes: array [1 .. 1] of fdt$variable_attribute,
      variable_name: ost$name;


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

    variable_attributes [1].key := fdc$output_format;
    IF pvt [p$format].value^.keyword_value = 'F' THEN
      variable_attributes [1].output_format.key := fdc$f_output_format;
    ELSEIF pvt [p$format].value^.keyword_value = 'G' THEN
      variable_attributes [1].output_format.key := fdc$g_output_format;
    ELSE
      variable_attributes [1].output_format.key := fdc$e_output_format;
    IFEND;

    variable_attributes [1].output_format.float_output_format.digits_right_decimal :=
          pvt [p$digits_right_of_decimal].value^.integer_value.value;
    variable_attributes [1].output_format.float_output_format.field_width :=
          pvt [p$width].value^.integer_value.value;
    IF pvt [p$sign].value^.keyword_value = 'MINUS_IF_NEGATIVE' THEN
      variable_attributes [1].output_format.float_output_format.sign_treatment := mlc$minus_if_negative;
    ELSE
      variable_attributes [1].output_format.float_output_format.sign_treatment := mlc$always_signed;
    IFEND;

    variable_attributes [1].output_format.float_output_format.suppress_zero :=
          pvt [p$suppress_zero].value^.boolean_value.value;

    IF pvt [p$variable_name].value^.kind = clc$name THEN
      convert_to_form_name (pvt [p$variable_name].value^.name_value, form_processor, variable_name);
    ELSE
      variable_name := pvt [p$variable_name].value^.cobol_name_value;
    IFEND;

    fdp$change_variable (current_form_identifier, variable_name, variable_attributes, status);

  PROCEND set_float_output;

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

{ PURPOSE:
{   This procedure processes the set_form command.

  PROCEDURE set_form
    (    parameter_list: clt$parameter_list;
     VAR status: ost$status);

{ PROCEDURE (fdm$crefm_setf) set_form, setf (
{   processor, p: key
{       ansi_fortran, cdc_fortran, extended_fortran, cobol, cybil, pascal, scl
{     keyend = cobol
{   column, c: integer 1..fdc$maximum_x_position = 1
{   line, l: integer 1..fdc$maximum_y_position = 1
{   width, w: integer 1..fdc$maximum_x_position = $optional
{   height, h: integer 1..fdc$maximum_y_position = $optional
{   display, displays, d: list of key
{       inverse, low_intensity, high_intensity, blink, black_background, blue_background, green_background
{       magenta_background, red_background, cyan_background, yellow_background, white_background
{       black_foreground, blue_foreground, green_foreground, magenta_foreground, red_foreground
{       cyan_foreground, yellow_foreground, white_foreground, fine_border, medium_border, bold_border
{       display_left_to_right, display_right_to_left
{     keyend = (black_background, white_foreground,display_left_to_right)
{   comment, comments: (BY_NAME) list of string 1..fdc$maximum_comment_length = $optional
{   event_form, ef: (BY_NAME) any of
{       key
{         system, none
{       keyend
{       name
{     anyend = system
{   help_processing, hp: (BY_NAME) any of
{       key
{         system, none
{       keyend
{       name
{       string 0..fdc$maximum_y_position
{     anyend = none
{   error_message_form, emf, message_form, mf: (BY_NAME) any of
{       key
{         system
{       keyend
{       name
{     anyend = system
{   variable_deck_name, vdn: (BY_NAME) name = $optional
{   variable_record_name, vrn: (BY_NAME) any of
{       name
{       cobol_name
{     anyend = $optional
{   invalid_data_character, idc: (BY_NAME) any of
{       key
{         none
{       keyend
{       string 1..1
{     anyend = none
{   help_message_form, hmf: (BY_NAME) any of
{       key
{         system
{       keyend
{       name
{     anyend = system
{   hidden_editing, he: (BY_NAME) boolean = FALSE
{   status)

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

  VAR
    pdt: [STATIC, READ, cls$declaration_section] record
      header: clt$pdt_header,
      names: array [1 .. 34] of clt$pdt_parameter_name,
      parameters: array [1 .. 16] of clt$pdt_parameter,
      type1: record
        header: clt$type_specification_header,
        qualifier: clt$keyword_type_qualifier,
        keyword_specs: array [1 .. 7] of clt$keyword_specification,
        default_value: string (5),
      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,
        qualifier: clt$integer_type_qualifier,
      recend,
      type5: record
        header: clt$type_specification_header,
        qualifier: clt$integer_type_qualifier,
      recend,
      type6: record
        header: clt$type_specification_header,
        qualifier: clt$list_type_qualifier_v2,
        element_type_spec: record
          header: clt$type_specification_header,
          qualifier: clt$keyword_type_qualifier,
          keyword_specs: array [1 .. 25] of clt$keyword_specification,
        recend,
        default_value: string (58),
      recend,
      type7: record
        header: clt$type_specification_header,
        qualifier: clt$list_type_qualifier_v2,
        element_type_spec: record
          header: clt$type_specification_header,
          qualifier: clt$string_type_qualifier,
        recend,
      recend,
      type8: 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 .. 2] of clt$keyword_specification,
        recend,
        type_size_2: clt$type_specification_size,
        element_type_spec_2: record
          header: clt$type_specification_header,
          qualifier: clt$name_type_qualifier,
        recend,
        default_value: string (6),
      recend,
      type9: 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 .. 2] of clt$keyword_specification,
        recend,
        type_size_2: clt$type_specification_size,
        element_type_spec_2: record
          header: clt$type_specification_header,
          qualifier: clt$name_type_qualifier,
        recend,
        type_size_3: clt$type_specification_size,
        element_type_spec_3: record
          header: clt$type_specification_header,
          qualifier: clt$string_type_qualifier,
        recend,
        default_value: string (4),
      recend,
      type10: 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,
          qualifier: clt$name_type_qualifier,
        recend,
        default_value: string (6),
      recend,
      type11: record
        header: clt$type_specification_header,
        qualifier: clt$name_type_qualifier,
      recend,
      type12: 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$name_type_qualifier,
        recend,
        type_size_2: clt$type_specification_size,
        element_type_spec_2: record
          header: clt$type_specification_header,
        recend,
      recend,
      type13: 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,
          qualifier: clt$string_type_qualifier,
        recend,
        default_value: string (4),
      recend,
      type14: 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,
          qualifier: clt$name_type_qualifier,
        recend,
        default_value: string (6),
      recend,
      type15: record
        header: clt$type_specification_header,
        default_value: string (5),
      recend,
      type16: record
        header: clt$type_specification_header,
      recend,
    recend := [
    [1,
    [90, 7, 18, 16, 18, 9, 313],
    clc$command, 34, 16, 0, 0, 0, 0, 16, 'FDM$CREFM_SETF'], [
    ['C                              ',clc$abbreviation_entry, 2],
    ['COLUMN                         ',clc$nominal_entry, 2],
    ['COMMENT                        ',clc$nominal_entry, 7],
    ['COMMENTS                       ',clc$abbreviation_entry, 7],
    ['D                              ',clc$abbreviation_entry, 6],
    ['DISPLAY                        ',clc$nominal_entry, 6],
    ['DISPLAYS                       ',clc$alias_entry, 6],
    ['EF                             ',clc$abbreviation_entry, 8],
    ['EMF                            ',clc$alias_entry, 10],
    ['ERROR_MESSAGE_FORM             ',clc$nominal_entry, 10],
    ['EVENT_FORM                     ',clc$nominal_entry, 8],
    ['H                              ',clc$abbreviation_entry, 5],
    ['HE                             ',clc$abbreviation_entry, 15],
    ['HEIGHT                         ',clc$nominal_entry, 5],
    ['HELP_MESSAGE_FORM              ',clc$nominal_entry, 14],
    ['HELP_PROCESSING                ',clc$nominal_entry, 9],
    ['HIDDEN_EDITING                 ',clc$nominal_entry, 15],
    ['HMF                            ',clc$abbreviation_entry, 14],
    ['HP                             ',clc$abbreviation_entry, 9],
    ['IDC                            ',clc$abbreviation_entry, 13],
    ['INVALID_DATA_CHARACTER         ',clc$nominal_entry, 13],
    ['L                              ',clc$abbreviation_entry, 3],
    ['LINE                           ',clc$nominal_entry, 3],
    ['MESSAGE_FORM                   ',clc$alias_entry, 10],
    ['MF                             ',clc$abbreviation_entry, 10],
    ['P                              ',clc$abbreviation_entry, 1],
    ['PROCESSOR                      ',clc$nominal_entry, 1],
    ['STATUS                         ',clc$nominal_entry, 16],
    ['VARIABLE_DECK_NAME             ',clc$nominal_entry, 11],
    ['VARIABLE_RECORD_NAME           ',clc$nominal_entry, 12],
    ['VDN                            ',clc$abbreviation_entry, 11],
    ['VRN                            ',clc$abbreviation_entry, 12],
    ['W                              ',clc$abbreviation_entry, 4],
    ['WIDTH                          ',clc$nominal_entry, 4]],
    [
{ PARAMETER 1
    [27, 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, 266,
  clc$optional_default_parameter, 0, 5],
{ PARAMETER 2
    [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, 20,
  clc$optional_default_parameter, 0, 1],
{ PARAMETER 3
    [23, 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
    [34, 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_parameter,
  0, 0],
{ PARAMETER 5
    [14, 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_parameter,
  0, 0],
{ PARAMETER 6
    [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, 948,
  clc$optional_default_parameter, 0, 58],
{ PARAMETER 7
    [3, clc$normal_usage_entry, clc$non_secure_parameter,
    $clt$parameter_spec_methods[clc$specify_by_name],
    clc$pass_by_value, clc$immediate_evaluation, clc$standard_parameter_checking, 24, clc$optional_parameter,
  0, 0],
{ PARAMETER 8
    [11, clc$normal_usage_entry, clc$non_secure_parameter,
    $clt$parameter_spec_methods[clc$specify_by_name],
    clc$pass_by_value, clc$immediate_evaluation, clc$standard_parameter_checking, 106,
  clc$optional_default_parameter, 0, 6],
{ PARAMETER 9
    [16, clc$normal_usage_entry, clc$non_secure_parameter,
    $clt$parameter_spec_methods[clc$specify_by_name],
    clc$pass_by_value, clc$immediate_evaluation, clc$standard_parameter_checking, 118,
  clc$optional_default_parameter, 0, 4],
{ PARAMETER 10
    [10, clc$normal_usage_entry, clc$non_secure_parameter,
    $clt$parameter_spec_methods[clc$specify_by_name],
    clc$pass_by_value, clc$immediate_evaluation, clc$standard_parameter_checking, 69,
  clc$optional_default_parameter, 0, 6],
{ PARAMETER 11
    [29, clc$normal_usage_entry, clc$non_secure_parameter,
    $clt$parameter_spec_methods[clc$specify_by_name],
    clc$pass_by_value, clc$immediate_evaluation, clc$standard_parameter_checking, 5, clc$optional_parameter, 0
  , 0],
{ PARAMETER 12
    [30, clc$normal_usage_entry, clc$non_secure_parameter,
    $clt$parameter_spec_methods[clc$specify_by_name],
    clc$pass_by_value, clc$immediate_evaluation, clc$standard_parameter_checking, 28, clc$optional_parameter,
  0, 0],
{ PARAMETER 13
    [21, clc$normal_usage_entry, clc$non_secure_parameter,
    $clt$parameter_spec_methods[clc$specify_by_name],
    clc$pass_by_value, clc$immediate_evaluation, clc$standard_parameter_checking, 72,
  clc$optional_default_parameter, 0, 4],
{ PARAMETER 14
    [15, clc$normal_usage_entry, clc$non_secure_parameter,
    $clt$parameter_spec_methods[clc$specify_by_name],
    clc$pass_by_value, clc$immediate_evaluation, clc$standard_parameter_checking, 69,
  clc$optional_default_parameter, 0, 6],
{ PARAMETER 15
    [17, clc$normal_usage_entry, clc$non_secure_parameter,
    $clt$parameter_spec_methods[clc$specify_by_name],
    clc$pass_by_value, clc$immediate_evaluation, clc$standard_parameter_checking, 3,
  clc$optional_default_parameter, 0, 5],
{ PARAMETER 16
    [28, 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], [7], [
    ['ANSI_FORTRAN                   ', clc$nominal_entry, clc$normal_usage_entry, 1],
    ['CDC_FORTRAN                    ', clc$nominal_entry, clc$normal_usage_entry, 2],
    ['COBOL                          ', clc$nominal_entry, clc$normal_usage_entry, 4],
    ['CYBIL                          ', clc$nominal_entry, clc$normal_usage_entry, 5],
    ['EXTENDED_FORTRAN               ', clc$nominal_entry, clc$normal_usage_entry, 3],
    ['PASCAL                         ', clc$nominal_entry, clc$normal_usage_entry, 6],
    ['SCL                            ', clc$nominal_entry, clc$normal_usage_entry, 7]]
    ,
    'cobol'],
{ 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$integer_type], [1, fdc$maximum_x_position, 10]],
{ PARAMETER 5
    [[1, 0, clc$integer_type], [1, fdc$maximum_y_position, 10]],
{ PARAMETER 6
    [[1, 0, clc$list_type], [932, 1, clc$max_list_size, 0, FALSE, FALSE],
      [[1, 0, clc$keyword_type], [25], [
      ['BLACK_BACKGROUND               ', clc$nominal_entry, clc$normal_usage_entry, 5],
      ['BLACK_FOREGROUND               ', clc$nominal_entry, clc$normal_usage_entry, 13],
      ['BLINK                          ', clc$nominal_entry, clc$normal_usage_entry, 4],
      ['BLUE_BACKGROUND                ', clc$nominal_entry, clc$normal_usage_entry, 6],
      ['BLUE_FOREGROUND                ', clc$nominal_entry, clc$normal_usage_entry, 14],
      ['BOLD_BORDER                    ', clc$nominal_entry, clc$normal_usage_entry, 23],
      ['CYAN_BACKGROUND                ', clc$nominal_entry, clc$normal_usage_entry, 10],
      ['CYAN_FOREGROUND                ', clc$nominal_entry, clc$normal_usage_entry, 18],
      ['DISPLAY_LEFT_TO_RIGHT          ', clc$nominal_entry, clc$normal_usage_entry, 24],
      ['DISPLAY_RIGHT_TO_LEFT          ', clc$nominal_entry, clc$normal_usage_entry, 25],
      ['FINE_BORDER                    ', clc$nominal_entry, clc$normal_usage_entry, 21],
      ['GREEN_BACKGROUND               ', clc$nominal_entry, clc$normal_usage_entry, 7],
      ['GREEN_FOREGROUND               ', clc$nominal_entry, clc$normal_usage_entry, 15],
      ['HIGH_INTENSITY                 ', clc$nominal_entry, clc$normal_usage_entry, 3],
      ['INVERSE                        ', clc$nominal_entry, clc$normal_usage_entry, 1],
      ['LOW_INTENSITY                  ', clc$nominal_entry, clc$normal_usage_entry, 2],
      ['MAGENTA_BACKGROUND             ', clc$nominal_entry, clc$normal_usage_entry, 8],
      ['MAGENTA_FOREGROUND             ', clc$nominal_entry, clc$normal_usage_entry, 16],
      ['MEDIUM_BORDER                  ', clc$nominal_entry, clc$normal_usage_entry, 22],
      ['RED_BACKGROUND                 ', clc$nominal_entry, clc$normal_usage_entry, 9],
      ['RED_FOREGROUND                 ', clc$nominal_entry, clc$normal_usage_entry, 17],
      ['WHITE_BACKGROUND               ', clc$nominal_entry, clc$normal_usage_entry, 12],
      ['WHITE_FOREGROUND               ', clc$nominal_entry, clc$normal_usage_entry, 20],
      ['YELLOW_BACKGROUND              ', clc$nominal_entry, clc$normal_usage_entry, 11],
      ['YELLOW_FOREGROUND              ', clc$nominal_entry, clc$normal_usage_entry, 19]]
      ]
    ,
    '(black_background, white_foreground,display_left_to_right)'],
{ PARAMETER 7
    [[1, 0, clc$list_type], [8, 1, clc$max_list_size, 0, FALSE, FALSE],
      [[1, 0, clc$string_type], [1, fdc$maximum_comment_length, FALSE]]
    ],
{ PARAMETER 8
    [[1, 0, clc$union_type], [[clc$keyword_type, clc$name_type],
    FALSE, 2],
    81, [[1, 0, clc$keyword_type], [2], [
      ['NONE                           ', clc$nominal_entry, clc$normal_usage_entry, 2],
      ['SYSTEM                         ', clc$nominal_entry, clc$normal_usage_entry, 1]]
      ],
    5, [[1, 0, clc$name_type], [1, osc$max_name_size]]
    ,
    'system'],
{ PARAMETER 9
    [[1, 0, clc$union_type], [[clc$keyword_type, clc$name_type, clc$string_type],
    FALSE, 3],
    81, [[1, 0, clc$keyword_type], [2], [
      ['NONE                           ', clc$nominal_entry, clc$normal_usage_entry, 2],
      ['SYSTEM                         ', clc$nominal_entry, clc$normal_usage_entry, 1]]
      ],
    5, [[1, 0, clc$name_type], [1, osc$max_name_size]],
    8, [[1, 0, clc$string_type], [0, fdc$maximum_y_position, FALSE]]
    ,
    'none'],
{ PARAMETER 10
    [[1, 0, clc$union_type], [[clc$keyword_type, clc$name_type],
    FALSE, 2],
    44, [[1, 0, clc$keyword_type], [1], [
      ['SYSTEM                         ', clc$nominal_entry, clc$normal_usage_entry, 1]]
      ],
    5, [[1, 0, clc$name_type], [1, osc$max_name_size]]
    ,
    'system'],
{ PARAMETER 11
    [[1, 0, clc$name_type], [1, osc$max_name_size]],
{ PARAMETER 12
    [[1, 0, clc$union_type], [[clc$cobol_name_type, clc$name_type],
    FALSE, 2],
    5, [[1, 0, clc$name_type], [1, osc$max_name_size]],
    3, [[1, 0, clc$cobol_name_type]]
    ],
{ PARAMETER 13
    [[1, 0, clc$union_type], [[clc$keyword_type, clc$string_type],
    FALSE, 2],
    44, [[1, 0, clc$keyword_type], [1], [
      ['NONE                           ', clc$nominal_entry, clc$normal_usage_entry, 1]]
      ],
    8, [[1, 0, clc$string_type], [1, 1, FALSE]]
    ,
    'none'],
{ PARAMETER 14
    [[1, 0, clc$union_type], [[clc$keyword_type, clc$name_type],
    FALSE, 2],
    44, [[1, 0, clc$keyword_type], [1], [
      ['SYSTEM                         ', clc$nominal_entry, clc$normal_usage_entry, 1]]
      ],
    5, [[1, 0, clc$name_type], [1, osc$max_name_size]]
    ,
    'system'],
{ PARAMETER 15
    [[1, 0, clc$boolean_type],
    'FALSE'],
{ PARAMETER 16
    [[1, 0, clc$status_type]]];

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

    CONST
      p$processor = 1,
      p$column = 2,
      p$line = 3,
      p$width = 4,
      p$height = 5,
      p$display = 6,
      p$comment = 7,
      p$event_form = 8,
      p$help_processing = 9,
      p$error_message_form = 10,
      p$variable_deck_name = 11,
      p$variable_record_name = 12,
      p$invalid_data_character = 13,
      p$help_message_form = 14,
      p$hidden_editing = 15,
      p$status = 16;

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

    CONST
      processor_attribute = 1,
      area_attribute = 2,
      display_attribute = 3,
      event_form_attribute = 4,
      help_attribute = 5,
      error_message_form_attribute = 6,
      invalid_data_attribute = 7,
      help_message_form_attribute = 8,
      hidden_editing_attribute =9,
      comment_attribute = 10;

    VAR
      comment: comment_attribute .. clc$max_list_size + comment_attribute,
      form_attributes_p: ^array [1 .. * ] of fdt$form_attribute,
      list_size: clt$list_size,
      local_status: ost$status,
      next_data_value_p: ^clt$data_value,
      record_attributes: array [1 .. 2] of fdt$record_attribute;

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

    list_size := clp$count_list_elements (pvt [p$comment].value);
    PUSH form_attributes_p: [1 .. list_size + hidden_editing_attribute];
    form_attributes_p^ [processor_attribute].key := fdc$form_processor;
    IF (pvt [p$processor].value^.keyword_value = 'COBOL') THEN
      form_attributes_p^ [processor_attribute].form_processor := fdc$cobol_processor;
    ELSEIF (pvt [p$processor].value^.keyword_value = 'CDC_FORTRAN') THEN
      form_attributes_p^ [processor_attribute].form_processor := fdc$cdc_fortran_processor;
    ELSEIF (pvt [p$processor].value^.keyword_value = 'ANSI_FORTRAN') THEN
      form_attributes_p^ [processor_attribute].form_processor := fdc$ansi_fortran_processor;
    ELSEIF (pvt [p$processor].value^.keyword_value = 'EXTENDED_FORTRAN') THEN
      form_attributes_p^ [processor_attribute].form_processor := fdc$extended_fortran_processor;
    ELSEIF (pvt [p$processor].value^.keyword_value = 'CYBIL') THEN
      form_attributes_p^ [processor_attribute].form_processor := fdc$cybil_processor;
    ELSEIF (pvt [p$processor].value^.keyword_value = 'PASCAL') THEN
      form_attributes_p^ [processor_attribute].form_processor := fdc$pascal_processor;
    ELSE
      form_attributes_p^ [processor_attribute].form_processor := fdc$scl_processor;
    IFEND;

    form_processor := form_attributes_p^ [processor_attribute].form_processor;

    form_attributes_p^ [area_attribute].key := fdc$form_area;
    IF (((pvt [p$column].specified) AND (pvt [p$column].value^.integer_value.value <> 1)) OR
          ((pvt [p$line].specified) AND (pvt [p$line].value^.integer_value.value <> 1))) THEN
      IF ((NOT pvt [p$width].specified) AND (NOT pvt [p$height].specified)) THEN
        osp$set_status_abnormal (fdc$format_display_identifier, fde$width_and_height_required,
              current_form_name, status);
        RETURN;
      IFEND;
    IFEND;

    IF pvt [p$width].specified THEN
      form_attributes_p^ [area_attribute].form_area.key := fdc$defined_area;
      form_attributes_p^ [area_attribute].form_area.x_position := pvt [p$column].value^.integer_value.value;
      form_attributes_p^ [area_attribute].form_area.y_position := pvt [p$line].value^.integer_value.value;
      form_attributes_p^ [area_attribute].form_area.width := pvt [p$width].value^.integer_value.value;
      form_attributes_p^ [area_attribute].form_area.height := pvt [p$height].value^.integer_value.value
    ELSE
      form_attributes_p^ [area_attribute].form_area.key := fdc$screen_area;
    IFEND;

    form_attributes_p^ [display_attribute].key := fdc$form_display_attribute;
    process_attributes (pvt [p$display].value, form_attributes_p^ [display_attribute].form_display_attribute,
          status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    form_attributes_p^ [event_form_attribute].key := fdc$event_form;
    IF pvt [p$event_form].value^.kind = clc$keyword THEN
      IF (pvt [p$event_form].value^.keyword_value = 'SYSTEM') THEN
        form_attributes_p^ [event_form_attribute].event_form_definition.key := fdc$system_default_event_form;
      ELSE
        form_attributes_p^ [event_form_attribute].event_form_definition.key := fdc$no_event_form;
      IFEND;

    ELSE
      form_attributes_p^ [event_form_attribute].event_form_definition.key := fdc$user_event_form;
      form_attributes_p^ [event_form_attribute].event_form_definition.event_form_name :=
            pvt [p$event_form].value^.name_value;
    IFEND;

    form_attributes_p^ [help_attribute].key := fdc$form_help;
    CASE pvt [p$help_processing].value^.kind OF

    = clc$keyword =
      IF (pvt [p$help_processing].value^.keyword_value = 'SYSTEM') THEN
        form_attributes_p^ [help_attribute].form_help.key := fdc$system_default_help
      ELSE
        form_attributes_p^ [help_attribute].form_help.key := fdc$no_help_response;
      IFEND;

    = clc$name =
      form_attributes_p^ [help_attribute].form_help.key := fdc$help_form;
      form_attributes_p^ [help_attribute].form_help.help_form := pvt [p$help_processing].value^.name_value;

    ELSE
      form_attributes_p^ [help_attribute].form_help.key := fdc$help_message;
      form_attributes_p^ [help_attribute].form_help.p_help_message :=
            pvt [p$help_processing].value^.string_value;
    CASEND;

    form_attributes_p^ [error_message_form_attribute].key := fdc$error_message_form;
    IF pvt [p$error_message_form].value^.kind = clc$keyword THEN
      form_attributes_p^ [error_message_form_attribute].error_message_form := osc$null_name;
    ELSE
      form_attributes_p^ [error_message_form_attribute].error_message_form :=
            pvt [p$error_message_form].value^.name_value;
    IFEND;

    IF pvt [p$invalid_data_character].value^.kind = clc$keyword THEN
      form_attributes_p^ [invalid_data_attribute].key := fdc$invalid_data_character;
      form_attributes_p^ [invalid_data_attribute].invalid_data_character.defined := FALSE;
    ELSE
      form_attributes_p^ [invalid_data_attribute].key := fdc$invalid_data_character;
      form_attributes_p^ [invalid_data_attribute].invalid_data_character.defined := TRUE;
      form_attributes_p^ [invalid_data_attribute].invalid_data_character.character :=
               pvt[p$invalid_data_character].value^.string_value^(1);
    IFEND;

    form_attributes_p^ [help_message_form_attribute].key := fdc$help_message_form;
    IF pvt [p$help_message_form].value^.kind = clc$keyword THEN
      form_attributes_p^ [help_message_form_attribute].message_form := osc$null_name;
    ELSE
      form_attributes_p^ [help_message_form_attribute].help_message_form :=
            pvt [p$help_message_form].value^.name_value;
    IFEND;

    form_attributes_p^ [hidden_editing_attribute].key := fdc$hidden_editing;
    form_attributes_p^ [hidden_editing_attribute].hidden_editing :=
          pvt [p$hidden_editing].value^.boolean_value.value;

{ Process one or more comments.

    next_data_value_p := pvt [p$comment].value;

  /get_comment/
    FOR comment := comment_attribute TO UPPERBOUND (form_attributes_p^) DO
      form_attributes_p^ [comment].key := fdc$add_form_comment;
      form_attributes_p^ [comment].p_form_comment := next_data_value_p^.element_value^.string_value;
      next_data_value_p := next_data_value_p^.link;
    FOREND /get_comment/;

    fdp$change_form (current_form_identifier, form_attributes_p^, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    IF pvt [p$variable_deck_name].specified THEN
      record_attributes [1].key := fdc$record_deck_name;
      record_attributes [1].record_deck_name := pvt [p$variable_deck_name].value^.name_value;
    ELSE
      record_attributes [1].key := fdc$unused_record_entry;
    IFEND;

    IF pvt [p$variable_record_name].specified THEN
      record_attributes [2].key := fdc$record_name;
      record_attributes [2].record_name := pvt [p$variable_record_name].value^.name_value;
    ELSE
      record_attributes [2].key := fdc$unused_record_entry;
    IFEND;

    IF (pvt [p$variable_deck_name].specified OR pvt [p$variable_record_name].specified) THEN
      fdp$change_form_record (current_form_identifier, record_attributes, status);
    IFEND;

  PROCEND set_form;

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

{ PURPOSE:
{   This procedure processes the set_integer_input command.

  PROCEDURE set_integer_input
    (    parameter_list: clt$parameter_list;
     VAR status: ost$status);

{ PROCEDURE (fdm$crefm_setii) set_integer_input, setii (
{   variable_name, vn: any of
{       name
{       cobol_name
{     anyend = $required
{   valid_value, valid_values, vv: list 0..fdc$maximum_valid_ranges of range of integer = $optional
{   entry_format, ef: key
{       digits, signed
{     keyend = $optional
{   status)

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

  VAR
    pdt: [STATIC, READ, cls$declaration_section] record
      header: clt$pdt_header,
      names: array [1 .. 8] of clt$pdt_parameter_name,
      parameters: array [1 .. 4] of clt$pdt_parameter,
      type1: 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$name_type_qualifier,
        recend,
        type_size_2: clt$type_specification_size,
        element_type_spec_2: record
          header: clt$type_specification_header,
        recend,
      recend,
      type2: record
        header: clt$type_specification_header,
        qualifier: clt$list_type_qualifier,
        element_type_spec: record
          header: clt$type_specification_header,
          qualifier: clt$range_type_qualifier,
          element_type_spec: record
            header: clt$type_specification_header,
            qualifier: clt$integer_type_qualifier,
          recend,
        recend,
      recend,
      type3: record
        header: clt$type_specification_header,
        qualifier: clt$keyword_type_qualifier,
        keyword_specs: array [1 .. 2] of clt$keyword_specification,
      recend,
      type4: record
        header: clt$type_specification_header,
      recend,
    recend := [
    [1,
    [89, 7, 19, 13, 47, 11, 147],
    clc$command, 8, 4, 1, 0, 0, 0, 4, 'FDM$CREFM_SETII'], [
    ['EF                             ',clc$abbreviation_entry, 3],
    ['ENTRY_FORMAT                   ',clc$nominal_entry, 3],
    ['STATUS                         ',clc$nominal_entry, 4],
    ['VALID_VALUE                    ',clc$nominal_entry, 2],
    ['VALID_VALUES                   ',clc$alias_entry, 2],
    ['VARIABLE_NAME                  ',clc$nominal_entry, 1],
    ['VN                             ',clc$abbreviation_entry, 1],
    ['VV                             ',clc$abbreviation_entry, 2]],
    [
{ PARAMETER 1
    [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, 28, 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, 43, clc$optional_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, 81, clc$optional_parameter,
  0, 0],
{ 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$union_type], [[clc$cobol_name_type, clc$name_type],
    FALSE, 2],
    5, [[1, 0, clc$name_type], [1, osc$max_name_size]],
    3, [[1, 0, clc$cobol_name_type]]
    ],
{ PARAMETER 2
    [[1, 0, clc$list_type], [27, 0, fdc$maximum_valid_ranges, FALSE],
      [[1, 0, clc$range_type], [20],
        [[1, 0, clc$integer_type], [clc$min_integer, clc$max_integer, 10]]
      ]
    ],
{ PARAMETER 3
    [[1, 0, clc$keyword_type], [2], [
    ['DIGITS                         ', clc$nominal_entry, clc$normal_usage_entry, 1],
    ['SIGNED                         ', clc$nominal_entry, clc$normal_usage_entry, 2]]
    ],
{ PARAMETER 4
    [[1, 0, clc$status_type]]];

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

    CONST
      p$variable_name = 1,
      p$valid_value = 2,
      p$entry_format = 3,
      p$status = 4;

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

    VAR
      list_size: clt$list_size,
      next_data_value_p: ^clt$data_value,
      valid_value: 2 .. clc$max_list_size + 1,
      variable_attributes_p: ^array [1 .. * ] of fdt$variable_attribute,
      variable_name: ost$name;

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

    list_size := clp$count_list_elements (pvt [p$valid_value].value);
    PUSH variable_attributes_p: [1 .. list_size + 1];

    IF pvt [p$entry_format].specified THEN
      variable_attributes_p^ [1].key := fdc$input_format;
      IF pvt [p$entry_format].value^.keyword_value = 'DIGITS' THEN
        variable_attributes_p^ [1].input_format.key := fdc$digits_input_format;
      ELSE
        variable_attributes_p^ [1].input_format.key := fdc$signed_input_format;
      IFEND;
    ELSE
      variable_attributes_p^ [1].key := fdc$unused_variable_entry;
    IFEND;

    next_data_value_p := pvt [p$valid_value].value;

  /get_valid_integer/
    FOR valid_value := 2 TO list_size + 1 DO
      variable_attributes_p^ [valid_value].key := fdc$add_valid_integer_range;
      variable_attributes_p^ [valid_value].maximum_integer :=
            next_data_value_p^.element_value^.high_value^.integer_value.value;
      variable_attributes_p^ [valid_value].minimum_integer := next_data_value_p^.element_value^.low_value^.
            integer_value.value;
      next_data_value_p := next_data_value_p^.link;
    FOREND /get_valid_integer/;

    IF pvt [p$variable_name].value^.kind = clc$name THEN
      convert_to_form_name (pvt [p$variable_name].value^.name_value, form_processor, variable_name);
    ELSE
      variable_name := pvt [p$variable_name].value^.cobol_name_value;
    IFEND;

    fdp$change_variable (current_form_identifier, variable_name, variable_attributes_p^, status);

  PROCEND set_integer_input;

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

{ PURPOSE:
{   This procedure processes the set_integer_output command.

  PROCEDURE set_integer_output
    (    parameter_list: clt$parameter_list;
     VAR status: ost$status);

{ PROCEDURE (fdm$crefm_setio) set_integer_output, setio (
{   variable_name, vn: any of
{       name
{       cobol_name
{     anyend = $required
{   width, w: integer 1..19 = $required
{   minimum_digit, minimum_digits, md: integer 0..19 = 0
{   sign, s: key
{       minus_if_negative, always_signed
{     keyend = minus_if_negative
{   status)

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

  VAR
    pdt: [STATIC, READ, cls$declaration_section] record
      header: clt$pdt_header,
      names: array [1 .. 10] of clt$pdt_parameter_name,
      parameters: array [1 .. 5] of clt$pdt_parameter,
      type1: 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$name_type_qualifier,
        recend,
        type_size_2: clt$type_specification_size,
        element_type_spec_2: record
          header: clt$type_specification_header,
        recend,
      recend,
      type2: record
        header: clt$type_specification_header,
        qualifier: clt$integer_type_qualifier,
      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$keyword_type_qualifier,
        keyword_specs: array [1 .. 2] of clt$keyword_specification,
        default_value: string (17),
      recend,
      type5: record
        header: clt$type_specification_header,
      recend,
    recend := [
    [1,
    [89, 5, 18, 16, 11, 56, 746],
    clc$command, 10, 5, 2, 0, 0, 0, 5, 'FDM$CREFM_SETIO'], [
    ['MD                             ',clc$abbreviation_entry, 3],
    ['MINIMUM_DIGIT                  ',clc$nominal_entry, 3],
    ['MINIMUM_DIGITS                 ',clc$alias_entry, 3],
    ['S                              ',clc$abbreviation_entry, 4],
    ['SIGN                           ',clc$nominal_entry, 4],
    ['STATUS                         ',clc$nominal_entry, 5],
    ['VARIABLE_NAME                  ',clc$nominal_entry, 1],
    ['VN                             ',clc$abbreviation_entry, 1],
    ['W                              ',clc$abbreviation_entry, 2],
    ['WIDTH                          ',clc$nominal_entry, 2]],
    [
{ PARAMETER 1
    [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, 28, clc$required_parameter,
  0, 0],
{ PARAMETER 2
    [10, 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$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, 20,
  clc$optional_default_parameter, 0, 1],
{ PARAMETER 4
    [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, 81,
  clc$optional_default_parameter, 0, 17],
{ PARAMETER 5
    [6, 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$union_type], [[clc$cobol_name_type, clc$name_type],
    FALSE, 2],
    5, [[1, 0, clc$name_type], [1, osc$max_name_size]],
    3, [[1, 0, clc$cobol_name_type]]
    ],
{ PARAMETER 2
    [[1, 0, clc$integer_type], [1, 19, 10]],
{ PARAMETER 3
    [[1, 0, clc$integer_type], [0, 19, 10],
    '0'],
{ PARAMETER 4
    [[1, 0, clc$keyword_type], [2], [
    ['ALWAYS_SIGNED                  ', clc$nominal_entry, clc$normal_usage_entry, 2],
    ['MINUS_IF_NEGATIVE              ', clc$nominal_entry, clc$normal_usage_entry, 1]]
    ,
    'minus_if_negative'],
{ PARAMETER 5
    [[1, 0, clc$status_type]]];

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

    CONST
      p$variable_name = 1,
      p$width = 2,
      p$minimum_digit = 3,
      p$sign = 4,
      p$status = 5;

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

    VAR
      list_size: clt$list_size,
      variable_attributes: array [1 .. 1] of fdt$variable_attribute,
      variable_name: ost$name;

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

    variable_attributes [1].key := fdc$output_format;
    variable_attributes [1].output_format.key := fdc$integer_output_format;
    variable_attributes [1].output_format.integer_output_format.field_width :=
          pvt [p$width].value^.integer_value.value;
    variable_attributes [1].output_format.integer_output_format.minimum_output_digits :=
          pvt [p$minimum_digit].value^.integer_value.value;
    IF pvt [p$sign].value^.keyword_value = 'MINUS_IF_NEGATIVE' THEN
      variable_attributes [1].output_format.integer_output_format.sign_treatment := mlc$minus_if_negative;
    ELSE
      variable_attributes [1].output_format.integer_output_format.sign_treatment := mlc$always_signed;
    IFEND;


    IF pvt [p$variable_name].value^.kind = clc$name THEN
      convert_to_form_name (pvt [p$variable_name].value^.name_value, form_processor, variable_name);
    ELSE
      variable_name := pvt [p$variable_name].value^.cobol_name_value;
    IFEND;

    fdp$change_variable (current_form_identifier, variable_name, variable_attributes, status);

  PROCEND set_integer_output;

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

{ PURPOSE:
{   This procedure processes the set_money_input command.

  PROCEDURE set_money_input
    (    parameter_list: clt$parameter_list;
     VAR status: ost$status);

{ PROCEDURE (fdm$crefm_setmi) set_money_input, setmi (
{   variable_name, vn: any of
{       name
{       cobol_name
{     anyend = $required
{   money_symbol, ms: string 1 = '$'
{   thousands_separator, ts: string 1 = ','
{   decimal_point, dp: string 1 = '.'
{   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$union_type_qualifier,
        type_size_1: clt$type_specification_size,
        element_type_spec_1: record
          header: clt$type_specification_header,
          qualifier: clt$name_type_qualifier,
        recend,
        type_size_2: clt$type_specification_size,
        element_type_spec_2: record
          header: clt$type_specification_header,
        recend,
      recend,
      type2: record
        header: clt$type_specification_header,
        qualifier: clt$string_type_qualifier,
        default_value: string (3),
      recend,
      type3: record
        header: clt$type_specification_header,
        qualifier: clt$string_type_qualifier,
        default_value: string (3),
      recend,
      type4: record
        header: clt$type_specification_header,
        qualifier: clt$string_type_qualifier,
        default_value: string (3),
      recend,
      type5: record
        header: clt$type_specification_header,
      recend,
    recend := [
    [1,
    [90, 10, 23, 16, 46, 27, 738],
    clc$command, 9, 5, 1, 0, 0, 0, 5, 'FDM$CREFM_SETMI'], [
    ['DECIMAL_POINT                  ',clc$nominal_entry, 4],
    ['DP                             ',clc$abbreviation_entry, 4],
    ['MONEY_SYMBOL                   ',clc$nominal_entry, 2],
    ['MS                             ',clc$abbreviation_entry, 2],
    ['STATUS                         ',clc$nominal_entry, 5],
    ['THOUSANDS_SEPARATOR            ',clc$nominal_entry, 3],
    ['TS                             ',clc$abbreviation_entry, 3],
    ['VARIABLE_NAME                  ',clc$nominal_entry, 1],
    ['VN                             ',clc$abbreviation_entry, 1]],
    [
{ PARAMETER 1
    [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, 28, 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$specify_positionally],
    clc$pass_by_value, clc$immediate_evaluation, clc$standard_parameter_checking, 8,
  clc$optional_default_parameter, 0, 3],
{ 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_value, clc$immediate_evaluation, clc$standard_parameter_checking, 8,
  clc$optional_default_parameter, 0, 3],
{ 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, 8,
  clc$optional_default_parameter, 0, 3],
{ 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$union_type], [[clc$cobol_name_type, clc$name_type],
    FALSE, 2],
    5, [[1, 0, clc$name_type], [1, osc$max_name_size]],
    3, [[1, 0, clc$cobol_name_type]]
    ],
{ PARAMETER 2
    [[1, 0, clc$string_type], [1, 1, FALSE],
    '''$'''],
{ PARAMETER 3
    [[1, 0, clc$string_type], [1, 1, FALSE],
    ''','''],
{ PARAMETER 4
    [[1, 0, clc$string_type], [1, 1, FALSE],
    '''.'''],
{ PARAMETER 5
    [[1, 0, clc$status_type]]];

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

    CONST
      p$variable_name = 1,
      p$money_symbol = 2,
      p$thousands_separator = 3,
      p$decimal_point = 4,
      p$status = 5;

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

    VAR
      variable_attributes: array [1 .. 1] of fdt$variable_attribute,
      variable_name: ost$name;

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


    variable_attributes [1].key := fdc$input_format;
    variable_attributes [1].input_format.key := fdc$currency_input_format;
    variable_attributes [1].input_format.input_currency_format.currency_sybmol :=
          pvt [p$money_symbol].value^.string_value^;
    variable_attributes [1].input_format.input_currency_format.thousands_separator :=
          pvt [p$thousands_separator].value^.string_value^;
    variable_attributes [1].input_format.input_currency_format.decimal_point :=
          pvt [p$decimal_point].value^.string_value^;

    IF pvt [p$variable_name].value^.kind = clc$name THEN
      convert_to_form_name (pvt [p$variable_name].value^.name_value, form_processor, variable_name);

    ELSE
      variable_name := pvt [p$variable_name].value^.cobol_name_value;
    IFEND;

    fdp$change_variable (current_form_identifier, variable_name, variable_attributes, status);

  PROCEND set_money_input;

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

{ PURPOSE:
{   This procedure processes the set_money_output command.

  PROCEDURE set_money_output
    (    parameter_list: clt$parameter_list;
     VAR status: ost$status);

{ PROCEDURE (fdm$crefm_setmo) set_money_output, setmo (
{   variable_name, vn: any of
{       name
{       cobol_name
{     anyend = $required
{   money_symbol, ms: string 1 = '$'
{   thousands_separator, ts: string 1 = ','
{   decimal_point, dp: string 1 = '.'
{   sign, s: key
{       minus_if_negative, always_signed
{     keyend = minus_if_negative
{   suppress_zero, sz: boolean = TRUE
{   status)

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

  VAR
    pdt: [STATIC, READ, cls$declaration_section] record
      header: clt$pdt_header,
      names: array [1 .. 13] of clt$pdt_parameter_name,
      parameters: array [1 .. 7] of clt$pdt_parameter,
      type1: 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$name_type_qualifier,
        recend,
        type_size_2: clt$type_specification_size,
        element_type_spec_2: record
          header: clt$type_specification_header,
        recend,
      recend,
      type2: record
        header: clt$type_specification_header,
        qualifier: clt$string_type_qualifier,
        default_value: string (3),
      recend,
      type3: record
        header: clt$type_specification_header,
        qualifier: clt$string_type_qualifier,
        default_value: string (3),
      recend,
      type4: record
        header: clt$type_specification_header,
        qualifier: clt$string_type_qualifier,
        default_value: string (3),
      recend,
      type5: record
        header: clt$type_specification_header,
        qualifier: clt$keyword_type_qualifier,
        keyword_specs: array [1 .. 2] of clt$keyword_specification,
        default_value: string (17),
      recend,
      type6: record
        header: clt$type_specification_header,
        default_value: string (4),
      recend,
      type7: record
        header: clt$type_specification_header,
      recend,
    recend := [
    [1,
    [90, 10, 23, 16, 51, 31, 208],
    clc$command, 13, 7, 1, 0, 0, 0, 7, 'FDM$CREFM_SETMO'], [
    ['DECIMAL_POINT                  ',clc$nominal_entry, 4],
    ['DP                             ',clc$abbreviation_entry, 4],
    ['MONEY_SYMBOL                   ',clc$nominal_entry, 2],
    ['MS                             ',clc$abbreviation_entry, 2],
    ['S                              ',clc$abbreviation_entry, 5],
    ['SIGN                           ',clc$nominal_entry, 5],
    ['STATUS                         ',clc$nominal_entry, 7],
    ['SUPPRESS_ZERO                  ',clc$nominal_entry, 6],
    ['SZ                             ',clc$abbreviation_entry, 6],
    ['THOUSANDS_SEPARATOR            ',clc$nominal_entry, 3],
    ['TS                             ',clc$abbreviation_entry, 3],
    ['VARIABLE_NAME                  ',clc$nominal_entry, 1],
    ['VN                             ',clc$abbreviation_entry, 1]],
    [
{ PARAMETER 1
    [12, 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, 28, 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$specify_positionally],
    clc$pass_by_value, clc$immediate_evaluation, clc$standard_parameter_checking, 8,
  clc$optional_default_parameter, 0, 3],
{ PARAMETER 3
    [10, 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, 8,
  clc$optional_default_parameter, 0, 3],
{ 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, 8,
  clc$optional_default_parameter, 0, 3],
{ PARAMETER 5
    [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, 81,
  clc$optional_default_parameter, 0, 17],
{ PARAMETER 6
    [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$optional_default_parameter, 0, 4],
{ PARAMETER 7
    [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$union_type], [[clc$cobol_name_type, clc$name_type],
    FALSE, 2],
    5, [[1, 0, clc$name_type], [1, osc$max_name_size]],
    3, [[1, 0, clc$cobol_name_type]]
    ],
{ PARAMETER 2
    [[1, 0, clc$string_type], [1, 1, FALSE],
    '''$'''],
{ PARAMETER 3
    [[1, 0, clc$string_type], [1, 1, FALSE],
    ''','''],
{ PARAMETER 4
    [[1, 0, clc$string_type], [1, 1, FALSE],
    '''.'''],
{ PARAMETER 5
    [[1, 0, clc$keyword_type], [2], [
    ['ALWAYS_SIGNED                  ', clc$nominal_entry, clc$normal_usage_entry, 2],
    ['MINUS_IF_NEGATIVE              ', clc$nominal_entry, clc$normal_usage_entry, 1]]
    ,
    'minus_if_negative'],
{ PARAMETER 6
    [[1, 0, clc$boolean_type],
    'TRUE'],
{ PARAMETER 7
    [[1, 0, clc$status_type]]];

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

    CONST
      p$variable_name = 1,
      p$money_symbol = 2,
      p$thousands_separator = 3,
      p$decimal_point = 4,
      p$sign = 5,
      p$suppress_zero = 6,
      p$status = 7;

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

    VAR
      variable_attributes: array [1 .. 1] of fdt$variable_attribute,
      variable_name: ost$name;

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

    variable_attributes [1].key := fdc$output_format;
    variable_attributes [1].output_format.key := fdc$currency_output_format;
    variable_attributes [1].output_format.output_currency_format.currency_sybmol := pvt [p$money_symbol].
          value^.string_value^;
    variable_attributes [1].output_format.output_currency_format.thousands_separator :=
          pvt [p$thousands_separator].value^.string_value^;
    variable_attributes [1].output_format.output_currency_format.decimal_point := pvt [p$decimal_point].
          value^.string_value^;
    variable_attributes [1].output_format.output_currency_format.suppress_leading_zeros :=
          pvt [p$suppress_zero].value^.boolean_value.value;
    IF pvt [p$sign].value^.keyword_value = 'MINUS_IF_NEGATIVE' THEN
      variable_attributes [1].output_format.output_currency_format.sign_treatment := mlc$minus_if_negative;
    ELSE
      variable_attributes [1].output_format.output_currency_format.sign_treatment := mlc$always_signed;
    IFEND;

    IF pvt [p$variable_name].value^.kind = clc$name THEN

      convert_to_form_name (pvt [p$variable_name].value^.name_value, form_processor, variable_name);
    ELSE
      variable_name := pvt [p$variable_name].value^.cobol_name_value;
    IFEND;

    fdp$change_variable (current_form_identifier, variable_name, variable_attributes, status);

  PROCEND set_money_output;

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

{ PURPOSE:
{   This procedure processes the set_real_input command.

  PROCEDURE set_real_input
    (    parameter_list: clt$parameter_list;
     VAR status: ost$status);

{ PROCEDURE (fdm$crefm_setri) set_real_input, setri (
{   variable_name, vn: any of
{       name
{       cobol_name
{     anyend = $required
{   valid_value, valid_values, vv: list 1..fdc$maximum_valid_ranges of range of real = $optional
{   status)

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

  VAR
    pdt: [STATIC, READ, cls$declaration_section] record
      header: clt$pdt_header,
      names: array [1 .. 6] of clt$pdt_parameter_name,
      parameters: array [1 .. 3] of clt$pdt_parameter,
      type1: 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$name_type_qualifier,
        recend,
        type_size_2: clt$type_specification_size,
        element_type_spec_2: record
          header: clt$type_specification_header,
        recend,
      recend,
      type2: record
        header: clt$type_specification_header,
        qualifier: clt$list_type_qualifier,
        element_type_spec: record
          header: clt$type_specification_header,
          qualifier: clt$range_type_qualifier,
          element_type_spec: record
            header: clt$type_specification_header,
            qualifier: clt$real_type_qualifier,
          recend,
        recend,
      recend,
      type3: record
        header: clt$type_specification_header,
      recend,
    recend := [
    [1,
    [89, 5, 22, 11, 43, 35, 889],
    clc$command, 6, 3, 1, 0, 0, 0, 3, 'FDM$CREFM_SETRI'], [
    ['STATUS                         ',clc$nominal_entry, 3],
    ['VALID_VALUE                    ',clc$nominal_entry, 2],
    ['VALID_VALUES                   ',clc$alias_entry, 2],
    ['VARIABLE_NAME                  ',clc$nominal_entry, 1],
    ['VN                             ',clc$abbreviation_entry, 1],
    ['VV                             ',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, 28, clc$required_parameter,
  0, 0],
{ PARAMETER 2
    [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, 58, clc$optional_parameter,
  0, 0],
{ 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$union_type], [[clc$cobol_name_type, clc$name_type],
    FALSE, 2],
    5, [[1, 0, clc$name_type], [1, osc$max_name_size]],
    3, [[1, 0, clc$cobol_name_type]]
    ],
{ PARAMETER 2
    [[1, 0, clc$list_type], [42, 1, fdc$maximum_valid_ranges, FALSE],
      [[1, 0, clc$range_type], [35],
        [[1, 0, clc$real_type],
        [[{-$INFINITY} 3, [[0D000(16), 0(16)], [0D000(16), 0(16)]]],
        [{$INFINITY} 3, [[5000(16), 0(16)], [5000(16), 0(16)]]]]
        ]
      ]
    ],
{ PARAMETER 3
    [[1, 0, clc$status_type]]];

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

    CONST
      p$variable_name = 1,
      p$valid_value = 2,
      p$status = 3;

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

    VAR
      list_size: clt$list_size,
      long_real_record: fdt$long_real_record,
      next_data_value_p: ^clt$data_value,
      valid_value: 1 .. clc$max_list_size,
      variable_attributes_p: ^array [1 .. * ] of fdt$variable_attribute,
      variable_name: ost$name;

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

    list_size := clp$count_list_elements (pvt [p$valid_value].value);
    PUSH variable_attributes_p: [1 .. list_size];

    next_data_value_p := pvt [p$valid_value].value;

  /get_valid_real/
    FOR valid_value := 1 TO list_size DO
      variable_attributes_p^ [valid_value].key := fdc$add_valid_real_range;
      #UNCHECKED_CONVERSION (next_data_value_p^.element_value^.high_value^.real_value.value,
            long_real_record);
      variable_attributes_p^ [valid_value].maximum_real := long_real_record.first_real;
      #UNCHECKED_CONVERSION (next_data_value_p^.element_value^.low_value^.real_value.value, long_real_record);
      variable_attributes_p^ [valid_value].minimum_real := long_real_record.first_real;
      next_data_value_p := next_data_value_p^.link;
    FOREND /get_valid_real/;

    IF pvt [p$variable_name].value^.kind = clc$name THEN
      convert_to_form_name (pvt [p$variable_name].value^.name_value, form_processor, variable_name);
    ELSE
      variable_name := pvt [p$variable_name].value^.cobol_name_value;
    IFEND;

    fdp$change_variable (current_form_identifier, variable_name, variable_attributes_p^, status);

  PROCEND set_real_input;

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

{ PURPOSE:
{   This procedure processes the end_form_module command.

  PROCEDURE end_form_module
    (    parameter_list: clt$parameter_list;
     VAR status: ost$status);

{ PROCEDURE (fdm$crefm_endfm) end_form_module, endfm, quit, qui (
{   create_module, cm: boolean = yes
{   status)

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

  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,
        default_value: string (3),
      recend,
      type2: record
        header: clt$type_specification_header,
      recend,
    recend := [
    [1,
    [89, 5, 18, 16, 13, 23, 274],
    clc$command, 3, 2, 0, 0, 0, 0, 2, 'FDM$CREFM_ENDFM'], [
    ['CM                             ',clc$abbreviation_entry, 1],
    ['CREATE_MODULE                  ',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$optional_default_parameter, 0, 3],
{ 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$boolean_type],
    'yes'],
{ PARAMETER 2
    [[1, 0, clc$status_type]]];

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

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

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


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

    create_form := pvt [p$create_module].value^.boolean_value.value;
    clp$end_include (utility_name, status);

  PROCEND end_form_module;

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

{ PURPOSE:
{   This procedure converts the name appearing in the command to the name
{   appropriate for the form language.
{
{ DESIGN:
{   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.

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

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

  PROCEND convert_to_form_name;

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

{ PURPOSE:
{   This procedure converts the name defined for the form language to a
{   SCL name.
{
{ DESIGN:
{   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.

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

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

  PROCEND convert_to_scl_name;

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

{ PURPOSE:
{   This procedure displays form errors.

  PROCEDURE display_form_errors
    (VAR errors_p: ^SEQ ( * );
     VAR display_status: ost$status);

    VAR
      error_input_conversion_p: ^fdt$error_input_conversion,
      error_invalid_value_p: ^fdt$error_invalid_value,
      error_header_p: ^fdt$error_header,
      error_no_table_object_p: ^fdt$error_no_table_object,
      error_no_table_variable_p: ^fdt$error_no_table_variable,
      error_no_variable_def_p: ^fdt$error_no_variable_def,
      error_no_variable_object_p: ^fdt$error_no_variable_object,
      error_output_conversion_p: ^fdt$error_output_conversion,
      error_unequal_tbl_obj_width_p: ^fdt$error_unequal_tbl_obj_width,
      local_status: ost$status,
      status: ost$status;

    display_status.normal := TRUE;
    RESET errors_p;
    NEXT error_header_p IN errors_p;

{ Unpack error message from sequence and display it.

    WHILE error_header_p <> NIL DO
      CASE error_header_p^.key OF

      = fdc$no_variable_definition =
        NEXT error_no_variable_def_p IN errors_p;
        osp$set_status_abnormal (fdc$format_display_identifier, fde$no_variable_definition, current_form_name,
              status);
        osp$append_status_parameter (osc$status_parameter_delimiter, error_no_variable_def_p^.variable_name,
              status);
        osp$append_status_integer (osc$status_parameter_delimiter,
              $INTEGER (error_no_variable_def_p^.occurrence), 10, FALSE, status);
        osp$generate_error_message (status, local_status);

      = fdc$no_table_variable =
        NEXT error_no_table_variable_p IN errors_p;
        osp$set_status_abnormal (fdc$format_display_identifier, fde$no_table_variable, current_form_name,
              status);
        osp$append_status_parameter (osc$status_parameter_delimiter, error_no_table_variable_p^.table_name,
              status);
        osp$append_status_parameter (osc$status_parameter_delimiter, error_no_table_variable_p^.variable_name,
              status);
        osp$generate_error_message (status, local_status);

      = fdc$no_variable_object =
        NEXT error_no_variable_object_p IN errors_p;
        osp$set_status_abnormal (fdc$format_display_identifier, fde$no_variable_object, current_form_name,
              status);
        osp$append_status_parameter (osc$status_parameter_delimiter,
              error_no_variable_object_p^.variable_name, status);
        osp$append_status_integer (osc$status_parameter_delimiter,
              $INTEGER (error_no_variable_object_p^.occurrence), 10, FALSE, status);
        osp$generate_error_message (status, local_status);

      = fdc$no_table_object =
        NEXT error_no_table_object_p IN errors_p;
        osp$set_status_abnormal (fdc$format_display_identifier, fde$no_table_object, current_form_name,
              status);
        osp$append_status_parameter (osc$status_parameter_delimiter, error_no_table_object_p^.table_name,
              status);
        osp$append_status_parameter (osc$status_parameter_delimiter, error_no_table_object_p^.variable_name,
              status);
        osp$generate_error_message (status, local_status);

      = fdc$unequal_tbl_obj_width =
        NEXT error_unequal_tbl_obj_width_p IN errors_p;
        osp$set_status_abnormal (fdc$format_display_identifier, fde$unequal_tbl_obj_width, current_form_name,
              status);
        osp$append_status_parameter (osc$status_parameter_delimiter,
              error_unequal_tbl_obj_width_p^.table_name, status);
        osp$append_status_parameter (osc$status_parameter_delimiter,
              error_unequal_tbl_obj_width_p^.variable_name, status);
        osp$append_status_integer (osc$status_parameter_delimiter,
              $INTEGER (error_unequal_tbl_obj_width_p^.occurrence), 10, FALSE, status);
        osp$generate_error_message (status, local_status);

      = fdc$error_input_conversion =
        NEXT error_input_conversion_p IN errors_p;
        osp$set_status_abnormal (fdc$format_display_identifier, fde$error_input_conversion, current_form_name,
              status);
        osp$append_status_parameter (osc$status_parameter_delimiter, error_input_conversion_p^.variable_name,
              status);
        osp$append_status_integer (osc$status_parameter_delimiter,
              $INTEGER (error_input_conversion_p^.occurrence), 10, FALSE, status);
        osp$generate_error_message (status, local_status);

      = fdc$error_output_conversion =
        NEXT error_output_conversion_p IN errors_p;
        osp$set_status_abnormal (fdc$format_display_identifier, fde$error_output_conversion,
              current_form_name, status);
        osp$append_status_parameter (osc$status_parameter_delimiter, error_output_conversion_p^.variable_name,
              status);
        osp$append_status_integer (osc$status_parameter_delimiter,
              $INTEGER (error_output_conversion_p^.occurrence), 10, FALSE, status);
        osp$generate_error_message (status, local_status);

      = fdc$error_invalid_value =
        NEXT error_invalid_value_p IN errors_p;
        osp$set_status_abnormal (fdc$format_display_identifier, fde$error_invalid_value, current_form_name,
              status);
        osp$append_status_parameter (osc$status_parameter_delimiter, error_invalid_value_p^.variable_name,
              status);
        osp$append_status_integer (osc$status_parameter_delimiter,
              $INTEGER (error_invalid_value_p^.occurrence), 10, FALSE, status);
        osp$generate_error_message (status, local_status);

      ELSE
        osp$set_status_abnormal (fdc$format_display_identifier, fde$system_error, 'invalid error value',
              display_status);
        RETURN;
      CASEND;

      NEXT error_header_p IN errors_p;

    WHILEND;
  PROCEND display_form_errors;

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

{ PURPOSE:
{   Convert key word specified in display attribute to Screen Formatting
{   ordinal.

  PROCEDURE process_attributes
    (    data_value_p: ^clt$data_value;
     VAR display_attribute_set: fdt$display_attribute_set;
     VAR status: ost$status);

    TYPE
      attribute_translation = record
        attribute_name: ost$name,
        display_attribute: fdt$display_attribute,
      recend;

    CONST
      attribute_maximum = 36;

    VAR
      attribute: 1 .. attribute_maximum,
      convert_attribute: [READ] array [1 .. attribute_maximum] of attribute_translation :=

{ Place most frequently used attributes at the beginning of the array.

      [['ITALIC', fdc$italic_display_attribute], ['TITLE', fdc$title_display_attribute],
            ['INPUT', fdc$input_display_attribute], ['ERROR', fdc$error_display_attribute],
            ['MESSAGE', fdc$message_display_attribute], ['INVERSE', fdc$inverse_video],
            ['LOW_INTENSITY', fdc$low_intensity], ['HIGH_INTENSITY', fdc$high_intensity],
            ['BLINK', fdc$blink], ['UNDERLINE', fdc$underline], ['PROTECT', fdc$protect],
            ['HIDDEN', fdc$hidden], ['BLACK_FOREGROUND', fdc$black_foreground],
            ['BLACK_BACKGROUND', fdc$black_background], ['BLUE_FOREGROUND', fdc$blue_foreground],
            ['BLUE_BACKGROUND', fdc$blue_background], ['GREEN_FOREGROUND', fdc$green_foreground],
            ['GREEN_BACKGROUND', fdc$green_background], ['MAGENTA_FOREGROUND', fdc$magenta_foreground],
            ['MAGENTA_BACKGROUND', fdc$magenta_background], ['RED_FOREGROUND', fdc$red_foreground],
            ['RED_BACKGROUND', fdc$red_background], ['CYAN_FOREGROUND', fdc$cyan_foreground],
            ['CYAN_BACKGROUND', fdc$cyan_background], ['YELLOW_FOREGROUND', fdc$yellow_foreground],
            ['YELLOW_BACKGROUND', fdc$yellow_background], ['WHITE_FOREGROUND', fdc$white_foreground],
            ['WHITE_BACKGROUND', fdc$white_background], ['FINE_LINE', fdc$fine_line],
            ['MEDIUM_LINE', fdc$medium_line], ['BOLD_LINE', fdc$bold_line], ['FINE_BORDER', fdc$fine_border],
            ['MEDIUM_BORDER', fdc$medium_border], ['BOLD_BORDER', fdc$bold_border],
            ['DISPLAY_LEFT_TO_RIGHT', fdc$display_left_to_right],
            ['DISPLAY_RIGHT_TO_LEFT', fdc$display_right_to_left]],
      keyword: clt$keyword,
      list: clt$list_size,
      list_size: clt$list_size,
      next_data_value_p: ^clt$data_value;

    status.normal := TRUE;
    display_attribute_set := $fdt$display_attribute_set [];
    list_size := clp$count_list_elements (data_value_p);
    next_data_value_p := data_value_p;

  /get_next_attribute/
    FOR list := 1 TO list_size DO
      keyword := next_data_value_p^.element_value^.keyword_value;

{ Convert key word attribute to Screen Formatting ordinal attribute.

    /find_attribute/
      FOR attribute := LOWERBOUND (convert_attribute) TO UPPERBOUND (convert_attribute) DO
        IF (keyword = convert_attribute [attribute].attribute_name) THEN
          display_attribute_set := display_attribute_set + $fdt$display_attribute_set
                [convert_attribute [attribute].display_attribute];
          next_data_value_p := next_data_value_p^.link;
          CYCLE /get_next_attribute/;
        IFEND;
      FOREND /find_attribute/;

      osp$set_status_abnormal (fdc$format_display_identifier, fde$system_error, 'invalid display attribute',
            status);
      RETURN;
    FOREND /get_next_attribute/;

  PROCEND process_attributes;

MODEND fdm$create_form_module;

