?? RIGHT := 110 ??
?? TITLE := 'NOS/VE Batch Device Support : Status and Control Facility Server' ??
MODULE nfm$status_control_fac_server;

{  DESCRIPTION:
{    This module contains the procedures and functions that collectively
{    implement the host application known as the control facility (SCFS/VE).
{
{  PURPOSE:
{    SCFS/VE is responsible for controlling the flow of output to batch devices, and
{    receiving batch device and file status and control commands.  The
{    station operator utility (operate_station) will make a connection to
{    the control facility (SCFS/VE) and pass along batch control commands.
{    SCFS/VE will process some of the commands itself, and relay others to the
{    proper SCF/VE or SCF/DI for processing.
{
{    SCFS/VE is also responsible for controlling the transfer of NTF files to
{    batch streams, and receiving batch stream and file status and control
{    commands.  The NTF operator utility (operate_ntf) will make a connection
{    to the control facility (SCFS/VE) and pass along batch control commands.
{    SCFS/VE will process some of the commands itself, and relay others to the
{    proper NTF/VE or SCF/DI for processing.

?? PUSH (LISTEXT := ON) ??
?? NEWTITLE := 'System Definitions', EJECT ??
*copyc nae$namve_conditions
*copyc nae$application_interfaces
*copyc nat$protocol_stack_integer
*copyc nfc$ntf_control_facility_prefix
*copyc nfe$status_control_fac_server
*copyc nft$accept_messages
*copyc nft$all_or_top_10_q_entries
*copyc nft$banner_highlight_field
*copyc nft$banner_page_count
*copyc nft$btfs_di_advanced_features
*copyc nft$btfs_di_title
*copyc nft$byte_array
*copyc nft$carriage_control_action
*copyc nft$code_set
*copyc nft$connection_address
*copyc nft$copies
*copyc nft$destination_unavail_actions
*copyc nft$device_control_resp_codes
*copyc nft$device_file_size
*copyc nft$device_max_page_length
*copyc nft$device_status
*copyc nft$device_status_data
*copyc nft$device_type
*copyc nft$display_status_resp_codes
*copyc nft$external_characteristics
*copyc nft$file_and_priority
*copyc nft$file_assignment_response
*copyc nft$file_count
*copyc nft$file_disposition
*copyc nft$file_position
*copyc nft$file_size
*copyc nft$file_transfer_state
*copyc nft$file_transfer_status
*copyc nft$file_vertical_print_density
*copyc nft$format_effector_actions
*copyc nft$forms_code
*copyc nft$forms_size
*copyc nft$input_job_size
*copyc nft$io_station_usage
*copyc nft$message_kind
*copyc nft$message_sequence
*copyc nft$network_address
*copyc nft$ntf_authority_level
*copyc nft$ntf_command_kind
*copyc nft$ntf_command_text
*copyc nft$ntf_inactivity_timer
*copyc nft$ntf_line_speed
*copyc nft$ntf_logical_line_data
*copyc nft$ntf_logical_line_number
*copyc nft$ntf_positive_acknowledge
*copyc nft$ntf_remote_system_count
*copyc nft$ntf_remote_system_data
*copyc nft$ntf_remote_system_kind
*copyc nft$ntf_remote_system_protocol
*copyc nft$ntf_remote_system_type
*copyc nft$ntf_remote_system_status
*copyc nft$ntf_route_back_position
*copyc nft$ntf_skip_punch_count
*copyc nft$ntf_system_identifier
*copyc nft$ntf_wait_a_bit
*copyc nft$optimize_list
*copyc nft$output_data_mode
*copyc nft$page_format
*copyc nft$page_length
*copyc nft$page_width
*copyc nft$parameter_value_length
*copyc nft$pm_message_actions
*copyc nft$priority
*copyc nft$priority_multiplier
*copyc nft$q_status_data
*copyc nft$scfs_client_identifier
*copyc nft$scfs_pdt
*copyc nft$select_file_response
*copyc nft$suppress_carriage_control
*copyc nft$terqo_file_status_codes
*copyc nft$terminal_model
*copyc nft$tip_type
*copyc nft$transmit_block_size
*copyc nft$unsolicited_device_msg
*copyc nft$vertical_print_density
*copyc nft$vfu_load_option
*copyc nft$vfu_load_procedure
*copyc ost$date_time
*copyc ost$name
*copyc ost$status
*copyc ost$time
*copyc osv$lower_to_upper
?? TITLE := 'XREF Procedures', EJECT ??
*copyc amp$get_segment_pointer
*copyc amp$get_next
*copyc amp$put_next
*copyc amp$return
*copyc bap$validate_file_identifier
*copyc clp$convert_integer_to_rjstring
*copyc clp$convert_integer_to_string
*copyc clp$convert_string_to_integer
*copyc clp$convert_string_to_real
*copyc clp$delete_variable
*copyc clp$get_value
*copyc clp$scan_parameter_list
*copyc clp$test_parameter
*copyc clp$trimmed_string_size
*copyc fsp$close_file
*copyc fsp$open_file
*copyc jmp$print_file
*copyc nap$accept_connection
*copyc nap$acquire_connection
*copyc nap$add_server_title
*copyc nap$attach_server_application
*copyc nap$await_data_available
*copyc nap$begin_directory_search
*copyc nap$delete_server_title
*copyc nap$detach_server_application
*copyc nap$end_directory_search
*copyc nap$get_attributes
*copyc nap$get_title_translation
*copyc nap$se_receive_data
*copyc nap$se_send_data
*copyc nfp$crack_terqo_msg
*copyc nfp$create_appl_def_segment_var
*copyc nfp$get_connection_data
*copyc nfp$get_parameter_value_length
*copyc nfp$modify_param_value_length
*copyc nfp$network_addresses_match
*copyc nfp$put_parameter_value_length
*copyc nfp$send_message_on_connection
*copyc nfp$send_terqo_response_msg
*copyc osp$generate_log_message
*copyc osp$i_await_activity_completion
*copyc osp$set_status_abnormal
*copyc pfp$attach
*copyc pfp$define
*copyc pfp$define_catalog
*copyc pmp$compute_date_time_increment
*copyc pmp$establish_condition_handler
*copyc pmp$format_compact_date
*copyc pmp$get_compact_date_time
*copyc pmp$get_microsecond_clock
*copyc pmp$get_date
*copyc pmp$get_time
*copyc pmp$get_unique_name
*copyc pmp$log
*copyc pmp$wait
?? POP ??
?? TITLE := 'Global Definitions', EJECT ??

  TYPE
    nft$scfs_tables = record
      first_station_name_alias: ^nft$alias,
      first_io_station: ^nft$io_station,
      first_ntf_acc_remote_system: ^nft$alias,
      first_ntf_remote_system: ^nft$io_station,
      first_connection: ^nft$connection,
      first_ntf_operator: ^nft$connection,
      ntf_acc_remote_system_count: nft$ntf_remote_system_count,
      unknown_private_operators_q: ^nft$output_queue_file,
    recend;

  CONST
    nfc$ntf_remote_sys_seq_storage = 32;

  TYPE
    nft$io_station = record
      name: ost$name,
      required_operator_device: ost$name,
      file_acknowledgement: boolean,
      automatic_operator_control: boolean,
      operator_assigned: boolean,
      connected_operator: ^nft$connection,
      station_operational: boolean,
      batch_device_list: ^nft$batch_device,
      back_link: ^nft$io_station,
      link: ^nft$io_station,
      case usage: nft$io_station_usage of
      = nfc$public_io_station, nfc$private_io_station =
        alias_names: array [1 .. 3] of ost$name,
        check_ios_unique: boolean,
        default_job_destination: ost$name,
        destination_unavailable_action: nft$destination_unavail_actions,
        pm_message_action: nft$pm_message_actions,
        scfdi_connection_pointers: ^nft$pointer_list_entry,
        selected_files_queue: ^nft$selected_file,
        last_selected_file_in_q: ^nft$selected_file,
        alias_list: array [0 .. 3] of ^nft$alias,
      = nfc$ntf_remote_system =
        ntf_protocol: nft$ntf_remote_system_protocol,
        ntf_local_system_name: ost$name,
        ntf_authority_level: nft$ntf_authority_level,
        ntf_wait_a_bit: nft$ntf_wait_a_bit,
        ntf_inactivity_timer: nft$ntf_inactivity_timer,
        ntf_positive_acknowledge: nft$ntf_positive_acknowledge,
        ntf_remote_password: ost$name,
        ntf_local_password: ost$name,
        ntf_default_job_destination: ost$name,
        ntf_default_file_destination: ost$name,
        ntf_store_forward_destination: ost$name,
        ntf_remote_system_type: nft$ntf_remote_system_type,
        ntf_route_back_position: nft$ntf_route_back_position,
        ntf_request_permission_retry: boolean,
        ntf_logical_line_list: ^nft$ntf_logical_line,
        ntf_acc_remote_system_ptr_list: ^nft$pointer_list_entry,
      casend,
    recend;

  TYPE
    nft$selected_file = record
      back_link: ^nft$selected_file,
      link: ^nft$selected_file,
      output_file: ^nft$output_queue_file,
      device_selected: ost$name,
    recend;

  TYPE
    nft$ntf_logical_line = record
      logical_line_number: nft$ntf_logical_line_number,
      line_name: ost$name,
      line_speed: nft$ntf_line_speed,
      signon_status: nft$device_status,
      console_stream_name: ost$name,
      terminal_user_procedure: ost$name,
      scfdi_connection: ^nft$connection,
      back_link: ^nft$ntf_logical_line,
      link: ^nft$ntf_logical_line,
    recend;

  CONST
    nfc$max_di_response_msgs = 255;

  TYPE
    nft$di_response_messages = (nfc$start_bd, nfc$stop_bd, nfc$change_bd_attr, nfc$suppress_cc,
      nfc$terminate_xfer, nfc$position_file);

  TYPE
    nft$outstanding_di_responses = array [nft$di_response_messages] of 0 .. nfc$max_di_response_msgs;

  TYPE
    protocol_stacks = (xns_protocol_stack, osi_protocol_stack),
    protocol_stacks_set = set of protocol_stacks;

  TYPE
    nft$btfs_di_status_codes = (nfc$btfs_di_down, nfc$btfs_di_active);

  TYPE
    unreachable_btfs_di = record
      title: nft$btfs_di_title,
      timer: integer,
      link: ^unreachable_btfs_di,
    recend;

  TYPE
    nft$batch_device = record
      name: ost$name,
      device_status: nft$device_status,
      file_transfer_status: nft$file_transfer_status,
      alias_names: array [1 .. 3] of ost$name,
      device_type: nft$device_type,
      tip_type: nft$tip_type,
      terminal_model: nft$terminal_model,
      file_acknowledgement: boolean,
      transmission_block_size: nft$transmit_block_size,
      maximum_file_size: nft$device_file_size,
      maximum_page_length: nft$device_max_page_length,
      page_width: nft$page_width,
      page_length: nft$page_length,
      banner_page_count: nft$banner_page_count,
      banner_highlight_field: nft$banner_highlight_field,
      carriage_control_action: nft$carriage_control_action,
      external_characteristics: array [1 .. 4] of nft$external_characteristics,
      forms_code: array [1 .. 4] of nft$forms_code,
      suppress_carriage_control: nft$suppress_carriage_control,
      code_set: nft$code_set,
      vertical_print_density: nft$vertical_print_density,
      vfu_load_procedure: nft$vfu_load_procedure,
      forms_size: nft$forms_size,
      undefined_fe_action: nft$format_effector_actions,
      unsupported_fe_action: nft$format_effector_actions,
      vfu_load_option: nft$vfu_load_option,
      input_job: nft$input_job,
      btfs_di_protocol_stacks: protocol_stacks_set,
      btfs_di_status: nft$btfs_di_status_codes,
      btfs_di_address: nft$network_address,
      btfs_di_title: nft$btfs_di_title,
      device_timer_activated: boolean,
      timer_start_time: integer,
      number_of_files_requeued: 0 .. 1000,
      outstanding_di_responses: nft$outstanding_di_responses,
      last_unsolicited_msg_length: 0 .. nfc$max_unsolicited_msg_length,
      last_unsolicited_msg: nft$unsolicited_device_msg,
      transparent_mode: boolean,
      ntf_skip_punch_count: nft$ntf_skip_punch_count,
      ntf_logical_line_number: nft$ntf_logical_line_number,
      current_file: ^nft$output_queue_file,
      scfdi_connection: ^nft$connection,
      io_station: ^nft$io_station,
      back_link: ^nft$batch_device,
      link: ^nft$batch_device,
    recend;

  TYPE
    nft$input_job = record
      actual_destination: ost$name,
      requested_destination: ost$name,
      user_job_name: ost$name,
      system_job_name: ost$name,
      input_bytes_transferred: nft$input_job_size,
    recend;

  TYPE
    nft$queue_file_list = record
      queue_file: ^nft$output_queue_file,
      link: ^nft$queue_file_list,
    recend;

  TYPE
    nft$output_queue_file = record
      ios_name: ost$name,
      operator_name: ost$name,
      operator_family: ost$name,
      ios_usage: nft$io_station_usage,
      system_file_name: ost$name,
      system_job_name: ost$name,
      user_file_name: ost$name,
      user_job_name: ost$name,
      user_name: ost$name,
      family_name: ost$name,
      copies: nft$copies,
      device_name: ost$name,
      external_characteristics: nft$external_characteristics,
      file_size: nft$file_size,
      forms_code: nft$forms_code,
      output_data_mode: nft$output_data_mode,
      initial_priority: nft$priority,
      maximum_priority: nft$priority,
      priority_factor: nft$priority_multiplier,
      output_state: nft$file_transfer_state,
      time_stamp: ost$date_time,
      percent_complete: nft$file_position,
      page_width: nft$page_width,
      scfve_connection: ^nft$connection,
      assigned_device: ^nft$batch_device,
      next_scfve_queue: ^nft$output_queue_file,
      prior_scfve_queue: ^nft$output_queue_file,
      back_link: ^nft$output_queue_file,
      link: ^nft$output_queue_file,
      case device_type: nft$device_type of
      = nfc$null_device, nfc$console, nfc$reader =
        ,
      = nfc$printer =
        page_format: nft$page_format,
        page_length: nft$page_length,
        vertical_print_density: nft$file_vertical_print_density,
        vfu_load_procedure: nft$vfu_load_procedure,
      = nfc$punch, nfc$plotter =
        ,
      casend,
    recend;

  TYPE
    nft$connection_kind = (nfc$unknown_connection, nfc$scfdi_connection, nfc$scfve_connection,
      nfc$operator_connection, nfc$scfsve_connection, nfc$ntfve_connection, nfc$ntf_operator_connection);

  TYPE
    nft$connection = record
      file_name: amt$local_file_name,
      id: amt$file_identifier,
      back_link: ^nft$connection,
      link: ^nft$connection,
      peer_address: nat$network_address,
      wait_list_index: integer,
      case kind: nft$connection_kind of
      = nfc$scfdi_connection =
        btfs_di_status: nft$btfs_di_status_codes,
        btfs_di_address: nft$network_address,
        btfs_di_protocol_stacks: protocol_stacks_set,
        btfs_di_title: nft$btfs_di_title,
        btfs_di_advanced_features: nft$btfs_di_advanced_features,
      = nfc$scfve_connection, nfc$ntfve_connection =
        scfve_queue: ^nft$output_queue_file,
        ntf_system_identifier: nft$ntf_system_identifier,
        btf_ve_protocol_stacks: protocol_stacks_set,
        btf_ve_status_received: boolean,
        unreachable_btfs_di_list: ^unreachable_btfs_di,
      = nfc$operator_connection, nfc$ntf_operator_connection =
        user: ost$name,
        family: ost$name,
        ntf_operator_identifier: nft$ntf_system_identifier,
        operating_station: ^nft$io_station,
        accept_messages: boolean,
        prior_ntf_operator: ^nft$connection,
        next_ntf_operator: ^nft$connection,
      = nfc$scfsve_connection =
        ,
      casend,
    recend;

  TYPE
    nft$pointer_kind = (nfc$queue, nfc$io_station, nfc$batch_device, nfc$connection,
          nfc$ntf_acc_remote_system, nfc$ntf_remote_sys_logical_line);

  TYPE
    nft$pointer_list_entry = record
      back_link: ^nft$pointer_list_entry,
      link: ^nft$pointer_list_entry,
      case kind: nft$pointer_kind of
      = nfc$queue =
        queue: ^nft$output_queue_file,
      = nfc$io_station =
        io_station: ^nft$io_station,
      = nfc$batch_device =
        batch_device: ^nft$batch_device,
      = nfc$connection =
        connection: ^nft$connection,
      = nfc$ntf_acc_remote_system =
        ntf_acc_remote_system: ^nft$alias,
      = nfc$ntf_remote_sys_logical_line =
        ntf_remote_system: ^nft$io_station,
        ntf_logical_line_number: nft$ntf_logical_line_number,
      casend,
    recend;

  CONST
    nfc$max_alias_stations = 255;

  TYPE
    nft$title_kind = (nfc$station_title, nfc$alias_title);

  TYPE
    nft$number_of_alias_stations = 0 .. nfc$max_alias_stations,
    nft$alias_kind = (nfc$io_station_alias, nfc$batch_device_alias);

{ If TYPE nft$alias is modified, the following constant must be recalculated.

  CONST
    size_of_nft$alias = 53;

  TYPE
    nft$alias = record
      name: ost$name,
      back_link: ^nft$alias,
      link: ^nft$alias,
      case kind: nft$alias_kind of
      = nfc$io_station_alias =
        queue: ^nft$output_queue_file,
        station_list: ^nft$pointer_list_entry,
        station_title_registered: boolean,
        alias_title_registered: boolean,
        ntf_authority_level: nft$ntf_authority_level,
        ntf_remote_system_type: nft$ntf_remote_system_type,
        ntf_route_back_position: nft$ntf_route_back_position,
      = nfc$batch_device_alias =
        batch_device_pointer_list: ^nft$pointer_list_entry,
      casend,
    recend;

  TYPE
    nft$file_name_validation_result = (nfc$valid_file_name, nfc$duplicate_file_name,
          nfc$system_file_name_error);

  TYPE
    nft$wait_connection_list = array [wait_connection_list_lowest .. * ] of ^nft$connection;

  CONST
    automatic = 'AUTOMATIC                      ',
    long_scfs_timer = 0ffffffff(16),
    nfc$scf_ve_client_name = 'OSA$STATUS_CONTROL_FAC_CLIENT  ',
    nfc$wait_list_limit = 20,
    start_of_scfs_title = 'SCFS$',
    start_of_alias_title = 'SCFA$',
    start_of_title_length = 5,
    unreachable_btfs_di_wait_time = 60 * 1000,
    wait_connection_list_lowest = 3;

  TYPE
    file_status_transition_kind = (no_transition, file_transfer_begun, file_transfer_completed);

  TYPE
    file_acknowledge_msg = record
      message: string (25),
      msg_length: 0 .. 25,
    recend;

  VAR
    file_ack_messages: array [nft$file_transfer_status] of file_acknowledge_msg:=
          [['Finished', 9], ['Device disconnected', 19], ['VFU not loadable', 16],
          ['Transfer error', 14], ['Accounting limit exceded', 25], ['Dropped', 9],
          ['Requeued', 9], ['Held', 9], ['Started', 9], REP 7 OF * ];

  VAR
    ntf_signon_statuses: [READ, STATIC] array [nft$device_status] of string (20) := [REP 11 OF *,
          {nfc$ntf_waiting_signon} 'Waiting for signon',
          {nfc$ntf_signon_initiated} 'Signon initiated',
          {nfc$ntf_signed_on} 'Signed on',
          {nfc$ntf_signon_failed} 'Signon failed',
          {nfc$ntf_signed_off} 'Signed off'];

  VAR
    control_facility_name: ost$name := osc$null_name,
    scfs_event_logging: boolean := FALSE,
    scfs_log_file: ^fst$file_reference := NIL,
    scfs_log_file_identifier: amt$file_identifier,
    scfs_log_sequence: amt$segment_pointer,
    scfs_ntf_title: ^nat$title_pattern := NIL,
    scfs_tables: nft$scfs_tables,
    scfs_title: ^nat$title_pattern := NIL,
    server_name: nat$application_name,
    wait_connection_list_seq: ^SEQ ( * ) := NIL,
    wait_list_seq: ^SEQ ( * ) := NIL;

*copyc nfs$appl_def_segment_variables
*copyc nfv$appl_def_segment_variables
?? TITLE := 'add batch device msg', EJECT ??

{  PURPOSE:
{    This procedure is executed when a request is received from SCF/DI to
{    define a new batch device within an existing I/O station.  The request
{    is processed and a response is sent back to SCF/DI.  If a duplicate
{    device alias is specified, if the station name is not found, or if
{    the device name is a duplicate, a negative response is returned.
{
{    This procedure is also executed when a request is received from SCF/DI to
{    define a new batch stream within an existing NTF remote system.  The
{    request is processed and a response is sent back to SCF/DI.  If the remote
{    system name is not found or if the stream name is a duplicate, a negative
{    response is returned.

  PROCEDURE add_batch_device_msg
    (VAR message: ^nft$message_sequence;
         connection: ^nft$connection;
     VAR msg_length: integer;
     VAR status: ost$status);

    VAR
      accept_add_ios_msg: boolean,
      batch_device: nft$batch_device,
      current_batch_device: ^nft$batch_device,
      device: ^nft$batch_device,
      io_station: ^nft$io_station,
      io_station_found: boolean,
      io_station_name: ost$name,
      message_response: nft$add_bd_responses,
      ntf_logical_line: ^nft$ntf_logical_line;

*copy nft$add_batch_device_message
*copy nft$add_bd_resp_codes

?? NEWTITLE := 'add batch device entry', EJECT ??

{  PURPOSE:
{    This procedure allocates space for a device entry and adds the entry
{    into the device list for the station.

    PROCEDURE add_batch_device_entry
      (    io_station: ^nft$io_station;
       VAR current_bd: ^nft$batch_device,
           bd_entry: nft$batch_device;
       VAR status: ost$status);

      VAR
        alias_index: 1 .. 3,
        new_batch_device: ^nft$batch_device;

      ALLOCATE new_batch_device;
      new_batch_device^ := bd_entry;

      IF io_station^.batch_device_list = NIL THEN
        io_station^.batch_device_list := new_batch_device;
        new_batch_device^.back_link := NIL;
      ELSE
        current_bd := io_station^.batch_device_list;
        WHILE current_bd^.link <> NIL DO
          current_bd := current_bd^.link;
        WHILEND;
        current_bd^.link := new_batch_device;
        new_batch_device^.back_link := current_bd;
      IFEND;

      current_bd := new_batch_device;
      current_bd^.link := NIL;

    PROCEND add_batch_device_entry;
?? TITLE := 'crack add batch device msg', EJECT ??

{  PURPOSE:
{    Determine the parameters and values sent by SCF/DI on the add batch
{    device message and set the attributes in the batch device entry
{    to those.

    PROCEDURE crack_add_batch_device_msg
      (VAR message: ^nft$message_sequence;
       VAR msg_length: integer;
       VAR station_name: ost$name;
       VAR batch_device: nft$batch_device;
       VAR status: ost$status);

      VAR
        ascii_string: ^string ( * <= osc$max_name_size),
        byte_array: ^nft$byte_array,
        banner_page_count: ^nft$banner_page_count,
        banner_highlight_field: ^nft$banner_highlight_field,
        boolean_parameter: ^boolean,
        calculated_page_length: 0 .. 2000,
        carriage_control_action: ^nft$carriage_control_action,
        code_set: ^nft$code_set,
        device_type: ^nft$device_type,
        device_status: ^nft$device_status,
        device_vpd_values: [STATIC] array [nft$vertical_print_density] OF 6..12 :=
             [{nfc$six_only} 6,       {nfc$eight_only} 8,
              {nfc$six_any}  6,       {nfc$eight_any}  8],
        file_ack: ^boolean,
        file_transfer_status: ^nft$file_transfer_status,
        forms_size: ^nft$forms_size,
        maximum_file_size: ^nft$device_file_size,
        maximum_page_length: ^nft$device_max_page_length,
        ntf_logical_line_number: ^nft$ntf_logical_line_number,
        ntf_skip_punch_count: ^nft$ntf_skip_punch_count,
        page_width: ^nft$page_width,
        page_length: ^nft$page_length,
        page_length_specified: boolean,
        parameter: ^nft$add_bd_message_parameter,
        suppress_carriage_control: ^nft$suppress_carriage_control,
        tip_type: ^nft$tip_type,
        transmission_block_size: ^nft$transmit_block_size,
        transparent_mode: ^boolean,
        undefined_fe_action: ^nft$format_effector_actions,
        unsupported_fe_action: ^nft$format_effector_actions,
        value_length: integer,
        vfu_load_option: ^nft$vfu_load_option,
        vertical_print_density: ^nft$vertical_print_density;

      page_length_specified := FALSE;

      NEXT parameter IN message;

      WHILE (parameter <> NIL) AND (parameter^.param <> nfc$null_parameter) AND (msg_length > 0) DO
        msg_length := msg_length - 1;
        IF parameter^.length_indicated THEN
          nfp$get_parameter_value_length (message, msg_length, value_length, status);
          msg_length := msg_length - value_length;
        ELSE
          value_length := 1;
          msg_length := msg_length - 1;
        IFEND;

        CASE parameter^.param OF
        = nfc$io_station_name =
          NEXT ascii_string: [value_length] IN message;
          #translate (osv$lower_to_upper, ascii_string^, station_name);

        = nfc$device_name =
          NEXT ascii_string: [value_length] IN message;
          #translate (osv$lower_to_upper, ascii_string^, batch_device.name);

        = nfc$device_status =
          NEXT device_status IN message;
          batch_device.device_status := device_status^;

        = nfc$file_transfer_status_param =
          NEXT file_transfer_status IN message;
          batch_device.file_transfer_status := file_transfer_status^;

        = nfc$device_alias_1 =
          NEXT ascii_string: [value_length] IN message;
          #translate (osv$lower_to_upper, ascii_string^, batch_device.alias_names [1]);

        = nfc$device_alias_2 =
          NEXT ascii_string: [value_length] IN message;
          #translate (osv$lower_to_upper, ascii_string^, batch_device.alias_names [2]);

        = nfc$device_alias_3 =
          NEXT ascii_string: [value_length] IN message;
          #translate (osv$lower_to_upper, ascii_string^, batch_device.alias_names [3]);

        = nfc$device_type =
          NEXT device_type IN message;
          batch_device.device_type := device_type^;

        = nfc$tip_type =
          NEXT tip_type IN message;
          batch_device.tip_type := tip_type^;

        = nfc$terminal_model =
          NEXT ascii_string: [value_length] IN message;
          #translate (osv$lower_to_upper, ascii_string^, batch_device.terminal_model);

        = nfc$file_acknowledgement =
          NEXT file_ack IN message;
          batch_device.file_acknowledgement := file_ack^;

        = nfc$transmission_block_size =
          NEXT transmission_block_size IN message;
          batch_device.transmission_block_size := transmission_block_size^;

        = nfc$maximum_file_size =
          NEXT maximum_file_size IN message;
          batch_device.maximum_file_size := maximum_file_size^;

        = nfc$page_width =
          NEXT page_width IN message;
          batch_device.page_width := page_width^;

        = nfc$page_length =
          NEXT page_length IN message;
          batch_device.page_length := page_length^;
          page_length_specified := TRUE;

        = nfc$banner_page_count =
          NEXT banner_page_count IN message;
          batch_device.banner_page_count := banner_page_count^;

        = nfc$banner_highlight_field =
          NEXT banner_highlight_field IN message;
          batch_device.banner_highlight_field := banner_highlight_field^;

        = nfc$carriage_control_action =
          NEXT carriage_control_action IN message;
          batch_device.carriage_control_action := carriage_control_action^;

        = nfc$forms_code_1 =
          NEXT ascii_string: [value_length] IN message;
          #translate (osv$lower_to_upper, ascii_string^, batch_device.forms_code [1]);

        = nfc$forms_code_2 =
          NEXT ascii_string: [value_length] IN message;
          #translate (osv$lower_to_upper, ascii_string^, batch_device.forms_code [2]);

        = nfc$forms_code_3 =
          NEXT ascii_string: [value_length] IN message;
          #translate (osv$lower_to_upper, ascii_string^, batch_device.forms_code [3]);

        = nfc$forms_code_4 =
          NEXT ascii_string: [value_length] IN message;
          #translate (osv$lower_to_upper, ascii_string^, batch_device.forms_code [4]);

        = nfc$external_characteristics_1 =
          NEXT ascii_string: [value_length] IN message;
          #translate (osv$lower_to_upper, ascii_string^, batch_device.external_characteristics [1]);

        = nfc$external_characteristics_2 =
          NEXT ascii_string: [value_length] IN message;
          #translate (osv$lower_to_upper, ascii_string^, batch_device.external_characteristics [2]);

        = nfc$external_characteristics_3 =
          NEXT ascii_string: [value_length] IN message;
          #translate (osv$lower_to_upper, ascii_string^, batch_device.external_characteristics [3]);

        = nfc$external_characteristics_4 =
          NEXT ascii_string: [value_length] IN message;
          #translate (osv$lower_to_upper, ascii_string^, batch_device.external_characteristics [4]);

        = nfc$suppress_carriage_control =
          NEXT suppress_carriage_control IN message;
          batch_device.suppress_carriage_control := suppress_carriage_control^;

        = nfc$code_set =
          NEXT code_set IN message;
          batch_device.code_set := code_set^;

        = nfc$vertical_print_density =
          NEXT vertical_print_density IN message;
          batch_device.vertical_print_density := vertical_print_density^;

        = nfc$vfu_load_procedure =
          NEXT ascii_string: [value_length] IN message;
          #translate (osv$lower_to_upper, ascii_string^, batch_device.vfu_load_procedure);

        = nfc$forms_size =
          NEXT forms_size IN message;
          batch_device.forms_size := forms_size^;

        = nfc$undefined_fe_action =
          NEXT undefined_fe_action IN message;
          batch_device.undefined_fe_action := undefined_fe_action^;

        = nfc$unsupported_fe_action =
          NEXT unsupported_fe_action IN message;
          batch_device.unsupported_fe_action := unsupported_fe_action^;

        = nfc$vfu_load_option =
          NEXT vfu_load_option IN message;
          batch_device.vfu_load_option := vfu_load_option^;

        = nfc$device_maximum_page_length =
          NEXT maximum_page_length IN message;
          batch_device.maximum_page_length := maximum_page_length^;

        = nfc$ntf_skip_punch_count =
          NEXT ntf_skip_punch_count IN message;
          batch_device.ntf_skip_punch_count := ntf_skip_punch_count^;

        = nfc$transparent_mode =
          NEXT transparent_mode IN message;
          batch_device.transparent_mode := transparent_mode^;

        = nfc$ntf_logical_line_number =
          NEXT ntf_logical_line_number IN message;
          batch_device.ntf_logical_line_number := ntf_logical_line_number^;

        ELSE
{         ERROR ----   Ignore parameter value.
          NEXT byte_array: [1 .. value_length] IN message;

        CASEND;
        NEXT parameter IN message;
      WHILEND;

{  If the device is a printer and SCF/DI did not send up the page_length,
{  calculate the value based on the forms_size and vertical_print_density.
{  NOTE:  The calculated value may only be used if the value is less
{         than or equal to the maximum value allowed in the current protocol

      IF (batch_device.device_type = nfc$printer) AND (NOT page_length_specified) THEN
        calculated_page_length := (batch_device.forms_size*
              device_vpd_values[batch_device.vertical_print_density]) DIV 2;
        IF calculated_page_length <= nfc$maximum_page_length THEN
          batch_device.page_length := calculated_page_length;
        ELSE
{         use the default value set up at initialization
        IFEND;
      IFEND;

    PROCEND crack_add_batch_device_msg;
?? TITLE := 'duplicate device name found', EJECT ??

{  PURPOSE:
{    This function determines if the device name is already in the
{    specified device list.

    FUNCTION duplicate_device_name_found (device_name: ost$name;
          batch_device_list: ^nft$batch_device): boolean;

      VAR
        current_device: ^nft$batch_device,
        name_match: boolean;

      name_match := FALSE;
      current_device := batch_device_list;

      WHILE NOT name_match AND (current_device <> NIL) DO
        name_match := current_device^.name = device_name;
        IF NOT name_match THEN
          current_device := current_device^.link;
        IFEND;
      WHILEND;

      duplicate_device_name_found := name_match;

    FUNCEND duplicate_device_name_found;
?? TITLE := 'initialize batch device entry', EJECT ??

{  PURPOSE:
{    Initialize the fields in the structure used to contain information about
{    a batch device.  A batch device may be a printer, punch, plotter or a
{    reader.

    PROCEDURE initialize_batch_device_entry
      (VAR batch_device_entry: nft$batch_device);

      batch_device_entry.name := osc$null_name;
      batch_device_entry.device_status := nfc$device_not_ready;
      batch_device_entry.file_transfer_status := nfc$idle;
      batch_device_entry.alias_names [1] := osc$null_name;
      batch_device_entry.alias_names [2] := osc$null_name;
      batch_device_entry.alias_names [3] := osc$null_name;

      batch_device_entry.device_type := nfc$printer;
      batch_device_entry.tip_type := nfc$internal_tip;
      batch_device_entry.terminal_model := osc$null_name;
      batch_device_entry.file_acknowledgement := FALSE;
      batch_device_entry.transmission_block_size := nfc$max_transmit_block_size;

      batch_device_entry.maximum_file_size := nfc$max_file_size;
      batch_device_entry.page_width := nfc$minimum_page_width;
      batch_device_entry.page_length := nfc$maximum_page_length;
      batch_device_entry.maximum_page_length := nfc$device_max_page_length;
      batch_device_entry.banner_page_count := 1;
      batch_device_entry.banner_highlight_field := nfc$user_name;
      batch_device_entry.carriage_control_action := nfc$pre_print;

      batch_device_entry.forms_code [1] := 'NORMAL';
      batch_device_entry.forms_code [2] := '      ';
      batch_device_entry.forms_code [3] := '      ';
      batch_device_entry.forms_code [4] := '      ';

      batch_device_entry.external_characteristics [1] := 'NORMAL';
      batch_device_entry.external_characteristics [2] := '      ';
      batch_device_entry.external_characteristics [3] := '      ';
      batch_device_entry.external_characteristics [4] := '      ';

      batch_device_entry.suppress_carriage_control := FALSE;
      batch_device_entry.code_set := nfc$ascii;
      batch_device_entry.vertical_print_density := nfc$six_only;
      batch_device_entry.vfu_load_procedure := osc$null_name;

{ forms size is specified in multiples of 1/2 - so 22 stands for an 11 inch form

      batch_device_entry.forms_size := 22;
      batch_device_entry.undefined_fe_action := nfc$print_after_spacing;
      batch_device_entry.unsupported_fe_action := nfc$discard_print_line;
      batch_device_entry.vfu_load_option := nfc$vfu_not_present_or_load;
      batch_device_entry.last_unsolicited_msg_length := 0;
      batch_device_entry.last_unsolicited_msg := '';

      batch_device_entry.input_job.actual_destination := osc$null_name;
      batch_device_entry.input_job.requested_destination := osc$null_name;
      batch_device_entry.input_job.user_job_name := osc$null_name;
      batch_device_entry.input_job.system_job_name := osc$null_name;
      batch_device_entry.input_job.input_bytes_transferred := 0;

      batch_device_entry.device_timer_activated := FALSE;
      batch_device_entry.timer_start_time := 0;
      batch_device_entry.number_of_files_requeued := 0;

      batch_device_entry.ntf_skip_punch_count := 1;
      batch_device_entry.transparent_mode := TRUE;
      batch_device_entry.ntf_logical_line_number := 1;

      batch_device_entry.current_file := NIL;
      batch_device_entry.scfdi_connection := NIL;
      batch_device_entry.io_station := NIL;
      batch_device_entry.back_link := NIL;
      batch_device_entry.link := NIL;

      batch_device_entry.outstanding_di_responses [nfc$start_bd] := 0;
      batch_device_entry.outstanding_di_responses [nfc$stop_bd] := 0;
      batch_device_entry.outstanding_di_responses [nfc$change_bd_attr] := 0;
      batch_device_entry.outstanding_di_responses [nfc$suppress_cc] := 0;
      batch_device_entry.outstanding_di_responses [nfc$terminate_xfer] := 0;
      batch_device_entry.outstanding_di_responses [nfc$position_file] := 0;

    PROCEND initialize_batch_device_entry;
?? TITLE := 'send add bd response', EJECT ??

{  PURPOSE:
{    Build and send a message to SCF/DI containing SCFS's response
{    to the add batch device message.

    PROCEDURE send_add_bd_response
      (VAR message: ^nft$message_sequence;
           io_station_name: ost$name;
           device_name: ost$name;
           response_code: nft$add_bd_responses;
           connection: ^nft$connection;
       VAR status: ost$status);

      VAR
        ascii_string: ^string ( * <= osc$max_name_size),
        message_length: nft$message_length,
        message_type: ^nft$message_kind,
        parameter_kind: ^nft$add_del_bd_resp_parameter,
        parameter_kind_size: nft$message_length,
        param_length_size: nft$message_length,
        parameter_value_length: integer,
        response_param: ^nft$add_bd_responses;

*copy nft$add_del_device_response

      parameter_kind_size := #SIZE (nft$add_del_bd_resp_parameter);
      RESET message;

      NEXT message_type IN message;
      message_type^ := nfc$add_batch_device_resp;
      message_length := 1;

      NEXT parameter_kind IN message;
      parameter_kind^.param := nfc$io_station_name;
      parameter_value_length := clp$trimmed_string_size (io_station_name);
      nfp$modify_param_value_length (parameter_value_length);
      parameter_kind^.length_indicated := parameter_value_length > 1;
      IF parameter_kind^.length_indicated THEN
        nfp$put_parameter_value_length (parameter_value_length, message, param_length_size, status);
      ELSE
        param_length_size := 0;
      IFEND;
      NEXT ascii_string: [parameter_value_length] IN message;
      ascii_string^ := io_station_name (1, parameter_value_length);
      message_length := message_length + parameter_kind_size + param_length_size + parameter_value_length;

      NEXT parameter_kind IN message;
      parameter_kind^.param := nfc$device_name;
      parameter_value_length := clp$trimmed_string_size (device_name);
      nfp$modify_param_value_length (parameter_value_length);
      parameter_kind^.length_indicated := parameter_value_length > 1;
      IF parameter_kind^.length_indicated THEN
        nfp$put_parameter_value_length (parameter_value_length, message, param_length_size, status);
      ELSE
        param_length_size := 0;
      IFEND;
      NEXT ascii_string: [parameter_value_length] IN message;
      ascii_string^ := device_name (1, parameter_value_length);
      message_length := message_length + parameter_kind_size + param_length_size + parameter_value_length;

      NEXT parameter_kind IN message;
      parameter_kind^.length_indicated := FALSE;
      parameter_kind^.param := nfc$response_code;
      NEXT response_param IN message;
      response_param^ := response_code;
      message_length := message_length + parameter_kind_size + 1;

      nfp$send_message_on_connection (message, message_length, connection^.id, status);
      IF scfs_event_logging THEN
        log_connection_message (connection^, message_length, message);
      IFEND;

    PROCEND send_add_bd_response;
?? OLDTITLE, EJECT ??

{  Initialize the batch device.  Determine the attribute values sent up on
{  the add batch device message, and put these values into the batch device
{  entry.

    initialize_batch_device_entry (batch_device);
    crack_add_batch_device_msg (message, msg_length, io_station_name, batch_device, status);

    message_response := nfc$message_accepted;

    IF duplicate_aliases (batch_device.alias_names) THEN
      message_response := nfc$duplicate_aliases_specified;
    ELSE
      find_io_station_or_remote_sys (io_station_name, connection, io_station, io_station_found);
      IF io_station_found AND (io_station^.usage = nfc$ntf_remote_system) THEN
        find_ntf_logical_line (batch_device.ntf_logical_line_number, io_station,
              ntf_logical_line, io_station_found);
      IFEND;

      IF io_station_found THEN
        IF duplicate_device_name_found (batch_device.name, io_station^.batch_device_list) THEN
          message_response := nfc$duplicate_device_name;
        ELSE

{  The add batch device message from SCF/DI will be accepted.  Update the
{  device information.

          batch_device.scfdi_connection := connection;
          batch_device.io_station := io_station;
          batch_device.btfs_di_status := connection^.btfs_di_status;
          batch_device.btfs_di_address := connection^.btfs_di_address;
          batch_device.btfs_di_protocol_stacks := connection^.btfs_di_protocol_stacks;
          batch_device.btfs_di_title := connection^.btfs_di_title;
          IF (io_station^.usage = nfc$ntf_remote_system) AND (batch_device.device_type = nfc$console)
                THEN
            ntf_logical_line^.signon_status := batch_device.device_status;
            ntf_logical_line^.console_stream_name := batch_device.name;
          IFEND;

          add_batch_device_entry (io_station, current_batch_device, batch_device, status);

{  If the device is an NTF console just signing in, check for files queued
{  for all known streams for this remote system.
{
{  If the device is an output device and the station is operational, find a
{  file to print at the device.
{
{  If the device is an NTF transmit stream and the the remote system is
{  operational, find a file to transfer on the stream.

          IF (io_station^.usage = nfc$ntf_remote_system) AND (batch_device.device_type = nfc$console) AND
                (ntf_logical_line^.signon_status = nfc$ntf_signed_on) AND
                (io_station^.batch_device_list <> NIL) THEN
            device := io_station^.batch_device_list;
            WHILE device <> NIL DO
              IF device_available_for_output (device) THEN
                find_file_for_device (device, message, status);
              IFEND;
              device := device^.link;
            WHILEND;
          ELSEIF (io_station^.station_operational) AND output_device_or_stream (^batch_device)
                AND (device_available_for_output (current_batch_device)) THEN
            find_file_for_device (current_batch_device, message, status);
          IFEND;
        IFEND;
      ELSE
        message_response := nfc$no_io_station_found;
      IFEND;
    IFEND;

{  Send the response to SCF/DI.

    send_add_bd_response (message, io_station_name, batch_device.name, message_response, connection, status);

  PROCEND add_batch_device_msg;
?? TITLE := 'add file availability msg', EJECT ??

{  PURPOSE:
{    This procedure is executed when a message is received from SCF/VE
{    requesting SCFS to add an output file entry to the output queue for
{    scheduling.  If the requested destination is known, the output file
{    is placed in the appropriate station queue.   If the destination is not
{    known to SCFS, the message is ignored.
{
{    This procedure is also executed when a message is received from NTF/VE
{    requesting SCFS to add an NTF file entry to the NTF queue for scheduling.
{    If the requested destination is known, the NTF file is placed in the
{    appropriate remote system queue.  If the destination is not known to SCFS,
{    the message is ignored.

  PROCEDURE add_file_availability_msg
    (VAR message: ^nft$message_sequence;
         connection: ^nft$connection;
     VAR msg_length: integer;
     VAR status: ost$status);

    VAR
      alias_station_list: ^nft$pointer_list_entry,
      io_station: ^nft$io_station,
      new_file: nft$output_queue_file,
      q_found: boolean,
      queue_file: ^nft$output_queue_file,
      queue_pointer: ^^nft$output_queue_file;

*copy nft$file_availability_msg
?? NEWTITLE := 'add file to output queue', EJECT ??

{  PURPOSE:
{    This procedure allocates space for an output queue file entry and then
{    adds the new entry into the queue file list, which is a double-linked
{    list.

    PROCEDURE add_file_to_output_queue
      (    new_file: nft$output_queue_file;
       VAR q_list: ^^nft$output_queue_file;
       VAR queue_file: ^nft$output_queue_file;
       VAR status: ost$status);

      VAR
        new_q_file: ^nft$output_queue_file;

      ALLOCATE new_q_file;
      new_q_file^ := new_file;

      queue_file := q_list^;
      IF queue_file = NIL THEN
        q_list^ := new_q_file;
        new_q_file^.back_link := NIL;
      ELSE
        WHILE queue_file^.link <> NIL DO
          queue_file := queue_file^.link;
        WHILEND;
        queue_file^.link := new_q_file;
        new_q_file^.back_link := queue_file;
      IFEND;

      queue_file := new_q_file;

    PROCEND add_file_to_output_queue;
?? TITLE := 'add file to scfve queue', EJECT ??

{  PURPOSE:
{    This procedure links the output queue file into the SCF/VE queue.
{    The queue is determined by the connection the file availability
{    message came in on.

    PROCEDURE add_file_to_scfve_queue
      (    q_file: ^nft$output_queue_file;
           connection: ^nft$connection);

      VAR
        scfve_q_file: ^nft$output_queue_file;

      IF connection^.scfve_queue = NIL THEN
        connection^.scfve_queue := q_file;
        q_file^.prior_scfve_queue := NIL;
      ELSE
        scfve_q_file := connection^.scfve_queue;
        WHILE scfve_q_file^.next_scfve_queue <> NIL DO
          scfve_q_file := scfve_q_file^.next_scfve_queue;
        WHILEND;
        scfve_q_file^.next_scfve_queue := q_file;
        q_file^.prior_scfve_queue := scfve_q_file;
      IFEND;

    PROCEND add_file_to_scfve_queue;
?? TITLE := 'crack add file available msg', EJECT ??

{  PURPOSE:
{    Determine the parameters and values sent by SCF/VE on the file availability
{    message and set the output queue file attributes to those values.

    PROCEDURE crack_add_file_available_msg
      (VAR message: ^nft$message_sequence;
       VAR msg_length: integer;
       VAR queue_entry: nft$output_queue_file;
       VAR status: ost$status);

      VAR
        ascii_string: ^string ( * <= osc$max_name_size),
        byte_array: ^nft$byte_array,
        copies: ^nft$copies,
        device_type: ^nft$device_type,
        device_status: ^nft$device_status,
        file_size: ^nft$file_size,
        io_station_usage: ^nft$io_station_usage,
        output_data_mode: ^nft$output_data_mode,
        output_state: ^nft$file_transfer_state,
        page_format: ^amt$page_format,
        page_length: ^nft$page_length,
        page_width: ^nft$page_width,
        parameter: ^nft$file_available_msg_param,
        priority: ^nft$priority,
        priority_factor: ^nft$priority_multiplier,
        value_length: integer,
        vertical_print_density: ^nft$file_vertical_print_density;

      NEXT parameter IN message;

      WHILE (parameter <> NIL) AND (parameter^.param <> nfc$null_parameter) AND (msg_length > 0) DO
        msg_length := msg_length - 1;
        IF parameter^.length_indicated THEN
          nfp$get_parameter_value_length (message, msg_length, value_length, status);
          msg_length := msg_length - value_length;
        ELSE
          value_length := 1;
          msg_length := msg_length - 1;
        IFEND;

        CASE parameter^.param OF
        = nfc$copies =
          NEXT copies IN message;
          queue_entry.copies := copies^;

        = nfc$device_name =
          NEXT ascii_string: [value_length] IN message;
          #translate (osv$lower_to_upper, ascii_string^, queue_entry.device_name);

        = nfc$device_type =
          NEXT device_type IN message;
          queue_entry.device_type := device_type^;

        = nfc$external_characteristics =
          NEXT ascii_string: [value_length] IN message;
          #translate (osv$lower_to_upper, ascii_string^, queue_entry.external_characteristics);

        = nfc$file_size =
          NEXT file_size IN message;
          queue_entry.file_size := file_size^;

        = nfc$forms_code =
          NEXT ascii_string: [value_length] IN message;
          #translate (osv$lower_to_upper, ascii_string^, queue_entry.forms_code);

        = nfc$output_data_mode =
          NEXT output_data_mode IN message;
          queue_entry.output_data_mode := output_data_mode^;

        = nfc$output_initial_priority =
          NEXT priority IN message;
          queue_entry.initial_priority := priority^;

        = nfc$output_maximum_priority =
          NEXT priority IN message;
          queue_entry.maximum_priority := priority^;

        = nfc$output_priority_factor =
          NEXT priority_factor IN message;
          queue_entry.priority_factor := priority_factor^;

        = nfc$output_state =
          NEXT output_state IN message;
          queue_entry.output_state := output_state^;

        = nfc$page_format =
          NEXT page_format IN message;
          queue_entry.page_format := page_format^;

        = nfc$page_length =
          NEXT page_length IN message;
          queue_entry.page_length := page_length^;

        = nfc$page_width =
          NEXT page_width IN message;
          queue_entry.page_width := page_width^;

        = nfc$vertical_print_density =
          NEXT vertical_print_density IN message;
          queue_entry.vertical_print_density := vertical_print_density^;

        = nfc$vfu_load_procedure =
          NEXT ascii_string: [value_length] IN message;
          #translate (osv$lower_to_upper, ascii_string^, queue_entry.vfu_load_procedure);

        ELSE
{         ERROR  ----   Ignore parameter value.
          NEXT byte_array: [1 .. value_length] IN message;

        CASEND;
        NEXT parameter IN message;
      WHILEND;

    PROCEND crack_add_file_available_msg;
?? TITLE := 'initialize output queue entry', EJECT ??

    PROCEDURE initialize_output_queue_entry
      (VAR queue_entry: nft$output_queue_file);

      queue_entry.ios_name := osc$null_name;
      queue_entry.operator_name := osc$null_name;
      queue_entry.operator_family := osc$null_name;
      queue_entry.ios_usage := nfc$public_io_station;

      queue_entry.system_file_name := osc$null_name;
      queue_entry.system_job_name := osc$null_name;
      queue_entry.user_file_name := osc$null_name;
      queue_entry.user_job_name := osc$null_name;

      queue_entry.copies := 1;
      queue_entry.device_name := osc$null_name;
      queue_entry.external_characteristics := '';
      queue_entry.file_size := 0;
      queue_entry.forms_code := '';

      queue_entry.output_data_mode := nfc$coded_mode;
      queue_entry.initial_priority := 0;
      queue_entry.maximum_priority := 0;
      queue_entry.output_state := nfc$eligible_for_transfer;

      queue_entry.assigned_device := NIL;
      queue_entry.next_scfve_queue := NIL;
      queue_entry.prior_scfve_queue := NIL;
      queue_entry.back_link := NIL;
      queue_entry.link := NIL;

      queue_entry.device_type := nfc$printer;
      queue_entry.page_format := amc$burstable_form;
      queue_entry.page_length := nfc$maximum_page_length;
      queue_entry.page_width := nfc$maximum_page_width;
      queue_entry.vertical_print_density := nfc$vertical_print_density_none;
      queue_entry.vfu_load_procedure := osc$null_name;

    PROCEND initialize_output_queue_entry;
?? OLDTITLE, EJECT ??

    initialize_output_queue_entry (new_file);

    get_required_file_avail_params (message, msg_length, new_file, status);
    crack_add_file_available_msg (message, msg_length, new_file, status);

    pmp$get_compact_date_time (new_file.time_stamp, status);
    new_file.percent_complete := 0;
    new_file.scfve_connection := connection;

    q_found := FALSE;
    queue_pointer := NIL;
    IF new_file.ios_usage = nfc$public_io_station THEN
      find_public_queue (new_file.ios_name, queue_pointer, alias_station_list, q_found);

      IF q_found THEN
{       Check the first I/O station in the alias station list to see if it is a public station.
        io_station := alias_station_list^.io_station;
        q_found := io_station^.usage = nfc$public_io_station;
      IFEND;

{  A file sent to print at a private station must specify the "control facility"
{  for the station attribute.

    ELSEIF (new_file.ios_usage = nfc$private_io_station) AND (new_file.ios_name = control_facility_name) THEN
      find_private_queue (new_file.operator_name, new_file.operator_family, queue_pointer,
            alias_station_list, q_found);
      IF NOT q_found THEN
        q_found := NOT q_found;
        queue_pointer := ^scfs_tables.unknown_private_operators_q;
      IFEND;

    ELSEIF new_file.ios_usage = nfc$ntf_remote_system THEN
      find_ntf_remote_queue (new_file.ios_name, queue_pointer, alias_station_list);
      q_found := (queue_pointer <> NIL);
    IFEND;

    IF q_found THEN
      add_file_to_output_queue (new_file, queue_pointer, queue_file, status);

      add_file_to_scfve_queue (queue_file, connection);

      IF (queue_pointer <> ^scfs_tables.unknown_private_operators_q) AND
            (queue_file^.output_state = nfc$eligible_for_transfer) THEN
        output_file_assignment (queue_file, alias_station_list, message, connection, status);
      IFEND;
    IFEND;

  PROCEND add_file_availability_msg;
?? TITLE := 'add io station msg', EJECT ??

{  PURPOSE:
{    This procedure is executed when a request is received from SCF/DI to
{    define a new I/O station under control of this SCFS/VE copy.  The I/O
{    station name is checked against all I/O station definitions currently
{    known to SCFS/VE.  If it is a new station name, the definition is done.
{    If the station name already exists, a test is done on the "check io station
{    unique" parameter.  If this parameter is TRUE the definition is rejected.
{    If this parameter is FALSE, the definition is accepted if the existing
{    definition is found to be identical, and the current definition also has
{    "check io station unique" set to FALSE.  A response is sent back to
{    SCF/DI.
{
{    A negative response is also returned if the requested I/O station name or
{    alias conflicts with the name of an existing NTF remote system.

  PROCEDURE add_io_station_msg
    (VAR message: ^nft$message_sequence;
         connection: ^nft$connection;
     VAR msg_length: integer;
     VAR wait_list: ^ost$i_wait_list;
     VAR wait_connection_list: ^nft$wait_connection_list;
     VAR status: ost$status);

    VAR
      alias_index: 1 .. 4,
      current_ios: ^nft$io_station,
      io_station: nft$io_station,
      last_ios: ^nft$io_station,
      message_response: nft$add_io_station_responses,
      ntf_acc_remote_system: ^nft$alias,
      operator_connection: ^nft$connection,
      operator_name: ost$name,
      station_found: boolean;

*copy nft$add_io_station_message
*copy nft$add_ios_resp_codes

?? NEWTITLE := 'add io station entry to table', EJECT ??

{  PURPOSE:
{    This procedure adds the I/O station entry to the SCFS tables.
{    The station entry is added to the I/O station list, to the
{    "station name-alias list" and to the station list(s) that
{    the station name-alias entries point to.
{  NOTE:
{    This routine assumes that LAST_IO_STATION^ is the last io station defined
{    in the list.  A new ios definition will be added to the end.

    PROCEDURE add_io_station_entry_to_table
      (VAR last_io_station: ^nft$io_station;
           new_ios_def: nft$io_station;
       VAR status: ost$status);

      VAR
        alias_found: boolean,
        alias_index: 1 .. 3,
        current_alias: ^nft$alias,
        new_io_station: ^nft$io_station,
        trailing_alias: ^nft$alias;

?? NEWTITLE := 'add ios to alias station list', EJECT ??

{  PURPOSE:
{    This procedure adds an entry to the station list that the station alias
{    name entries point to.

      PROCEDURE add_ios_to_alias_station_list
        (    alias_pt: ^nft$alias;
             current_ios: ^nft$io_station;
         VAR status: ost$status);

        VAR
          alias_station: ^nft$pointer_list_entry,
          trailing_alias: ^nft$pointer_list_entry;

        alias_station := alias_pt^.station_list;

        IF alias_station <> NIL THEN
          REPEAT
            IF alias_station^.io_station = current_ios THEN
              RETURN;
            IFEND;
            trailing_alias := alias_station;
            IF alias_station^.link <> NIL THEN
              alias_station := alias_station^.link;
            IFEND;
          UNTIL trailing_alias^.link = NIL;
        IFEND;

        add_pointer_list_entry (alias_station, nfc$io_station, status);
        IF alias_pt^.station_list = NIL THEN
          alias_pt^.station_list := alias_station;
        IFEND;

        alias_station^.io_station := current_ios;

      PROCEND add_ios_to_alias_station_list;
?? TITLE := 'add to station aliases', EJECT ??

{  PURPOSE:
{    This procedure adds an alias entry to the station name-alias list.  The
{    station alias list has an entry for each station value known to the
{    control facility (station names and alias station names).  Each
{    station alias entry has an output queue file list and an I/O
{    station list.  The station list contains a pointer to the station with
{    that name and to each station with a station alias of that name.
{  eg.  station name:   station1
{       aliases for station1:   station2, station3
{
{       station name:   station2
{       aliases for station2:   station3
{
{       station name:   station3
{       (no aliases defined for station3)
{
{  FIRST_STATION
{  NAME_ALIAS
{      |
{      |                      (each unit is a "pointer list entry")
{      |
{  name: station1            back link       back link      back link
{  back link           +---- link      ----- link      ---- link
{  link                |     ^ station1      ^station2      ^station3
{  station list -------+
{  queue list-------+
{      |            +--- list of queue files with destination of station1
{      |
{      |
{      |
{  name: station2            back link       back link
{  back link           +---- link      ----- link
{  link                |     ^ station2      ^station3
{  station list -------+
{  queue list-------+
{      |            +--- list of queue files with destination of station2
{      |
{      |
{      |
{  name: station3            back link
{  back link           +---- link
{  link                |     ^ station3
{  station list -------+
{  queue list-------+
{                   +---- list of queue files with destination of station3
{

      PROCEDURE add_to_station_aliases
        (    io_station_name: ost$name;
         VAR current_alias: ^nft$alias;
         VAR status: ost$status);

        VAR
          alias_found: boolean,
          trailing_alias: ^nft$alias;

        alias_found := FALSE;

        current_alias := scfs_tables.first_station_name_alias;
        trailing_alias := current_alias;

        IF (current_alias <> NIL) THEN
        /search_alias_list/
          REPEAT
            IF (current_alias^.name = io_station_name) THEN
              alias_found := TRUE;
            ELSE
              trailing_alias := current_alias;
              IF current_alias^.link <> NIL THEN
                current_alias := current_alias^.link;
              IFEND;
            IFEND;
          UNTIL alias_found OR (trailing_alias^.link = NIL);
        IFEND;

        IF NOT alias_found THEN
          add_new_alias_to_list (current_alias, io_station_name, nfc$io_station_alias, status);
        IFEND;

      PROCEND add_to_station_aliases;
?? OLDTITLE, EJECT ??

      ALLOCATE new_io_station;
      new_io_station^ := new_ios_def;

      IF scfs_tables.first_io_station = NIL THEN
        scfs_tables.first_io_station := new_io_station;
        new_io_station^.back_link := NIL;
      ELSE
        last_io_station^.link := new_io_station;
        new_io_station^.back_link := last_io_station;
      IFEND;

      last_io_station := new_io_station;
      last_io_station^.link := NIL;

{     The io station alias list is really a list of station and alias names.
      add_to_station_aliases (new_ios_def.name, current_alias, status);
      add_ios_to_alias_station_list (current_alias, last_io_station, status);

      IF scfs_tables.first_station_name_alias = NIL THEN
        scfs_tables.first_station_name_alias := current_alias;
      IFEND;

      last_io_station^.alias_list [0] := current_alias;

      FOR alias_index := 1 TO 3 DO
        IF (last_io_station^.alias_names [alias_index] <> osc$null_name) AND
              (last_io_station^.alias_names [alias_index] <> new_ios_def.name) THEN

{ Only add a station alias if the name is not null and is different from the name of the station.

          current_alias := scfs_tables.first_station_name_alias;
          trailing_alias := current_alias;
          alias_found := FALSE;

          IF (current_alias <> NIL) THEN
          /search_alias_list/
            REPEAT
              IF current_alias^.name = new_ios_def.alias_names [alias_index] THEN
                add_ios_to_alias_station_list (current_alias, last_io_station, status);
                alias_found := TRUE;
              ELSE
                trailing_alias := current_alias;
                IF current_alias^.link <> NIL THEN
                  current_alias := current_alias^.link;
                IFEND;
              IFEND;
            UNTIL alias_found OR (trailing_alias^.link = NIL);
          IFEND;

          IF NOT alias_found THEN
            add_new_alias_to_list (current_alias, new_ios_def.alias_names [alias_index], nfc$io_station_alias,
                   status);
            add_ios_to_alias_station_list (current_alias, last_io_station, status);
          IFEND;
          last_io_station^.alias_list [alias_index] := current_alias;
        IFEND;
      FOREND;

    PROCEND add_io_station_entry_to_table;
?? TITLE := 'add scf di connection', EJECT ??

{  PURPOSE:
{    Add the current SCF/DI connection to the list of SCF/DI connections
{    known for the I/O station.
{  NOTE:  An I/O station may be defined across multiple DI's, so a list
{    of the SCF/DI connections for a particular station must be maintained.

    PROCEDURE add_scf_di_connection
      (    io_station: ^nft$io_station;
           connection: ^nft$connection;
       VAR status: ost$status);

      VAR
        last_connect_pt: ^nft$pointer_list_entry;

      last_connect_pt := io_station^.scfdi_connection_pointers;

      IF io_station^.scfdi_connection_pointers <> NIL THEN
        WHILE last_connect_pt^.link <> NIL DO
          last_connect_pt := last_connect_pt^.link;
        WHILEND;
      IFEND;

{     Add pointer list entry for the connection pointer.
      add_pointer_list_entry (last_connect_pt, nfc$connection, status);

      last_connect_pt^.connection := connection;

      IF io_station^.scfdi_connection_pointers = NIL THEN
        io_station^.scfdi_connection_pointers := last_connect_pt;
      IFEND;

    PROCEND add_scf_di_connection;
?? TITLE := 'crack add io station msg', EJECT ??

{  PURPOSE:
{    Determine the parameters and values sent by SCF/DI on the add io station
{    message and set the I/O station attributes to those values.

    PROCEDURE crack_add_io_station_msg
      (VAR message: ^nft$message_sequence;
       VAR msg_length: integer;
       VAR io_station: nft$io_station;
       VAR status: ost$status);

      VAR
        ascii_string: ^string ( * <= osc$max_name_size),
        byte_array: ^nft$byte_array,
        boolean_parameter: ^boolean,
        destination_unavail_action: ^nft$destination_unavail_actions,
        file_ack: ^boolean,
        io_station_usage_param: ^nft$io_station_usage,
        parameter: ^nft$add_ios_message_parameter,
        pm_message_action: ^nft$pm_message_actions,
        value_length: integer;

      NEXT parameter IN message;

      WHILE (parameter <> NIL) AND (parameter^.param <> nfc$null_parameter) AND (msg_length > 0) DO
        msg_length := msg_length - 1;
        IF parameter^.length_indicated THEN
          nfp$get_parameter_value_length (message, msg_length, value_length, status);
          msg_length := msg_length - value_length;
        ELSE
          value_length := 1;
          msg_length := msg_length - 1;
        IFEND;

        CASE parameter^.param OF
        = nfc$io_station_name =
          NEXT ascii_string: [value_length] IN message;
          #translate (osv$lower_to_upper, ascii_string^, io_station.name);

        = nfc$io_station_alias_1 =
          NEXT ascii_string: [value_length] IN message;
          #translate (osv$lower_to_upper, ascii_string^, io_station.alias_names [1]);

        = nfc$io_station_alias_2 =
          NEXT ascii_string: [value_length] IN message;
          #translate (osv$lower_to_upper, ascii_string^, io_station.alias_names [2]);

        = nfc$io_station_alias_3 =
          NEXT ascii_string: [value_length] IN message;
          #translate (osv$lower_to_upper, ascii_string^, io_station.alias_names [3]);

        = nfc$required_operator_device =
          NEXT ascii_string: [value_length] IN message;
          #translate (osv$lower_to_upper, ascii_string^, io_station.required_operator_device);

        = nfc$station_usage =
          NEXT io_station_usage_param IN message;
          io_station.usage := io_station_usage_param^;

        = nfc$file_acknowledgement =
          NEXT file_ack IN message;
          io_station.file_acknowledgement := file_ack^;

        = nfc$check_station_unique =
          NEXT boolean_parameter IN message;
          io_station.check_ios_unique := boolean_parameter^;

        = nfc$auto_operator_control =
          NEXT boolean_parameter IN message;
          io_station.automatic_operator_control := boolean_parameter^;

        = nfc$default_job_destination =
          NEXT ascii_string: [value_length] IN message;
          #translate (osv$lower_to_upper, ascii_string^, io_station.default_job_destination);

        = nfc$destination_unavail_action =
          NEXT destination_unavail_action IN message;
          io_station.destination_unavailable_action := destination_unavail_action^;

        = nfc$pm_message_action =
          NEXT pm_message_action IN message;
          io_station.pm_message_action := pm_message_action^;

        ELSE
{         ERROR ----   Ignore parameter value.
          NEXT byte_array: [1 .. value_length] IN message;

        CASEND;
        NEXT parameter IN message;
      WHILEND;

    PROCEND crack_add_io_station_msg;
?? TITLE := 'io station match', EJECT ??

{  PURPOSE:
{    This function is used to determine if an I/O station definition with the
{    same station name as an existing station definition is valid.

    FUNCTION io_station_match (existing_io_station,
          new_io_station: nft$io_station): boolean;

      io_station_match :=

      (existing_io_station.alias_names [1] = new_io_station.alias_names [1]) AND

      (existing_io_station.alias_names [2] = new_io_station.alias_names [2]) AND

      (existing_io_station.alias_names [3] = new_io_station.alias_names [3]) AND

      (existing_io_station.check_ios_unique = new_io_station.check_ios_unique) AND

      (existing_io_station.required_operator_device = new_io_station.required_operator_device) AND

      (existing_io_station.usage = new_io_station.usage);

    FUNCEND io_station_match;
?? TITLE := 'get operator name', EJECT ??

    PROCEDURE get_operator_name
      (    station: ^nft$io_station;
       VAR operator_name: ost$name);

      VAR
        connection: ^nft$connection;

      IF station^.operator_assigned THEN
        connection := station^.connected_operator;
        operator_name := connection^.user;
      ELSE
        operator_name := osc$null_name;
      IFEND;

    PROCEND get_operator_name;
?? TITLE := 'register station alias titles', EJECT ??

{  PURPOSE:
{    Register the station name from the I/O station definition if the title
{    is not currently registered on the network.  Register the alias name if
{    SCFS/VE has not already done so.
{  NOTE:
{    The same destination may be known to two different control facilities.
{    Each one will register the title and a different network address will be
{    associated with each destination.

    PROCEDURE register_station_alias_titles
      (    io_station: ^nft$io_station;
       VAR message_response: nft$add_io_station_responses;
       VAR status: ost$status);

      VAR
        alias_pt: ^nft$alias,
        title: ^nat$title_pattern;

{  Register the station title on the network if it isn't currently known
{  on the network, and register the alias title if this SCFS hasn't already
{  done so.

      alias_pt := scfs_tables.first_station_name_alias;
      WHILE alias_pt <> NIL DO
        IF (io_station^.name = alias_pt^.name) THEN
          IF NOT alias_pt^.station_title_registered THEN
            register_new_title (alias_pt^.name, FALSE, status);
            IF NOT status.normal THEN
              message_response := nfc$not_unique_network_title;
            ELSE
              alias_pt^.station_title_registered := TRUE;
            IFEND;
          IFEND;
        ELSEIF (io_station^.alias_names [1] = alias_pt^.name) OR
              (io_station^.alias_names [2] = alias_pt^.name) OR
              (io_station^.alias_names [3] = alias_pt^.name) THEN
          IF NOT alias_pt^.alias_title_registered THEN
            PUSH title: [start_of_title_length + osc$max_name_size];
            title^ (1, start_of_title_length) := start_of_alias_title;
            title^ (1 + start_of_title_length, *) := alias_pt^.name;
            register_title (title^, status);
            IF status.normal THEN
              alias_pt^.alias_title_registered := TRUE;
            IFEND;
          IFEND;
        IFEND;

        alias_pt := alias_pt^.link;
      WHILEND;

    PROCEND register_station_alias_titles;
?? TITLE := 'send add io station response', EJECT ??

{  PURPOSE:
{    Build and send a message indicating SCFS's response to an
{    add io station message received from SCF/DI.

    PROCEDURE send_add_io_station_response
      (VAR message: ^nft$message_sequence;
           response_code: nft$add_io_station_responses;
           station_name: ost$name;
           connection: ^nft$connection;
       VAR status: ost$status);

      VAR
        ascii_string: ^string ( * <= osc$max_name_size),
        message_length: nft$message_length,
        message_type: ^nft$message_kind,
        parameter_kind: ^nft$add_ios_resp_msg_parameter,
        parameter_kind_size: nft$message_length,
        param_length_size: nft$message_length,
        parameter_value_length: integer,
        response_param: ^nft$add_io_station_responses;

*copy nft$add_io_station_response

      parameter_kind_size := #SIZE (nft$add_ios_resp_msg_parameter);
      RESET message;

      NEXT message_type IN message;
      message_type^ := nfc$add_io_station_resp;
      message_length := 1;

      NEXT parameter_kind IN message;
      parameter_kind^.param := nfc$io_station_name;
      parameter_value_length := clp$trimmed_string_size (station_name);
      nfp$modify_param_value_length (parameter_value_length);
      parameter_kind^.length_indicated := parameter_value_length > 1;
      IF parameter_kind^.length_indicated THEN
        nfp$put_parameter_value_length (parameter_value_length, message, param_length_size, status);
      ELSE
        param_length_size := 0;
      IFEND;
      NEXT ascii_string: [parameter_value_length] IN message;
      ascii_string^ := station_name (1, parameter_value_length);
      message_length := message_length + parameter_kind_size + param_length_size + parameter_value_length;

      NEXT parameter_kind IN message;
      parameter_kind^.length_indicated := FALSE;
      parameter_kind^.param := nfc$response_code;
      NEXT response_param IN message;
      response_param^ := response_code;
      message_length := message_length + parameter_kind_size + 1;

      nfp$send_message_on_connection (message, message_length, connection^.id, status);
      IF scfs_event_logging THEN
        log_connection_message (connection^, message_length, message);
      IFEND;

    PROCEND send_add_io_station_response;
?? OLDTITLE, EJECT ??

    initialize_io_station (io_station);

    crack_add_io_station_msg (message, msg_length, io_station, status);

  {  A private I/O station is not allowed to have station aliases, set them to a null name. }

    IF io_station.usage = nfc$private_io_station THEN
      io_station.alias_names [1] := osc$null_name;
      io_station.alias_names [2] := osc$null_name;
      io_station.alias_names [3] := osc$null_name;
    IFEND;

    message_response := nfc$message_accepted;

    find_ntf_acc_remote_system (io_station.name, ntf_acc_remote_system);
    alias_index := 1;
    WHILE (ntf_acc_remote_system = NIL) AND
          (alias_index <= 3) DO
      find_ntf_acc_remote_system (io_station.alias_names [alias_index], ntf_acc_remote_system);
      alias_index := alias_index + 1;
    WHILEND;

    IF (ntf_acc_remote_system <> NIL) THEN
      message_response := nfc$duplicate_defs_do_not_match;
    ELSEIF duplicate_aliases (io_station.alias_names) THEN
      message_response := nfc$duplicate_alias_names;
    ELSE
      last_ios := NIL;
      current_ios := scfs_tables.first_io_station;
      station_found := FALSE;

    /search_for_station/
      WHILE NOT station_found AND (current_ios <> NIL) DO
        IF io_station.name = current_ios^.name THEN
          station_found := TRUE;

{  Since the IO station name is already known to SCFS, if the "check ios unique"
{  parameter on the known station is set to TRUE, the definition must be
{  rejected.

          IF current_ios^.check_ios_unique THEN
            message_response := nfc$duplicate_with_check_unique;
          ELSE
            add_scf_di_connection (current_ios, connection, status);
          IFEND;
        IFEND;
        IF NOT station_found THEN
          last_ios := current_ios;
          current_ios := current_ios^.link;
        IFEND;
      WHILEND /search_for_station/;

{  If the station is not currently known, add it to the tables. }

      IF NOT station_found THEN
        add_io_station_entry_to_table (last_ios, io_station, status);
        add_scf_di_connection (last_ios, connection, status);

        last_ios^.station_operational := (last_ios^.usage = nfc$public_io_station);

{  If the station is a public station, or a fixed-private station, register the
{  station name.

        IF (last_ios^.usage = nfc$public_io_station) OR ((last_ios^.usage = nfc$private_io_station) AND (NOT
              last_ios^.check_ios_unique)) THEN
          register_station_alias_titles (last_ios, message_response, status);
          IF message_response = nfc$not_unique_network_title THEN
            delete_io_station (connection, last_ios, message,
                  wait_list, wait_connection_list, status);
          IFEND;
        IFEND;
      IFEND;
    IFEND;

{  Send a response back to SCF/DI.

    send_add_io_station_response (message, message_response, io_station.name, connection, status);

{  If the I/O station is already known and there is an operator assigned, send a start_io_station
{  message to SCF/DI.

    IF station_found AND status.normal AND (message_response = nfc$message_accepted) AND
          (current_ios^.usage <> nfc$ntf_remote_system) AND current_ios^.operator_assigned THEN
      operator_connection := current_ios^.connected_operator;
      send_start_io_station_msg (message, current_ios^.name, operator_connection^.user,
            operator_connection^.family, connection, status);
    IFEND;

  PROCEND add_io_station_msg;
?? TITLE := 'add new alias to list', EJECT ??
{  PURPOSE:
{    Allocate space for the specified alias type and initialize
{    the various fields.

  PROCEDURE add_new_alias_to_list
    (VAR alias_pt: ^nft$alias;
         alias_name: ost$name;
         alias_kind: nft$alias_kind;
     VAR status: ost$status);

    VAR
      new_alias: ^nft$alias;

    ALLOCATE new_alias;
    new_alias^.name := alias_name;
    new_alias^.kind := alias_kind;
    new_alias^.back_link := NIL;
    new_alias^.link := NIL;

    IF alias_pt <> NIL THEN
      alias_pt^.link := new_alias;
      new_alias^.back_link := alias_pt;
    IFEND;

    IF alias_kind = nfc$batch_device_alias THEN
      new_alias^.batch_device_pointer_list := NIL;
    ELSEIF alias_kind = nfc$io_station_alias THEN
      new_alias^.queue := NIL;
      new_alias^.station_list := NIL;
      new_alias^.station_title_registered := FALSE;
      new_alias^.alias_title_registered := FALSE;
      new_alias^.ntf_authority_level := nfc$ntf_none;
      new_alias^.ntf_remote_system_type := nfc$ntf_nos_ve;
      new_alias^.ntf_route_back_position := 0;
    IFEND;

    alias_pt := new_alias;

  PROCEND add_new_alias_to_list;
?? TITLE := 'add_ntf_acc_remote_system', EJECT ??

{  PURPOSE:
{    This procedure adds a specified accessible remote system to the SCFS
{    tables.

  PROCEDURE add_ntf_acc_remote_system
    (    acc_remote_system: ^nft$alias;
         remote_system: ^nft$io_station;
         logical_line: ^nft$ntf_logical_line);

    VAR
      acc_remote_system_ptr: ^nft$pointer_list_entry,
      acc_remote_system_ptr_entry: nft$pointer_list_entry,
      acc_remote_system_ptr_found: boolean,
      remote_system_ptr: ^nft$pointer_list_entry,
      remote_system_ptr_entry: nft$pointer_list_entry,
      remote_system_ptr_found: boolean;

    IF remote_system^.name = acc_remote_system^.name THEN
      acc_remote_system^.ntf_authority_level := remote_system^.ntf_authority_level;
      acc_remote_system^.ntf_remote_system_type := remote_system^.ntf_remote_system_type;
      acc_remote_system^.ntf_route_back_position := remote_system^.ntf_route_back_position;
    IFEND;

    find_ntf_remote_system_pointer (remote_system^.name, FALSE, 1, acc_remote_system,
          remote_system_ptr, acc_remote_system_ptr_found);
    find_ntf_remote_system_pointer (remote_system^.name, TRUE, logical_line^.logical_line_number,
          acc_remote_system, remote_system_ptr, remote_system_ptr_found);
    IF NOT remote_system_ptr_found THEN
      init_ntf_remote_sys_ptr_entry ( remote_system_ptr_entry);
      remote_system_ptr_entry.ntf_remote_system := remote_system;
      remote_system_ptr_entry.ntf_logical_line_number := logical_line^.logical_line_number;
      add_ntf_remote_system_pointer (remote_system_ptr_entry, remote_system_ptr, acc_remote_system,
             remote_system_ptr);
      IF NOT acc_remote_system_ptr_found THEN
        init_ntf_acc_rem_sys_ptr_entry ( acc_remote_system_ptr_entry);
        acc_remote_system_ptr_entry.ntf_acc_remote_system := acc_remote_system;
        ALLOCATE acc_remote_system_ptr;
        acc_remote_system_ptr^ := acc_remote_system_ptr_entry;
        acc_remote_system_ptr^.link := remote_system^.ntf_acc_remote_system_ptr_list;
        remote_system^.ntf_acc_remote_system_ptr_list := acc_remote_system_ptr;
      IFEND;
    IFEND;

  PROCEND add_ntf_acc_remote_system;
?? TITLE := 'add_ntf_acc_remote_system_msg', EJECT ??

{  PURPOSE:
{    This procedure is executed when a request is received from SCF/DI to
{    define a new NTF accessible remote system under control of this SCFS/VE
{    copy.  The NTF accessible remote system name is checked against all NTF
{    accessible remote system definitions currently known to SCFS/VE.  If it is
{    a new system name, the definition is done.  If the system name already
{    exists the definition is accepted if the existing definition is found to
{    be identical.  A response is sent back to SCF/DI.

  PROCEDURE add_ntf_acc_remote_system_msg
    (VAR message: ^nft$message_sequence;
         connection: ^nft$connection;
     VAR msg_length: integer;
     VAR status: ost$status);

    VAR
      acc_remote_system: ^nft$alias,
      acc_remote_system_name: ost$name,
      authority_level: nft$ntf_authority_level,
      ios_alias: ^nft$alias,
      ios_alias_found: boolean,
      logical_line: ^nft$ntf_logical_line,
      logical_line_found: boolean,
      logical_line_number: nft$ntf_logical_line_number,
      message_response: nft$ntf_add_ars_response_codes,
      remote_system: ^nft$io_station,
      remote_system_found: boolean,
      remote_system_name: ost$name,
      remote_system_ptr: ^nft$pointer_list_entry,
      remote_system_ptr_found: boolean,
      remote_system_type: nft$ntf_remote_system_type,
      route_back_position: nft$ntf_route_back_position;

*copy nft$ntf_add_acc_rem_sys_msg
*copy nft$ntf_add_ars_response_codes
?? NEWTITLE := 'crack_add_acc_remote_system_msg', EJECT ??

    PROCEDURE crack_add_acc_remote_system_msg
      (VAR message: ^nft$message_sequence;
       VAR msg_length: integer;
       VAR remote_system_name: ost$name;
       VAR logical_line_number: nft$ntf_logical_line_number;
       VAR acc_remote_system_name: ost$name;
       VAR authority_level: nft$ntf_authority_level;
       VAR remote_system_type: nft$ntf_remote_system_type;
       VAR route_back_position: nft$ntf_route_back_position;
       VAR status: ost$status);

      VAR
        ascii_string: ^string ( * <= osc$max_name_size),
        a_level: ^nft$ntf_authority_level,
        byte_array: ^nft$byte_array,
        line_number: ^nft$ntf_logical_line_number,
        parameter: ^nft$ntf_add_acc_rem_sys_msg,
        remote_sys_type: ^nft$ntf_remote_system_type,
        route_back: ^nft$ntf_route_back_position,
        value_length: integer;

      status.normal := TRUE;
      remote_system_type := nfc$ntf_nos_ve;
      route_back_position := 0;
      NEXT parameter IN message;

      WHILE (parameter <> NIL) AND (parameter^.param <> nfc$null_parameter) AND (msg_length > 0) DO
        msg_length := msg_length - 1;
        IF parameter^.length_indicated THEN
          nfp$get_parameter_value_length (message, msg_length, value_length, status);
          msg_length := msg_length - value_length;
        ELSE
          value_length := 1;
          msg_length := msg_length - 1;
        IFEND;

        CASE parameter^.param OF
        = nfc$ntf_remote_system_name =
          NEXT ascii_string: [value_length] IN message;
          #TRANSLATE (osv$lower_to_upper, ascii_string^, remote_system_name);

        = nfc$ntf_logical_line_number =
          NEXT line_number IN message;
          logical_line_number := line_number^;

        = nfc$ntf_acc_remote_system_name =
          NEXT ascii_string: [value_length] IN message;
          #TRANSLATE (osv$lower_to_upper, ascii_string^, acc_remote_system_name);

        = nfc$ntf_authority_level =
          NEXT a_level IN message;
          authority_level := a_level^;

        = nfc$ntf_remote_system_type =
          NEXT remote_sys_type IN message;
          remote_system_type := remote_sys_type^;

        = nfc$ntf_route_back_position =
          NEXT route_back IN message;
          route_back_position := route_back^;

        ELSE
{         ERROR ----   Ignore parameter value.
          NEXT byte_array: [1 .. value_length] IN message;

        CASEND;
        NEXT parameter IN message;
      WHILEND;

    PROCEND crack_add_acc_remote_system_msg;
?? TITLE := 'send_add_acc_remote_system_resp', EJECT ??

    PROCEDURE send_add_acc_remote_system_resp
      (VAR message: ^nft$message_sequence;
           response_code: nft$ntf_add_ars_response_codes;
           remote_system_name: ost$name;
           logical_line_number: nft$ntf_logical_line_number;
           acc_remote_system_name: ost$name;
           connection: ^nft$connection;
       VAR status: ost$status);

      VAR
        ascii_string: ^string ( * <= osc$max_name_size),
        line_number: ^nft$ntf_logical_line_number,
        message_length: nft$message_length,
        message_type: ^nft$message_kind,
        parameter_kind: ^nft$ntf_add_acc_rem_sys_resp,
        parameter_kind_size: nft$message_length,
        param_length_size: nft$message_length,
        parameter_value_length: integer,
        response_param: ^nft$ntf_add_ars_response_codes;

*copy nft$ntf_add_acc_rem_sys_resp

      status.normal := TRUE;
      parameter_kind_size := #SIZE (nft$ntf_add_acc_rem_sys_resp);
      RESET message;

      NEXT message_type IN message;
      message_type^ := nfc$add_ntf_acc_rem_sys_resp;
      message_length := 1;

      NEXT parameter_kind IN message;
      parameter_kind^.param := nfc$ntf_remote_system_name;
      parameter_value_length := clp$trimmed_string_size (remote_system_name);
      nfp$modify_param_value_length (parameter_value_length);
      parameter_kind^.length_indicated := parameter_value_length > 1;
      IF parameter_kind^.length_indicated THEN
        nfp$put_parameter_value_length (parameter_value_length, message, param_length_size, status);
      ELSE
        param_length_size := 0;
      IFEND;
      NEXT ascii_string: [parameter_value_length] IN message;
      ascii_string^ := remote_system_name (1, parameter_value_length);
      message_length := message_length + parameter_kind_size + param_length_size + parameter_value_length;

      NEXT parameter_kind IN message;
      parameter_kind^.param := nfc$ntf_logical_line_number;
      parameter_value_length := #SIZE (nft$ntf_logical_line_number);
      parameter_kind^.length_indicated := TRUE;
      nfp$put_parameter_value_length (parameter_value_length, message, param_length_size, status);
      NEXT line_number IN message;
      line_number^ := logical_line_number;
      message_length := message_length + parameter_kind_size + param_length_size + parameter_value_length;

      NEXT parameter_kind IN message;
      parameter_kind^.param := nfc$ntf_acc_remote_system_name;
      parameter_value_length := clp$trimmed_string_size (acc_remote_system_name);
      nfp$modify_param_value_length (parameter_value_length);
      parameter_kind^.length_indicated := parameter_value_length > 1;
      IF parameter_kind^.length_indicated THEN
        nfp$put_parameter_value_length (parameter_value_length, message, param_length_size, status);
      ELSE
        param_length_size := 0;
      IFEND;
      NEXT ascii_string: [parameter_value_length] IN message;
      ascii_string^ := acc_remote_system_name (1, parameter_value_length);
      message_length := message_length + parameter_kind_size + param_length_size + parameter_value_length;

      NEXT parameter_kind IN message;
      parameter_kind^.length_indicated := FALSE;
      parameter_kind^.param := nfc$response_code;
      NEXT response_param IN message;
      response_param^ := response_code;
      message_length := message_length + parameter_kind_size + 1;

      nfp$send_message_on_connection (message, message_length, connection^.id, status);
      IF scfs_event_logging THEN
        log_connection_message (connection^, message_length, message);
      IFEND;

    PROCEND send_add_acc_remote_system_resp;
?? OLDTITLE, EJECT ??

    status.normal := TRUE;
    crack_add_acc_remote_system_msg (message, msg_length, remote_system_name, logical_line_number,
          acc_remote_system_name, authority_level, remote_system_type, route_back_position, status);
    message_response := nfc$message_accepted;

    find_io_station_alias (acc_remote_system_name, ios_alias, ios_alias_found);
    IF NOT ios_alias_found THEN
      find_ntf_acc_remote_system (acc_remote_system_name, acc_remote_system);
      IF (acc_remote_system <> NIL) THEN
        find_ntf_remote_system (remote_system_name, remote_system, remote_system_found);
        IF remote_system_found THEN
          find_ntf_logical_line (logical_line_number, remote_system, logical_line,
                logical_line_found);
          IF logical_line_found THEN
            find_ntf_remote_system_pointer (remote_system_name, TRUE, logical_line_number,
                  acc_remote_system, remote_system_ptr, remote_system_ptr_found);
            IF remote_system_ptr_found THEN
              message_response := nfc$ntf_dup_defs_do_not_match;
            IFEND;

            IF (message_response = nfc$message_accepted) AND (acc_remote_system^.station_list <>
                  NIL) AND ((acc_remote_system^.ntf_remote_system_type <>
                  remote_system_type) OR (acc_remote_system^.ntf_route_back_position <> route_back_position))
                  THEN
              message_response := nfc$ntf_dup_defs_do_not_match;
            IFEND;

            IF message_response = nfc$message_accepted THEN
              acc_remote_system^.ntf_remote_system_type := remote_system_type;
              acc_remote_system^.ntf_route_back_position := route_back_position;
              add_ntf_acc_remote_system (acc_remote_system, remote_system, logical_line);
            IFEND;
          ELSE
            message_response := nfc$ntf_logical_line_not_found;
          IFEND;
        ELSE
          message_response := nfc$ntf_remote_system_not_found;
        IFEND;
      ELSE
        message_response := nfc$ntf_remote_sys_not_listed;
      IFEND;
    ELSE
      message_response := nfc$ntf_dup_defs_do_not_match;
    IFEND;

    send_add_acc_remote_system_resp (message, message_response, remote_system_name, logical_line_number,
          acc_remote_system_name, connection, status);

    IF message_response = nfc$message_accepted THEN
      find_files_for_ntf_logical_line (remote_system, logical_line_number, message, status);
    IFEND;
  PROCEND add_ntf_acc_remote_system_msg;
?? TITLE := 'add_ntf_logical_line_entry', EJECT ??

{  PURPOSE:
{    This procedure adds a logical line to the end of the list of logical lines
{    known to a remote system.

  PROCEDURE add_ntf_logical_line_entry
    (    logical_line_entry: nft$ntf_logical_line;
         last_logical_line: ^nft$ntf_logical_line;
         remote_system: ^nft$io_station;
     VAR logical_line: ^nft$ntf_logical_line);

    ALLOCATE logical_line;
    logical_line^ := logical_line_entry;
    IF last_logical_line <> NIL THEN
      logical_line^.back_link := last_logical_line;
      last_logical_line^.link := logical_line;
    ELSE
      remote_system^.ntf_logical_line_list := logical_line;
    IFEND;

  PROCEND add_ntf_logical_line_entry;
?? TITLE := 'add_ntf_remote_system_entry', EJECT ??

{  PURPOSE:
{    This procedure adds a remote system to the end of the list of remote
{    systems known to SCFS.

  PROCEDURE add_ntf_remote_system_entry
    (    remote_system_entry: nft$io_station;
         last_remote_system: ^nft$io_station;
     VAR remote_system: ^nft$io_station);

    ALLOCATE remote_system;
    remote_system^ := remote_system_entry;
    IF last_remote_system <> NIL THEN
      remote_system^.back_link := last_remote_system;
      last_remote_system^.link := remote_system;
    ELSE
      scfs_tables.first_ntf_remote_system := remote_system;
    IFEND;

  PROCEND add_ntf_remote_system_entry;
?? TITLE := 'add_ntf_remote_system_message', EJECT ??

{  PURPOSE:
{    This procedure is executed when a request is received from SCF/DI to
{    define a new NTF remote system under control of this SCFS/VE copy.  The
{    NTF remote system name is checked against all NTF remote system
{    definitions currently known to SCFS/VE.  If it is a new system name, the
{    definition is done.  If the system name already exists the definition is
{    accepted if the existing definition is found to be identical.  A response
{    is sent back to SCF/DI.

  PROCEDURE add_ntf_remote_system_message
    (VAR message: ^nft$message_sequence;
         connection: ^nft$connection;
     VAR msg_length: integer;
     VAR status: ost$status);

    VAR
      acc_remote_system: ^nft$alias,
      alias_found: boolean,
      ios_alias: ^nft$alias,
      logical_line: ^nft$ntf_logical_line,
      logical_line_entry: nft$ntf_logical_line,
      logical_line_found: boolean,
      logical_line_match: boolean,
      logical_line_ptr: ^nft$pointer_list_entry,
      logical_line_ptr_entry: nft$pointer_list_entry,
      message_response: nft$ntf_add_rs_response_codes,
      remote_system: ^nft$io_station,
      remote_system_entry: nft$io_station,
      remote_system_found: boolean,
      remote_system_match: boolean;

*copy nft$ntf_add_remote_sys_msg
*copy nft$ntf_add_rs_response_codes
?? NEWTITLE := 'crack_add_remote_system_message', EJECT ??

    PROCEDURE crack_add_remote_system_message
      (VAR message: ^nft$message_sequence;
       VAR msg_length: integer;
       VAR remote_system_entry: nft$io_station;
       VAR logical_line_entry: nft$ntf_logical_line;
       VAR status: ost$status);

      VAR
        ascii_string: ^string ( * <= osc$max_name_size),
        authority_level: ^nft$ntf_authority_level,
        byte_array: ^nft$byte_array,
        inactivity_timer: ^nft$ntf_inactivity_timer,
        line_speed: ^nft$ntf_line_speed,
        logical_line_number: ^nft$ntf_logical_line_number,
        parameter: ^nft$ntf_add_remote_sys_msg,
        positive_acknowledge: ^nft$ntf_positive_acknowledge,
        protocol: ^nft$ntf_remote_system_protocol,
        remote_system_type: ^nft$ntf_remote_system_type,
        request_permission_retry: ^boolean,
        route_back_position: ^nft$ntf_route_back_position,
        value_length: integer,
        wait_a_bit: ^nft$ntf_wait_a_bit;

      status.normal := TRUE;
      NEXT parameter IN message;

      WHILE (parameter <> NIL) AND (parameter^.param <> nfc$null_parameter) AND (msg_length > 0) DO
        msg_length := msg_length - 1;
        IF parameter^.length_indicated THEN
          nfp$get_parameter_value_length (message, msg_length, value_length, status);
          msg_length := msg_length - value_length;
        ELSE
          value_length := 1;
          msg_length := msg_length - 1;
        IFEND;

        CASE parameter^.param OF
        = nfc$ntf_remote_system_name =
          NEXT ascii_string: [value_length] IN message;
          #TRANSLATE (osv$lower_to_upper, ascii_string^, remote_system_entry.name);

        = nfc$ntf_protocol =
          NEXT protocol IN message;
          remote_system_entry.ntf_protocol := protocol^;

        = nfc$ntf_logical_line_number =
          NEXT logical_line_number IN message;
          logical_line_entry.logical_line_number := logical_line_number^;

        = nfc$ntf_line_speed =
          NEXT line_speed IN message;
          logical_line_entry.line_speed := line_speed^;

        = nfc$ntf_line_name =
          NEXT ascii_string: [value_length] IN message;
          #TRANSLATE (osv$lower_to_upper, ascii_string^, logical_line_entry.line_name);

        = nfc$ntf_authority_level =
          NEXT authority_level IN message;
          remote_system_entry.ntf_authority_level := authority_level^;

        = nfc$ntf_terminal_user_procedure =
          NEXT ascii_string: [value_length] IN message;
          #TRANSLATE (osv$lower_to_upper, ascii_string^, logical_line_entry.terminal_user_procedure);

        = nfc$ntf_wait_a_bit =
          NEXT wait_a_bit IN message;
          remote_system_entry.ntf_wait_a_bit := wait_a_bit^;

        = nfc$ntf_inactivity_timer =
          NEXT inactivity_timer IN message;
          remote_system_entry.ntf_inactivity_timer := inactivity_timer^;

        = nfc$ntf_positive_acknowledge =
          NEXT positive_acknowledge IN message;
          remote_system_entry.ntf_positive_acknowledge := positive_acknowledge^;

        = nfc$ntf_default_job_destination =
          NEXT ascii_string: [value_length] IN message;
          #TRANSLATE (osv$lower_to_upper, ascii_string^, remote_system_entry.ntf_default_job_destination);

        = nfc$ntf_default_file_destin =
          NEXT ascii_string: [value_length] IN message;
          #TRANSLATE (osv$lower_to_upper, ascii_string^, remote_system_entry.ntf_default_file_destination);

        = nfc$ntf_store_forward_destin =
          NEXT ascii_string: [value_length] IN message;
          #TRANSLATE (osv$lower_to_upper, ascii_string^, remote_system_entry.ntf_store_forward_destination);

        = nfc$ntf_remote_system_type =
          NEXT remote_system_type IN message;
          remote_system_entry.ntf_remote_system_type := remote_system_type^;

        = nfc$ntf_route_back_position =
          NEXT route_back_position IN message;
          remote_system_entry.ntf_route_back_position := route_back_position^;

        = nfc$ntf_request_perm_retry =
          NEXT request_permission_retry IN message;
          remote_system_entry.ntf_request_permission_retry := request_permission_retry^;

        = nfc$ntf_local_system_name =
          NEXT ascii_string: [value_length] IN message;
          #TRANSLATE (osv$lower_to_upper, ascii_string^, remote_system_entry.ntf_local_system_name);

        ELSE
{         ERROR ----   Ignore parameter value.
          NEXT byte_array: [1 .. value_length] IN message;

        CASEND;
        NEXT parameter IN message;
      WHILEND;

    PROCEND crack_add_remote_system_message;
?? TITLE := 'send_add_remote_system_response', EJECT ??

    PROCEDURE send_add_remote_system_response
      (VAR message: ^nft$message_sequence;
           response_code: nft$ntf_add_rs_response_codes;
           remote_system_name: ost$name;
           logical_line_number: nft$ntf_logical_line_number;
           connection: ^nft$connection;
       VAR status: ost$status);

      VAR
        ascii_string: ^string ( * <= osc$max_name_size),
        line_number: ^nft$ntf_logical_line_number,
        message_length: nft$message_length,
        message_type: ^nft$message_kind,
        parameter_kind: ^nft$ntf_add_remote_sys_resp,
        parameter_kind_size: nft$message_length,
        param_length_size: nft$message_length,
        parameter_value_length: integer,
        response_param: ^nft$ntf_add_rs_response_codes;

*copy nft$ntf_add_remote_sys_resp

      status.normal := TRUE;
      parameter_kind_size := #SIZE (nft$ntf_add_remote_sys_resp);
      RESET message;

      NEXT message_type IN message;
      message_type^ := nfc$add_ntf_remote_sys_resp;
      message_length := 1;

      NEXT parameter_kind IN message;
      parameter_kind^.param := nfc$ntf_remote_system_name;
      parameter_value_length := clp$trimmed_string_size (remote_system_name);
      nfp$modify_param_value_length (parameter_value_length);
      parameter_kind^.length_indicated := parameter_value_length > 1;
      IF parameter_kind^.length_indicated THEN
        nfp$put_parameter_value_length (parameter_value_length, message, param_length_size, status);
      ELSE
        param_length_size := 0;
      IFEND;
      NEXT ascii_string: [parameter_value_length] IN message;
      ascii_string^ := remote_system_name (1, parameter_value_length);
      message_length := message_length + parameter_kind_size + param_length_size + parameter_value_length;

      NEXT parameter_kind IN message;
      parameter_kind^.param := nfc$ntf_logical_line_number;
      parameter_value_length := #SIZE (nft$ntf_logical_line_number);
      parameter_kind^.length_indicated := TRUE;
      nfp$put_parameter_value_length (parameter_value_length, message, param_length_size, status);
      NEXT line_number IN message;
      line_number^ := logical_line_number;
      message_length := message_length + parameter_kind_size + param_length_size + parameter_value_length;

      NEXT parameter_kind IN message;
      parameter_kind^.length_indicated := FALSE;
      parameter_kind^.param := nfc$response_code;
      NEXT response_param IN message;
      response_param^ := response_code;
      message_length := message_length + parameter_kind_size + 1;

      nfp$send_message_on_connection (message, message_length, connection^.id, status);
      IF scfs_event_logging THEN
        log_connection_message (connection^, message_length, message);
      IFEND;

    PROCEND send_add_remote_system_response;
?? OLDTITLE, EJECT ??

    status.normal := TRUE;
    initialize_ntf_remote_system ( remote_system_entry);
    initialize_ntf_logical_line ( logical_line_entry);
    logical_line_entry.scfdi_connection := connection;
    crack_add_remote_system_message (message, msg_length, remote_system_entry, logical_line_entry,
          status);
    message_response := nfc$message_accepted;

    find_io_station_alias (remote_system_entry.name, ios_alias, alias_found);
    IF NOT alias_found THEN
      find_ntf_acc_remote_system (remote_system_entry.name, acc_remote_system);
      IF acc_remote_system <> NIL THEN
        find_ntf_remote_system (remote_system_entry.name, remote_system, remote_system_found);
        IF remote_system_found THEN
          compare_ntf_remote_systems (remote_system_entry, remote_system^, remote_system_match);
          IF remote_system_match THEN
            find_ntf_logical_line (logical_line_entry.logical_line_number, remote_system,
                  logical_line, logical_line_found);
            IF logical_line_found THEN
              message_response := nfc$ntf_dup_logical_line_number;
            IFEND;
          ELSE
            message_response := nfc$ntf_dup_defs_do_not_match;
          IFEND;
        IFEND;

        IF (message_response = nfc$message_accepted) AND (acc_remote_system^.station_list <>
              NIL) AND ((remote_system_entry.ntf_remote_system_type <>
              acc_remote_system^.ntf_remote_system_type) OR (remote_system_entry.ntf_route_back_position <>
              acc_remote_system^.ntf_route_back_position)) THEN
          message_response := nfc$ntf_dup_defs_do_not_match;
        IFEND;

        IF (message_response = nfc$message_accepted) AND (NOT remote_system_found) THEN
          add_ntf_remote_system_entry (remote_system_entry, remote_system, remote_system);
          logical_line := NIL;
        IFEND;

        IF message_response = nfc$message_accepted THEN
          add_ntf_logical_line_entry (logical_line_entry, logical_line, remote_system,
                logical_line);
          add_ntf_acc_remote_system (acc_remote_system, remote_system, logical_line);
        IFEND;
      ELSE
        message_response := nfc$ntf_remote_sys_not_listed;
      IFEND;
    ELSE
      message_response := nfc$ntf_dup_defs_do_not_match;
    IFEND;

    send_add_remote_system_response (message, message_response, remote_system_entry.name,
          logical_line_entry.logical_line_number, connection, status);

  PROCEND add_ntf_remote_system_message;
?? TITLE := 'add_ntf_remote_system_pointer', EJECT ??

{  PURPOSE:
{    This procedure adds a remote system pointer to the end of the list of
{    remote system pointers known to an accessible remote system.

  PROCEDURE add_ntf_remote_system_pointer
    (    remote_system_ptr_entry: nft$pointer_list_entry;
         last_remote_system_ptr: ^nft$pointer_list_entry;
         acc_remote_system: ^nft$alias;
     VAR remote_system_ptr: ^nft$pointer_list_entry);

    ALLOCATE remote_system_ptr;
    remote_system_ptr^ := remote_system_ptr_entry;
    IF last_remote_system_ptr <> NIL THEN
      remote_system_ptr^.back_link := last_remote_system_ptr;
      last_remote_system_ptr^.link := remote_system_ptr;
    ELSE
      acc_remote_system^.station_list := remote_system_ptr;
    IFEND;

  PROCEND add_ntf_remote_system_pointer;
?? TITLE := 'add pointer list entry', EJECT ??

{  PURPOSE:
{    Allocate space for the specified type of pointer list entry
{    and initialize the various fields.

  PROCEDURE add_pointer_list_entry
    (VAR current_pointer: ^nft$pointer_list_entry;
         pointer_kind: nft$pointer_kind;
     VAR status: ost$status);

    VAR
      new_pointer_entry: ^nft$pointer_list_entry;

    ALLOCATE new_pointer_entry;

    IF current_pointer <> NIL THEN
      current_pointer^.link := new_pointer_entry;
      new_pointer_entry^.back_link := current_pointer;
    ELSE
      new_pointer_entry^.back_link := NIL;
    IFEND;

    current_pointer := new_pointer_entry;
    current_pointer^.link := NIL;
    current_pointer^.kind := pointer_kind;

    CASE current_pointer^.kind OF
    = nfc$queue =
      current_pointer^.queue := NIL;
    = nfc$io_station =
      current_pointer^.io_station := NIL;
    = nfc$batch_device =
      current_pointer^.batch_device := NIL;
    = nfc$connection =
      current_pointer^.connection := NIL;
    CASEND;

  PROCEND add_pointer_list_entry;
?? OLDTITLE ??
?? NEWTITLE := 'add_unreachable_btfs_di', EJECT ??

{  PURPOSE:
{    Add an entry to the SCF/VE's list of unreachable BTFS/DI's.  No new
{    entry is created if the BTFS/DI title is already in the list.

  PROCEDURE add_unreachable_btfs_di
    (    title: nft$btfs_di_title;
         connection: ^nft$connection;
     VAR wait_list: ^ost$i_wait_list);

    VAR
      clock: integer,
      current_pointer: ^unreachable_btfs_di,
      ignore_status: ost$status,
      next_pointer: ^unreachable_btfs_di;

    current_pointer := connection^.unreachable_btfs_di_list;
    next_pointer := current_pointer;

    WHILE next_pointer <> NIL DO
      current_pointer := next_pointer;
      next_pointer := current_pointer^.link;
      IF current_pointer^.title = title THEN
        RETURN;
      IFEND;
    WHILEND;

    ALLOCATE next_pointer;
    IF connection^.unreachable_btfs_di_list = NIL THEN
      connection^.unreachable_btfs_di_list := next_pointer;
    ELSE
      current_pointer^.link := next_pointer;
    IFEND;
    next_pointer^.title := title;
    pmp$get_microsecond_clock (clock, ignore_status);
    clock := clock DIV 1000;
    next_pointer^.timer := clock + unreachable_btfs_di_wait_time;
    next_pointer^.link := NIL;

    wait_list^ [2].milliseconds := unreachable_btfs_di_wait_time;

  PROCEND add_unreachable_btfs_di;
?? OLDTITLE ??
?? NEWTITLE := 'add user msg', EJECT ??

{  PURPOSE:
{    This procedure is executed when a request is received from OPES to
{    register a user as an I/O station operator.   If another operator is
{    currently assigned to the station, or if the request for station control
{    was not entered at the required operator device(if there is one), the
{    request is rejected.  A response is sent to OPES, and if the message
{    was accepted by SCFS, SCF/DI is informed that an operator has been
{    assigned to this I/O station.  (The message sent to SCF/DI is required to
{    activate the batch devices for I/O stations which have the "check io
{    station unique" attribute set to TRUE.)
{
{    This procedure is also executed when a request is received from OPENTF to
{    register a user as an NTF remote system operator.  If another operator is
{    currently assigned to the remote system, the request is rejected.  A
{    response is sent to OPENTF.

  PROCEDURE add_user_msg
    (VAR message: ^nft$message_sequence;
         connection: ^nft$connection;
     VAR msg_length: integer;
     VAR status: ost$status);

    VAR
      bd_connection: ^nft$connection,
      connection_ptr: ^nft$pointer_list_entry,
      control_device: ost$name,
      device: ^nft$batch_device,
      io_station: ^nft$io_station,
      ios_connection: ^nft$connection,
      message_response: nft$add_user_responses,
      station_found: boolean,
      station_or_control_facility: ost$name,
      station_usage: nft$io_station_usage;

*copyc nft$add_user_msg
*copyc nft$add_user_responses
?? NEWTITLE := 'crack add user msg', EJECT ??

{  PURPOSE:
{    Determine the parameters and values sent by OPES in the add
{    user message.

    PROCEDURE crack_add_user_msg
      (VAR message: ^nft$message_sequence;
       VAR msg_length: integer;
           connection: ^nft$connection;
       VAR station_or_control_facility: ost$name;
       VAR control_device: ost$name;
       VAR station_usage: nft$io_station_usage;
       VAR status: ost$status);

      VAR
        accept_messages: ^nft$accept_messages,
        ascii_string: ^string ( * <= osc$max_name_size),
        byte_array: ^nft$byte_array,
        io_station_usage_param: ^nft$io_station_usage,
        parameter: ^nft$add_user_message_parameter,
        value_length: integer;

      connection^.accept_messages := TRUE;
      NEXT parameter IN message;

      WHILE (parameter <> NIL) AND (parameter^.param <> nfc$null_parameter) AND (msg_length > 0) DO
        msg_length := msg_length - 1;
        IF parameter^.length_indicated THEN
          nfp$get_parameter_value_length (message, msg_length, value_length, status);
          msg_length := msg_length - value_length;
        ELSE
          value_length := 1;
          msg_length := msg_length - 1;
        IFEND;

        CASE parameter^.param OF
        = nfc$station_or_control_facility =
          NEXT ascii_string: [value_length] IN message;
          #translate (osv$lower_to_upper, ascii_string^, station_or_control_facility);

        = nfc$control_device_name =
          NEXT ascii_string: [value_length] IN message;
          #translate (osv$lower_to_upper, ascii_string^, control_device);

        = nfc$family_name =
          NEXT ascii_string: [value_length] IN message;
          #translate (osv$lower_to_upper, ascii_string^, connection^.family);

        = nfc$user_name =
          NEXT ascii_string: [value_length] IN message;
          #translate (osv$lower_to_upper, ascii_string^, connection^.user);

        = nfc$station_usage =
          NEXT io_station_usage_param IN message;
          station_usage := io_station_usage_param^;

        = nfc$accept_messages =
          NEXT accept_messages IN message;
          connection^.accept_messages := (accept_messages^ = nfc$do_accept_messages);

        ELSE
{         ERROR ----   Ignore parameter value.
          NEXT byte_array: [1 .. value_length] IN message;

        CASEND;
        NEXT parameter IN message;
      WHILEND;

    PROCEND crack_add_user_msg;
?? TITLE := 'find private dynamic station', EJECT ??

    PROCEDURE find_private_dynamic_station
      (    control_device: ost$name;
           station_usage: nft$io_station_usage;
       VAR io_station: ^nft$io_station;
       VAR station_found: boolean;
       VAR status: ost$status);

      io_station := scfs_tables.first_io_station;
      station_found := FALSE;

      WHILE NOT station_found AND (io_station <> NIL) DO
        station_found :=

        (io_station^.usage = nfc$private_io_station) AND

        io_station^.check_ios_unique AND

        (NOT io_station^.operator_assigned);

        IF (station_found) AND (io_station^.required_operator_device <> osc$null_name) THEN
          station_found := (control_device = io_station^.required_operator_device);
        IFEND;

        IF NOT station_found THEN
          io_station := io_station^.link;
        IFEND;
      WHILEND;

    PROCEND find_private_dynamic_station;
?? TITLE := 'move files from unknown q', EJECT ??

{  PURPOSE:
{    This procedure moves files from the unknown queue to the appropriate
{    station queue.  The unknown private operators queue houses all files
{    destined for a private station, but for which there is no operator
{    currently operating the station the file(s) are intended to print at.
{    When an operator gains control of a private station, the files that
{    he is allowed to control are added to the station queue for that station.

    PROCEDURE move_files_from_unknown_q
      (    operator_name: ost$name;
           operator_family: ost$name;
           io_station: ^nft$io_station);

      VAR
        alias_pt: ^nft$alias,
        next_q_file: ^nft$output_queue_file,
        q_file: ^nft$output_queue_file,
        q_pointer: ^^nft$output_queue_file;

?? NEWTITLE := 'move file to station q', EJECT ??

      PROCEDURE move_file_to_station_q
        (    q_file: ^nft$output_queue_file;
         VAR station_q: ^^nft$output_queue_file);

        VAR
          last_q_file: ^nft$output_queue_file;

        last_q_file := station_q^;
        IF last_q_file = NIL THEN
          station_q^ := q_file;
          q_file^.back_link := NIL;
        ELSE
          WHILE last_q_file^.link <> NIL DO
            last_q_file := last_q_file^.link;
          WHILEND;
          last_q_file^.link := q_file;
          q_file^.back_link := last_q_file;
        IFEND;

        q_file^.link := NIL;

      PROCEND move_file_to_station_q;
?? TITLE := 'remove file from unknown q', EJECT ??

      PROCEDURE remove_file_from_unknown_q
        (    q_file: ^nft$output_queue_file);

        VAR
          back_link_q_file: ^nft$output_queue_file,
          link_q_file: ^nft$output_queue_file;

        back_link_q_file := q_file^.back_link;
        link_q_file := q_file^.link;
        IF q_file = scfs_tables.unknown_private_operators_q THEN
          scfs_tables.unknown_private_operators_q := q_file^.link;
          IF q_file^.link <> NIL THEN
            link_q_file^.back_link := NIL;
          IFEND;
        ELSE
          back_link_q_file^.link := q_file^.link;
          IF q_file^.link <> NIL THEN
            link_q_file^.back_link := q_file^.back_link;
          IFEND;
        IFEND;

      PROCEND remove_file_from_unknown_q;
?? OLDTITLE, EJECT ??

      q_file := scfs_tables.unknown_private_operators_q;
      q_pointer := NIL;
      WHILE q_file <> NIL DO
        next_q_file := q_file^.link;
        IF (q_file^.operator_name = operator_name) AND (q_file^.operator_family = operator_family) THEN
          remove_file_from_unknown_q (q_file);
          alias_pt := io_station^.alias_list [0];
          q_pointer := ^alias_pt^.queue;
          move_file_to_station_q (q_file, q_pointer);
        IFEND;
        q_file := next_q_file;
      WHILEND;

    PROCEND move_files_from_unknown_q;
?? TITLE := 'send add user response', EJECT ??

{  PURPOSE:
{    Build and send a message to OPES indicating SCFS's response
{    to an add user message.  The add user mssage indicated a
{    user wishes to gain control of a station.

    PROCEDURE send_add_user_response
      (VAR message: ^nft$message_sequence;
           response_code: nft$add_user_responses;
           station_or_control_facility: ost$name;
           connection: ^nft$connection;
       VAR status: ost$status);

      VAR
        ascii_string: ^string ( * <= osc$max_name_size),
        message_length: nft$message_length,
        message_type: ^nft$message_kind,
        parameter_kind: ^nft$add_user_resp_msg_parameter,
        parameter_kind_size: nft$message_length,
        param_length_size: nft$message_length,
        parameter_value_length: integer,
        response_param: ^nft$add_user_responses;

*copyc nft$add_user_resp_msg

      parameter_kind_size := #SIZE (nft$add_user_resp_msg_parameter);
      RESET message;

      NEXT message_type IN message;
      message_type^ := nfc$add_user_resp;
      message_length := 1;

      NEXT parameter_kind IN message;
      parameter_kind^.param := nfc$station_or_control_facility;
      parameter_value_length := clp$trimmed_string_size (station_or_control_facility);
      nfp$modify_param_value_length (parameter_value_length);
      parameter_kind^.length_indicated := parameter_value_length > 1;
      IF parameter_kind^.length_indicated THEN
        nfp$put_parameter_value_length (parameter_value_length, message, param_length_size, status);
      ELSE
        param_length_size := 0;
      IFEND;
      NEXT ascii_string: [parameter_value_length] IN message;
      ascii_string^ := station_or_control_facility (1, parameter_value_length);
      message_length := message_length + parameter_kind_size + param_length_size + parameter_value_length;

      NEXT parameter_kind IN message;
      parameter_kind^.length_indicated := FALSE;
      parameter_kind^.param := nfc$response_code;
      NEXT response_param IN message;
      response_param^ := response_code;
      message_length := message_length + parameter_kind_size + 1;

      NEXT parameter_kind IN message;
      parameter_kind^.length_indicated := FALSE;
      parameter_kind^.param := nfc$null_parameter;
      message_length := message_length + parameter_kind_size;

      nfp$send_message_on_connection (message, message_length, connection^.id, status);
      IF scfs_event_logging THEN
        log_connection_message (connection^, message_length, message);
      IFEND;

    PROCEND send_add_user_response;
?? OLDTITLE, EJECT ??

    IF connection^.kind <> nfc$ntf_operator_connection THEN
      connection^.kind := nfc$operator_connection;
    IFEND;

    message_response := nfc$message_accepted;

    crack_add_user_msg (message, msg_length, connection, station_or_control_facility,
          control_device, station_usage, status);

{  Station name specified - PUBLIC station or FIXED-PRIVATE station }
    IF (station_or_control_facility <> control_facility_name) OR (connection^.kind =
          nfc$ntf_operator_connection) THEN
      find_io_station_or_remote_sys (station_or_control_facility, connection, io_station,
            station_found);
      IF NOT station_found THEN
        message_response := nfc$no_io_station_found;
      IFEND;
{  Control facility name specified - DYNAMIC-PRIVATE station }
    ELSE
      find_private_dynamic_station (control_device, station_usage, io_station, station_found,
            status);
      IF NOT station_found THEN
        message_response := nfc$no_io_station_found;
      IFEND;
    IFEND;

    IF station_found AND io_station^.operator_assigned THEN
      message_response := nfc$operator_already_assigned;
    ELSEIF station_found AND (io_station^.required_operator_device <> osc$null_name) AND (io_station^.
          required_operator_device <> control_device) THEN
      message_response := nfc$operator_device_mismatch;
    IFEND;

    IF message_response = nfc$message_accepted THEN
      station_or_control_facility  := io_station^.name;
      connection^.operating_station := io_station;
      io_station^.connected_operator := connection;
      io_station^.operator_assigned := TRUE;
      io_station^.station_operational := TRUE;
      IF io_station^.usage = nfc$private_io_station THEN
        move_files_from_unknown_q (connection^.user, connection^.family, io_station);
      IFEND;

      IF io_station^.usage <> nfc$ntf_remote_system THEN
        connection_ptr := io_station^.scfdi_connection_pointers;
        WHILE connection_ptr <> NIL DO
          ios_connection := connection_ptr^.connection;
          send_start_io_station_msg (message, io_station^.name, connection^.user, connection^.family,
                ios_connection, status);
          connection_ptr := connection_ptr^.link;
        WHILEND;
      IFEND;

      IF io_station^.batch_device_list <> NIL THEN
        device := io_station^.batch_device_list;
        WHILE device <> NIL DO
          IF device_available_for_output (device) THEN
            find_file_for_device (device, message, status);
          IFEND;
          device := device^.link;
        WHILEND;
      IFEND;
    IFEND;

    send_add_user_response (message, message_response, station_or_control_facility, connection, status);

  PROCEND add_user_msg;
?? TITLE := 'any outstanding di responses', EJECT ??

{  Determine if the DI has not responded to commands that were sent
{  by SCFS.  If there are responses outstanding, set result to TRUE.

  FUNCTION any_outstanding_di_responses (di_responses: nft$outstanding_di_responses): boolean;

    any_outstanding_di_responses := (di_responses [nfc$start_bd] + di_responses [nfc$stop_bd] + di_responses
          [nfc$change_bd_attr] + di_responses [nfc$suppress_cc] + di_responses [nfc$terminate_xfer] +
          di_responses [nfc$position_file]) > 0;

  FUNCEND any_outstanding_di_responses;
?? TITLE := 'broadcast_ntf_message', EJECT ??

{  PURPOSE:
{    This procedure will send a message to every NTF operator or user known by
{    SCFS with the specified family name, user name, and/or operator identifier.
{    If the family name is null, SCFS will not check the family name of the
{    operator.  If the user name is null, SCFS will not check the user name of
{    the operator.  If the operator identifier is null, SCFS will not check the
{    operator identifier of the operator.

  PROCEDURE broadcast_ntf_message
    (    message_area: ^nft$message_sequence;
         length: nft$message_length;
         family_name: ost$name;
         user_name: ost$name;
         operator_identifier: nft$ntf_system_identifier;
     VAR messages_sent: boolean;
     VAR status: ost$status);

    VAR
      connection: ^nft$connection,
      message: ^nft$message_sequence;

    status.normal := TRUE;
    messages_sent := FALSE;
    connection := scfs_tables.first_ntf_operator;
    WHILE connection <> NIL DO
      IF ((user_name = osc$null_name) OR (user_name = connection^.user)) AND ((family_name = osc$null_name)
            OR (family_name = connection^.family)) AND ((operator_identifier =
            nfc$ntf_blank_system_identifier) OR (operator_identifier = connection^.ntf_operator_identifier))
            AND connection^.accept_messages THEN
        nfp$send_message_on_connection (message_area, length, connection^.id, status);
        IF scfs_event_logging THEN
          message := message_area;
          log_connection_message (connection^, length, message);
        IFEND;

        messages_sent := TRUE;
      IFEND;

      connection := connection^.next_ntf_operator;
    WHILEND;

  PROCEND broadcast_ntf_message;
?? TITLE := 'calculate priority', EJECT ??

  FUNCTION calculate_priority (q_file: ^nft$output_queue_file;
        current_time: ost$date_time): nft$priority;

    VAR
      priority: nft$priority;

{     Q File priority is the current time minus the q file time stamp (in seconds) times the
{         priority multiplier added to the initial priority.

    priority := time_in_scfs_queue (q_file^.time_stamp, current_time) * q_file^.priority_factor + q_file^.
          initial_priority;

    calculate_priority := priority;
    IF priority > q_file^.maximum_priority THEN
      calculate_priority := q_file^.maximum_priority;
    ELSEIF priority < 0 THEN
      calculate_priority := q_file^.initial_priority;
    IFEND;

  FUNCEND calculate_priority;
?? TITLE := 'change batch device attr resp', EJECT ??

{  PURPOSE:
{    This procedure is executed when a response to a change batch device
{    attributes operator command is received from SCF/DI.  SCFS tables are
{    updated accordingly and if the station operator is still assigned,
{    a response is forwarded to OPES.
{
{    This procedure is also executed when a response to a change batch stream
{    attributes operator command is received from SCF/DI.  SCFS tables are
{    updated accordingly and if the NTF remote system operator is still
{    assigned, a response is forwarded to OPENTF.

  PROCEDURE change_batch_device_attr_resp
      (VAR message: ^nft$message_sequence;
        message_length: integer;
        connection: ^nft$connection;
    VAR msg_length: integer;
    VAR status: ost$status);

    VAR
      alias_index: 1 .. 3,
      ascii_string: ^string ( * <= osc$max_name_size),
      device: ^nft$batch_device,
      device_found: boolean,
      device_name: ost$name,
      io_station: ^nft$io_station,
      io_station_found: boolean,
      io_station_name: ost$name,
      old_bd: nft$batch_device,
      operator_connection: ^nft$connection,
      response_code: nft$device_control_resp_codes;

*copyc nft$change_bd_attr_resp_msg
?? NEWTITLE := 'change batch device attrs', EJECT ??

{  PURPOSE:
{    This procedure updates the batch device attributes that were
{    just changed by an operator command.

    PROCEDURE change_batch_device_attrs
      (VAR message: ^nft$message_sequence;
       VAR msg_length: integer;
       VAR batch_device: nft$batch_device;
       VAR status: ost$status);

      CONST
        null_string = ' ';

      VAR
        ascii_string: ^string ( * <= osc$max_name_size),
        byte_array: ^nft$byte_array,
        banner_page_count: ^nft$banner_page_count,
        banner_highlight_field: ^nft$banner_highlight_field,
        boolean_parameter: ^boolean,
        carriage_control_action: ^nft$carriage_control_action,
        code_set: ^nft$code_set,
        empty_string: ost$name,
        file_ack: ^boolean,
        forms_size: ^nft$forms_size,
        maximum_file_size: ^nft$device_file_size,
        ntf_skip_punch_count: ^nft$ntf_skip_punch_count,
        page_length: ^nft$page_length,
        page_width: ^nft$page_width,
        parameter: ^nft$change_bd_attr_resp_param,
        transmission_block_size: ^nft$transmit_block_size,
        undefined_fe_action: ^nft$format_effector_actions,
        unsupported_fe_action: ^nft$format_effector_actions,
        value_length: integer,
        vertical_print_density: ^nft$vertical_print_density;

      status.normal := TRUE;
      empty_string := osc$null_name;
      NEXT parameter IN message;

      WHILE (parameter <> NIL) AND (parameter^.param <> nfc$null_parameter) AND (msg_length > 0) DO
        msg_length := msg_length - 1;
        IF parameter^.length_indicated THEN
          nfp$get_parameter_value_length (message, msg_length, value_length, status);
          msg_length := msg_length - value_length;
          IF value_length = 0 THEN
            ascii_string := ^empty_string;
          IFEND;
        ELSE
          value_length := 1;
          msg_length := msg_length - 1;
        IFEND;

        CASE parameter^.param OF
        = nfc$device_alias_1 =
          IF value_length <> 0 THEN
            NEXT ascii_string: [value_length] IN message;
            #translate (osv$lower_to_upper, ascii_string^, batch_device.alias_names [1]);
          ELSE
            batch_device.alias_names [1] := null_string;
          IFEND;

        = nfc$device_alias_2 =
          IF value_length <> 0 THEN
            NEXT ascii_string: [value_length] IN message;
            #translate (osv$lower_to_upper, ascii_string^, batch_device.alias_names [2]);
          ELSE
            batch_device.alias_names [2] := null_string;
          IFEND;

        = nfc$device_alias_3 =
          IF value_length <> 0 THEN
            NEXT ascii_string: [value_length] IN message;
            #translate (osv$lower_to_upper, ascii_string^, batch_device.alias_names [3]);
          ELSE
            batch_device.alias_names [3] := null_string;
          IFEND;

        = nfc$file_acknowledgement =
          NEXT file_ack IN message;
          batch_device.file_acknowledgement := file_ack^;

        = nfc$terminal_model =
          NEXT ascii_string: [value_length] IN message;
          #translate (osv$lower_to_upper, ascii_string^, batch_device.terminal_model);

        = nfc$transmission_block_size =
          NEXT transmission_block_size IN message;
          batch_device.transmission_block_size := transmission_block_size^;

        = nfc$maximum_file_size =
          NEXT maximum_file_size IN message;
          batch_device.maximum_file_size := maximum_file_size^;

        = nfc$page_width =
          NEXT page_width IN message;
          batch_device.page_width := page_width^;

        = nfc$page_length =
          NEXT page_length IN message;
          batch_device.page_length := page_length^;

        = nfc$banner_page_count =
          NEXT banner_page_count IN message;
          batch_device.banner_page_count := banner_page_count^;

        = nfc$banner_highlight_field =
          NEXT banner_highlight_field IN message;
          batch_device.banner_highlight_field := banner_highlight_field^;

        = nfc$carriage_control_action =
          NEXT carriage_control_action IN message;
          batch_device.carriage_control_action := carriage_control_action^;

        = nfc$forms_code_1 =
          IF value_length <> 0 THEN
            NEXT ascii_string: [value_length] IN message;
            #translate (osv$lower_to_upper, ascii_string^, batch_device.forms_code [1]);
          ELSE
            batch_device.forms_code [1] := null_string;
          IFEND;

        = nfc$forms_code_2 =
          IF value_length <> 0 THEN
            NEXT ascii_string: [value_length] IN message;
            #translate (osv$lower_to_upper, ascii_string^, batch_device.forms_code [2]);
          ELSE
            batch_device.forms_code [2] := null_string;
          IFEND;

        = nfc$forms_code_3 =
          IF value_length <> 0 THEN
            NEXT ascii_string: [value_length] IN message;
            #translate (osv$lower_to_upper, ascii_string^, batch_device.forms_code [3]);
          ELSE
            batch_device.forms_code [3] := null_string;
          IFEND;

        = nfc$forms_code_4 =
          IF value_length <> 0 THEN
            NEXT ascii_string: [value_length] IN message;
            #translate (osv$lower_to_upper, ascii_string^, batch_device.forms_code [4]);
          ELSE
            batch_device.forms_code [4] := null_string;
          IFEND;

        = nfc$external_characteristics_1 =
          IF value_length <> 0 THEN
            NEXT ascii_string: [value_length] IN message;
            #translate (osv$lower_to_upper, ascii_string^, batch_device.external_characteristics [1]);
          ELSE
            batch_device.external_characteristics [1] := null_string;
          IFEND;

        = nfc$external_characteristics_2 =
          IF value_length <> 0 THEN
            NEXT ascii_string: [value_length] IN message;
            #translate (osv$lower_to_upper, ascii_string^, batch_device.external_characteristics [2]);
          ELSE
            batch_device.external_characteristics [2] := null_string;
          IFEND;

        = nfc$external_characteristics_3 =
          IF value_length <> 0 THEN
            NEXT ascii_string: [value_length] IN message;
            #translate (osv$lower_to_upper, ascii_string^, batch_device.external_characteristics [3]);
          ELSE
            batch_device.external_characteristics [3] := null_string;
          IFEND;

        = nfc$external_characteristics_4 =
          IF value_length <> 0 THEN
            NEXT ascii_string: [value_length] IN message;
            #translate (osv$lower_to_upper, ascii_string^, batch_device.external_characteristics [4]);
          ELSE
            batch_device.external_characteristics [4] := null_string;
          IFEND;

        = nfc$code_set =
          NEXT code_set IN message;
          batch_device.code_set := code_set^;

        = nfc$vertical_print_density =
          NEXT vertical_print_density IN message;
          batch_device.vertical_print_density := vertical_print_density^;

        = nfc$vfu_load_procedure =
          IF value_length <> 0 THEN
            NEXT ascii_string: [value_length] IN message;
            #translate (osv$lower_to_upper, ascii_string^, batch_device.vfu_load_procedure);
          ELSE
            batch_device.vfu_load_procedure := null_string;
          IFEND;

        = nfc$forms_size =
          NEXT forms_size IN message;
          batch_device.forms_size := forms_size^;

        = nfc$undefined_fe_action =
          NEXT undefined_fe_action IN message;
          batch_device.undefined_fe_action := undefined_fe_action^;

        = nfc$unsupported_fe_action =
          NEXT unsupported_fe_action IN message;
          batch_device.unsupported_fe_action := unsupported_fe_action^;

        = nfc$ntf_skip_punch_count =
          NEXT ntf_skip_punch_count IN message;
          batch_device.ntf_skip_punch_count := ntf_skip_punch_count^;

        = nfc$invalid_chg_request =
          osp$set_status_abnormal ('NF', nfe$invalid_chg_requ_by_oper, '', status);
          RETURN;

        ELSE
{         ERROR ----   Ignore parameter value.
          NEXT byte_array: [1 .. value_length] IN message;

        CASEND;
        NEXT parameter IN message;
      WHILEND;

    PROCEND change_batch_device_attrs;
?? OLDTITLE, EJECT ??

    crack_device_control_resp (message, msg_length, io_station_name, device_name, response_code, status);

    find_io_station_or_remote_sys (io_station_name, connection, io_station, io_station_found);
    IF io_station_found THEN
      find_batch_device (device_name, io_station, device, device_found);
      IF device_found THEN
        change_batch_device_attrs (message, msg_length, device^, status);
        IF status.normal AND (response_code = nfc$dc_msg_accepted) THEN
          old_bd := device^;
        IFEND;

        device^.outstanding_di_responses [nfc$change_bd_attr] := device^.outstanding_di_responses
              [nfc$change_bd_attr] - 1;

        IF io_station^.operator_assigned THEN
          operator_connection := io_station^.connected_operator;
          nfp$send_message_on_connection (message, message_length, operator_connection^.id, status);
          IF scfs_event_logging THEN
            log_connection_message (operator_connection^, message_length, message);
          IFEND;
        IFEND;

        IF device_available_for_output (device) THEN
          find_file_for_device (device, message, status);
        IFEND;
      IFEND;
    IFEND;

  PROCEND change_batch_device_attr_resp;
?? TITLE := 'change batch device attributes', EJECT ??

{  PURPOSE:
{    This procedure is executed when a change batch device attributes
{    operator command is received from OPES.  SCFS forwards the change
{    request to SCF/DI if the station and the device for which the request
{    was made are known, otherwise a negative response is sent to OPES.
{
{    This procedure is also executed when a change batch stream attributes
{    operator command is received from OPENTF.  SCFS forwards the change
{    request to SCF/DI if the NTF remote system and the stream for which the
{    request was made are known, otherwise a negative response is sent to
{    OPENTF.

  PROCEDURE change_batch_device_attributes
    (VAR message: ^nft$message_sequence;
         message_length: integer;
         connection: ^nft$connection;
     VAR msg_length: integer;
     VAR status: ost$status);

    VAR
      changed_device_attrs: nft$batch_device,
      device: ^nft$batch_device,
      device_found: boolean,
      device_name: ost$name,
      di_connection: ^nft$connection,
      io_station: ^nft$io_station,
      io_station_found: boolean,
      io_station_name: ost$name,
      new_device_attributes: nft$batch_device,
      response: nft$device_control_resp_codes;

*copyc nft$change_bd_attributes_msg
?? NEWTITLE := 'get required parameters', EJECT ??

{  PURPOSE:
{    This procedure determines the values for the required parameters
{    on a change batch device attributes command.  The required parameters
{    identify which device on which station should be changed.

    PROCEDURE get_required_parameters
      (VAR message: ^nft$message_sequence;
       VAR msg_length: integer;
       VAR station_name: ost$name;
       VAR device_name: ost$name;
       VAR status: ost$status);

      VAR
        ascii_string: ^string ( * <= osc$max_name_size),
        byte_array: ^nft$byte_array,
        parameter: ^nft$change_bd_attr_parameter,
        value_length: integer;

      NEXT parameter IN message;

      WHILE (parameter <> NIL) AND (parameter^.param <= nfc$device_name) AND (msg_length > 0) DO
        msg_length := msg_length - 1;
        IF parameter^.length_indicated THEN
          nfp$get_parameter_value_length (message, msg_length, value_length, status);
          msg_length := msg_length - value_length;
        ELSE
          value_length := 1;
          msg_length := msg_length - 1;
        IFEND;

        CASE parameter^.param OF
        = nfc$io_station_name =
          NEXT ascii_string: [value_length] IN message;
          #translate (osv$lower_to_upper, ascii_string^, station_name);

        = nfc$device_name =
          NEXT ascii_string: [value_length] IN message;
          #translate (osv$lower_to_upper, ascii_string^, device_name);
        ELSE
{         ERROR ----   Ignore parameter value.
          NEXT byte_array: [1 .. value_length] IN message;

        CASEND;
        NEXT parameter IN message;
      WHILEND;

      RESET message TO parameter;

    PROCEND get_required_parameters;
?? OLDTITLE, EJECT ??

    get_required_parameters (message, msg_length, io_station_name, device_name, status);

    find_io_station_or_remote_sys (io_station_name, connection, io_station, io_station_found);
    IF NOT io_station_found THEN
      response := nfc$dc_msg_reject_unknown_ios;
    ELSE
      find_batch_device (device_name, io_station, device, device_found);
      IF NOT device_found THEN
        response := nfc$dc_msg_reject_unknown_dev;
      ELSE
        response := nfc$dc_msg_accepted;
        di_connection := device^.scfdi_connection;
        device^.outstanding_di_responses [nfc$change_bd_attr] := device^.outstanding_di_responses
              [nfc$change_bd_attr] + 1;
        nfp$send_message_on_connection (message, message_length, di_connection^.id, status);
        IF scfs_event_logging THEN
          log_connection_message (di_connection^, message_length, message);
        IFEND;
      IFEND;
    IFEND;

    IF response <> nfc$dc_msg_accepted THEN
      send_device_control_response (message, nfc$change_bat_device_attr_resp, io_station_name, device_name,
            response, connection, status);
    IFEND;

  PROCEND change_batch_device_attributes;
?? TITLE := 'change batch device status', EJECT ??

{  PURPOSE:
{    This procedure is executed when a request is received from SCF/DI informing
{    SCFS that the status of a device has changed.  SCFS tables are updated
{    accordingly.
{
{    This procedure is also executed when a request is received from SCF/DI
{    informing SCFS that the status of an NTF batch stream has changed.  SCFS
{    tables are updated accordingly.

  PROCEDURE change_batch_device_status
    (VAR message: ^nft$message_sequence;
         connection: ^nft$connection;
     VAR msg_length: integer;
     VAR status: ost$status);

    VAR
      device: ^nft$batch_device,
      device_found: boolean,
      device_name: ost$name,
      device_status: ^nft$device_status,
      file_transfer_status: ^nft$file_transfer_status,
      io_station: ^nft$io_station,
      io_station_found: boolean,
      io_station_name: ost$name,
      ntf_logical_line: ^nft$ntf_logical_line,
      ntf_logical_line_found: boolean;

*copy nft$batch_device_status_message

?? NEWTITLE := 'get required parameters', EJECT ??

{  PURPOSE:
{    This procedure gets the required parameters and their values
{    for a batch device status command sent by SCF/DI.

    PROCEDURE get_required_parameters
      (VAR message: ^nft$message_sequence;
       VAR msg_length: integer;
       VAR station_name: ost$name;
       VAR device_name: ost$name;
       VAR device_status: ^nft$device_status;
       VAR file_transfer_status: ^nft$file_transfer_status;
       VAR status: ost$status);

      VAR
        ascii_string: ^string ( * <= osc$max_name_size),
        byte_array: ^nft$byte_array,
        parameter: ^nft$bd_status_message_parameter,
        value_length: integer;

      NEXT parameter IN message;

      WHILE (parameter <> NIL) AND (parameter^.param <> nfc$null_parameter) AND (msg_length > 0) DO
        msg_length := msg_length - 1;
        IF parameter^.length_indicated THEN
          nfp$get_parameter_value_length (message, msg_length, value_length, status);
          msg_length := msg_length - value_length;
        ELSE
          value_length := 1;
          msg_length := msg_length - 1;
        IFEND;

        CASE parameter^.param OF
        = nfc$io_station_name =
          NEXT ascii_string: [value_length] IN message;
          #translate (osv$lower_to_upper, ascii_string^, station_name);

        = nfc$device_name =
          NEXT ascii_string: [value_length] IN message;
          #translate (osv$lower_to_upper, ascii_string^, device_name);

        = nfc$device_status =
          NEXT device_status IN message;

        = nfc$file_transfer_status_param =
          NEXT file_transfer_status IN message;

        ELSE
{         ERROR ----   Ignore parameter value.
          NEXT byte_array: [1 .. value_length] IN message;

        CASEND;
        NEXT parameter IN message;
      WHILEND;

    PROCEND get_required_parameters;
?? OLDTITLE, EJECT ??

    get_required_parameters (message, msg_length, io_station_name, device_name, device_status,
          file_transfer_status, status);

    find_io_station_or_remote_sys (io_station_name, connection, io_station, io_station_found);
    IF io_station_found THEN
      find_batch_device (device_name, io_station, device, device_found);
      IF device_found THEN
        device^.device_status := device_status^;
        device^.file_transfer_status := file_transfer_status^;
        IF (io_station^.usage = nfc$ntf_remote_system) AND (device^.device_type = nfc$console) THEN
           find_ntf_logical_line (device^.ntf_logical_line_number, io_station, ntf_logical_line,
                 ntf_logical_line_found);
           ntf_logical_line^.signon_status := device_status^;
           ntf_logical_line^.console_stream_name := device^.name;
           IF ntf_logical_line^.signon_status = nfc$ntf_signed_on THEN
             find_files_for_ntf_logical_line (io_station, ntf_logical_line^.logical_line_number,
                   message, status);
           IFEND;

           send_ntf_signon_status_message (ntf_signon_statuses [ntf_logical_line^.signon_status], io_station,
                 ntf_logical_line, status);
        IFEND;

        IF device_available_for_output (device) THEN
          device^.current_file := NIL;
          find_file_for_device (device, message, status);
        IFEND;
      IFEND;
    IFEND;

  PROCEND change_batch_device_status;
?? TITLE := 'change_btf_ve_status', EJECT ??

{  PURPOSE:
{    This procedure is executed when a message is received from SCF/VE
{    informing SCFS of the status of BTF/VE.  This status indicates the
{    protocol stack(s) supported by BTF/VE.

  PROCEDURE change_btf_ve_status
    (VAR message: ^nft$message_sequence;
         connection: ^nft$connection;
     VAR msg_length: integer;
     VAR status: ost$status);

    VAR
      btf_ve_protocol_stacks_integer: ^nat$protocol_stack_integer,
      byte_array: ^nft$byte_array,
      parameter: ^nft$btf_ve_status_parameter,
      value_length: integer;

*copy nft$btf_ve_status_message

    NEXT parameter IN message;

    WHILE (parameter <> NIL) AND (parameter^.param <> nfc$null_parameter) AND
          (msg_length > 0) DO
      msg_length := msg_length - 1;
      IF parameter^.length_indicated THEN
        nfp$get_parameter_value_length (message, msg_length, value_length,
              status);
        msg_length := msg_length - value_length;
      ELSE
        value_length := 1;
        msg_length := msg_length - 1;
      IFEND;

      IF parameter^.param = nfc$btf_ve_protocol_stacks THEN
        NEXT btf_ve_protocol_stacks_integer IN message;
      ELSE
{ ERROR ----   Ignore parameter value.
        NEXT byte_array: [1 .. value_length] IN message;
      IFEND;
      NEXT parameter IN message;
    WHILEND;

    IF (connection^.kind = nfc$scfve_connection) OR
          (connection^.kind = nfc$ntfve_connection) THEN
      connection^.btf_ve_status_received := TRUE;
      connection^.btf_ve_protocol_stacks := $protocol_stacks_set [];

{ Convert integer received from SCF/DI to set type:
{ - First check for XNS bit set

      IF (((btf_ve_protocol_stacks_integer^ DIV nac$xns_protocol_stack) DIV 2) * 2) <>
            (btf_ve_protocol_stacks_integer^ DIV nac$xns_protocol_stack) THEN
        connection^.btf_ve_protocol_stacks := connection^.btf_ve_protocol_stacks +
              $protocol_stacks_set [xns_protocol_stack];
      IFEND;

{ - Next check for OSI bit set

      IF (((btf_ve_protocol_stacks_integer^ DIV nac$osi_protocol_stack) DIV 2) * 2) <>
            (btf_ve_protocol_stacks_integer^ DIV nac$osi_protocol_stack) THEN
        connection^.btf_ve_protocol_stacks := connection^.btf_ve_protocol_stacks +
              $protocol_stacks_set [osi_protocol_stack];
      IFEND;
    IFEND;

  PROCEND change_btf_ve_status;
?? TITLE := 'change btfs di status', EJECT ??

{  PURPOSE:
{    This procedure is executed when a message is received from SCF/DI informing
{    SCFS that BTFS/DI service is available and the network address or title used
{    to access that service.  This message is usually sent after a new connection
{    is established between SCFS and SCF/DI.  This status message may also be
{    used to inform SCFS that the service has failed.

  PROCEDURE change_btfs_di_status
    (VAR message: ^nft$message_sequence;
         connection: ^nft$connection;
     VAR msg_length: integer;
     VAR status: ost$status);

    VAR
      ascii_string: ^string ( * <= osc$max_name_size),
      btfs_di_advanced_features: ^nft$btfs_di_advanced_features,
      btfs_di_network_address: ^nft$network_address,
      btfs_di_status_code: ^nft$btfs_di_status_codes,
      btfs_di_title: ^nft$btfs_di_title,
      btfs_di_title_string: ^nat$title_pattern,
      byte_array: ^nft$byte_array,
      parameter: ^nft$btfs_di_status_parameter,
      value_length: integer;

*copy nft$btfs_di_status_message

?? NEWTITLE := 'update_devices_btfs_di_statuses', EJECT ??

    PROCEDURE update_devices_btfs_di_statuses
      (    first_io_station: ^nft$io_station;
           connection: ^nft$connection;
           btfs_di_network_address: ^nft$network_address,
           btfs_di_status_code: ^nft$btfs_di_status_codes,
           btfs_di_title: ^nft$btfs_di_title;
           btfs_di_protocol_stacks: protocol_stacks_set);

      VAR
        device: ^nft$batch_device,
        io_station: ^nft$io_station;

      io_station := first_io_station;
      WHILE io_station <> NIL DO
        device := io_station^.batch_device_list;
        WHILE device <> NIL DO
          IF device^.scfdi_connection = connection THEN
            device^.btfs_di_status := btfs_di_status_code^;
            IF btfs_di_network_address <> NIL THEN
              device^.btfs_di_address := btfs_di_network_address^;
            IFEND;
            IF btfs_di_title <> NIL THEN
              device^.btfs_di_title := btfs_di_title^;
            IFEND;
            device^.btfs_di_protocol_stacks := btfs_di_protocol_stacks;
          IFEND;
          device := device^.link;
        WHILEND;
        io_station := io_station^.link;
      WHILEND;

    PROCEND update_devices_btfs_di_statuses;
?? OLDTITLE, EJECT ??

    btfs_di_advanced_features := NIL;
    btfs_di_network_address := NIL;
    btfs_di_title := NIL;
    NEXT parameter IN message;

    WHILE (parameter <> NIL) AND (parameter^.param <> nfc$null_parameter) AND (msg_length > 0) DO
      msg_length := msg_length - 1;
      IF parameter^.length_indicated THEN
        nfp$get_parameter_value_length (message, msg_length, value_length, status);
        msg_length := msg_length - value_length;
      ELSE
        value_length := 1;
        msg_length := msg_length - 1;
      IFEND;

      CASE parameter^.param OF
      = nfc$btfs_di_network_address =
        NEXT btfs_di_network_address IN message;

      = nfc$btfs_status_code =
        NEXT btfs_di_status_code IN message;

      = nfc$btfs_di_title =
        NEXT btfs_di_title_string: [value_length] IN message;
        PUSH btfs_di_title;
        btfs_di_title^.length := value_length;
        btfs_di_title^.title := btfs_di_title_string^;

      = nfc$btfs_di_advanced_features =
        NEXT btfs_di_advanced_features IN message;

      ELSE
{ ERROR ----   Ignore parameter value.
        NEXT byte_array: [1 .. value_length] IN message;
      CASEND;
      NEXT parameter IN message;
    WHILEND;

    IF connection^.kind = nfc$scfdi_connection THEN
      connection^.btfs_di_protocol_stacks := $protocol_stacks_set [];
      connection^.btfs_di_status := btfs_di_status_code^;
      IF btfs_di_network_address <> NIL THEN
        connection^.btfs_di_address := btfs_di_network_address^;
        connection^.btfs_di_protocol_stacks := connection^.btfs_di_protocol_stacks +
                  $protocol_stacks_set [xns_protocol_stack];
      IFEND;
      IF btfs_di_title <> NIL THEN
        connection^.btfs_di_title := btfs_di_title^;
        connection^.btfs_di_protocol_stacks := connection^.btfs_di_protocol_stacks +
                  $protocol_stacks_set [osi_protocol_stack];
      IFEND;
      IF btfs_di_advanced_features <> NIL THEN
        connection^.btfs_di_advanced_features := btfs_di_advanced_features^;
      IFEND;
      update_devices_btfs_di_statuses (scfs_tables.first_io_station, connection,
            btfs_di_network_address, btfs_di_status_code, btfs_di_title,
                  connection^.btfs_di_protocol_stacks);
      update_devices_btfs_di_statuses (scfs_tables.first_ntf_remote_system,
            connection, btfs_di_network_address, btfs_di_status_code, btfs_di_title,
                  connection^.btfs_di_protocol_stacks);
    IFEND;

  PROCEND change_btfs_di_status;
?? TITLE := 'change file transfer status', EJECT ??

{  PURPOSE:
{    This procedure is executed when a message is received from SCF/DI informing
{    SCFS that the "file transfer status" has changed (e.g. start or end of a
{    file transfer) for a particular device.  If file acknowledgement is turned
{    on for the station or device, and a file status message is received
{    indicating an output file started, an output file completed or an input
{    job completed, SCFS sends a message to the station operator (if one is
{    currently assigned).
{
{    This procedure is also executed when a message is received from SCF/DI
{    informing SCFS that the "file transfer status" has changed (e.g.  start or
{    end of a file transfer) for a particular NTF batch stream.

  PROCEDURE change_file_transfer_status
    (VAR message: ^nft$message_sequence;
         connection: ^nft$connection;
     VAR msg_length: integer;
     VAR status: ost$status);

    VAR
      actual_destination: ost$name,
      device: ^nft$batch_device,
      device_found: boolean,
      device_name: ost$name,
      device_status: ^nft$device_status,
      bytes_transferred: integer,
      file_status_transition: file_status_transition_kind,
      file_position: nft$file_position,
      file_transfer_status: ^nft$file_transfer_status,
      ignore_status: ost$status,
      io_station: ^nft$io_station,
      io_station_found: boolean,
      io_station_name: ost$name,
      job_file_name: ost$name,
      old_file_xfer_status: nft$file_transfer_status,
      operator_connection: ^nft$connection,
      q_file: ^nft$output_queue_file,
      requested_destination: ost$name,
      system_family: ost$name,
      system_file_name: ost$name,
      system_job_name: ost$name,
      user_file_name: ost$name,
      user_job_name: ost$name,
      user_name: ost$name;

*copy nft$file_status_message

?? NEWTITLE := 'get input parameters', EJECT ??

{  PURPOSE:
{    Get the parameters and values sent by SCF/DI if the file
{    transfer status changed on an input device.

    PROCEDURE get_input_parameters
      (VAR message: ^nft$message_sequence;
       VAR msg_length: integer;
       VAR actual_destination: ost$name;
       VAR user_job_name: ost$name;
       VAR requested_destination: ost$name;
       VAR system_job_name: ost$name;
       VAR bytes_transferred: integer;
       VAR status: ost$status);

      VAR
        ascii_string: ^string ( * <= osc$max_name_size),
        byte_array: ^nft$byte_array,
        bytes: ^nft$input_job_size,
        parameter: ^nft$file_status_message_param,
        value_length: integer;

      actual_destination := osc$null_name;
      user_job_name := osc$null_name;
      requested_destination := osc$null_name;
      system_job_name := osc$null_name;

      NEXT parameter IN message;

      WHILE (parameter <> NIL) AND (parameter^.param <> nfc$null_parameter) AND (msg_length > 0) DO
        msg_length := msg_length - 1;
        IF parameter^.length_indicated THEN
          nfp$get_parameter_value_length (message, msg_length, value_length, status);
          msg_length := msg_length - value_length;
        ELSE
          value_length := 1;
          msg_length := msg_length - 1;
        IFEND;

        CASE parameter^.param OF
        = nfc$system_job_file_name =
          NEXT ascii_string: [value_length] IN message;
          #translate (osv$lower_to_upper, ascii_string^, system_job_name);

        = nfc$user_job_file_name =
          NEXT ascii_string: [value_length] IN message;
          #translate (osv$lower_to_upper, ascii_string^, user_job_name);

        = nfc$actual_destination =
          NEXT ascii_string: [value_length] IN message;
          #translate (osv$lower_to_upper, ascii_string^, actual_destination);

        = nfc$requested_destination =
          NEXT ascii_string: [value_length] IN message;
          #translate (osv$lower_to_upper, ascii_string^, requested_destination);

        = nfc$input_bytes_transferred =
          NEXT bytes IN message;
          bytes_transferred := bytes^;

        ELSE
{         ERROR ----   Ignore parameter value.
          NEXT byte_array: [1 .. value_length] IN message;
        CASEND;
        NEXT parameter IN message;
      WHILEND;

    PROCEND get_input_parameters;
?? TITLE := 'get required output parameters', EJECT ??

{  PURPOSE:
{    Get the parameters and values sent by SCF/DI if the file
{    transfer status changed on an output device.

    PROCEDURE get_required_output_parameters
      (VAR message: ^nft$message_sequence;
       VAR msg_length: integer;
       VAR system_file_name: ost$name;
       VAR system_family: ost$name;
       VAR user_file_name: ost$name;
       VAR file_position: nft$file_position;
       VAR status: ost$status);

      VAR
        ascii_string: ^string ( * <= osc$max_name_size),
        byte_array: ^nft$byte_array,
        parameter: ^nft$file_status_message_param,
        percent_complete: ^nft$file_position,
        value_length: integer;

      NEXT parameter IN message;

      WHILE (parameter <> NIL) AND (parameter^.param <> nfc$null_parameter) AND (msg_length > 0) DO
        msg_length := msg_length - 1;
        IF parameter^.length_indicated THEN
          nfp$get_parameter_value_length (message, msg_length, value_length, status);
          msg_length := msg_length - value_length;
        ELSE
          value_length := 1;
          msg_length := msg_length - 1;
        IFEND;

        CASE parameter^.param OF
        = nfc$system_job_file_name =
          NEXT ascii_string: [value_length] IN message;
          #translate (osv$lower_to_upper, ascii_string^, system_file_name);

        = nfc$system_id_family =
          NEXT ascii_string: [value_length] IN message;
          #translate (osv$lower_to_upper, ascii_string^, system_family);

        = nfc$user_job_file_name =
          NEXT ascii_string: [value_length] IN message;
          #translate (osv$lower_to_upper, ascii_string^, user_file_name);

        = nfc$file_position =
          NEXT percent_complete IN message;
          file_position := percent_complete^;

        ELSE
{         ERROR ----   Ignore parameter value.
          NEXT byte_array: [1 .. value_length] IN message;

        CASEND;
        NEXT parameter IN message;
      WHILEND;

    PROCEND get_required_output_parameters;
?? TITLE := 'get required parameters', EJECT ??

{  PURPOSE:
{    Get the parameters and values sent by SCF/DI if the file
{    transfer status changed on either type of device, input
{    or output.

    PROCEDURE get_required_parameters
      (VAR message: ^nft$message_sequence;
       VAR msg_length: integer;
       VAR station_name: ost$name;
       VAR device_name: ost$name;
       VAR device_status: ^nft$device_status;
       VAR file_transfer_status: ^nft$file_transfer_status;
       VAR status: ost$status);

      VAR
        ascii_string: ^string ( * <= osc$max_name_size),
        byte_array: ^nft$byte_array,
        parameter: ^nft$file_status_message_param,
        value_length: integer;

      NEXT parameter IN message;

      WHILE (parameter <> NIL) AND (parameter^.param <= nfc$file_transfer_status_param) AND (msg_length > 0)
            DO
        msg_length := msg_length - 1;
        IF parameter^.length_indicated THEN
          nfp$get_parameter_value_length (message, msg_length, value_length, status);
          msg_length := msg_length - value_length;
        ELSE
          value_length := 1;
          msg_length := msg_length - 1;
        IFEND;

        CASE parameter^.param OF
        = nfc$io_station_name =
          NEXT ascii_string: [value_length] IN message;
          #translate (osv$lower_to_upper, ascii_string^, station_name);

        = nfc$device_name =
          NEXT ascii_string: [value_length] IN message;
          #translate (osv$lower_to_upper, ascii_string^, device_name);

        = nfc$device_status =
          NEXT device_status IN message;

        = nfc$file_transfer_status_param =
          NEXT file_transfer_status IN message;

        ELSE
{         ERROR ----   Ignore parameter value.
          NEXT byte_array: [1 .. value_length] IN message;

        CASEND;
        NEXT parameter IN message;
      WHILEND;

      RESET message TO parameter;

    PROCEND get_required_parameters;
?? OLDTITLE, EJECT ??

    bytes_transferred := 0;
    job_file_name := osc$null_name;
    user_name := osc$null_name;

    get_required_parameters (message, msg_length, io_station_name, device_name, device_status,
          file_transfer_status, status);

    find_io_station_or_remote_sys (io_station_name, connection, io_station, io_station_found);
    IF io_station_found THEN
      find_batch_device (device_name, io_station, device, device_found);
      IF device_found THEN
        device^.device_status := device_status^;
        old_file_xfer_status := device^.file_transfer_status;
        device^.file_transfer_status := file_transfer_status^;

        q_file := device^.current_file;
{       Modify file status
        IF output_device_or_stream (device) THEN
          IF msg_length > 0 THEN
            get_required_output_parameters (message, msg_length, system_file_name, system_family,
                  user_file_name, file_position, status);
            IF q_file <> NIL THEN
              q_file^.percent_complete := file_position;
            IFEND;
          IFEND;
        ELSEIF input_device_or_stream (device) THEN
          IF msg_length > 0 THEN
            get_input_parameters (message, msg_length, actual_destination, user_job_name,
                  requested_destination, system_job_name, bytes_transferred, status);
            device^.input_job.input_bytes_transferred := bytes_transferred;
          IFEND;
        IFEND;

        file_status_transition := no_transition;
        IF (old_file_xfer_status >= nfc$busy) AND (device^.file_transfer_status < nfc$busy) THEN
          file_status_transition := file_transfer_completed;
        ELSEIF (old_file_xfer_status < nfc$busy) AND (device^.file_transfer_status = nfc$busy) THEN
          file_status_transition := file_transfer_begun;
        IFEND;

{  Update the file transfer status information.

        IF (file_status_transition <> no_transition) THEN

          IF output_device_or_stream (device) THEN
            IF q_file <> NIL THEN
              job_file_name := q_file^.user_file_name;
              user_name := q_file^.user_name;
              IF (file_status_transition = file_transfer_begun) OR
                    (file_status_transition = file_transfer_completed) THEN
                bytes_transferred := q_file^.file_size;
              ELSE
                bytes_transferred := 0;
              IFEND;
            IFEND;
          ELSEIF input_device_or_stream (device) THEN

{  An input job has started.  Obtain the job information.

            IF (file_status_transition = file_transfer_begun) THEN
              IF user_job_name <> osc$null_name THEN
                device^.input_job.user_job_name := user_job_name;
              IFEND;
              IF system_job_name <> osc$null_name THEN
                device^.input_job.system_job_name := system_job_name;
              IFEND;
              IF requested_destination <> osc$null_name THEN
                device^.input_job.requested_destination := requested_destination;
              IFEND;
              IF actual_destination <> osc$null_name THEN
                device^.input_job.actual_destination := actual_destination;
              IFEND;

{  An input job has completed.  Delete the information for the input job
{  from the data structure.

            ELSEIF (file_status_transition = file_transfer_completed) THEN
              device^.input_job.user_job_name := osc$null_name;
              device^.input_job.system_job_name := osc$null_name;
              device^.input_job.requested_destination := osc$null_name;
              device^.input_job.actual_destination := osc$null_name;
              device^.input_job.input_bytes_transferred := 0;
              IF user_job_name <> osc$null_name THEN
                job_file_name := user_job_name;
              ELSEIF system_job_name <> osc$null_name THEN
                job_file_name := system_job_name;
              IFEND;
            IFEND;
          IFEND;

{  Send a file acknowledgement message if an output file transfer has
{  started or finished and if an input job has completed or if an NTF
{  file transfer has started or finished.

          IF (io_station^.usage = nfc$ntf_remote_system) OR (io_station^.operator_assigned AND
                (io_station^.file_acknowledgement OR device^.file_acknowledgement) AND
                (output_device_or_stream (device) OR (input_device_or_stream (device)
                AND (file_status_transition = file_transfer_completed)))) THEN
            operator_connection := io_station^.connected_operator;
            IF (job_file_name = osc$null_name) AND (io_station^.usage = nfc$ntf_remote_system) THEN
              IF input_device_or_stream (device) THEN
                job_file_name := 'NTF_RECEIVE_FILE';
              ELSE
                job_file_name := 'NTF_TRANSMIT_FILE';
              IFEND;
            IFEND;

            send_file_acknowledgement_msg (message, device, file_ack_messages [device^.file_transfer_status],
                  job_file_name, user_name, bytes_transferred, operator_connection,
                  ignore_status);
          IFEND;
        IFEND;

{ If the device is an output device, update the file transfer information. }

        IF output_device_or_stream (device) THEN
          IF (file_status_transition = file_transfer_completed) AND
                (device^.file_transfer_status <> nfc$idle_operator_hold_file) AND
                (q_file <> NIL) AND
                (q_file^.copies > 1) THEN
            q_file^.copies := q_file^.copies - 1;

{  Update the number of copies printed, and return so that another file is
{  not selected to print at that device.

            RETURN;
          ELSEIF file_status_transition = file_transfer_completed THEN
            device^.suppress_carriage_control := FALSE;
            device^.current_file := NIL;
            IF device^.file_transfer_status = nfc$idle_operator_hold_file THEN
              IF q_file <> NIL THEN
                q_file^.output_state := nfc$hold_transfer;
              IFEND;
            IFEND;
          IFEND;

          IF device_available_for_output (device) THEN
            find_file_for_device (device, message, status);
          IFEND;
        IFEND;
      IFEND;
    IFEND;

  PROCEND change_file_transfer_status;
?? TITLE := 'check_for_ntf_signed_on_stream', EJECT ??

{  PURPOSE:
{    Check if the specified NTF batch stream is on a signed on logical line.

  PROCEDURE check_for_ntf_signed_on_stream
    (    remote_system: ^nft$io_station;
         batch_stream: ^nft$batch_device;
     VAR signed_on: boolean);

    VAR
      logical_line: ^nft$ntf_logical_line,
      logical_line_found: boolean;

    find_ntf_logical_line (batch_stream^.ntf_logical_line_number, remote_system, logical_line,
          logical_line_found);
    signed_on := logical_line_found AND (logical_line^.signon_status = nfc$ntf_signed_on);

  PROCEND check_for_ntf_signed_on_stream;
?? OLDTITLE ??
?? NEWTITLE := 'check_unreachable_btfs_di_lists', EJECT ??

{  PURPOSE:
{    Sweep through all the SCF/VE lists of unreachable BTFS/DI's looking for
{    expired timers.  When an expired timer is found then the entry in the list
{    of unreachable BTFS/DI's is removed and file assignents are attempted for
{    files queued for that DI.

  PROCEDURE check_unreachable_btfs_di_lists
    (VAR wait_list: ^ost$i_wait_list;
     VAR message: ^nft$message_sequence);

    VAR
      clock: integer,
      connection: ^nft$connection,
      current_unreachable_btfs_di: ^unreachable_btfs_di,
      ignore_status: ost$status,
      next_unreachable_btfs_di: ^unreachable_btfs_di,
      previous_unreachable_btfs_di: ^unreachable_btfs_di,
      timers_still_active: boolean;

?? NEWTITLE := 'retry_file_assignment', EJECT ??

{  PURPOSE:
{    Attempt to assign all eligible files in this SCF/VE connection's queue.

    PROCEDURE retry_file_assignment
      (    connection: ^nft$connection;
       VAR message: ^nft$message_sequence);

      VAR
        alias_station_list: ^nft$pointer_list_entry,
        ignore_status: ost$status,
        io_station: ^nft$io_station,
        q_found: boolean,
        queue_file: ^nft$output_queue_file,
        queue_pointer: ^ ^nft$output_queue_file; {!!}

      queue_file := connection^.scfve_queue;

      WHILE queue_file <> NIL DO
        IF queue_file^.output_state = nfc$eligible_for_transfer THEN
          q_found := FALSE;

          IF queue_file^.ios_usage = nfc$public_io_station THEN
            find_public_queue (queue_file^.ios_name, queue_pointer, alias_station_list, q_found);
            IF q_found THEN
              io_station := alias_station_list^.io_station;
              q_found := io_station^.usage = nfc$public_io_station;
            IFEND;

          ELSEIF (queue_file^.ios_usage = nfc$private_io_station) AND
                (queue_file^.ios_name = control_facility_name) THEN
            find_private_queue (queue_file^.operator_name, queue_file^.operator_family,
                  queue_pointer, alias_station_list, q_found);

          ELSEIF queue_file^.ios_usage = nfc$ntf_remote_system THEN
            find_ntf_remote_queue (queue_file^.ios_name, queue_pointer, alias_station_list);
            q_found := queue_pointer <> NIL;
          IFEND;

          IF q_found THEN
            output_file_assignment (queue_file, alias_station_list, message, connection,
                  ignore_status);
          IFEND;
        IFEND;

        queue_file := queue_file^.link;

      WHILEND;

    PROCEND retry_file_assignment;
?? OLDTITLE, EJECT ??

    pmp$get_microsecond_clock (clock, ignore_status);
    clock := clock DIV 1000;
    connection := scfs_tables.first_connection;
    timers_still_active := FALSE;

  /loop_thru_connections/
    WHILE connection <> NIL DO
      IF connection^.kind = nfc$scfve_connection THEN
        current_unreachable_btfs_di := connection^.unreachable_btfs_di_list;
        previous_unreachable_btfs_di := NIL;

      /loop_thru_unreachable_list/
        WHILE current_unreachable_btfs_di <> NIL DO
          next_unreachable_btfs_di := current_unreachable_btfs_di^.link;
          IF clock >= current_unreachable_btfs_di^.timer THEN
            IF previous_unreachable_btfs_di = NIL THEN
              connection^.unreachable_btfs_di_list := current_unreachable_btfs_di^.link;
            ELSE
              previous_unreachable_btfs_di^.link := current_unreachable_btfs_di^.link;
            IFEND;
            FREE current_unreachable_btfs_di;
            retry_file_assignment (connection, message);
          ELSE
            timers_still_active := TRUE;
            previous_unreachable_btfs_di := current_unreachable_btfs_di;
          IFEND;
          current_unreachable_btfs_di := next_unreachable_btfs_di;
        WHILEND /loop_thru_unreachable_list/;

      IFEND;
      connection := connection^.link;
    WHILEND /loop_thru_connections/;

    IF NOT timers_still_active THEN
      wait_list^ [2].milliseconds := long_scfs_timer;
    IFEND;

  PROCEND check_unreachable_btfs_di_lists;
?? OLDTITLE ??
?? NEWTITLE := 'clear_unreachable_btfs_di_list', EJECT ??

{  PURPOSE:
{    Delete all entries in the SCF/VE's list of unreachable BTFS/DI's.

  PROCEDURE clear_unreachable_btfs_di_list
    (    connection: ^nft$connection);

    VAR
      current_pointer: ^unreachable_btfs_di,
      next_pointer: ^unreachable_btfs_di;

    current_pointer := connection^.unreachable_btfs_di_list;
    next_pointer := current_pointer;

    WHILE next_pointer <> NIL DO
      current_pointer := next_pointer;
      next_pointer := current_pointer^.link;
      FREE current_pointer;
    WHILEND;

    connection^.unreachable_btfs_di_list := NIL;

  PROCEND clear_unreachable_btfs_di_list;
?? OLDTITLE ??
?? NEWTITLE := 'compare_ntf_logical_lines', EJECT ??

{  PURPOSE:
{    This procedure compares logical lines to verify that all fields except
{    pointers are identical to each other.

  PROCEDURE compare_ntf_logical_lines
    (    logical_line_entry_1: nft$ntf_logical_line;
         logical_line_entry_2: nft$ntf_logical_line;
     VAR logical_line_match: boolean);

    logical_line_match := (logical_line_entry_1.logical_line_number =
          logical_line_entry_2.logical_line_number) AND (logical_line_entry_1.line_name =
          logical_line_entry_2.line_name) AND (logical_line_entry_1.line_speed =
          logical_line_entry_2.line_speed) AND (logical_line_entry_1.signon_status =
          logical_line_entry_2.signon_status) AND (logical_line_entry_1.terminal_user_procedure =
          logical_line_entry_2.terminal_user_procedure) AND
          (logical_line_entry_1.scfdi_connection = logical_line_entry_2.scfdi_connection);

  PROCEND compare_ntf_logical_lines;
?? TITLE := 'compare_ntf_remote_systems', EJECT ??

{  PURPOSE:
{    This procedure compares two remote systems to verify that all fields
{    except pointers are identical to each other.

  PROCEDURE compare_ntf_remote_systems
    (    remote_system_entry_1: nft$io_station;
         remote_system_entry_2: nft$io_station;
     VAR remote_system_match: boolean);

    remote_system_match := (remote_system_entry_1.name = remote_system_entry_2.name) AND
          (remote_system_entry_1.usage = remote_system_entry_2.usage) AND
          (remote_system_entry_1.ntf_protocol = remote_system_entry_2.ntf_protocol) AND
          (remote_system_entry_1.ntf_local_system_name = remote_system_entry_2.ntf_local_system_name) AND
          (remote_system_entry_1.ntf_authority_level = remote_system_entry_2.ntf_authority_level) AND
          (remote_system_entry_1.ntf_wait_a_bit = remote_system_entry_2.ntf_wait_a_bit) AND
          (remote_system_entry_1.ntf_inactivity_timer = remote_system_entry_2.ntf_inactivity_timer) AND
          (remote_system_entry_1.ntf_positive_acknowledge =
          remote_system_entry_2.ntf_positive_acknowledge) AND
          (remote_system_entry_1.ntf_remote_password = remote_system_entry_2.ntf_remote_password) AND
          (remote_system_entry_1.ntf_local_password = remote_system_entry_2.ntf_local_password) AND
          (remote_system_entry_1.ntf_default_job_destination =
          remote_system_entry_2.ntf_default_job_destination) AND
          (remote_system_entry_1.ntf_default_file_destination =
          remote_system_entry_2.ntf_default_file_destination) AND
          (remote_system_entry_1.ntf_store_forward_destination =
          remote_system_entry_2.ntf_store_forward_destination) AND
          (remote_system_entry_1.ntf_remote_system_type = remote_system_entry_2.ntf_remote_system_type) AND
          (remote_system_entry_1.ntf_route_back_position = remote_system_entry_2.ntf_route_back_position) AND
          (remote_system_entry_1.ntf_request_permission_retry =
          remote_system_entry_2.ntf_request_permission_retry);

  PROCEND compare_ntf_remote_systems;
?? TITLE := 'count of files for station', EJECT ??

  FUNCTION count_of_files_for_station (io_station: ^nft$io_station): integer;

    VAR
      alias_entry: ^nft$alias,
      count: integer,
      i: 0 .. 3,
      q_file: ^nft$output_queue_file,
      selected_file: ^nft$selected_file;

    count := 0;

    IF (io_station^.usage <> nfc$ntf_remote_system) AND (io_station^.selected_files_queue <> NIL) THEN
      selected_file := io_station^.selected_files_queue;
      WHILE selected_file <> NIL DO
        count := count + 1;
        selected_file := selected_file^.link;
      WHILEND;
    IFEND;

    FOR i := 0 TO 3 DO
      IF io_station^.alias_list [i] <> NIL THEN
        alias_entry := io_station^.alias_list [i];
        IF alias_entry^.queue <> NIL THEN
          q_file := alias_entry^.queue;
          WHILE q_file <> NIL DO
            count := count + 1;
            q_file := q_file^.link;
          WHILEND;
        IFEND;
      IFEND;
    FOREND;

    count_of_files_for_station := count;

  FUNCEND count_of_files_for_station;
?? TITLE := 'crack device control resp', EJECT ??

{  PURPOSE:
{    This procedure obtains the required parameters from SCF/DI's
{    response to the following operator commands:
{      -  change_batch_device_attributes
{      -  position_file
{      -  start_batch_device
{      -  stop_batch_device
{      -  suppress_carraige_control
{      -  terminate_transfer

  PROCEDURE crack_device_control_resp
    (VAR message: ^nft$message_sequence;
     VAR msg_length: integer;
     VAR io_station_name: ost$name;
     VAR device_name: ost$name;
     VAR response_code: nft$device_control_resp_codes;
     VAR status: ost$status);

    VAR
      ascii_string: ^string ( * <= osc$max_name_size),
      byte_array: ^nft$byte_array,
      parameter: ^nft$device_control_resp_param,
      resp_code: ^nft$device_control_resp_codes,
      value_length: integer;

*copy nft$device_control_resp_msg

    NEXT parameter IN message;

    WHILE (parameter <> NIL) AND (parameter^.param <= nfc$response_code) AND (msg_length > 0) DO
      msg_length := msg_length - 1;
      IF parameter^.length_indicated THEN
        nfp$get_parameter_value_length (message, msg_length, value_length, status);
        msg_length := msg_length - value_length;
      ELSE
        value_length := 1;
        msg_length := msg_length - 1;
      IFEND;

      CASE parameter^.param OF
      = nfc$io_station_name =
        NEXT ascii_string: [value_length] IN message;
        #translate (osv$lower_to_upper, ascii_string^, io_station_name);

      = nfc$device_name =
        NEXT ascii_string: [value_length] IN message;
        #translate (osv$lower_to_upper, ascii_string^, device_name);

      = nfc$response_code =
        NEXT resp_code IN message;
        response_code := resp_code^;

      ELSE
{       ERROR ----   Ignore parameter value.
        NEXT byte_array: [1 .. value_length] IN message;

      CASEND;
      NEXT parameter IN message;
    WHILEND;

    RESET message TO parameter;

  PROCEND crack_device_control_resp;
?? TITLE := 'create_fake_io_station_for_ntf', EJECT ??

{  PURPOSE:
{     This procedure initializes an IO station entry using an NTF accessible
{     remote system name as the IO station name.  If the accessible remote
{     system exists, the IO station entry will be set up so that its only alias
{     is the accessible remote system.  This is needed so that NTF operators
{     can status files that are queued for only one accessible remote system.

  PROCEDURE create_fake_io_station_for_ntf
    (    ntf_acc_remote_system_name: ost$name;
     VAR fake_io_station_entry: nft$io_station;
     VAR ntf_acc_remote_system_found: boolean);

    VAR
      acc_remote_system: ^nft$alias;

    initialize_io_station (fake_io_station_entry);
    fake_io_station_entry.name := ntf_acc_remote_system_name;
    find_ntf_acc_remote_system (ntf_acc_remote_system_name, acc_remote_system);
    ntf_acc_remote_system_found := (acc_remote_system <> NIL);
    IF ntf_acc_remote_system_found THEN
      fake_io_station_entry.alias_list [0] := acc_remote_system;
    IFEND;

  PROCEND create_fake_io_station_for_ntf;
?? OLDTITLE ??
?? NEWTITLE := 'delete_all_unreachable_btfs_di', EJECT ??

{  PURPOSE:
{    Delete the entry in all SCF/VE lists of unreachable BTFS/DI's that
{    corresponds to the specified BTFS/DI title.

  PROCEDURE delete_all_unreachable_btfs_di
    (    title: nft$btfs_di_title);

    VAR
      connection: ^nft$connection,
      current_unreachable_btfs_di: ^unreachable_btfs_di,
      previous_unreachable_btfs_di: ^unreachable_btfs_di,
      title_found: boolean;

    connection := scfs_tables.first_connection;

  /loop_thru_connections/
    WHILE connection <> NIL DO
      IF connection^.kind = nfc$scfve_connection THEN
        current_unreachable_btfs_di := connection^.unreachable_btfs_di_list;
        previous_unreachable_btfs_di := NIL;
        title_found := FALSE;

      /loop_thru_unreachable_list/
        WHILE (current_unreachable_btfs_di <> NIL) AND (NOT title_found) DO
          IF current_unreachable_btfs_di^.title = title THEN
            title_found := TRUE;
            IF previous_unreachable_btfs_di = NIL THEN
              connection^.unreachable_btfs_di_list := current_unreachable_btfs_di^.link;
            ELSE
              previous_unreachable_btfs_di^.link := current_unreachable_btfs_di^.link;
            IFEND;
            FREE current_unreachable_btfs_di;
          ELSE
            previous_unreachable_btfs_di := current_unreachable_btfs_di;
            current_unreachable_btfs_di := current_unreachable_btfs_di^.link;
          IFEND;
        WHILEND /loop_thru_unreachable_list/;

      IFEND;
      connection := connection^.link;
    WHILEND /loop_thru_connections/;

  PROCEND delete_all_unreachable_btfs_di;
?? OLDTITLE ??
?? NEWTITLE := 'delete batch device msg', EJECT ??

{  PURPOSE:
{    This procedure is executed when a request is received from SCF/DI to
{    delete the definition of an existing batch device within an existing I/O
{    station.  If the station and the device specified are found, the device
{    entry is deleted, otherwise a response is sent to SCF/DI indicating
{    the station or device specified is unknown.
{
{    This procedure is also executed when a request is received from SCF/DI to
{    delete the definition of an existing batch stream within an existing NTF
{    remote system.  If the remote system and the stream specified are found,
{    the stream entry is deleted, otherwise a response is sent to SCF/DI
{    indicating the remote system or stream specified is unknown.

  PROCEDURE delete_batch_device_msg
    (VAR message: ^nft$message_sequence;
         connection: ^nft$connection;
     VAR msg_length: integer;
     VAR status: ost$status);

    VAR
      device: ^nft$batch_device,
      device_found: boolean,
      device_name: ost$name,
      io_station: ^nft$io_station,
      io_station_found: boolean,
      io_station_name: ost$name,
      message_response: nft$delete_bd_responses;

*copy nft$delete_batch_device_message
*copy nft$delete_bd_resp_codes

?? NEWTITLE := 'crack delete batch device msg', EJECT ??

{  PURPOSE:
{    Determine the parameters and values sent by SCF/DI on a
{    delete batch device message.

    PROCEDURE crack_delete_batch_device_msg
      (VAR message: ^nft$message_sequence;
       VAR msg_length: integer;
       VAR station_name: ost$name;
       VAR device_name: ost$name;
       VAR status: ost$status);

      VAR
        ascii_string: ^string ( * <= osc$max_name_size),
        byte_array: ^nft$byte_array,
        parameter: ^nft$del_bd_message_parameter,
        value_length: integer;

      NEXT parameter IN message;

      WHILE (parameter <> NIL) AND (parameter^.param <> nfc$null_parameter) AND (msg_length > 0) DO
        msg_length := msg_length - 1;
        IF parameter^.length_indicated THEN
          nfp$get_parameter_value_length (message, msg_length, value_length, status);
          msg_length := msg_length - value_length;
        ELSE
          value_length := 1;
          msg_length := msg_length - 1;
        IFEND;

        CASE parameter^.param OF
        = nfc$io_station_name =
          NEXT ascii_string: [value_length] IN message;
          #translate (osv$lower_to_upper, ascii_string^, station_name);

        = nfc$device_name =
          NEXT ascii_string: [value_length] IN message;
          #translate (osv$lower_to_upper, ascii_string^, device_name);

        ELSE
{         ERROR ----   Ignore parameter value.
          NEXT byte_array: [1 .. value_length] IN message;

        CASEND;
        NEXT parameter IN message;
      WHILEND;

    PROCEND crack_delete_batch_device_msg;
?? TITLE := 'send delete bd response', EJECT ??

{  PURPOSE:
{    Send a message to SCF/DI indicating SCFS's response to a
{    previous delete batch device message.

    PROCEDURE send_delete_bd_response
      (VAR message: ^nft$message_sequence;
           io_station_name: ost$name;
           device_name: ost$name;
           response_code: nft$delete_bd_responses;
           connection: ^nft$connection;
       VAR status: ost$status);

      VAR
        ascii_string: ^string ( * <= osc$max_name_size),
        message_length: nft$message_length,
        message_type: ^nft$message_kind,
        parameter_kind: ^nft$add_del_bd_resp_parameter,
        parameter_kind_size: nft$message_length,
        param_length_size: nft$message_length,
        parameter_value_length: integer,
        response_param: ^nft$delete_bd_responses;

*copy nft$add_del_device_response

      parameter_kind_size := #SIZE (nft$add_del_bd_resp_parameter);
      RESET message;

      NEXT message_type IN message;
      message_type^ := nfc$delete_batch_device_resp;
      message_length := 1;

      NEXT parameter_kind IN message;
      parameter_kind^.param := nfc$io_station_name;
      parameter_value_length := clp$trimmed_string_size (io_station_name);
      nfp$modify_param_value_length (parameter_value_length);
      parameter_kind^.length_indicated := parameter_value_length > 1;
      IF parameter_kind^.length_indicated THEN
        nfp$put_parameter_value_length (parameter_value_length, message, param_length_size, status);
      ELSE
        param_length_size := 0;
      IFEND;
      NEXT ascii_string: [parameter_value_length] IN message;
      ascii_string^ := io_station_name (1, parameter_value_length);
      message_length := message_length + parameter_kind_size + param_length_size + parameter_value_length;

      NEXT parameter_kind IN message;
      parameter_kind^.param := nfc$device_name;
      parameter_value_length := clp$trimmed_string_size (device_name);
      nfp$modify_param_value_length (parameter_value_length);
      parameter_kind^.length_indicated := parameter_value_length > 1;
      IF parameter_kind^.length_indicated THEN
        nfp$put_parameter_value_length (parameter_value_length, message, param_length_size, status);
      ELSE
        param_length_size := 0;
      IFEND;
      NEXT ascii_string: [parameter_value_length] IN message;
      ascii_string^ := device_name (1, parameter_value_length);
      message_length := message_length + parameter_kind_size + param_length_size + parameter_value_length;

      NEXT parameter_kind IN message;
      parameter_kind^.length_indicated := FALSE;
      parameter_kind^.param := nfc$response_code;
      NEXT response_param IN message;
      response_param^ := response_code;
      message_length := message_length + parameter_kind_size + 1;

      nfp$send_message_on_connection (message, message_length, connection^.id, status);
      IF scfs_event_logging THEN
        log_connection_message (connection^, message_length, message);
      IFEND;

    PROCEND send_delete_bd_response;
?? OLDTITLE, EJECT ??

    message_response := nfc$message_accepted;

    crack_delete_batch_device_msg (message, msg_length, io_station_name, device_name, status);

    find_io_station_or_remote_sys (io_station_name, connection, io_station, io_station_found);
    IF io_station_found THEN
      find_batch_device (device_name, io_station, device, device_found);
      IF device_found THEN
        delete_batch_device_entry (device, io_station);
      ELSE
        message_response := nfc$no_device_found;
      IFEND;
    ELSE
      message_response := nfc$no_io_station_found;
    IFEND;

    send_delete_bd_response (message, io_station_name, device_name, message_response, connection, status);

  PROCEND delete_batch_device_msg;
?? TITLE := 'delete batch device entry', EJECT ??

{  PURPOSE:
{    Delete a batch device entry out of an I/O station's list of associated
{    batch devices or delete a batch stream entry out of an NTF remote system's
{    list of associated batch streams.

  PROCEDURE delete_batch_device_entry
    (VAR device: ^nft$batch_device;
         io_station: ^nft$io_station);

    VAR
      alias_index: 1 .. 3,
      back_link_device: ^nft$batch_device,
      current_file: ^nft$output_queue_file,
      link_device: ^nft$batch_device;

{ If a file is currently being transferred then disassociate it from this device - and hold the file

    current_file := device^.current_file;
    IF (current_file <> NIL) AND (current_file^.assigned_device = device) THEN
      current_file^.assigned_device := NIL;
      current_file^.output_state := nfc$hold_transfer;
    IFEND;

    IF device = io_station^.batch_device_list THEN
      io_station^.batch_device_list := device^.link;
      link_device := io_station^.batch_device_list;
      IF link_device <> NIL THEN
        link_device^.back_link := NIL;
      IFEND;
    ELSE
      back_link_device := device^.back_link;
      back_link_device^.link := device^.link;
      link_device := device^.link;
      IF link_device <> NIL THEN;
        link_device^.back_link := device^.back_link;
      IFEND;
    IFEND;

    FREE device;

  PROCEND delete_batch_device_entry;
?? TITLE := 'delete connection from tables', EJECT ??

{  PURPOSE:
{    This procedure deletes a connection out of a list of
{    connections known to SCFS.

  PROCEDURE delete_connection_from_tables
    (    connection: ^nft$connection);

    VAR
      next_connection: ^nft$connection,
      prior_connection: ^nft$connection;

    next_connection := connection^.link;
    IF connection = scfs_tables.first_connection THEN
      scfs_tables.first_connection := connection^.link;
      IF next_connection <> NIL THEN
        next_connection^.back_link := NIL;
      IFEND;
    ELSE
      prior_connection := connection^.back_link;
      prior_connection^.link := connection^.link;
      IF next_connection <> NIL THEN
        next_connection^.back_link := connection^.back_link;
      IFEND;
    IFEND;

  PROCEND delete_connection_from_tables;
?? TITLE := 'delete file availability msg', EJECT ??

{  PURPOSE:
{    This procedure is executed when a request is received from SCF/VE to
{    delete an output file entry in the output file scheduling queue(s).
{
{    This procedure is also executed when a request is received from NTF/VE to
{    delete an NTF file entry in the NTF file scheduling queue(s).

  PROCEDURE delete_file_availability_msg
    (VAR message: ^nft$message_sequence;
         connection: ^nft$connection;
     VAR msg_length: integer;
     VAR status: ost$status);

    VAR
      device: ^nft$batch_device,
      file_held_by_filter: boolean,
      file_requeued: boolean,
      io_station: ^nft$io_station,
      io_station_name: ost$name,
      q_found: boolean,
      q_file: ^nft$output_queue_file,
      queue_file: nft$output_queue_file,
      queue_pointer: ^^nft$output_queue_file,
      selected_file: ^nft$selected_file,
      station_list: ^nft$pointer_list_entry;

?? NEWTITLE := 'delete file from q', EJECT ??

{  PURPOSE:
{    Delete the queue file from the station queue list,
{    from the SCF/VE connection queue list and from the device.

    PROCEDURE delete_file_from_q
      (    q_pointer: ^^nft$output_queue_file;
           connection: ^nft$connection;
       VAR q_file: ^nft$output_queue_file);

      VAR
        back_link_file: ^nft$output_queue_file,
        link_file: ^nft$output_queue_file;

      back_link_file := q_file^.back_link;
      link_file := q_file^.link;
      IF q_file = q_pointer^ THEN
        q_pointer^ := q_file^.link;
      IFEND;
      IF q_file^.back_link <> NIL THEN
        back_link_file^.link := q_file^.link;
      IFEND;
      IF q_file^.link <> NIL THEN
        link_file^.back_link := q_file^.back_link;
      IFEND;

      delete_from_scfve_q_and_device (q_file, connection);

      FREE q_file;

    PROCEND delete_file_from_q;
?? TITLE := 'delete_file_from_selected_q', EJECT ??

{  PURPOSE:
{    Delete a file that had been placed in the station's selected file queue.

    PROCEDURE delete_file_from_selected_q
      (    io_station: ^nft$io_station;
           connection: ^nft$connection;
       VAR selected_file: ^nft$selected_file);

      VAR
        q_file: ^nft$output_queue_file;

      q_file := selected_file^.output_file;

      remove_selected_file (io_station, selected_file);

      delete_from_scfve_q_and_device (q_file, connection);

      FREE q_file;

    PROCEND delete_file_from_selected_q;
?? TITLE := 'delete_from_scfve_q_and_device', EJECT ??

    PROCEDURE delete_from_scfve_q_and_device
      (    q_file: ^nft$output_queue_file;
           connection: ^nft$connection);

      VAR
        device: ^nft$batch_device,
        next_scfve_file: ^nft$output_queue_file,
        prior_scfve_file: ^nft$output_queue_file;

      prior_scfve_file := q_file^.prior_scfve_queue;
      next_scfve_file := q_file^.next_scfve_queue;
      IF q_file = connection^.scfve_queue THEN
        connection^.scfve_queue := q_file^.next_scfve_queue;
      IFEND;
      IF q_file^.prior_scfve_queue <> NIL THEN
        prior_scfve_file^.next_scfve_queue := q_file^.next_scfve_queue;
      IFEND;
      IF q_file^.next_scfve_queue <> NIL THEN
        next_scfve_file^.prior_scfve_queue := q_file^.prior_scfve_queue;
      IFEND;

      device := q_file^.assigned_device;
      IF device <> NIL THEN
        IF device^.current_file <> NIL THEN
          IF device^.current_file^.system_file_name = q_file^.system_file_name THEN
            device^.current_file := NIL;
          IFEND;
        IFEND;
      IFEND;

    PROCEND delete_from_scfve_q_and_device;

?? TITLE := 'get_requeue_and_held_params', EJECT ??

{  PURPOSE:
{    Get the parameter and value sent by SCF/DI if the file
{    transfer was held by a filter or requeued.

    PROCEDURE get_requeue_and_held_params
      (VAR message: ^nft$message_sequence;
       VAR msg_length: integer;
       VAR file_requeued: boolean;
       VAR file_held_by_filter: boolean;
       VAR status: ost$status);

*copy nft$file_availability_msg

      VAR
        byte_array: ^nft$byte_array,
        held: ^boolean,
        parameter: ^nft$file_available_msg_param,
        requeued: ^boolean,
        value_length: integer;

      status.normal := TRUE;
      file_held_by_filter := FALSE;
      file_requeued := FALSE;

      NEXT parameter IN message;

      WHILE (parameter <> NIL) AND (parameter^.param <> nfc$null_parameter) AND (msg_length > 0) DO
        msg_length := msg_length - 1;

        IF parameter^.length_indicated THEN
          nfp$get_parameter_value_length (message, msg_length, value_length, status);
          msg_length := msg_length - value_length;
        ELSE
          value_length := 1;
          msg_length := msg_length - 1;
        IFEND;

        CASE parameter^.param OF
        = nfc$file_requeued =
          NEXT requeued IN message;
          file_requeued := requeued^;

        = nfc$file_held_by_filter =
          NEXT held IN message;
          file_held_by_filter := held^;

        ELSE
{         ERROR ----   Ignore parameter value.
          NEXT byte_array: [1 .. value_length] IN message;

        CASEND;
        NEXT parameter IN message;
      WHILEND;

    PROCEND get_requeue_and_held_params;
?? TITLE := 'send_terminate_transfer_msg', EJECT ??

{  PURPOSE:
{    Send a terminate transfer message because the owner of the file has issued
{    a terminate_output request on the file.  This makes the DI think that OPES
{    sent the terminate_transfer request.  SCFS will send the response to an
{    operator even though the operator is not expecting the response.

    PROCEDURE send_terminate_transfer_msg
      (    device: ^nft$batch_device;
           io_station_name: ost$name;
       VAR message: ^nft$message_sequence;
       VAR status: ost$status);

      VAR
        ascii_string: ^string ( * <= osc$max_name_size),
        connection: ^nft$connection,
        file_disposition: ^nft$file_disposition,
        message_length: nft$message_length,
        message_type: ^nft$message_kind,
        parameter_kind: ^nft$terminate_xfer_msg_param,
        parameter_kind_size: nft$message_length,
        param_length_size: nft$message_length,
        parameter_value_length: integer;

*copyc nft$terminate_transfer_msg

      parameter_kind_size := #SIZE (nft$terminate_xfer_msg_param);
      RESET message;

      NEXT message_type IN message;
      message_type^ := nfc$terminate_transfer;
      message_length := 1;

      NEXT parameter_kind IN message;
      parameter_kind^.param := nfc$io_station_name;
      parameter_value_length := clp$trimmed_string_size (io_station_name);
      nfp$modify_param_value_length (parameter_value_length);
      parameter_kind^.length_indicated := parameter_value_length > 1;
      IF parameter_kind^.length_indicated THEN
        nfp$put_parameter_value_length (parameter_value_length, message, param_length_size, status);
      ELSE
        param_length_size := 0;
      IFEND;
      NEXT ascii_string: [parameter_value_length] IN message;
      ascii_string^ := io_station_name (1, parameter_value_length);
      message_length := message_length + parameter_kind_size + param_length_size + parameter_value_length;

      NEXT parameter_kind IN message;
      parameter_kind^.param := nfc$device_name;
      parameter_value_length := clp$trimmed_string_size (device^.name);
      parameter_kind^.length_indicated := parameter_value_length > 1;
      IF parameter_kind^.length_indicated THEN
        nfp$put_parameter_value_length (parameter_value_length, message, param_length_size, status);
      ELSE
        param_length_size := 0;
      IFEND;
      NEXT ascii_string: [parameter_value_length] IN message;
      ascii_string^ := device^.name (1, parameter_value_length);
      message_length := message_length + parameter_kind_size + param_length_size + parameter_value_length;

      NEXT parameter_kind IN message;
      parameter_kind^.length_indicated := FALSE;
      parameter_kind^.param := nfc$file_disposition;
      NEXT file_disposition IN message;
      file_disposition^ := nfc$drop_file_from_q;
      message_length := message_length + parameter_kind_size + 1;

      connection := device^.scfdi_connection;
      nfp$send_message_on_connection (message, message_length, connection^.id, status);
      IF scfs_event_logging THEN
        log_connection_message (connection^, message_length, message);
      IFEND;

    PROCEND send_terminate_transfer_msg;
?? TITLE := 'update number of requeues', EJECT ??

{  PURPOSE:
{    Update the number of requeues to the specified device.  If the number
{    of requeues per minute exceeds the defined threshold value, down the
{    device so that files are not assigned to print at that device.

    PROCEDURE update_number_of_requeues
      (    q_file: ^nft$output_queue_file;
       VAR message: ^nft$message_sequence;
       VAR status: ost$status);

      CONST
        maximum_requeues_allowed = 10,
        operator_message = 'Device rejecting file transfers, start device later.',
        requeue_timer_interval = 60;

      VAR
        device: ^nft$batch_device,
        elapsed_time: integer,
        io_station: ^nft$io_station,
        operator_connection: ^nft$connection,
        time: integer;

      pmp$get_microsecond_clock (time, status);

      device := q_file^.assigned_device;

{ The device associated with this queue file may have been deleted from SCFS's tables if
{ SCF/DI had recently sent a DELETE_BATCH_DEVICE message for the device.

      IF device <> NIL THEN
        IF NOT device^.device_timer_activated THEN
          device^.device_timer_activated := TRUE;
          device^.timer_start_time := time;
          device^.number_of_files_requeued := 1;
        ELSE
          elapsed_time := (time - device^.timer_start_time) DIV 1000000;
          IF elapsed_time < 0 THEN
            device^.timer_start_time := time;
            device^.number_of_files_requeued := 1;
          ELSEIF elapsed_time <= requeue_timer_interval THEN
            device^.number_of_files_requeued := device^.number_of_files_requeued + 1;
            IF (device^.number_of_files_requeued >= maximum_requeues_allowed) THEN
              device^.device_status := nfc$device_stopped_by_system;
              io_station := device^.io_station;
              IF io_station^.operator_assigned OR (io_station^.usage = nfc$ntf_remote_system) THEN
                operator_connection :=  io_station^.connected_operator;
                send_operator_message (message, device, operator_message, operator_connection,
                      status);
              IFEND;
            IFEND;
          ELSE
            device^.device_timer_activated := FALSE;
            device^.timer_start_time := 0;
            device^.number_of_files_requeued := 0;
         IFEND;
       IFEND;
     IFEND;

    PROCEND update_number_of_requeues;
?? OLDTITLE, EJECT ??
    device := NIL;
    file_held_by_filter := FALSE;
    q_file := NIL;
    q_found := FALSE;
    queue_pointer := NIL;
    selected_file := NIL;

    get_required_file_avail_params (message, msg_length, queue_file, status);
    get_requeue_and_held_params (message, msg_length, file_requeued, file_held_by_filter, status);

    CASE queue_file.ios_usage OF
    = nfc$private_io_station =
      find_private_queue (queue_file.operator_name, queue_file.operator_family, queue_pointer,
            station_list, q_found);
      IF NOT q_found THEN
        q_found := NOT q_found;
        queue_pointer := ^scfs_tables.unknown_private_operators_q;
      IFEND;
    = nfc$public_io_station =
      find_public_queue (queue_file.ios_name, queue_pointer, station_list, q_found);
    = nfc$ntf_remote_system =
      find_ntf_remote_queue (queue_file.ios_name, queue_pointer, station_list);
      q_found := (queue_pointer <> NIL);
    CASEND;

    IF q_found THEN
      find_q_file (queue_file.system_file_name, queue_pointer^, q_file);
      IF q_file <> NIL THEN
        IF file_requeued THEN
          update_number_of_requeues (q_file, message, status);
        IFEND;
        device := q_file^.assigned_device;

{ If the device is receiving the file in question, then send a terminate_transfer
{ message (the user terminated the output).  Then delete the file from the queue.

        IF (q_file^.output_state = nfc$selected_for_transfer) AND (device <> NIL) AND (device^.current_file =
              q_file) AND (device^.file_transfer_status >= nfc$busy) THEN
          io_station := device^.io_station;
          send_terminate_transfer_msg (device, io_station^.name, message, status);
          IF NOT status.normal THEN
            RETURN;
          IFEND;
        IFEND;
        IF file_held_by_filter THEN
          q_file^.output_state := nfc$hold_transfer;
          IF (device <> NIL) THEN
            device^.current_file := NIL;
          IFEND;
        ELSE
          delete_file_from_q (queue_pointer, connection, q_file);
        IFEND;
      ELSE
        find_station_and_selected_file (queue_file.system_file_name, io_station, selected_file);
        IF (selected_file <> NIL) THEN
          q_file := selected_file^.output_file;
          IF (q_file <> NIL) THEN
            device := q_file^.assigned_device;
          IFEND;
        IFEND;

{ Selected_file is a file that has been selected for transfer by the station operator.

        IF (selected_file <> NIL) THEN
          IF (device <> NIL) THEN
            IF (q_file^.output_state = nfc$selected_for_transfer) AND (device^.current_file =
                  q_file) AND (device^.file_transfer_status >= nfc$busy) THEN
              send_terminate_transfer_msg (device, io_station^.name, message, status);
              IF NOT status.normal THEN
                RETURN;
              IFEND;
            IFEND;
          IFEND;
          IF file_held_by_filter THEN
            q_file^.output_state := nfc$hold_transfer;
            IF (device <> NIL) THEN
              device^.current_file := NIL;
            IFEND;
          ELSE
            delete_file_from_selected_q (io_station, connection, selected_file);
          IFEND;
        IFEND;
      IFEND;
      IF (device <> NIL) AND device_available_for_output (device) THEN
        find_file_for_device (device, message, status);
      IFEND;
    IFEND;

  PROCEND delete_file_availability_msg;
?? TITLE := 'delete io station', EJECT ??

{  PURPOSE:
{    This procedure does the actually deleting of an io station
{    from the tables maintained by SCFS.  The SCF/DI connection
{    is deleted, the operator connection is deleted (if there
{    currently is an operator connected), the station is removed
{    from the lists and a message is sent to each SCF/VE that
{    sent files to this destination and control facility.  If the
{    station being deleted is a private station, all files are
{    returned to the "unknown station queue".

  PROCEDURE delete_io_station
    (    connection: ^nft$connection;
     VAR io_station: ^nft$io_station;
     VAR message: ^nft$message_sequence;
     VAR wait_list: ^ost$i_wait_list;
     VAR wait_connection_list: ^nft$wait_connection_list;
     VAR status: ost$status);

    VAR
      file_id_is_valid: boolean,
      file_instance: ^bat$task_file_entry,
      file_name: amt$local_file_name,
      ignore_status: ost$status,
      operator_connection: ^nft$connection;

?? NEWTITLE := 'delete dest msg to all scfves', EJECT ??

{  PURPOSE:
{    Send a message to each SCF/VE that sent files to the station
{    currently being deleted.

    PROCEDURE delete_dest_msg_to_all_scfves
      (    destination_name: ost$name;
       VAR message: ^nft$message_sequence;
       VAR status: ost$status);

      VAR
        connection: ^nft$connection;

      connection := scfs_tables.first_connection;
      WHILE connection <> NIL DO
        IF connection^.kind = nfc$scfve_connection THEN
          send_delete_destination_msg (message, destination_name, control_facility_name, connection, status);
        IFEND;
        connection := connection^.link;
      WHILEND;

    PROCEND delete_dest_msg_to_all_scfves;
?? TITLE := 'delete io station connection', EJECT ??

    PROCEDURE delete_io_station_connection
      (    io_station: ^nft$io_station;
           connection: ^nft$connection);

      VAR
        pointer_to_connection: ^nft$pointer_list_entry;

?? NEWTITLE := 'delete bds on same connection', EJECT ??

      PROCEDURE delete_bds_on_same_connection
        (    io_station: ^nft$io_station;
             connection: ^nft$connection);

        VAR
          current_bd: ^nft$batch_device,
          device: ^nft$batch_device;

        IF io_station^.batch_device_list <> NIL THEN
          current_bd := io_station^.batch_device_list;

          WHILE current_bd <> NIL DO
            device := current_bd;
            current_bd := current_bd^.link;
            IF device^.scfdi_connection = connection THEN
              delete_batch_device_entry (device, io_station);
            IFEND;
          WHILEND;
        IFEND;

      PROCEND delete_bds_on_same_connection;
?? OLDTITLE, EJECT ??

      delete_bds_on_same_connection (io_station, connection);

      pointer_to_connection := io_station^.scfdi_connection_pointers;

      IF pointer_to_connection^.connection = connection THEN
        io_station^.scfdi_connection_pointers := pointer_to_connection^.link;
      ELSE

      /find_connection/
        WHILE pointer_to_connection <> NIL DO
          IF pointer_to_connection^.connection = connection THEN
            EXIT /find_connection/;
          IFEND;
          pointer_to_connection := pointer_to_connection^.link;
        WHILEND /find_connection/;
      IFEND;

      IF pointer_to_connection <> NIL THEN
        delete_pointer_list_entry (pointer_to_connection);
      IFEND;

    PROCEND delete_io_station_connection;
?? TITLE := 'delete io station entry', EJECT ??

    PROCEDURE delete_io_station_entry
      (VAR io_station: ^nft$io_station;
       VAR status: ost$status);

      VAR
        back_link_station,
        link_station: ^nft$io_station;

      back_link_station := io_station^.back_link;
      link_station := io_station^.link;

      IF io_station = scfs_tables.first_io_station THEN
        scfs_tables.first_io_station := io_station^.link;
        IF io_station^.link <> NIL THEN
          link_station^.back_link := NIL;
        IFEND;
      ELSE
        back_link_station^.link := io_station^.link;
        IF io_station^.link <> NIL THEN
          link_station^.back_link := io_station^.back_link;
        IFEND;
      IFEND;

      FREE io_station;

    PROCEND delete_io_station_entry;
?? TITLE := 'free all queue files', EJECT ??

    PROCEDURE free_all_queue_files
      (    current_alias: ^nft$alias);

      VAR
        current_q_entry: ^nft$output_queue_file,
        queue_entry: ^nft$output_queue_file;

      current_q_entry := current_alias^.queue;

      IF current_q_entry = NIL THEN
        WHILE current_q_entry <> NIL DO
          remove_file_from_scf_ve_q (current_q_entry);
          queue_entry := current_q_entry;
          current_q_entry := current_q_entry^.link;
          FREE queue_entry;
        WHILEND;
      IFEND;

    PROCEND free_all_queue_files;
?? TITLE := 'free_selected_files_queue', EJECT ??

    PROCEDURE free_selected_files_queue
      (    io_station: ^nft$io_station);

      VAR
        current_q_entry: ^nft$output_queue_file,
        old_selected_queue_entry: ^nft$selected_file,
        selected_queue_entry: ^nft$selected_file;

      selected_queue_entry := io_station^.selected_files_queue;
      WHILE selected_queue_entry <> NIL DO
        current_q_entry := selected_queue_entry^.output_file;
        remove_file_from_scf_ve_q (current_q_entry);
        old_selected_queue_entry := selected_queue_entry;
        selected_queue_entry := selected_queue_entry^.link;
        FREE old_selected_queue_entry;
      WHILEND;

      io_station^.selected_files_queue := NIL;
      io_station^.last_selected_file_in_q := NIL;

    PROCEND free_selected_files_queue;
?? TITLE := 'remove_file_from_scf_ve_q', EJECT ??

    PROCEDURE remove_file_from_scf_ve_q
      (    current_file: ^nft$output_queue_file);

      VAR
        next_scfve_queue: ^nft$output_queue_file,
        prior_scfve_queue: ^nft$output_queue_file,
        scfve_connection: ^nft$connection;

?? NEWTITLE := 'get_scfve_connection', EJECT ??

      PROCEDURE get_scfve_connection
        (    q_file: ^nft$output_queue_file;
         VAR connection: ^nft$connection);

        VAR
          connection_found: boolean;

        connection_found := FALSE;
        connection := scfs_tables.first_connection;
        WHILE (NOT connection_found) AND (connection <> scfs_tables.first_connection) DO
          connection_found := (connection^.kind = nfc$scfve_connection) AND (connection^.scfve_queue =
                q_file);
          IF NOT connection_found THEN
            connection := connection^.link;
          IFEND;
        WHILEND;

      PROCEND get_scfve_connection;
?? OLDTITLE, EJECT ??
      get_scfve_connection (current_file, scfve_connection);

      IF current_file^.prior_scfve_queue = NIL THEN
        scfve_connection^.scfve_queue := current_file^.next_scfve_queue;
      ELSE
        prior_scfve_queue := current_file^.prior_scfve_queue;
        prior_scfve_queue^.next_scfve_queue := current_file^.next_scfve_queue;
        next_scfve_queue := current_file^.next_scfve_queue;
        IF (next_scfve_queue <> NIL) THEN
          next_scfve_queue^.prior_scfve_queue := current_file^.prior_scfve_queue;
        IFEND;
      IFEND;

    PROCEND remove_file_from_scf_ve_q;
?? TITLE := 'remove station from alias list', EJECT ??

{  PURPOSE:
{    Remove the station from the station list pointed to by the
{    station name-alias entry and remove the station from the
{    station name-alias list.  Removal of the station also
{    entails deleting the title registration from the network.

    PROCEDURE remove_station_from_alias_list
      (    io_station: ^nft$io_station;
       VAR message: ^nft$message_sequence);

      VAR
        alias_station: ^nft$pointer_list_entry,
        current_alias: ^nft$alias,
        station: ^nft$io_station;

?? NEWTITLE := 'delete ios in alias list', EJECT ??

      PROCEDURE delete_ios_in_alias_list
        (    alias_pt: ^nft$alias;
             io_station: ^nft$io_station);

        VAR
          pointer_list_entry: ^nft$pointer_list_entry;

        pointer_list_entry := alias_pt^.station_list;

      /find_last_station_pointer/
        WHILE pointer_list_entry <> NIL DO
          IF pointer_list_entry^.io_station = io_station THEN
            IF pointer_list_entry = alias_pt^.station_list THEN
              alias_pt^.station_list := pointer_list_entry^.link;
            IFEND;
            delete_pointer_list_entry (pointer_list_entry);
            EXIT /find_last_station_pointer/;
          IFEND;
          pointer_list_entry := pointer_list_entry^.link;
        WHILEND /find_last_station_pointer/;

      PROCEND delete_ios_in_alias_list;
?? TITLE := 'remove name from alias list', EJECT ??

      PROCEDURE remove_entry_from_alias_list
        (VAR alias_pt: ^nft$alias);

        VAR
          back_link: ^nft$alias,
          current_alias: ^nft$alias,
          link: ^nft$alias,
          status: ost$status;

        current_alias := alias_pt;
        back_link := current_alias^.back_link;
        link := current_alias^.link;

        IF current_alias = scfs_tables.first_station_name_alias THEN
          scfs_tables.first_station_name_alias := current_alias^.link;
          IF current_alias^.link <> NIL THEN
            link^.back_link := NIL;
          IFEND;
        ELSE
          back_link^.link := current_alias^.link;
          IF current_alias^.link <> NIL THEN
            link^.back_link := current_alias^.back_link;
          IFEND;
        IFEND;

        free_all_queue_files (current_alias);

        FREE current_alias;

        alias_pt := link;

      PROCEND remove_entry_from_alias_list;
?? OLDTITLE, EJECT ??

      current_alias := scfs_tables.first_station_name_alias;

    /search_station_alias_list/
      WHILE current_alias <> NIL DO
        IF (current_alias^.name = io_station^.name) OR (current_alias^.name = io_station^.alias_names [1]) OR
              (current_alias^.name = io_station^.alias_names [2]) OR (current_alias^.name = io_station^.
              alias_names [3]) THEN

          delete_ios_in_alias_list (current_alias, io_station);

{  No stations in the station list, delete alias and station title.
          IF current_alias^.station_list = NIL THEN
            IF current_alias^.station_title_registered THEN
              delete_station_alias_title (current_alias^.name, nfc$station_title, status);
              IF status.normal THEN
                current_alias^.station_title_registered := FALSE;
              IFEND;
            IFEND;

            IF current_alias^.alias_title_registered THEN
              delete_station_alias_title (current_alias^.name, nfc$alias_title, status);
              IF status.normal THEN
                current_alias^.alias_title_registered := FALSE;
              IFEND;
            IFEND;
            delete_dest_msg_to_all_scfves (current_alias^.name, message, status);
            remove_entry_from_alias_list ( current_alias);
            CYCLE /search_station_alias_list/;

{  Delete station title.
          ELSEIF (current_alias^.name = io_station^.name) THEN
            IF current_alias^.station_title_registered THEN
              delete_station_alias_title (current_alias^.name, nfc$station_title, status);
              IF status.normal THEN
                current_alias^.station_title_registered := FALSE;
              IFEND;
            IFEND;

{  Delete alias title, if there is only one entry in the station list and that
{  entry is pointing to a station with the same name as the station_alias entry.
          ELSE  {current_alias^.name = one of the io_station's alias names}
            alias_station := current_alias^.station_list;
            station := alias_station^.io_station;
            IF (alias_station^.link = NIL) AND
                  (station^.name = current_alias^.name) AND
                  current_alias^.alias_title_registered THEN
              delete_station_alias_title (current_alias^.name, nfc$alias_title, status);
              IF status.normal THEN
                current_alias^.alias_title_registered := FALSE;
              IFEND;
            IFEND;
          IFEND;
        IFEND;
        IF current_alias <> NIL THEN
          current_alias := current_alias^.link;
        IFEND;
      WHILEND /search_station_alias_list/;

    PROCEND remove_station_from_alias_list;
?? OLDTITLE, EJECT ??

    delete_io_station_connection (io_station, connection);
    IF io_station^.scfdi_connection_pointers = NIL THEN
      IF io_station^.connected_operator <> NIL THEN
        operator_connection := io_station^.connected_operator;
        operator_connection^.operating_station := NIL;
        bap$validate_file_identifier (operator_connection^.id, file_instance, file_id_is_valid);
        IF file_id_is_valid THEN
          file_name := file_instance^.local_file_name;
          fsp$close_file (operator_connection^.id, status);
          amp$return (file_name, ignore_status);
        IFEND;
        delete_connection_from_tables (operator_connection);
        remove_from_wait_lists (operator_connection^.wait_list_index, wait_list, wait_connection_list);
      IFEND;
      IF io_station^.usage = nfc$private_io_station THEN
        move_files_back_to_unknown_q (io_station);
      IFEND;
      IF io_station^.selected_files_queue <> NIL THEN
        free_selected_files_queue (io_station);
      IFEND;
      remove_station_from_alias_list (io_station, message);
      delete_io_station_entry (io_station, status);
    IFEND;

  PROCEND delete_io_station;
?? TITLE := 'delete io station msg', EJECT ??

{  PURPOSE:
{    This procedure is executed when a request is received from SCF/DI to
{    delete access to the I/O station for the specified SCF/DI connection.
{    Any batch devices defined for the requesting DI that are defined for
{    the I/O station are deleted.  When all SCF/DI connections are deleted, the
{    complete I/O station is deleted.  A response to the request is sent
{    to SCF/DI.

  PROCEDURE delete_io_station_msg
    (VAR message: ^nft$message_sequence;
     VAR connection: ^nft$connection;
     VAR msg_length: integer;
     VAR wait_list: ^ost$i_wait_list;
     VAR wait_connection_list: ^nft$wait_connection_list;
     VAR status: ost$status);

    VAR
      io_station: ^nft$io_station,
      io_station_found: boolean,
      io_station_name: ost$name,
      operator_connection: ^nft$connection,
      message_response: nft$delete_io_station_responses;

*copy nft$delete_io_station_message
*copy nft$delete_ios_resp_codes

?? NEWTITLE := 'crack delete io station msg', EJECT ??

    PROCEDURE crack_delete_io_station_msg
      (VAR message: ^nft$message_sequence;
       VAR msg_length: integer;
       VAR station_name: ost$name;
       VAR status: ost$status);

      VAR
        ascii_string: ^string ( * <= osc$max_name_size),
        byte_array: ^nft$byte_array,
        parameter: ^nft$del_ios_message_parameter,
        value_length: integer;

      NEXT parameter IN message;

      WHILE (parameter <> NIL) AND (parameter^.param <> nfc$null_parameter) AND (msg_length > 0) DO
        msg_length := msg_length - 1;
        IF parameter^.length_indicated THEN
          nfp$get_parameter_value_length (message, msg_length, value_length, status);
          msg_length := msg_length - value_length;
        ELSE
          value_length := 1;
          msg_length := msg_length - 1;
        IFEND;

        IF parameter^.param = nfc$io_station_name THEN
          NEXT ascii_string: [value_length] IN message;
          #translate (osv$lower_to_upper, ascii_string^, station_name);
        ELSE
{         ERROR ----   Ignore parameter value.
          NEXT byte_array: [1 .. value_length] IN message;

        IFEND;
        NEXT parameter IN message;
      WHILEND;

    PROCEND crack_delete_io_station_msg;
?? TITLE := 'send delete io station response', EJECT ??

{  PURPOSE:
{    Send a message to SCF/DI indicating SCFS's response to a
{    previous delete I/O station message.

    PROCEDURE send_delete_io_station_response
      (VAR message: ^nft$message_sequence;
           response_code: nft$delete_io_station_responses;
           station_name: ost$name;
           connection: ^nft$connection;
       VAR status: ost$status);

      VAR
        ascii_string: ^string ( * <= osc$max_name_size),
        message_length: nft$message_length,
        message_type: ^nft$message_kind,
        parameter_kind: ^nft$del_ios_resp_msg_parameter,
        parameter_kind_size: nft$message_length,
        param_length_size: nft$message_length,
        parameter_value_length: integer,
        response_param: ^nft$delete_io_station_responses;

*copy nft$delete_io_station_response

      parameter_kind_size := #SIZE (nft$del_ios_resp_msg_parameter);
      RESET message;

      NEXT message_type IN message;
      message_type^ := nfc$delete_io_station_resp;
      message_length := 1;

      NEXT parameter_kind IN message;
      parameter_kind^.param := nfc$io_station_name;
      parameter_value_length := clp$trimmed_string_size (station_name);
      nfp$modify_param_value_length (parameter_value_length);
      parameter_kind^.length_indicated := parameter_value_length > 1;
      IF parameter_kind^.length_indicated THEN
        nfp$put_parameter_value_length (parameter_value_length, message, param_length_size, status);
      ELSE
        param_length_size := 0;
      IFEND;
      NEXT ascii_string: [parameter_value_length] IN message;
      ascii_string^ := station_name (1, parameter_value_length);
      message_length := message_length + parameter_kind_size + param_length_size + parameter_value_length;

      NEXT parameter_kind IN message;
      parameter_kind^.length_indicated := FALSE;
      parameter_kind^.param := nfc$response_code;
      NEXT response_param IN message;
      response_param^ := response_code;
      message_length := message_length + parameter_kind_size + 1;

      nfp$send_message_on_connection (message, message_length, connection^.id, status);
      IF scfs_event_logging THEN
        log_connection_message (connection^, message_length, message);
      IFEND;

    PROCEND send_delete_io_station_response;
?? OLDTITLE, EJECT ??

    crack_delete_io_station_msg (message, msg_length, io_station_name, status);

    message_response := nfc$message_accepted;

    find_io_station (io_station_name, io_station, io_station_found);
    IF NOT io_station_found THEN
      message_response := nfc$no_io_station;
    ELSE
      delete_io_station (connection, io_station, message, wait_list, wait_connection_list,
            status);
    IFEND;

    send_delete_io_station_response (message, message_response, io_station_name, connection, status);

  PROCEND delete_io_station_msg;

?? TITLE := 'delete station alias title', EJECT ??

{  PURPOSE:
{    Delete the specified title from the network.
{    Now when a client requests a title translation with
{    this name, the address for this control facility will
{    not be returned.

  PROCEDURE delete_station_alias_title
    (    title_part: ost$name;
         title_kind: nft$title_kind;
     VAR status: ost$status);

    VAR
      title: ^nat$title_pattern;

    status.normal := TRUE;

    PUSH title: [start_of_title_length + osc$max_name_size];
    IF title_kind = nfc$station_title THEN
      title^ (1, start_of_title_length) := start_of_scfs_title;
    ELSEIF title_kind = nfc$alias_title THEN
      title^ (1, start_of_title_length) := start_of_alias_title;
    IFEND;
    title^ (1 + start_of_title_length, * ) := title_part;

    nap$delete_server_title (server_name, title^, status);

  PROCEND delete_station_alias_title;
?? TITLE := 'delete_ntf_acc_remote_sys_ptr', EJECT ??

{  PURPOSE:
{    This procedure deletes an accessible remote system pointer from the list
{    of accessible remote system pointers known to a logical line.

  PROCEDURE delete_ntf_acc_remote_sys_ptr
    (VAR acc_remote_system_ptr: ^nft$pointer_list_entry;
         remote_system: ^nft$io_station);

    VAR
      prev_acc_remote_system_ptr: ^nft$pointer_list_entry,
      next_acc_remote_system_ptr: ^nft$pointer_list_entry;

    prev_acc_remote_system_ptr := acc_remote_system_ptr^.back_link;
    IF prev_acc_remote_system_ptr <> NIL THEN
      prev_acc_remote_system_ptr^.link := acc_remote_system_ptr^.link;
    ELSE
      remote_system^.ntf_acc_remote_system_ptr_list := acc_remote_system_ptr^.link;
    IFEND;

    next_acc_remote_system_ptr := acc_remote_system_ptr^.link;
    IF next_acc_remote_system_ptr <> NIL THEN
      next_acc_remote_system_ptr^.back_link := acc_remote_system_ptr^.back_link;
    IFEND;

    FREE acc_remote_system_ptr;

  PROCEND delete_ntf_acc_remote_sys_ptr;
?? TITLE := 'delete_ntf_logical_line_entry', EJECT ??

{  PURPOSE:
{    This procedure deletes a logical line from the list of logical lines known
{    to a remote system.

  PROCEDURE delete_ntf_logical_line_entry
    (VAR logical_line: ^nft$ntf_logical_line;
         remote_system: ^nft$io_station);

    VAR
      ignore_status: ost$status,
      prev_logical_line: ^nft$ntf_logical_line,
      next_logical_line: ^nft$ntf_logical_line;

    prev_logical_line := logical_line^.back_link;
    IF prev_logical_line <> NIL THEN
      prev_logical_line^.link := logical_line^.link;
    ELSE
      remote_system^.ntf_logical_line_list := logical_line^.link;
    IFEND;

    next_logical_line := logical_line^.link;
    IF next_logical_line <> NIL THEN
      next_logical_line^.back_link := logical_line^.back_link;
    IFEND;

    send_ntf_signon_status_message ('Deleted             ', remote_system, logical_line,
          ignore_status);
    FREE logical_line;

  PROCEND delete_ntf_logical_line_entry;
?? TITLE := 'delete_ntf_remote_system', EJECT ??

{  PURPOSE:
{    This procedure deletes a specified connection from a remote system.  As
{    an option, the deletion can be restricted to a specific logical line on
{    the connection.  If all logical lines for the remote system are deleted,
{    the remote system will be deleted from SCFS tables.

  PROCEDURE delete_ntf_remote_system
    (VAR remote_system: ^nft$io_station;
         connection: ^nft$connection;
         check_logical_line_number: boolean;
         logical_line_number: nft$ntf_logical_line_number);

    VAR
      batch_stream: ^nft$batch_device,
      last_batch_stream: ^nft$batch_device,
      last_logical_line: ^nft$ntf_logical_line,
      logical_line: ^nft$ntf_logical_line,
      next_remote_system: ^nft$io_station,
      operator_connection: ^nft$connection,
      previous_remote_system: ^nft$io_station;

?? NEWTITLE := 'delete_logical_line', EJECT ??

    PROCEDURE delete_logical_line
      (VAR logical_line: ^nft$ntf_logical_line;
           remote_system: ^nft$io_station);

      VAR
        acc_remote_system: ^nft$alias,
        acc_remote_system_ptr: ^nft$pointer_list_entry,
        last_acc_remote_system_ptr: ^nft$pointer_list_entry,
        remote_system_ptr: ^nft$pointer_list_entry,
        remote_system_ptr_found: boolean;

      acc_remote_system_ptr := remote_system^.ntf_acc_remote_system_ptr_list;
      WHILE acc_remote_system_ptr <> NIL DO
        acc_remote_system := acc_remote_system_ptr^.ntf_acc_remote_system;
        last_acc_remote_system_ptr := acc_remote_system_ptr;
        acc_remote_system_ptr := last_acc_remote_system_ptr^.link;
        find_ntf_remote_system_pointer (remote_system^.name, TRUE, logical_line^.logical_line_number,
              acc_remote_system, remote_system_ptr, remote_system_ptr_found);
        IF remote_system_ptr_found THEN
          delete_ntf_remote_system_ptr (remote_system_ptr, acc_remote_system);
          IF acc_remote_system^.station_list = NIL THEN
            acc_remote_system^.ntf_authority_level := nfc$ntf_none;
            delete_ntf_acc_remote_sys_ptr (last_acc_remote_system_ptr, remote_system);
          ELSE
            find_ntf_remote_system_pointer (remote_system^.name, FALSE, 1, acc_remote_system,
                  remote_system_ptr, remote_system_ptr_found);
            IF NOT remote_system_ptr_found THEN
              delete_ntf_acc_remote_sys_ptr (last_acc_remote_system_ptr, remote_system);
            IFEND;
          IFEND;
        IFEND;
      WHILEND;

      delete_ntf_logical_line_entry (logical_line, remote_system);

    PROCEND delete_logical_line;
?? OLDTITLE, EJECT ??

    batch_stream := remote_system^.batch_device_list;
    WHILE batch_stream <> NIL DO
      last_batch_stream := batch_stream;
      batch_stream := last_batch_stream^.link;
      IF (last_batch_stream^.scfdi_connection = connection) AND
            ((NOT check_logical_line_number) OR (last_batch_stream^.ntf_logical_line_number =
            logical_line_number)) THEN
        delete_batch_device_entry (last_batch_stream, remote_system);
      IFEND;
    WHILEND;

    logical_line := remote_system^.ntf_logical_line_list;
    WHILE logical_line <> NIL DO
      last_logical_line := logical_line;
      logical_line := last_logical_line^.link;
      IF (last_logical_line^.scfdi_connection = connection) AND
            ((NOT check_logical_line_number) OR (last_logical_line^.logical_line_number =
            logical_line_number)) THEN
        delete_logical_line (last_logical_line, remote_system);
      IFEND;
    WHILEND;

    IF remote_system^.ntf_logical_line_list = NIL THEN
      previous_remote_system := remote_system^.back_link;
      IF previous_remote_system <> NIL THEN
        previous_remote_system^.link := remote_system^.link;
      ELSE
        scfs_tables.first_ntf_remote_system := remote_system^.link;
      IFEND;

      next_remote_system := remote_system^.link;
      IF next_remote_system <> NIL THEN
        next_remote_system^.back_link := remote_system^.back_link;
      IFEND;

      IF remote_system^.connected_operator <> NIL THEN
        operator_connection := remote_system^.connected_operator;
        operator_connection^.operating_station := NIL;
      IFEND;

      FREE remote_system;
    IFEND;

  PROCEND delete_ntf_remote_system;
?? TITLE := 'delete_ntf_remote_system_msg', EJECT ??

{  PURPOSE:
{    This procedure is executed when a request is received from SCF/DI to
{    delete access to the NTF remote system for the specified logical line.
{    Any batch streams for the logical line are deleted.  When all logical
{    lines are deleted, the complete NTF remote system is deleted.  A response
{    to the request is sent to SCF/DI.

  PROCEDURE delete_ntf_remote_system_msg
    (VAR message: ^nft$message_sequence;
     VAR connection: ^nft$connection;
     VAR msg_length: integer;
     VAR status: ost$status);

    VAR
      logical_line: ^nft$ntf_logical_line,
      logical_line_found: boolean,
      logical_line_number: nft$ntf_logical_line_number,
      remote_system: ^nft$io_station,
      remote_system_found: boolean,
      remote_system_name: ost$name,
      message_response: nft$ntf_del_rs_response_codes;

*copy nft$ntf_del_remote_sys_msg
*copy nft$ntf_del_rs_response_codes
?? NEWTITLE := 'crack_delete_remote_system_msg', EJECT ??

    PROCEDURE crack_delete_remote_system_msg
      (VAR message: ^nft$message_sequence;
       VAR msg_length: integer;
       VAR remote_system_name: ost$name;
       VAR logical_line_number: nft$ntf_logical_line_number;
       VAR status: ost$status);

      VAR
        ascii_string: ^string ( * <= osc$max_name_size),
        byte_array: ^nft$byte_array,
        line_number: ^nft$ntf_logical_line_number,
        parameter: ^nft$ntf_del_remote_sys_msg,
        value_length: integer;

      status.normal := TRUE;
      NEXT parameter IN message;

      WHILE (parameter <> NIL) AND (parameter^.param <> nfc$null_parameter) AND (msg_length > 0) DO
        msg_length := msg_length - 1;
        IF parameter^.length_indicated THEN
          nfp$get_parameter_value_length (message, msg_length, value_length, status);
          msg_length := msg_length - value_length;
        ELSE
          value_length := 1;
          msg_length := msg_length - 1;
        IFEND;

        CASE parameter^.param OF
        = nfc$ntf_remote_system_name =
          NEXT ascii_string: [value_length] IN message;
          #TRANSLATE (osv$lower_to_upper, ascii_string^, remote_system_name);

        = nfc$ntf_logical_line_number =
          NEXT line_number IN message;
          logical_line_number := line_number^;

        ELSE
{         ERROR ----   Ignore parameter value.
          NEXT byte_array: [1 .. value_length] IN message;

        CASEND;
        NEXT parameter IN message;
      WHILEND;

    PROCEND crack_delete_remote_system_msg;
?? TITLE := 'send_delete_remote_system_resp', EJECT ??

    PROCEDURE send_delete_remote_system_resp
      (VAR message: ^nft$message_sequence;
           response_code: nft$ntf_del_rs_response_codes;
           remote_system_name: ost$name;
           logical_line_number: nft$ntf_logical_line_number;
           connection: ^nft$connection;
       VAR status: ost$status);

      VAR
        ascii_string: ^string ( * <= osc$max_name_size),
        line_number: ^nft$ntf_logical_line_number,
        message_length: nft$message_length,
        message_type: ^nft$message_kind,
        parameter_kind: ^nft$ntf_del_remote_sys_resp,
        parameter_kind_size: nft$message_length,
        param_length_size: nft$message_length,
        parameter_value_length: integer,
        response_param: ^nft$ntf_del_rs_response_codes;

*copy nft$ntf_del_remote_sys_resp

      status.normal := TRUE;
      parameter_kind_size := #SIZE (nft$ntf_del_remote_sys_resp);
      RESET message;

      NEXT message_type IN message;
      message_type^ := nfc$delete_ntf_remote_sys_resp;
      message_length := 1;

      NEXT parameter_kind IN message;
      parameter_kind^.param := nfc$ntf_remote_system_name;
      parameter_value_length := clp$trimmed_string_size (remote_system_name);
      nfp$modify_param_value_length (parameter_value_length);
      parameter_kind^.length_indicated := parameter_value_length > 1;
      IF parameter_kind^.length_indicated THEN
        nfp$put_parameter_value_length (parameter_value_length, message, param_length_size, status);
      ELSE
        param_length_size := 0;
      IFEND;
      NEXT ascii_string: [parameter_value_length] IN message;
      ascii_string^ := remote_system_name (1, parameter_value_length);
      message_length := message_length + parameter_kind_size + param_length_size + parameter_value_length;

      NEXT parameter_kind IN message;
      parameter_kind^.param := nfc$ntf_logical_line_number;
      parameter_value_length := #SIZE (nft$ntf_logical_line_number);
      parameter_kind^.length_indicated := TRUE;
      nfp$put_parameter_value_length (parameter_value_length, message, param_length_size, status);
      NEXT line_number IN message;
      line_number^ := logical_line_number;
      message_length := message_length + parameter_kind_size + param_length_size + parameter_value_length;

      NEXT parameter_kind IN message;
      parameter_kind^.length_indicated := FALSE;
      parameter_kind^.param := nfc$response_code;
      NEXT response_param IN message;
      response_param^ := response_code;
      message_length := message_length + parameter_kind_size + 1;

      nfp$send_message_on_connection (message, message_length, connection^.id, status);
      IF scfs_event_logging THEN
        log_connection_message (connection^, message_length, message);
      IFEND;

    PROCEND send_delete_remote_system_resp;
?? OLDTITLE, EJECT ??

    status.normal := TRUE;
    crack_delete_remote_system_msg (message, msg_length, remote_system_name, logical_line_number, status);
    message_response := nfc$message_accepted;
    find_ntf_remote_system (remote_system_name, remote_system, remote_system_found);
    IF remote_system_found THEN
      find_ntf_logical_line (logical_line_number, remote_system, logical_line,
            logical_line_found);
      IF logical_line_found THEN
        delete_ntf_remote_system (remote_system, connection, TRUE, logical_line_number);
      ELSE
        message_response := nfc$ntf_remote_system_not_found;
      IFEND;
    ELSE
      message_response := nfc$ntf_remote_system_not_found;
    IFEND;

    send_delete_remote_system_resp (message, message_response, remote_system_name, logical_line_number,
          connection, status);

  PROCEND delete_ntf_remote_system_msg;
?? TITLE := 'delete_ntf_remote_system_ptr', EJECT ??

{  PURPOSE:
{    This procedure deletes a remote system pointer from the list of remote
{    system pointers known to accessible remote system.

  PROCEDURE delete_ntf_remote_system_ptr
    (VAR remote_system_ptr: ^nft$pointer_list_entry;
         acc_remote_system: ^nft$alias);

    VAR
      prev_remote_system_ptr: ^nft$pointer_list_entry,
      next_remote_system_ptr: ^nft$pointer_list_entry;

    prev_remote_system_ptr := remote_system_ptr^.back_link;
    IF prev_remote_system_ptr <> NIL THEN
      prev_remote_system_ptr^.link := remote_system_ptr^.link;
    ELSE
      acc_remote_system^.station_list := remote_system_ptr^.link;
    IFEND;

    next_remote_system_ptr := remote_system_ptr^.link;
    IF next_remote_system_ptr <> NIL THEN
      next_remote_system_ptr^.back_link := remote_system_ptr^.back_link;
    IFEND;

    FREE remote_system_ptr;

  PROCEND delete_ntf_remote_system_ptr;
?? TITLE := 'delete_ntf_user_message', EJECT ??

{    This procedure is executed when a request is received from OPENTF to
{    remove operator control of a remote system.  A negative response is sent
{    to OPENTF if the remote system is not found or if the specified operator
{    is not in control of the remote system.  This message is accepted if the
{    remote system is not under control of an operator.

  PROCEDURE delete_ntf_user_message
    (VAR message: ^nft$message_sequence;
         connection: ^nft$connection;
     VAR msg_length: integer;
     VAR status: ost$status);

    VAR
      family_name: ost$name,
      message_response: nft$ntf_delete_user_resp_codes,
      operator_connection: ^nft$connection,
      remote_system: ^nft$io_station,
      remote_system_found: boolean,
      remote_system_name: ost$name,
      user_name: ost$name;

*copy nft$ntf_delete_user_msg
*copy nft$ntf_delete_user_resp_codes
?? NEWTITLE := 'crack_delete_user_message', EJECT ??

    PROCEDURE crack_delete_user_message
      (VAR message: ^nft$message_sequence;
       VAR msg_length: integer;
       VAR remote_system_name: ost$name;
       VAR family_name: ost$name;
       VAR user_name: ost$name;
       VAR status: ost$status);

      VAR
        ascii_string: ^string ( * <= osc$max_name_size),
        byte_array: ^nft$byte_array,
        parameter: ^nft$ntf_delete_user_msg,
        value_length: integer;

      status.normal := TRUE;
      NEXT parameter IN message;

      WHILE (parameter <> NIL) AND (parameter^.param <> nfc$null_parameter) AND (msg_length > 0) DO
        msg_length := msg_length - 1;
        IF parameter^.length_indicated THEN
          nfp$get_parameter_value_length (message, msg_length, value_length, status);
          msg_length := msg_length - value_length;
        ELSE
          value_length := 1;
          msg_length := msg_length - 1;
        IFEND;

        CASE parameter^.param OF
        = nfc$ntf_remote_system_name =
          NEXT ascii_string: [value_length] IN message;
          #TRANSLATE (osv$lower_to_upper, ascii_string^, remote_system_name);

        = nfc$ntf_family_name =
          NEXT ascii_string: [value_length] IN message;
          #TRANSLATE (osv$lower_to_upper, ascii_string^, family_name);

        = nfc$ntf_user_name =
          NEXT ascii_string: [value_length] IN message;
          #TRANSLATE (osv$lower_to_upper, ascii_string^, user_name);

        ELSE
{         ERROR ----   Ignore parameter value.
          NEXT byte_array: [1 .. value_length] IN message;

        CASEND;
        NEXT parameter IN message;
      WHILEND;

    PROCEND crack_delete_user_message;

?? TITLE := 'send_delete_user_response', EJECT ??

    PROCEDURE send_delete_user_response
      (VAR message: ^nft$message_sequence;
           response_code: nft$ntf_delete_user_resp_codes;
           remote_system_name: ost$name;
           connection: ^nft$connection;
       VAR status: ost$status);

      VAR
        ascii_string: ^string ( * <= osc$max_name_size),
        message_length: nft$message_length,
        message_type: ^nft$message_kind,
        parameter_kind: ^nft$ntf_delete_user_resp,
        parameter_kind_size: nft$message_length,
        param_length_size: nft$message_length,
        parameter_value_length: integer,
        response_param: ^nft$ntf_delete_user_resp_codes;

*copy nft$ntf_delete_user_resp

      status.normal := TRUE;
      parameter_kind_size := #SIZE (nft$ntf_delete_user_resp);
      RESET message;

      NEXT message_type IN message;
      message_type^ := nfc$delete_ntf_user_resp;
      message_length := 1;

      NEXT parameter_kind IN message;
      parameter_kind^.param := nfc$ntf_remote_system_name;
      parameter_value_length := clp$trimmed_string_size (remote_system_name);
      nfp$modify_param_value_length (parameter_value_length);
      parameter_kind^.length_indicated := parameter_value_length > 1;
      IF parameter_kind^.length_indicated THEN
        nfp$put_parameter_value_length (parameter_value_length, message, param_length_size, status);
      ELSE
        param_length_size := 0;
      IFEND;
      NEXT ascii_string: [parameter_value_length] IN message;
      ascii_string^ := remote_system_name (1, parameter_value_length);
      message_length := message_length + parameter_kind_size + param_length_size + parameter_value_length;

      NEXT parameter_kind IN message;
      parameter_kind^.length_indicated := FALSE;
      parameter_kind^.param := nfc$response_code;
      NEXT response_param IN message;
      response_param^ := response_code;
      message_length := message_length + parameter_kind_size + 1;

      NEXT parameter_kind IN message;
      parameter_kind^.length_indicated := FALSE;
      parameter_kind^.param := nfc$null_parameter;
      message_length := message_length + parameter_kind_size;

      nfp$send_message_on_connection (message, message_length, connection^.id, status);
      IF scfs_event_logging THEN
        log_connection_message (connection^, message_length, message);
      IFEND;

    PROCEND send_delete_user_response;
?? OLDTITLE, EJECT ??

    status.normal := TRUE;
    crack_delete_user_message (message, msg_length, remote_system_name, family_name, user_name, status);
    message_response := nfc$message_accepted;
    find_ntf_remote_system (remote_system_name, remote_system, remote_system_found);
    IF NOT remote_system_found THEN
      message_response := nfc$ntf_remote_system_not_found;
    ELSEIF remote_system^.operator_assigned THEN
      IF remote_system^.connected_operator <> NIL THEN
        operator_connection := remote_system^.connected_operator;
        IF (operator_connection^.family <> family_name) OR (operator_connection^.user <> user_name) THEN
          message_response := nfc$ntf_operator_not_connected;
        IFEND;
      IFEND;
    IFEND;

    IF message_response = nfc$message_accepted THEN
      IF remote_system^.connected_operator <> NIL THEN
        operator_connection := remote_system^.connected_operator;
        operator_connection^.operating_station := NIL;
      IFEND;

      remote_system^.connected_operator := NIL;
      remote_system^.operator_assigned := FALSE;
      remote_system^.station_operational := TRUE;
    IFEND;

    send_delete_user_response (message, message_response, remote_system_name, connection, status);

  PROCEND delete_ntf_user_message;
?? TITLE := 'duplicate aliases', EJECT ??

  FUNCTION duplicate_aliases (alias_names: array [1 .. 3] OF ost$name): boolean;

    duplicate_aliases :=

    ((alias_names [1] <> osc$null_name) AND ((alias_names [1] = alias_names [2]) OR (alias_names [1] =
          alias_names [3])))

    OR

    ((alias_names [2] <> osc$null_name) AND (alias_names [2] = alias_names [3]));

  FUNCEND duplicate_aliases;
?? TITLE := 'delete pointer list entry', EJECT ??

{  PURPOSE:
{    This procedure deletes the pointer list entry from the
{    list in which it is currently linked.

  PROCEDURE delete_pointer_list_entry
    (VAR pointer_list_entry: ^nft$pointer_list_entry);

    VAR
      pointer_list_entry_back_link: ^nft$pointer_list_entry,
      pointer_list_entry_link: ^nft$pointer_list_entry;

    pointer_list_entry_back_link := pointer_list_entry^.back_link;
    pointer_list_entry_link := pointer_list_entry^.link;

    IF pointer_list_entry^.back_link <> NIL THEN
      pointer_list_entry_back_link^.link := pointer_list_entry^.link;
    IFEND;
    IF pointer_list_entry^.link <> NIL THEN
      pointer_list_entry_link^.back_link := pointer_list_entry^.back_link;
    IFEND;

    FREE pointer_list_entry;

    pointer_list_entry := pointer_list_entry_link;

  PROCEND delete_pointer_list_entry;
?? TITLE := 'device_available_for_output', EJECT ??

  FUNCTION device_available_for_output
    (    device: ^nft$batch_device): boolean;

    device_available_for_output := (device^.btfs_di_status = nfc$btfs_di_active) AND

    output_device_or_stream (device) AND

    (device^.file_transfer_status < nfc$busy) AND

    (device^.device_status = nfc$device_active) AND

    (device^.current_file = NIL) AND

    (NOT any_outstanding_di_responses (device^.outstanding_di_responses));

  FUNCEND device_available_for_output;
?? TITLE := 'file and device match', EJECT ??

{  PURPOSE:
{    This procedure determines if the attributes of the output queue file
{    and the attributes of the device are such that the file should be
{    allowed to print at that device.
{    For the file to be assigned to the device, the following rules must be met:
{      - device type of the file = device type
{      - external characteristics of the file = ONE of the external characteristics of the device
{      - forms code of the file = ONE of the forms codes of the device
{      - file size <= maximum file size allowed for the device
{      - at least 1 common protocol stack between SCF/VE and BTFS/DI
{    If the device is a printer, then the following rules must also be met:
{         -  page width of the file  <=  page width of the device
{         -  page length of the file/print density <= forms size of the device
{         -  page length of the file/print density <= maximum page length of the device
{      If the file specifies a VFU load procedure, then:
{         - the VLO for the device must be changeable by the user
{    If the file is queued for NTF, this request is forwarded to the function
{    ntf_file_and_stream_match.

  FUNCTION file_and_device_match
    (    q_file: ^nft$output_queue_file;
         device: ^nft$batch_device): boolean;

    CONST
      divisor = 2;

*copy amt$vertical_print_density

    VAR
      bd_connection: ^nft$connection,
      current_unreachable_btfs_di: ^unreachable_btfs_di,
      device_forms_size: real,
      device_match: boolean,
      device_max_page_length: real,
      device_vpd_values: [STATIC] array [nft$vertical_print_density] OF 6..12 :=
           [{nfc$six_only} 6,       {nfc$eight_only} 8,
            {nfc$six_any}  6,       {nfc$eight_any}  8],
      file_vpd_values: [STATIC] array [nfc$vertical_print_density_6 .. nfc$vertical_print_density_12] OF
            6..12 := [{nfc$vertical_print_density_6} 6, {nfc$vertical_print_density_7} 7,
            {nfc$vertical_print_density_8} 8,           {nfc$vertical_print_density_9} 9,
            {nfc$vertical_print_density_10} 10,         {nfc$vertical_print_density_11} 11,
            {nfc$vertical_print_density_12} 12],
      scfve_connection: ^nft$connection,
      vertical_print_density: amt$vertical_print_density;

    IF q_file^.ios_usage = nfc$ntf_remote_system THEN
      file_and_device_match := ntf_file_and_stream_match (q_file, device);
      RETURN;
    IFEND;

    device_match := (q_file^.device_type = device^.device_type) AND

      ((q_file^.external_characteristics = device^.external_characteristics [1]) OR

      (q_file^.external_characteristics = device^.external_characteristics [2]) OR

      (q_file^.external_characteristics = device^.external_characteristics [3]) OR

      (q_file^.external_characteristics = device^.external_characteristics [4])) AND

      ((q_file^.forms_code = device^.forms_code [1]) OR (q_file^.forms_code = device^.forms_code [2]) OR

      (q_file^.forms_code = device^.forms_code [3]) OR (q_file^.forms_code = device^.forms_code [4]));

    IF device_match AND (device^.maximum_file_size > 0) THEN
      device_match := q_file^.file_size <= device^.maximum_file_size;
    IFEND;

    IF device_match AND (q_file^.output_data_mode = nfc$transparent_mode) THEN
      bd_connection := device^.scfdi_connection;
      device_match := (device^.tip_type = nfc$async_tip) OR
            (device^.tip_type = nfc$hasp_tip) OR (device^.tip_type = nfc$x25_async_tip) OR
            ((device^.tip_type = nfc$uri_tip) AND (bd_connection^.btfs_di_advanced_features = 1));
    IFEND;

    scfve_connection := q_file^.scfve_connection;

    IF device_match THEN
      device_match := ((xns_protocol_stack IN scfve_connection^.btf_ve_protocol_stacks) AND
            (xns_protocol_stack IN device^.btfs_di_protocol_stacks)) OR
            ((osi_protocol_stack IN scfve_connection^.btf_ve_protocol_stacks) AND
            (osi_protocol_stack IN device^.btfs_di_protocol_stacks));
    IFEND;

    IF device_match AND (device^.btfs_di_title.length > 0) THEN
      current_unreachable_btfs_di := scfve_connection^.unreachable_btfs_di_list;
      WHILE device_match AND (current_unreachable_btfs_di <> NIL) DO
        device_match := device^.btfs_di_title <> current_unreachable_btfs_di^.title;
        current_unreachable_btfs_di := current_unreachable_btfs_di^.link;
      WHILEND;
    IFEND;

    IF device_match AND (device^.device_type = nfc$printer) THEN

      device_forms_size := $REAL (device^.forms_size)/$REAL (divisor);
      device_max_page_length := $REAL (device^.maximum_page_length);

      IF (q_file^.vertical_print_density <> nfc$vertical_print_density_none) THEN
        vertical_print_density := file_vpd_values [q_file^.vertical_print_density];
      ELSE  {user wishes file to print at the device's print density}
        vertical_print_density := device_vpd_values [device^.vertical_print_density];
      IFEND;

      device_match := (q_file^.page_width <= device^.page_width) AND
            ($REAL(q_file^.page_length)/$REAL(vertical_print_density) <= device_forms_size);
      device_match := device_match AND ($REAL(q_file^.page_length)/$REAL(vertical_print_density)
             <= device_max_page_length);

      IF device_match THEN
        IF (vertical_print_density = 6) THEN
          device_match := (device^.vertical_print_density = nfc$six_only) OR
                (device^.vertical_print_density = nfc$six_any) OR
                (device^.vertical_print_density = nfc$eight_any);
        ELSEIF(vertical_print_density = 8) THEN
          device_match := (device^.vertical_print_density = nfc$eight_only) OR
                (device^.vertical_print_density = nfc$six_any) OR
                (device^.vertical_print_density = nfc$eight_any);
        ELSE
          device_match := FALSE;
        IFEND;
      IFEND;

      IF device_match AND (q_file^.vfu_load_procedure <> osc$null_name) THEN
        device_match := (device^.vfu_load_option = nfc$vfu_changeable_by_user);
      IFEND;

    IFEND;
    file_and_device_match := device_match;

  FUNCEND file_and_device_match;
?? TITLE := 'file assignment response', EJECT ??

{  PURPOSE:
{    This procedure is executed when a response is received from SCF/VE to
{    a file assignment message sent by SCFS.  If the response indicates a
{    rejection to the file assignment, SCFS removes the file assignment and
{    attempts to assign another file to the device.
{
{    This procedure is also executed when a response is received from NTF/VE to
{    a file assignment message sent by SCFS.  If the response indicates a
{    rejection to the file assignment, SCFS removes the file assignment and
{    attempts to assign another file to the NTF batch stream.

  PROCEDURE file_assignment_response
    (VAR message: ^nft$message_sequence;
     VAR wait_list: ^ost$i_wait_list;
     VAR msg_length: integer;
     VAR status: ost$status);

    VAR
      device: ^nft$batch_device,
      device_found: boolean,
      device_name: ost$name,
      io_station: ^nft$io_station,
      io_station_found: boolean,
      io_station_name: ost$name,
      file_name: ost$name,
      queue_pointer: ^nft$output_queue_file,
      queue_file: ^nft$output_queue_file,
      response_code: nft$file_assignment_response,
      scfve_connection: ^nft$connection;

*copyc nft$file_assignment_resp_msg
?? NEWTITLE := 'crack file assignment response', EJECT ??

    PROCEDURE crack_file_assignment_response
      (VAR message: ^nft$message_sequence;
       VAR msg_length: integer;
       VAR io_station_name: ost$name;
       VAR file_name: ost$name;
       VAR response_code: nft$file_assignment_response;
       VAR device_name: ost$name;
       VAR status: ost$status);

      VAR
        ascii_string: ^string ( * <= osc$max_name_size),
        byte_array: ^nft$byte_array,
        parameter: ^nft$file_assign_resp_parameter,
        resp_code: ^nft$file_assignment_response,
        value_length: integer;

      NEXT parameter IN message;

      WHILE (parameter <> NIL) AND (parameter^.param <> nfc$null_parameter) AND (msg_length > 0) DO
        msg_length := msg_length - 1;
        IF parameter^.length_indicated THEN
          nfp$get_parameter_value_length (message, msg_length, value_length, status);
          msg_length := msg_length - value_length;
        ELSE
          value_length := 1;
          msg_length := msg_length - 1;
        IFEND;

        CASE parameter^.param OF
        = nfc$io_station_name =
          NEXT ascii_string: [value_length] IN message;
          #translate (osv$lower_to_upper, ascii_string^, io_station_name);

        = nfc$system_file_name =
          NEXT ascii_string: [value_length] IN message;
          #translate (osv$lower_to_upper, ascii_string^, file_name);

        = nfc$response_code =
          NEXT resp_code IN message;
          response_code := resp_code^;

        = nfc$device_name =
          NEXT ascii_string: [value_length] IN message;
          #translate (osv$lower_to_upper, ascii_string^, device_name);

        ELSE
{         ERROR ----   Ignore parameter value.
          NEXT byte_array: [1 .. value_length] IN message;

        CASEND;
        NEXT parameter IN message;
      WHILEND;

    PROCEND crack_file_assignment_response;
?? OLDTITLE, EJECT ??

    crack_file_assignment_response (message, msg_length, io_station_name, file_name, response_code,
          device_name, status);

    IF response_code <> nfc$file_assignment_accepted THEN
      find_io_station (io_station_name, io_station, io_station_found);
      IF NOT io_station_found THEN
        find_ntf_remote_system (io_station_name, io_station, io_station_found);
      IFEND;

      IF io_station_found THEN
        find_batch_device (device_name, io_station, device, device_found);
        IF device_found THEN
          queue_file := device^.current_file;
          IF queue_file <> NIL THEN
            queue_file^.assigned_device := NIL;
            device^.current_file := NIL;

            IF response_code = nfc$btfsdi_title_not_translated THEN
              queue_file^.output_state := nfc$eligible_for_transfer;
              scfve_connection := queue_file^.scfve_connection;
              add_unreachable_btfs_di (device^.btfs_di_title, scfve_connection, wait_list);
            ELSE
              queue_file^.output_state := nfc$not_eligible_for_transfer;
            IFEND;

            IF device_available_for_output (device) THEN
              find_file_for_device (device, message, status);
            IFEND;
          IFEND;
        IFEND;
      IFEND;
    IFEND;

  PROCEND file_assignment_response;
?? TITLE := 'find batch device', EJECT ??

  PROCEDURE find_batch_device
    (    device_name: ost$name;
         io_station: ^nft$io_station;
     VAR device: ^nft$batch_device;
     VAR device_found: boolean);

    device := io_station^.batch_device_list;
    device_found := FALSE;

    WHILE NOT device_found AND (device <> NIL) DO
      device_found := device^.name = device_name;
      IF NOT device_found THEN
        device := device^.link;
      IFEND;
    WHILEND;

  PROCEND find_batch_device;
?? TITLE := 'find file for device', EJECT ??

{  PURPOSE:
{    This procedure determines if the attributes of the output queue file
{    and the attributes of the device are such that the file should be
{    allowed to print at that device.
{
{    This procedure also determines if the attributes of the NTF queue file and
{    the attributes of the batch stream are such that the file should be sent
{    to that batch stream.

  PROCEDURE find_file_for_device
    (    device: ^nft$batch_device;
     VAR message: ^nft$message_sequence;
     VAR status: ost$status);

    VAR
      alias_entry: ^nft$alias,
      connection: ^nft$connection,
      current_file_priority: nft$priority,
      current_time: ost$date_time,
      index: 0 .. 4,
      io_station: ^nft$io_station,
      matching_file_priority: nft$priority,
      matching_q_file: ^nft$output_queue_file,
      more_aliases: boolean,
      ntf_acc_remote_system_ptr: ^nft$pointer_list_entry,
      null_alias: boolean,
      q_file: ^nft$output_queue_file,
      use_intial_priority: boolean;

?? NEWTITLE := 'check_selected_files_q_for_file', EJECT ??

    PROCEDURE check_selected_files_q_for_file
      (    io_station: ^nft$io_station;
           device: ^nft$batch_device;
       VAR matching_q_file: ^nft$output_queue_file);

      VAR
        q_file: ^nft$output_queue_file,
        selected_file: ^nft$selected_file;

      matching_q_file := NIL;

      q_file := NIL;
      selected_file := io_station^.selected_files_queue;
      WHILE selected_file <> NIL DO
        q_file := selected_file^.output_file;
        IF (q_file^.output_state = nfc$eligible_for_transfer) AND
              ((selected_file^.device_selected = device^.name) OR
              (((q_file^.device_name = osc$null_name) OR (q_file^.device_name = automatic) OR
              (q_file^.device_name = device^.name) OR (q_file^.device_name = device^.alias_names [1]) OR
              (q_file^.device_name = device^.alias_names [2]) OR
              (q_file^.device_name = device^.alias_names [3])) AND
              file_and_device_match (q_file, device))) THEN
          matching_q_file := q_file;
          RETURN;
        IFEND;
        selected_file := selected_file^.link;
      WHILEND;

    PROCEND check_selected_files_q_for_file;
?? OLDTITLE, EJECT ??
    IF NOT any_outstanding_di_responses (device^.outstanding_di_responses) THEN
      matching_file_priority := 0;
      matching_q_file := NIL;
      io_station := device^.io_station;
      pmp$get_compact_date_time (current_time, status);
      use_intial_priority := NOT status.normal;
      IF io_station^.usage <> nfc$ntf_remote_system THEN
        IF io_station^.selected_files_queue <> NIL THEN
          check_selected_files_q_for_file (io_station, device, matching_q_file);
        IFEND;
        IF matching_q_file <> NIL THEN
          more_aliases := FALSE;
        ELSE
          index := 0;
          more_aliases := TRUE;
        IFEND;
      ELSE
        ntf_acc_remote_system_ptr := io_station^.ntf_acc_remote_system_ptr_list;
        check_for_ntf_signed_on_stream (io_station, device, more_aliases);
        more_aliases := more_aliases AND (ntf_acc_remote_system_ptr <> NIL);
      IFEND;

      WHILE more_aliases DO
        IF io_station^.usage <> nfc$ntf_remote_system THEN
          null_alias := io_station^.alias_list [index] = NIL;
        ELSE
          null_alias := FALSE;
        IFEND;

        IF NOT null_alias THEN
          IF io_station^.usage <> nfc$ntf_remote_system THEN
            alias_entry := io_station^.alias_list [index];
          ELSE
            alias_entry := ntf_acc_remote_system_ptr^.ntf_acc_remote_system;
          IFEND;

          IF alias_entry^.queue <> NIL THEN
            q_file := alias_entry^.queue;
            WHILE q_file <> NIL DO
              IF (q_file^.output_state = nfc$eligible_for_transfer) AND ((q_file^.device_name = osc$null_name)
                    OR (q_file^.device_name = automatic) OR (q_file^.device_name = device^.name) OR (q_file^.
                    device_name = device^.alias_names [1]) OR (q_file^.device_name = device^.alias_names [2])
                    OR (q_file^.device_name = device^.alias_names [3])) AND (file_and_device_match (q_file,
                    device)) THEN
                IF use_intial_priority THEN
                  current_file_priority := q_file^.initial_priority;
                ELSE
                  current_file_priority := calculate_priority (q_file, current_time);
                IFEND;
                IF current_file_priority > matching_file_priority THEN
                  matching_q_file := q_file;
                  matching_file_priority := current_file_priority;
                IFEND;
              IFEND;
              q_file := q_file^.link;
            WHILEND;
          IFEND;
        IFEND;

        IF io_station^.usage <> nfc$ntf_remote_system THEN
          index := index + 1;
          more_aliases := index <= 3;
        ELSE
          ntf_acc_remote_system_ptr := ntf_acc_remote_system_ptr^.link;
          more_aliases := ntf_acc_remote_system_ptr <> NIL;
        IFEND;
      WHILEND;

      IF matching_q_file <> NIL THEN
        matching_q_file^.output_state := nfc$selected_for_transfer;
        matching_q_file^.assigned_device := device;
        device^.current_file := matching_q_file;
        connection := matching_q_file^.scfve_connection;
        send_file_assignment_msg (message, io_station^.name, matching_q_file^, device, connection,
               status);
      IFEND;
    IFEND;

  PROCEND find_file_for_device;
?? TITLE := 'find_files_for_ntf_logical_line', EJECT ??

{  PURPOSE:
{    This procedure checks each batch stream on an NTF logical line to see if
{    if the attributes of an NTF queue file and the attributes of the batch
{    stream are such that the file should be sent to that batch stream.

  PROCEDURE find_files_for_ntf_logical_line
    (    remote_system: ^nft$io_station;
         logical_line_number: nft$ntf_logical_line_number;
     VAR message: ^nft$message_sequence;
     VAR status: ost$status);

    VAR
      batch_stream: ^nft$batch_device;

    status.normal := TRUE;
    batch_stream := remote_system^.batch_device_list;
    WHILE batch_stream <> NIL DO
      IF batch_stream^.ntf_logical_line_number = logical_line_number THEN
        IF device_available_for_output (batch_stream) THEN
          find_file_for_device (batch_stream, message, status);
        IFEND;
      IFEND;

      batch_stream := batch_stream^.link;
    WHILEND;
  PROCEND find_files_for_ntf_logical_line;
?? TITLE := 'find io station', EJECT ??

{  PURPOSE:
{    This procedure finds a station name within the list of IO stations.
{    A pointer to the I/O station is returned if the station name is found.

  PROCEDURE find_io_station
    (    io_station_name: ost$name;
     VAR station: ^nft$io_station;
     VAR station_found: boolean);

    station := scfs_tables.first_io_station;
    station_found := FALSE;

    WHILE NOT station_found AND (station <> NIL) DO
      station_found := station^.name = io_station_name;
      IF NOT station_found THEN
        station := station^.link;
      IFEND;
    WHILEND;

  PROCEND find_io_station;
?? TITLE := 'find_io_station_alias', EJECT ??

{  PURPOSE:
{    This procedure finds a station name within the list of IO station aliases.
{    A pointer to the station alias is returned if the station name is found.

  PROCEDURE find_io_station_alias
    (    io_station_name: ost$name;
     VAR ios_alias: ^nft$alias;
     VAR alias_found: boolean);

    ios_alias := scfs_tables.first_station_name_alias;
    alias_found := FALSE;
    WHILE NOT alias_found AND (ios_alias <> NIL) DO
      alias_found := ios_alias^.name = io_station_name;
      IF NOT alias_found THEN
        ios_alias := ios_alias^.link;
      IFEND;
    WHILEND;

  PROCEND find_io_station_alias;
?? TITLE := 'find_io_station_or_remote_system', EJECT ??

{  PURPOSE:
{    This procedure finds a station name within the list of IO stations or
{    within the list of NTF remote systems.  A pointer to the station or remote
{    system is returned if the station name is found.

  PROCEDURE find_io_station_or_remote_sys
    (    io_station_name: ost$name;
         connection: ^nft$connection;
     VAR station: ^nft$io_station;
     VAR station_found: boolean);

{ Do not search for an IO station if the request comes from a connection that
{ is only used by NTF such as NTF/VE or OPERATE_NTF.

    IF (connection^.kind <> nfc$ntfve_connection) AND (connection^.kind <> nfc$ntf_operator_connection) THEN
      find_io_station (io_station_name, station, station_found);
      IF station_found THEN
        RETURN;
      IFEND;
    IFEND;

{ Do not search for an NTF remote system if the request comes from a connection
{ that is never used by NTF such as SCF/VE or OPERATE_STATION.

    IF (connection^.kind <> nfc$scfve_connection) AND (connection^.kind <> nfc$operator_connection) THEN
      find_ntf_remote_system (io_station_name, station, station_found);
    IFEND;

  PROCEND find_io_station_or_remote_sys;
?? TITLE := 'find_ntf_acc_remote_system', EJECT ??

{  PURPOSE:
{    This procedure finds an accessible remote system in the list of accessible
{    remote systems known to SCFS.  If the specified accessible remote system
{    is not found, a pointer to the null alias is returned.

  PROCEDURE find_ntf_acc_remote_system
    (    acc_remote_system_name: ost$name;
     VAR acc_remote_system: ^nft$alias);

?? NEWTITLE := 'search_acc_remote_system_list', EJECT ??

    PROCEDURE search_acc_remote_system_list
      (    acc_remote_system_name: ost$name;
           first_acc_remote_system: ^cell;
       VAR acc_remote_system: ^nft$alias);

      VAR
        temp: integer,
        acc_remote_system_found: boolean,
        acc_remote_system_list: ^array [1 .. nfc$ntf_max_remote_systems] of nft$alias,
        current: nft$ntf_remote_system_count,
        first: nft$ntf_remote_system_count,
        last: nft$ntf_remote_system_count;

      acc_remote_system_list := first_acc_remote_system;
      first := 1;
      last := scfs_tables.ntf_acc_remote_system_count;
      acc_remote_system_found := FALSE;
      WHILE (first <= last) AND (NOT acc_remote_system_found) DO
        temp := first + last;
        current := temp DIV 2;
        IF acc_remote_system_name < acc_remote_system_list^ [current].name THEN
          last := current - 1;
        ELSEIF acc_remote_system_name > acc_remote_system_list^ [current].name THEN
          first := current + 1;
        ELSE
          acc_remote_system_found := TRUE;
        IFEND;
      WHILEND;

      IF acc_remote_system_found THEN
        acc_remote_system := ^acc_remote_system_list^ [current];
      ELSE
        acc_remote_system := NIL;
      IFEND;

    PROCEND search_acc_remote_system_list;

?? OLDTITLE, EJECT ??

    search_acc_remote_system_list (acc_remote_system_name, scfs_tables.first_ntf_acc_remote_system,
          acc_remote_system);

  PROCEND find_ntf_acc_remote_system;
?? TITLE := 'find_ntf_client_connection', EJECT ??

{  PURPOSE:
{    This procedure finds an NTF client connection based on the NTF system
{    identifier.  If the specified client connection is not found, a null
{    pointer is returned.

  PROCEDURE find_ntf_client_connection
    (    ntf_system_identifier: nft$ntf_system_identifier;
     VAR connection: ^nft$connection);

    VAR
      connection_found: boolean;

    connection_found := FALSE;
    connection := scfs_tables.first_connection;
    WHILE (NOT connection_found) AND (connection <> NIL)
          DO
      connection_found := ((connection^.kind = nfc$ntfve_connection) AND (ntf_system_identifier (1,
            nfc$ntf_model_and_sn_size) = connection^.ntf_system_identifier (1, nfc$ntf_model_and_sn_size)));
      IF NOT connection_found THEN
        connection := connection^.link;
      IFEND;
    WHILEND;

  PROCEND find_ntf_client_connection;
?? TITLE := 'find_ntf_logical_line', EJECT ??

{  PURPOSE:
{    This procedure finds a logical line in the list of logical lines known to
{    a remote system.  If the specified logical line is not found, a pointer to
{    the last logical line in the list is returned.

  PROCEDURE find_ntf_logical_line
    (    logical_line_number: nft$ntf_logical_line_number;
         remote_system: ^nft$io_station;
     VAR logical_line: ^nft$ntf_logical_line;
     VAR logical_line_found: boolean);

    VAR
      last_logical_line: ^nft$ntf_logical_line;

    logical_line := remote_system^.ntf_logical_line_list;
    last_logical_line := logical_line;
    logical_line_found := FALSE;
    WHILE (NOT logical_line_found) AND (logical_line <> NIL) DO
      logical_line_found := logical_line_number = logical_line^.logical_line_number;
      IF NOT logical_line_found THEN
        last_logical_line := logical_line;
        logical_line := logical_line^.link;
      IFEND;
    WHILEND;

    IF NOT logical_line_found THEN
      logical_line := last_logical_line;
    IFEND;

  PROCEND find_ntf_logical_line;
?? TITLE := 'find_ntf_remote_queue', EJECT ??

{  PURPOSE:
{    This procedure searches the accessible remote system list for the
{    specified destination name.  If it is found, pointers to the queue file
{    and the queue list are returned.  If it is not found, the pointers are set
{    to null.

  PROCEDURE find_ntf_remote_queue
    (    destination_name: ost$name;
     VAR queue_pointer: ^^nft$output_queue_file; {!!}
     VAR remote_system_list: ^nft$pointer_list_entry);

    VAR
      destination: ^nft$alias,
      q_found: boolean;

    q_found := FALSE;
    queue_pointer := NIL;
    remote_system_list := NIL;
    destination := scfs_tables.first_ntf_acc_remote_system;
    WHILE (NOT q_found) AND (destination <> NIL) DO
      q_found := (destination^.name = destination_name);
      IF q_found THEN
        queue_pointer := ^destination^.queue;
        remote_system_list := destination^.station_list;
      ELSE
        destination := destination^.link;
      IFEND;
    WHILEND;

  PROCEND find_ntf_remote_queue;
?? TITLE := 'find_ntf_remote_system', EJECT ??

{  PURPOSE:
{    This procedure finds a remote system in the list of remote systems known
{    to SCFS.  If the specified remote system is not found, a pointer to the
{    last remote system in the list is returned.

  PROCEDURE find_ntf_remote_system
    (    remote_system_name: ost$name;
     VAR remote_system: ^nft$io_station;
     VAR remote_system_found: boolean);

    VAR
      last_remote_system: ^nft$io_station;

    remote_system := scfs_tables.first_ntf_remote_system;
    last_remote_system := remote_system;
    remote_system_found := FALSE;
    WHILE (NOT remote_system_found) AND (remote_system <> NIL) DO
      remote_system_found := remote_system_name = remote_system^.name;
      IF NOT remote_system_found THEN
        last_remote_system := remote_system;
        remote_system := remote_system^.link;
      IFEND;
    WHILEND;

    IF NOT remote_system_found THEN
      remote_system := last_remote_system;
    IFEND;

  PROCEND find_ntf_remote_system;
?? TITLE := 'find_ntf_remote_system_pointer', EJECT ??

{  PURPOSE:
{    This procedure finds a remote system pointer in the list of remote system
{    pointers known to an accessible remote system.  A specific logical line of
{    the remote system can be optionally specified.  If the specified remote
{    system pointer is not found, a pointer to the last remote system pointer
{    in the list is returned.

  PROCEDURE find_ntf_remote_system_pointer
    (    remote_system_name: ost$name;
         check_logical_line_number: boolean;
         logical_line_number: nft$ntf_logical_line_number;
         acc_remote_system: ^nft$alias;
     VAR remote_system_ptr: ^nft$pointer_list_entry;
     VAR remote_system_ptr_found: boolean);

    VAR
      last_remote_system_ptr: ^nft$pointer_list_entry,
      remote_system: ^nft$io_station;

    remote_system_ptr := acc_remote_system^.station_list;
    last_remote_system_ptr := remote_system_ptr;
    remote_system_ptr_found := FALSE;
    WHILE (NOT remote_system_ptr_found) AND (remote_system_ptr <> NIL) DO
      remote_system := remote_system_ptr^.ntf_remote_system;
      remote_system_ptr_found := remote_system_name = remote_system^.name;
      IF check_logical_line_number AND remote_system_ptr_found THEN
        remote_system_ptr_found := (logical_line_number = remote_system_ptr^.ntf_logical_line_number);
      IFEND;

      IF NOT remote_system_ptr_found THEN
        last_remote_system_ptr := remote_system_ptr;
        remote_system_ptr := remote_system_ptr^.link;
      IFEND;
    WHILEND;

    IF NOT remote_system_ptr_found THEN
      remote_system_ptr := last_remote_system_ptr;
    IFEND;

  PROCEND find_ntf_remote_system_pointer;
?? TITLE := 'find private queue', EJECT ??

{  PURPOSE:
{    This procedure finds a private queue.  The "private queue" is said
{    to be found when an operator is currently in control of the station,
{    the specified operator name matches the operator currently in control
{    and the specified operator family matches the family of the operator
{    currently in control of the station.

  PROCEDURE find_private_queue
   (    operator_name: ost$name;
        operator_family: ost$name;
    VAR queue_pointer: ^^nft$output_queue_file;
    VAR station_list: ^nft$pointer_list_entry;
    VAR q_found: boolean);

    VAR
      alias_entry: ^nft$alias,
      alias_found: boolean,
      connection: ^nft$connection,
      io_station: ^nft$io_station;

    connection := scfs_tables.first_connection;

    q_found := FALSE;
    WHILE (NOT q_found) AND (connection <> NIL) DO
      q_found := (connection^.kind = nfc$operator_connection) AND (connection^.user = operator_name) AND
            (connection^.family = operator_family);
      IF q_found THEN
        io_station := connection^.operating_station;
        q_found := io_station^.usage = nfc$private_io_station;
      IFEND;
      IF q_found THEN
        alias_entry := io_station^.alias_list [0];
        queue_pointer := ^alias_entry^.queue;
        station_list := alias_entry^.station_list;
      ELSE
        connection := connection^.link;
      IFEND;
    WHILEND;

  PROCEND find_private_queue;
?? TITLE := 'find public queue', EJECT ??

{  PURPOSE:
{    This procedure searches the station name alias list for the specified
{    destination name.  If it is found, a pointer to the queue list is returned.

  PROCEDURE find_public_queue
    (    destination_name: ost$name;
     VAR queue_pointer: ^^nft$output_queue_file;
     VAR station_list: ^nft$pointer_list_entry;
     VAR q_found: boolean);

    VAR
      destination: ^nft$alias;

    q_found := FALSE;
    destination := scfs_tables.first_station_name_alias;
    WHILE NOT q_found AND (destination <> NIL) DO
      q_found := destination^.name = destination_name;
      IF q_found THEN
        queue_pointer := ^destination^.queue;
        station_list := destination^.station_list;
      ELSE
        destination := destination^.link;
      IFEND;
    WHILEND;

  PROCEND find_public_queue;
?? TITLE := 'find q file', EJECT ??

{  PURPOSE:
{    This procedure searches the specified queue list for the given queue
{    file name.  If the file name is found, a pointer to the queue file is
{    returned.

  PROCEDURE find_q_file
    (    file_name: ost$name;
         queue_list:^ nft$output_queue_file;
     VAR q_file: ^nft$output_queue_file);

    VAR
      file_found: boolean;

    file_found := FALSE;
    q_file := queue_list;
    WHILE NOT file_found AND (q_file <> NIL) DO
      file_found := file_name = q_file^.system_file_name;
      IF NOT file_found THEN
        q_file := q_file^.link;
      IFEND;
    WHILEND;

  PROCEND find_q_file;
?? TITLE := 'find_station_and_selected_file', EJECT ??

{  PURPOSE:
{    This procedure finds the station that has the desired file in its selected
{    files queue.  It returns the station and the selected file.

  PROCEDURE find_station_and_selected_file
    (    file_name: ost$name;
     VAR io_station: ^nft$io_station;
     VAR selected_file: ^nft$selected_file);

    VAR
      output_file: ^nft$output_queue_file;

    selected_file := NIL;
    io_station := scfs_tables.first_io_station;

  /io_station_loop/
    WHILE io_station <> NIL DO
      IF io_station^.selected_files_queue <> NIL THEN
        selected_file := io_station^.selected_files_queue;

      /selected_files_queue_loop/
        WHILE selected_file <> NIL DO
          output_file := selected_file^.output_file;
          IF file_name = output_file^.system_file_name THEN
            EXIT /io_station_loop/;
          IFEND;
          selected_file := selected_file^.link;
        WHILEND /selected_files_queue_loop/ ;
      IFEND;
      io_station := io_station^.link;
    WHILEND /io_station_loop/;

  PROCEND find_station_and_selected_file;
?? TITLE := 'get device status msg', EJECT ??

{  PURPOSE:
{    This procedure is executed when a request is received from OPES for
{    detailed status information on a specified device.  If the station and
{    device specified are found, the device information is sent back in the
{    response message, otherwise a negative response code is sent back to OPES.
{
{    This procedure is also executed when a request is received from OPENTF for
{    detailed status information on a specified batch stream.  If the remote
{    system and batch stream specified are found, the stream information is
{    sent back in the response message, otherwise a negative response code is
{    sent back to OPENTF.

  PROCEDURE get_device_status_msg
    (VAR message: ^nft$message_sequence;
         connection: ^nft$connection;
     VAR status: ost$status);

    VAR
      ascii_string: ^string ( * <= osc$max_name_size),
      device: ^nft$batch_device,
      device_found: boolean,
      device_name: ost$name,
      fake_device: nft$batch_device,
      io_station: ^nft$io_station,
      io_station_found: boolean,
      io_station_name: ost$name,
      msg_length: integer,
      parameter: ^nft$get_device_status_param,
      response: nft$display_status_resp_codes,
      value_length: integer;

*copy nft$get_device_status_msg

    msg_length := 0;
    response := nfc$disp_msg_accepted;

{   Since Get Device Status has only 2 parameters, this is all that is needed.
    NEXT parameter IN message;
    IF parameter^.length_indicated THEN
      nfp$get_parameter_value_length (message, msg_length, value_length, status);
    ELSE
      value_length := 1;
    IFEND;
    NEXT ascii_string: [value_length] IN message;
    #translate (osv$lower_to_upper, ascii_string^, io_station_name);

    NEXT parameter IN message;
    IF parameter^.length_indicated THEN
      nfp$get_parameter_value_length (message, msg_length, value_length, status);
    ELSE
      value_length := 1;
    IFEND;
    NEXT ascii_string: [value_length] IN message;
    #translate (osv$lower_to_upper, ascii_string^, device_name);

    find_io_station_or_remote_sys (io_station_name, connection, io_station, io_station_found);
    IF io_station_found THEN
      find_batch_device (device_name, io_station, device, device_found);
      IF NOT device_found THEN
        response := nfc$disp_no_batch_device;
      IFEND;
    ELSE
      response := nfc$disp_no_io_station;
    IFEND;

    IF response <> nfc$disp_msg_accepted THEN
      fake_device.name := device_name;
      device := ^fake_device;
    IFEND;

    send_device_status_msg (message, response, io_station, device, connection, {optimize} FALSE,
         status);

  PROCEND get_device_status_msg;
?? TITLE := 'get new connection', EJECT ??

{  PURPOSE:
{    This procedure is executed in response to a connection request by another
{    process executing within the CDNA system (e.g. SCF/DI, SCF/VE , NTF/VE,
{    OPES, or OPENTF).

  PROCEDURE get_new_connection
   (VAR wait_list: ^ost$i_wait_list;
    VAR wait_connection_list: ^nft$wait_connection_list;
    VAR message: ^nft$message_sequence;
    VAR status: ost$status);

    VAR
      attributes: ^nat$create_attributes,
      cf: ^ost$name,
      connect_file: ^fst$file_reference,
      connect_file_identifier: amt$file_identifier,
      connection: ^nft$connection,
      ignore_status: ost$status,
      index: integer,
      known_connection: boolean,
      mandated_attributes: [STATIC, READ] array [1 .. 1] of fst$file_cycle_attribute :=
            [[fsc$file_organization, amc$sequential]],
      temporary_connection: nft$connection,
      unique_name: ost$name,
      wait_time: 0 .. 0ffffffff(16);

?? NEWTITLE := 'add connection to list', EJECT ??

    PROCEDURE add_connection_to_list
      (    connect_file: string ( * );
           connect_file_identifier: amt$file_identifier;
           connection: nft$connection;
       VAR current_connection: ^nft$connection);

      VAR
        new_connection: ^nft$connection,
        next_ntf_operator: ^nft$connection;

      ALLOCATE new_connection;
      new_connection^ := connection;

      current_connection := scfs_tables.first_connection;
      IF scfs_tables.first_connection <> NIL THEN

      /find_last_connection/
        WHILE current_connection^.link <> NIL DO
          current_connection := current_connection^.link;
        WHILEND /find_last_connection/;
      IFEND;

      IF scfs_tables.first_connection = NIL THEN
        scfs_tables.first_connection := new_connection;
        new_connection^.back_link := NIL;
      ELSE
        current_connection^.link := new_connection;
        new_connection^.back_link := current_connection;
      IFEND;

      current_connection := new_connection;
      current_connection^.file_name := connect_file;
      current_connection^.id := connect_file_identifier;
      current_connection^.link := NIL;
      IF current_connection^.kind = nfc$ntf_operator_connection THEN
        scfs_tables.first_ntf_operator := current_connection;
        IF current_connection^.next_ntf_operator <> NIL THEN
          next_ntf_operator := current_connection^.next_ntf_operator;
          next_ntf_operator^.prior_ntf_operator := current_connection;
        IFEND;
      IFEND;

    PROCEND add_connection_to_list;
?? TITLE := 'add to wait list', EJECT ??

    PROCEDURE add_to_wait_list
      (    connection: ^nft$connection;
       VAR wait_list: ^ost$i_wait_list;
       VAR wait_connection_list: ^nft$wait_connection_list);

      VAR
        i: integer,
        temp_seq: ^SEQ ( * ),
        temp_wait_list: ^ost$i_wait_list,
        temp_wait_connection_list: ^nft$wait_connection_list,
        wait_list_limit: integer;

      wait_list_limit := UPPERBOUND (wait_list^);
      IF (wait_list_limit MOD nfc$wait_list_limit) <> 0 THEN
        RESET wait_list_seq;
        NEXT wait_list: [1 .. (wait_list_limit + 1)] IN wait_list_seq;
        RESET wait_connection_list_seq;
        NEXT wait_connection_list: [wait_connection_list_lowest .. (wait_list_limit + 1)]
              IN wait_connection_list_seq;
      ELSE
        ALLOCATE temp_seq: [[REP (wait_list_limit + nfc$wait_list_limit) OF ost$i_activity]];
        RESET temp_seq;
        NEXT temp_wait_list: [1 .. (wait_list_limit + 1)] IN temp_seq;
        FOR i := 1 TO wait_list_limit DO
          temp_wait_list^ [i] := wait_list^ [i];
        FOREND;
        FREE wait_list_seq;
        wait_list_seq := temp_seq;
        wait_list := temp_wait_list;

        ALLOCATE temp_seq: [[REP (wait_list_limit + nfc$wait_list_limit) OF ost$i_activity]];
        RESET temp_seq;
        NEXT temp_wait_connection_list: [wait_connection_list_lowest .. (wait_list_limit + 1)] IN temp_seq;
        FOR i := wait_connection_list_lowest TO wait_list_limit DO
          temp_wait_connection_list^ [i] := wait_connection_list^ [i];
        FOREND;
        FREE wait_connection_list_seq;
        wait_connection_list_seq := temp_seq;
        wait_connection_list := temp_wait_connection_list;
      IFEND;

      wait_list^ [wait_list_limit + 1].activity := nac$i_await_data_available;
      wait_list^ [wait_list_limit + 1].file_identifier := connection^.id;
      wait_connection_list^ [wait_list_limit + 1] := connection;
      connection^.wait_list_index := wait_list_limit + 1;

    PROCEND add_to_wait_list;
?? TITLE := 'get client call data', EJECT ??

    PROCEDURE get_client_call_data
      (    connect_file: string ( * );
       VAR connection: nft$connection;
       VAR status: ost$status);

      VAR
        client_identifier: ^nft$scfs_client_identifier,
        peer_attributes: ^nat$get_attributes;

      status.normal := TRUE;

      PUSH peer_attributes: [1 .. 2];
      peer_attributes^ [1].kind := nac$peer_address;
      peer_attributes^ [2].kind := nac$peer_connect_data;
      PUSH peer_attributes^ [2].peer_connect_data: [[REP 512 OF cell]];

      nap$get_attributes (connect_file, peer_attributes^, status);
      IF status.normal THEN
        IF (peer_attributes^ [1].peer_address.kind = nac$internet_address) OR
              (peer_attributes^ [1].peer_address.kind = nac$osi_transport_address) THEN
          connection.peer_address := peer_attributes^ [1].peer_address;
        IFEND;
        RESET peer_attributes^ [2].peer_connect_data;
        NEXT client_identifier: [peer_attributes^ [2].peer_connect_data_length - 1] IN peer_attributes^ [2].
              peer_connect_data;

        IF client_identifier^.data_version <> nfc$scfs_client_data_version THEN
          status.normal := FALSE;
        ELSEIF client_identifier^.identifier = nfc$scf_di_client THEN
          connection.kind := nfc$scfdi_connection;
          connection.btfs_di_status := nfc$btfs_di_down;
          connection.btfs_di_title.length := 0;
          connection.btfs_di_title.title := ' ';
          connection.btfs_di_protocol_stacks := $protocol_stacks_set [xns_protocol_stack];
          connection.btfs_di_advanced_features := 0;
        ELSEIF client_identifier^.identifier = nfc$scf_ve_client THEN
          connection.kind := nfc$scfve_connection;
          connection.scfve_queue := NIL;
          connection.ntf_system_identifier := nfc$ntf_blank_system_identifier;
          connection.btf_ve_protocol_stacks := $protocol_stacks_set [xns_protocol_stack];
          connection.btf_ve_status_received := FALSE;
          connection.unreachable_btfs_di_list := NIL;
        ELSEIF client_identifier^.identifier = nfc$opes_ve_client THEN
          connection.kind := nfc$operator_connection;
          connection.user := osc$null_name;
          connection.family := osc$null_name;
          connection.ntf_operator_identifier := nfc$ntf_blank_system_identifier;
          connection.operating_station := NIL;
          connection.accept_messages := FALSE;
          connection.prior_ntf_operator := NIL;
          connection.next_ntf_operator := NIL;
        ELSEIF client_identifier^.identifier = nfc$scfs_ve_client THEN
          connection.kind := nfc$scfsve_connection;
        ELSEIF client_identifier^.identifier (1, nfc$opentf_ve_client_length) = nfc$opentf_ve_client THEN
          connection.kind := nfc$ntf_operator_connection;
          connection.user := osc$null_name;
          connection.family := osc$null_name;
          connection.ntf_operator_identifier := client_identifier^.identifier (nfc$opentf_ve_client_length +
                1, nfc$ntf_system_identifier_size);
          connection.operating_station := NIL;
          connection.accept_messages := FALSE;
          connection.prior_ntf_operator := NIL;
          connection.next_ntf_operator := scfs_tables.first_ntf_operator;
        ELSEIF client_identifier^.identifier (1, nfc$ntf_ve_client_length) = nfc$ntf_ve_client THEN
          connection.kind := nfc$ntfve_connection;
          connection.scfve_queue := NIL;
          connection.ntf_system_identifier := client_identifier^.identifier (nfc$ntf_ve_client_length + 1,
                nfc$ntf_system_identifier_size);
          connection.btf_ve_protocol_stacks := $protocol_stacks_set [xns_protocol_stack];
          connection.btf_ve_status_received := FALSE;
          connection.unreachable_btfs_di_list := NIL;
        ELSE
          status.normal := FALSE;
        IFEND;
      IFEND;

    PROCEND get_client_call_data;
?? TITLE := 'search connection list', EJECT ??

    PROCEDURE search_connection_list
     (    connection: nft$connection;
      VAR known_connection: boolean;
      VAR connection_index: integer);

      VAR
        current_connection: ^nft$connection;

      known_connection := FALSE;

      IF (connection.kind <> nfc$operator_connection) AND (connection.kind <> nfc$ntf_operator_connection)
            THEN
        current_connection := scfs_tables.first_connection;

      /search_for_connection/
        WHILE (current_connection <> NIL)
              AND (NOT known_connection) DO

          known_connection := ((connection.kind = current_connection^.kind) AND
                nfp$network_addresses_match (connection.peer_address, current_connection^.peer_address));

          IF known_connection THEN
            connection_index := current_connection^.wait_list_index;
          ELSE
            current_connection := current_connection^.link;
          IFEND;

        WHILEND;

      IFEND;

    PROCEND search_connection_list;

?? OLDTITLE, EJECT ??

{   If there is no connection the SCFS can wait for a connection.

    IF scfs_tables.first_connection = NIL THEN
      wait_time := 0fff(16);
    ELSE
      wait_time := 0;
    IFEND;

    pmp$get_unique_name (unique_name, status);
    connect_file := ^unique_name;

    PUSH attributes: [1 .. 1];
    attributes^ [1].kind := nac$connect_data;
    PUSH attributes^ [1].connect_data: [[REP osc$max_name_size OF cell]];
    RESET attributes^ [1].connect_data;
    NEXT cf IN attributes^ [1].connect_data;
    cf^ := control_facility_name;

{  Request ownership of the connections which have been assigned to the
{  server application.

    nap$acquire_connection (server_name, connect_file^, attributes, wait_time, status);
    IF status.normal THEN

{  Open the file which will identify the connection end point.  }

      fsp$open_file (unique_name, amc$record, NIL, NIL, NIL, ^mandated_attributes, NIL,
            connect_file_identifier, status);
      IF status.normal THEN
        get_client_call_data (connect_file^, temporary_connection, status);
        IF scfs_event_logging THEN
          log_receive_connection_event (connect_file^, temporary_connection, status.normal);
        IFEND;
        search_connection_list (temporary_connection, known_connection, index);
        IF status.normal THEN

{  Accept the request to establish a connection with SCFS. }

          IF known_connection THEN
            remove_connection_from_list ( index, wait_list, wait_connection_list,
                  message, status);
          IFEND;
          nap$accept_connection (connect_file^, status);
          IF status.normal THEN
            add_connection_to_list (connect_file^, connect_file_identifier, temporary_connection,
                   connection);
            add_to_wait_list (connection, wait_list, wait_connection_list);
          ELSEIF (status.condition = nae$invalid_request) THEN
            RETURN;
          ELSE
            fsp$close_file (connect_file_identifier, ignore_status);
            amp$return (unique_name, ignore_status);
          IFEND;
        ELSE
          fsp$close_file (connect_file_identifier, ignore_status);
          amp$return (unique_name, ignore_status);
        IFEND;
      ELSE { unable to open connection file
        amp$return (unique_name, ignore_status);
      IFEND;
    ELSEIF (status.condition = nae$application_inactive) OR
         (status.condition = nae$server_not_attached) OR
         (status.condition = nae$invalid_connect_data_change) THEN
      RETURN;
    IFEND;

  PROCEND get_new_connection;
?? TITLE := 'get_ntf_remote_system_names_msg', EJECT ??

{  PURPOSE:
{    This procedure is executed when a request is received from OPENTF for
{    remote system names information.  If the remote system is unknown, a
{    negative response is sent to OPENTF, otherwise the remote system
{    information is returned.

  PROCEDURE get_ntf_remote_system_names_msg
    (VAR message: ^nft$message_sequence;
         connection: ^nft$connection;
     VAR msg_length: integer;
     VAR status: ost$status);

    VAR
      logical_line_number: nft$ntf_logical_line_number,
      logical_line_number_specified: boolean,
      remote_system_kind_set: set of nft$ntf_remote_system_kind,
      remote_system_name: ost$name,
      remote_system_name_specified: boolean,
      message_response: nft$display_status_resp_codes;

*copy nft$ntf_get_rem_sys_names_msg
?? NEWTITLE := 'crack_get_remote_sys_names_msg', EJECT ??

    PROCEDURE crack_get_remote_sys_names_msg
      (VAR message: ^nft$message_sequence;
       VAR msg_length: integer;
       VAR remote_system_name_specified: boolean;
       VAR remote_system_name: ost$name;
       VAR logical_line_number_specified: boolean;
       VAR logical_line_number: nft$ntf_logical_line_number;
       VAR remote_system_kind_set: set of nft$ntf_remote_system_kind;
       VAR status: ost$status);

      TYPE
        kind_set = set of nft$ntf_remote_system_kind;

      VAR
        ascii_string: ^string ( * <= osc$max_name_size),
        byte_array: ^nft$byte_array,
        line_number: ^nft$ntf_logical_line_number,
        parameter: ^nft$ntf_get_rem_sys_names_msg,
        remote_sys_kind_set: ^kind_set,
        value_length: integer;

      status.normal := TRUE;
      NEXT parameter IN message;
      logical_line_number_specified := FALSE;
      remote_system_name_specified := FALSE;
      remote_system_kind_set := - $kind_set [ ];

      WHILE (parameter <> NIL) AND (parameter^.param <> nfc$null_parameter) AND (msg_length > 0) DO
        msg_length := msg_length - 1;
        IF parameter^.length_indicated THEN
          nfp$get_parameter_value_length (message, msg_length, value_length, status);
          msg_length := msg_length - value_length;
        ELSE
          value_length := 1;
          msg_length := msg_length - 1;
        IFEND;

        CASE parameter^.param OF
        = nfc$ntf_remote_system_name =
          NEXT ascii_string: [value_length] IN message;
          #TRANSLATE (osv$lower_to_upper, ascii_string^, remote_system_name);
          remote_system_name_specified := TRUE;

        = nfc$ntf_logical_line_number =
          NEXT line_number IN message;
          logical_line_number := line_number^;
          logical_line_number_specified := TRUE;

        = nfc$ntf_remote_system_kind =
          NEXT remote_sys_kind_set IN message;
          remote_system_kind_set := remote_sys_kind_set^;

        ELSE
{         ERROR ----   Ignore parameter value.
          NEXT byte_array: [1 .. value_length] IN message;

        CASEND;
        NEXT parameter IN message;
      WHILEND;

    PROCEND crack_get_remote_sys_names_msg;
?? TITLE := 'send_remote_system_names_data', EJECT ??

    PROCEDURE send_remote_system_names_data
      (    response_code: nft$display_status_resp_codes;
           remote_system_name_specified: boolean;
           remote_system_name: ost$name;
           logical_line_number_specified: boolean;
           logical_line_number: nft$ntf_logical_line_number;
           remote_system_kind_set: set of nft$ntf_remote_system_kind;
           connection: ^nft$connection;
       VAR status: ost$status);

      VAR
        acc_remote_system: ^nft$alias,
        ascii_string: ^string ( * <= osc$max_name_size),
        message: ^nft$message_sequence,
        message_length: nft$message_length,
        message_type: ^nft$message_kind,
        name_length: 0 .. osc$max_name_size,
        parameter_kind: ^nft$ntf_get_rem_sys_names_data,
        parameter_kind_size: nft$message_length,
        param_length_size: nft$message_length,
        parameter_value_length: integer,
        remote_system_data: ^nft$ntf_remote_system_data,
        remote_system_kind: nft$ntf_remote_system_kind,
        remote_system_name_count: ^integer,
        remote_system_ptr: ^nft$pointer_list_entry,
        remote_system_ptr_found: boolean,
        response_param: ^nft$display_status_resp_codes,
        send_data: boolean;

*copy nft$ntf_get_rem_sys_names_data

      status.normal := TRUE;
      parameter_kind_size := #SIZE (nft$ntf_get_rem_sys_names_data);
      PUSH message: [[REP nfc$maximum_message_length + (nfc$ntf_remote_sys_seq_storage *
            scfs_tables.ntf_acc_remote_system_count) OF cell]];
      RESET message;

      NEXT message_type IN message;
      message_type^ := nfc$get_ntf_rem_sys_names_data;
      message_length := 1;

      NEXT parameter_kind IN message;
      parameter_kind^.param := nfc$response_code;
      parameter_kind^.length_indicated := FALSE;
      NEXT response_param IN message;
      response_param^ := response_code;
      message_length := message_length + parameter_kind_size + 1;

      IF response_code = nfc$disp_msg_accepted THEN
        NEXT parameter_kind IN message;
        parameter_kind^.param := nfc$ntf_remote_system_count;
        parameter_value_length := #SIZE (integer);
        parameter_kind^.length_indicated := TRUE;
        nfp$put_parameter_value_length (parameter_value_length, message, param_length_size, status);
        NEXT remote_system_name_count IN message;
        remote_system_name_count^ := 0;
        message_length := message_length + parameter_kind_size + param_length_size + parameter_value_length;

        acc_remote_system := scfs_tables.first_ntf_acc_remote_system;
        WHILE acc_remote_system <> NIL DO
          IF acc_remote_system^.station_list = NIL THEN
            remote_system_kind := nfc$ntf_not_configured;
            send_data := ((nfc$ntf_not_configured IN remote_system_kind_set) AND ((NOT
                  remote_system_name_specified) OR (remote_system_name = acc_remote_system^.name)));
          ELSE
            find_ntf_remote_system_pointer (acc_remote_system^.name, FALSE, 1, acc_remote_system,
                   remote_system_ptr, remote_system_ptr_found);
            IF remote_system_ptr_found THEN
              remote_system_kind := nfc$ntf_directly_connected;
            ELSE
              remote_system_kind := nfc$ntf_accessible;
            IFEND;

            send_data := (remote_system_kind IN remote_system_kind_set);
            IF send_data AND remote_system_name_specified THEN
              find_ntf_remote_system_pointer (remote_system_name, logical_line_number_specified,
                    logical_line_number, acc_remote_system, remote_system_ptr,
                    remote_system_ptr_found);
              send_data := (remote_system_ptr_found OR ((NOT logical_line_number_specified) AND
                    (remote_system_name = acc_remote_system^.name)));
            IFEND;
          IFEND;

          IF send_data THEN
            remote_system_name_count^ := remote_system_name_count^ +1;

            NEXT parameter_kind IN message;
            parameter_kind^.param := nfc$ntf_remote_system_data;
            name_length := clp$trimmed_string_size (acc_remote_system^.name);
            parameter_value_length := #SIZE (nft$ntf_remote_system_data: [0]) + name_length;
            parameter_kind^.length_indicated := TRUE;
            nfp$put_parameter_value_length (parameter_value_length, message, param_length_size, status);
            NEXT remote_system_data: [name_length] IN message;
            remote_system_data^.remote_system_type := acc_remote_system^.ntf_remote_system_type;
            remote_system_data^.kind := remote_system_kind;
            remote_system_data^.route_back_position := acc_remote_system^.ntf_route_back_position;
            remote_system_data^.authority_level := acc_remote_system^.ntf_authority_level;
            remote_system_data^.name := acc_remote_system^.name (1, name_length);
            message_length := message_length + parameter_kind_size + param_length_size +
                  parameter_value_length;
          IFEND;

          acc_remote_system := acc_remote_system^.link;
        WHILEND;
      IFEND;

      nfp$send_message_on_connection (message, message_length, connection^.id, status);
      IF scfs_event_logging THEN
        log_connection_message (connection^, message_length, message);
      IFEND;

    PROCEND send_remote_system_names_data;
?? OLDTITLE, EJECT ??

    status.normal := TRUE;
    crack_get_remote_sys_names_msg (message, msg_length, remote_system_name_specified, remote_system_name,
          logical_line_number_specified, logical_line_number, remote_system_kind_set, status);

    message_response := nfc$disp_msg_accepted;
    send_remote_system_names_data (message_response, remote_system_name_specified, remote_system_name,
          logical_line_number_specified, logical_line_number, remote_system_kind_set, connection,
           status);

  PROCEND get_ntf_remote_system_names_msg;
?? TITLE := 'get_ntf_remote_system_opts_msg', EJECT ??

{  PURPOSE:
{    This procedure is executed when a request is received from OPENTF for
{    remote system options information.  If the remote system is unknown, a
{    negative response is sent to OPENTF, otherwise the remote system
{    information is returned.

  PROCEDURE get_ntf_remote_system_opts_msg
    (VAR message: ^nft$message_sequence;
         connection: ^nft$connection;
     VAR msg_length: integer;
     VAR status: ost$status);

    VAR
      fake_remote_system: nft$io_station,
      remote_system: ^nft$io_station,
      remote_system_found: boolean,
      remote_system_name: ost$name,
      message_response: nft$display_status_resp_codes;

*copy nft$ntf_get_rem_sys_opts_msg
?? NEWTITLE := 'crack_get_remote_sys_opts_msg', EJECT ??

    PROCEDURE crack_get_remote_sys_opts_msg
      (VAR message: ^nft$message_sequence;
       VAR msg_length: integer;
       VAR remote_system_name: ost$name;
       VAR status: ost$status);

      VAR
        ascii_string: ^string ( * <= osc$max_name_size),
        byte_array: ^nft$byte_array,
        parameter: ^nft$ntf_get_rem_sys_opts_msg,
        value_length: integer;

      status.normal := TRUE;
      NEXT parameter IN message;

      WHILE (parameter <> NIL) AND (parameter^.param <> nfc$null_parameter) AND (msg_length > 0) DO
        msg_length := msg_length - 1;
        IF parameter^.length_indicated THEN
          nfp$get_parameter_value_length (message, msg_length, value_length, status);
          msg_length := msg_length - value_length;
        ELSE
          value_length := 1;
          msg_length := msg_length - 1;
        IFEND;

        CASE parameter^.param OF
        = nfc$ntf_remote_system_name =
          NEXT ascii_string: [value_length] IN message;
          #TRANSLATE (osv$lower_to_upper, ascii_string^, remote_system_name);

        ELSE
{         ERROR ----   Ignore parameter value.
          NEXT byte_array: [1 .. value_length] IN message;

        CASEND;
        NEXT parameter IN message;
      WHILEND;

    PROCEND crack_get_remote_sys_opts_msg;
?? TITLE := 'send_remote_system_options_data', EJECT ??

    PROCEDURE send_remote_system_options_data
      (VAR message: ^nft$message_sequence;
           response_code: nft$display_status_resp_codes;
           remote_system: ^nft$io_station;
           connection: ^nft$connection;
       VAR status: ost$status);

      VAR
        ascii_string: ^string ( * <= osc$max_name_size),
        authority_level: ^nft$ntf_authority_level,
        batch_stream: ^nft$batch_device,
        count: ^integer,
        inactivity_timer: ^nft$ntf_inactivity_timer,
        logical_line: ^nft$ntf_logical_line,
        logical_line_data: ^nft$ntf_logical_line_data,
        message_length: nft$message_length,
        message_type: ^nft$message_kind,
        name_length: 0 .. osc$max_name_size,
        parameter_kind: ^nft$ntf_get_rem_sys_opts_data,
        parameter_kind_size: nft$message_length,
        param_length_size: nft$message_length,
        parameter_value_length: integer,
        positive_acknowledge: ^nft$ntf_positive_acknowledge,
        protocol: ^nft$ntf_remote_system_protocol,
        remote_system_type: ^nft$ntf_remote_system_type,
        request_permission_retry: ^boolean,
        response_param: ^nft$display_status_resp_codes,
        route_back_position: ^nft$ntf_route_back_position,
        wait_a_bit: ^nft$ntf_wait_a_bit;

*copy nft$ntf_get_rem_sys_opts_data

      status.normal := TRUE;
      parameter_kind_size := #SIZE (nft$ntf_get_rem_sys_opts_data);
      RESET message;

      NEXT message_type IN message;
      message_type^ := nfc$get_ntf_rem_sys_opts_data;
      message_length := 1;

      NEXT parameter_kind IN message;
      parameter_kind^.param := nfc$ntf_remote_system_name;
      parameter_value_length := clp$trimmed_string_size (remote_system^.name);
      nfp$modify_param_value_length (parameter_value_length);
      parameter_kind^.length_indicated := parameter_value_length > 1;
      IF parameter_kind^.length_indicated THEN
        nfp$put_parameter_value_length (parameter_value_length, message, param_length_size, status);
      ELSE
        param_length_size := 0;
      IFEND;
      NEXT ascii_string: [parameter_value_length] IN message;
      ascii_string^ := remote_system^.name (1, parameter_value_length);
      message_length := message_length + parameter_kind_size + param_length_size + parameter_value_length;

      NEXT parameter_kind IN message;
      parameter_kind^.param := nfc$response_code;
      parameter_kind^.length_indicated := FALSE;
      NEXT response_param IN message;
      response_param^ := response_code;
      message_length := message_length + parameter_kind_size + 1;

      IF response_code = nfc$disp_msg_accepted THEN
        NEXT parameter_kind IN message;
        parameter_kind^.param := nfc$ntf_control_facility_name;
        parameter_value_length := clp$trimmed_string_size (control_facility_name);
        nfp$modify_param_value_length (parameter_value_length);
        parameter_kind^.length_indicated := parameter_value_length > 1;
        IF parameter_kind^.length_indicated THEN
          nfp$put_parameter_value_length (parameter_value_length, message, param_length_size, status);
        ELSE
          param_length_size := 0;
        IFEND;
        NEXT ascii_string: [parameter_value_length] IN message;
        ascii_string^ := control_facility_name (1, parameter_value_length);
        message_length := message_length + parameter_kind_size + param_length_size + parameter_value_length;

        NEXT parameter_kind IN message;
        parameter_kind^.param := nfc$ntf_protocol;
        parameter_kind^.length_indicated := FALSE;
        NEXT protocol IN message;
        protocol^ := remote_system^.ntf_protocol;
        message_length := message_length + parameter_kind_size + 1;

        NEXT parameter_kind IN message;
        parameter_kind^.param := nfc$ntf_authority_level;
        parameter_kind^.length_indicated := FALSE;
        NEXT authority_level IN message;
        authority_level^ := remote_system^.ntf_authority_level;
        message_length := message_length + parameter_kind_size + 1;

        NEXT parameter_kind IN message;
        parameter_kind^.param := nfc$ntf_wait_a_bit;
        parameter_kind^.length_indicated := FALSE;
        NEXT wait_a_bit IN message;
        wait_a_bit^ := remote_system^.ntf_wait_a_bit;
        message_length := message_length + parameter_kind_size + 1;

        NEXT parameter_kind IN message;
        parameter_kind^.param := nfc$ntf_inactivity_timer;
        parameter_value_length := #SIZE (nft$ntf_inactivity_timer);
        parameter_kind^.length_indicated := TRUE;
        nfp$put_parameter_value_length (parameter_value_length, message, param_length_size, status);
        NEXT inactivity_timer IN message;
        inactivity_timer^ := remote_system^.ntf_inactivity_timer;
        message_length := message_length + parameter_kind_size + param_length_size + parameter_value_length;

        NEXT parameter_kind IN message;
        parameter_kind^.param := nfc$ntf_positive_acknowledge;
        parameter_kind^.length_indicated := FALSE;
        NEXT positive_acknowledge IN message;
        positive_acknowledge^ := remote_system^.ntf_positive_acknowledge;
        message_length := message_length + parameter_kind_size + 1;

        IF remote_system^.ntf_default_job_destination <> osc$null_name THEN
          NEXT parameter_kind IN message;
          parameter_kind^.param := nfc$ntf_default_job_destination;
          parameter_value_length := clp$trimmed_string_size (remote_system^.ntf_default_job_destination);
          nfp$modify_param_value_length (parameter_value_length);
          parameter_kind^.length_indicated := parameter_value_length > 1;
          IF parameter_kind^.length_indicated THEN
            nfp$put_parameter_value_length (parameter_value_length, message, param_length_size, status);
          ELSE
            param_length_size := 0;
          IFEND;
          NEXT ascii_string: [parameter_value_length] IN message;
          ascii_string^ := remote_system^.ntf_default_job_destination (1, parameter_value_length);
          message_length := message_length + parameter_kind_size + param_length_size +
                parameter_value_length;
        IFEND;

        IF remote_system^.ntf_default_file_destination <> osc$null_name THEN
          NEXT parameter_kind IN message;
          parameter_kind^.param := nfc$ntf_default_file_destin;
          parameter_value_length := clp$trimmed_string_size (remote_system^.ntf_default_file_destination);
          nfp$modify_param_value_length (parameter_value_length);
          parameter_kind^.length_indicated := parameter_value_length > 1;
          IF parameter_kind^.length_indicated THEN
            nfp$put_parameter_value_length (parameter_value_length, message, param_length_size, status);
          ELSE
            param_length_size := 0;
          IFEND;
          NEXT ascii_string: [parameter_value_length] IN message;
          ascii_string^ := remote_system^.ntf_default_file_destination (1, parameter_value_length);
          message_length := message_length + parameter_kind_size + param_length_size +
                parameter_value_length;
        IFEND;

        IF remote_system^.ntf_store_forward_destination <> osc$null_name THEN
          NEXT parameter_kind IN message;
          parameter_kind^.param := nfc$ntf_store_forward_destin;
          parameter_value_length := clp$trimmed_string_size (remote_system^.ntf_store_forward_destination);
          nfp$modify_param_value_length (parameter_value_length);
          parameter_kind^.length_indicated := parameter_value_length > 1;
          IF parameter_kind^.length_indicated THEN
            nfp$put_parameter_value_length (parameter_value_length, message, param_length_size, status);
          ELSE
            param_length_size := 0;
          IFEND;
          NEXT ascii_string: [parameter_value_length] IN message;
          ascii_string^ := remote_system^.ntf_store_forward_destination (1, parameter_value_length);
          message_length := message_length + parameter_kind_size + param_length_size +
                parameter_value_length;
        IFEND;

        NEXT parameter_kind IN message;
        parameter_kind^.param := nfc$ntf_remote_system_type;
        parameter_kind^.length_indicated := FALSE;
        NEXT remote_system_type IN message;
        remote_system_type^ := remote_system^.ntf_remote_system_type;
        message_length := message_length + parameter_kind_size + 1;

        NEXT parameter_kind IN message;
        parameter_kind^.param := nfc$ntf_route_back_position;
        parameter_kind^.length_indicated := FALSE;
        NEXT route_back_position IN message;
        route_back_position^ := remote_system^.ntf_route_back_position;
        message_length := message_length + parameter_kind_size + 1;

        NEXT parameter_kind IN message;
        parameter_kind^.param := nfc$ntf_request_perm_retry;
        parameter_kind^.length_indicated := FALSE;
        NEXT request_permission_retry IN message;
        request_permission_retry^ := remote_system^.ntf_request_permission_retry;
        message_length := message_length + parameter_kind_size + 1;

        IF remote_system^.ntf_local_system_name <> osc$null_name THEN
          NEXT parameter_kind IN message;
          parameter_kind^.param := nfc$ntf_local_system_name;
          parameter_value_length := clp$trimmed_string_size (remote_system^.ntf_local_system_name);
          nfp$modify_param_value_length (parameter_value_length);
          parameter_kind^.length_indicated := parameter_value_length > 1;
          IF parameter_kind^.length_indicated THEN
            nfp$put_parameter_value_length (parameter_value_length, message, param_length_size, status);
          ELSE
            param_length_size := 0;
          IFEND;
          NEXT ascii_string: [parameter_value_length] IN message;
          ascii_string^ := remote_system^.ntf_local_system_name (1, parameter_value_length);
          message_length := message_length + parameter_kind_size + param_length_size +
                parameter_value_length;
        IFEND;

        NEXT parameter_kind IN message;
        parameter_kind^.param := nfc$ntf_logical_line_count;
        parameter_value_length := #SIZE (integer);
        parameter_kind^.length_indicated := TRUE;
        nfp$put_parameter_value_length (parameter_value_length, message, param_length_size, status);
        NEXT count IN message;
        count^ := 0;
        message_length := message_length + parameter_kind_size + param_length_size + parameter_value_length;

        logical_line := remote_system^.ntf_logical_line_list;
        WHILE logical_line <> NIL DO
          count^ := count^ +1;

          NEXT parameter_kind IN message;
          parameter_kind^.param := nfc$ntf_logical_line_data;
          name_length := clp$trimmed_string_size (logical_line^.line_name);
          parameter_value_length := #SIZE (nft$ntf_logical_line_data: [0]) + name_length;
          parameter_kind^.length_indicated := TRUE;
          nfp$put_parameter_value_length (parameter_value_length, message, param_length_size, status);
          NEXT logical_line_data: [name_length] IN message;
          logical_line_data^.number := logical_line^.logical_line_number;
          logical_line_data^.terminal_user_procedure := logical_line^.terminal_user_procedure;
          logical_line_data^.name := logical_line^.line_name (1, name_length);
          message_length := message_length + parameter_kind_size + param_length_size +
                parameter_value_length;

          logical_line := logical_line^.link;
        WHILEND;

        NEXT parameter_kind IN message;
        parameter_kind^.param := nfc$ntf_batch_stream_count;
        parameter_value_length := #SIZE (integer);
        parameter_kind^.length_indicated := TRUE;
        nfp$put_parameter_value_length (parameter_value_length, message, param_length_size, status);
        NEXT count IN message;
        count^ := 0;
        message_length := message_length + parameter_kind_size + param_length_size + parameter_value_length;

        batch_stream := remote_system^.batch_device_list;
        WHILE batch_stream <> NIL DO
          count^ := count^ +1;

          NEXT parameter_kind IN message;
          parameter_kind^.param := nfc$ntf_batch_stream_names;
          parameter_value_length := clp$trimmed_string_size (batch_stream^.name);
          nfp$modify_param_value_length (parameter_value_length);
          parameter_kind^.length_indicated := parameter_value_length > 1;
          IF parameter_kind^.length_indicated THEN
            nfp$put_parameter_value_length (parameter_value_length, message, param_length_size, status);
          ELSE
            param_length_size := 0;
          IFEND;
          NEXT ascii_string: [parameter_value_length] IN message;
          ascii_string^ := batch_stream^.name (1, parameter_value_length);
          message_length := message_length + parameter_kind_size + param_length_size +
                parameter_value_length;

          batch_stream := batch_stream^.link;
        WHILEND;
      IFEND;

      nfp$send_message_on_connection (message, message_length, connection^.id, status);
      IF scfs_event_logging THEN
        log_connection_message (connection^, message_length, message);
      IFEND;

    PROCEND send_remote_system_options_data;
?? OLDTITLE, EJECT ??

    status.normal := TRUE;
    crack_get_remote_sys_opts_msg (message, msg_length, remote_system_name, status);
    message_response := nfc$disp_msg_accepted;
    find_ntf_remote_system (remote_system_name, remote_system, remote_system_found);
    IF NOT remote_system_found THEN
      message_response := nfc$disp_no_io_station;

{     Initialize a remote system entry so that a remote system name can be passed in the response.

      fake_remote_system.name := remote_system_name;
      remote_system := ^fake_remote_system;
    IFEND;

    send_remote_system_options_data (message, message_response, remote_system, connection,
          status);

  PROCEND get_ntf_remote_system_opts_msg;
?? TITLE := 'get_ntf_remote_system_stat_msg', EJECT ??

{  PURPOSE:
{    This procedure is executed when a request is received from OPENTF for
{    remote system status information.  If the remote system is unknown, a
{    negative response is sent to OPENTF, otherwise the remote system
{    information is returned.

  PROCEDURE get_ntf_remote_system_stat_msg
    (VAR message: ^nft$message_sequence;
         connection: ^nft$connection;
     VAR msg_length: integer;
     VAR status: ost$status);

    VAR
      fake_remote_system: nft$io_station,
      logical_line_number: nft$ntf_logical_line_number,
      logical_line_number_specified: boolean,
      remote_system: ^nft$io_station,
      remote_system_found: boolean,
      remote_system_name: ost$name,
      message_response: nft$display_status_resp_codes,
      signon_status: nft$device_status,
      signon_status_specified: boolean;

*copy nft$ntf_get_rem_sys_stat_msg
?? NEWTITLE := 'crack_get_remote_sys_status_msg', EJECT ??

    PROCEDURE crack_get_remote_sys_status_msg
      (VAR message: ^nft$message_sequence;
       VAR msg_length: integer;
       VAR remote_system_name: ost$name;
       VAR logical_line_number_specified: boolean;
       VAR logical_line_number: nft$ntf_logical_line_number;
       VAR signon_status_specified: boolean;
       VAR signon_status: nft$device_status;
       VAR status: ost$status);

      VAR
        ascii_string: ^string ( * <= osc$max_name_size),
        byte_array: ^nft$byte_array,
        line_number: ^nft$ntf_logical_line_number,
        parameter: ^nft$ntf_get_rem_sys_stat_msg,
        signon_stat: ^nft$device_status,
        value_length: integer;

      status.normal := TRUE;
      NEXT parameter IN message;
      logical_line_number_specified := FALSE;
      signon_status_specified := FALSE;

      WHILE (parameter <> NIL) AND (parameter^.param <> nfc$null_parameter) AND (msg_length > 0) DO
        msg_length := msg_length - 1;
        IF parameter^.length_indicated THEN
          nfp$get_parameter_value_length (message, msg_length, value_length, status);
          msg_length := msg_length - value_length;
        ELSE
          value_length := 1;
          msg_length := msg_length - 1;
        IFEND;

        CASE parameter^.param OF
        = nfc$ntf_remote_system_name =
          NEXT ascii_string: [value_length] IN message;
          #TRANSLATE (osv$lower_to_upper, ascii_string^, remote_system_name);

        = nfc$ntf_logical_line_number =
          NEXT line_number IN message;
          logical_line_number := line_number^;
          logical_line_number_specified := TRUE;

        = nfc$ntf_signon_status =
          NEXT signon_stat IN message;
          signon_status := signon_stat^;
          signon_status_specified := TRUE;

        ELSE
{         ERROR ----   Ignore parameter value.
          NEXT byte_array: [1 .. value_length] IN message;

        CASEND;
        NEXT parameter IN message;
      WHILEND;

    PROCEND crack_get_remote_sys_status_msg;
?? TITLE := 'send_remote_system_status_data', EJECT ??

    PROCEDURE send_remote_system_status_data
      (VAR message: ^nft$message_sequence;
           response_code: nft$display_status_resp_codes;
           remote_system: ^nft$io_station;
           logical_line_number_specified: boolean;
           logical_line_number: nft$ntf_logical_line_number;
           signon_status_specified: boolean;
           signon_status: nft$device_status;
           connection: ^nft$connection;
       VAR status: ost$status);

      VAR
        ascii_string: ^string ( * <= osc$max_name_size),
        count: ^integer,
        logical_line: ^nft$ntf_logical_line,
        logical_line_found: boolean,
        message_length: nft$message_length,
        message_type: ^nft$message_kind,
        name_length: 0 .. osc$max_name_size,
        parameter_kind: ^nft$ntf_get_rem_sys_stat_data,
        parameter_kind_size: nft$message_length,
        param_length_size: nft$message_length,
        parameter_value_length: integer,
        remote_system_status: ^nft$ntf_remote_system_status,
        response_param: ^nft$display_status_resp_codes;

*copy nft$ntf_get_rem_sys_stat_data

      status.normal := TRUE;
      parameter_kind_size := #SIZE (nft$ntf_get_rem_sys_stat_data);
      RESET message;

      NEXT message_type IN message;
      message_type^ := nfc$get_ntf_rem_sys_stat_data;
      message_length := 1;

      NEXT parameter_kind IN message;
      parameter_kind^.param := nfc$ntf_remote_system_name;
      parameter_value_length := clp$trimmed_string_size (remote_system^.name);
      nfp$modify_param_value_length (parameter_value_length);
      parameter_kind^.length_indicated := parameter_value_length > 1;
      IF parameter_kind^.length_indicated THEN
        nfp$put_parameter_value_length (parameter_value_length, message, param_length_size, status);
      ELSE
        param_length_size := 0;
      IFEND;
      NEXT ascii_string: [parameter_value_length] IN message;
      ascii_string^ := remote_system^.name (1, parameter_value_length);
      message_length := message_length + parameter_kind_size + param_length_size + parameter_value_length;

      NEXT parameter_kind IN message;
      parameter_kind^.param := nfc$response_code;
      parameter_kind^.length_indicated := FALSE;
      NEXT response_param IN message;
      response_param^ := response_code;
      message_length := message_length + parameter_kind_size + 1;

      IF response_code = nfc$disp_msg_accepted THEN
        NEXT parameter_kind IN message;
        parameter_kind^.param := nfc$ntf_logical_line_count;
        parameter_value_length := #SIZE (integer);
        parameter_kind^.length_indicated := TRUE;
        nfp$put_parameter_value_length (parameter_value_length, message, param_length_size, status);
        NEXT count IN message;
        count^ := 0;
        message_length := message_length + parameter_kind_size + param_length_size + parameter_value_length;

        logical_line := remote_system^.ntf_logical_line_list;
        logical_line_found := FALSE;
        WHILE (NOT logical_line_found) AND (logical_line <> NIL) DO
          IF NOT logical_line_number_specified OR (logical_line^.logical_line_number = logical_line_number)
                THEN
            IF NOT signon_status_specified OR (logical_line^.signon_status = signon_status) THEN
              count^ := count^ +1;
              logical_line_found := logical_line_number_specified;

              NEXT parameter_kind IN message;
              parameter_kind^.param := nfc$ntf_remote_system_status;
              name_length := clp$trimmed_string_size (logical_line^.line_name);
              parameter_value_length := #SIZE (nft$ntf_remote_system_status: [0]) + name_length;
              parameter_kind^.length_indicated := TRUE;
              nfp$put_parameter_value_length (parameter_value_length, message, param_length_size, status);
              NEXT remote_system_status: [name_length] IN message;
              remote_system_status^.logical_line_number := logical_line^.logical_line_number;
              remote_system_status^.line_speed := logical_line^.line_speed;
              remote_system_status^.signon_status := logical_line^.signon_status;
              remote_system_status^.name := logical_line^.line_name (1, name_length);
              message_length := message_length + parameter_kind_size + param_length_size +
                    parameter_value_length;
            IFEND;
          IFEND;

          logical_line := logical_line^.link;
        WHILEND;
      IFEND;

      nfp$send_message_on_connection (message, message_length, connection^.id, status);
      IF scfs_event_logging THEN
        log_connection_message (connection^, message_length, message);
      IFEND;

    PROCEND send_remote_system_status_data;
?? OLDTITLE, EJECT ??

    status.normal := TRUE;
    crack_get_remote_sys_status_msg (message, msg_length, remote_system_name, logical_line_number_specified,
          logical_line_number, signon_status_specified, signon_status, status);
    message_response := nfc$disp_msg_accepted;
    find_ntf_remote_system (remote_system_name, remote_system, remote_system_found);
    IF NOT remote_system_found THEN
      message_response := nfc$disp_no_io_station;

{     Initialize a remote system entry so that a remote system name can be passed in the response.

      fake_remote_system.name := remote_system_name;
      remote_system := ^fake_remote_system;
    IFEND;

    send_remote_system_status_data (message, message_response, remote_system, logical_line_number_specified,
          logical_line_number, signon_status_specified, signon_status, connection, status);

  PROCEND get_ntf_remote_system_stat_msg;
?? TITLE := 'get queue entry msg', EJECT ??

{  PURPOSE:
{    This procedure is executed when a request is received from OPES for
{    detailed information about a specific queue file entry.  If a user
{    file name is specified and there is more than one entry with that name,
{    the information for each of the entries is sent up to OPES.
{
{    This procedure is also executed when a request is received from OPENTF for
{    detailed information about a specific NTF queue file entry.  If a user
{    file name is specified and there is more than one entry with that name,
{    the information for each of the entries is sent up to OPENTF.

  PROCEDURE get_queue_entry_msg
    (VAR message: ^nft$message_sequence;
         connection: ^nft$connection;
     VAR status: ost$status);

    VAR
      ascii_string: ^string ( * <= osc$max_name_size),
      current_ptr: ^nft$queue_file_list,
      fake_file: nft$output_queue_file,
      fake_station: nft$io_station,
      file_name: ost$name,
      ignore_status: ost$status,
      io_station: ^nft$io_station,
      io_station_found: boolean,
      io_station_name: ost$name,
      msg_length: integer,
      parameter: ^nft$get_queue_entry_parameter,
      q_file: ^nft$output_queue_file,
      q_file_list: ^nft$queue_file_list,
      q_file_ptr: ^nft$queue_file_list,
      response: nft$display_status_resp_codes,
      value_length: integer;

*copy nft$get_queue_entry_msg

?? NEWTITLE := 'build queue file list', EJECT ??

{  PURPOSE:
{    Build a queue file list containing each queue entry matching the specified
{    file name.  The file name will be compared with the queue file's
{    system file name and user file name.

    PROCEDURE build_queue_file_list
      (    file_name: ost$name;
           io_station: ^nft$io_station;
       VAR fake_file: nft$output_queue_file;
       VAR q_file_list: ^nft$queue_file_list;
       VAR response: nft$display_status_resp_codes);

      VAR
        alias_pt: ^nft$alias,
        current_pointer: ^nft$queue_file_list,
        file_found: boolean,
        file_match: boolean,
        i: 0..3,
        q_file: ^nft$output_queue_file,
        q_file_ptr: ^nft$queue_file_list,
        selected_file: ^nft$selected_file;
?? NEWTITLE := 'add_q_file_ptr_to_list', EJECT ??

      PROCEDURE add_q_file_ptr_to_list
        (    q_file: ^nft$output_queue_file;
         VAR q_file_list: ^nft$queue_file_list;
         VAR current_ptr: ^nft$queue_file_list);

        VAR
          q_file_ptr: ^nft$queue_file_list;

        ALLOCATE q_file_ptr;
        q_file_ptr^.queue_file := q_file;
        q_file_ptr^.link := NIL;
        IF q_file_list = NIL THEN
          q_file_list := q_file_ptr;
        ELSE
          current_ptr^.link := q_file_ptr;
        IFEND;
        current_ptr := q_file_ptr;

      PROCEND add_q_file_ptr_to_list;
?? OLDTITLE, EJECT ??
      file_found := FALSE;
      file_match := FALSE;
      current_pointer := NIL;
      q_file := NIL;
      q_file_ptr := NIL;

      IF io_station^.usage <> nfc$ntf_remote_system THEN
        selected_file := io_station^.selected_files_queue;
        WHILE selected_file <> NIL DO
          q_file := selected_file^.output_file;
          file_match := (file_name = q_file^.system_file_name) OR (file_name = q_file^.user_file_name);
          IF file_match THEN
            file_found := TRUE;
            add_q_file_ptr_to_list (q_file, q_file_list, current_pointer);
          IFEND;
          selected_file := selected_file^.link;
        WHILEND;
      IFEND;

    /find_file/
      FOR i := LOWERBOUND (io_station^.alias_list) TO UPPERBOUND (io_station^.alias_list)  DO
        alias_pt := io_station^.alias_list [i];
        IF (alias_pt <> NIL) AND (alias_pt^.queue <> NIL) THEN

          q_file := alias_pt^.queue;
          WHILE (q_file <> NIL) DO

            file_match := (file_name = q_file^.system_file_name) OR (file_name = q_file^.user_file_name);
            IF file_match THEN
              file_found := TRUE;
              add_q_file_ptr_to_list (q_file, q_file_list, current_pointer);
            IFEND;
            q_file := q_file^.link;
          WHILEND;
        IFEND;
      FOREND /find_file/;

      IF NOT file_found THEN
        fake_file.system_file_name := file_name;
        q_file := ^fake_file;
        response := nfc$disp_unknown_file_name;

        ALLOCATE q_file_ptr;
        q_file_ptr^.queue_file := q_file;
        q_file_ptr^.link := NIL;
        q_file_list := q_file_ptr;
      IFEND;

    PROCEND build_queue_file_list;
?? OLDTITLE, EJECT ??
    response := nfc$disp_msg_accepted;
    msg_length := 0;
    current_ptr := NIL;
    q_file_list := NIL;
    q_file_ptr := NIL;

{   Since Get Queue Entry has only 2 parameters, this is all that is needed.

    NEXT parameter IN message;
    IF parameter^.length_indicated THEN
      nfp$get_parameter_value_length (message, msg_length, value_length, status);
    ELSE
      value_length := 1;
    IFEND;
    NEXT ascii_string: [value_length] IN message;
    #translate (osv$lower_to_upper, ascii_string^, io_station_name);

    NEXT parameter IN message;
    IF parameter^.length_indicated THEN
      nfp$get_parameter_value_length (message, msg_length, value_length, status);
    ELSE
      value_length := 1;
    IFEND;
    NEXT ascii_string: [value_length] IN message;
    #translate (osv$lower_to_upper, ascii_string^, file_name);

    q_file := NIL;
    IF connection^.kind = nfc$ntf_operator_connection THEN
      create_fake_io_station_for_ntf (io_station_name, fake_station, io_station_found);
      io_station := ^fake_station;
    ELSE
      find_io_station (io_station_name, io_station, io_station_found);
    IFEND;

    IF io_station_found THEN
     build_queue_file_list (file_name, io_station, fake_file,
           q_file_list, response);
    ELSE
      fake_station.name := io_station_name;
      io_station := ^fake_station;
      fake_file.system_file_name := file_name;
      q_file := ^fake_file;
      response := nfc$disp_no_io_station;

      ALLOCATE q_file_ptr;
      q_file_ptr^.queue_file := q_file;
      q_file_ptr^.link := NIL;
      q_file_list := q_file_ptr;
    IFEND;

    send_queue_entry_msg (message, response, io_station, q_file_list, connection,
          {optimized} FALSE, ignore_status);

{  Delete the queue file list. }

    WHILE (q_file_list <> NIL) DO
      current_ptr := q_file_list;
      q_file_list := current_ptr^.link;
      FREE current_ptr;
    WHILEND;

  PROCEND get_queue_entry_msg;
?? TITLE := 'get queue entry list msg', EJECT ??

{  PURPOSE:
{    This procedure is executed when a request is received from OPES for
{    information about files in an output queue.  If the request requires an
{    optimized response then full information about the files is returned,
{    otherwise only a list of all system file names and current priorities
{    is returned.
{
{    This procedure is also executed when a request is received from OPENTF for
{    a list of all system file names and current priorities for files in an NTF
{    queue.

  PROCEDURE get_queue_entry_list_msg
    (VAR message: ^nft$message_sequence;
         connection: ^nft$connection;
     VAR msg_length: integer;
     VAR status: ost$status);

    VAR
      all_or_top_10: nft$all_or_top_10_q_entries,
      ascii_string: ^string ( * <= osc$max_name_size),
      byte_array: ^nft$byte_array,
      entries: ^nft$all_or_top_10_q_entries,
      fake_station: nft$io_station,
      io_station: ^nft$io_station,
      io_station_found: boolean,
      io_station_name: ost$name,
      optimize_queue_list: boolean,
      optimize_queue_list_param: ^nft$optimize_list,
      parameter: ^nft$get_q_entry_list_msg_param,
      response: nft$display_status_resp_codes,
      value_length: integer;

*copyc nft$get_q_entry_list_msg

    optimize_queue_list := FALSE;
    response := nfc$disp_msg_accepted;

    NEXT parameter IN message;

    WHILE (parameter <> NIL) AND (parameter^.param <> nfc$null_parameter) AND (msg_length > 0) DO
      msg_length := msg_length - 1;
      IF parameter^.length_indicated THEN
        nfp$get_parameter_value_length (message, msg_length, value_length, status);
        msg_length := msg_length - value_length;
      ELSE
        value_length := 1;
        msg_length := msg_length - 1;
      IFEND;

      CASE parameter^.param OF
      = nfc$io_station_name =
        NEXT ascii_string: [value_length] IN message;
        #translate (osv$lower_to_upper, ascii_string^, io_station_name);

      = nfc$all_or_top_ten =
        NEXT entries IN message;
        all_or_top_10 := entries^;

      = nfc$optimize_queue_list =
        NEXT optimize_queue_list_param IN message;
        optimize_queue_list := (optimize_queue_list_param^ = nfc$do_optimize);

      ELSE

{ ERROR ----   Ignore parameter value.

        NEXT byte_array: [1 .. value_length] IN message;
      CASEND;

      NEXT parameter IN message;
    WHILEND;

    IF connection^.kind = nfc$ntf_operator_connection THEN
      create_fake_io_station_for_ntf (io_station_name, fake_station, io_station_found);
      io_station := ^fake_station;
    ELSE
      find_io_station (io_station_name, io_station, io_station_found);
    IFEND;

    IF NOT io_station_found THEN
      fake_station.name := io_station_name;
      io_station := ^fake_station;
      response := nfc$disp_no_io_station;
    IFEND;

    IF optimize_queue_list THEN
     send_queue_entry_msg_optimized (connection, io_station, all_or_top_10, message, status);
    ELSE
      send_queue_entry_list_msg (response, io_station, all_or_top_10, connection, status);
    IFEND;

  PROCEND get_queue_entry_list_msg;
?? TITLE := 'get queue status msg', EJECT ??

{  PURPOSE:
{    This procedure is executed when a request is received from OPES for
{    information about the output queue for an I/O station.
{
{    This procedure is also executed when a request is received from OPENTF for
{    information about the NTF queue for a remote system.

  PROCEDURE get_queue_status_msg
    (VAR message: ^nft$message_sequence;
         connection: ^nft$connection;
     VAR status: ost$status);

    VAR
      ascii_string: ^string ( * <= osc$max_name_size),
      fake_station: nft$io_station,
      file_count: integer,
      io_station: ^nft$io_station,
      io_station_found: boolean,
      io_station_name: ost$name,
      msg_length: integer,
      parameter: ^nft$get_station_status_param,
      response: nft$display_status_resp_codes,
      value_length: integer;

{    NOTE:  The parameters for the Get Queue Status message are identical to
{    the parameters for the Get Station Status message.  That is why the types
{    defined in nft$get_station_status_msg are used for this message.

*copy nft$get_station_status_msg

    msg_length := 0;
    response := nfc$disp_msg_accepted;

{   Since Get Queue Status has only 1 parameter, this is all that is needed.
    NEXT parameter IN message;
    IF parameter^.length_indicated THEN
      nfp$get_parameter_value_length (message, msg_length, value_length, status);
    ELSE
      value_length := 1;
    IFEND;
    NEXT ascii_string: [value_length] IN message;
    #translate (osv$lower_to_upper, ascii_string^, io_station_name);

    IF connection^.kind = nfc$ntf_operator_connection THEN
      create_fake_io_station_for_ntf (io_station_name, fake_station, io_station_found);
      io_station := ^fake_station;
    ELSE
      find_io_station (io_station_name, io_station, io_station_found);
    IFEND;

    IF NOT io_station_found THEN
      fake_station.name := io_station_name;
      io_station := ^fake_station;
      response := nfc$disp_no_io_station;
    IFEND;

    send_queue_status_msg (message, response, io_station, connection, status);

  PROCEND get_queue_status_msg;
?? TITLE := 'get required file avail params', EJECT ??

  PROCEDURE get_required_file_avail_params
    (VAR message: ^nft$message_sequence;
     VAR msg_length: integer;
     VAR q_file: nft$output_queue_file;
     VAR status: ost$status);

    VAR
      ascii_string: ^string ( * <= osc$max_name_size),
      byte_array: ^nft$byte_array,
      io_station_usage: ^nft$io_station_usage,
      parameter: ^nft$file_available_msg_param,
      value_length: integer;

*copy nft$file_availability_msg

    NEXT parameter IN message;

    WHILE (parameter <> NIL) AND (parameter^.param <= nfc$user_family) AND (parameter^.param <>
          nfc$null_parameter) AND (msg_length > 0) DO
      msg_length := msg_length - 1;
      IF parameter^.length_indicated THEN
        nfp$get_parameter_value_length (message, msg_length, value_length, status);
        msg_length := msg_length - value_length;
      ELSE
        value_length := 1;
        msg_length := msg_length - 1;
      IFEND;

      CASE parameter^.param OF
      = nfc$io_station_name =
        NEXT ascii_string: [value_length] IN message;
        #translate (osv$lower_to_upper, ascii_string^, q_file.ios_name);

      = nfc$operator_name =
        NEXT ascii_string: [value_length] IN message;
        #translate (osv$lower_to_upper, ascii_string^, q_file.operator_name);

      = nfc$operator_family =
        NEXT ascii_string: [value_length] IN message;
        #translate (osv$lower_to_upper, ascii_string^, q_file.operator_family);

      = nfc$station_usage =
        NEXT io_station_usage IN message;
        q_file.ios_usage := io_station_usage^;

      = nfc$system_file_name =
        NEXT ascii_string: [value_length] IN message;
        #translate (osv$lower_to_upper, ascii_string^, q_file.system_file_name);

      = nfc$system_job_name =
        NEXT ascii_string: [value_length] IN message;
        #translate (osv$lower_to_upper, ascii_string^, q_file.system_job_name);

      = nfc$user_file_name =
        NEXT ascii_string: [value_length] IN message;
        #translate (osv$lower_to_upper, ascii_string^, q_file.user_file_name);

      = nfc$user_job_name =
        NEXT ascii_string: [value_length] IN message;
        #translate (osv$lower_to_upper, ascii_string^, q_file.user_job_name);

      = nfc$user_name =
        NEXT ascii_string: [value_length] IN message;
        #translate (osv$lower_to_upper, ascii_string^, q_file.user_name);

      = nfc$user_family =
        NEXT ascii_string: [value_length] IN message;
        #translate (osv$lower_to_upper, ascii_string^, q_file.family_name);

      ELSE
{       ERROR ----   Ignore parameter value.
        NEXT byte_array: [1 .. value_length] IN message;

      CASEND;
      NEXT parameter IN message;
    WHILEND;

    RESET message TO parameter;

  PROCEND get_required_file_avail_params;
?? TITLE := 'get station status msg', EJECT ??

{  PURPOSE:
{    This procedure is executed when a request is received from OPES for
{    I/O station status information.  If the station is unknown, a negative
{    response is sent to OPES, otherwise the station information is returned.

  PROCEDURE get_station_status_msg
    (VAR message: ^nft$message_sequence;
     VAR msg_length: integer;
         connection: ^nft$connection;
     VAR status: ost$status);

    VAR
      ascii_string: ^string ( * <= osc$max_name_size),
      byte_array: ^nft$byte_array,
      fake_station: nft$io_station,
      io_station: ^nft$io_station,
      io_station_found: boolean,
      io_station_name: ost$name,
      message_area: ^nft$message_sequence,
      optimize_device_list: boolean,
      optimize_device_list_param: ^nft$optimize_list,
      parameter: ^nft$get_station_status_param,
      response: nft$display_status_resp_codes,
      value_length: integer;

*copy nft$get_station_status_msg

    optimize_device_list := FALSE;
    response := nfc$disp_msg_accepted;

    NEXT parameter in message;

    WHILE (parameter <> NIL) AND (parameter^.param <> nfc$null_parameter) AND (msg_length > 0) DO
      msg_length := msg_length - 1;
      IF parameter^.length_indicated THEN
        nfp$get_parameter_value_length (message, msg_length, value_length, status);
        msg_length := msg_length - value_length;
      ELSE
        value_length := 1;
        msg_length := msg_length - 1;
      IFEND;

      CASE parameter^.param OF
      = nfc$io_station_name =
        NEXT ascii_string: [value_length] IN message;
        #translate (osv$lower_to_upper, ascii_string^, io_station_name);

      = nfc$optimize_device_list =
        NEXT optimize_device_list_param IN message;
        optimize_device_list := (optimize_device_list_param^ = nfc$do_optimize);

      ELSE

{ ERROR ----   Ignore parameter value.

        NEXT byte_array: [1 .. value_length] IN message;
      CASEND;

      NEXT parameter IN message;
    WHILEND;

    find_io_station (io_station_name, io_station, io_station_found);
    IF NOT io_station_found THEN
      fake_station.name := io_station_name;
      io_station := ^fake_station;
      response := nfc$disp_no_io_station;
    IFEND;

    IF optimize_device_list THEN
      PUSH message_area: [[REP nfc$maximum_send_message_length OF cell]];
      send_device_status_msg (message_area, response, io_station, NIL, connection, optimize_device_list,
            status);
    ELSE
      send_station_status_msg (message, response, io_station, connection, status);
    IFEND;

  PROCEND get_station_status_msg;
?? TITLE := 'initialize_io_station', EJECT ??

  PROCEDURE initialize_io_station
    (VAR io_station_entry: nft$io_station);

    io_station_entry.name := osc$null_name;
    io_station_entry.alias_names [1] := osc$null_name;
    io_station_entry.alias_names [2] := osc$null_name;
    io_station_entry.alias_names [3] := osc$null_name;

    io_station_entry.required_operator_device := osc$null_name;
    io_station_entry.usage := nfc$public_io_station;
    io_station_entry.file_acknowledgement := FALSE;
    io_station_entry.check_ios_unique := FALSE;

    io_station_entry.automatic_operator_control := FALSE;
    io_station_entry.operator_assigned := FALSE;
    io_station_entry.connected_operator := NIL;
    io_station_entry.station_operational := FALSE;

    io_station_entry.default_job_destination := osc$null_name;
    io_station_entry.destination_unavailable_action := nfc$stop_input_device;
    io_station_entry.pm_message_action := nfc$print_pm_message;

    io_station_entry.scfdi_connection_pointers := NIL;
    io_station_entry.batch_device_list := NIL;
    io_station_entry.selected_files_queue := NIL;
    io_station_entry.last_selected_file_in_q := NIL;

    io_station_entry.alias_list [0] := NIL;
    io_station_entry.alias_list [1] := NIL;
    io_station_entry.alias_list [2] := NIL;
    io_station_entry.alias_list [3] := NIL;

  PROCEND initialize_io_station;
?? TITLE := 'initialize_ntf_logical_line', EJECT ??

{  PURPOSE:
{    This procedure initializes all fields of a logical line entry.

  PROCEDURE initialize_ntf_logical_line
    (VAR logical_line_entry: nft$ntf_logical_line);

    logical_line_entry.logical_line_number := 1;
    logical_line_entry.line_name := osc$null_name;
    logical_line_entry.line_speed := 9600;
    logical_line_entry.signon_status := nfc$ntf_waiting_signon;
    logical_line_entry.console_stream_name := osc$null_name;
    logical_line_entry.terminal_user_procedure := osc$null_name;
    logical_line_entry.scfdi_connection := NIL;
    logical_line_entry.back_link := NIL;
    logical_line_entry.link := NIL;

  PROCEND initialize_ntf_logical_line;
?? TITLE := 'initialize_ntf_remote_system', EJECT ??

{  PURPOSE:
{    This procedure initializes all fields of a remote system entry.

  PROCEDURE initialize_ntf_remote_system
    (VAR remote_system_entry: nft$io_station);

    remote_system_entry.name := osc$null_name;
    remote_system_entry.required_operator_device := osc$null_name;
    remote_system_entry.usage := nfc$ntf_remote_system;
    remote_system_entry.file_acknowledgement := TRUE;
    remote_system_entry.automatic_operator_control := FALSE;
    remote_system_entry.operator_assigned := FALSE;
    remote_system_entry.connected_operator := NIL;
    remote_system_entry.station_operational := TRUE;
    remote_system_entry.batch_device_list := NIL;
    remote_system_entry.back_link := NIL;
    remote_system_entry.link := NIL;
    remote_system_entry.ntf_protocol := nfc$ntf_nje;
    remote_system_entry.ntf_local_system_name := osc$null_name;
    remote_system_entry.ntf_authority_level := nfc$ntf_none;
    remote_system_entry.ntf_wait_a_bit := nfc$ntf_acknowledge;
    remote_system_entry.ntf_inactivity_timer := 0;
    remote_system_entry.ntf_positive_acknowledge := nfc$ntf_ack;
    remote_system_entry.ntf_remote_password := osc$null_name;
    remote_system_entry.ntf_local_password := osc$null_name;
    remote_system_entry.ntf_default_job_destination := osc$null_name;
    remote_system_entry.ntf_default_file_destination := osc$null_name;
    remote_system_entry.ntf_store_forward_destination := osc$null_name;
    remote_system_entry.ntf_remote_system_type := nfc$ntf_nos_ve;
    remote_system_entry.ntf_route_back_position := 0;
    remote_system_entry.ntf_request_permission_retry := FALSE;
    remote_system_entry.ntf_logical_line_list := NIL;
    remote_system_entry.ntf_acc_remote_system_ptr_list := NIL;

  PROCEND initialize_ntf_remote_system;
?? TITLE := 'initialize scfs', EJECT ??

{  PURPOSE:
{    This procedure does the following:
{      1.  obtains the parameters specified when SCFS was initiated
{      2.  attaches the server job
{      3.  initializes SCFS's tables
{      4.  sets up logging (if specified on parameters)
{      5.  allocates space for the wait lists

  PROCEDURE initialize_scfs
    (    parameter_list: clt$parameter_list;
     VAR event_logging: boolean;
     VAR wait_list: ^ost$i_wait_list;
     VAR message_area: ^nft$message_sequence;
     VAR status: ost$status);

    TYPE
      connection_pt = ^nft$connection;

    VAR
      ntf_remote_system_count: nft$ntf_remote_system_count,
      ntf_remote_system_list_file: amt$local_file_name;

?? NEWTITLE := 'get control facility parameters', EJECT ??

    PROCEDURE get_control_facility_parameters
      (    parameter_list: clt$parameter_list;
           scfs_command_pdt: clt$parameter_descriptor_table;
       VAR control_name: ost$name;
       VAR server_name: ost$name;
       VAR event_logging: boolean;
       VAR ntf_remote_system_list_file: amt$local_file_name;
       VAR status: ost$status);

      VAR
        list_file_specified: boolean,
        logging_specified: boolean,
        value: clt$value;

      list_file_specified := FALSE;
      ntf_remote_system_list_file := osc$null_name;
      logging_specified := FALSE;
      clp$scan_parameter_list (parameter_list, scfs_command_pdt, status);
      IF status.normal THEN
        clp$get_value ('CONTROL_FACILITY', 1, 1, clc$low, value, status);
        IF status.normal THEN
          control_name := value.name.value;

          clp$get_value ('SERVER', 1, 1, clc$low, value, status);
          IF status.normal THEN
            server_name := value.name.value;

{  If the logging is specified, message coming into SCFS and
{  sent by SCFS will be written to a file.

            clp$test_parameter ('LOGGING', logging_specified, status);
            IF logging_specified THEN
              clp$get_value ('LOGGING', 1, 1, clc$low, value, status);
              IF status.normal THEN
                event_logging := value.bool.value;
              IFEND;
            IFEND;

            IF status.normal THEN
              clp$test_parameter ('NTF_SYSTEM_LIST', list_file_specified, status);
              IF status.normal AND list_file_specified THEN
                clp$get_value ('NTF_SYSTEM_LIST', 1, 1, clc$low, value, status);
                IF status.normal THEN
                  ntf_remote_system_list_file := value.file.local_file_name;
                IFEND;
              IFEND;
            IFEND;
          IFEND;
        IFEND;
      IFEND;

    PROCEND get_control_facility_parameters;
?? TITLE := 'initialize_ntf_acc_rem_sys_list', EJECT ??

    PROCEDURE initialize_ntf_acc_rem_sys_list
      (    ntf_remote_system_list_file: amt$local_file_name;
       VAR remote_system_count: nft$ntf_remote_system_count;
       VAR status: ost$status);

      VAR
        acc_remote_system: ^nft$alias,
        acc_remote_system_list: ^array [1 .. *] of nft$alias,
        actual_count: nft$ntf_remote_system_count,
        byte_address: amt$file_byte_address,
        count_string: string (osc$max_string_size),
        count_integer: clt$integer,
        file_position: amt$file_position,
        ignore_status: ost$status,
        last_acc_remote_system: ^nft$alias,
        remote_system_list_fid: amt$file_identifier,
        remote_system_name: ost$name,
        transfer_count: amt$transfer_count;

      status.normal := TRUE;
      remote_system_count := 0;

      fsp$open_file (ntf_remote_system_list_file, amc$record, NIL, NIL, NIL, NIL, NIL,
            remote_system_list_fid, status);
      IF NOT status.normal THEN
        RETURN;
      IFEND;

      amp$get_next (remote_system_list_fid, ^count_string, #SIZE (count_string), transfer_count, byte_address,
            file_position, status);
      IF status.normal THEN
        IF file_position <> amc$eoi THEN
          clp$convert_string_to_integer (count_string (1, transfer_count), count_integer, status);
          IF status.normal THEN
            remote_system_count := count_integer.value;
          ELSE
            osp$set_status_abnormal (nfc$status_id, nfe$ntf_system_list_file_error, ' ', status);
            fsp$close_file (remote_system_list_fid, ignore_status);
            RETURN;
          IFEND;
        IFEND;
      IFEND;

      IF remote_system_count > nfc$ntf_max_remote_systems THEN
        pmp$log ('NTF_System_List contains more than 3000 remote systems.', status);
        pmp$log ('Only the first 3000 remote systems will be used.', status);
        remote_system_count := nfc$ntf_max_remote_systems;
      IFEND;

      IF (remote_system_count > 0) AND (file_position <> amc$eoi) THEN
        ALLOCATE acc_remote_system_list: [1 .. remote_system_count];
      IFEND;

      actual_count := 0;
      last_acc_remote_system := NIL;
      WHILE (actual_count < remote_system_count) AND (file_position <> amc$eoi) DO
        amp$get_next (remote_system_list_fid, ^remote_system_name, #SIZE (remote_system_name),
              transfer_count, byte_address, file_position, status);
        IF NOT status.normal THEN
          fsp$close_file (remote_system_list_fid, ignore_status);
          RETURN;
        IFEND;

        actual_count := actual_count + 1;
        acc_remote_system := ^acc_remote_system_list^ [actual_count];
        acc_remote_system^.name := remote_system_name (1, transfer_count);
        acc_remote_system^.back_link := last_acc_remote_system;
        acc_remote_system^.link := NIL;
        acc_remote_system^.kind := nfc$io_station_alias;
        acc_remote_system^.queue := NIL;
        acc_remote_system^.station_list := NIL;
        acc_remote_system^.station_title_registered := FALSE;
        acc_remote_system^.alias_title_registered := FALSE;
        acc_remote_system^.ntf_authority_level := nfc$ntf_none;
        acc_remote_system^.ntf_remote_system_type := nfc$ntf_nos_ve;
        acc_remote_system^.ntf_route_back_position := 0;
        IF last_acc_remote_system <> NIL THEN
          IF last_acc_remote_system^.name >= acc_remote_system^.name THEN
            fsp$close_file (remote_system_list_fid, ignore_status);
            osp$set_status_abnormal (nfc$status_id, nfe$ntf_system_list_file_error, ' ', status);
            RETURN;
          IFEND;

          last_acc_remote_system^.link := acc_remote_system;
        IFEND;

        last_acc_remote_system := acc_remote_system;
      WHILEND;

      remote_system_count := actual_count;
      IF remote_system_count > 0 THEN
        acc_remote_system := ^acc_remote_system_list^ [1];
        scfs_tables.first_ntf_acc_remote_system := acc_remote_system;
      IFEND;

      fsp$close_file (remote_system_list_fid, status);
    PROCEND initialize_ntf_acc_rem_sys_list;

?? TITLE := 'initialize title', EJECT ??

    PROCEDURE initialize_title
      (    server: nat$application_name;
       VAR control_facility_name: ost$name;
           register_ntf: boolean;
       VAR status: ost$status);

      CONST
        maximum_connections = 0;

      VAR
        ignore_status: ost$status;

{  Attach the current job to the server application.  This must be done
{  before connections may be acquired.

      nap$attach_server_application (server, maximum_connections, status);
      IF status.normal THEN
        register_new_title (control_facility_name, FALSE, status);
        IF status.normal THEN
          ALLOCATE scfs_title: [start_of_title_length + osc$max_name_size];
          scfs_title^ (1, start_of_title_length) := start_of_scfs_title;
          scfs_title^ (1 + start_of_title_length, * ) := control_facility_name;
          IF register_ntf AND (control_facility_name (1, nfc$ntf_control_fac_prefix_size) <>
                nfc$ntf_control_facility_prefix) THEN
            register_new_title (control_facility_name, TRUE, status);
            IF status.normal THEN
              ALLOCATE scfs_ntf_title: [start_of_title_length + nfc$ntf_control_fac_prefix_size +
                    osc$max_name_size];
              scfs_ntf_title^ (1, start_of_title_length) := start_of_scfs_title;
              scfs_ntf_title^ (1 + start_of_title_length, nfc$ntf_control_fac_prefix_size) :=
                    nfc$ntf_control_facility_prefix;
              scfs_ntf_title^ (1 + start_of_title_length + nfc$ntf_control_fac_prefix_size, * ) :=
                    control_facility_name;
            IFEND;
          IFEND;
        ELSE
          nap$detach_server_application (server, ignore_status);
          control_facility_name := osc$null_name;
        IFEND;
      IFEND;

    PROCEND initialize_title;
?? OLDTITLE, EJECT ??

    status.normal := TRUE;

    scfs_tables.first_connection := NIL;
    scfs_tables.first_io_station := NIL;
    scfs_tables.first_ntf_acc_remote_system := NIL;
    scfs_tables.first_ntf_operator := NIL;
    scfs_tables.first_ntf_remote_system := NIL;
    scfs_tables.first_station_name_alias := NIL;
    scfs_tables.ntf_acc_remote_system_count := 0;
    scfs_tables.unknown_private_operators_q := NIL;

    get_control_facility_parameters (parameter_list, scfs_command_pdt, control_facility_name, server_name,
          event_logging, ntf_remote_system_list_file, status);
    IF status.normal THEN
      initialize_title (server_name, control_facility_name, (ntf_remote_system_list_file <> osc$null_name),
            status);
      IF status.normal THEN
        IF ntf_remote_system_list_file <> osc$null_name THEN
          ntf_remote_system_count := 0;
          initialize_ntf_acc_rem_sys_list (ntf_remote_system_list_file, ntf_remote_system_count,
                status);
          IF NOT status.normal THEN
            RETURN;
          IFEND;
          scfs_tables.ntf_acc_remote_system_count := ntf_remote_system_count;
        IFEND;
        IF status.normal THEN
          IF event_logging THEN
            initialize_scfs_event_logging (status);
          IFEND;
          IF status.normal THEN
            ALLOCATE message_area: [[REP nfc$maximum_message_length OF cell]];

            ALLOCATE wait_connection_list_seq: [[REP (nfc$wait_list_limit-wait_connection_list_lowest+1)
                  OF connection_pt]];

            ALLOCATE wait_list_seq: [[REP nfc$wait_list_limit OF ost$i_activity]];
            RESET wait_list_seq;
            NEXT wait_list: [1 .. 2] IN wait_list_seq;
            wait_list^ [1].activity := nac$i_await_connection;
            wait_list^ [1].server := server_name;
            wait_list^ [2].activity := osc$i_await_time;
            wait_list^ [2].milliseconds := long_scfs_timer;
          IFEND;
        IFEND;
      IFEND;
    IFEND;

  PROCEND initialize_scfs;
?? TITLE := 'initialize scfs event logging', EJECT ??

  PROCEDURE initialize_scfs_event_logging
    (VAR status: ost$status);

    VAR
      catalog_path: ^pft$path,
      cycle_selector: pft$cycle_selector,
      file_path: ^pft$path,
      ignore_status: ost$status,
      log_file_attachment_options: ^fst$attachment_options,
      path: ^SEQ ( * ),
      usage_selections: pft$usage_selections,
      share_selections: pft$share_selections;

    ALLOCATE scfs_log_file: [osc$max_name_size];
    PUSH path: [[REP 5 of pft$name]];

    RESET path;
    NEXT file_path: [1 .. 5] IN path;
    file_path^ [1] := '$SYSTEM';
    file_path^ [2] := '$SYSTEM';
    file_path^ [3] := 'BATCH_DEVICE_SUPPORT';
    file_path^ [4] := 'SCFS_LOG';
    file_path^ [5] := control_facility_name;
    scfs_log_file^ := control_facility_name;

    RESET path;
    NEXT catalog_path: [1 .. 4] IN path;

    pfp$define_catalog (catalog_path^, status);

    cycle_selector.cycle_option := pfc$highest_cycle;
    amp$return (file_path^ [5], ignore_status);
    pfp$define (file_path^ [5], file_path^, cycle_selector, osc$null_name, pfc$maximum_retention,
          pfc$no_log, status);
    IF status.normal THEN
      PUSH log_file_attachment_options: [1 .. 2];
      log_file_attachment_options^ [1].selector := fsc$access_and_share_modes;
      log_file_attachment_options^ [1].access_modes.selector :=
            fsc$specific_access_modes;
      log_file_attachment_options^ [1].access_modes.value :=
            -$fst$file_access_options [];
      log_file_attachment_options^ [1].share_modes.selector :=
            fsc$specific_share_modes;
      log_file_attachment_options^ [1].share_modes.value :=
            $fst$file_access_options [fsc$read, fsc$execute];
      log_file_attachment_options^ [2].selector :=
            fsc$open_share_modes;
      log_file_attachment_options^ [2].open_share_modes :=
            $fst$file_access_options [fsc$read, fsc$execute];
      fsp$open_file (scfs_log_file^, amc$segment, log_file_attachment_options, NIL, NIL, NIL, NIL,
            scfs_log_file_identifier, status);
      IF status.normal THEN
        amp$get_segment_pointer (scfs_log_file_identifier, amc$sequence_pointer, scfs_log_sequence, status);
        RESET scfs_log_sequence.sequence_pointer;
      IFEND;
    IFEND;

  PROCEND initialize_scfs_event_logging;
?? TITLE := 'init_ntf_acc_rem_sys_ptr_entry', EJECT ??

{  PURPOSE:
{    This procedure initializes all fields of an accessible remote system
{    pointer.

  PROCEDURE init_ntf_acc_rem_sys_ptr_entry
    (VAR acc_remote_system_ptr_entry: nft$pointer_list_entry);

    acc_remote_system_ptr_entry.back_link := NIL;
    acc_remote_system_ptr_entry.link := NIL;
    acc_remote_system_ptr_entry.kind := nfc$ntf_acc_remote_system;
    acc_remote_system_ptr_entry.ntf_acc_remote_system := NIL;

  PROCEND init_ntf_acc_rem_sys_ptr_entry;
?? TITLE := 'init_ntf_remote_sys_ptr_entry', EJECT ??

{  PURPOSE:
{    This procedure initializes all fields of a remote system pointer.

  PROCEDURE init_ntf_remote_sys_ptr_entry
    (VAR remote_system_ptr_entry: nft$pointer_list_entry);

    remote_system_ptr_entry.back_link := NIL;
    remote_system_ptr_entry.link := NIL;
    remote_system_ptr_entry.kind := nfc$ntf_remote_sys_logical_line;
    remote_system_ptr_entry.ntf_remote_system := NIL;
    remote_system_ptr_entry.ntf_logical_line_number := 1;

  PROCEND init_ntf_remote_sys_ptr_entry;
?? TITLE := 'input_device_or_stream', EJECT ??

{  PURPOSE:
{    This function identifies whether a batch device or an NTF batch stream
{    is an input device or stream.

  FUNCTION input_device_or_stream
    (    device: ^nft$batch_device): boolean;

    VAR
      station: ^nft$io_station;

    station := device^.io_station;
    CASE device^.device_type OF
    = nfc$reader =
      input_device_or_stream := (station^.usage <> nfc$ntf_remote_system);
    = nfc$printer, nfc$punch, nfc$plotter, nfc$ntf_remote_system_input, nfc$ntf_job_receiver,
          nfc$ntf_sysout_receiver =
      input_device_or_stream := (station^.usage = nfc$ntf_remote_system);
    ELSE
      input_device_or_stream := FALSE;
    CASEND;

  FUNCEND input_device_or_stream;
?? TITLE := 'log receive connection event', EJECT ??

  PROCEDURE log_receive_connection_event
    (    connection_file: fst$file_reference;
         connection: nft$connection;
         connection_established: boolean);

    CONST
      accepted = 'ACC',
      rejected = 'REJ';

    VAR
      address: ^nft$connection_address,
      connection_accepted: ^string (3),
      connection_kind: ^nft$connection_kind,
      date: ost$date,
      local_status: ost$status,
      log_date: ^ost$date,
      log_time: ^ost$time,
      time: ost$time;

    NEXT connection_accepted IN scfs_log_sequence.sequence_pointer;
    IF connection_established THEN
      connection_accepted^ := accepted;
    ELSE
      connection_accepted^ := rejected;
    IFEND;

    NEXT connection_kind IN scfs_log_sequence.sequence_pointer;
    connection_kind^ := connection.kind;

    NEXT address IN scfs_log_sequence.sequence_pointer;
    address^.kind := connection.peer_address.kind;
    CASE connection.peer_address.kind OF
    = nac$internet_address =
      address^.internet_address := connection.peer_address.internet_address;
    = nac$osi_transport_address =
      address^.network_address_length := connection.peer_address.osi_transport_address.network_address_length;
      address^.network_address := connection.peer_address.osi_transport_address.network_address;
    ELSE
      ;
    CASEND;

    pmp$get_time (osc$millisecond_time, time, local_status);
    NEXT log_time IN scfs_log_sequence.sequence_pointer;
    log_time^ := time;

    IF connection_established THEN
      pmp$get_date (osc$iso_date, date, local_status);
      NEXT log_date IN scfs_log_sequence.sequence_pointer;
      log_date^ := date;
    IFEND;

  PROCEND log_receive_connection_event;
?? TITLE := 'log connection message', EJECT ??

  PROCEDURE log_connection_message
    (    connection: nft$connection;
         msg_length: integer;
     VAR message: ^nft$message_sequence);

    CONST
      msg = 'MSG';

    VAR
      array_length: ^integer,
      byte_array: ^nft$byte_array,
      connection_addr: ^nft$connection_address,
      connection_kind: ^nft$connection_kind,
      connection_message: ^string (3),
      i: integer,
      local_status: ost$status,
      log_time: ^ost$time,
      message_bytes: ^nft$byte_array,
      time: ost$time;

    NEXT connection_message IN scfs_log_sequence.sequence_pointer;
    connection_message^ := msg;

    NEXT connection_kind IN scfs_log_sequence.sequence_pointer;
    connection_kind^ := connection.kind;

    NEXT connection_addr IN scfs_log_sequence.sequence_pointer;
    connection_addr^.kind := connection.peer_address.kind;
    CASE connection.peer_address.kind OF
    = nac$internet_address =
      connection_addr^.internet_address := connection.peer_address.internet_address;
    = nac$osi_transport_address =
      connection_addr^.network_address_length :=
            connection.peer_address.osi_transport_address.network_address_length;
      connection_addr^.network_address := connection.peer_address.osi_transport_address.network_address;
    ELSE
      ;
    CASEND;

    pmp$get_time (osc$millisecond_time, time, local_status);
    NEXT log_time IN scfs_log_sequence.sequence_pointer;
    log_time^ := time;

    NEXT array_length IN scfs_log_sequence.sequence_pointer;
    array_length^ := msg_length;

    NEXT byte_array: [1 .. msg_length] IN scfs_log_sequence.sequence_pointer;
    RESET message;
    NEXT message_bytes: [1 .. msg_length] IN message;
    FOR i := 1 TO msg_length DO
      byte_array^ [i] := message_bytes^ [i];
    FOREND;

  PROCEND log_connection_message;
?? TITLE := 'log terminated connection', EJECT ??

  PROCEDURE log_terminated_connection
    (    connection: nft$connection);

    CONST
      terminated = 'TER';

    VAR
      address: ^nft$connection_address,
      connection_action: ^string (3),
      connection_kind: ^nft$connection_kind,
      local_status: ost$status,
      log_time: ^ost$time,
      time: ost$time;

    NEXT connection_action IN scfs_log_sequence.sequence_pointer;
    connection_action^ := terminated;

    NEXT connection_kind IN scfs_log_sequence.sequence_pointer;
    connection_kind^ := connection.kind;

    NEXT address IN scfs_log_sequence.sequence_pointer;
    address^.kind := connection.peer_address.kind;
    CASE connection.peer_address.kind OF
    = nac$internet_address =
      address^.internet_address := connection.peer_address.internet_address;
    = nac$osi_transport_address =
      address^.network_address_length := connection.peer_address.osi_transport_address.network_address_length;
      address^.network_address := connection.peer_address.osi_transport_address.network_address;
    ELSE
      ;
    CASEND;

    pmp$get_time (osc$millisecond_time, time, local_status);
    NEXT log_time IN scfs_log_sequence.sequence_pointer;
    log_time^ := time;

  PROCEND log_terminated_connection;
?? TITLE := 'modify file availability msg', EJECT ??

{  PURPOSE:
{    This procedure is executed when a message is received from SCF/VE
{    informing SCFS that an output queue file entry has been modified by
{    the user.  Changes are made accordingly and the file is made allowed
{    to be selected.
{
{    This procedure is also executed when a message is received from NTF/VE
{    informing SCFS that an NTF queue file entry has been modified by the user.
{    Changes are made accordingly and the file is allowed to be selected.

  PROCEDURE modify_file_availability_msg
    (VAR message: ^nft$message_sequence;
         connection: ^nft$connection;
     VAR msg_length: integer;
     VAR status: ost$status);

    VAR
      alias_station_list: ^nft$pointer_list_entry,
      io_station: ^nft$io_station,
      modify_file: nft$output_queue_file,
      q_found: boolean,
      queue_file: ^nft$output_queue_file,
      queue_pointer: ^^nft$output_queue_file,
      selected_file: ^nft$selected_file;

*copy nft$file_availability_msg
?? NEWTITLE := 'change modify optional_fields', EJECT ??

{  Update the attributes of the queue file entry according to }
{  what the user has changed via change_output_attributes. }

    PROCEDURE change_modify_optional_fields
      (VAR message: ^nft$message_sequence;
       VAR msg_length: integer;
       VAR queue_entry: nft$output_queue_file;
       VAR status: ost$status);

      VAR
        ascii_string: ^string ( * <= osc$max_name_size),
        byte_array: ^nft$byte_array,
        copies: ^nft$copies,
        parameter: ^nft$file_available_msg_param,
        parameter_length: ^nft$parameter_value_length,
        priority: ^nft$priority,
        priority_factor: ^nft$priority_multiplier,
        value_length: integer,
        vertical_print_density: ^nft$file_vertical_print_density;

      NEXT parameter IN message;

      WHILE (parameter <> NIL) AND (parameter^.param <> nfc$null_parameter) AND (msg_length > 0) DO
        msg_length := msg_length - 1;
        IF parameter^.length_indicated THEN
          nfp$get_parameter_value_length (message, msg_length, value_length, status);
          msg_length := msg_length - value_length;
        ELSE
          value_length := 1;
          msg_length := msg_length - 1;
        IFEND;

        CASE parameter^.param OF
        = nfc$copies =
          NEXT copies IN message;
          queue_entry.copies := copies^;

        = nfc$device_name =
          NEXT ascii_string: [value_length] IN message;
          #translate (osv$lower_to_upper, ascii_string^, queue_entry.device_name);

        = nfc$external_characteristics =
          NEXT ascii_string: [value_length] IN message;
          #translate (osv$lower_to_upper, ascii_string^, queue_entry.external_characteristics);

        = nfc$forms_code =
          NEXT ascii_string: [value_length] IN message;
          #translate (osv$lower_to_upper, ascii_string^, queue_entry.forms_code);

        = nfc$output_initial_priority =
          NEXT priority IN message;
          queue_entry.initial_priority := priority^;

        = nfc$vfu_load_procedure =
          NEXT ascii_string: [value_length] IN message;
          #translate (osv$lower_to_upper, ascii_string^, queue_entry.vfu_load_procedure);

        = nfc$vertical_print_density =
          NEXT vertical_print_density IN message;
          queue_entry.vertical_print_density := vertical_print_density^;

        ELSE
{         ERROR ----   Ignore parameter value.
          NEXT byte_array: [1 .. value_length] IN message;

        CASEND;
        NEXT parameter IN message;
      WHILEND;

    PROCEND change_modify_optional_fields;
?? OLDTITLE, EJECT ??
    queue_pointer := NIL;
    get_required_file_avail_params (message, msg_length, modify_file, status);

    CASE modify_file.ios_usage OF
    = nfc$public_io_station =
      find_public_queue (modify_file.ios_name, queue_pointer, alias_station_list, q_found);
    = nfc$private_io_station =
      find_private_queue (modify_file.operator_name, modify_file.operator_family, queue_pointer,
            alias_station_list, q_found);
      IF NOT q_found THEN
        q_found := TRUE;
        queue_pointer := ^scfs_tables.unknown_private_operators_q;
      IFEND;
    = nfc$ntf_remote_system =
      find_ntf_remote_queue (modify_file.ios_name, queue_pointer, alias_station_list);
      q_found := (queue_pointer <> NIL);
    CASEND;

    IF q_found THEN
      find_q_file (modify_file.system_file_name, queue_pointer^, queue_file);
      IF queue_file = NIL THEN
        find_station_and_selected_file (modify_file.system_file_name, io_station, selected_file);
        IF selected_file <> NIL THEN
          queue_file := selected_file^.output_file;

          alias_station_list := NIL;
          PUSH alias_station_list;
          alias_station_list^.back_link := NIL;
          alias_station_list^.link := NIL;
          alias_station_list^.kind := nfc$io_station;
          alias_station_list^.io_station := io_station;
        IFEND;
      IFEND;

      IF queue_file <> NIL THEN
        change_modify_optional_fields (message, msg_length, queue_file^, status);

        queue_file^.output_state := nfc$eligible_for_transfer;

        IF queue_pointer <> ^scfs_tables.unknown_private_operators_q THEN
          output_file_assignment (queue_file, alias_station_list, message, connection, status);
          IF NOT status.normal THEN
            status.normal := TRUE;
          IFEND;
        IFEND;
      IFEND;
    IFEND;

  PROCEND modify_file_availability_msg;
?? TITLE := 'move files back to unknown q', EJECT ??

  PROCEDURE move_files_back_to_unknown_q
    (    io_station: ^nft$io_station);

    VAR
      alias_entry: ^nft$alias,
      last_q_file: ^nft$output_queue_file,
      private_q_file: ^nft$output_queue_file;

?? NEWTITLE := 'move_select_files_to_unknown_q', EJECT ??

    PROCEDURE move_select_files_to_unknown_q
      (    io_station: ^nft$io_station;
       VAR last_file_in_unknown_op_q: ^nft$output_queue_file;
       VAR unknown_private_operators_q: ^nft$output_queue_file);

      VAR
        last_output_file: ^nft$output_queue_file,
        new_output_q: ^nft$output_queue_file,
        old_selected_file: ^nft$selected_file,
        output_file: ^nft$output_queue_file,
        selected_file: ^nft$selected_file;

      selected_file := io_station^.selected_files_queue;
      new_output_q := NIL;
      WHILE selected_file <> NIL DO
        IF new_output_q = NIL THEN
          new_output_q := selected_file^.output_file;
          last_output_file := new_output_q;
        ELSE
          last_output_file^.link := selected_file^.output_file;
          output_file := selected_file^.output_file;
          output_file^.back_link := last_output_file;
          last_output_file := output_file;
        IFEND;
        old_selected_file := selected_file;
        selected_file := selected_file^.link;
        FREE old_selected_file;
      WHILEND;

      io_station^.selected_files_queue := NIL;
      io_station^.last_selected_file_in_q := NIL;

      IF unknown_private_operators_q = NIL THEN
        unknown_private_operators_q := new_output_q;
      ELSE
        last_file_in_unknown_op_q^.link := new_output_q;
      IFEND;
      last_file_in_unknown_op_q := last_output_file;

    PROCEND move_select_files_to_unknown_q;
?? OLDTITLE, EJECT ??
    alias_entry := io_station^.alias_list [0];
    IF (io_station^.selected_files_queue <> NIL) OR (alias_entry^.queue <> NIL) THEN
      last_q_file := scfs_tables.unknown_private_operators_q;
      IF last_q_file <> NIL THEN
        WHILE last_q_file^.link <> NIL DO
          last_q_file := last_q_file^.link;
        WHILEND;
      IFEND;

      IF io_station^.selected_files_queue <> NIL THEN
        move_select_files_to_unknown_q (io_station, last_q_file,
              scfs_tables.unknown_private_operators_q);
      IFEND;

      IF last_q_file <> NIL THEN
        last_q_file^.link := alias_entry^.queue;
        private_q_file := alias_entry^.queue;
        private_q_file^.back_link := last_q_file;
      ELSE
        scfs_tables.unknown_private_operators_q := alias_entry^.queue;
      IFEND;
      alias_entry^.queue := NIL;
    IFEND;

  PROCEND move_files_back_to_unknown_q;
?? OLDTITLE ??
?? NEWTITLE := 'ntf_file_and_stream_match', EJECT ??

{  PURPOSE:
{    This procedure determines if the attributes of the output queue file
{    and the attributes of the stream are such that the file should be
{    sent to that stream.
{
{    If the protocol for the remote system is not NJE, the device type of the
{    queue file will be assumed to be card reader.

  FUNCTION ntf_file_and_stream_match
    (    q_file: ^nft$output_queue_file;
         stream: ^nft$batch_device): boolean;

    VAR
      remote_system: ^nft$io_station,
      stream_match: boolean;

    remote_system := stream^.io_station;
    IF stream^.maximum_file_size > 0 THEN
      stream_match := q_file^.file_size <= stream^.maximum_file_size;
    ELSE
      stream_match := TRUE;
    IFEND;

    IF remote_system^.ntf_protocol <> nfc$ntf_nje THEN
      stream_match := stream_match AND (stream^.device_type = nfc$reader);
      stream_match := stream_match AND (q_file^.page_width <= stream^.page_width);
    ELSE
      stream_match := stream_match AND (stream^.device_type = q_file^.device_type);
    IFEND;

    ntf_file_and_stream_match := stream_match;

  FUNCEND ntf_file_and_stream_match;
?? TITLE := 'operator message', EJECT ??

{  PURPOSE:
{    This procedure is executed when a request is received from SCF/DI to
{    send a message to the I/O station operator.  This message would be sent
{    if a print file message is encounted "PM message", upon detection of an
{    error condition (e.g. bad route job command) or to send preview data when
{    positioning a file.  This message is only forwarded if an operator is
{    currently assigned to the specified I/O station.

  PROCEDURE operator_message
    (VAR message: ^nft$message_sequence;
         message_length: integer;
         connection: ^nft$connection;
     VAR msg_length: integer;
     VAR status: ost$status);

    VAR
      device: ^nft$batch_device,
      device_found: boolean,
      device_name: ost$name,
      io_station: ^nft$io_station,
      io_station_found: boolean,
      io_station_name: ost$name,
      msg_text: string (255),
      msg_text_length: 0 .. 255,
      operator_connection: ^nft$connection;

*copy nft$operator_message
?? NEWTITLE := 'crack operator msg', EJECT ??

    PROCEDURE crack_operator_msg
      (VAR message: ^nft$message_sequence;
       VAR msg_length: integer;
       VAR io_station_name: ost$name;
       VAR device_name: ost$name;
       VAR msg_text: string (255);
       VAR msg_text_length: 0 .. 255;
       VAR status: ost$status);

      VAR
        ascii_string: ^string ( * <= osc$max_name_size),
        byte_array: ^nft$byte_array,
        parameter: ^nft$operator_message_parameter,
        text: ^string ( * ),
        value_length: integer;

      NEXT parameter IN message;

      WHILE (parameter <> NIL) AND (parameter^.param <> nfc$null_parameter) AND (msg_length > 0) DO
        msg_length := msg_length - 1;
        IF parameter^.length_indicated THEN
          nfp$get_parameter_value_length (message, msg_length, value_length, status);
          msg_length := msg_length - value_length;
        ELSE
          value_length := 1;
          msg_length := msg_length - 1;
        IFEND;

        CASE parameter^.param OF
        = nfc$io_station_name =
          NEXT ascii_string: [value_length] IN message;
          #translate (osv$lower_to_upper, ascii_string^, io_station_name);

        = nfc$device_name =
          NEXT ascii_string: [value_length] IN message;
          #translate (osv$lower_to_upper, ascii_string^, device_name);

        = nfc$text =
          NEXT text: [value_length] IN message;
          IF value_length < 255 THEN
            msg_text (1, value_length) := text^ (1, value_length);
            msg_text_length := value_length;
          ELSE
            msg_text := text^ (1, 255);
            msg_text_length := 255;
          IFEND;

        ELSE
{         ERROR ----   Ignore parameter value.
          NEXT byte_array: [1 .. value_length] IN message;

        CASEND;
        NEXT parameter IN message;
      WHILEND;

    PROCEND crack_operator_msg;

?? TITLE := 'print error listing', EJECT ??

    PROCEDURE print_error_listing
      (    msg_text: string(255);
           msg_text_length: 0..255;
           io_station: ^nft$io_station;
           device_name: ost$name);

      CONST
        comment_banner = '**** ERROR ****',
        device_label = 'Device   : ',
        device_label_size = 11,
        routing_banner = 'STATION   OPERATOR';

      VAR
        attachment_options: [STATIC, READ] array [1..1] of fst$attachment_option :=
              [[fsc$access_and_share_modes, [fsc$specific_access_modes, [fsc$read, fsc$modify,
              fsc$append, fsc$execute]], *]],
        byte_addr: amt$file_byte_address,
        file_id: amt$file_identifier,
        file_name: ost$name,
        operator_connection: ^nft$connection,
        start_pos: 1..80,
        status: ost$status,
        str_length: 0 .. osc$max_name_size,
        submission_options: ^jmt$output_submission_options,
        system_supplied_name: jmt$system_supplied_name,
        text: string (80),
        text_length: 0..80;

      submission_options := NIL;

{  Create the error listing file, using the operator text sent up from SCF/DI. }

      pmp$get_unique_name (file_name, status);
      IF NOT status.normal THEN
        RETURN;
      IFEND;

      fsp$open_file (file_name, amc$record, ^attachment_options, NIL, NIL, NIL, NIL, file_id, status);
      IF NOT status.normal THEN
        RETURN;
      IFEND;

{  Format the line containing the device and the station name. }

      text (1, device_label_size) := device_label;
      text_length := device_label_size;

      start_pos := text_length + 1;
      str_length := clp$trimmed_string_size (device_name);
      text (start_pos, str_length) := device_name (1, str_length);
      text_length := text_length + str_length;

      start_pos := text_length + 1;
      text (start_pos, 4) := ' at ';
      text_length := text_length + 4;

      start_pos := text_length + 1;
      str_length := clp$trimmed_string_size (io_station^.name);
      text (start_pos, str_length) := io_station^.name (1, str_length);
      text_length := text_length + str_length;

{  Write the station information and the text message to the file.

      amp$put_next (file_id, ^text, text_length, byte_addr, status);
      IF NOT status.normal THEN
        RETURN;
      IFEND;

      amp$put_next (file_id, ^msg_text, msg_text_length, byte_addr, status);
      IF NOT status.normal THEN
        RETURN;
      IFEND;

      fsp$close_file (file_id, status);
      IF NOT status.normal THEN
        RETURN;
      IFEND;

{  Set up the submission options necessary to print the listing at the same  }
{  station the input job was read in from.  }

      IF (io_station^.usage = nfc$public_io_station) THEN

        PUSH submission_options: [1..4];
        submission_options^[1].key := jmc$comment_banner;
        submission_options^[1].comment_banner := comment_banner;
        submission_options^[2].key := jmc$routing_banner;
        submission_options^[2].routing_banner := routing_banner;
        submission_options^[3].key := jmc$station;
        submission_options^[3].station := io_station^.name;
        submission_options^[4].key := jmc$output_destination_usage;
        submission_options^[4].output_destination_usage := jmc$public_usage;

      ELSE {io_station^.usage = nfc$private_io_station}

        IF (io_station^.connected_operator <> NIL) THEN
          PUSH submission_options: [1..6];
          operator_connection := io_station^.connected_operator;
          submission_options^[1].key := jmc$comment_banner;
          submission_options^[1].comment_banner := comment_banner;
          submission_options^[2].key := jmc$routing_banner;
          submission_options^[2].routing_banner := routing_banner;
          submission_options^[3].key := jmc$station;
          submission_options^[3].station := control_facility_name;
          submission_options^[4].key := jmc$output_destination_usage;
          submission_options^[4].output_destination_usage := jmc$private_usage;
          submission_options^[5].key := jmc$station_operator;
          submission_options^[5].station_operator := operator_connection^.user;
          submission_options^[6].key := jmc$output_destination_family;
          submission_options^[6].output_destination_family := operator_connection^.family;
        IFEND;

      IFEND;

{  Send the error listing to print.  }

      jmp$print_file (file_name, submission_options, system_supplied_name, status);

    PROCEND print_error_listing;

?? OLDTITLE, EJECT ??

    crack_operator_msg (message, msg_length, io_station_name, device_name, msg_text, msg_text_length, status);

    find_io_station (io_station_name, io_station, io_station_found);
    IF io_station_found THEN
      find_batch_device (device_name, io_station, device, device_found);
      IF device_found THEN

{  If the operator message came from an input device, the message is an error  }
{  message and an output listing should be generated.  }

        IF (device^.device_type = nfc$reader) THEN
          print_error_listing (msg_text, msg_text_length, io_station, device_name);
        IFEND;

        device^.last_unsolicited_msg_length := msg_text_length;
        device^.last_unsolicited_msg (1, msg_text_length) := msg_text (1, msg_text_length);

        IF io_station^.connected_operator <> NIL THEN
          operator_connection := io_station^.connected_operator;
          nfp$send_message_on_connection (message, message_length, operator_connection^.id, status);
          IF scfs_event_logging THEN
            log_connection_message (operator_connection^, message_length, message);
          IFEND;
        IFEND;
      IFEND;
    IFEND;

  PROCEND operator_message;
?? TITLE := 'output_device_or_stream', EJECT ??

{  PURPOSE:
{    This function identifies whether a batch device or an NTF batch stream
{    is an output device or stream.

  FUNCTION output_device_or_stream
    (    device: ^nft$batch_device): boolean;

    VAR
      station: ^nft$io_station;

    station := device^.io_station;
    CASE device^.device_type OF
    = nfc$reader, nfc$ntf_job_transmitter, nfc$ntf_sysout_transmitter =
      output_device_or_stream := (station^.usage = nfc$ntf_remote_system);
    = nfc$printer, nfc$punch, nfc$plotter =
      output_device_or_stream := (station^.usage <> nfc$ntf_remote_system);
    ELSE
      output_device_or_stream := FALSE;
    CASEND;

  FUNCEND output_device_or_stream;
?? TITLE := 'output file assignment', EJECT ??

  PROCEDURE output_file_assignment
    (    q_file: ^nft$output_queue_file;
         alias_station_list: ^nft$pointer_list_entry;
     VAR message: ^nft$message_sequence;
         connection: ^nft$connection;
     VAR status: ost$status);

    VAR
      device: ^nft$batch_device,
      device_found: boolean,
      signed_on: boolean,
      station: ^nft$io_station,
      station_list: ^nft$pointer_list_entry;

    device_found := FALSE;
    station_list := alias_station_list;

    WHILE NOT device_found AND (station_list <> NIL) DO
      IF station_list^.kind <> nfc$ntf_remote_sys_logical_line THEN
        station := station_list^.io_station;
      ELSE
        station := station_list^.ntf_remote_system;
      IFEND;

      IF station^.usage = q_file^.ios_usage THEN
        device := station^.batch_device_list;
        WHILE NOT device_found AND (device <> NIL) DO
          IF station^.usage = nfc$ntf_remote_system THEN
            check_for_ntf_signed_on_stream (station, device, signed_on);
          ELSE
            signed_on := TRUE;
          IFEND;

          IF ((q_file^.device_name = osc$null_name) OR (q_file^.device_name = automatic) OR (q_file^.
                device_name = device^.name) OR (q_file^.device_name = device^.alias_names [1]) OR (q_file^.
                device_name = device^.alias_names [2]) OR (q_file^.device_name = device^.alias_names [3]))
                AND signed_on THEN
            IF device_available_for_output (device) THEN
              device_found := file_and_device_match (q_file, device);
              IF device_found THEN
                q_file^.output_state := nfc$selected_for_transfer;
                q_file^.assigned_device := device;
                device^.current_file := q_file;
              IFEND;
            IFEND;
          IFEND;
          IF NOT device_found THEN
            device := device^.link;
          IFEND;
        WHILEND;
      IFEND;
      IF NOT device_found THEN
        station_list := station_list^.link;
      IFEND;
    WHILEND;

    IF device_found THEN
      send_file_assignment_msg (message, station^.name, q_file^, device, connection, status);
    ELSE
      status.normal := FALSE;
    IFEND;

  PROCEND output_file_assignment;
?? TITLE := 'position file msg', EJECT ??

{  PURPOSE:
{    This procedure is executed when a request is received from OPES to
{    position an output file transfer that is active on an output device.
{    The information is forwarded to SCF/DI for processing if the station and
{    device are found, the device is an output device and there is a file
{    currently being printed, otherwise the request is rejected.

  PROCEDURE position_file_msg
    (VAR message: ^nft$message_sequence;
         connection: ^nft$connection;
     VAR msg_length: integer;
     VAR status: ost$status);

    VAR
      current_file: ^nft$output_queue_file,
      device: ^nft$batch_device,
      device_found: boolean,
      device_name: ost$name,
      io_station: ^nft$io_station,
      io_station_found: boolean,
      io_station_name: ost$name,
      parameter_block: ^string ( * ),
      param_block_str_length: 0 .. 999,
      posf_direction: nft$position_file_direction,
      posf_loc_count: nft$position_file_locate_count,
      posf_loc_string_1: string (nfc$posf_max_string_length),
      posf_loc_string_2: string (nfc$posf_max_string_length),
      posf_preview_count: nft$position_file_preview_count,
      posf_start_position: nft$position_file_from_position,
      posf_string_1_length: 0 .. nfc$posf_max_string_length,
      posf_string_2_length: 0 .. nfc$posf_max_string_length,
      posf_units: nft$position_file_units,
      response: nft$device_control_resp_codes,
      scf_di_connection: ^nft$connection;

*copyc nft$position_file_param_types
?? NEWTITLE := 'build parameter block', EJECT ??

    PROCEDURE build_parameter_block
      (VAR parameter_block: ^string ( * );
       VAR str_length: 0 .. 999;
       VAR status: ost$status);

      CONST
        zero_fill = '0',
        parameter_block_fixed_length = 32,
        one = '001',
        zero = '000',

        location_count_param = '01',
        location_string_1_param = '02',
        location_string_2_param = '03',
        units_param = '04',
        direction_param = '05',
        start_position_param = '06',
        preview_count_param = '07';

      VAR
        count_length: integer,
        int: integer,
        posf_loc_count_size: integer,
        posf_loc_count_size_string: string(3),
        posf_string_size: string(3),
        second_count_length: integer;

      str_length := parameter_block_fixed_length;
      IF posf_string_1_length > 0 THEN
        str_length := str_length + posf_string_1_length;
        IF posf_loc_string_2 <> osc$null_name THEN
          str_length := str_length + posf_string_2_length;
        IFEND;
      ELSE
        IF (posf_loc_count >= 0) AND (posf_loc_count <= 9) THEN
          posf_loc_count_size := 1;
          posf_loc_count_size_string := one;
        ELSEIF (posf_loc_count >= 10) AND (posf_loc_count <= 99) THEN
          posf_loc_count_size := 2;
          posf_loc_count_size_string := '002';
        ELSEIF (posf_loc_count >= 100) AND (posf_loc_count <= 999) THEN
          posf_loc_count_size := 3;
          posf_loc_count_size_string := '003';
        ELSEIF (posf_loc_count >= 1000) AND (posf_loc_count <= 9999) THEN
          posf_loc_count_size := 4;
          posf_loc_count_size_string := '004';
        ELSEIF (posf_loc_count >= 10000) AND (posf_loc_count <= nfc$posf_max_locate_count) THEN
          posf_loc_count_size := 5;
          posf_loc_count_size_string := '005';
        IFEND;
        str_length := str_length + posf_loc_count_size;
      IFEND;
      ALLOCATE parameter_block: [str_length];

      parameter_block^ := one;
      str_length := 3;

      IF posf_loc_string_1 <> osc$null_name THEN
        parameter_block^ (str_length + 1, 2) := location_string_1_param;
        int := posf_string_1_length;
        clp$convert_integer_to_rjstring (int, 10, false, zero_fill,
              posf_string_size, status);
        parameter_block^ (str_length + 3, 3) := posf_string_size;
        parameter_block^ (str_length + 6, posf_string_1_length) := posf_loc_string_1;
        str_length := str_length + 5 + posf_string_1_length;
        IF posf_loc_string_2 <> osc$null_name THEN
          parameter_block^ (str_length + 1, 2) := location_string_2_param;
          int := posf_string_2_length;
          clp$convert_integer_to_rjstring (int, 10, false, zero_fill,
                posf_string_size, status);
          parameter_block^ (str_length + 3, 3) := posf_string_size;
          parameter_block^ (str_length + 6, posf_string_2_length) := posf_loc_string_2;
          str_length := str_length + 5 + posf_string_2_length;
        IFEND;
      ELSE
        parameter_block^ (str_length + 1, 2) := location_count_param;
        parameter_block^ (str_length + 3, 3) := posf_loc_count_size_string;
        clp$convert_integer_to_rjstring (posf_loc_count, 10, FALSE, ' ', parameter_block^ (str_length + 6,
              posf_loc_count_size), status);
        str_length := str_length + 5 + posf_loc_count_size;
      IFEND;

      parameter_block^ (str_length + 1, 2) := units_param;
      parameter_block^ (str_length + 3, 3) := one;
      IF posf_units = nfc$position_file_page THEN
        parameter_block^ (str_length + 6) := 'P';
      ELSEIF posf_units = nfc$position_file_line THEN
        parameter_block^ (str_length + 6) := 'L';
      IFEND;
      str_length := str_length + 6;

      parameter_block^ (str_length + 1, 2) := direction_param;
      parameter_block^ (str_length + 3, 3) := one;
      IF posf_direction = nfc$position_file_backwards THEN
        parameter_block^ (str_length + 6) := 'B';
      ELSEIF posf_direction = nfc$position_file_forwards THEN
        parameter_block^ (str_length + 6) := 'F';
      IFEND;
      str_length := str_length + 6;

      parameter_block^ (str_length + 1, 2) := start_position_param;
      parameter_block^ (str_length + 3, 3) := one;
      IF posf_start_position = nfc$end_of_file THEN
        parameter_block^ (str_length + 6) := 'E';
      ELSEIF posf_start_position = nfc$beginning_of_file THEN
        parameter_block^ (str_length + 6) := 'B';
      ELSEIF posf_start_position = nfc$last_line_printed THEN
        parameter_block^ (str_length + 6) := 'L';
      IFEND;
      str_length := str_length + 6;

{  The preview count value sent from OPES can range from 1 .. 10.  The value
{  sent to the DI will be mapped into values 0 .. 9.

      IF (posf_preview_count >= 1) THEN
        parameter_block^ (str_length + 1, 2) := preview_count_param;
        parameter_block^ (str_length + 3, 3) := one;
        parameter_block^ (str_length + 6) := $CHAR ((posf_preview_count-1) + 30(16));
        str_length := str_length + 6;
      IFEND;

    PROCEND build_parameter_block;
?? TITLE := 'crack position file msg', EJECT ??

    PROCEDURE crack_position_file_msg
      (VAR message: ^nft$message_sequence;
       VAR msg_length: integer;
       VAR io_station_name: ost$name;
       VAR device_name: ost$name;
       VAR status: ost$status);

      VAR
        ascii_string: ^string ( * <= nfc$posf_max_string_length),
        byte_array: ^nft$byte_array,
        direction: ^nft$position_file_direction,
        location_count: ^nft$position_file_locate_count,
        parameter: ^nft$position_file_msg_parameter,
        preview_count: ^nft$position_file_preview_count,
        start_position: ^nft$position_file_from_position,
        units: ^nft$position_file_units,
        value_length: integer;

*copyc nft$position_file_msg

      NEXT parameter IN message;

      WHILE (parameter <> NIL) AND (parameter^.param <> nfc$null_parameter) AND (msg_length > 0) DO
        msg_length := msg_length - 1;
        IF parameter^.length_indicated THEN
          nfp$get_parameter_value_length (message, msg_length, value_length, status);
          msg_length := msg_length - value_length;
        ELSE
          value_length := 1;
          msg_length := msg_length - 1;
        IFEND;

        CASE parameter^.param OF
        = nfc$io_station_name =
          NEXT ascii_string: [value_length] IN message;
          #translate (osv$lower_to_upper, ascii_string^, io_station_name);

        = nfc$device_name =
          NEXT ascii_string: [value_length] IN message;
          #translate (osv$lower_to_upper, ascii_string^, device_name);

        = nfc$location_integer =
          NEXT location_count IN message;
          posf_loc_count := location_count^;

        = nfc$location_string_1 =
          NEXT ascii_string: [value_length] IN message;
          posf_loc_string_1 := ascii_string^;
          posf_string_1_length := value_length;

        = nfc$location_string_2 =
          NEXT ascii_string: [value_length] IN message;
          posf_loc_string_2 := ascii_string^;
          posf_string_2_length := value_length;

        = nfc$units =
          NEXT units IN message;
          posf_units := units^;

        = nfc$direction =
          NEXT direction IN message;
          posf_direction := direction^;

        = nfc$starting_position =
          NEXT start_position IN message;
          posf_start_position := start_position^;

        = nfc$preview_line_count =
          NEXT preview_count IN message;
          posf_preview_count := preview_count^;

        ELSE
{         ERROR ----   Ignore parameter value.
          NEXT byte_array: [1 .. value_length] IN message;

        CASEND;
        NEXT parameter IN message;
      WHILEND;

    PROCEND crack_position_file_msg;
?? OLDTITLE, EJECT ??

    posf_loc_count := 0;
    posf_preview_count := 0;
    posf_loc_string_1 := osc$null_name;
    posf_loc_string_2 := osc$null_name;
    posf_string_1_length := 0;
    posf_string_2_length := 0;

    crack_position_file_msg (message, msg_length, io_station_name, device_name, status);

    find_io_station (io_station_name, io_station, io_station_found);
    IF NOT io_station_found THEN
      response := nfc$dc_msg_reject_unknown_ios;
    ELSE
      find_batch_device (device_name, io_station, device, device_found);
      IF NOT device_found THEN
        response := nfc$dc_msg_reject_unknown_dev;

{  If the device is an input device, a position file command is not valid.  }

      ELSEIF device^.device_type = nfc$reader THEN
        response := nfc$dc_msg_reject_bad_dev_type;
      ELSEIF device^.btfs_di_status <> nfc$btfs_di_active THEN
        response := nfc$dc_msg_reject_btfsdi_down;
      ELSE
        response := nfc$dc_msg_accepted;
        current_file := device^.current_file;

{  Send the position file command to SCF/DI for processing if it is accepted. }

        IF response = nfc$dc_msg_accepted THEN
          build_parameter_block (parameter_block, param_block_str_length, status);
          scf_di_connection := device^.scfdi_connection;
          send_position_file_di_msg (message, io_station_name, device_name, parameter_block^ (1,
                param_block_str_length), scf_di_connection, status);
          device^.outstanding_di_responses [nfc$position_file] := device^.outstanding_di_responses
                [nfc$position_file] + 1;
          FREE parameter_block;
        IFEND;
      IFEND;
    IFEND;

{  Send a reject response if the message is not accepted.  }

    IF response > nfc$dc_msg_accepted THEN
      send_device_control_response (message, nfc$position_file_resp, io_station_name, device_name, response,
            connection, status);
    IFEND;

  PROCEND position_file_msg;
?? TITLE := 'position file resp', EJECT ??

{  PURPOSE:
{    This procedure is executed when a response is received from SCF/DI to
{    an operator position file command.  If an operator is assigned to the
{    station for which the device is defined, the response is forwarded to
{    the station operator.

  PROCEDURE position_file_resp
    (VAR message: ^nft$message_sequence;
         message_length: integer;
         connection: ^nft$connection;
     VAR msg_length: integer;
     VAR status: ost$status);

    VAR
      device: ^nft$batch_device,
      device_found: boolean,
      device_name: ost$name,
      io_station: ^nft$io_station,
      io_station_found: boolean,
      io_station_name: ost$name,
      operator_connection: ^nft$connection,
      response_code: nft$device_control_resp_codes;

    crack_device_control_resp (message, msg_length, io_station_name, device_name, response_code, status);

    find_io_station (io_station_name, io_station, io_station_found);
    IF io_station_found THEN
      find_batch_device (device_name, io_station, device, device_found);
      IF device_found THEN
        device^.outstanding_di_responses [nfc$position_file] := device^.outstanding_di_responses
              [nfc$position_file] - 1;

        IF io_station^.operator_assigned THEN
          operator_connection := io_station^.connected_operator;
          nfp$send_message_on_connection (message, message_length, operator_connection^.id, status);
          IF scfs_event_logging THEN
            log_connection_message (operator_connection^, message_length, message);
         IFEND;
        IFEND;
      IFEND;
    IFEND;

  PROCEND position_file_resp;
?? TITLE := 'register new title', EJECT ??

  PROCEDURE register_new_title
    (    title_part: ost$name;
         ntf_title: boolean;
     VAR status: ost$status);

    VAR
      next_character: integer,
      title: ^nat$title_pattern;

?? TITLE := 'title already registered', EJECT ??

    FUNCTION title_already_registered (title: nat$title_pattern): boolean;

      CONST
        translation_wait_time = 0;

      VAR
        recurrent_search: boolean,
        search_id: nat$directory_search_identifier,
        translation_address: nat$network_address,
        translation_attributes: ^nat$translation_attributes;

      recurrent_search := FALSE;

      nap$begin_directory_search (title, nfc$scf_ve_client_name, recurrent_search, search_id, status);

      translation_attributes := NIL;

      REPEAT
        nap$get_title_translation (search_id, translation_wait_time, translation_attributes,
              translation_address, status);
        IF NOT status.normal AND (status.condition = nae$no_translation_available) THEN
          pmp$wait (1500, 1500);
        IFEND;
      UNTIL status.normal OR (status.condition <> nae$no_translation_available);

      title_already_registered := status.normal;

      nap$end_directory_search (search_id, status);

    FUNCEND title_already_registered;
?? OLDTITLE, EJECT ??

    PUSH title: [start_of_title_length + nfc$ntf_control_fac_prefix_size + osc$max_name_size];
    next_character := 1;
    title^ (next_character, start_of_title_length) := start_of_scfs_title;
    next_character := next_character + start_of_title_length;
    IF ntf_title THEN
      title^ (next_character, nfc$ntf_control_fac_prefix_size) := nfc$ntf_control_facility_prefix;
      next_character := next_character + nfc$ntf_control_fac_prefix_size;
    IFEND;

    title^ (next_character, * ) := title_part;

    IF title_already_registered (title^) THEN
      osp$set_status_abnormal ('NF', nfe$cf_title_already_registered, title^, status);
    ELSE
      register_title (title^, status);
    IFEND;

  PROCEND register_new_title;

?? NEWTITLE := 'register title', EJECT ??

    PROCEDURE register_title
      (    title: nat$title_pattern;
       VAR status: ost$status);

      VAR
        distribute_title: boolean;

      distribute_title := TRUE;

      nap$add_server_title (server_name, title, NIL, distribute_title, status);

    PROCEND register_title;

?? TITLE := 'remove connection from list', EJECT ??

  PROCEDURE remove_connection_from_list
   (    connection_index: integer;
    VAR wait_list: ^ost$i_wait_list;
    VAR wait_connection_list: ^nft$wait_connection_list;
    VAR message: ^nft$message_sequence;
    VAR status: ost$status);

    VAR
      current_connection: ^nft$connection,
      connection_found: boolean,
      file_id_is_valid: boolean,
      file_instance: ^bat$task_file_entry,
      file_name: amt$local_file_name,
      ignore_status: ost$status,
      io_station: ^nft$io_station,
      next_io_station: ^nft$io_station,
      ntf_operator: ^nft$connection;

?? NEWTITLE := 'clean up operated station', EJECT ??

    PROCEDURE clean_up_operated_station
      (    connection: ^nft$connection;
       VAR message: ^nft$message_sequence;
       VAR status: ost$status);

      VAR
        connection_pt: ^nft$pointer_list_entry,
        di_connection: ^nft$connection,
        io_station: ^nft$io_station;

      io_station := connection^.operating_station;
      IF io_station^.usage <> nfc$ntf_remote_system THEN
        connection_pt := io_station^.scfdi_connection_pointers;

        WHILE connection_pt <> NIL DO
          di_connection := connection_pt^.connection;
          send_stop_io_station_msg (message, io_station^.name, di_connection, status);
          connection_pt := connection_pt^.link;
        WHILEND;
      IFEND;

      IF io_station^.usage = nfc$private_io_station THEN
        move_files_back_to_unknown_q (io_station);
      IFEND;

      io_station^.operator_assigned := FALSE;
      io_station^.connected_operator := NIL;
      IF io_station^.usage <> nfc$ntf_remote_system THEN
        io_station^.station_operational := (io_station^.usage = nfc$public_io_station);
      IFEND;

    PROCEND clean_up_operated_station;
?? TITLE := 'find connection in io station', EJECT ??

    PROCEDURE find_connection_in_io_station
      (    io_station: ^nft$io_station;
           connection: ^nft$connection;
       VAR connection_found: boolean);

      VAR
        connection_pointer: ^nft$pointer_list_entry,
        di_connection: ^nft$connection;

      connection_pointer := io_station^.scfdi_connection_pointers;
      connection_found := FALSE;
      WHILE (connection_pointer <> NIL) AND
            (NOT connection_found) DO
        di_connection := connection_pointer^.connection;
        connection_found := di_connection = connection;
        connection_pointer := connection_pointer^.link;
      WHILEND;

    PROCEND find_connection_in_io_station;
?? TITLE := 'remove_ve_client_queue_files', EJECT ??

    PROCEDURE remove_ve_client_queue_files
      (    connection: ^nft$connection);

      VAR
        back_link: ^nft$output_queue_file,
        current_file: ^nft$output_queue_file,
        device: ^nft$batch_device,
        file_was_not_in_selected_q: boolean,
        io_station: ^nft$io_station,
        link: ^nft$output_queue_file,
        prior_ve_client_file: ^nft$output_queue_file,
        pointer_to_q: ^^nft$output_queue_file,
        pointer_to_q_found: boolean,
        selected_file: ^nft$selected_file;

?? NEWTITLE := 'get pointer to q', EJECT ??

      PROCEDURE get_pointer_to_q
        (    q_file: ^nft$output_queue_file;
         VAR q_pointer_found: boolean;
         VAR q_pointer: ^^nft$output_queue_file);

        VAR
          alias_pt: ^nft$alias,
          connection: ^nft$connection,
          io_station: ^nft$io_station,
          station_list: ^nft$pointer_list_entry;

        q_pointer_found := FALSE;
        IF q_file^.ios_usage <> nfc$ntf_remote_system THEN
          alias_pt := scfs_tables.first_station_name_alias;
        ELSE
          alias_pt := scfs_tables.first_ntf_acc_remote_system;
        IFEND;

        WHILE (NOT q_pointer_found) AND (alias_pt <> NIL) DO
          CASE q_file^.ios_usage OF
          = nfc$public_io_station, nfc$ntf_remote_system =
            q_pointer_found := q_file^.ios_name = alias_pt^.name;

          = nfc$private_io_station =
            station_list := alias_pt^.station_list;
            io_station := station_list^.io_station;
            IF io_station^.operator_assigned THEN
              connection := io_station^.connected_operator;
              q_pointer_found := (q_file^.operator_name = connection^.user) AND (q_file^.operator_family =
                    connection^.family) AND (io_station^.usage = nfc$private_io_station);
            IFEND;
          CASEND;
          IF q_pointer_found THEN
            q_pointer := ^alias_pt^.queue;
          ELSE
            alias_pt := alias_pt^.link;
          IFEND;
        WHILEND;

        IF (q_file^.ios_usage = nfc$private_io_station) AND
              (NOT q_pointer_found) AND (q_file =
              scfs_tables.unknown_private_operators_q) THEN
          q_pointer := ^scfs_tables.unknown_private_operators_q;
          q_pointer_found := TRUE;
       IFEND;

      PROCEND get_pointer_to_q;
?? OLDTITLE, EJECT ??
      pointer_to_q := NIL;
      current_file := connection^.scfve_queue;
      WHILE current_file <> NIL DO
        selected_file := NIL;
        file_was_not_in_selected_q := TRUE;
        IF current_file^.ios_usage <> nfc$ntf_remote_system THEN
          find_station_and_selected_file (current_file^.system_file_name, io_station,
                selected_file);
          file_was_not_in_selected_q := (selected_file = NIL);
          IF selected_file <> NIL THEN
            remove_selected_file (io_station, selected_file);
          IFEND;
        IFEND;

        IF file_was_not_in_selected_q THEN
          back_link := current_file^.back_link;
          link := current_file^.link;

          IF current_file^.back_link = NIL THEN
            get_pointer_to_q (current_file, pointer_to_q_found, pointer_to_q);
            IF pointer_to_q_found THEN
              pointer_to_q^ := current_file^.link;
            IFEND;
            IF link <> NIL THEN
              link^.back_link := NIL;
            IFEND;
          ELSE
            back_link^.link := current_file^.link;
            IF link <> NIL THEN
              link^.back_link := current_file^.back_link;
            IFEND;
          IFEND;
        IFEND;

        device := current_file^.assigned_device;
        IF device <> NIL THEN
          device^.current_file := NIL;
        IFEND;

        prior_ve_client_file := current_file;
        current_file := current_file^.next_scfve_queue;

        FREE prior_ve_client_file;
      WHILEND;

    PROCEND remove_ve_client_queue_files;
?? OLDTITLE, EJECT ??

    current_connection := wait_connection_list^ [connection_index];

    delete_connection_from_tables (current_connection);
    remove_from_wait_lists (connection_index, wait_list, wait_connection_list);
    IF scfs_event_logging THEN
      log_terminated_connection (current_connection^);
    IFEND;

    CASE current_connection^.kind OF
    = nfc$scfdi_connection =
      io_station := scfs_tables.first_io_station;
      WHILE io_station <> NIL DO
        find_connection_in_io_station (io_station, current_connection, connection_found);
        IF connection_found THEN
          next_io_station := io_station^.link;
          delete_io_station (current_connection, io_station, message, wait_list,
                wait_connection_list, status);
          io_station := next_io_station;
        ELSE
          io_station := io_station^.link;
        IFEND;
      WHILEND;

      io_station := scfs_tables.first_ntf_remote_system;
      WHILE io_station <> NIL DO
        next_io_station := io_station^.link;
        delete_ntf_remote_system (io_station, current_connection, FALSE, 1);
        io_station := next_io_station;
      WHILEND;

      delete_all_unreachable_btfs_di (current_connection^.btfs_di_title);

    = nfc$scfve_connection, nfc$ntfve_connection =
      remove_ve_client_queue_files (current_connection);
      clear_unreachable_btfs_di_list (current_connection);

    = nfc$operator_connection, nfc$ntf_operator_connection =
      IF current_connection^.operating_station <> NIL THEN
        clean_up_operated_station (current_connection, message, status);
      IFEND;

      IF current_connection^.kind = nfc$ntf_operator_connection THEN
        IF current_connection^.next_ntf_operator <> NIL THEN
          ntf_operator := current_connection^.next_ntf_operator;
          ntf_operator^.prior_ntf_operator := current_connection^.prior_ntf_operator;
        IFEND;

        IF current_connection^.prior_ntf_operator <> NIL THEN
          ntf_operator := current_connection^.prior_ntf_operator;
          ntf_operator^.next_ntf_operator := current_connection^.next_ntf_operator;
        ELSE
          scfs_tables.first_ntf_operator := current_connection^.next_ntf_operator;
        IFEND;
      IFEND;
    ELSE
      ;
    CASEND;

    bap$validate_file_identifier (current_connection^.id, file_instance, file_id_is_valid);
    IF file_id_is_valid THEN
      file_name := file_instance^.local_file_name;
      fsp$close_file (current_connection^.id, status);
      amp$return (file_name, ignore_status);
    IFEND;

    FREE current_connection;

  PROCEND remove_connection_from_list;
?? TITLE := 'remove from wait lists', EJECT ??

  PROCEDURE remove_from_wait_lists
    (    index: integer;
     VAR wait_list: ^ost$i_wait_list;
     VAR wait_connection_list: ^nft$wait_connection_list);

    VAR
      last_index: integer;

    last_index := UPPERBOUND (wait_list^);
    IF (last_index >= 3) AND (last_index <> index) THEN
      wait_list^ [index] := wait_list^ [last_index];
      wait_connection_list^ [index] := wait_connection_list^ [last_index];
      wait_connection_list^ [index]^.wait_list_index := index;
    IFEND;

    RESET wait_list_seq;
    NEXT wait_list: [1 .. (last_index - 1)] IN wait_list_seq;

    RESET wait_connection_list_seq;
    NEXT wait_connection_list: [wait_connection_list_lowest .. (last_index - 1)] IN wait_connection_list_seq;

  PROCEND remove_from_wait_lists;
?? TITLE := 'remove_selected_file', EJECT ??

  PROCEDURE remove_selected_file
    (    io_station: ^nft$io_station;
     VAR selected_file: ^nft$selected_file);

    VAR
      back_link: ^nft$selected_file,
      link: ^nft$selected_file,
      top_selected_file_in_q: ^nft$selected_file;

    IF selected_file = io_station^.selected_files_queue THEN
      io_station^.selected_files_queue := selected_file^.link;
      IF io_station^.selected_files_queue <> NIL THEN
        top_selected_file_in_q := io_station^.selected_files_queue;
        top_selected_file_in_q^.back_link := NIL;
      IFEND;
    ELSE
      back_link := selected_file^.back_link;
      back_link^.link := selected_file^.link;

      IF selected_file^.link <> NIL THEN
        link := selected_file^.link;
        link^.back_link := selected_file^.back_link;
      IFEND;
    IFEND;

    IF selected_file = io_station^.last_selected_file_in_q THEN
      io_station^.last_selected_file_in_q := selected_file^.back_link;
    IFEND;

    FREE selected_file;

  PROCEND remove_selected_file;
?? TITLE := 'search_alias_list_for_file_name', EJECT ??

  PROCEDURE search_alias_list_for_file_name
    (    io_station: ^nft$io_station;
         file_name: ost$name;
     VAR matching_alias_entry: ^nft$alias;
     VAR matching_q_file: ^nft$output_queue_file;
     VAR duplicate_file_name: boolean);

    VAR
      alias_entry: ^nft$alias,
      file_found: boolean,
      file_match: boolean,
      index: 0 .. 4,
      local_status: ost$status,
      more_aliases: boolean,
      ntf_acc_remote_system_ptr: ^nft$pointer_list_entry,
      q_file: ^nft$output_queue_file;

    duplicate_file_name := FALSE;
    file_found := FALSE;
    file_match := FALSE;
    index := 0;

    q_file := NIL;
    matching_q_file := NIL;
    matching_alias_entry := NIL;
    IF io_station^.usage <> nfc$ntf_remote_system THEN
      more_aliases := TRUE;
    ELSE
      ntf_acc_remote_system_ptr := io_station^.ntf_acc_remote_system_ptr_list;
      more_aliases := ntf_acc_remote_system_ptr <> NIL;
    IFEND;

  /search_alias_list/
    WHILE more_aliases AND (NOT duplicate_file_name) DO
      IF io_station^.usage <> nfc$ntf_remote_system THEN
        alias_entry := io_station^.alias_list [index];
      ELSE
        alias_entry := ntf_acc_remote_system_ptr^.ntf_acc_remote_system;
      IFEND;

      IF (alias_entry <> NIL) AND (alias_entry^.queue <> NIL) THEN
        q_file := alias_entry^.queue;

      /search_queue_file_list/
        WHILE (q_file <> NIL) AND (NOT duplicate_file_name) DO

          file_match := (file_name = q_file^.system_file_name) OR
                (file_name = q_file^.user_file_name);
          IF file_match THEN

{ The following logic causes MATCHING_Q_FILE and MATCHING_ALIAS_ENTRY to be set once and only once.

            duplicate_file_name := file_found AND file_match;
            IF (NOT duplicate_file_name) THEN
              file_found := file_match;
              matching_q_file := q_file;
              matching_alias_entry := alias_entry;
            IFEND;
          IFEND;

          IF NOT duplicate_file_name THEN
            q_file := q_file^.link;
          IFEND;
        WHILEND /search_queue_file_list/;
      IFEND;

      IF io_station^.usage <> nfc$ntf_remote_system THEN
        index := index + 1;
        more_aliases := index <= 3;
      ELSE
        ntf_acc_remote_system_ptr := ntf_acc_remote_system_ptr^.link;
        more_aliases := ntf_acc_remote_system_ptr <> NIL;
      IFEND;
    WHILEND /search_alias_list/;

    IF duplicate_file_name THEN
      matching_q_file := NIL;
    IFEND;

  PROCEND search_alias_list_for_file_name;
?? TITLE := 'search_selected_q_for_file', EJECT ??

  PROCEDURE search_selected_q_for_file
    (    io_station: ^nft$io_station;
         file_name: ost$name;
     VAR q_file: ^nft$output_queue_file;
     VAR selected_file: ^nft$selected_file;
     VAR file_in_selected_q: boolean;
     VAR duplicate_file_name: boolean);

    VAR
      file_match: boolean,
      selected_queue_file: ^nft$selected_file;

    duplicate_file_name := FALSE;
    file_in_selected_q := FALSE;
    file_match := FALSE;
    q_file := NIL;
    selected_file := NIL;

    selected_queue_file := io_station^.selected_files_queue;
    WHILE selected_queue_file <> NIL DO
      q_file := selected_queue_file^.output_file;
      file_match := (file_name = q_file^.system_file_name) OR
            (file_name = q_file^.user_file_name);
      IF file_match THEN
        duplicate_file_name := file_in_selected_q AND file_match;
        IF (NOT duplicate_file_name) THEN
          file_in_selected_q := file_match;
          selected_file := selected_queue_file;
        IFEND;
      IFEND;
      selected_queue_file := selected_queue_file^.link;
    WHILEND;

    IF file_in_selected_q AND (NOT duplicate_file_name) THEN
      q_file := selected_file^.output_file;
    ELSEIF duplicate_file_name THEN
      selected_file := NIL;
    IFEND;

  PROCEND search_selected_q_for_file;
?? TITLE := 'select file message msg', EJECT ??

{  PURPOSE:
{    This procedure is executed when a request is received from OPES to
{    select an output file for immediate processing.  If a device name is
{    specified, the output file is forced to that device.  The select file
{    message is rejected if the station, device or file is unknown, if the file
{    is already printing, if there is more than one file with that name in the
{    queue, or if the device is an input device.  If there are no devices
{    currently available for printing of files, the priority of the queue
{    file entry is raised to the maximum priority value.  If SCFS is able
{    to assign the file to a device, a file assignment message is sent to SCF/VE.
{
{    This procedure is also executed when a request is received from OPENTF to
{    select an NTF file for immediate processing.  If a batch stream name is
{    specified, the NTF file is forced to that stream.  The select file message
{    is rejected if the remote system, batch stream or file is unknown, if the
{    file is already being transferred, if there is more than one file with
{    that name in the queue, or if the stream is an input stream.  If there are
{    no streams currently available for transferring of files, the priority of
{    the queue file entry is raised to the maximum priority value.  If SCFS is
{    able to assign the file to a stream, a file assignment message is sent to
{    NTF/VE.

  PROCEDURE select_file_msg
    (VAR message: ^nft$message_sequence;
         connection: ^nft$connection;
     VAR msg_length: integer;
     VAR status: ost$status);

    VAR
      alias_entry: ^nft$alias,
      device: ^nft$batch_device,
      device_found: boolean,
      device_alias_found: boolean,
      device_name: ost$name,
      duplicate_file_name: boolean,
      fake_station: nft$io_station,
      file_in_selected_q: boolean,
      file_name: ost$name,
      i: 0 .. 3,
      io_station: ^nft$io_station,
      io_station_found: boolean,
      io_station_name: ost$name,
      q_file: ^nft$output_queue_file,
      response_code: nft$select_file_response,
      scfve_connection: ^nft$connection,
      selected_file: ^nft$selected_file,
      unable_to_assign_file: boolean;

?? NEWTITLE := 'assign file to device', EJECT ??

    PROCEDURE assign_file_to_device
      (    q_file: ^nft$output_queue_file;
           io_station: ^nft$io_station;
       VAR message: ^nft$message_sequence;
           connection: ^nft$connection;
       VAR status: ost$status);

      VAR
        device: ^nft$batch_device,
        device_found: boolean,
        signed_on: boolean;

      device_found := FALSE;

      device := io_station^.batch_device_list;
      WHILE NOT device_found AND (device <> NIL) DO
        IF io_station^.usage = nfc$ntf_remote_system THEN
          check_for_ntf_signed_on_stream (io_station, device, signed_on);
        ELSE
          signed_on := TRUE;
        IFEND;

        IF ((q_file^.device_name = osc$null_name) OR (q_file^.device_name = automatic) OR (q_file^.device_name
              = device^.name) OR (q_file^.device_name = device^.alias_names [1]) OR (q_file^.device_name =
              device^.alias_names [2]) OR (q_file^.device_name = device^.alias_names [3])) AND signed_on THEN
          IF device_available_for_output (device) THEN
            device_found := file_and_device_match (q_file, device);
            IF device_found THEN
              q_file^.output_state := nfc$selected_for_transfer;
              q_file^.assigned_device := device;
              device^.current_file := q_file;
            IFEND;
          IFEND;
        IFEND;
        IF NOT device_found THEN
          device := device^.link;
        IFEND;
      WHILEND;

      IF device_found THEN
        send_file_assignment_msg (message, io_station^.name, q_file^, device, connection,
              status);
      ELSE
        status.normal := FALSE;
      IFEND;

    PROCEND assign_file_to_device;
?? TITLE := 'assign file to device alias', EJECT ??

    PROCEDURE assign_file_to_device_alias
      (    q_file: ^nft$output_queue_file;
           alias_name: ost$name;
           io_station: ^nft$io_station;
       VAR message: ^nft$message_sequence;
           connection: ^nft$connection;
       VAR status: ost$status);

      VAR
        device: ^nft$batch_device,
        device_found: boolean;

      device_found := FALSE;

      device := io_station^.batch_device_list;
      WHILE NOT device_found AND (device <> NIL) DO
        IF (alias_name = device^.name) OR (q_file^.device_name = device^.alias_names [1]) OR (q_file^.
              device_name = device^.alias_names [2]) OR (q_file^.device_name = device^.alias_names [3]) THEN
          device_found := device_available_for_output (device);
          IF device_found THEN
            q_file^.output_state := nfc$selected_for_transfer;
            q_file^.assigned_device := device;
            device^.current_file := q_file;
          IFEND;
        IFEND;
        IF NOT device_found THEN
          device := device^.link;
        IFEND;
      WHILEND;

      IF device_found THEN
        send_file_assignment_msg (message, io_station^.name, q_file^, device, connection,
              status);
      ELSE
        status.normal := FALSE;
      IFEND;

    PROCEND assign_file_to_device_alias;
?? TITLE := 'crack select file msg', EJECT ??

    PROCEDURE crack_select_file_msg
      (VAR message: ^nft$message_sequence;
       VAR msg_length: integer;
       VAR io_station_name: ost$name;
       VAR file_name: ost$name;
       VAR device_name: ost$name;
       VAR status: ost$status);

      VAR
        ascii_string: ^string ( * <= osc$max_name_size),
        byte_array: ^nft$byte_array,
        parameter: ^nft$select_file_parameter,
        value_length: integer;

*copyc nft$select_file_msg

      NEXT parameter IN message;

      WHILE (parameter <> NIL) AND (parameter^.param <> nfc$null_parameter) AND (msg_length > 0) DO
        msg_length := msg_length - 1;
        IF parameter^.length_indicated THEN
          nfp$get_parameter_value_length (message, msg_length, value_length, status);
          msg_length := msg_length - value_length;
        ELSE
          value_length := 1;
          msg_length := msg_length - 1;
        IFEND;

        CASE parameter^.param OF
        = nfc$io_station_name =
          NEXT ascii_string: [value_length] IN message;
          #translate (osv$lower_to_upper, ascii_string^, io_station_name);

        = nfc$system_file_name =
          NEXT ascii_string: [value_length] IN message;
          #translate (osv$lower_to_upper, ascii_string^, file_name);

        = nfc$device_name =
          NEXT ascii_string: [value_length] IN message;
          #translate (osv$lower_to_upper, ascii_string^, device_name);

        ELSE
{         ERROR ----   Ignore parameter value.
          NEXT byte_array: [1 .. value_length] IN message;

        CASEND;
        NEXT parameter IN message;
      WHILEND;

    PROCEND crack_select_file_msg;
?? TITLE := 'find device alias name', EJECT ??

    PROCEDURE find_device_alias_name
      (    device_name: ost$name;
           io_station: ^nft$io_station;
       VAR device_alias_found: boolean);

      VAR
        device: ^nft$batch_device;

      device_alias_found := FALSE;
      device := io_station^.batch_device_list;
      WHILE (NOT device_alias_found) AND (device <> NIL) DO
        device_alias_found := (device_name = device^.name) OR (device_name = device^.alias_names [1]) OR
              (device_name = device^.alias_names [2]) OR (device_name = device^.alias_names[3]);
        IF NOT device_alias_found THEN
          device := device^.link;
        IFEND;
      WHILEND;

    PROCEND find_device_alias_name;
?? TITLE := 'move_file_to_selected_queue', EJECT ??

    PROCEDURE move_file_to_selected_queue
      (    q_file: ^nft$output_queue_file;
           device_name: ost$name;
           alias_entry: ^nft$alias,
           io_station: ^nft$io_station);

      VAR
        back_link_q_file: ^nft$output_queue_file,
        last_selected: ^nft$selected_file,
        link_q_file: ^nft$output_queue_file,
        selected_file: ^nft$selected_file;

      ALLOCATE selected_file;
      selected_file^.output_file := q_file;
      selected_file^.device_selected := device_name;
      selected_file^.back_link := NIL;
      selected_file^.link := NIL;

      IF io_station^.selected_files_queue = NIL THEN
        io_station^.selected_files_queue := selected_file;
      ELSE
        selected_file^.back_link := io_station^.last_selected_file_in_q;

        last_selected := io_station^.last_selected_file_in_q;
        last_selected^.link := selected_file;
      IFEND;
      io_station^.last_selected_file_in_q := selected_file;

      IF q_file = alias_entry^.queue THEN
        alias_entry^.queue := q_file^.link;

        IF q_file^.link <> NIL THEN
          link_q_file := q_file^.link;
          link_q_file^.back_link := q_file^.back_link;
        IFEND;
      ELSE
        IF q_file^.back_link <> NIL THEN
          back_link_q_file := q_file^.back_link;
          back_link_q_file^.link := q_file^.link;
        IFEND;

        IF q_file^.link <> NIL THEN
          link_q_file := q_file^.link;
          link_q_file^.back_link := q_file^.back_link;
        IFEND;
      IFEND;

      q_file^.back_link := NIL;
      q_file^.link := NIL;

    PROCEND move_file_to_selected_queue;
?? TITLE := 'move file to top of queue', EJECT ??

    PROCEDURE move_file_to_top_of_queue
      (    alias_entry: ^nft$alias,
           q_file: ^nft$output_queue_file);

      VAR
        back_link_q_file: ^nft$output_queue_file,
        link_q_file: ^nft$output_queue_file,
        top_q_file: ^nft$output_queue_file;

      top_q_file := alias_entry^.queue;
      IF q_file <> top_q_file THEN
        IF q_file^.back_link <> NIL THEN
          back_link_q_file := q_file^.back_link;
          back_link_q_file^.link := q_file^.link;
        IFEND;

        IF q_file^.link <> NIL THEN
          link_q_file := q_file^.link;
          link_q_file^.back_link := q_file^.back_link;
        IFEND;

        q_file^.back_link := NIL;
        q_file^.link := alias_entry^.queue;

        alias_entry^.queue := q_file;
        top_q_file^.back_link := alias_entry^.queue;
      IFEND;

    PROCEND move_file_to_top_of_queue;
?? TITLE := 'move_file_to_top_of_selected_q', EJECT ??

    PROCEDURE move_file_to_top_of_selected_q
      (    selected_q_file: ^nft$selected_file;
           device_name: ost$name;
           io_station: ^nft$io_station);

      VAR
        back_link_q_file: ^nft$selected_file,
        link_q_file: ^nft$selected_file,
        top_of_selected_queue: ^nft$selected_file;

      top_of_selected_queue := io_station^.selected_files_queue;
      IF selected_q_file <> top_of_selected_queue THEN
        IF selected_q_file^.back_link  <> NIL THEN
          back_link_q_file := selected_q_file^.back_link;
          back_link_q_file^.link := selected_q_file^.link;
        IFEND;

        IF selected_q_file^.link  <> NIL THEN
          link_q_file := selected_q_file^.link;
          link_q_file^.back_link := selected_q_file^.back_link;
        IFEND;

        IF selected_q_file = io_station^.last_selected_file_in_q THEN
          io_station^.last_selected_file_in_q := selected_q_file^.back_link;
        IFEND;

        selected_q_file^.back_link := NIL;
        selected_q_file^.link := io_station^.selected_files_queue;
        top_of_selected_queue^.back_link := selected_q_file;
        io_station^.selected_files_queue := selected_q_file;
      IFEND;

    PROCEND move_file_to_top_of_selected_q ;
?? OLDTITLE, EJECT ??
    device_name := osc$null_name;

    crack_select_file_msg (message, msg_length, io_station_name, file_name, device_name, status);

    response_code := nfc$self_msg_accepted;

    find_io_station_or_remote_sys (io_station_name, connection, io_station, io_station_found);
    IF (NOT io_station_found) AND (connection^.kind = nfc$ntf_operator_connection) THEN
      create_fake_io_station_for_ntf (io_station_name, fake_station, io_station_found);
      io_station := ^fake_station;
    IFEND;

    IF NOT io_station_found THEN
      response_code := nfc$self_msg_unknown_ios;
    ELSE
      IF connection^.kind <> nfc$ntf_operator_connection THEN
        search_selected_q_for_file (io_station, file_name, q_file, selected_file,
              file_in_selected_q, duplicate_file_name);
      ELSE
        file_in_selected_q := FALSE;
      IFEND;
      IF NOT file_in_selected_q THEN
        search_alias_list_for_file_name (io_station, file_name,
              alias_entry, q_file, duplicate_file_name);
      IFEND;

      unable_to_assign_file := FALSE;
      IF duplicate_file_name THEN
        response_code := nfc$self_duplicate_file_name;
      ELSEIF q_file = NIL THEN
        response_code := nfc$self_msg_unknown_file;
      ELSEIF q_file^.output_state = nfc$selected_for_transfer THEN
        response_code := nfc$self_file_already_printing;
      ELSEIF device_name <> osc$null_name THEN
        scfve_connection := q_file^.scfve_connection;
        find_batch_device (device_name, io_station, device, device_found);
        IF NOT device_found THEN
          find_device_alias_name (device_name, io_station, device_alias_found);
          IF NOT device_alias_found THEN
            response_code := nfc$self_msg_unknown_device;
          ELSE
            assign_file_to_device_alias (q_file, device_name, io_station, message,
                  scfve_connection, status);
            IF NOT status.normal THEN
              status.normal := TRUE;
              unable_to_assign_file := TRUE;
            IFEND;
          IFEND;
        ELSEIF device_available_for_output (device) THEN
          device^.current_file := q_file;
          q_file^.output_state := nfc$selected_for_transfer;
          q_file^.assigned_device := device;
          send_file_assignment_msg (message, io_station^.name, q_file^, device, scfve_connection,
                status);
        ELSE
          IF input_device_or_stream (device) THEN
            response_code := nfc$self_wrong_device_type;
          ELSE
            unable_to_assign_file := TRUE;
          IFEND;
        IFEND;
      ELSE
        scfve_connection := q_file^.scfve_connection;
        assign_file_to_device (q_file, io_station, message, scfve_connection, status);
        IF NOT status.normal THEN
          status.normal := TRUE;
          unable_to_assign_file := TRUE;
        IFEND;
      IFEND;
    IFEND;

    IF unable_to_assign_file AND (response_code = nfc$self_msg_accepted) THEN
      q_file^.output_state := nfc$eligible_for_transfer;
      IF connection^.kind = nfc$ntf_operator_connection THEN
        q_file^.initial_priority := nfc$maximum_priority;
        q_file^.device_name := device_name;
        move_file_to_top_of_queue (alias_entry, q_file);
      ELSEIF file_in_selected_q THEN
        move_file_to_top_of_selected_q (selected_file, device_name, io_station);
      ELSE
        move_file_to_selected_queue (q_file, device_name, alias_entry, io_station);
      IFEND;
    IFEND;

    send_select_file_response_msg (message, io_station_name, device_name, file_name, response_code,
          connection, status);

  PROCEND select_file_msg;
?? TITLE := 'send delete destination msg', EJECT ??

{  PURPOSE:
{    This procedure sends a message to SCF/VE when an I/O station or alias
{    has been deleted from the control facility.  SCF/VE should not send
{    file availability messages to this SCFS until the destination returns.

  PROCEDURE send_delete_destination_msg
    (VAR message: ^nft$message_sequence;
         destination: ost$name;
         control_facility: ost$name;
         connection: ^nft$connection;
     VAR status: ost$status);

    VAR
      ascii_string: ^string ( * <= osc$max_name_size),
      message_length: nft$message_length,
      message_type: ^nft$message_kind,
      parameter_kind: ^nft$delete_destination_param,
      parameter_kind_size: nft$message_length,
      param_length_size: nft$message_length,
      parameter_value_length: integer;

*copy nft$delete_destination_msg

    parameter_kind_size := #SIZE (nft$delete_destination_param);
    RESET message;

    NEXT message_type IN message;
    message_type^ := nfc$delete_destination;
    message_length := 1;

    NEXT parameter_kind IN message;
    parameter_kind^.param := nfc$destination_name;
    parameter_value_length := clp$trimmed_string_size (destination);
    nfp$modify_param_value_length (parameter_value_length);
    parameter_kind^.length_indicated := parameter_value_length > 1;
    IF parameter_kind^.length_indicated THEN
      nfp$put_parameter_value_length (parameter_value_length, message, param_length_size, status);
    ELSE
      param_length_size := 0;
    IFEND;
    NEXT ascii_string: [parameter_value_length] IN message;
    ascii_string^ := destination (1, parameter_value_length);
    message_length := message_length + parameter_kind_size + param_length_size + parameter_value_length;

    NEXT parameter_kind IN message;
    parameter_kind^.param := nfc$control_facility_name;
    parameter_value_length := clp$trimmed_string_size (control_facility);
    nfp$modify_param_value_length (parameter_value_length);
    parameter_kind^.length_indicated := parameter_value_length > 1;
    IF parameter_kind^.length_indicated THEN
      nfp$put_parameter_value_length (parameter_value_length, message, param_length_size, status);
    ELSE
      param_length_size := 0;
    IFEND;
    NEXT ascii_string: [parameter_value_length] IN message;
    ascii_string^ := control_facility (1, parameter_value_length);
    message_length := message_length + parameter_kind_size + param_length_size + parameter_value_length;

    NEXT parameter_kind IN message;
    parameter_kind^.length_indicated := FALSE;
    parameter_kind^.param := nfc$null_parameter;
    message_length := message_length + parameter_kind_size;

    nfp$send_message_on_connection (message, message_length, connection^.id, status);
    IF scfs_event_logging THEN
      log_connection_message (connection^, message_length, message);
    IFEND;

  PROCEND send_delete_destination_msg;
?? TITLE := 'send device control response', EJECT ??

{  PURPOSE:
{    This procedure builds/sends a message to OPES indicating the response to
{    the following operate station commands:
{      -  change_batch_device_attributes
{      -  position_file
{      -  start_batch_device
{      -  stop_batch_device
{      -  suppress_carraige_control
{      -  terminate_transfer
{
{    This procedure also builds/sends a message to OPENTF indicating the
{    response to the following operate NTF commands:
{      -  change_batch_stream_attributes
{      -  start_batch_stream
{      -  stop_batch_stream
{      -  terminate_transfer

  PROCEDURE send_device_control_response
    (VAR message: ^nft$message_sequence;
         msg_kind: nft$message_kind;
         io_station: ost$name;
         device: ost$name;
         response: nft$device_control_resp_codes;
         connection: ^nft$connection;
     VAR status: ost$status);

    VAR
      ascii_string: ^string ( * <= osc$max_name_size),
      message_length: nft$message_length,
      message_type: ^nft$message_kind,
      parameter_kind: ^nft$device_control_resp_param,
      parameter_kind_size: nft$message_length,
      param_length_size: nft$message_length,
      parameter_value_length: integer,
      response_code: ^nft$device_control_resp_codes;

*copy nft$device_control_resp_msg

    parameter_kind_size := #SIZE (nft$device_control_resp_param);
    RESET message;

    NEXT message_type IN message;
    message_type^ := msg_kind;
    message_length := 1;

    NEXT parameter_kind IN message;
    parameter_kind^.param := nfc$io_station_name;
    parameter_value_length := clp$trimmed_string_size (io_station);
    nfp$modify_param_value_length (parameter_value_length);
    parameter_kind^.length_indicated := parameter_value_length > 1;
    IF parameter_kind^.length_indicated THEN
      nfp$put_parameter_value_length (parameter_value_length, message, param_length_size, status);
    ELSE
      param_length_size := 0;
    IFEND;
    NEXT ascii_string: [parameter_value_length] IN message;
    ascii_string^ := io_station (1, parameter_value_length);
    message_length := message_length + parameter_kind_size + param_length_size + parameter_value_length;

    NEXT parameter_kind IN message;
    parameter_kind^.param := nfc$device_name;
    parameter_value_length := clp$trimmed_string_size (device);
    nfp$modify_param_value_length (parameter_value_length);
    parameter_kind^.length_indicated := parameter_value_length > 1;
    IF parameter_kind^.length_indicated THEN
      nfp$put_parameter_value_length (parameter_value_length, message, param_length_size, status);
    ELSE
      param_length_size := 0;
    IFEND;
    NEXT ascii_string: [parameter_value_length] IN message;
    ascii_string^ := device (1, parameter_value_length);
    message_length := message_length + parameter_kind_size + param_length_size + parameter_value_length;

    NEXT parameter_kind IN message;
    parameter_kind^.length_indicated := FALSE;
    parameter_kind^.param := nfc$response_code;
    NEXT response_code IN message;
    response_code^ := response;
    message_length := message_length + parameter_kind_size + 1;

    NEXT parameter_kind IN message;
    parameter_kind^.length_indicated := FALSE;
    parameter_kind^.param := nfc$null_parameter;
    message_length := message_length + parameter_kind_size;

    nfp$send_message_on_connection (message, message_length, connection^.id, status);
    IF scfs_event_logging THEN
      log_connection_message (connection^, message_length, message);
    IFEND;

  PROCEND send_device_control_response;
?? TITLE := 'send device status msg', EJECT ??

{  PURPOSE:
{    This procedure builds/sends a message to OPES containing the device
{    status information.  Information is sent to OPES based on device type.
{
{    This procedure also builds/sends a message to OPENTF containing the batch
{    stream status information.  Information is sent to OPENTF based on stream
{    type.

  PROCEDURE send_device_status_msg
    (VAR message: ^nft$message_sequence;
         response: nft$display_status_resp_codes;
         io_station: ^nft$io_station;
         desired_device: ^nft$batch_device;
         connection: ^nft$connection;
         optimize: boolean;
     VAR status: ost$status);

    VAR
      ascii_string: ^string ( * <= osc$max_name_size),
      banner_page_count: ^nft$banner_page_count,
      banner_highlight_field: ^nft$banner_highlight_field,
      bytes_transferred: ^nft$input_job_size,
      carriage_control_action: ^nft$carriage_control_action,
      code_set: ^nft$code_set,
      destination_name: ost$name,
      device: ^nft$batch_device,
      device_status: ^nft$device_status,
      device_type: ^nft$device_type,
      file_ack: ^boolean,
      file_transfer_status: ^nft$file_transfer_status,
      forms_size: ^nft$forms_size,
      maximum_file_size: ^nft$device_file_size,
      message_length: nft$message_length,
      message_type: ^nft$message_kind,
      ntf_logical_line_number: ^nft$ntf_logical_line_number,
      ntf_remote_system: ^nft$io_station,
      ntf_skip_punch_count: ^nft$ntf_skip_punch_count,
      transparent_mode: ^boolean,
      page_width: ^nft$page_width,
      page_length: ^nft$page_length,
      parameter_kind: ^nft$device_sd_msg_param,
      parameter_kind_size: nft$message_length,
      param_length_size: nft$message_length,
      parameter_value_length: integer,
      percent_complete: ^nft$file_position,
      q_file: ^nft$output_queue_file,
      response_code: ^nft$display_status_resp_codes,
      suppress_carriage_control: ^nft$suppress_carriage_control,
      transmission_block_size: ^nft$transmit_block_size,
      undefined_fe_action: ^nft$format_effector_actions,
      unsupported_fe_action: ^nft$format_effector_actions,
      vfu_load_option: ^nft$vfu_load_option,
      vertical_print_density: ^nft$vertical_print_density;

*copyc nft$device_status_data_msg

    parameter_kind_size := #SIZE (nft$device_sd_msg_param);
    RESET message;

    IF optimize THEN
      device := io_station^.batch_device_list;
    ELSE
      device := desired_device;
    IFEND;

    NEXT message_type IN message;
    message_type^ := nfc$device_status_data;
    message_length := 1;

    NEXT parameter_kind IN message;
    parameter_kind^.param := nfc$io_station_name;
    parameter_value_length := clp$trimmed_string_size (io_station^.name);
    nfp$modify_param_value_length (parameter_value_length);
    parameter_kind^.length_indicated := parameter_value_length > 1;
    IF parameter_kind^.length_indicated THEN
      nfp$put_parameter_value_length (parameter_value_length, message, param_length_size, status);
    ELSE
      param_length_size := 0;
    IFEND;
    NEXT ascii_string: [parameter_value_length] IN message;
    ascii_string^ := io_station^.name (1, parameter_value_length);
    message_length := message_length + parameter_kind_size + param_length_size + parameter_value_length;

    NEXT parameter_kind IN message;
    parameter_kind^.length_indicated := FALSE;
    parameter_kind^.param := nfc$response_code;
    NEXT response_code IN message;
    IF (device <> NIL) THEN
      response_code^ := response;
    ELSE
      response_code^ := nfc$disp_no_batch_device;
    IFEND;
    message_length := message_length + parameter_kind_size + 1;

    REPEAT
      IF (device <> NIL) THEN
        NEXT parameter_kind IN message;
        parameter_kind^.param := nfc$device_name;
        parameter_value_length := clp$trimmed_string_size (device^.name);
        parameter_value_length := clp$trimmed_string_size (device^.name);
        nfp$modify_param_value_length (parameter_value_length);
        parameter_kind^.length_indicated := parameter_value_length > 1;
        IF parameter_kind^.length_indicated THEN
          nfp$put_parameter_value_length (parameter_value_length, message, param_length_size, status);
        ELSE
          param_length_size := 0;
        IFEND;
        NEXT ascii_string: [parameter_value_length] IN message;
        ascii_string^ := device^.name (1, parameter_value_length);
        message_length := message_length + parameter_kind_size + param_length_size +
              parameter_value_length;
      IFEND;

      IF response_code^ = nfc$disp_msg_accepted THEN
        NEXT parameter_kind IN message;
        parameter_kind^.length_indicated := FALSE;
        parameter_kind^.param := nfc$device_status;
        NEXT device_status IN message;
        device_status^ := device^.device_status;
        message_length := message_length + parameter_kind_size + 1;

        NEXT parameter_kind IN message;
        parameter_kind^.length_indicated := FALSE;
        parameter_kind^.param := nfc$device_type;
        NEXT device_type IN message;
        device_type^ := device^.device_type;
        message_length := message_length + parameter_kind_size + 1;

        NEXT parameter_kind IN message;
        parameter_kind^.length_indicated := FALSE;
        parameter_kind^.param := nfc$file_transfer_status_param;
        NEXT file_transfer_status IN message;
        file_transfer_status^ := device^.file_transfer_status;
        message_length := message_length + parameter_kind_size + 1;

        IF device^.terminal_model <> osc$null_name THEN
          NEXT parameter_kind IN message;
          parameter_kind^.param := nfc$terminal_model;
          parameter_value_length := clp$trimmed_string_size (device^.terminal_model);
          parameter_kind^.length_indicated := parameter_value_length > 1;
          IF parameter_kind^.length_indicated THEN
            nfp$put_parameter_value_length (parameter_value_length, message, param_length_size, status);
          ELSE
            param_length_size := 0;
          IFEND;
          NEXT ascii_string: [parameter_value_length] IN message;
          ascii_string^ := device^.terminal_model (1, parameter_value_length);
          message_length := message_length + parameter_kind_size + param_length_size +
                parameter_value_length;
        IFEND;

        NEXT parameter_kind IN message;
        parameter_kind^.length_indicated := FALSE;
        parameter_kind^.param := nfc$file_acknowledgement;
        NEXT file_ack IN message;
        file_ack^ := device^.file_acknowledgement;
        message_length := message_length + parameter_kind_size + 1;

        IF device^.external_characteristics [1] <> osc$null_name THEN
          NEXT parameter_kind IN message;
          parameter_kind^.param := nfc$external_characteristics_1;
          parameter_value_length := clp$trimmed_string_size (device^.external_characteristics [1]);
          parameter_kind^.length_indicated := parameter_value_length > 1;
          IF parameter_kind^.length_indicated THEN
            nfp$put_parameter_value_length (parameter_value_length, message, param_length_size, status);
          ELSE
            param_length_size := 0;
          IFEND;
          NEXT ascii_string: [parameter_value_length] IN message;
          ascii_string^ := device^.external_characteristics [1] (1, parameter_value_length);
          message_length := message_length + parameter_kind_size + param_length_size +
                parameter_value_length;
        IFEND;

        IF device^.external_characteristics [2] <> osc$null_name THEN
          NEXT parameter_kind IN message;
          parameter_kind^.param := nfc$external_characteristics_2;
          parameter_value_length := clp$trimmed_string_size (device^.external_characteristics [2]);
          parameter_kind^.length_indicated := parameter_value_length > 1;
          IF parameter_kind^.length_indicated THEN
            nfp$put_parameter_value_length (parameter_value_length, message, param_length_size, status);
          ELSE
            param_length_size := 0;
          IFEND;
          NEXT ascii_string: [parameter_value_length] IN message;
          ascii_string^ := device^.external_characteristics [2] (1, parameter_value_length);
          message_length := message_length + parameter_kind_size + param_length_size +
                parameter_value_length;
        IFEND;

        IF device^.external_characteristics [3] <> osc$null_name THEN
          NEXT parameter_kind IN message;
          parameter_kind^.param := nfc$external_characteristics_3;
          parameter_value_length := clp$trimmed_string_size (device^.external_characteristics [3]);
          parameter_kind^.length_indicated := parameter_value_length > 1;
          IF parameter_kind^.length_indicated THEN
            nfp$put_parameter_value_length (parameter_value_length, message, param_length_size, status);
          ELSE
            param_length_size := 0;
          IFEND;
          NEXT ascii_string: [parameter_value_length] IN message;
          ascii_string^ := device^.external_characteristics [3] (1, parameter_value_length);
          message_length := message_length + parameter_kind_size + param_length_size +
                parameter_value_length;
        IFEND;

        IF device^.external_characteristics [4] <> osc$null_name THEN
          NEXT parameter_kind IN message;
          parameter_kind^.param := nfc$external_characteristics_4;
          parameter_value_length := clp$trimmed_string_size (device^.external_characteristics [4]);
          parameter_kind^.length_indicated := parameter_value_length > 1;
          IF parameter_kind^.length_indicated THEN
            nfp$put_parameter_value_length (parameter_value_length, message, param_length_size, status);
          ELSE
            param_length_size := 0;
          IFEND;
          NEXT ascii_string: [parameter_value_length] IN message;
          ascii_string^ := device^.external_characteristics [4] (1, parameter_value_length);
          message_length := message_length + parameter_kind_size + param_length_size +
                parameter_value_length;
        IFEND;

        IF device^.last_unsolicited_msg_length > 0 THEN
          NEXT parameter_kind IN message;
          parameter_kind^.param := nfc$last_unsolicited_msg;
          parameter_value_length := device^.last_unsolicited_msg_length;
          parameter_kind^.length_indicated := parameter_value_length > 1;
          IF parameter_kind^.length_indicated THEN
            nfp$put_parameter_value_length (parameter_value_length, message, param_length_size, status);
          ELSE
            param_length_size := 0;
          IFEND;
          NEXT ascii_string: [parameter_value_length] IN message;
          ascii_string^ := device^.last_unsolicited_msg;
          message_length := message_length + parameter_kind_size + param_length_size +
                parameter_value_length;
        IFEND;

        IF output_device_or_stream (device) THEN
          NEXT parameter_kind IN message;
          parameter_kind^.length_indicated := TRUE;
          parameter_kind^.param := nfc$maximum_file_size;
          parameter_value_length := #SIZE (nft$device_file_size);
          nfp$put_parameter_value_length (parameter_value_length, message, param_length_size, status);
          NEXT maximum_file_size IN message;
          maximum_file_size^ := device^.maximum_file_size;
          message_length := message_length + parameter_kind_size + param_length_size +
                parameter_value_length;

          NEXT parameter_kind IN message;
          parameter_kind^.length_indicated := FALSE;
          parameter_kind^.param := nfc$banner_page_count;
          NEXT banner_page_count IN message;
          banner_page_count^ := device^.banner_page_count;
          message_length := message_length + parameter_kind_size + 1;

          NEXT parameter_kind IN message;
          parameter_kind^.length_indicated := FALSE;
          parameter_kind^.param := nfc$banner_highlight_field;
          NEXT banner_highlight_field IN message;
          banner_highlight_field^ := device^.banner_highlight_field;
          message_length := message_length + parameter_kind_size + 1;

          NEXT parameter_kind IN message;
          parameter_kind^.length_indicated := FALSE;
          parameter_kind^.param := nfc$carriage_control_action;
          NEXT carriage_control_action IN message;
          carriage_control_action^ := device^.carriage_control_action;
          message_length := message_length + parameter_kind_size + 1;

          NEXT parameter_kind IN message;
          parameter_kind^.length_indicated := FALSE;
          parameter_kind^.param := nfc$page_length;
          NEXT page_length IN message;
          page_length^ := device^.page_length;
          message_length := message_length + parameter_kind_size + 1;

          NEXT parameter_kind IN message;
          parameter_kind^.length_indicated := FALSE;
          parameter_kind^.param := nfc$page_width;
          NEXT page_width IN message;
          page_width^ := device^.page_width;
          message_length := message_length + parameter_kind_size + 1;

          NEXT parameter_kind IN message;
          parameter_kind^.length_indicated := TRUE;
          parameter_kind^.param := nfc$transmission_block_size;
          parameter_value_length := #SIZE (nft$transmit_block_size);
          nfp$put_parameter_value_length (parameter_value_length, message, param_length_size, status);
          NEXT transmission_block_size IN message;
          transmission_block_size^ := device^.transmission_block_size;
          message_length := message_length + parameter_kind_size + param_length_size +
                parameter_value_length;

          IF device^.alias_names [1] <> osc$null_name THEN
            NEXT parameter_kind IN message;
            parameter_kind^.param := nfc$device_alias_1;
            parameter_value_length := clp$trimmed_string_size (device^.alias_names [1]);
            parameter_kind^.length_indicated := parameter_value_length > 1;
            IF parameter_kind^.length_indicated THEN
              nfp$put_parameter_value_length (parameter_value_length, message, param_length_size, status);
            ELSE
              param_length_size := 0;
            IFEND;
            NEXT ascii_string: [parameter_value_length] IN message;
            ascii_string^ := device^.alias_names [1] (1, parameter_value_length);
            message_length := message_length + parameter_kind_size + param_length_size +
                  parameter_value_length;
          IFEND;

          IF device^.alias_names [2] <> osc$null_name THEN
            NEXT parameter_kind IN message;
            parameter_kind^.param := nfc$device_alias_2;
            parameter_value_length := clp$trimmed_string_size (device^.alias_names [2]);
            parameter_kind^.length_indicated := parameter_value_length > 1;
            IF parameter_kind^.length_indicated THEN
              nfp$put_parameter_value_length (parameter_value_length, message, param_length_size, status);
            ELSE
              param_length_size := 0;
            IFEND;
            NEXT ascii_string: [parameter_value_length] IN message;
            ascii_string^ := device^.alias_names [2] (1, parameter_value_length);
            message_length := message_length + parameter_kind_size + param_length_size +
                  parameter_value_length;
          IFEND;

          IF device^.alias_names [3] <> osc$null_name THEN
            NEXT parameter_kind IN message;
            parameter_kind^.param := nfc$device_alias_3;
            parameter_value_length := clp$trimmed_string_size (device^.alias_names [3]);
            parameter_kind^.length_indicated := parameter_value_length > 1;
            IF parameter_kind^.length_indicated THEN
              nfp$put_parameter_value_length (parameter_value_length, message, param_length_size, status);
            ELSE
              param_length_size := 0;
            IFEND;
            NEXT ascii_string: [parameter_value_length] IN message;
            ascii_string^ := device^.alias_names [3] (1, parameter_value_length);
            message_length := message_length + parameter_kind_size + param_length_size +
                  parameter_value_length;
          IFEND;

          IF device^.forms_code [1] <> osc$null_name THEN
            NEXT parameter_kind IN message;
            parameter_kind^.param := nfc$forms_code_1;
            parameter_value_length := clp$trimmed_string_size (device^.forms_code [1]);
            parameter_kind^.length_indicated := parameter_value_length > 1;
            IF parameter_kind^.length_indicated THEN
              nfp$put_parameter_value_length (parameter_value_length, message, param_length_size, status);
            ELSE
              param_length_size := 0;
            IFEND;
            NEXT ascii_string: [parameter_value_length] IN message;
            ascii_string^ := device^.forms_code [1] (1, parameter_value_length);
            message_length := message_length + parameter_kind_size + param_length_size +
                  parameter_value_length;
          IFEND;

          IF device^.forms_code [2] <> osc$null_name THEN
            NEXT parameter_kind IN message;
            parameter_kind^.param := nfc$forms_code_2;
            parameter_value_length := clp$trimmed_string_size (device^.forms_code [2]);
            parameter_kind^.length_indicated := parameter_value_length > 1;
            IF parameter_kind^.length_indicated THEN
              nfp$put_parameter_value_length (parameter_value_length, message, param_length_size, status);
            ELSE
              param_length_size := 0;
            IFEND;
            NEXT ascii_string: [parameter_value_length] IN message;
            ascii_string^ := device^.forms_code [2] (1, parameter_value_length);
            message_length := message_length + parameter_kind_size + param_length_size +
                  parameter_value_length;
          IFEND;

          IF device^.forms_code [3] <> osc$null_name THEN
            NEXT parameter_kind IN message;
            parameter_kind^.param := nfc$forms_code_3;
            parameter_value_length := clp$trimmed_string_size (device^.forms_code [3]);
            parameter_kind^.length_indicated := parameter_value_length > 1;
            IF parameter_kind^.length_indicated THEN
              nfp$put_parameter_value_length (parameter_value_length, message, param_length_size, status);
            ELSE
              param_length_size := 0;
            IFEND;
            NEXT ascii_string: [parameter_value_length] IN message;
            ascii_string^ := device^.forms_code [3] (1, parameter_value_length);
            message_length := message_length + parameter_kind_size + param_length_size +
                  parameter_value_length;
          IFEND;

          IF device^.forms_code [4] <> osc$null_name THEN
            NEXT parameter_kind IN message;
            parameter_kind^.param := nfc$forms_code_4;
            parameter_value_length := clp$trimmed_string_size (device^.forms_code [4]);
            parameter_kind^.length_indicated := parameter_value_length > 1;
            IF parameter_kind^.length_indicated THEN
              nfp$put_parameter_value_length (parameter_value_length, message, param_length_size, status);
            ELSE
              param_length_size := 0;
            IFEND;
            NEXT ascii_string: [parameter_value_length] IN message;
            ascii_string^ := device^.forms_code [4] (1, parameter_value_length);
            message_length := message_length + parameter_kind_size + param_length_size +
                  parameter_value_length;
          IFEND;

          NEXT parameter_kind IN message;
          parameter_kind^.length_indicated := FALSE;
          parameter_kind^.param := nfc$suppress_carriage_control;
          NEXT suppress_carriage_control IN message;
          suppress_carriage_control^ := device^.suppress_carriage_control;
          message_length := message_length + parameter_kind_size + 1;

          NEXT parameter_kind IN message;
          parameter_kind^.length_indicated := FALSE;
          parameter_kind^.param := nfc$code_set;
          NEXT code_set IN message;
          code_set^ := device^.code_set;
          message_length := message_length + parameter_kind_size + 1;

          NEXT parameter_kind IN message;
          parameter_kind^.length_indicated := FALSE;
          parameter_kind^.param := nfc$vertical_print_density;
          NEXT vertical_print_density IN message;
          vertical_print_density^ := device^.vertical_print_density;
          message_length := message_length + parameter_kind_size + 1;

          IF device^.vfu_load_procedure <> osc$null_name THEN
            NEXT parameter_kind IN message;
            parameter_kind^.param := nfc$vfu_load_procedure;
            parameter_value_length := clp$trimmed_string_size (device^.vfu_load_procedure);
            parameter_kind^.length_indicated := parameter_value_length > 1;
            IF parameter_kind^.length_indicated THEN
              nfp$put_parameter_value_length (parameter_value_length, message, param_length_size, status);
            ELSE
              param_length_size := 0;
            IFEND;
            NEXT ascii_string: [parameter_value_length] IN message;
            ascii_string^ := device^.vfu_load_procedure (1, parameter_value_length);
            message_length := message_length + parameter_kind_size + param_length_size +
                  parameter_value_length;
          IFEND;

          NEXT parameter_kind IN message;
          parameter_kind^.length_indicated := FALSE;
          parameter_kind^.param := nfc$forms_size;
          NEXT forms_size IN message;
          forms_size^ := device^.forms_size;
          message_length := message_length + parameter_kind_size + 1;

          NEXT parameter_kind IN message;
          parameter_kind^.length_indicated := FALSE;
          parameter_kind^.param := nfc$undefined_fe_action;
          NEXT undefined_fe_action IN message;
          undefined_fe_action^ := device^.undefined_fe_action;
          message_length := message_length + parameter_kind_size + 1;

          NEXT parameter_kind IN message;
          parameter_kind^.length_indicated := FALSE;
          parameter_kind^.param := nfc$unsupported_fe_action;
          NEXT unsupported_fe_action IN message;
          unsupported_fe_action^ := device^.unsupported_fe_action;
          message_length := message_length + parameter_kind_size + 1;

          NEXT parameter_kind IN message;
          parameter_kind^.length_indicated := FALSE;
          parameter_kind^.param := nfc$vfu_load_option;
          NEXT vfu_load_option IN message;
          vfu_load_option^ := device^.vfu_load_option;
          message_length := message_length + parameter_kind_size + 1;

        ELSEIF input_device_or_stream (device) THEN
          IF device^.input_job.user_job_name <> osc$null_name THEN
            NEXT parameter_kind IN message;
            parameter_kind^.param := nfc$user_job_name;
            parameter_value_length := clp$trimmed_string_size (device^.input_job.user_job_name);
            parameter_kind^.length_indicated := parameter_value_length > 1;
            IF parameter_kind^.length_indicated THEN
              nfp$put_parameter_value_length (parameter_value_length, message, param_length_size, status);
            ELSE
              param_length_size := 0;
            IFEND;
            NEXT ascii_string: [parameter_value_length] IN message;
            ascii_string^ := device^.input_job.user_job_name (1, parameter_value_length);
            message_length := message_length + parameter_kind_size + param_length_size +
                  parameter_value_length;
          IFEND;

          IF device^.input_job.requested_destination <> osc$null_name THEN
            destination_name := device^.input_job.requested_destination;
          ELSE
            destination_name := device^.input_job.actual_destination;
          IFEND;
          IF destination_name <> osc$null_name THEN
            NEXT parameter_kind IN message;
            parameter_kind^.param := nfc$destination_name;
            parameter_value_length := clp$trimmed_string_size (destination_name);
            parameter_kind^.length_indicated := parameter_value_length > 1;
            IF parameter_kind^.length_indicated THEN
              nfp$put_parameter_value_length (parameter_value_length, message, param_length_size, status);
            ELSE
              param_length_size := 0;
            IFEND;
            NEXT ascii_string: [parameter_value_length] IN message;
            ascii_string^ := destination_name (1, parameter_value_length);
            message_length := message_length + parameter_kind_size + param_length_size +
                  parameter_value_length;
          IFEND;

{ Send up input bytes transferred only if an input job is currently being read in.

          IF (device^.input_job.input_bytes_transferred > 0) OR
                ((device^.input_job.input_bytes_transferred = 0) AND
                ((destination_name <> osc$null_name) OR (destination_name <> osc$null_name))) THEN
            NEXT parameter_kind IN message;
            parameter_kind^.length_indicated := TRUE;
            parameter_kind^.param := nfc$input_bytes_transferred;
            parameter_value_length := #SIZE (nft$input_job_size);
            nfp$put_parameter_value_length (parameter_value_length, message, param_length_size, status);
            NEXT bytes_transferred IN message;
            bytes_transferred^ := device^.input_job.input_bytes_transferred;
            message_length := message_length + parameter_kind_size + param_length_size +
                  parameter_value_length;
          IFEND;

        IFEND;

        IF (device^.current_file <> NIL) AND output_device_or_stream (device) THEN
          q_file := device^.current_file;

          NEXT parameter_kind IN message;
          parameter_kind^.param := nfc$system_file_name;
          parameter_value_length := clp$trimmed_string_size (q_file^.system_file_name);
          nfp$modify_param_value_length (parameter_value_length);
          parameter_kind^.length_indicated := parameter_value_length > 1;
          IF parameter_kind^.length_indicated THEN
            nfp$put_parameter_value_length (parameter_value_length, message, param_length_size, status);
          ELSE
            param_length_size := 0;
          IFEND;
          NEXT ascii_string: [parameter_value_length] IN message;
          ascii_string^ := q_file^.system_file_name (1, parameter_value_length);
          message_length := message_length + parameter_kind_size + param_length_size +
                parameter_value_length;

          NEXT parameter_kind IN message;
          parameter_kind^.param := nfc$user_file_name;
          parameter_value_length := clp$trimmed_string_size (q_file^.user_file_name);
          nfp$modify_param_value_length (parameter_value_length);
          parameter_kind^.length_indicated := parameter_value_length > 1;
          IF parameter_kind^.length_indicated THEN
            nfp$put_parameter_value_length (parameter_value_length, message, param_length_size, status);
          ELSE
            param_length_size := 0;
          IFEND;
          NEXT ascii_string: [parameter_value_length] IN message;
          ascii_string^ := q_file^.user_file_name (1, parameter_value_length);
          message_length := message_length + parameter_kind_size + param_length_size +
                parameter_value_length;

          NEXT parameter_kind IN message;
          parameter_kind^.param := nfc$system_job_name;
          parameter_value_length := clp$trimmed_string_size (q_file^.system_job_name);
          nfp$modify_param_value_length (parameter_value_length);
          parameter_kind^.length_indicated := parameter_value_length > 1;
          IF parameter_kind^.length_indicated THEN
            nfp$put_parameter_value_length (parameter_value_length, message, param_length_size, status);
          ELSE
            param_length_size := 0;
          IFEND;
          NEXT ascii_string: [parameter_value_length] IN message;
          ascii_string^ := q_file^.system_job_name (1, parameter_value_length);
          message_length := message_length + parameter_kind_size + param_length_size +
                parameter_value_length;

          NEXT parameter_kind IN message;
          parameter_kind^.param := nfc$user_job_name;
          parameter_value_length := clp$trimmed_string_size (q_file^.user_job_name);
          nfp$modify_param_value_length (parameter_value_length);
          parameter_kind^.length_indicated := parameter_value_length > 1;
          IF parameter_kind^.length_indicated THEN
            nfp$put_parameter_value_length (parameter_value_length, message, param_length_size, status);
          ELSE
            param_length_size := 0;
          IFEND;
          NEXT ascii_string: [parameter_value_length] IN message;
          ascii_string^ := q_file^.user_job_name (1, parameter_value_length);
          message_length := message_length + parameter_kind_size + param_length_size +
                parameter_value_length;

          NEXT parameter_kind IN message;
          parameter_kind^.param := nfc$user_name;
          parameter_value_length := clp$trimmed_string_size (q_file^.user_name);
          nfp$modify_param_value_length (parameter_value_length);
          parameter_kind^.length_indicated := parameter_value_length > 1;
          IF parameter_kind^.length_indicated THEN
            nfp$put_parameter_value_length (parameter_value_length, message, param_length_size, status);
          ELSE
            param_length_size := 0;
          IFEND;
          NEXT ascii_string: [parameter_value_length] IN message;
          ascii_string^ := q_file^.user_name (1, parameter_value_length);
          message_length := message_length + parameter_kind_size + param_length_size +
                parameter_value_length;

          NEXT parameter_kind IN message;
          parameter_kind^.param := nfc$family_name;
          parameter_value_length := clp$trimmed_string_size (q_file^.family_name);
          nfp$modify_param_value_length (parameter_value_length);
          parameter_kind^.length_indicated := parameter_value_length > 1;
          IF parameter_kind^.length_indicated THEN
            nfp$put_parameter_value_length (parameter_value_length, message, param_length_size, status);
          ELSE
            param_length_size := 0;
          IFEND;
          NEXT ascii_string: [parameter_value_length] IN message;
          ascii_string^ := q_file^.family_name (1, parameter_value_length);
          message_length := message_length + parameter_kind_size + param_length_size +
                parameter_value_length;

          NEXT parameter_kind IN message;
          parameter_kind^.length_indicated := FALSE;
          parameter_kind^.param := nfc$percent_complete;
          NEXT percent_complete IN message;
          percent_complete^ := q_file^.percent_complete;
          message_length := message_length + parameter_kind_size + 1;
        IFEND;

        ntf_remote_system := device^.io_station;
        IF ntf_remote_system^.usage = nfc$ntf_remote_system THEN
          NEXT parameter_kind IN message;
          parameter_kind^.length_indicated := TRUE;
          parameter_kind^.param := nfc$ntf_logical_line_number;
          parameter_value_length := #SIZE (nft$ntf_logical_line_number);
          nfp$put_parameter_value_length (parameter_value_length, message, param_length_size, status);
          NEXT ntf_logical_line_number IN message;
          ntf_logical_line_number^ := device^.ntf_logical_line_number;
          message_length := message_length + parameter_kind_size + param_length_size +
                parameter_value_length;

          NEXT parameter_kind IN message;
          parameter_kind^.length_indicated := FALSE;
          parameter_kind^.param := nfc$transparent_mode;
          NEXT transparent_mode IN message;
          transparent_mode^ := device^.transparent_mode;
          message_length := message_length + parameter_kind_size + 1;

          NEXT parameter_kind IN message;
          parameter_kind^.length_indicated := FALSE;
          parameter_kind^.param := nfc$ntf_skip_punch_count;
          NEXT ntf_skip_punch_count IN message;
          ntf_skip_punch_count^ := device^.ntf_skip_punch_count;
          message_length := message_length + parameter_kind_size + 1;
        IFEND;

        IF (optimize AND (device <> NIL)) THEN
          device := device^.link;
          IF (device <> NIL) THEN
            NEXT parameter_kind IN message;
            parameter_kind^.length_indicated := FALSE;
            parameter_kind^.param := nfc$null_parameter;
            message_length := message_length + parameter_kind_size;
          IFEND;
        IFEND;
      IFEND;
    UNTIL (NOT optimize) OR (device = NIL);

    NEXT parameter_kind IN message;
    parameter_kind^.length_indicated := FALSE;
    parameter_kind^.param := nfc$null_parameter;
    message_length := message_length + parameter_kind_size;

    nfp$send_message_on_connection (message, message_length, connection^.id, status);
    IF scfs_event_logging THEN
      log_connection_message (connection^, message_length, message);
    IFEND;

  PROCEND send_device_status_msg;
?? TITLE := 'send_file_acknowledgement_msg', EJECT ??

{  PURPOSE:
{    This procedure builds/sends a message to OPES containing file
{    acknowledgement information that is to be displayed to the station
{    operator.

  PROCEDURE send_file_acknowledgement_msg
    (VAR message: ^nft$message_sequence;
         device: ^nft$batch_device;
         ack_message: file_acknowledge_msg;
         job_file_name: ost$name;
         user_name: ost$name;
         file_size: integer;
         connection: ^nft$connection;
     VAR status: ost$status);

    CONST
      size_label = '   Size: ',
      size_label_length = 9,
      user_label = '   User: ',
      user_label_length = 9;

    VAR
      ascii_string: ^string ( * <= 80),
      io_station: ^nft$io_station,
      length: 0 .. osc$max_name_size,
      message_length: integer,
      message_type: ^nft$message_kind,
      messages_sent: boolean,
      parameter_kind: ^nft$operator_message_parameter,
      parameter_kind_size: nft$message_length,
      param_length_size: nft$message_length,
      parameter_value_length: integer,
      start_pos: 0 .. 256,
      str: ost$string,
      str_length: 0 .. 65535,
      text: string (256),
      text_length: 0 .. 80;

*copy nft$operator_message
?? EJECT ??

    io_station := device^.io_station;

    parameter_kind_size := #SIZE (nft$operator_message_parameter);
    RESET message;

    NEXT message_type IN message;
    message_type^ := nfc$operator_message;
    message_length := 1;

    NEXT parameter_kind IN message;
    parameter_kind^.param := nfc$io_station_name;
    parameter_value_length := clp$trimmed_string_size (io_station^.name);
    nfp$modify_param_value_length (parameter_value_length);
    parameter_kind^.length_indicated := parameter_value_length > 1;
    IF parameter_kind^.length_indicated THEN
      nfp$put_parameter_value_length (parameter_value_length, message, param_length_size, status);
    ELSE
      param_length_size := 0;
    IFEND;
    NEXT ascii_string: [parameter_value_length] IN message;
    ascii_string^ := io_station^.name (1, parameter_value_length);
    message_length := message_length + parameter_kind_size + param_length_size + parameter_value_length;

    NEXT parameter_kind IN message;
    parameter_kind^.param := nfc$device_name;
    parameter_value_length := clp$trimmed_string_size (device^.name);
    nfp$modify_param_value_length (parameter_value_length);
    parameter_kind^.length_indicated := parameter_value_length > 1;
    IF parameter_kind^.length_indicated THEN
      nfp$put_parameter_value_length (parameter_value_length, message, param_length_size, status);
    ELSE
      param_length_size := 0;
    IFEND;
    NEXT ascii_string: [parameter_value_length] IN message;
    ascii_string^ := device^.name (1, parameter_value_length);
    message_length := message_length + parameter_kind_size + param_length_size + parameter_value_length;

{   BUILD text of file acknowledgment message.
    text := ack_message.message;
    text_length := ack_message.msg_length;

    IF (job_file_name <> osc$null_name) THEN
      start_pos := text_length + 1;
      text (start_pos, 2) := ': ';
      text_length := text_length + 2;

      start_pos := text_length + 1;
      str_length := clp$trimmed_string_size (job_file_name);
      text (start_pos, str_length) := job_file_name (1, str_length);
      text_length := text_length + str_length;

      IF (user_name <> osc$null_name) THEN
        start_pos := text_length + 1;
        text (start_pos, user_label_length) := user_label;
        text_length := text_length + user_label_length;

        start_pos := text_length + 1;
        str_length := clp$trimmed_string_size (user_name);
        text (start_pos, str_length) := user_name (1, str_length);
        text_length := text_length + str_length;
      IFEND;

      IF (file_size <> 0) THEN
        clp$convert_integer_to_string (file_size, 10, FALSE, str, status);
        IF status.normal THEN
          start_pos := text_length + 1;
          text (start_pos, size_label_length) := size_label;
          text_length := text_length + size_label_length;

          start_pos := text_length + 1;
          text (start_pos, str.size) := str.value (1, str.size);
          text_length := text_length + str.size;
        IFEND;
      IFEND;
    IFEND;
{   FILE ACKNOWLEDGEMENT text is built.

    device^.last_unsolicited_msg (1, * ) := text;
    device^.last_unsolicited_msg_length := text_length;

    NEXT parameter_kind IN message;
    parameter_kind^.param := nfc$text;
    parameter_value_length := text_length;
    parameter_kind^.length_indicated := parameter_value_length > 1;
    IF parameter_kind^.length_indicated THEN
      nfp$put_parameter_value_length (parameter_value_length, message, param_length_size, status);
    ELSE
      param_length_size := 0;
    IFEND;
    NEXT ascii_string: [text_length] IN message;
    ascii_string^ := text (1, text_length);
    message_length := message_length + parameter_kind_size + param_length_size + parameter_value_length;

    NEXT parameter_kind IN message;
    parameter_kind^.length_indicated := FALSE;
    parameter_kind^.param := nfc$null_parameter;
    message_length := message_length + parameter_kind_size;

    IF (io_station^.usage <> nfc$ntf_remote_system) AND connection^.accept_messages THEN
      nfp$send_message_on_connection (message, message_length, connection^.id, status);
      IF scfs_event_logging THEN
        log_connection_message (connection^, message_length, message);
      IFEND;
    ELSEIF device^.device_type <> nfc$console THEN
      broadcast_ntf_message (message, message_length, osc$null_name, osc$null_name,
            nfc$ntf_blank_system_identifier, messages_sent, status);
    IFEND;

  PROCEND send_file_acknowledgement_msg;
?? TITLE := 'send_file_assignment_msg', EJECT ??

{  PURPOSE:
{    This procedure builds/sends a message to SCF/VE containing information
{    currently known to SCFS.  This information will be compared to SCF/VE's
{    current information on the output file.
{
{    This procedure also builds/sends a message to NTF/VE containing
{    information currently known to SCFS.  This information will be compared to
{    NTF/VE's current information on the NTF file.

  PROCEDURE send_file_assignment_msg
    (VAR message: ^nft$message_sequence;
         io_station_name: ost$name;
         q_file: nft$output_queue_file;
         device: ^nft$batch_device;
         connection: ^nft$connection;
     VAR status: ost$status);

*copyc nft$file_assignment_msg

    VAR
      ascii_string: ^string ( * <= osc$max_name_size),
      banner_page_count: ^nft$banner_page_count,
      banner_highlight_field: ^nft$banner_highlight_field,
      btfs_di_title: ^nat$title_pattern,
      carriage_control_action: ^nft$carriage_control_action,
      code_set: ^nft$code_set,
      copies: ^nft$copies,
      device_type: ^nft$device_type,
      file_ack: ^boolean,
      forms_size: ^nft$forms_size,
      initial_priority: ^nft$priority,
      maximum_file_size: ^nft$device_file_size,
      message_length: nft$message_length,
      message_type: ^nft$message_kind,
      network_address: ^nft$network_address,
      ntf_acc_remote_system: ^nft$alias,
      ntf_protocol: ^nft$ntf_remote_system_protocol,
      ntf_remote_system: ^nft$io_station,
      ntf_remote_system_type: ^nft$ntf_remote_system_type,
      ntf_route_back_position: ^nft$ntf_route_back_position,
      output_initial_priority: ^nft$priority,
      page_width: ^nft$page_width,
      parameter_kind: ^nft$file_assign_msg_parameter,
      parameter_kind_size: nft$message_length,
      param_length_size: nft$message_length,
      parameter_value_length: integer,
      station_usage: ^nft$io_station_usage,
      tip_type: ^nft$tip_type,
      transmission_block_size: ^nft$transmit_block_size,
      undefined_fe_action: ^nft$format_effector_actions,
      unsupported_fe_action: ^nft$format_effector_actions,
      vertical_print_density: ^nft$file_vertical_print_density,
      vertical_print_density_dev: ^nft$vertical_print_density,
      vfu_load_option: ^nft$vfu_load_option;

?? EJECT ??

    parameter_kind_size := #SIZE (nft$file_assign_msg_parameter);
    RESET message;

    NEXT message_type IN message;
    message_type^ := nfc$file_assignment;
    message_length := 1;

    NEXT parameter_kind IN message;
    parameter_kind^.param := nfc$io_station_name;
    parameter_value_length := clp$trimmed_string_size (io_station_name);
    nfp$modify_param_value_length (parameter_value_length);
    parameter_kind^.length_indicated := parameter_value_length > 1;
    IF parameter_kind^.length_indicated THEN
      nfp$put_parameter_value_length (parameter_value_length, message, param_length_size, status);
    ELSE
      param_length_size := 0;
    IFEND;
    NEXT ascii_string: [parameter_value_length] IN message;
    ascii_string^ := io_station_name (1, parameter_value_length);
    message_length := message_length + parameter_kind_size + param_length_size + parameter_value_length;

    NEXT parameter_kind IN message;
    parameter_kind^.param := nfc$system_file_name;
    parameter_value_length := clp$trimmed_string_size (q_file.system_file_name);
    nfp$modify_param_value_length (parameter_value_length);
    parameter_kind^.length_indicated := parameter_value_length > 1;
    IF parameter_kind^.length_indicated THEN
      nfp$put_parameter_value_length (parameter_value_length, message, param_length_size, status);
    ELSE
      param_length_size := 0;
    IFEND;
    NEXT ascii_string: [parameter_value_length] IN message;
    ascii_string^ := q_file.system_file_name (1, parameter_value_length);
    message_length := message_length + parameter_kind_size + param_length_size + parameter_value_length;

    NEXT parameter_kind IN message;
    parameter_kind^.param := nfc$device_name;
    parameter_value_length := clp$trimmed_string_size (device^.name);
    nfp$modify_param_value_length (parameter_value_length);
    parameter_kind^.length_indicated := parameter_value_length > 1;
    IF parameter_kind^.length_indicated THEN
      nfp$put_parameter_value_length (parameter_value_length, message, param_length_size, status);
    ELSE
      param_length_size := 0;
    IFEND;
    NEXT ascii_string: [parameter_value_length] IN message;
    ascii_string^ := device^.name (1, parameter_value_length);
    message_length := message_length + parameter_kind_size + param_length_size + parameter_value_length;

    NEXT parameter_kind IN message;
    parameter_kind^.length_indicated := FALSE;
    parameter_kind^.param := nfc$device_type;
    NEXT device_type IN message;
    device_type^ := q_file.device_type;
    message_length := message_length + parameter_kind_size + 1;

    IF (connection^.btf_ve_status_received AND (device^.btfs_di_title.length > 0)) THEN
      NEXT parameter_kind IN message;
      parameter_kind^.length_indicated := TRUE;
      parameter_kind^.param := nfc$btfs_di_title;
      parameter_value_length := device^.btfs_di_title.length;
      nfp$put_parameter_value_length (parameter_value_length, message, param_length_size, status);
      NEXT btfs_di_title: [parameter_value_length] IN message;
      btfs_di_title^ := device^.btfs_di_title.title (1, parameter_value_length);
      message_length := message_length + parameter_kind_size + param_length_size + parameter_value_length;
    ELSE
      NEXT parameter_kind IN message;
      parameter_kind^.length_indicated := TRUE;
      parameter_kind^.param := nfc$btfsdi_address;
      parameter_value_length := #SIZE (nft$network_address);
      nfp$put_parameter_value_length (parameter_value_length, message, param_length_size, status);
      NEXT network_address IN message;
      network_address^ := device^.btfs_di_address;
      message_length := message_length + parameter_kind_size + param_length_size + parameter_value_length;
    IFEND;

    NEXT parameter_kind IN message;
    parameter_kind^.param := nfc$requested_io_station;
    parameter_value_length := clp$trimmed_string_size (q_file.ios_name);
    nfp$modify_param_value_length (parameter_value_length);
    parameter_kind^.length_indicated := parameter_value_length > 1;
    IF parameter_kind^.length_indicated THEN
      nfp$put_parameter_value_length (parameter_value_length, message, param_length_size, status);
    ELSE
      param_length_size := 0;
    IFEND;
    NEXT ascii_string: [parameter_value_length] IN message;
    ascii_string^ := q_file.ios_name (1, parameter_value_length);
    message_length := message_length + parameter_kind_size + param_length_size + parameter_value_length;

    NEXT parameter_kind IN message;
    parameter_kind^.param := nfc$requested_device;
    parameter_value_length := clp$trimmed_string_size (q_file.device_name);
    nfp$modify_param_value_length (parameter_value_length);
    parameter_kind^.length_indicated := parameter_value_length > 1;
    IF parameter_kind^.length_indicated THEN
      nfp$put_parameter_value_length (parameter_value_length, message, param_length_size, status);
    ELSE
      param_length_size := 0;
    IFEND;
    NEXT ascii_string: [parameter_value_length] IN message;
    ascii_string^ := q_file.device_name (1, parameter_value_length);
    message_length := message_length + parameter_kind_size + param_length_size + parameter_value_length;

    NEXT parameter_kind IN message;
    parameter_kind^.param := nfc$operator_name;
    parameter_value_length := clp$trimmed_string_size (q_file.operator_name);
    nfp$modify_param_value_length (parameter_value_length);
    parameter_kind^.length_indicated := parameter_value_length > 1;
    IF parameter_kind^.length_indicated THEN
      nfp$put_parameter_value_length (parameter_value_length, message, param_length_size, status);
    ELSE
      param_length_size := 0;
    IFEND;
    NEXT ascii_string: [parameter_value_length] IN message;
    ascii_string^ := q_file.operator_name (1, parameter_value_length);
    message_length := message_length + parameter_kind_size + param_length_size + parameter_value_length;

    NEXT parameter_kind IN message;
    parameter_kind^.param := nfc$operator_family;
    parameter_value_length := clp$trimmed_string_size (q_file.operator_family);
    nfp$modify_param_value_length (parameter_value_length);
    parameter_kind^.length_indicated := parameter_value_length > 1;
    IF parameter_kind^.length_indicated THEN
      nfp$put_parameter_value_length (parameter_value_length, message, param_length_size, status);
    ELSE
      param_length_size := 0;
    IFEND;
    NEXT ascii_string: [parameter_value_length] IN message;
    ascii_string^ := q_file.operator_family (1, parameter_value_length);
    message_length := message_length + parameter_kind_size + param_length_size + parameter_value_length;

    NEXT parameter_kind IN message;
    parameter_kind^.length_indicated := FALSE;
    parameter_kind^.param := nfc$station_usage;
    NEXT station_usage IN message;
    station_usage^ := q_file.ios_usage;
    message_length := message_length + parameter_kind_size + 1;

    NEXT parameter_kind IN message;
    parameter_kind^.length_indicated := TRUE;
    parameter_kind^.param := nfc$copies;
    parameter_value_length := #SIZE (nft$copies);
    nfp$put_parameter_value_length (parameter_value_length, message, param_length_size, status);
    NEXT copies IN message;
    copies^ := q_file.copies;
    message_length := message_length + parameter_kind_size + param_length_size + parameter_value_length;

    IF q_file.external_characteristics <> osc$null_name THEN
      NEXT parameter_kind IN message;
      parameter_kind^.param := nfc$external_characteristics;
      parameter_value_length := clp$trimmed_string_size (q_file.external_characteristics);
      parameter_kind^.length_indicated := parameter_value_length > 1;
      IF parameter_kind^.length_indicated THEN
        nfp$put_parameter_value_length (parameter_value_length, message,
              param_length_size, status);
      ELSE
        param_length_size := 0;
      IFEND;
      NEXT ascii_string: [parameter_value_length] IN message;
      ascii_string^ := q_file.external_characteristics (1, parameter_value_length);
      message_length := message_length + parameter_kind_size + param_length_size + parameter_value_length;
    IFEND;

    IF q_file.forms_code <> osc$null_name THEN
      NEXT parameter_kind IN message;
      parameter_kind^.param := nfc$forms_code;
      parameter_value_length := clp$trimmed_string_size (q_file.forms_code);
      parameter_kind^.length_indicated := parameter_value_length > 1;
      IF parameter_kind^.length_indicated THEN
        nfp$put_parameter_value_length (parameter_value_length, message, param_length_size, status);
      ELSE
        param_length_size := 0;
      IFEND;
      NEXT ascii_string: [parameter_value_length] IN message;
      ascii_string^ := q_file.forms_code (1, parameter_value_length);
      message_length := message_length + parameter_kind_size + param_length_size + parameter_value_length;
    IFEND;

    NEXT parameter_kind IN message;
    parameter_kind^.length_indicated := TRUE;
    parameter_kind^.param := nfc$output_initial_priority;
    parameter_value_length := #SIZE (nft$priority);
    nfp$put_parameter_value_length (parameter_value_length, message, param_length_size, status);
    NEXT initial_priority IN message;
    initial_priority^ := q_file.initial_priority;
    message_length := message_length + parameter_kind_size + param_length_size + parameter_value_length;

    IF q_file.vfu_load_procedure <> osc$null_name THEN
      NEXT parameter_kind IN message;
      parameter_kind^.param := nfc$vfu_load_procedure;
      parameter_value_length := clp$trimmed_string_size (q_file.vfu_load_procedure);
      parameter_kind^.length_indicated := parameter_value_length > 1;
      IF parameter_kind^.length_indicated THEN
        nfp$put_parameter_value_length (parameter_value_length, message, param_length_size, status);
      ELSE
        param_length_size := 0;
      IFEND;
      NEXT ascii_string: [parameter_value_length] IN message;
      ascii_string^ := q_file.vfu_load_procedure (1, parameter_value_length);
      message_length := message_length + parameter_kind_size + param_length_size + parameter_value_length;
    IFEND;

    NEXT parameter_kind IN message;
    parameter_kind^.length_indicated := FALSE;
    parameter_kind^.param := nfc$vertical_print_density;
    NEXT vertical_print_density IN message;
    vertical_print_density^ := q_file.vertical_print_density;
    message_length := message_length + parameter_kind_size + 1;

    IF q_file.ios_usage = nfc$ntf_remote_system THEN

      ntf_remote_system := device^.io_station;
      find_ntf_acc_remote_system (io_station_name, ntf_acc_remote_system);

      NEXT parameter_kind IN message;
      parameter_kind^.length_indicated := FALSE;
      parameter_kind^.param := nfc$ntf_remote_system_protocol;
      NEXT ntf_protocol IN message;
      ntf_protocol^ := ntf_remote_system^.ntf_protocol;
      message_length := message_length + parameter_kind_size + 1;

      IF ntf_protocol^ <> nfc$ntf_nje THEN
        NEXT parameter_kind IN message;
        parameter_kind^.length_indicated := FALSE;
        parameter_kind^.param := nfc$ntf_remote_system_type;
        NEXT ntf_remote_system_type IN message;
        ntf_remote_system_type^ := ntf_acc_remote_system^.ntf_remote_system_type;
        message_length := message_length + parameter_kind_size + 1;

        NEXT parameter_kind IN message;
        parameter_kind^.length_indicated := FALSE;
        parameter_kind^.param := nfc$ntf_route_back_position;
        NEXT ntf_route_back_position IN message;
        ntf_route_back_position^ := ntf_acc_remote_system^.ntf_route_back_position;
        message_length := message_length + parameter_kind_size + 1;
      IFEND;

    IFEND;

    IF connection^.kind = nfc$scfve_connection THEN
      NEXT parameter_kind IN message;
      parameter_kind^.length_indicated := FALSE;
      parameter_kind^.param := nfc$banner_highlight_field;
      NEXT banner_highlight_field IN message;
      banner_highlight_field^ := device^.banner_highlight_field;
      message_length := message_length + parameter_kind_size + 1;

      NEXT parameter_kind IN message;
      parameter_kind^.length_indicated := FALSE;
      parameter_kind^.param := nfc$banner_page_count;
      NEXT banner_page_count IN message;
      banner_page_count^ := device^.banner_page_count;
      message_length := message_length + parameter_kind_size + 1;

      NEXT parameter_kind IN message;
      parameter_kind^.length_indicated := FALSE;
      parameter_kind^.param := nfc$carriage_control_support;
      NEXT carriage_control_action IN message;
      carriage_control_action^ := device^.carriage_control_action;
      message_length := message_length + parameter_kind_size + 1;

      NEXT parameter_kind IN message;
      parameter_kind^.length_indicated := FALSE;
      parameter_kind^.param := nfc$code_set;
      NEXT code_set IN message;
      code_set^ := device^.code_set;
      message_length := message_length + parameter_kind_size + 1;

      IF device^.alias_names [1] <> osc$null_name THEN
        NEXT parameter_kind IN message;
        parameter_kind^.param := nfc$device_alias_1;
        parameter_value_length := clp$trimmed_string_size (device^.alias_names [1]);
        parameter_kind^.length_indicated := parameter_value_length > 1;
        IF parameter_kind^.length_indicated THEN
          nfp$put_parameter_value_length (parameter_value_length, message, param_length_size, status);
        ELSE
          param_length_size := 0;
        IFEND;
        NEXT ascii_string: [parameter_value_length] IN message;
        ascii_string^ := device^.alias_names [1] (1, parameter_value_length);
        message_length := message_length + parameter_kind_size + param_length_size + parameter_value_length;
      IFEND;

      IF device^.alias_names [2] <> osc$null_name THEN
        NEXT parameter_kind IN message;
        parameter_kind^.param := nfc$device_alias_2;
        parameter_value_length := clp$trimmed_string_size (device^.alias_names [2]);
        parameter_kind^.length_indicated := parameter_value_length > 1;
        IF parameter_kind^.length_indicated THEN
          nfp$put_parameter_value_length (parameter_value_length, message, param_length_size, status);
        ELSE
          param_length_size := 0;
        IFEND;
        NEXT ascii_string: [parameter_value_length] IN message;
        ascii_string^ := device^.alias_names [2] (1, parameter_value_length);
        message_length := message_length + parameter_kind_size + param_length_size + parameter_value_length;
      IFEND;

      IF device^.alias_names [3] <> osc$null_name THEN
        NEXT parameter_kind IN message;
        parameter_kind^.param := nfc$device_alias_3;
        parameter_value_length := clp$trimmed_string_size (device^.alias_names [3]);
        parameter_kind^.length_indicated := parameter_value_length > 1;
        IF parameter_kind^.length_indicated THEN
          nfp$put_parameter_value_length (parameter_value_length, message, param_length_size, status);
        ELSE
          param_length_size := 0;
        IFEND;
        NEXT ascii_string: [parameter_value_length] IN message;
        ascii_string^ := device^.alias_names [3] (1, parameter_value_length);
        message_length := message_length + parameter_kind_size + param_length_size + parameter_value_length;
      IFEND;

      IF device^.external_characteristics [1] <> osc$null_name THEN
        NEXT parameter_kind IN message;
        parameter_kind^.param := nfc$external_characteristics_1;
        parameter_value_length := clp$trimmed_string_size (device^.external_characteristics [1]);
        parameter_kind^.length_indicated := parameter_value_length > 1;
        IF parameter_kind^.length_indicated THEN
          nfp$put_parameter_value_length (parameter_value_length, message, param_length_size, status);
        ELSE
          param_length_size := 0;
        IFEND;
        NEXT ascii_string: [parameter_value_length] IN message;
        ascii_string^ := device^.external_characteristics [1] (1, parameter_value_length);
        message_length := message_length + parameter_kind_size + param_length_size + parameter_value_length;
      IFEND;

      IF device^.external_characteristics [2] <> osc$null_name THEN
        NEXT parameter_kind IN message;
        parameter_kind^.param := nfc$external_characteristics_2;
        parameter_value_length := clp$trimmed_string_size (device^.external_characteristics [2]);
        parameter_kind^.length_indicated := parameter_value_length > 1;
        IF parameter_kind^.length_indicated THEN
          nfp$put_parameter_value_length (parameter_value_length, message, param_length_size, status);
        ELSE
          param_length_size := 0;
        IFEND;
        NEXT ascii_string: [parameter_value_length] IN message;
        ascii_string^ := device^.external_characteristics [2] (1, parameter_value_length);
        message_length := message_length + parameter_kind_size + param_length_size + parameter_value_length;
      IFEND;

      IF device^.external_characteristics [3] <> osc$null_name THEN
        NEXT parameter_kind IN message;
        parameter_kind^.param := nfc$external_characteristics_3;
        parameter_value_length := clp$trimmed_string_size (device^.external_characteristics [3]);
        parameter_kind^.length_indicated := parameter_value_length > 1;
        IF parameter_kind^.length_indicated THEN
          nfp$put_parameter_value_length (parameter_value_length, message, param_length_size, status);
        ELSE
          param_length_size := 0;
        IFEND;
        NEXT ascii_string: [parameter_value_length] IN message;
        ascii_string^ := device^.external_characteristics [3] (1, parameter_value_length);
        message_length := message_length + parameter_kind_size + param_length_size + parameter_value_length;
      IFEND;

      IF device^.external_characteristics [4] <> osc$null_name THEN
        NEXT parameter_kind IN message;
        parameter_kind^.param := nfc$external_characteristics_4;
        parameter_value_length := clp$trimmed_string_size (device^.external_characteristics [4]);
        parameter_kind^.length_indicated := parameter_value_length > 1;
        IF parameter_kind^.length_indicated THEN
          nfp$put_parameter_value_length (parameter_value_length, message, param_length_size, status);
        ELSE
          param_length_size := 0;
        IFEND;
        NEXT ascii_string: [parameter_value_length] IN message;
        ascii_string^ := device^.external_characteristics [4] (1, parameter_value_length);
        message_length := message_length + parameter_kind_size + param_length_size + parameter_value_length;
      IFEND;

      NEXT parameter_kind IN message;
      parameter_kind^.length_indicated := FALSE;
      parameter_kind^.param := nfc$file_acknowledgement;
      NEXT file_ack IN message;
      file_ack^ := device^.file_acknowledgement;
      message_length := message_length + parameter_kind_size + 1;

      IF device^.forms_code [1] <> osc$null_name THEN
        NEXT parameter_kind IN message;
        parameter_kind^.param := nfc$forms_code_1;
        parameter_value_length := clp$trimmed_string_size (device^.forms_code [1]);
        parameter_kind^.length_indicated := parameter_value_length > 1;
        IF parameter_kind^.length_indicated THEN
          nfp$put_parameter_value_length (parameter_value_length, message, param_length_size, status);
        ELSE
          param_length_size := 0;
        IFEND;
        NEXT ascii_string: [parameter_value_length] IN message;
        ascii_string^ := device^.forms_code [1] (1, parameter_value_length);
        message_length := message_length + parameter_kind_size + param_length_size + parameter_value_length;
      IFEND;

      IF device^.forms_code [2] <> osc$null_name THEN
        NEXT parameter_kind IN message;
        parameter_kind^.param := nfc$forms_code_2;
        parameter_value_length := clp$trimmed_string_size (device^.forms_code [2]);
        parameter_kind^.length_indicated := parameter_value_length > 1;
        IF parameter_kind^.length_indicated THEN
          nfp$put_parameter_value_length (parameter_value_length, message, param_length_size, status);
        ELSE
          param_length_size := 0;
        IFEND;
        NEXT ascii_string: [parameter_value_length] IN message;
        ascii_string^ := device^.forms_code [2] (1, parameter_value_length);
        message_length := message_length + parameter_kind_size + param_length_size + parameter_value_length;
      IFEND;

      IF device^.forms_code [3] <> osc$null_name THEN
        NEXT parameter_kind IN message;
        parameter_kind^.param := nfc$forms_code_3;
        parameter_value_length := clp$trimmed_string_size (device^.forms_code [3]);
        parameter_kind^.length_indicated := parameter_value_length > 1;
        IF parameter_kind^.length_indicated THEN
          nfp$put_parameter_value_length (parameter_value_length, message, param_length_size, status);
        ELSE
          param_length_size := 0;
        IFEND;
        NEXT ascii_string: [parameter_value_length] IN message;
        ascii_string^ := device^.forms_code [3] (1, parameter_value_length);
        message_length := message_length + parameter_kind_size + param_length_size + parameter_value_length;
      IFEND;

      IF device^.forms_code [4] <> osc$null_name THEN
        NEXT parameter_kind IN message;
        parameter_kind^.param := nfc$forms_code_4;
        parameter_value_length := clp$trimmed_string_size (device^.forms_code [4]);
        parameter_kind^.length_indicated := parameter_value_length > 1;
        IF parameter_kind^.length_indicated THEN
          nfp$put_parameter_value_length (parameter_value_length, message, param_length_size, status);
        ELSE
          param_length_size := 0;
        IFEND;
        NEXT ascii_string: [parameter_value_length] IN message;
        ascii_string^ := device^.forms_code [4] (1, parameter_value_length);
        message_length := message_length + parameter_kind_size + param_length_size + parameter_value_length;
      IFEND;

      NEXT parameter_kind IN message;
      parameter_kind^.length_indicated := FALSE;
      parameter_kind^.param := nfc$forms_size;
      NEXT forms_size IN message;
      forms_size^ := device^.forms_size;
      message_length := message_length + parameter_kind_size + 1;

      NEXT parameter_kind IN message;
      parameter_kind^.length_indicated := TRUE;
      parameter_kind^.param := nfc$maximum_file_size;
      parameter_value_length := #SIZE (nft$device_file_size);
      nfp$put_parameter_value_length (parameter_value_length, message, param_length_size, status);
      NEXT maximum_file_size IN message;
      maximum_file_size^ := device^.maximum_file_size;
      message_length := message_length + parameter_kind_size + param_length_size + parameter_value_length;

      NEXT parameter_kind IN message;
      parameter_kind^.length_indicated := FALSE;
      parameter_kind^.param := nfc$page_width;
      NEXT page_width IN message;
      page_width^ := device^.page_width;
      message_length := message_length + parameter_kind_size + 1;

      IF device^.terminal_model <> osc$null_name THEN
        NEXT parameter_kind IN message;
        parameter_kind^.param := nfc$terminal_model;
        parameter_value_length := clp$trimmed_string_size (device^.terminal_model);
        parameter_kind^.length_indicated := parameter_value_length > 1;
        IF parameter_kind^.length_indicated THEN
          nfp$put_parameter_value_length (parameter_value_length, message, param_length_size, status);
        ELSE
          param_length_size := 0;
        IFEND;
        NEXT ascii_string: [parameter_value_length] IN message;
        ascii_string^ := device^.terminal_model (1, parameter_value_length);
        message_length := message_length + parameter_kind_size + param_length_size + parameter_value_length;
      IFEND;

      NEXT parameter_kind IN message;
      parameter_kind^.length_indicated := FALSE;
      parameter_kind^.param := nfc$tip_type;
      NEXT tip_type IN message;
      tip_type^ := device^.tip_type;
      message_length := message_length + parameter_kind_size + 1;

      NEXT parameter_kind IN message;
      parameter_kind^.length_indicated := TRUE;
      parameter_kind^.param := nfc$transmission_block_size;
      parameter_value_length := #SIZE (nft$transmit_block_size);
      nfp$put_parameter_value_length (parameter_value_length, message, param_length_size, status);
      NEXT transmission_block_size IN message;
      transmission_block_size^ := device^.transmission_block_size;
      message_length := message_length + parameter_kind_size + param_length_size + parameter_value_length;

      NEXT parameter_kind IN message;
      parameter_kind^.length_indicated := FALSE;
      parameter_kind^.param := nfc$undefined_fe_action;
      NEXT undefined_fe_action IN message;
      undefined_fe_action^ := device^.undefined_fe_action;
      message_length := message_length + parameter_kind_size + 1;

      NEXT parameter_kind IN message;
      parameter_kind^.length_indicated := FALSE;
      parameter_kind^.param := nfc$unsupported_fe_action;
      NEXT unsupported_fe_action IN message;
      unsupported_fe_action^ := device^.unsupported_fe_action;
      message_length := message_length + parameter_kind_size + 1;

      NEXT parameter_kind IN message;
      parameter_kind^.length_indicated := FALSE;
      parameter_kind^.param := nfc$dev_vertical_print_density;
      NEXT vertical_print_density_dev IN message;
      vertical_print_density_dev^ := device^.vertical_print_density;
      message_length := message_length + parameter_kind_size + 1;

      NEXT parameter_kind IN message;
      parameter_kind^.length_indicated := FALSE;
      parameter_kind^.param := nfc$vfu_load_option;
      NEXT vfu_load_option IN message;
      vfu_load_option^ := device^.vfu_load_option;
      message_length := message_length + parameter_kind_size + 1;

      IF device^.vfu_load_procedure <> osc$null_name THEN
        NEXT parameter_kind IN message;
        parameter_kind^.param := nfc$dev_vfu_load_procedure;
        parameter_value_length := clp$trimmed_string_size (device^.vfu_load_procedure);
        parameter_kind^.length_indicated := parameter_value_length > 1;
        IF parameter_kind^.length_indicated THEN
          nfp$put_parameter_value_length (parameter_value_length, message, param_length_size, status);
        ELSE
          param_length_size := 0;
        IFEND;
        NEXT ascii_string: [parameter_value_length] IN message;
        ascii_string^ := device^.vfu_load_procedure (1, parameter_value_length);
        message_length := message_length + parameter_kind_size + param_length_size + parameter_value_length;
      IFEND;
    IFEND;

    NEXT parameter_kind IN message;
    parameter_kind^.length_indicated := FALSE;
    parameter_kind^.param := nfc$null_parameter;
    message_length := message_length + parameter_kind_size;

    nfp$send_message_on_connection (message, message_length, connection^.id, status);
    IF scfs_event_logging THEN
      log_connection_message (connection^, message_length, message);
    IFEND;

  PROCEND send_file_assignment_msg;
?? TITLE := 'send_ntf_remote_command_message', EJECT ??

{  PURPOSE:
{    This procedure is executed when a message is received from OPENTF to send
{    a command to a remote system.  If the remote system can accept the
{    command, the command will be sent to the appropriate SCF/DI.  If the
{    remote system can not accept the command, a negative response will be
{    returned to OPENTF.
{
{    This procedure is also executed when a message is received from NTF/VE or
{    OPENTF to forward to NTF operators or users.  This procedure is also
{    executed when a message is received from OPENTF to forward to NTF/VE.

  PROCEDURE send_ntf_remote_command_message
    (VAR message: ^nft$message_sequence;
         connection: ^nft$connection;
     VAR msg_length: integer;
     VAR status: ost$status);

    VAR
      client_connection: ^nft$connection,
      command_kind: nft$ntf_command_kind,
      command_text: nft$ntf_command_text,
      console_stream_name: ost$name,
      dir_conn_remote_system_name: ost$name,
      family_name: ost$name,
      logical_line: ^nft$ntf_logical_line,
      logical_line_found: boolean,
      logical_line_number: nft$ntf_logical_line_number,
      messages_sent: boolean,
      original_message: ^nft$message_sequence,
      original_msg_length: integer,
      remote_system: ^nft$io_station,
      remote_system_found: boolean,
      remote_system_name: ost$name,
      message_response: nft$ntf_send_rc_response_codes,
      operator_identifier: nft$ntf_system_identifier,
      scfdi_connection: ^nft$connection,
      signon_status: nft$device_status,
      system_identifier: nft$ntf_system_identifier,
      user_name: ost$name,
      wait_for_di_message: boolean;

*copy nft$ntf_send_remote_comm_msg
*copy nft$ntf_send_rc_response_codes
?? NEWTITLE := 'crack_send_remote_command_msg', EJECT ??

    PROCEDURE crack_send_remote_command_msg
      (VAR message: ^nft$message_sequence;
       VAR msg_length: integer;
       VAR remote_system_name: ost$name;
       VAR logical_line_number: nft$ntf_logical_line_number;
       VAR command_kind: nft$ntf_command_kind;
       VAR command_text: nft$ntf_command_text;
       VAR system_identifier: nft$ntf_system_identifier;
       VAR family_name: ost$name;
       VAR user_name: ost$name;
       VAR operator_identifier: nft$ntf_system_identifier;
       VAR status: ost$status);

      VAR
        ascii_string: ^string ( * <= osc$max_name_size),
        byte_array: ^nft$byte_array,
        kind: ^nft$ntf_command_kind,
        line_number: ^nft$ntf_logical_line_number,
        parameter: ^nft$ntf_send_remote_comm_msg,
        text: ^string ( * <= nfc$ntf_max_command_text_size),
        value_length: integer;

      status.normal := TRUE;
      remote_system_name := osc$null_name;
      family_name := osc$null_name;
      user_name := osc$null_name;
      operator_identifier := nfc$ntf_blank_system_identifier;
      NEXT parameter IN message;

      WHILE (parameter <> NIL) AND (parameter^.param <> nfc$null_parameter) AND (msg_length > 0) DO
        msg_length := msg_length - 1;
        IF parameter^.length_indicated THEN
          nfp$get_parameter_value_length (message, msg_length, value_length, status);
          msg_length := msg_length - value_length;
        ELSE
          value_length := 1;
          msg_length := msg_length - 1;
        IFEND;

        CASE parameter^.param OF
        = nfc$ntf_remote_system_name =
          NEXT ascii_string: [value_length] IN message;
          #TRANSLATE (osv$lower_to_upper, ascii_string^, remote_system_name);

        = nfc$ntf_logical_line_number =
          NEXT line_number IN message;
          logical_line_number := line_number^;

        = nfc$ntf_command_kind =
          NEXT kind IN message;
          command_kind := kind^;

        = nfc$ntf_command_text =
          NEXT text: [value_length] IN message;
          command_text := text^ (1, value_length);

        = nfc$ntf_system_identifier =
          NEXT ascii_string: [value_length] IN message;
          #TRANSLATE (osv$lower_to_upper, ascii_string^, system_identifier);

        = nfc$ntf_family_name =
          NEXT ascii_string: [value_length] IN message;
          #TRANSLATE (osv$lower_to_upper, ascii_string^, family_name);

        = nfc$ntf_user_name =
          NEXT ascii_string: [value_length] IN message;
          #TRANSLATE (osv$lower_to_upper, ascii_string^, user_name);

        = nfc$ntf_operator_identifier =
          NEXT ascii_string: [value_length] IN message;
          #TRANSLATE (osv$lower_to_upper, ascii_string^, operator_identifier);

        ELSE
{         ERROR ----   Ignore parameter value.
          NEXT byte_array: [1 .. value_length] IN message;

        CASEND;
        NEXT parameter IN message;
      WHILEND;

    PROCEND crack_send_remote_command_msg;
?? TITLE := 'find_signed_on_logical_line', EJECT ??

{  PURPOSE:
{    This procedure finds a signed on logical line to an accessible remote
{    system.  The directly connected remote system name and logical line number
{    of a signed on logical line is returned.  If no signed on logical line is
{    found, a null directly connected remote system name is returned.

    PROCEDURE find_signed_on_logical_line
      (    remote_system_name: ost$name;
           connection: ^nft$connection;
       VAR dir_conn_remote_system_name: ost$name;
       VAR logical_line_number: nft$ntf_logical_line_number);

      VAR
        acc_remote_system: ^nft$alias,
        logical_line: ^nft$ntf_logical_line,
        remote_system: ^nft$io_station,
        remote_system_ptr: ^nft$pointer_list_entry;

      find_ntf_acc_remote_system (remote_system_name, acc_remote_system);
      IF acc_remote_system <> NIL THEN
        logical_line_found := FALSE;
        remote_system_ptr := acc_remote_system^.station_list;
        WHILE (NOT logical_line_found) AND (remote_system_ptr <> NIL) DO
          remote_system := remote_system_ptr^.ntf_remote_system;
          dir_conn_remote_system_name := remote_system^.name;
          logical_line_number := remote_system_ptr^.ntf_logical_line_number;
          find_ntf_logical_line (logical_line_number, remote_system, logical_line,
                logical_line_found);
          IF logical_line_found THEN
            logical_line_found := (logical_line^.signon_status = nfc$ntf_signed_on);
          IFEND;

          remote_system_ptr := remote_system_ptr^.link;
        WHILEND;

        IF NOT logical_line_found THEN
          dir_conn_remote_system_name := osc$null_name;
          logical_line_number := 1;
        IFEND;
      ELSE
        dir_conn_remote_system_name := osc$null_name;
        logical_line_number := 1;
      IFEND;

    PROCEND find_signed_on_logical_line;
?? TITLE := 'forward_send_remote_command_msg', EJECT ??

    PROCEDURE forward_send_remote_command_msg
      (VAR message: ^nft$message_sequence;
           remote_system_name: ost$name;
           console_stream_name: ost$name;
           command_kind: nft$ntf_command_kind;
           command_text: nft$ntf_command_text;
           family_name: ost$name;
           user_name: ost$name;
           connection: ^nft$connection;
       VAR status: ost$status);

      VAR
        ascii_string: ^string ( * <= osc$max_name_size),
        kind: ^nft$ntf_command_kind,
        message_length: integer,
        message_type: ^nft$message_kind,
        parameter_kind: ^nft$ntf_send_remote_comm_msg,
        parameter_kind_size: nft$message_length,
        param_length_size: nft$message_length,
        parameter_value_length: integer,
        text: ^string ( * <= nfc$ntf_max_command_text_size);

      parameter_kind_size := #SIZE (nft$ntf_send_remote_comm_msg);
      RESET message;

      NEXT message_type IN message;
      message_type^ := nfc$send_ntf_remote_comm_msg;
      message_length := 1;

      NEXT parameter_kind IN message;
      parameter_kind^.param := nfc$ntf_remote_system_name;
      parameter_value_length := clp$trimmed_string_size (remote_system_name);
      nfp$modify_param_value_length (parameter_value_length);
      parameter_kind^.length_indicated := parameter_value_length > 1;
      IF parameter_kind^.length_indicated THEN
        nfp$put_parameter_value_length (parameter_value_length, message, param_length_size, status);
      ELSE
        param_length_size := 0;
      IFEND;
      NEXT ascii_string: [parameter_value_length] IN message;
      ascii_string^ := remote_system_name (1, parameter_value_length);
      message_length := message_length + parameter_kind_size + param_length_size + parameter_value_length;

      NEXT parameter_kind IN message;
      parameter_kind^.param := nfc$ntf_console_stream_name;
      parameter_value_length := clp$trimmed_string_size (console_stream_name);
      nfp$modify_param_value_length (parameter_value_length);
      parameter_kind^.length_indicated := parameter_value_length > 1;
      IF parameter_kind^.length_indicated THEN
        nfp$put_parameter_value_length (parameter_value_length, message, param_length_size, status);
      ELSE
        param_length_size := 0;
      IFEND;
      NEXT ascii_string: [parameter_value_length] IN message;
      ascii_string^ := console_stream_name (1, parameter_value_length);
      message_length := message_length + parameter_kind_size + param_length_size + parameter_value_length;

      NEXT parameter_kind IN message;
      parameter_kind^.length_indicated := FALSE;
      parameter_kind^.param := nfc$ntf_command_kind;
      NEXT kind IN message;
      kind^ := command_kind;
      message_length := message_length + parameter_kind_size + 1;

      NEXT parameter_kind IN message;
      parameter_kind^.param := nfc$ntf_command_text;
      parameter_value_length := clp$trimmed_string_size (command_text);
      parameter_kind^.length_indicated := parameter_value_length > 1;
      IF parameter_kind^.length_indicated THEN
        nfp$put_parameter_value_length (parameter_value_length, message, param_length_size, status);
      ELSE
        param_length_size := 0;
      IFEND;
      IF parameter_value_length > 0 THEN
        NEXT text: [parameter_value_length] IN message;
        text^ := command_text (1, parameter_value_length);
      ELSE
        parameter_value_length := 1;
        NEXT text: [parameter_value_length] IN message;
        text^ := ' ';
      IFEND;
      message_length := message_length + parameter_kind_size + param_length_size + parameter_value_length;

      NEXT parameter_kind IN message;
      parameter_kind^.param := nfc$ntf_family_name;
      parameter_value_length := clp$trimmed_string_size (family_name);
      nfp$modify_param_value_length (parameter_value_length);
      parameter_kind^.length_indicated := parameter_value_length > 1;
      IF parameter_kind^.length_indicated THEN
        nfp$put_parameter_value_length (parameter_value_length, message, param_length_size, status);
      ELSE
        param_length_size := 0;
      IFEND;
      NEXT ascii_string: [parameter_value_length] IN message;
      ascii_string^ := family_name (1, parameter_value_length);
      message_length := message_length + parameter_kind_size + param_length_size + parameter_value_length;

      NEXT parameter_kind IN message;
      parameter_kind^.param := nfc$ntf_user_name;
      parameter_value_length := clp$trimmed_string_size (user_name);
      nfp$modify_param_value_length (parameter_value_length);
      parameter_kind^.length_indicated := parameter_value_length > 1;
      IF parameter_kind^.length_indicated THEN
        nfp$put_parameter_value_length (parameter_value_length, message, param_length_size, status);
      ELSE
        param_length_size := 0;
      IFEND;
      NEXT ascii_string: [parameter_value_length] IN message;
      ascii_string^ := user_name (1, parameter_value_length);
      message_length := message_length + parameter_kind_size + param_length_size + parameter_value_length;

      NEXT parameter_kind IN message;
      parameter_kind^.length_indicated := FALSE;
      parameter_kind^.param := nfc$null_parameter;
      message_length := message_length + parameter_kind_size;

      nfp$send_message_on_connection (message, message_length, connection^.id, status);
      IF scfs_event_logging THEN
        log_connection_message (connection^, message_length, message);
      IFEND;

    PROCEND forward_send_remote_command_msg;
?? TITLE := 'send_remote_command_resp', EJECT ??

    PROCEDURE send_remote_command_resp
      (VAR message: ^nft$message_sequence;
           response_code: nft$ntf_send_rc_response_codes;
           remote_system_name: ost$name;
           command_kind: nft$ntf_command_kind;
           signon_status: nft$device_status;
           connection: ^nft$connection;
       VAR status: ost$status);

      VAR
        ascii_string: ^string ( * <= osc$max_name_size),
        kind: ^nft$ntf_command_kind,
        message_length: nft$message_length,
        message_type: ^nft$message_kind,
        parameter_kind: ^nft$ntf_send_remote_comm_resp,
        parameter_kind_size: nft$message_length,
        param_length_size: nft$message_length,
        parameter_value_length: integer,
        response_param: ^nft$ntf_send_rc_response_codes,
        signon_stat: ^nft$device_status;

*copy nft$ntf_send_remote_comm_resp

      status.normal := TRUE;
      parameter_kind_size := #SIZE (nft$ntf_send_remote_comm_resp);
      RESET message;

      NEXT message_type IN message;
      message_type^ := nfc$send_ntf_remote_comm_resp;
      message_length := 1;

      NEXT parameter_kind IN message;
      parameter_kind^.param := nfc$ntf_remote_system_name;
      parameter_value_length := clp$trimmed_string_size (remote_system_name);
      nfp$modify_param_value_length (parameter_value_length);
      parameter_kind^.length_indicated := parameter_value_length > 1;
      IF parameter_kind^.length_indicated THEN
        nfp$put_parameter_value_length (parameter_value_length, message, param_length_size, status);
      ELSE
        param_length_size := 0;
      IFEND;
      NEXT ascii_string: [parameter_value_length] IN message;
      ascii_string^ := remote_system_name (1, parameter_value_length);
      message_length := message_length + parameter_kind_size + param_length_size + parameter_value_length;

      NEXT parameter_kind IN message;
      parameter_kind^.length_indicated := FALSE;
      parameter_kind^.param := nfc$ntf_command_kind;
      NEXT kind IN message;
      kind^ := command_kind;
      message_length := message_length + parameter_kind_size + 1;

      NEXT parameter_kind IN message;
      parameter_kind^.length_indicated := FALSE;
      parameter_kind^.param := nfc$ntf_signon_status;
      NEXT signon_stat IN message;
      signon_stat^ := signon_status;
      message_length := message_length + parameter_kind_size + 1;

      NEXT parameter_kind IN message;
      parameter_kind^.length_indicated := FALSE;
      parameter_kind^.param := nfc$response_code;
      NEXT response_param IN message;
      response_param^ := response_code;
      message_length := message_length + parameter_kind_size + 1;

      nfp$send_message_on_connection (message, message_length, connection^.id, status);
      IF scfs_event_logging THEN
        log_connection_message (connection^, message_length, message);
      IFEND;

    PROCEND send_remote_command_resp;
?? OLDTITLE, EJECT ??

    status.normal := TRUE;
    original_message := message;
    original_msg_length := msg_length;
    crack_send_remote_command_msg (message, msg_length, remote_system_name, logical_line_number,
          command_kind, command_text, system_identifier, family_name, user_name, operator_identifier,
          status);
    message_response := nfc$message_accepted;
    signon_status := nfc$ntf_signed_off;
    wait_for_di_message := FALSE;
    CASE command_kind OF
    = nfc$ntf_operator_message, nfc$ntf_user_message =
      broadcast_ntf_message (original_message, original_msg_length, family_name, user_name,
            operator_identifier, messages_sent, status);
      IF NOT messages_sent THEN
        message_response := nfc$ntf_no_users_found;
      IFEND;
    = nfc$ntf_client_command =
      find_ntf_client_connection (system_identifier, client_connection);
      IF client_connection <> NIL THEN
        broadcast_ntf_message (original_message, original_msg_length, osc$null_name, osc$null_name,
              client_connection^.ntf_system_identifier, messages_sent, status);
        IF NOT messages_sent THEN
          message_response := nfc$ntf_client_not_found;
        IFEND;
      ELSE
        message_response := nfc$ntf_client_not_found;
      IFEND;
    ELSE
      IF (command_kind = nfc$ntf_command) OR (command_kind = nfc$ntf_message) THEN
        find_signed_on_logical_line (remote_system_name, connection,
              dir_conn_remote_system_name, logical_line_number);
      ELSE
        dir_conn_remote_system_name := remote_system_name;
        wait_for_di_message := TRUE;
      IFEND;

      find_ntf_remote_system (dir_conn_remote_system_name, remote_system, remote_system_found);
      IF remote_system_found THEN
        find_ntf_logical_line (logical_line_number, remote_system, logical_line,
              logical_line_found);
        IF logical_line_found THEN
          signon_status := logical_line^.signon_status;
          console_stream_name := logical_line^.console_stream_name;
          IF ((command_kind = nfc$ntf_command) OR (command_kind = nfc$ntf_message)) AND
                (signon_status <> nfc$ntf_signed_on) THEN
            message_response := nfc$ntf_incorrect_signon_status;
          ELSEIF (command_kind = nfc$ntf_signon) AND ((signon_status <> nfc$ntf_signon_failed) OR
                (signon_status <> nfc$ntf_signed_off)) THEN
            message_response := nfc$ntf_incorrect_signon_status;
          IFEND;

          IF message_response = nfc$message_accepted THEN
            scfdi_connection := logical_line^.scfdi_connection;
            forward_send_remote_command_msg (message, dir_conn_remote_system_name, console_stream_name,
                  command_kind, command_text, family_name, user_name, scfdi_connection, status);
          IFEND;
        ELSE
          message_response := nfc$ntf_remote_system_not_found;
        IFEND;
      ELSE
        message_response := nfc$ntf_remote_system_not_found;
      IFEND;
    CASEND;

    IF (NOT wait_for_di_message) OR (message_response <> nfc$message_accepted) THEN
      send_remote_command_resp (message, message_response, remote_system_name, command_kind,
              signon_status, connection, status);
    IFEND;

  PROCEND send_ntf_remote_command_message;
?? TITLE := 'send_ntf_remote_command_resp', EJECT ??

{  PURPOSE:
{    This procedure is executed when a response is received from SCF/DI for a
{    command sent to a remote system.  If an operator is connected to a remote
{    system, the response will be sent to the appropriate OPENTF.

  PROCEDURE send_ntf_remote_command_resp
    (VAR message: ^nft$message_sequence;
         message_length: integer;
         connection: ^nft$connection;
     VAR msg_length: integer;
     VAR status: ost$status);

    VAR
      operator_connection: ^nft$connection,
      remote_system: ^nft$io_station,
      remote_system_found: boolean,
      remote_system_name: ost$name;

?? NEWTITLE := 'crack_send_remote_command_resp', EJECT ??

    PROCEDURE crack_send_remote_command_resp
      (VAR message: ^nft$message_sequence;
       VAR msg_length: integer;
       VAR remote_system_name: ost$name;
       VAR status: ost$status);

      VAR
        ascii_string: ^string ( * <= osc$max_name_size),
        byte_array: ^nft$byte_array,
        parameter: ^nft$ntf_send_remote_comm_resp,
        value_length: integer;

*copy nft$ntf_send_remote_comm_resp

      status.normal := TRUE;
      NEXT parameter IN message;

      WHILE (parameter <> NIL) AND (parameter^.param <= nfc$ntf_remote_system_name) AND (msg_length > 0) DO
        msg_length := msg_length - 1;
        IF parameter^.length_indicated THEN
          nfp$get_parameter_value_length (message, msg_length, value_length, status);
          msg_length := msg_length - value_length;
        ELSE
          value_length := 1;
          msg_length := msg_length - 1;
        IFEND;

        CASE parameter^.param OF
        = nfc$ntf_remote_system_name =
          NEXT ascii_string: [value_length] IN message;
          #TRANSLATE (osv$lower_to_upper, ascii_string^, remote_system_name);

        ELSE
{         ERROR ----   Ignore parameter value.
          NEXT byte_array: [1 .. value_length] IN message;

        CASEND;
        NEXT parameter IN message;
      WHILEND;

      RESET message TO parameter;

    PROCEND crack_send_remote_command_resp;
?? OLDTITLE, EJECT ??

    status.normal := TRUE;
    crack_send_remote_command_resp (message, msg_length, remote_system_name, status);
    find_ntf_remote_system (remote_system_name, remote_system, remote_system_found);
    IF remote_system_found THEN
      IF remote_system^.operator_assigned THEN
        operator_connection := remote_system^.connected_operator;
        nfp$send_message_on_connection (message, message_length, operator_connection^.id, status);
        IF scfs_event_logging THEN
          log_connection_message (operator_connection^, message_length, message);
        IFEND;
      IFEND;
    IFEND;

  PROCEND send_ntf_remote_command_resp;
?? TITLE := 'send_ntf_signon_status_message', EJECT ??

{ PURPOSE:
{   Sends a message to all connected NTF operators when the signon status of an
{   NTF logical line changes.

  PROCEDURE send_ntf_signon_status_message
    (    description: string ( * );
         remote_system: ^nft$io_station;
         logical_line: ^nft$ntf_logical_line;
     VAR status: ost$status);

    VAR
      ascii_string: ^string ( * <= osc$max_name_size),
      command_text: nft$ntf_command_text,
      kind: ^nft$ntf_command_kind,
      logical_line_number: ^nft$ntf_logical_line_number,
      message: ^nft$message_sequence,
      message_length: integer,
      message_type: ^nft$message_kind,
      messages_sent: boolean,
      parameter_kind: ^nft$ntf_send_remote_comm_msg,
      parameter_kind_size: nft$message_length,
      param_length_size: nft$message_length,
      parameter_value_length: integer,
      text: ^string ( * <= nfc$ntf_max_command_text_size),
      text_length: integer;

*copy nft$ntf_send_remote_comm_msg

    status.normal := TRUE;
    PUSH message: [[REP nfc$maximum_message_length OF cell]];
    command_text := osc$null_name;
    command_text (osc$max_name_size + 1, * ) := description;
    text_length := clp$trimmed_string_size (command_text);
    command_text (text_length + 1, * ) := ' line_name=';
    text_length := text_length + 11;
    command_text (text_length + 1, * ) := logical_line^.line_name;
    parameter_kind_size := #SIZE (nft$ntf_send_remote_comm_msg);
    RESET message;

    NEXT message_type IN message;
    message_type^ := nfc$send_ntf_remote_comm_msg;
    message_length := 1;

    NEXT parameter_kind IN message;
    parameter_kind^.param := nfc$ntf_remote_system_name;
    parameter_value_length := clp$trimmed_string_size (remote_system^.name);
    nfp$modify_param_value_length (parameter_value_length);
    parameter_kind^.length_indicated := parameter_value_length > 1;
    IF parameter_kind^.length_indicated THEN
      nfp$put_parameter_value_length (parameter_value_length, message, param_length_size, status);
    ELSE
      param_length_size := 0;
    IFEND;

    NEXT ascii_string: [parameter_value_length] IN message;
    ascii_string^ := remote_system^.name (1, parameter_value_length);
    message_length := message_length + parameter_kind_size + param_length_size + parameter_value_length;

    NEXT parameter_kind IN message;
    parameter_kind^.param := nfc$ntf_logical_line_number;
    parameter_value_length := #SIZE (nft$ntf_logical_line_number);
    nfp$modify_param_value_length (parameter_value_length);
    parameter_kind^.length_indicated := parameter_value_length > 1;
    IF parameter_kind^.length_indicated THEN
      nfp$put_parameter_value_length (parameter_value_length, message, param_length_size, status);
    ELSE
      param_length_size := 0;
    IFEND;

    NEXT logical_line_number IN message;
    logical_line_number^ := logical_line^.logical_line_number;
    message_length := message_length + parameter_kind_size + param_length_size + parameter_value_length;

    NEXT parameter_kind IN message;
    parameter_kind^.length_indicated := FALSE;
    parameter_kind^.param := nfc$ntf_command_kind;
    NEXT kind IN message;
    kind^ := nfc$ntf_operator_message;
    message_length := message_length + parameter_kind_size + 1;

    NEXT parameter_kind IN message;
    parameter_kind^.param := nfc$ntf_command_text;
    parameter_value_length := clp$trimmed_string_size (command_text);
    parameter_kind^.length_indicated := parameter_value_length > 1;
    IF parameter_kind^.length_indicated THEN
      nfp$put_parameter_value_length (parameter_value_length, message, param_length_size, status);
    ELSE
      param_length_size := 0;
    IFEND;

    IF parameter_value_length > 0 THEN
      NEXT text: [parameter_value_length] IN message;
      text^ := command_text (1, parameter_value_length);
    ELSE
      parameter_value_length := 1;
      NEXT text: [parameter_value_length] IN message;
      text^ := ' ';
    IFEND;

    message_length := message_length + parameter_kind_size + param_length_size + parameter_value_length;

    NEXT parameter_kind IN message;
    parameter_kind^.length_indicated := FALSE;
    parameter_kind^.param := nfc$null_parameter;
    message_length := message_length + parameter_kind_size;
    broadcast_ntf_message (message, message_length, osc$null_name, osc$null_name,
          nfc$ntf_blank_system_identifier, messages_sent, status);
  PROCEND send_ntf_signon_status_message;
?? TITLE := 'send_operator_message', EJECT ??

{  PURPOSE:
{    This procedure sends a message to OPES containing information
{    for the operator to display.

  PROCEDURE send_operator_message
    (VAR message: ^nft$message_sequence;
         device: ^nft$batch_device;
         operator_message: string (*);
         connection: ^nft$connection;
     VAR status: ost$status);

    VAR
      ascii_string: ^string ( * <= 80),
      io_station: ^nft$io_station,
      length: 0 .. osc$max_name_size,
      message_length: integer,
      message_type: ^nft$message_kind,
      messages_sent: boolean,
      parameter_kind: ^nft$operator_message_parameter,
      parameter_kind_size: nft$message_length,
      param_length_size: nft$message_length,
      parameter_value_length: integer;

*copy nft$operator_message
?? EJECT ??

    io_station := device^.io_station;

    parameter_kind_size := #SIZE (nft$operator_message_parameter);
    RESET message;

    NEXT message_type IN message;
    message_type^ := nfc$operator_message;
    message_length := 1;

    NEXT parameter_kind IN message;
    parameter_kind^.param := nfc$io_station_name;
    parameter_value_length := clp$trimmed_string_size (io_station^.name);
    nfp$modify_param_value_length (parameter_value_length);
    parameter_kind^.length_indicated := parameter_value_length > 1;
    IF parameter_kind^.length_indicated THEN
      nfp$put_parameter_value_length (parameter_value_length, message, param_length_size, status);
    ELSE
      param_length_size := 0;
    IFEND;
    NEXT ascii_string: [parameter_value_length] IN message;
    ascii_string^ := io_station^.name (1, parameter_value_length);
    message_length := message_length + parameter_kind_size + param_length_size + parameter_value_length;

    NEXT parameter_kind IN message;
    parameter_kind^.param := nfc$device_name;
    parameter_value_length := clp$trimmed_string_size (device^.name);
    nfp$modify_param_value_length (parameter_value_length);
    parameter_kind^.length_indicated := parameter_value_length > 1;
    IF parameter_kind^.length_indicated THEN
      nfp$put_parameter_value_length (parameter_value_length, message, param_length_size, status);
    ELSE
      param_length_size := 0;
    IFEND;
    NEXT ascii_string: [parameter_value_length] IN message;
    ascii_string^ := device^.name (1, parameter_value_length);
    message_length := message_length + parameter_kind_size + param_length_size + parameter_value_length;

{   add on text of operator message

    NEXT parameter_kind IN message;
    parameter_kind^.param := nfc$text;
    parameter_value_length := clp$trimmed_string_size (operator_message);
    nfp$modify_param_value_length (parameter_value_length);
    parameter_kind^.length_indicated := parameter_value_length > 1;
    IF parameter_kind^.length_indicated THEN
      nfp$put_parameter_value_length (parameter_value_length, message, param_length_size, status);
    ELSE
      param_length_size := 0;
    IFEND;
    NEXT ascii_string: [parameter_value_length] IN message;
    ascii_string^ := operator_message (1, parameter_value_length);
    message_length := message_length + parameter_kind_size + param_length_size + parameter_value_length;

    NEXT parameter_kind IN message;
    parameter_kind^.length_indicated := FALSE;
    parameter_kind^.param := nfc$null_parameter;
    message_length := message_length + parameter_kind_size;

    IF io_station^.usage <> nfc$ntf_remote_system THEN
      nfp$send_message_on_connection (message, message_length, connection^.id, status);
      IF scfs_event_logging THEN
        log_connection_message (connection^, message_length, message);
      IFEND;
    ELSE
      broadcast_ntf_message (message, message_length, osc$null_name, osc$null_name,
            nfc$ntf_blank_system_identifier, messages_sent, status);
    IFEND;

  PROCEND send_operator_message;
?? TITLE := 'send position file di msg', EJECT ??

{  PURPOSE:
{    This procedure builds/sends a message to SCF/DI indicating the position
{    file values specified by the station operator.  These values will be
{    used to position the output file currently being transferred to the
{    device.

  PROCEDURE send_position_file_di_msg
    (VAR message: ^nft$message_sequence;
         io_station_name: ost$name;
         device_name: ost$name;
         parameter_block: string ( * );
         connection: ^nft$connection;
     VAR status: ost$status);

    VAR
      ascii_string: ^string ( * ),
      message_length: nft$message_length,
      message_type: ^nft$message_kind,
      parameter_kind: ^nft$position_file_di_msg_param,
      parameter_kind_size: nft$message_length,
      param_length_size: nft$message_length,
      parameter_value_length: integer;

*copy nft$di_position_file_message

    parameter_kind_size := #SIZE (nft$position_file_di_msg_param);
    RESET message;

    NEXT message_type IN message;
    message_type^ := nfc$position_file_di;
    message_length := 1;

    NEXT parameter_kind IN message;
    parameter_kind^.param := nfc$io_station_name;
    parameter_value_length := clp$trimmed_string_size (io_station_name);
    nfp$modify_param_value_length (parameter_value_length);
    parameter_kind^.length_indicated := parameter_value_length > 1;
    IF parameter_kind^.length_indicated THEN
      nfp$put_parameter_value_length (parameter_value_length, message, param_length_size, status);
    ELSE
      param_length_size := 0;
    IFEND;
    NEXT ascii_string: [parameter_value_length] IN message;
    ascii_string^ := io_station_name (1, parameter_value_length);
    message_length := message_length + parameter_kind_size + param_length_size + parameter_value_length;

    NEXT parameter_kind IN message;
    parameter_kind^.param := nfc$device_name;
    parameter_value_length := clp$trimmed_string_size (device_name);
    nfp$modify_param_value_length (parameter_value_length);
    parameter_kind^.length_indicated := parameter_value_length > 1;
    IF parameter_kind^.length_indicated THEN
      nfp$put_parameter_value_length (parameter_value_length, message, param_length_size, status);
    ELSE
      param_length_size := 0;
    IFEND;
    NEXT ascii_string: [parameter_value_length] IN message;
    ascii_string^ := device_name (1, parameter_value_length);
    message_length := message_length + parameter_kind_size + param_length_size + parameter_value_length;

    NEXT parameter_kind IN message;
    parameter_kind^.param := nfc$position_parameters;
    parameter_value_length := clp$trimmed_string_size (parameter_block);
    parameter_kind^.length_indicated := parameter_value_length > 1;
    IF parameter_kind^.length_indicated THEN
      nfp$put_parameter_value_length (parameter_value_length, message, param_length_size, status);
    ELSE
      param_length_size := 0;
    IFEND;
    NEXT ascii_string: [parameter_value_length] IN message;
    ascii_string^ := parameter_block (1, parameter_value_length);
    message_length := message_length + parameter_kind_size + param_length_size + parameter_value_length;

    nfp$send_message_on_connection (message, message_length, connection^.id, status);
    IF scfs_event_logging THEN
      log_connection_message (connection^, message_length, message);
    IFEND;

  PROCEND send_position_file_di_msg;
?? TITLE := 'send_queue_entry_msg', EJECT ??

{  PURPOSE:
{    This procedure builds/sends a message to OPES containing information
{    about the specified output file entry.  If there is more than one entry
{    with the file name, the information for each queue entry is returned
{    to OPES.  If optimized is true then a large number of files may be sent,
{    and the information may have to be split into more than one message.
{    For non-optimized only a small number of files are returned.
{
{    This procedure also builds/sends a message to OPENTF containing
{    information about the specified NTF file entry.  If there is more than one
{    entry with the file name, the information for each queue entry is returned
{    to OPENTF.

  PROCEDURE send_queue_entry_msg
    (VAR message: ^nft$message_sequence;
         response: nft$display_status_resp_codes;
         io_station: ^nft$io_station;
         q_file_list: ^nft$queue_file_list;
         connection: ^nft$connection;
         optimized: boolean;
     VAR status: ost$status);

    VAR
      ascii_string: ^string (* <= osc$max_name_size),
      message_length: nft$message_length,
      message_type: ^nft$message_kind,
      parameter_kind: ^nft$queue_entry_msg_parameter,
      parameter_kind_size: nft$message_length,
      param_length_size: nft$message_length,
      parameter_value_length: integer,
      q_ptr: ^nft$queue_file_list,
      response_code: ^nft$display_status_resp_codes,
      time_enqueued: ^ost$date_time;

*copyc nft$queue_entry_data_msg

?? NEWTITLE := 'build_queue_entry_msg', EJECT ??

    PROCEDURE build_queue_entry_msg
      (VAR message: ^nft$message_sequence;
       VAR message_length: nft$message_length;
           io_station: ^nft$io_station;
           parameter_kind_size: nft$message_length;
           response: nft$display_status_resp_codes;
           q_file_list: ^nft$queue_file_list;
           optimized: boolean;
       VAR q_ptr: ^nft$queue_file_list;
       VAR status: ost$status);

{ NOTE - Following constants must be kept small enough so message
{        does not exceed 65K.

      CONST
        max_queue_entries_non_opt = 10,
        max_queue_entries_opt = 128;

      VAR
        ascii_string: ^string ( * <= osc$max_name_size),
        copies: ^nft$copies,
        current_date_time: ost$date_time,
        data_mode: ^nft$output_data_mode,
        destination: ost$name,
        device_type: ^nft$device_type,
        file_size: ^nft$file_size,
        local_status: ost$status,
        max_queue_entries: integer,
        number_of_queue_entries: 0 .. 10,
        output_state: ^nft$file_transfer_state,
        page_format: ^nft$page_format,
        page_length: ^nft$page_length,
        page_width: ^nft$page_width,
        parameter_kind: ^nft$queue_entry_msg_parameter,
        param_length_size: nft$message_length,
        parameter_value_length: integer,
        priority: ^nft$priority,
        q_file: ^nft$output_queue_file,
        q_position: ^integer,
        time_enqueued: ^ost$date_time,
        vertical_print_density: ^nft$file_vertical_print_density;

?? NEWTITLE := 'q_position_of_file', EJECT ??

    FUNCTION q_position_of_file
      (    q_file: ^nft$output_queue_file;
           io_station: ^nft$io_station): integer;

      VAR
        alias_entry: ^nft$alias,
        current_file: ^nft$output_queue_file,
        current_file_priority: nft$priority,
        found_q_file: boolean,
        i: 0 .. 3,
        position_in_q: integer,
        position_in_selected_q: integer,
        q_file_priority: nft$priority,
        selected_file: ^nft$selected_file;

      q_file_priority := calculate_priority (q_file, current_date_time);
      position_in_selected_q := 0;
      found_q_file := FALSE;

      selected_file := io_station^.selected_files_queue;
      WHILE (NOT found_q_file) AND (selected_file <> NIL) DO
        current_file := selected_file^.output_file;
        position_in_selected_q := position_in_selected_q + 1;
        found_q_file := current_file = q_file;
        IF found_q_file THEN
          position_in_q := position_in_selected_q;
        IFEND;
        selected_file := selected_file^.link;
      WHILEND;

      IF NOT found_q_file THEN
        position_in_q := position_in_selected_q + 1;
        FOR i := 0 TO 3 DO
          IF io_station^.alias_list [i] <> NIL THEN
            alias_entry := io_station^.alias_list [i];
            IF alias_entry^.queue <> NIL THEN
              current_file := alias_entry^.queue;
              WHILE current_file <> NIL DO
                found_q_file := found_q_file OR (current_file = q_file);
                IF current_file^.output_state = nfc$eligible_for_transfer THEN
                  current_file_priority := calculate_priority (current_file, current_date_time);
                  IF (found_q_file AND (current_file_priority > q_file_priority)) OR ((NOT found_q_file) AND
                        (current_file_priority >= q_file_priority)) THEN
                    position_in_q := position_in_q + 1;
                  IFEND;
                IFEND;

                current_file := current_file^.link;
              WHILEND;
            IFEND;
          IFEND;
        FOREND;
      IFEND;

      q_position_of_file := position_in_q;

    FUNCEND q_position_of_file;
?? OLDTITLE, EJECT ??

    pmp$get_compact_date_time (current_date_time, local_status);

    IF optimized THEN
      max_queue_entries := max_queue_entries_opt;
    ELSE
      max_queue_entries := max_queue_entries_non_opt;
    IFEND;
    number_of_queue_entries := 0;

{  The q file list contains each queue entry matching the specified file name.

  /send_info_for_each_q_entry/
    WHILE (q_ptr <> NIL) AND (number_of_queue_entries < max_queue_entries) DO
      number_of_queue_entries := number_of_queue_entries + 1;
      q_file := q_ptr^.queue_file;

      NEXT parameter_kind IN message;
      parameter_kind^.param := nfc$system_file_name;
      parameter_value_length := clp$trimmed_string_size (q_file^.system_file_name);
      nfp$modify_param_value_length (parameter_value_length);
      parameter_kind^.length_indicated := parameter_value_length > 1;
      IF parameter_kind^.length_indicated THEN
        nfp$put_parameter_value_length (parameter_value_length, message, param_length_size, status);
      ELSE
        param_length_size := 0;
      IFEND;
      NEXT ascii_string: [parameter_value_length] IN message;
      ascii_string^ := q_file^.system_file_name (1, parameter_value_length);
      message_length := message_length + parameter_kind_size + param_length_size + parameter_value_length;

      IF response = nfc$disp_msg_accepted THEN
        NEXT parameter_kind IN message;
        parameter_kind^.param := nfc$user_file_name;
        parameter_value_length := clp$trimmed_string_size (q_file^.user_file_name);
        nfp$modify_param_value_length (parameter_value_length);
        parameter_kind^.length_indicated := parameter_value_length > 1;
        IF parameter_kind^.length_indicated THEN
          nfp$put_parameter_value_length (parameter_value_length, message, param_length_size, status);
        ELSE
          param_length_size := 0;
        IFEND;
        NEXT ascii_string: [parameter_value_length] IN message;
        ascii_string^ := q_file^.user_file_name (1, parameter_value_length);
        message_length := message_length + parameter_kind_size + param_length_size + parameter_value_length;

        NEXT parameter_kind IN message;
        parameter_kind^.length_indicated := TRUE;
        parameter_kind^.param := nfc$time_enqueued;
        parameter_value_length := #SIZE (ost$date_time);
        nfp$put_parameter_value_length (parameter_value_length, message, param_length_size, status);
        NEXT time_enqueued IN message;
        time_enqueued^ := q_file^.time_stamp;
        message_length := message_length + parameter_kind_size + param_length_size + parameter_value_length;

        NEXT parameter_kind IN message;
        parameter_kind^.length_indicated := TRUE;
        parameter_kind^.param := nfc$position_in_queue;
        parameter_value_length := #SIZE (integer);
        nfp$put_parameter_value_length (parameter_value_length, message, param_length_size, status);
        NEXT q_position IN message;
        IF NOT local_status.normal THEN
          q_position^ := 1;
        ELSE
          q_position^ := q_position_of_file (q_file, io_station);
        IFEND;
        message_length := message_length + parameter_kind_size + param_length_size + parameter_value_length;

        NEXT parameter_kind IN message;
        parameter_kind^.length_indicated := TRUE;
        parameter_kind^.param := nfc$priority;
        parameter_value_length := #SIZE (nft$priority);
        nfp$put_parameter_value_length (parameter_value_length, message, param_length_size, status);
        NEXT priority IN message;
        priority^ := calculate_priority (q_file, current_date_time);
        message_length := message_length + parameter_kind_size + param_length_size + parameter_value_length;

        NEXT parameter_kind IN message;
        parameter_kind^.length_indicated := TRUE;
        parameter_kind^.param := nfc$copies;
        parameter_value_length := #SIZE (nft$copies);
        nfp$put_parameter_value_length (parameter_value_length, message, param_length_size, status);
        NEXT copies IN message;
        copies^ := q_file^.copies;
        message_length := message_length + parameter_kind_size + param_length_size + parameter_value_length;

        NEXT parameter_kind IN message;
        parameter_kind^.param := nfc$create_job_family_name;
        parameter_value_length := clp$trimmed_string_size (q_file^.family_name);
        nfp$modify_param_value_length (parameter_value_length);
        parameter_kind^.length_indicated := parameter_value_length > 1;
        IF parameter_kind^.length_indicated THEN
          nfp$put_parameter_value_length (parameter_value_length, message, param_length_size, status);
        ELSE
          param_length_size := 0;
        IFEND;
        NEXT ascii_string: [parameter_value_length] IN message;
        ascii_string^ := q_file^.family_name (1, parameter_value_length);
        message_length := message_length + parameter_kind_size + param_length_size + parameter_value_length;

        NEXT parameter_kind IN message;
        parameter_kind^.param := nfc$create_system_job_name;
        parameter_value_length := clp$trimmed_string_size (q_file^.system_job_name);
        nfp$modify_param_value_length (parameter_value_length);
        parameter_kind^.length_indicated := parameter_value_length > 1;
        IF parameter_kind^.length_indicated THEN
          nfp$put_parameter_value_length (parameter_value_length, message, param_length_size, status);
        ELSE
          param_length_size := 0;
        IFEND;
        NEXT ascii_string: [parameter_value_length] IN message;
        ascii_string^ := q_file^.system_job_name (1, parameter_value_length);
        message_length := message_length + parameter_kind_size + param_length_size + parameter_value_length;

        NEXT parameter_kind IN message;
        parameter_kind^.param := nfc$create_user_job_name;
        parameter_value_length := clp$trimmed_string_size (q_file^.user_job_name);
        nfp$modify_param_value_length (parameter_value_length);
        parameter_kind^.length_indicated := parameter_value_length > 1;
        IF parameter_kind^.length_indicated THEN
          nfp$put_parameter_value_length (parameter_value_length, message, param_length_size, status);
        ELSE
          param_length_size := 0;
        IFEND;
        NEXT ascii_string: [parameter_value_length] IN message;
        ascii_string^ := q_file^.user_job_name (1, parameter_value_length);
        message_length := message_length + parameter_kind_size + param_length_size + parameter_value_length;

        IF io_station^.usage = nfc$public_io_station THEN
          destination := q_file^.ios_name;
        ELSEIF io_station^.usage = nfc$private_io_station THEN
          destination := control_facility_name;
        IFEND;

        NEXT parameter_kind IN message;
        parameter_kind^.param := nfc$destination_name;
        parameter_value_length := clp$trimmed_string_size (destination);
        nfp$modify_param_value_length (parameter_value_length);
        parameter_kind^.length_indicated := parameter_value_length > 1;
        IF parameter_kind^.length_indicated THEN
          nfp$put_parameter_value_length (parameter_value_length, message, param_length_size, status);
        ELSE
          param_length_size := 0;
        IFEND;
        NEXT ascii_string: [parameter_value_length] IN message;
        ascii_string^ := destination (1, parameter_value_length);
        message_length := message_length + parameter_kind_size + param_length_size + parameter_value_length;

        NEXT parameter_kind IN message;
        parameter_kind^.length_indicated := FALSE;
        parameter_kind^.param := nfc$device_type;
        NEXT device_type IN message;
        device_type^ := q_file^.device_type;
        message_length := message_length + parameter_kind_size + 1;

        NEXT parameter_kind IN message;
        parameter_kind^.length_indicated := TRUE;
        parameter_kind^.param := nfc$file_length;
        parameter_value_length := #SIZE (nft$file_size);
        nfp$put_parameter_value_length (parameter_value_length, message, param_length_size, status);
        NEXT file_size IN message;
        file_size^ := q_file^.file_size;
        message_length := message_length + parameter_kind_size + param_length_size + parameter_value_length;

        NEXT parameter_kind IN message;
        parameter_kind^.length_indicated := FALSE;
        parameter_kind^.param := nfc$output_data_mode;
        NEXT data_mode IN message;
        data_mode^ := q_file^.output_data_mode;
        message_length := message_length + parameter_kind_size + 1;

        IF q_file^.device_name <> osc$null_name THEN
          NEXT parameter_kind IN message;
          parameter_kind^.param := nfc$device_name;
          parameter_value_length := clp$trimmed_string_size (q_file^.device_name);
          parameter_kind^.length_indicated := parameter_value_length > 1;
          IF parameter_kind^.length_indicated THEN
            nfp$put_parameter_value_length (parameter_value_length, message, param_length_size, status);
          ELSE
            param_length_size := 0;
          IFEND;
          NEXT ascii_string: [parameter_value_length] IN message;
          ascii_string^ := q_file^.device_name (1, parameter_value_length);
          message_length := message_length + parameter_kind_size + param_length_size + parameter_value_length;
        IFEND;

        IF q_file^.external_characteristics <> osc$null_name THEN
          NEXT parameter_kind IN message;
          parameter_kind^.param := nfc$external_characteristics;
          parameter_value_length := clp$trimmed_string_size (q_file^.external_characteristics);
          parameter_kind^.length_indicated := parameter_value_length > 1;
          IF parameter_kind^.length_indicated THEN
            nfp$put_parameter_value_length (parameter_value_length, message, param_length_size, status);
          ELSE
            param_length_size := 0;
          IFEND;
          NEXT ascii_string: [parameter_value_length] IN message;
          ascii_string^ := q_file^.external_characteristics (1, parameter_value_length);
          message_length := message_length + parameter_kind_size + param_length_size + parameter_value_length;
        IFEND;

        IF q_file^.forms_code <> osc$null_name THEN
          NEXT parameter_kind IN message;
          parameter_kind^.param := nfc$forms_code;
          parameter_value_length := clp$trimmed_string_size (q_file^.forms_code);
          parameter_kind^.length_indicated := parameter_value_length > 1;
          IF parameter_kind^.length_indicated THEN
            nfp$put_parameter_value_length (parameter_value_length, message, param_length_size, status);
          ELSE
            param_length_size := 0;
          IFEND;
          NEXT ascii_string: [parameter_value_length] IN message;
          ascii_string^ := q_file^.forms_code (1, parameter_value_length);
          message_length := message_length + parameter_kind_size + param_length_size + parameter_value_length;
        IFEND;

        IF q_file^.device_type = nfc$printer THEN
          NEXT parameter_kind IN message;
          parameter_kind^.length_indicated := FALSE;
          parameter_kind^.param := nfc$page_format;
          NEXT page_format IN message;
          page_format^ := q_file^.page_format;
          message_length := message_length + parameter_kind_size + 1;

          NEXT parameter_kind IN message;
          parameter_kind^.length_indicated := FALSE;
          parameter_kind^.param := nfc$page_length;
          NEXT page_length IN message;
          page_length^ := q_file^.page_length;
          message_length := message_length + parameter_kind_size + 1;

          NEXT parameter_kind IN message;
          parameter_kind^.length_indicated := FALSE;
          parameter_kind^.param := nfc$page_width;
          NEXT page_width IN message;
          page_width^ := q_file^.page_width;
          message_length := message_length + parameter_kind_size + 1;

          NEXT parameter_kind IN message;
          parameter_kind^.length_indicated := FALSE;
          parameter_kind^.param := nfc$vertical_print_density;
          NEXT vertical_print_density IN message;
          vertical_print_density^ := q_file^.vertical_print_density;
          message_length := message_length + parameter_kind_size + 1;

          IF q_file^.vfu_load_procedure <> osc$null_name THEN
            NEXT parameter_kind IN message;
            parameter_kind^.param := nfc$vfu_load_procedure;
            parameter_value_length := clp$trimmed_string_size (q_file^.vfu_load_procedure);
            parameter_kind^.length_indicated := parameter_value_length > 1;
            IF parameter_kind^.length_indicated THEN
              nfp$put_parameter_value_length (parameter_value_length, message, param_length_size, status);
            ELSE
              param_length_size := 0;
            IFEND;
            NEXT ascii_string: [parameter_value_length] IN message;
            ascii_string^ := q_file^.vfu_load_procedure (1, parameter_value_length);
            message_length := message_length + parameter_kind_size + param_length_size +
                  parameter_value_length;
          IFEND;

          NEXT parameter_kind IN message;
          parameter_kind^.length_indicated := FALSE;
          parameter_kind^.param := nfc$scfs_output_status;
          NEXT output_state IN message;
          output_state^ := q_file^.output_state;
          message_length := message_length + parameter_kind_size + 1;
        IFEND;

        NEXT parameter_kind IN message;
        parameter_kind^.param := nfc$creating_user_name;
        parameter_value_length := clp$trimmed_string_size (q_file^.user_name);
        nfp$modify_param_value_length (parameter_value_length);
        parameter_kind^.length_indicated := parameter_value_length > 1;
        IF parameter_kind^.length_indicated THEN
          nfp$put_parameter_value_length (parameter_value_length, message, param_length_size, status);
        ELSE
          param_length_size := 0;
        IFEND;
        NEXT ascii_string: [parameter_value_length] IN message;
        ascii_string^ := q_file^.user_name (1, parameter_value_length);
        message_length := message_length + parameter_kind_size + param_length_size + parameter_value_length;
      IFEND;

{  The null parameter is used to let OPES know when the data for each queue
{  entry terminates.  There may be more than one queue file entry in SCFS's
{  queues with the given name, so each entry with that name is returned.

      NEXT parameter_kind IN message;
      parameter_kind^.length_indicated := FALSE;
      parameter_kind^.param := nfc$null_parameter;
      message_length := message_length + parameter_kind_size;

     q_ptr := q_ptr^.link;
   WHILEND /send_info_for_each_q_entry/;

   IF (optimized) AND (q_ptr <> NIL) AND (number_of_queue_entries = max_queue_entries) THEN
     parameter_kind^.param := nfc$queue_entry_data_continues;
   IFEND

   PROCEND build_queue_entry_msg;
?? OLDTITLE, EJECT ??

    parameter_kind_size := #SIZE (nft$queue_entry_msg_parameter);
    q_ptr := q_file_list;

    REPEAT
      RESET message;

      NEXT message_type IN message;
      message_type^ := nfc$queue_entry_data;
      message_length := 1;

      NEXT parameter_kind IN message;
      parameter_kind^.param := nfc$io_station_name;
      parameter_value_length := clp$trimmed_string_size (io_station^.name);
      nfp$modify_param_value_length (parameter_value_length);
      parameter_kind^.length_indicated := parameter_value_length > 1;
      IF parameter_kind^.length_indicated THEN
        nfp$put_parameter_value_length (parameter_value_length, message, param_length_size, status);
      ELSE
        param_length_size := 0;
      IFEND;
      NEXT ascii_string: [parameter_value_length] IN message;
      ascii_string^ := io_station^.name (1, parameter_value_length);
      message_length := message_length + parameter_kind_size + param_length_size + parameter_value_length;

      NEXT parameter_kind IN message;
      parameter_kind^.length_indicated := FALSE;
      parameter_kind^.param := nfc$response_code;
      NEXT response_code IN message;
      response_code^ := response;
      message_length := message_length + parameter_kind_size + 1;

      IF (q_file_list <> NIL) THEN
        build_queue_entry_msg (message, message_length, io_station,
              parameter_kind_size, response, q_file_list, optimized, q_ptr, status);
      ELSE
        NEXT parameter_kind IN message;
        parameter_kind^.length_indicated := FALSE;
        parameter_kind^.param := nfc$null_parameter;
        message_length := message_length + parameter_kind_size;
      IFEND;

      nfp$send_message_on_connection (message, message_length, connection^.id, status);
      IF scfs_event_logging THEN
        log_connection_message (connection^, message_length, message);
      IFEND;
    UNTIL (NOT optimized) OR (q_ptr = NIL);

  PROCEND send_queue_entry_msg;
?? TITLE := 'send queue entry list msg', EJECT ??

{  PURPOSE:
{    This procedure builds/sends a message to OPES containing a list of all
{    system file names and their current priority in the output queue.
{
{    This procedure also builds/sends a message to OPENTF containing a list of
{    all system file names and their current priority in the NTF queue.

  PROCEDURE send_queue_entry_list_msg
    (    response: nft$display_status_resp_codes;
         io_station: ^nft$io_station;
         all_or_top_10: nft$all_or_top_10_q_entries;
         connection: ^nft$connection;
     VAR status: ost$status);

    TYPE
      file_priority_list = record
        link: ^file_priority_list,
        file_priority: nft$file_and_priority,
      recend;

    VAR
      ascii_string: ^string ( * <= osc$max_name_size),
      count: ^nft$file_count,
      count_size: 0 .. 255,
      f_p_l: ^file_priority_list,
      file_count: nft$file_count,
      file_list: ^file_priority_list,
      message: ^nft$message_sequence,
      message_length: nft$message_length,
      message_type: ^nft$message_kind,
      parameter_kind: ^nft$q_entry_list_data_msg_param,
      parameter_kind_size: nft$message_length,
      param_length_size: nft$message_length,
      parameter_value_length: integer,
      q_file_info: ^nft$file_and_priority,
      response_code: ^nft$display_status_resp_codes;

*copyc nft$q_entry_list_data_msg
?? NEWTITLE := 'get_top_10_q_entries', EJECT ??

    PROCEDURE get_top_10_q_entries
      (    io_station: ^nft$io_station;
       VAR file_list: ^file_priority_list;
       VAR file_count: nft$file_count;
       VAR status: ost$status);

      TYPE
        top_10_list = record
          priority: integer,
          name: ost$name,
        recend;

      VAR
        alias_entry: ^nft$alias,
        current_time: ost$date_time,
        file_priority: ^file_priority_list,
        i: nft$file_count,
        q_file: ^nft$output_queue_file,
        q_priority: nft$priority,
        selected_file: ^nft$selected_file,
        top_10: array [1 .. 10] of top_10_list;

?? NEWTITLE := 'put_file_in_top_10', EJECT ??

      PROCEDURE put_file_in_top_10
        (    system_file_name: ost$name;
             q_priority: nft$priority;
         VAR top_10: array [1 .. 10] OF top_10_list;
         VAR file_count: nft$file_count);

        VAR
          i: nft$file_count,
          priority_slot: nft$file_count;

        IF file_count = 0 THEN
          file_count := 1;
          top_10 [1].priority := q_priority;
          top_10 [1].name := system_file_name;

        ELSEIF (file_count = 10) AND (q_priority <= top_10 [file_count].priority) THEN
          ; { This file does not belong in  the top 10.

        ELSEIF (file_count < 10) AND (q_priority <= top_10 [file_count].priority) THEN
          file_count := file_count + 1;
          top_10 [file_count].priority := q_priority;
          top_10 [file_count].name := system_file_name;

        ELSE

        /find_priority_slot/
          FOR i := 1 TO file_count DO
            IF q_priority > top_10 [i].priority THEN
              EXIT /find_priority_slot/;
            IFEND;
          FOREND /find_priority_slot/;
          priority_slot := i;

          IF file_count < 10 THEN
            file_count := file_count + 1;
          IFEND;
          FOR i := file_count DOWNTO (priority_slot + 1) DO
            top_10 [i] := top_10 [i - 1];
          FOREND;
          top_10 [priority_slot].priority := q_priority;
          top_10 [priority_slot].name := system_file_name;
        IFEND;

      PROCEND put_file_in_top_10;
?? OLDTITLE, EJECT ??
      file_list := NIL;
      file_count := 0;
      pmp$get_compact_date_time (current_time, status);

      IF (io_station^.usage <> nfc$ntf_remote_system) AND (io_station^.selected_files_queue <> NIL) THEN
        q_priority := nfc$maximum_priority;
        selected_file := io_station^.selected_files_queue;
        WHILE selected_file <> NIL DO
          q_file := selected_file^.output_file;
          put_file_in_top_10 (q_file^.system_file_name, q_priority, top_10, file_count);
          selected_file := selected_file^.link;
        WHILEND;
      IFEND;

      FOR i := 0 TO 3 DO
        IF io_station^.alias_list [i] <> NIL THEN
          alias_entry := io_station^.alias_list [i];
          IF alias_entry^.queue <> NIL THEN
            q_file := alias_entry^.queue;
            WHILE q_file <> NIL DO
              q_priority := calculate_priority (q_file, current_time);
              put_file_in_top_10 (q_file^.system_file_name, q_priority, top_10, file_count);

              q_file := q_file^.link;
            WHILEND;
          IFEND;
        IFEND;
      FOREND;

      IF file_count > 0 THEN
        ALLOCATE file_list: [clp$trimmed_string_size (top_10 [1].name)];
        file_list^.link := NIL;
        file_list^.file_priority.priority := top_10 [1].priority;
        file_list^.file_priority.name := top_10 [1].name;
        file_priority := file_list;

        FOR i := 2 TO file_count DO
          ALLOCATE file_priority^.link: [clp$trimmed_string_size (top_10 [i].name)];
          file_priority := file_priority^.link;
          file_priority^.link := NIL;
          file_priority^.file_priority.priority := top_10 [i].priority;
          file_priority^.file_priority.name := top_10 [i].name;
        FOREND;
      IFEND;

    PROCEND get_top_10_q_entries;
?? TITLE := 'get all q entries', EJECT ??

    PROCEDURE get_all_q_entries
      (    io_station: ^nft$io_station;
       VAR file_list: ^file_priority_list;
       VAR file_count: nft$file_count;
       VAR status: ost$status);

      VAR
        alias_entry: ^nft$alias,
        current_time: ost$date_time,
        file_priority: ^file_priority_list,
        i: 0 .. 3,
        q_file: ^nft$output_queue_file,
        selected_file: ^nft$selected_file;

?? NEWTITLE := 'add_to_file_priority_list', EJECT ??

      PROCEDURE add_to_file_priority_list
        (    q_file: ^nft$output_queue_file;
         VAR file_count: nft$file_count;
         VAR file_list: ^file_priority_list;
         VAR file_priority: ^file_priority_list);

        VAR
          name_length: ost$name_size;

        name_length := clp$trimmed_string_size (q_file^.system_file_name);
        IF file_list = NIL THEN
          ALLOCATE file_list: [name_length];
          file_priority := file_list;
        ELSE
          ALLOCATE file_priority^.link: [name_length];
          file_priority := file_priority^.link;
        IFEND;
        file_priority^.link := NIL;

        file_priority^.file_priority.priority := calculate_priority (q_file, current_time);
        file_priority^.file_priority.name := q_file^.system_file_name (1, name_length);
        file_count := file_count + 1;

      PROCEND add_to_file_priority_list;
?? OLDTITLE, EJECT ??
      file_list := NIL;
      file_count := 0;
      pmp$get_compact_date_time (current_time, status);

      IF (io_station^.usage <> nfc$ntf_remote_system) AND (io_station^.selected_files_queue <> NIL) THEN
        selected_file := io_station^.selected_files_queue;
        WHILE selected_file <> NIL DO
          q_file := selected_file^.output_file;
          add_to_file_priority_list (q_file, file_count, file_list, file_priority);
          selected_file := selected_file^.link;
        WHILEND;
      IFEND;

      FOR i := 0 TO 3 DO
        IF io_station^.alias_list [i] <> NIL THEN
          alias_entry := io_station^.alias_list [i];
          IF alias_entry^.queue <> NIL THEN
            q_file := alias_entry^.queue;
            WHILE q_file <> NIL DO
              add_to_file_priority_list (q_file, file_count, file_list, file_priority);
              q_file := q_file^.link;
            WHILEND;
          IFEND;
        IFEND;
      FOREND;

    PROCEND get_all_q_entries;
?? OLDTITLE, EJECT ??
    count_size := #SIZE (nft$file_count);
    parameter_kind_size := #SIZE (nft$q_entry_list_data_msg_param);
    PUSH message: [[REP nfc$maximum_send_message_length OF cell]];
    RESET message;

    NEXT message_type IN message;
    message_type^ := nfc$queue_entry_list_data;
    message_length := 1;

    NEXT parameter_kind IN message;
    parameter_kind^.param := nfc$io_station_name;
    parameter_value_length := clp$trimmed_string_size (io_station^.name);
    nfp$modify_param_value_length (parameter_value_length);
    parameter_kind^.length_indicated := parameter_value_length > 1;
    IF parameter_kind^.length_indicated THEN
      nfp$put_parameter_value_length (parameter_value_length, message, param_length_size, status);
    ELSE
      param_length_size := 0;
    IFEND;
    NEXT ascii_string: [parameter_value_length] IN message;
    ascii_string^ := io_station^.name (1, parameter_value_length);
    message_length := message_length + parameter_kind_size + param_length_size + parameter_value_length;

    NEXT parameter_kind IN message;
    parameter_kind^.length_indicated := FALSE;
    parameter_kind^.param := nfc$response_code;
    NEXT response_code IN message;
    response_code^ := response;
    message_length := message_length + parameter_kind_size + 1;

    IF response = nfc$disp_msg_accepted THEN
      IF all_or_top_10 = nfc$top_10_q_entries THEN
        get_top_10_q_entries (io_station, file_list, file_count, status);
      ELSEIF all_or_top_10 = nfc$all_q_entries THEN
        get_all_q_entries (io_station, file_list, file_count, status);
      IFEND;

      NEXT parameter_kind IN message;
      parameter_kind^.length_indicated := TRUE;
      parameter_kind^.param := nfc$number_of_files;
      parameter_value_length := count_size;
      nfp$put_parameter_value_length (parameter_value_length, message, param_length_size, status);
      NEXT count IN message;
      count^ := file_count;
      message_length := message_length + parameter_kind_size + param_length_size + parameter_value_length;

      WHILE file_list <> NIL DO
        f_p_l := file_list;
        NEXT parameter_kind IN message;
        parameter_kind^.length_indicated := TRUE;
        parameter_kind^.param := nfc$sys_file_and_priority;
        parameter_value_length := #SIZE (f_p_l^.file_priority);
        nfp$put_parameter_value_length (parameter_value_length, message, param_length_size, status);
        NEXT q_file_info: [STRLENGTH (f_p_l^.file_priority.name)] IN message;
        q_file_info^ := f_p_l^.file_priority;
        message_length := message_length + parameter_kind_size + param_length_size + parameter_value_length;

        file_list := file_list^.link;
        FREE f_p_l;
      WHILEND;
    IFEND;

    NEXT parameter_kind IN message;
    parameter_kind^.length_indicated := FALSE;
    parameter_kind^.param := nfc$null_parameter;
    message_length := message_length + parameter_kind_size;

    nfp$send_message_on_connection (message, message_length, connection^.id, status);
    IF scfs_event_logging THEN
      log_connection_message (connection^, message_length, message);
    IFEND;

  PROCEND send_queue_entry_list_msg;

?? NEWTITLE := 'send_queue_entry_msg_optimized', EJECT ??

{  PURPOSE:
{    This procedure is executed when a request is received from OPES for
{    detailed information about queue file entries.

  PROCEDURE send_queue_entry_msg_optimized
    (    connection: ^nft$connection;
         io_station: ^nft$io_station;
         all_or_top_10: nft$all_or_top_10_q_entries;
     VAR message: ^nft$message_sequence;
     VAR status: ost$status);

    VAR
      current_ptr: ^nft$queue_file_list,
      file_count: integer,
      ignore_status: ost$status,
      message_area: ^nft$message_sequence,
      q_file: ^nft$output_queue_file,
      q_file_list: ^nft$queue_file_list,
      q_file_ptr: ^nft$queue_file_list,
      response: nft$display_status_resp_codes;

?? NEWTITLE := 'build queue file list', EJECT ??

{  PURPOSE:
{    Build a queue file list containing each queue entry queued for the station.

    PROCEDURE build_queue_file_list
      (    io_station: ^nft$io_station;
           all_or_top_10: nft$all_or_top_10_q_entries;
       VAR q_file_list: ^nft$queue_file_list);

      VAR
        alias_pt: ^nft$alias,
        current_pointer: ^nft$queue_file_list,
        i: 0 .. 3,
        q_file: ^nft$output_queue_file,
        q_file_ptr: ^nft$queue_file_list,
        selected_file: ^nft$selected_file;

?? NEWTITLE := 'add_q_file_ptr_to_list', EJECT ??

      PROCEDURE add_q_file_ptr_to_list
        (    q_file: ^nft$output_queue_file;
         VAR q_file_list: ^nft$queue_file_list;
         VAR current_ptr: ^nft$queue_file_list);

        VAR
          q_file_ptr: ^nft$queue_file_list;

        ALLOCATE q_file_ptr;
        q_file_ptr^.queue_file := q_file;
        q_file_ptr^.link := NIL;
        IF q_file_list = NIL THEN
          q_file_list := q_file_ptr;
        ELSE
          current_ptr^.link := q_file_ptr;
        IFEND;
        current_ptr := q_file_ptr;

      PROCEND add_q_file_ptr_to_list;

?? OLDTITLE, EJECT ??

      current_pointer := NIL;
      file_count := 0;
      q_file := NIL;
      q_file_ptr := NIL;

      IF io_station^.usage <> nfc$ntf_remote_system THEN
        selected_file := io_station^.selected_files_queue;
        WHILE selected_file <> NIL DO
          q_file := selected_file^.output_file;
          add_q_file_ptr_to_list (q_file, q_file_list, current_pointer);
          file_count := file_count+1;
          IF (all_or_top_10 = nfc$top_10_q_entries) AND (file_count = 10) THEN
            RETURN;
          IFEND;
          selected_file := selected_file^.link;
        WHILEND;
      IFEND;

      FOR i := LOWERBOUND (io_station^.alias_list) TO UPPERBOUND (io_station^.alias_list) DO
        alias_pt := io_station^.alias_list [i];
        IF (alias_pt <> NIL) AND (alias_pt^.queue <> NIL) THEN
          q_file := alias_pt^.queue;
          WHILE (q_file <> NIL) DO
            add_q_file_ptr_to_list (q_file, q_file_list, current_pointer);
            file_count := file_count+1;
            IF (all_or_top_10 = nfc$top_10_q_entries) AND (file_count = 10) THEN
              RETURN;
            IFEND;
            q_file := q_file^.link;
          WHILEND;
        IFEND;
      FOREND;

    PROCEND build_queue_file_list;

?? OLDTITLE, EJECT ??

    current_ptr := NIL;
    response := nfc$disp_msg_accepted;
    q_file_list := NIL;
    q_file_ptr := NIL;

    build_queue_file_list (io_station, all_or_top_10, q_file_list);

    IF (q_file_list = NIL) THEN
      response := nfc$disp_unknown_file_name;
      message_area := message;
    ELSE
      PUSH message_area: [[REP nfc$maximum_send_message_length OF cell]];
    IFEND;

    send_queue_entry_msg (message_area, response, io_station, q_file_list, connection,
          {OPTIMIZED} TRUE, ignore_status);

{  Delete the queue file list.

    WHILE (q_file_list <> NIL) DO
      current_ptr := q_file_list;
      q_file_list := current_ptr^.link;
      FREE current_ptr;
    WHILEND;

  PROCEND send_queue_entry_msg_optimized;

?? OLDTITLE ??
?? TITLE := 'send queue status msg', EJECT ??

{  PURPOSE:
{    This procedure builds/sends a message to OPES containing information
{    on the number of files for selector(e.g. particular ec value),
{    total byte length of files for selector, age of oldest file for
{    selector and the average age of files for selector.
{
{    This procedure also builds/sends a message to OPENTF containing
{    information on the number of files for selector (e.g.  particular stream
{    type value), total byte length of files for selector, age of oldest file
{    for selector and the average age of files for selector.

  PROCEDURE send_queue_status_msg
    (VAR message: ^nft$message_sequence;
         response: nft$display_status_resp_codes;
         io_station: ^nft$io_station;
         connection: ^nft$connection;
     VAR status: ost$status);

    TYPE
      list_array = array [0 .. 3] of ^nft$q_status_data,

      q_status_list = record
        link: ^q_status_list,
        status: nft$q_status_data,
      recend;

    VAR
      ascii_string: ^string ( * <= osc$max_name_size),
      count: ^nft$file_count,
      count_size: 0 .. 255,
      destination_list: list_array,
      device_name_list: ^q_status_list,
      device_type_list: ^q_status_list,
      external_characteristic_list: ^q_status_list,
      forms_code_list: ^q_status_list,
      i: 0 .. 3,
      message_length: nft$message_length,
      message_type: ^nft$message_kind,
      parameter_kind: ^nft$queue_status_msg_parameter,
      parameter_kind_size: nft$message_length,
      param_length_size: nft$message_length,
      parameter_value_length: integer,
      q_s_l: ^q_status_list,
      q_status: ^nft$q_status_data,
      response_code: ^nft$display_status_resp_codes;

*copyc nft$queue_status_data_msg
?? NEWTITLE := 'find q status info', EJECT ??

    PROCEDURE find_q_status_info
      (    io_station: ^nft$io_station;
       VAR ext_char_list: ^q_status_list;
       VAR forms_code_list: ^q_status_list;
       VAR device_name_list: ^q_status_list;
       VAR destination_list: list_array;
       VAR device_type_list: ^q_status_list);

      VAR
        alias_entry: ^nft$alias,
        current_date_time: ost$date_time,
        destination_file_age_sum: integer,
        destination_name: ost$name,
        device_name: ^q_status_list,
        device_name_file_age_sum: integer,
        device_type: ^q_status_list,
        device_type_file_age_sum: integer,
        ext_char: ^q_status_list,
        ext_char_file_age_sum: integer,
        file_age: nft$priority,
        forms_code: ^q_status_list,
        forms_code_file_age_sum: integer,
        i: 0 .. 3,
        q_file: ^nft$output_queue_file,
        selected_file: ^nft$selected_file;

?? NEWTITLE := 'add_info_to_q_status_list', EJECT ??

      PROCEDURE add_info_to_q_status_list
        (    q_file_time_stamp: ost$date_time;
             current_date_time: ost$date_time;
             q_file_file_size: nft$file_size;
         VAR file_age_sum: integer;
         VAR q_status: nft$q_status_data);

        VAR
          file_age: nft$priority;

        q_status.file_count := q_status.file_count + 1;
        q_status.total_size := q_status.total_size + q_file_file_size;
        file_age := time_in_scfs_queue (q_file_time_stamp, current_date_time);
        file_age_sum := file_age_sum + file_age;
        q_status.average_age := $INTEGER ($REAL (file_age_sum) / $REAL (q_status.file_count));
        IF file_age > q_status.oldest_age THEN
          q_status.oldest_age := file_age;
        IFEND;

      PROCEND add_info_to_q_status_list;
?? TITLE := 'add to destination list', EJECT ??

      PROCEDURE add_to_destination_list
        (    index: 0 .. 3;
             io_station: ^nft$io_station;
         VAR dest_list_array: list_array;
         VAR destination_name: ost$name);

        VAR
          operator_connection: ^nft$connection;

        IF index = 0 THEN
          IF io_station^.usage = nfc$public_io_station THEN
            destination_name := io_station^.name;
          ELSE
            destination_name := control_facility_name;
          IFEND;
        ELSE
          destination_name := io_station^.alias_names [index];
        IFEND;

        IF destination_name <> osc$null_name THEN
          ALLOCATE dest_list_array [index]: [clp$trimmed_string_size (destination_name)];

          dest_list_array [index]^.name := destination_name;
          dest_list_array [index]^.file_count := 0;
          dest_list_array [index]^.total_size := 0;
          dest_list_array [index]^.oldest_age := 0;
          dest_list_array [index]^.average_age := 0;
          IF destination_name = control_facility_name THEN
            operator_connection := io_station^.connected_operator;
            dest_list_array [index]^.operator_name := operator_connection^.user;
            dest_list_array [index]^.operator_family := operator_connection^.family;
          ELSE
            dest_list_array [index]^.operator_name := '';
            dest_list_array [index]^.operator_family := '';
          IFEND;
        IFEND;

      PROCEND add_to_destination_list;
?? TITLE := 'find device name match', EJECT ??

      PROCEDURE find_device_name_match
        (    device_name_str: ost$name;
         VAR first_device_name_list: ^q_status_list;
         VAR device_name_list: ^q_status_list);

        VAR
          last_device_name_list: ^q_status_list;

        last_device_name_list := NIL;
        device_name_list := first_device_name_list;
        WHILE device_name_list <> NIL DO
          IF device_name_list^.status.name = device_name_str THEN
            RETURN;
          IFEND;
          last_device_name_list := device_name_list;
          device_name_list := device_name_list^.link;
        WHILEND;

        ALLOCATE device_name_list: [clp$trimmed_string_size (device_name_str)];
        IF last_device_name_list <> NIL THEN
          last_device_name_list^.link := device_name_list;
        ELSE
          first_device_name_list := device_name_list;
        IFEND;

        device_name_list^.status.name := device_name_str;
        device_name_list^.status.file_count := 0;
        device_name_list^.status.total_size := 0;
        device_name_list^.status.oldest_age := 0;
        device_name_list^.status.average_age := 0;
        device_name_list^.status.operator_name := '';
        device_name_list^.status.operator_family := '';
        device_name_list^.link := NIL;

      PROCEND find_device_name_match;
?? TITLE := 'find device type match', EJECT ??

      PROCEDURE find_device_type_match
        (    device_type: nft$device_type;
         VAR first_device_type_list: ^q_status_list;
         VAR device_type_list: ^q_status_list);

        VAR
          device_type_str: ost$name,
          last_device_type_list: ^q_status_list;

        CASE device_type OF
        = nfc$reader =
          device_type_str := 'HASP READER';
        = nfc$printer =
          device_type_str := 'PRINTER';
        = nfc$punch =
          device_type_str := 'PUNCH';
        = nfc$plotter =
          device_type_str := 'PLOTTER';
        = nfc$ntf_job_transmitter =
          device_type_str := 'JOB_TRANSMITTER';
        = nfc$ntf_sysout_transmitter =
          device_type_str := 'SYSOUT_TRANSMITTER';
        ELSE
          RETURN;
        CASEND;

        last_device_type_list := NIL;
        device_type_list := first_device_type_list;
        WHILE device_type_list <> NIL DO
          IF device_type_list^.status.name = device_type_str THEN
            RETURN;
          IFEND;
          last_device_type_list := device_type_list;
          device_type_list := device_type_list^.link;
        WHILEND;

        ALLOCATE device_type_list: [clp$trimmed_string_size (device_type_str)];
        IF last_device_type_list <> NIL THEN
          last_device_type_list^.link := device_type_list;
        ELSE
          first_device_type_list := device_type_list;
        IFEND;

        device_type_list^.status.name := device_type_str;
        device_type_list^.status.file_count := 0;
        device_type_list^.status.total_size := 0;
        device_type_list^.status.oldest_age := 0;
        device_type_list^.status.average_age := 0;
        device_type_list^.status.operator_name := '';
        device_type_list^.status.operator_family := '';
        device_type_list^.link := NIL;

      PROCEND find_device_type_match;
?? TITLE := 'find ext characteristic match', EJECT ??

      PROCEDURE find_ext_characteristic_match
        (    external_characteristics: nft$external_characteristics;
         VAR first_ext_char: ^q_status_list;
         VAR ext_char: ^q_status_list);

        VAR
          last_ext_char: ^q_status_list;

        last_ext_char := NIL;
        ext_char := first_ext_char;
        WHILE ext_char <> NIL DO
          IF ext_char^.status.name = external_characteristics THEN
            RETURN;
          IFEND;
          last_ext_char := ext_char;
          ext_char := ext_char^.link;
        WHILEND;

        ALLOCATE ext_char: [clp$trimmed_string_size (external_characteristics)];
        IF last_ext_char <> NIL THEN
          last_ext_char^.link := ext_char;
        ELSE
          first_ext_char := ext_char;
        IFEND;

        ext_char^.status.name := external_characteristics;
        ext_char^.status.file_count := 0;
        ext_char^.status.total_size := 0;
        ext_char^.status.oldest_age := 0;
        ext_char^.status.average_age := 0;
        ext_char^.status.operator_name := '';
        ext_char^.status.operator_family := '';
        ext_char^.link := NIL;

      PROCEND find_ext_characteristic_match;
?? TITLE := 'find forms code match', EJECT ??

      PROCEDURE find_forms_code_match
        (    forms_code_str: nft$forms_code;
         VAR first_forms_code: ^q_status_list;
         VAR forms_code: ^q_status_list);

        VAR
          last_forms_code: ^q_status_list;

        last_forms_code := NIL;
        forms_code := first_forms_code;
        WHILE forms_code <> NIL DO
          IF forms_code^.status.name = forms_code_str THEN
            RETURN;
          IFEND;
          last_forms_code := forms_code;
          forms_code := forms_code^.link;
        WHILEND;

        ALLOCATE forms_code: [clp$trimmed_string_size (forms_code_str)];
        IF last_forms_code <> NIL THEN
          last_forms_code^.link := forms_code;
        ELSE
          first_forms_code := forms_code;
        IFEND;

        forms_code^.status.name := forms_code_str;
        forms_code^.status.file_count := 0;
        forms_code^.status.total_size := 0;
        forms_code^.status.oldest_age := 0;
        forms_code^.status.average_age := 0;
        forms_code^.status.operator_name := '';
        forms_code^.status.operator_family := '';
        forms_code^.link := NIL;

      PROCEND find_forms_code_match;
?? OLDTITLE, EJECT ??

      pmp$get_compact_date_time (current_date_time, status);
      ext_char_file_age_sum := 0;
      forms_code_file_age_sum := 0;
      destination_file_age_sum := 0;
      device_name_file_age_sum := 0;
      device_type_file_age_sum := 0;

      add_to_destination_list (0, io_station, destination_list, destination_name);

      IF (io_station^.usage <> nfc$ntf_remote_system) AND (io_station^.selected_files_queue <> NIL) THEN
        selected_file := io_station^.selected_files_queue;
        WHILE selected_file <> NIL DO
          q_file := selected_file^.output_file;
          add_info_to_q_status_list (q_file^.time_stamp, current_date_time, q_file^.file_size,
                destination_file_age_sum, destination_list [0]^);

          find_device_type_match (q_file^.device_type, device_type_list, device_type);
          add_info_to_q_status_list (q_file^.time_stamp, current_date_time, q_file^.file_size,
                device_type_file_age_sum, device_type^.status);

          IF q_file^.external_characteristics <> osc$null_name THEN
            find_ext_characteristic_match (q_file^.external_characteristics, ext_char_list, ext_char);
            add_info_to_q_status_list (q_file^.time_stamp, current_date_time, q_file^.file_size,
                  ext_char_file_age_sum, ext_char^.status);
          IFEND;

          IF q_file^.forms_code <> osc$null_name THEN
            find_forms_code_match (q_file^.forms_code, forms_code_list, forms_code);
            add_info_to_q_status_list (q_file^.time_stamp, current_date_time, q_file^.file_size,
                  forms_code_file_age_sum, forms_code^.status);
          IFEND;

          IF q_file^.device_name <> osc$null_name THEN
            find_device_name_match (q_file^.device_name, device_name_list, device_name);
            add_info_to_q_status_list (q_file^.time_stamp, current_date_time, q_file^.file_size,
                  device_name_file_age_sum, device_name^.status);
          IFEND;
          selected_file := selected_file^.link;
        WHILEND;
      IFEND;

      FOR i := 0 TO 3 DO
        IF io_station^.alias_list [i] <> NIL THEN
          alias_entry := io_station^.alias_list [i];
          IF alias_entry^.queue <> NIL THEN
            IF i <> 0 THEN
              add_to_destination_list (i, io_station, destination_list, destination_name);
            ELSE
              destination_name := destination_list [0]^.name;
            IFEND;
            q_file := alias_entry^.queue;
            WHILE q_file <> NIL DO
              IF destination_name <> osc$null_name THEN
                add_info_to_q_status_list (q_file^.time_stamp, current_date_time, q_file^.file_size,
                      destination_file_age_sum, destination_list [i]^);
              IFEND;

              find_device_type_match (q_file^.device_type, device_type_list, device_type);
              add_info_to_q_status_list (q_file^.time_stamp, current_date_time, q_file^.file_size,
                    device_type_file_age_sum, device_type^.status);

              IF q_file^.external_characteristics <> osc$null_name THEN
                find_ext_characteristic_match (q_file^.external_characteristics, ext_char_list, ext_char);
                add_info_to_q_status_list (q_file^.time_stamp, current_date_time, q_file^.file_size,
                      ext_char_file_age_sum, ext_char^.status);
              IFEND;

              IF q_file^.forms_code <> osc$null_name THEN
                find_forms_code_match (q_file^.forms_code, forms_code_list, forms_code);
                add_info_to_q_status_list (q_file^.time_stamp, current_date_time, q_file^.file_size,
                      forms_code_file_age_sum, forms_code^.status);
              IFEND;

              IF q_file^.device_name <> osc$null_name THEN
                find_device_name_match (q_file^.device_name, device_name_list, device_name);
                add_info_to_q_status_list (q_file^.time_stamp, current_date_time, q_file^.file_size,
                      device_name_file_age_sum, device_name^.status);
              IFEND;

              q_file := q_file^.link;
            WHILEND;
          IFEND;
        IFEND;
      FOREND;

    PROCEND find_q_status_info;
?? OLDTITLE, EJECT ??

    parameter_kind_size := #SIZE (nft$queue_status_msg_parameter);
    count_size := #SIZE (nft$file_count);
    RESET message;

    NEXT message_type IN message;
    message_type^ := nfc$queue_status_data;
    message_length := 1;

    NEXT parameter_kind IN message;
    parameter_kind^.param := nfc$io_station_name;
    parameter_value_length := clp$trimmed_string_size (io_station^.name);
    nfp$modify_param_value_length (parameter_value_length);
    parameter_kind^.length_indicated := parameter_value_length > 1;
    IF parameter_kind^.length_indicated THEN
      nfp$put_parameter_value_length (parameter_value_length, message, param_length_size, status);
    ELSE
      param_length_size := 0;
    IFEND;
    NEXT ascii_string: [parameter_value_length] IN message;
    ascii_string^ := io_station^.name (1, parameter_value_length);
    message_length := message_length + parameter_kind_size + param_length_size + parameter_value_length;

    NEXT parameter_kind IN message;
    parameter_kind^.length_indicated := FALSE;
    parameter_kind^.param := nfc$response_code;
    NEXT response_code IN message;
    response_code^ := response;
    message_length := message_length + parameter_kind_size + 1;

    IF response = nfc$disp_msg_accepted THEN
      NEXT parameter_kind IN message;
      parameter_kind^.length_indicated := TRUE;
      parameter_kind^.param := nfc$file_count;
      parameter_value_length := count_size;
      nfp$put_parameter_value_length (parameter_value_length, message, param_length_size, status);
      NEXT count IN message;
      count^ := count_of_files_for_station (io_station);
      message_length := message_length + parameter_kind_size + param_length_size + parameter_value_length;

      external_characteristic_list := NIL;
      forms_code_list := NIL;
      device_name_list := NIL;
      destination_list [0] := NIL;
      destination_list [1] := NIL;
      destination_list [2] := NIL;
      destination_list [3] := NIL;
      device_type_list := NIL;
      find_q_status_info (io_station, external_characteristic_list, forms_code_list,
            device_name_list, destination_list, device_type_list);

      NEXT parameter_kind IN message;
      parameter_kind^.length_indicated := TRUE;
      parameter_kind^.param := nfc$ext_chars_count;
      parameter_value_length := count_size;
      nfp$put_parameter_value_length (parameter_value_length, message, param_length_size, status);
      NEXT count IN message;
      count^ := 0;
      message_length := message_length + parameter_kind_size + param_length_size + parameter_value_length;

      WHILE external_characteristic_list <> NIL DO
        count^ := count^ + 1;
        q_s_l := external_characteristic_list;
        NEXT parameter_kind IN message;
        parameter_kind^.length_indicated := TRUE;
        parameter_kind^.param := nfc$ext_char_and_files;
        parameter_value_length := #SIZE (q_s_l^.status);
        nfp$put_parameter_value_length (parameter_value_length, message, param_length_size, status);
        NEXT q_status: [STRLENGTH (q_s_l^.status.name)] IN message;
        q_status^ := q_s_l^.status;
        message_length := message_length + parameter_kind_size + param_length_size + parameter_value_length;

        external_characteristic_list := external_characteristic_list^.link;
        FREE q_s_l;
      WHILEND;

      NEXT parameter_kind IN message;
      parameter_kind^.length_indicated := TRUE;
      parameter_kind^.param := nfc$forms_code_count;
      parameter_value_length := count_size;
      nfp$put_parameter_value_length (parameter_value_length, message, param_length_size, status);
      NEXT count IN message;
      count^ := 0;
      message_length := message_length + parameter_kind_size + param_length_size + parameter_value_length;

      WHILE forms_code_list <> NIL DO
        count^ := count^ + 1;
        q_s_l := forms_code_list;
        NEXT parameter_kind IN message;
        parameter_kind^.length_indicated := TRUE;
        parameter_kind^.param := nfc$forms_code_and_files;
        parameter_value_length := #SIZE (q_s_l^.status);
        nfp$put_parameter_value_length (parameter_value_length, message, param_length_size, status);
        NEXT q_status: [STRLENGTH (q_s_l^.status.name)] IN message;
        q_status^ := q_s_l^.status;
        message_length := message_length + parameter_kind_size + param_length_size + parameter_value_length;

        forms_code_list := forms_code_list^.link;
        FREE q_s_l;
      WHILEND;

      NEXT parameter_kind IN message;
      parameter_kind^.length_indicated := TRUE;
      parameter_kind^.param := nfc$device_count;
      parameter_value_length := count_size;
      nfp$put_parameter_value_length (parameter_value_length, message, param_length_size, status);
      NEXT count IN message;
      count^ := 0;
      message_length := message_length + parameter_kind_size + param_length_size + parameter_value_length;

      WHILE device_name_list <> NIL DO
        count^ := count^ + 1;
        q_s_l := device_name_list;
        NEXT parameter_kind IN message;
        parameter_kind^.length_indicated := TRUE;
        parameter_kind^.param := nfc$device_names_and_files;
        parameter_value_length := #SIZE (q_s_l^.status);
        nfp$put_parameter_value_length (parameter_value_length, message, param_length_size, status);
        NEXT q_status: [STRLENGTH (q_s_l^.status.name)] IN message;
        q_status^ := q_s_l^.status;
        message_length := message_length + parameter_kind_size + param_length_size + parameter_value_length;

        device_name_list := device_name_list^.link;
        FREE q_s_l;
      WHILEND;

      NEXT parameter_kind IN message;
      parameter_kind^.length_indicated := TRUE;
      parameter_kind^.param := nfc$destination_count;
      parameter_value_length := count_size;
      nfp$put_parameter_value_length (parameter_value_length, message, param_length_size, status);
      NEXT count IN message;
      count^ := 0;
      message_length := message_length + parameter_kind_size + param_length_size + parameter_value_length;

      FOR i := 0 TO 3 DO
        IF destination_list [i] <> NIL THEN
          count^ := count^ + 1;
          NEXT parameter_kind IN message;
          parameter_kind^.length_indicated := TRUE;
          parameter_kind^.param := nfc$destinations_and_files;
          parameter_value_length := #SIZE (destination_list [i]^);
          nfp$put_parameter_value_length (parameter_value_length, message, param_length_size, status);
          NEXT q_status: [STRLENGTH (destination_list [i]^.name)] IN message;
          q_status^ := destination_list [i]^;
          message_length := message_length + parameter_kind_size + param_length_size + parameter_value_length;

          FREE destination_list [i];
        IFEND;
      FOREND;

      NEXT parameter_kind IN message;
      parameter_kind^.length_indicated := TRUE;
      parameter_kind^.param := nfc$device_type_count;
      parameter_value_length := count_size;
      nfp$put_parameter_value_length (parameter_value_length, message, param_length_size, status);
      NEXT count IN message;
      count^ := 0;
      message_length := message_length + parameter_kind_size + param_length_size + parameter_value_length;

      WHILE device_type_list <> NIL DO
        count^ := count^ + 1;
        q_s_l := device_type_list;
        NEXT parameter_kind IN message;
        parameter_kind^.length_indicated := TRUE;
        parameter_kind^.param := nfc$device_types_and_files;
        parameter_value_length := #SIZE (q_s_l^.status);
        nfp$put_parameter_value_length (parameter_value_length, message, param_length_size, status);
        NEXT q_status: [STRLENGTH (q_s_l^.status.name)] IN message;
        q_status^ := q_s_l^.status;
        message_length := message_length + parameter_kind_size + param_length_size + parameter_value_length;

        device_type_list := device_type_list^.link;
        FREE q_s_l;
      WHILEND;
    IFEND;

    NEXT parameter_kind IN message;
    parameter_kind^.length_indicated := FALSE;
    parameter_kind^.param := nfc$null_parameter;
    message_length := message_length + parameter_kind_size;

    nfp$send_message_on_connection (message, message_length, connection^.id, status);
    IF scfs_event_logging THEN
      log_connection_message (connection^, message_length, message);
    IFEND;

  PROCEND send_queue_status_msg;
?? TITLE := 'send select file response msg', EJECT ??

{  PURPOSE:
{    This procedure builds/sends a message to OPES indicating the response
{    to a previous select file operator command.
{
{    This procedure also builds/sends a message to OPENTF indicating the
{    response to a previous select file operator command.

  PROCEDURE send_select_file_response_msg
    (VAR message: ^nft$message_sequence;
         io_station_name: ost$name;
         device_name: ost$name;
         file_name: ost$name;
         response_code: nft$select_file_response;
         connection: ^nft$connection;
     VAR status: ost$status);

    VAR
      ascii_string: ^string ( * <= osc$max_name_size),
      message_length: nft$message_length,
      message_type: ^nft$message_kind,
      parameter_kind: ^nft$select_file_resp_parameter,
      parameter_kind_size: nft$message_length,
      param_length_size: nft$message_length,
      parameter_value_length: integer,
      resp_code: ^nft$select_file_response;

*copyc nft$select_file_response_msg

    parameter_kind_size := #SIZE (nft$select_file_resp_parameter);
    RESET message;

    NEXT message_type IN message;
    message_type^ := nfc$select_file_response;
    message_length := 1;

    NEXT parameter_kind IN message;
    parameter_kind^.param := nfc$io_station_name;
    parameter_value_length := clp$trimmed_string_size (io_station_name);
    nfp$modify_param_value_length (parameter_value_length);
    parameter_kind^.length_indicated := parameter_value_length > 1;
    IF parameter_kind^.length_indicated THEN
      nfp$put_parameter_value_length (parameter_value_length, message, param_length_size, status);
    ELSE
      param_length_size := 0;
    IFEND;
    NEXT ascii_string: [parameter_value_length] IN message;
    ascii_string^ := io_station_name (1, parameter_value_length);
    message_length := message_length + parameter_kind_size + param_length_size + parameter_value_length;

    NEXT parameter_kind IN message;
    parameter_kind^.param := nfc$system_file_name;
    parameter_value_length := clp$trimmed_string_size (file_name);
    nfp$modify_param_value_length (parameter_value_length);
    parameter_kind^.length_indicated := parameter_value_length > 1;
    IF parameter_kind^.length_indicated THEN
      nfp$put_parameter_value_length (parameter_value_length, message, param_length_size, status);
    ELSE
      param_length_size := 0;
    IFEND;
    NEXT ascii_string: [parameter_value_length] IN message;
    ascii_string^ := file_name (1, parameter_value_length);
    message_length := message_length + parameter_kind_size + param_length_size + parameter_value_length;

    NEXT parameter_kind IN message;
    parameter_kind^.length_indicated := FALSE;
    parameter_kind^.param := nfc$response_code;
    NEXT resp_code IN message;
    resp_code^ := response_code;
    message_length := message_length + parameter_kind_size + 1;

    IF device_name <> osc$null_name THEN
      NEXT parameter_kind IN message;
      parameter_kind^.param := nfc$device_name;
      parameter_value_length := clp$trimmed_string_size (device_name);
      parameter_kind^.length_indicated := parameter_value_length > 1;
      IF parameter_kind^.length_indicated THEN
        nfp$put_parameter_value_length (parameter_value_length, message, param_length_size, status);
      ELSE
        param_length_size := 0;
      IFEND;
      NEXT ascii_string: [parameter_value_length] IN message;
      ascii_string^ := device_name (1, parameter_value_length);
      message_length := message_length + parameter_kind_size + param_length_size + parameter_value_length;
    IFEND;

    NEXT parameter_kind IN message;
    parameter_kind^.length_indicated := FALSE;
    parameter_kind^.param := nfc$null_parameter;
    message_length := message_length + parameter_kind_size;

    nfp$send_message_on_connection (message, message_length, connection^.id, status);
    IF scfs_event_logging THEN
      log_connection_message (connection^, message_length, message);
    IFEND;

  PROCEND send_select_file_response_msg;
?? TITLE := 'send start io station msg', EJECT ??

{  PURPOSE:
{    This procedure builds/sends a message informing SCF/DI that an operator
{    has now been assigned to the I/O station.

  PROCEDURE send_start_io_station_msg
    (VAR message: ^nft$message_sequence;
         station_name: ost$name;
         operator_name: ost$name;
         operator_family: ost$name;
         connection: ^nft$connection;
     VAR status: ost$status);

*copyc nft$start_io_station_msg

    VAR
      ascii_string: ^string ( * <= osc$max_name_size),
      message_length: nft$message_length,
      message_type: ^nft$message_kind,
      parameter_kind: ^nft$start_ios_message_parameter,
      parameter_kind_size: nft$message_length,
      param_length_size: nft$message_length,
      parameter_value_length: integer;

    parameter_kind_size := #SIZE (nft$start_ios_message_parameter);
    RESET message;

    NEXT message_type IN message;
    message_type^ := nfc$start_io_station;
    message_length := 1;

    NEXT parameter_kind IN message;
    parameter_kind^.param := nfc$io_station_name;
    parameter_value_length := clp$trimmed_string_size (station_name);
    nfp$modify_param_value_length (parameter_value_length);
    parameter_kind^.length_indicated := parameter_value_length > 1;
    IF parameter_kind^.length_indicated THEN
      nfp$put_parameter_value_length (parameter_value_length, message, param_length_size, status);
    ELSE
      param_length_size := 0;
    IFEND;
    NEXT ascii_string: [parameter_value_length] IN message;
    ascii_string^ := station_name (1, parameter_value_length);
    message_length := message_length + parameter_kind_size + param_length_size + parameter_value_length;

    NEXT parameter_kind IN message;
    parameter_kind^.length_indicated := TRUE;
    parameter_kind^.param := nfc$user_identity;
    parameter_value_length := osc$max_name_size * 2;
    nfp$put_parameter_value_length (parameter_value_length, message, param_length_size, status);
    NEXT ascii_string: [osc$max_name_size] IN message;
    ascii_string^ := operator_name;
    NEXT ascii_string: [osc$max_name_size] IN message;
    ascii_string^ := operator_family;
    message_length := message_length + parameter_kind_size + param_length_size + parameter_value_length;

    nfp$send_message_on_connection (message, message_length, connection^.id, status);
    IF scfs_event_logging THEN
      log_connection_message (connection^, message_length, message);
    IFEND;

  PROCEND send_start_io_station_msg;
?? TITLE := 'send station status msg', EJECT ??

{  PURPOSE:
{    This procedure builds/sends a message to OPES containing the station
{    information if the response is normal.

  PROCEDURE send_station_status_msg
    (VAR message: ^nft$message_sequence;
         response: nft$display_status_resp_codes;
         io_station: ^nft$io_station;
         connection: ^nft$connection;
     VAR status: ost$status);

    VAR
      ascii_string: ^string ( * <= osc$max_name_size),
      destination_unavail_action: ^nft$destination_unavail_actions,
      device: ^nft$batch_device,
      device_count: ^integer,
      file_ack: ^boolean,
      file_count: ^integer,
      message_length: nft$message_length,
      message_type: ^nft$message_kind,
      name_and_status: ^nft$device_status_data,
      parameter_kind: ^nft$station_status_msg_param,
      parameter_kind_size: nft$message_length,
      param_length_size: nft$message_length,
      parameter_value_length: integer,
      pm_message_action: ^nft$pm_message_actions,
      response_code: ^nft$display_status_resp_codes,
      station_usage: ^nft$io_station_usage;

*copyc nft$station_status_msg

    parameter_kind_size := #SIZE (nft$station_status_msg_param);
    RESET message;

    NEXT message_type IN message;
    message_type^ := nfc$station_status_data;
    message_length := 1;

    NEXT parameter_kind IN message;
    parameter_kind^.param := nfc$io_station_name;
    parameter_value_length := clp$trimmed_string_size (io_station^.name);
    nfp$modify_param_value_length (parameter_value_length);
    parameter_kind^.length_indicated := parameter_value_length > 1;
    IF parameter_kind^.length_indicated THEN
      nfp$put_parameter_value_length (parameter_value_length, message, param_length_size, status);
    ELSE
      param_length_size := 0;
    IFEND;
    NEXT ascii_string: [parameter_value_length] IN message;
    ascii_string^ := io_station^.name (1, parameter_value_length);
    message_length := message_length + parameter_kind_size + param_length_size + parameter_value_length;

    NEXT parameter_kind IN message;
    parameter_kind^.length_indicated := FALSE;
    parameter_kind^.param := nfc$response_code;
    NEXT response_code IN message;
    response_code^ := response;
    message_length := message_length + parameter_kind_size + 1;

    IF response = nfc$disp_msg_accepted THEN
      NEXT parameter_kind IN message;
      parameter_kind^.param := nfc$control_facility;
      parameter_value_length := clp$trimmed_string_size (control_facility_name);
      nfp$modify_param_value_length (parameter_value_length);
      parameter_kind^.length_indicated := parameter_value_length > 1;
      IF parameter_kind^.length_indicated THEN
        nfp$put_parameter_value_length (parameter_value_length, message, param_length_size, status);
      ELSE
        param_length_size := 0;
      IFEND;
      NEXT ascii_string: [parameter_value_length] IN message;
      ascii_string^ := control_facility_name (1, parameter_value_length);
      message_length := message_length + parameter_kind_size + param_length_size + parameter_value_length;

      NEXT parameter_kind IN message;
      parameter_kind^.length_indicated := TRUE;
      parameter_kind^.param := nfc$number_of_files_queued;
      parameter_value_length := #SIZE (integer);
      nfp$put_parameter_value_length (parameter_value_length, message, param_length_size, status);
      NEXT file_count IN message;
      file_count^ := count_of_files_for_station (io_station);
      message_length := message_length + parameter_kind_size + param_length_size + parameter_value_length;

      NEXT parameter_kind IN message;
      parameter_kind^.length_indicated := FALSE;
      parameter_kind^.param := nfc$station_usage;
      NEXT station_usage IN message;
      station_usage^ := io_station^.usage;
      message_length := message_length + parameter_kind_size + 1;

      NEXT parameter_kind IN message;
      parameter_kind^.length_indicated := FALSE;
      parameter_kind^.param := nfc$file_acknowledgement;
      NEXT file_ack IN message;
      file_ack^ := io_station^.file_acknowledgement;
      message_length := message_length + parameter_kind_size + 1;

      NEXT parameter_kind IN message;
      parameter_kind^.length_indicated := TRUE;
      parameter_kind^.param := nfc$count_of_devices;
      parameter_value_length := #SIZE (integer);
      nfp$put_parameter_value_length (parameter_value_length, message, param_length_size, status);
      NEXT device_count IN message;
{   DEVICE_COUNT^ will be filled in later when the device count is known.
      message_length := message_length + parameter_kind_size + param_length_size + parameter_value_length;

      device_count^ := 0;
      device := io_station^.batch_device_list;
      WHILE device <> NIL DO
        device_count^ := device_count^ + 1;

        NEXT parameter_kind IN message;
        parameter_kind^.length_indicated := TRUE;
        parameter_kind^.param := nfc$device_name_status;
        parameter_value_length := #SIZE (nft$device_status) + #SIZE (nft$file_transfer_status) + #SIZE
              (nft$device_type) + clp$trimmed_string_size (device^.name);
        nfp$put_parameter_value_length (parameter_value_length, message, param_length_size, status);
        NEXT name_and_status: [clp$trimmed_string_size (device^.name)] IN message;
        message_length := message_length + parameter_kind_size + param_length_size + parameter_value_length;

        name_and_status^.device_status := device^.device_status;
        name_and_status^.file_xfer_status := device^.file_transfer_status;
        name_and_status^.device_type := device^.device_type;
        name_and_status^.name := device^.name;

        device := device^.link;
      WHILEND;

      IF io_station^.required_operator_device <> osc$null_name THEN
        NEXT parameter_kind IN message;
        parameter_kind^.param := nfc$req_console_device;
        parameter_value_length := clp$trimmed_string_size (io_station^.required_operator_device);
        parameter_kind^.length_indicated := parameter_value_length > 1;
        IF parameter_kind^.length_indicated THEN
          nfp$put_parameter_value_length (parameter_value_length, message, param_length_size, status);
        ELSE
          param_length_size := 0;
        IFEND;
        NEXT ascii_string: [parameter_value_length] IN message;
        ascii_string^ := io_station^.required_operator_device (1, parameter_value_length);
        message_length := message_length + parameter_kind_size + param_length_size + parameter_value_length;
      IFEND;

      IF io_station^.alias_names [1] <> osc$null_name THEN
        NEXT parameter_kind IN message;
        parameter_kind^.param := nfc$io_station_alias_1;
        parameter_value_length := clp$trimmed_string_size (io_station^.alias_names [1]);
        parameter_kind^.length_indicated := parameter_value_length > 1;
        IF parameter_kind^.length_indicated THEN
          nfp$put_parameter_value_length (parameter_value_length, message, param_length_size, status);
        ELSE
          param_length_size := 0;
        IFEND;
        NEXT ascii_string: [parameter_value_length] IN message;
        ascii_string^ := io_station^.alias_names [1] (1, parameter_value_length);
        message_length := message_length + parameter_kind_size + param_length_size + parameter_value_length;
      IFEND;

      IF io_station^.alias_names [2] <> osc$null_name THEN
        NEXT parameter_kind IN message;
        parameter_kind^.param := nfc$io_station_alias_2;
        parameter_value_length := clp$trimmed_string_size (io_station^.alias_names [2]);
        parameter_kind^.length_indicated := parameter_value_length > 1;
        IF parameter_kind^.length_indicated THEN
          nfp$put_parameter_value_length (parameter_value_length, message, param_length_size, status);
        ELSE
          param_length_size := 0;
        IFEND;
        NEXT ascii_string: [parameter_value_length] IN message;
        ascii_string^ := io_station^.alias_names [2] (1, parameter_value_length);
        message_length := message_length + parameter_kind_size + param_length_size + parameter_value_length;
      IFEND;

      IF io_station^.alias_names [3] <> osc$null_name THEN
        NEXT parameter_kind IN message;
        parameter_kind^.param := nfc$io_station_alias_3;
        parameter_value_length := clp$trimmed_string_size (io_station^.alias_names [3]);
        parameter_kind^.length_indicated := parameter_value_length > 1;
        IF parameter_kind^.length_indicated THEN
          nfp$put_parameter_value_length (parameter_value_length, message, param_length_size, status);
        ELSE
          param_length_size := 0;
        IFEND;
        NEXT ascii_string: [parameter_value_length] IN message;
        ascii_string^ := io_station^.alias_names [3] (1, parameter_value_length);
        message_length := message_length + parameter_kind_size + param_length_size + parameter_value_length;
      IFEND;

      IF io_station^.default_job_destination <> osc$null_name THEN
        NEXT parameter_kind IN message;
        parameter_kind^.param := nfc$default_job_destination;
        parameter_value_length := clp$trimmed_string_size (io_station^.default_job_destination);
        parameter_kind^.length_indicated := parameter_value_length > 1;
        IF parameter_kind^.length_indicated THEN
          nfp$put_parameter_value_length (parameter_value_length, message, param_length_size, status);
        ELSE
          param_length_size := 0;
        IFEND;
        NEXT ascii_string: [parameter_value_length] IN message;
        ascii_string^ := io_station^.default_job_destination (1, parameter_value_length);
        message_length := message_length + parameter_kind_size + param_length_size + parameter_value_length;
      IFEND;

      NEXT parameter_kind IN message;
      parameter_kind^.length_indicated := FALSE;
      parameter_kind^.param := nfc$destination_unavail_action;
      NEXT destination_unavail_action IN message;
      destination_unavail_action^ := io_station^.destination_unavailable_action;
      message_length := message_length + parameter_kind_size + 1;

      NEXT parameter_kind IN message;
      parameter_kind^.length_indicated := FALSE;
      parameter_kind^.param := nfc$pm_message_action;
      NEXT pm_message_action IN message;
      pm_message_action^ := io_station^.pm_message_action;
      message_length := message_length + parameter_kind_size + 1;

    IFEND;

    NEXT parameter_kind IN message;
    parameter_kind^.length_indicated := FALSE;
    parameter_kind^.param := nfc$null_parameter;
    message_length := message_length + parameter_kind_size;

    nfp$send_message_on_connection (message, message_length, connection^.id, status);
    IF scfs_event_logging THEN
      log_connection_message (connection^, message_length, message);
    IFEND;

  PROCEND send_station_status_msg;
?? TITLE := 'send stop io station msg', EJECT ??

  PROCEDURE send_stop_io_station_msg
    (VAR message: ^nft$message_sequence;
         station_name: ost$name;
         connection: ^nft$connection;
     VAR status: ost$status);

*copyc nft$stop_io_station_msg

    VAR
      ascii_string: ^string ( * <= osc$max_name_size),
      message_length: nft$message_length,
      message_type: ^nft$message_kind,
      parameter_kind: ^nft$stop_ios_message_parameter,
      parameter_kind_size: nft$message_length,
      param_length_size: nft$message_length,
      parameter_value_length: integer;

    parameter_kind_size := #SIZE (nft$stop_ios_message_parameter);
    RESET message;

    NEXT message_type IN message;
    message_type^ := nfc$stop_io_station;
    message_length := 1;

    NEXT parameter_kind IN message;
    parameter_kind^.param := nfc$io_station_name;
    parameter_value_length := clp$trimmed_string_size (station_name);
    nfp$modify_param_value_length (parameter_value_length);
    parameter_kind^.length_indicated := parameter_value_length > 1;
    IF parameter_kind^.length_indicated THEN
      nfp$put_parameter_value_length (parameter_value_length, message, param_length_size, status);
    ELSE
      param_length_size := 0;
    IFEND;
    NEXT ascii_string: [parameter_value_length] IN message;
    ascii_string^ := station_name (1, parameter_value_length);
    message_length := message_length + parameter_kind_size + param_length_size + parameter_value_length;

    nfp$send_message_on_connection (message, message_length, connection^.id, status);
    IF scfs_event_logging THEN
      log_connection_message (connection^, message_length, message);
    IFEND;

  PROCEND send_stop_io_station_msg;
?? TITLE := 'start batch device msg', EJECT ??

{  PURPOSE:
{    This procedure is executed when a message is received from OPES
{    indicating the operator entered a start batch device command.
{    A maintained file transfer will restart at its suspended position
{    when the device was stopped.  This command reinstates a device for
{    selection.
{
{    This procedure is also executed when a message is received from OPENTF
{    indicating the operator entered a start batch stream command.  This
{    command reinstates a stream for selection.

  PROCEDURE start_batch_device_msg
    (VAR message: ^nft$message_sequence;
         message_length: integer;
         connection: ^nft$connection;
     VAR msg_length: integer;
     VAR status: ost$status);

    VAR
      bd_connection: ^nft$connection,
      device: ^nft$batch_device,
      device_found: boolean,
      device_name: ost$name,
      io_station: ^nft$io_station,
      io_station_found: boolean,
      io_station_name: ost$name,
      response: nft$device_control_resp_codes;

*copy nft$start_batch_device_msg
?? NEWTITLE := 'crack start batch device msg', EJECT ??

    PROCEDURE crack_start_batch_device_msg
      (VAR message: ^nft$message_sequence;
       VAR msg_length: integer;
       VAR io_station_name: ost$name;
       VAR device_name: ost$name;
       VAR status: ost$status);

      VAR
        ascii_string: ^string ( * <= osc$max_name_size),
        byte_array: ^nft$byte_array,
        parameter: ^nft$start_bd_message_parameter,
        value_length: integer;

      NEXT parameter IN message;

      WHILE (parameter <> NIL) AND (parameter^.param <> nfc$null_parameter) AND (msg_length > 0) DO
        msg_length := msg_length - 1;
        IF parameter^.length_indicated THEN
          nfp$get_parameter_value_length (message, msg_length, value_length, status);
          msg_length := msg_length - value_length;
        ELSE
          value_length := 1;
          msg_length := msg_length - 1;
        IFEND;

        CASE parameter^.param OF
        = nfc$io_station_name =
          NEXT ascii_string: [value_length] IN message;
          #translate (osv$lower_to_upper, ascii_string^, io_station_name);

        = nfc$device_name =
          NEXT ascii_string: [value_length] IN message;
          #translate (osv$lower_to_upper, ascii_string^, device_name);

        ELSE
{         ERROR ----   Ignore parameter value.
          NEXT byte_array: [1 .. value_length] IN message;

        CASEND;
        NEXT parameter IN message;
      WHILEND;

    PROCEND crack_start_batch_device_msg;
?? OLDTITLE, EJECT ??

    crack_start_batch_device_msg (message, msg_length, io_station_name, device_name, status);

    find_io_station_or_remote_sys (io_station_name, connection, io_station, io_station_found);
    IF NOT io_station_found THEN
      response := nfc$dc_msg_reject_unknown_ios;
    ELSE
      find_batch_device (device_name, io_station, device, device_found);
      IF NOT device_found THEN
        response := nfc$dc_msg_reject_unknown_dev;
      ELSE
        response := nfc$dc_msg_accepted;
        bd_connection := device^.scfdi_connection;
        nfp$send_message_on_connection (message, message_length, bd_connection^.id, status);
        IF scfs_event_logging THEN
          log_connection_message (bd_connection^, message_length, message);
        IFEND;
        device^.outstanding_di_responses [nfc$start_bd] := device^.outstanding_di_responses [nfc$start_bd] +
              1;
      IFEND;
    IFEND;

    IF response > nfc$dc_msg_accepted THEN
      send_device_control_response (message, nfc$start_batch_device_resp, io_station_name, device_name,
            response, connection, status);
    IFEND;

  PROCEND start_batch_device_msg;
?? TITLE := 'start batch device resp', EJECT ??

{  PURPOSE:
{    This procedure is executed when a response is received from SCF/DI in
{    response to a start batch device command that was forwarded from OPES.
{
{    This procedure is also executed when a response is received from SCF/DI in
{    response to a start batch stream command that was forwarded from OPENTF.

  PROCEDURE start_batch_device_resp
    (VAR message: ^nft$message_sequence;
         message_length: integer;
         connection: ^nft$connection;
     VAR msg_length: integer;
     VAR status: ost$status);

    VAR
      device: ^nft$batch_device,
      device_found: boolean,
      device_name: ost$name,
      io_station: ^nft$io_station,
      io_station_found: boolean,
      io_station_name: ost$name,
      operator_connection: ^nft$connection,
      response_code: nft$device_control_resp_codes;

    crack_device_control_resp (message, msg_length, io_station_name, device_name, response_code, status);

    find_io_station_or_remote_sys (io_station_name, connection, io_station, io_station_found);
    IF io_station_found THEN
      find_batch_device (device_name, io_station, device, device_found);
      IF device_found THEN
        device^.outstanding_di_responses [nfc$start_bd] := device^.outstanding_di_responses [nfc$start_bd] -
              1;

        device^.device_status := nfc$device_active;
        device^.device_timer_activated := FALSE;
        device^.timer_start_time := 0;
        device^.number_of_files_requeued := 0;

        IF io_station^.operator_assigned THEN
          operator_connection := io_station^.connected_operator;
          nfp$send_message_on_connection (message, message_length, operator_connection^.id, status);
          IF scfs_event_logging THEN
            log_connection_message (operator_connection^, message_length, message);
          IFEND;
        IFEND;

        IF device_available_for_output (device) THEN
          find_file_for_device (device, message, status);
        IFEND;
      IFEND;
    IFEND;

  PROCEND start_batch_device_resp;
?? TITLE := 'stop batch device msg', EJECT ??

{  PURPOSE:
{    This procedure is executed when a message is received from OPES
{    indicating a stop batch device command was entered by the
{    station operator.  The device is removed from service
{    immediatedly if the file disposition = drop, requeue or hold.  If the
{    file disposition = finish, the file transfer continues until it is
{    complete.
{
{    This procedure is also executed when a message is received from OPENTF
{    indicating a stop batch stream command was entered by the NTF operator.
{    The stream is removed from service immediatedly if the file disposition =
{    drop, requeue or hold.  If the file disposition = finish, the file
{    transfer continues until it is complete.

  PROCEDURE stop_batch_device_msg
    (VAR message: ^nft$message_sequence;
         message_length: integer;
         connection: ^nft$connection;
     VAR msg_length: integer;
     VAR status: ost$status);

    VAR
      bd_connection: ^nft$connection,
      device: ^nft$batch_device,
      device_found: boolean,
      device_name: ost$name,
      file_disposition: nft$file_disposition,
      io_station: ^nft$io_station,
      io_station_found: boolean,
      io_station_name: ost$name,
      response: nft$device_control_resp_codes;

*copy nft$stop_batch_device_msg
?? NEWTITLE := 'crack stop batch device msg', EJECT ??

    PROCEDURE crack_stop_batch_device_msg
      (VAR message: ^nft$message_sequence;
       VAR msg_length: integer;
       VAR io_station_name: ost$name;
       VAR device_name: ost$name;
       VAR file_disposition: nft$file_disposition;
       VAR status: ost$status);

      VAR
        ascii_string: ^string ( * <= osc$max_name_size),
        byte_array: ^nft$byte_array,
        disposition: ^nft$file_disposition,
        parameter: ^nft$stop_bd_message_parameter,
        value_length: integer;

      NEXT parameter IN message;

      WHILE (parameter <> NIL) AND (parameter^.param <> nfc$null_parameter) AND (msg_length > 0) DO
        msg_length := msg_length - 1;
        IF parameter^.length_indicated THEN
          nfp$get_parameter_value_length (message, msg_length, value_length, status);
          msg_length := msg_length - value_length;
        ELSE
          value_length := 1;
          msg_length := msg_length - 1;
        IFEND;

        CASE parameter^.param OF
        = nfc$io_station_name =
          NEXT ascii_string: [value_length] IN message;
          #translate (osv$lower_to_upper, ascii_string^, io_station_name);

        = nfc$device_name =
          NEXT ascii_string: [value_length] IN message;
          #translate (osv$lower_to_upper, ascii_string^, device_name);

        = nfc$file_disposition =
          NEXT disposition IN message;
          file_disposition := disposition^;

        ELSE
{         ERROR ----   Ignore parameter value.
          NEXT byte_array: [1 .. value_length] IN message;

        CASEND;
        NEXT parameter IN message;
      WHILEND;

    PROCEND crack_stop_batch_device_msg;
?? OLDTITLE, EJECT ??
{   Crack Stop Batch Device msg.
    crack_stop_batch_device_msg (message, msg_length, io_station_name, device_name, file_disposition, status);

    find_io_station_or_remote_sys (io_station_name, connection, io_station, io_station_found);
    IF NOT io_station_found THEN
      response := nfc$dc_msg_reject_unknown_ios;
    ELSE
      find_batch_device (device_name, io_station, device, device_found);
      IF NOT device_found THEN
        response := nfc$dc_msg_reject_unknown_dev;
      ELSE
        response := nfc$dc_msg_accepted;
        bd_connection := device^.scfdi_connection;
        nfp$send_message_on_connection (message, message_length, bd_connection^.id, status);
        IF scfs_event_logging THEN
          log_connection_message (bd_connection^, message_length, message);
        IFEND;
        device^.outstanding_di_responses [nfc$stop_bd] := device^.outstanding_di_responses [nfc$stop_bd] + 1;
      IFEND;
    IFEND;

    IF response > nfc$dc_msg_accepted THEN
      send_device_control_response (message, nfc$stop_batch_device_resp, io_station_name, device_name,
            response, connection, status);
    IFEND;

  PROCEND stop_batch_device_msg;
?? TITLE := 'stop batch device resp', EJECT ??

{  PURPOSE:
{    This procedure is executed when a message is received from SCF/DI
{    in response to a station operator stop batch device command that was
{    forwarded from OPES.
{
{    This procedure is also executed when a message is received from SCF/DI in
{    response to a NTF operator stop batch stream command that was forwarded
{    from OPENTF.

  PROCEDURE stop_batch_device_resp
    (VAR message: ^nft$message_sequence;
         message_length: integer;
         connection: ^nft$connection;
     VAR msg_length: integer;
     VAR status: ost$status);

    VAR
      device: ^nft$batch_device,
      device_found: boolean,
      device_name: ost$name,
      io_station: ^nft$io_station,
      io_station_found: boolean,
      io_station_name: ost$name,
      operator_connection: ^nft$connection,
      response_code: nft$device_control_resp_codes;

    crack_device_control_resp (message, msg_length, io_station_name, device_name, response_code, status);

    find_io_station_or_remote_sys (io_station_name, connection, io_station, io_station_found);
    IF io_station_found THEN
      find_batch_device (device_name, io_station, device, device_found);
      IF device_found THEN
        device^.outstanding_di_responses [nfc$stop_bd] := device^.outstanding_di_responses [nfc$stop_bd] - 1;
        IF response_code = nfc$dc_msg_accepted THEN
          device^.device_status := nfc$device_stopped;
        IFEND;

        IF io_station^.operator_assigned THEN
          operator_connection := io_station^.connected_operator;
          nfp$send_message_on_connection (message, message_length, operator_connection^.id, status);
          IF scfs_event_logging THEN
            log_connection_message (operator_connection^, message_length, message);
          IFEND;
        IFEND;
      IFEND;
    IFEND;

  PROCEND stop_batch_device_resp;
?? TITLE := 'suppress carriage control msg', EJECT ??

{  PURPOSE:
{    This procedure is executed when a message is received from OPES
{    indicating a suppress carriage control command was entered by the
{    station operator.  The interpretation of carriage control characters
{    is suppressed or not suppressed by this command.

  PROCEDURE suppress_carriage_control_msg
    (VAR message: ^nft$message_sequence;
         message_length: integer;
         connection: ^nft$connection;
     VAR msg_length: integer;
     VAR status: ost$status);

    VAR
      bd_connection: ^nft$connection,
      device: ^nft$batch_device,
      device_found: boolean,
      device_name: ost$name,
      io_station: ^nft$io_station,
      io_station_found: boolean,
      io_station_name: ost$name,
      response: nft$device_control_resp_codes;

*copy nft$suppress_carriage_cntrl_msg
?? NEWTITLE := 'crack suppress cc msg', EJECT ??

    PROCEDURE crack_suppress_cc_msg
      (VAR message: ^nft$message_sequence;
       VAR msg_length: integer;
       VAR io_station_name: ost$name;
       VAR device_name: ost$name;
       VAR status: ost$status);

      VAR
        ascii_string: ^string ( * <= osc$max_name_size),
        byte_array: ^nft$byte_array,
        format_cntrl: ^nft$suppress_carriage_control,
        format_control: nft$suppress_carriage_control,
        parameter: ^nft$suppress_cc_msg_parameter,
        value_length: integer;

      NEXT parameter IN message;

      WHILE (parameter <> NIL) AND (parameter^.param <> nfc$null_parameter) AND (msg_length > 0) DO
        msg_length := msg_length - 1;
        IF parameter^.length_indicated THEN
          nfp$get_parameter_value_length (message, msg_length, value_length, status);
          msg_length := msg_length - value_length;
        ELSE
          value_length := 1;
          msg_length := msg_length - 1;
        IFEND;

        CASE parameter^.param OF
        = nfc$io_station_name =
          NEXT ascii_string: [value_length] IN message;
          #translate (osv$lower_to_upper, ascii_string^, io_station_name);

        = nfc$device_name =
          NEXT ascii_string: [value_length] IN message;
          #translate (osv$lower_to_upper, ascii_string^, device_name);

        = nfc$suppress_format_control =
          NEXT format_cntrl IN message;
          format_control := format_cntrl^;

        ELSE
{         ERROR ----   Ignore parameter value.
          NEXT byte_array: [1 .. value_length] IN message;

        CASEND;
        NEXT parameter IN message;
      WHILEND;

    PROCEND crack_suppress_cc_msg;
?? OLDTITLE, EJECT ??

    crack_suppress_cc_msg (message, msg_length, io_station_name, device_name, status);

    find_io_station (io_station_name, io_station, io_station_found);
    IF NOT io_station_found THEN
      response := nfc$dc_msg_reject_unknown_ios;
    ELSE
      find_batch_device (device_name, io_station, device, device_found);
      IF NOT device_found THEN
        response := nfc$dc_msg_reject_unknown_dev;
      ELSE
        IF device^.device_type = nfc$reader THEN
          response := nfc$dc_msg_reject_bad_dev_type;
        ELSE
          response := nfc$dc_msg_accepted;
          bd_connection := device^.scfdi_connection;
          nfp$send_message_on_connection (message, message_length, bd_connection^.id, status);
          IF scfs_event_logging THEN
            log_connection_message (bd_connection^, message_length, message);
          IFEND;
          device^.outstanding_di_responses [nfc$suppress_cc] := device^.outstanding_di_responses
                [nfc$suppress_cc] + 1;
        IFEND;
      IFEND;
    IFEND;

    IF response > nfc$dc_msg_accepted THEN
      send_device_control_response (message, nfc$suppress_carriage_cntrl_rsp, io_station_name, device_name,
            response, connection, status);
    IFEND;

  PROCEND suppress_carriage_control_msg;
?? TITLE := 'suppress carriage control resp', EJECT ??

{  PURPOSE:
{    This procedure is executed when a message is received from SCF/DI
{    in response to a suppress carriage control command that was forwarded
{    from OPES.

  PROCEDURE suppress_carriage_control_resp
    (VAR message: ^nft$message_sequence;
         message_length: integer;
         connection: ^nft$connection;
     VAR msg_length: integer;
     VAR status: ost$status);

    VAR
      device: ^nft$batch_device,
      device_found: boolean,
      device_name: ost$name,
      io_station: ^nft$io_station,
      io_station_found: boolean,
      io_station_name: ost$name,
      operator_connection: ^nft$connection,
      response_code: nft$device_control_resp_codes;

    crack_device_control_resp (message, msg_length, io_station_name, device_name, response_code, status);

    find_io_station (io_station_name, io_station, io_station_found);
    IF io_station_found THEN
      find_batch_device (device_name, io_station, device, device_found);
      IF device_found THEN
        device^.suppress_carriage_control := TRUE;
        device^.outstanding_di_responses [nfc$suppress_cc] := device^.outstanding_di_responses
              [nfc$suppress_cc] - 1;

        IF io_station^.operator_assigned THEN
          operator_connection := io_station^.connected_operator;
          nfp$send_message_on_connection (message, message_length, operator_connection^.id, status);
          IF scfs_event_logging THEN
            log_connection_message (operator_connection^, message_length, message);
          IFEND;
        IFEND;
      IFEND;
    IFEND;

  PROCEND suppress_carriage_control_resp;
?? TITLE := 'time in scfs queue', EJECT ??

  FUNCTION time_in_scfs_queue (time_stamp: ost$date_time;
        current_time: ost$date_time): integer;

    CONST
      seconds_in_day = 86400;

    VAR
      days: integer,
      local_status: ost$status,
      new_date: ost$date,
      old_date: ost$date,
      time_increment: pmt$time_increment;

?? NEWTITLE := 'compute ordinal date difference', EJECT ??

    FUNCTION compute_ordinal_date_difference (late_date: ost$date;
          early_date: ost$date): integer;

      VAR
        early_days: clt$integer,
        early_years: clt$integer,
        late_days: clt$integer,
        late_years: clt$integer,
        local_status: ost$status;

      clp$convert_string_to_integer (late_date.ordinal (1, 4), late_years, local_status);
      clp$convert_string_to_integer (early_date.ordinal (1, 4), early_years, local_status);
      clp$convert_string_to_integer (late_date.ordinal (5, 3), late_days, local_status);
      clp$convert_string_to_integer (early_date.ordinal (5, 3), early_days, local_status);

      compute_ordinal_date_difference := (late_days.value - early_days.value) + (late_years.value -
            early_years.value) * 365;

    FUNCEND compute_ordinal_date_difference;
?? OLDTITLE, EJECT ??

    pmp$compute_date_time_increment (time_stamp, current_time, time_increment, local_status);

    days := 0;
    IF time_increment.day > 0 THEN
      pmp$format_compact_date (current_time, osc$ordinal_date, new_date, local_status);
      pmp$format_compact_date (time_stamp, osc$ordinal_date, old_date, local_status);
      days := compute_ordinal_date_difference (new_date, old_date);
    IFEND;

    time_in_scfs_queue := days * seconds_in_day + time_increment.hour * 3600 + time_increment.minute * 60 +
          time_increment.second;

  FUNCEND time_in_scfs_queue;
?? TITLE := 'terminate_queued_output', EJECT ??

{
{  PURPOSE:
{    This procedure is executed when a message is received from OPES
{    indicating a terminate queued output command was entered by the
{    station operator.  The requested file should be removed from the output
{    queue as a result of this command.
{

  PROCEDURE terminate_queued_output
    (    message_length: integer;
         connection: ^nft$connection;
     VAR message: ^nft$message_sequence;
     VAR msg_length: integer;
     VAR status: ost$status);

    VAR
      alias_entry: ^nft$alias,
      duplicate_file_name: boolean,
      file_in_selected_q: boolean,
      file_name: ost$name,
      io_station: ^nft$io_station,
      io_station_found: boolean,
      io_station_name: ost$name,
      q_file: ^nft$output_queue_file,
      response: nft$terqo_file_status_codes,
      scfve_connection: ^nft$connection,
      selected_file: ^nft$selected_file;

*copy nft$terminate_queued_output_msg
?? NEWTITLE := 'send_terqo_to_scfve', EJECT ??

    PROCEDURE send_terqo_to_scfve
      (    file_name: ost$name;
           io_station_name: ost$name;
           connection: ^nft$connection;
       VAR message: ^nft$message_sequence;
       VAR status: ost$status);

      VAR
        ascii_string: ^string ( * <= osc$max_name_size),
        message_length: nft$message_length,
        message_type: ^nft$message_kind,
        parameter_kind: ^nft$term_queue_output_parameter,
        parameter_kind_size: nft$message_length,
        param_length_size: nft$message_length,
        parameter_value_length: integer;

      parameter_kind_size := #SIZE (nft$term_queue_output_parameter);
      RESET message;

      NEXT message_type IN message;
      message_type^ := nfc$terminate_queue_output;
      message_length := 1;

      NEXT parameter_kind IN message;
      parameter_kind^.param := nfc$io_station_name;
      parameter_value_length := clp$trimmed_string_size (io_station_name);
      nfp$modify_param_value_length (parameter_value_length);
      parameter_kind^.length_indicated := parameter_value_length > 1;
      IF parameter_kind^.length_indicated THEN
        nfp$put_parameter_value_length (parameter_value_length, message, param_length_size, status);
      ELSE
        param_length_size := 0;
      IFEND;
      NEXT ascii_string: [parameter_value_length] IN message;
      ascii_string^ := io_station_name (1, parameter_value_length);
      message_length := message_length + parameter_kind_size + param_length_size + parameter_value_length;

      NEXT parameter_kind IN message;
      parameter_kind^.param := nfc$system_user_file_name;
      parameter_value_length := clp$trimmed_string_size (file_name);
      nfp$modify_param_value_length (parameter_value_length);
      parameter_kind^.length_indicated := parameter_value_length > 1;
      IF parameter_kind^.length_indicated THEN
        nfp$put_parameter_value_length (parameter_value_length, message, param_length_size, status);
      ELSE
        param_length_size := 0;
      IFEND;
      NEXT ascii_string: [parameter_value_length] IN message;
      ascii_string^ := file_name (1, parameter_value_length);
      message_length := message_length + parameter_kind_size + param_length_size + parameter_value_length;

      nfp$send_message_on_connection (message, message_length, connection^.id, status);
      IF scfs_event_logging THEN
        log_connection_message (connection^, message_length, message);
      IFEND;

    PROCEND send_terqo_to_scfve;
?? OLDTITLE, EJECT ??
    status.normal := TRUE;
    response := nfc$terqo_message_rejected;

    nfp$crack_terqo_msg (message, msg_length, io_station_name, file_name, status);

    IF status.normal THEN
      find_io_station_or_remote_sys (io_station_name, connection, io_station, io_station_found);
      IF NOT io_station_found THEN
        response := nfc$terqo_unknown_ios;
      ELSE
        search_selected_q_for_file (io_station, file_name, q_file, selected_file,
              file_in_selected_q, duplicate_file_name);
        IF NOT file_in_selected_q THEN
          search_alias_list_for_file_name (io_station, file_name,
                alias_entry, q_file, duplicate_file_name);
        IFEND;

        response := nfc$terqo_successful;
        IF duplicate_file_name THEN
          response := nfc$terqo_duplicate_file_names;
        ELSEIF q_file = NIL THEN
          response := nfc$terqo_unknown_file_name;
        ELSEIF q_file^.output_state = nfc$selected_for_transfer THEN
          response := nfc$terqo_file_in_transfer;
        ELSE
          scfve_connection := q_file^.scfve_connection;
          send_terqo_to_scfve (q_file^.system_file_name, io_station_name, scfve_connection, message,
                status);
        IFEND;
      IFEND;
    IFEND;

    IF response > nfc$terqo_successful THEN
      nfp$send_terqo_response_msg (io_station_name, file_name, response, connection^.id, message, status);
      IF scfs_event_logging THEN
        log_connection_message (connection^, message_length, message);
      IFEND;
    IFEND;

  PROCEND terminate_queued_output;
?? TITLE := 'terminate_queue_output_response', EJECT ??

{
{  PURPOSE:
{    This procedure is executed when a message is received from SCF/VE
{    in response to a terminate queued output command that was forwarded
{    from OPES.  The response indicates whether the file could be terminated
{    from the output queue or not.
{

  PROCEDURE terminate_queue_output_response
    (    message_length: integer;
         connection: ^nft$connection;
     VAR message: ^nft$message_sequence;
     VAR msg_length: integer;
     VAR status: ost$status);

    VAR
      io_station: ^nft$io_station,
      io_station_found: boolean,
      io_station_name: ost$name,
      operator_connection: ^nft$connection;

?? NEWTITLE := 'crack_terqo_resp_msg', EJECT ??

    PROCEDURE crack_terqo_resp_msg
      (VAR io_station_name: ost$name;
       VAR message: ^nft$message_sequence;
       VAR msg_length: integer;
       VAR status: ost$status);

      VAR
        ascii_string: ^string ( * <= osc$max_name_size),
        byte_array: ^nft$byte_array,
        parameter: ^nft$term_q_output_resp_param,
        value_length: integer;

*copy nft$terminate_q_output_resp_msg
?? EJECT ??
      NEXT parameter IN message;

      WHILE (parameter <> NIL) AND (parameter^.param <= nfc$file_status_code) AND (msg_length > 0) DO
        msg_length := msg_length - 1;
        IF parameter^.length_indicated THEN
          nfp$get_parameter_value_length (message, msg_length, value_length, status);
          msg_length := msg_length - value_length;
        ELSE
          value_length := 1;
          msg_length := msg_length - 1;
        IFEND;

        IF parameter^.param = nfc$io_station_name THEN
          NEXT ascii_string: [value_length] IN message;
          #translate (osv$lower_to_upper, ascii_string^, io_station_name);
        ELSE

{ All this routine cares about is the station name.  The rest of the parameters
{ do not have to be looked at.

          NEXT byte_array: [1 .. value_length] IN message;

        IFEND;
        NEXT parameter IN message;
      WHILEND;

      RESET message TO parameter;

    PROCEND crack_terqo_resp_msg;
?? OLDTITLE, EJECT ??
    crack_terqo_resp_msg (io_station_name, message, msg_length, status);

    IF status.normal THEN
      find_io_station_or_remote_sys (io_station_name, connection, io_station, io_station_found);
      IF io_station_found THEN
        IF io_station^.operator_assigned THEN
          operator_connection := io_station^.connected_operator;
          nfp$send_message_on_connection (message, message_length, operator_connection^.id, status);
          IF scfs_event_logging THEN
            log_connection_message (operator_connection^, message_length, message);
          IFEND;
        IFEND;
      IFEND;
    IFEND;

  PROCEND terminate_queue_output_response;
?? TITLE := 'terminate transfer msg', EJECT ??

{  PURPOSE:
{    This procedure is executed when a message is received from OPES
{    indicating a terminate transfer command was entered by the
{    station operator.  The current file transfer is dropped,
{    requeued or held, and the device then becomes a candidate for
{    printing an output file.
{
{    This procedure is also executed when a message is received from OPENTF
{    indicating a terminate transfer command was entered by the NTF operator.
{    The current file transfer is dropped, requeued or held, and the batch
{    stream then becomes a candidate for transferring an NTF file.

  PROCEDURE terminate_transfer_msg
    (VAR message: ^nft$message_sequence;
         message_length: integer;
         connection: ^nft$connection;
     VAR msg_length: integer;
     VAR status: ost$status);

    VAR
      bd_connection: ^nft$connection,
      device: ^nft$batch_device,
      device_found: boolean,
      device_name: ost$name,
      io_station: ^nft$io_station,
      io_station_found: boolean,
      io_station_name: ost$name,
      q_file: ^nft$output_queue_file,
      response: nft$device_control_resp_codes,
      transfer_action: nft$file_disposition;

*copy nft$terminate_transfer_msg
?? NEWTITLE := 'crack terminate transfer msg', EJECT ??

    PROCEDURE crack_terminate_transfer_msg
      (VAR message: ^nft$message_sequence;
       VAR msg_length: integer;
       VAR io_station_name: ost$name;
       VAR device_name: ost$name;
       VAR file_disposition: nft$file_disposition;
       VAR status: ost$status);

      VAR
        ascii_string: ^string ( * <= osc$max_name_size),
        byte_array: ^nft$byte_array,
        file_action: ^nft$file_disposition,
        parameter: ^nft$terminate_xfer_msg_param,
        value_length: integer;

      NEXT parameter IN message;

      WHILE (parameter <> NIL) AND (parameter^.param <> nfc$null_parameter) AND (msg_length > 0) DO
        msg_length := msg_length - 1;
        IF parameter^.length_indicated THEN
          nfp$get_parameter_value_length (message, msg_length, value_length, status);
          msg_length := msg_length - value_length;
        ELSE
          value_length := 1;
          msg_length := msg_length - 1;
        IFEND;

        CASE parameter^.param OF
        = nfc$io_station_name =
          NEXT ascii_string: [value_length] IN message;
          #translate (osv$lower_to_upper, ascii_string^, io_station_name);

        = nfc$device_name =
          NEXT ascii_string: [value_length] IN message;
          #translate (osv$lower_to_upper, ascii_string^, device_name);

        = nfc$file_disposition =
          NEXT file_action IN message;
          file_disposition := file_action^;

        ELSE
{         ERROR ----   Ignore parameter value.
          NEXT byte_array: [1 .. value_length] IN message;

        CASEND;
        NEXT parameter IN message;
      WHILEND;

    PROCEND crack_terminate_transfer_msg;
?? OLDTITLE, EJECT ??

    crack_terminate_transfer_msg (message, msg_length, io_station_name, device_name, transfer_action, status);

    find_io_station_or_remote_sys (io_station_name, connection, io_station, io_station_found);
    IF NOT io_station_found THEN
      response := nfc$dc_msg_reject_unknown_ios;
    ELSE
      find_batch_device (device_name, io_station, device, device_found);
      IF NOT device_found THEN
        response := nfc$dc_msg_reject_unknown_dev;
      ELSE
        response := nfc$dc_msg_accepted;
        IF (transfer_action = nfc$hold_file_in_q) AND (device^.current_file <> NIL) AND
              output_device_or_stream (device) THEN
          q_file := device^.current_file;
          q_file^.output_state := nfc$hold_transfer;
        IFEND;

        bd_connection := device^.scfdi_connection;
        nfp$send_message_on_connection (message, message_length, bd_connection^.id, status);
        IF scfs_event_logging THEN
          log_connection_message (bd_connection^, message_length, message);
        IFEND;
        device^.outstanding_di_responses [nfc$terminate_xfer] := device^.outstanding_di_responses
              [nfc$terminate_xfer] + 1;
      IFEND;
    IFEND;

    IF response > nfc$dc_msg_accepted THEN
      send_device_control_response (message, nfc$terminate_transfer_resp, io_station_name, device_name,
            response, connection, status);
    IFEND;

  PROCEND terminate_transfer_msg;
?? TITLE := 'terminate_transfer_resp', EJECT ??

{  PURPOSE:
{    This procedure is executed when a message is received from SCF/DI
{    in response to a terminate transfer message that was forwarded from
{    OPES.  Also, the terminate transfer message may have been generated from
{    a delete file availability message.
{
{    This procedure is also executed when a message is received from SCF/DI in
{    response to a terminate transfer message that was forwarded from OPENTF.

  PROCEDURE terminate_transfer_resp
    (VAR message: ^nft$message_sequence;
         message_length: integer;
         connection: ^nft$connection;
     VAR msg_length: integer;
     VAR status: ost$status);

    VAR
      device: ^nft$batch_device,
      device_found: boolean,
      device_name: ost$name,
      io_station: ^nft$io_station,
      io_station_found: boolean,
      io_station_name: ost$name,
      operator_connection: ^nft$connection,
      response_code: nft$device_control_resp_codes;

    crack_device_control_resp (message, msg_length, io_station_name, device_name, response_code, status);

    find_io_station_or_remote_sys (io_station_name, connection, io_station, io_station_found);
    IF io_station_found THEN
      find_batch_device (device_name, io_station, device, device_found);
      IF device_found THEN
        IF device^.outstanding_di_responses [nfc$terminate_xfer] > 0 THEN
          device^.outstanding_di_responses [nfc$terminate_xfer] := device^.outstanding_di_responses
                [nfc$terminate_xfer] - 1;
        ELSE
{ Special case where SCFS sent a terminate_transfer (from delete_file_availability_msg) -
{ we do not want to inform operator.
          RETURN;
        IFEND;

        IF io_station^.operator_assigned THEN
          operator_connection := io_station^.connected_operator;
          nfp$send_message_on_connection (message, message_length, operator_connection^.id, status);
          IF scfs_event_logging THEN
            log_connection_message (operator_connection^, message_length, message);
          IFEND;
        IFEND;
      IFEND;
    IFEND;

  PROCEND terminate_transfer_resp;
?? TITLE := 'determine and call message kind', EJECT ??

{  PURPOSE:
{    This procedure is executed when a message is received by SCFS.
{    The appropriate message is called based on the message type recieved.

  PROCEDURE determine_and_call_message_kind
    (    peer_operation: nat$se_peer_operation;
     VAR connection: ^nft$connection;
     VAR message: ^nft$message_sequence;
     VAR wait_list: ^ost$i_wait_list;
     VAR wait_connection_list: ^nft$wait_connection_list;
     VAR status: ost$status);

    VAR
      message_kind: ^nft$message_kind,
      message_length: integer;

    IF peer_operation.kind = nac$se_send_data THEN
      message_length := peer_operation.data_length;

      IF scfs_event_logging THEN
        log_connection_message (connection^, message_length, message);
      IFEND;

      RESET message;
{     Determine message type coming into SCFS/VE
      NEXT message_kind IN message;
      message_length := message_length - 1;

      CASE message_kind^ OF

{  The following message types are sent by SCF/DI.  }

      = nfc$add_io_station =
        add_io_station_msg (message, connection, message_length, wait_list, wait_connection_list,
              status);

      = nfc$delete_io_station =
        delete_io_station_msg (message, connection, message_length, wait_list,
              wait_connection_list, status);

      = nfc$add_batch_device =
        add_batch_device_msg (message, connection, message_length, status);

      = nfc$batch_device_status =
        change_batch_device_status (message, connection, message_length, status);

      = nfc$file_transfer_status =
        change_file_transfer_status (message, connection, message_length, status);

      = nfc$delete_batch_device =
        delete_batch_device_msg (message, connection, message_length, status);

      = nfc$btfs_di_status =
        change_btfs_di_status (message, connection, message_length, status);

      = nfc$operator_message =
        operator_message (message, peer_operation.data_length, connection, message_length,
              status);

      = nfc$suppress_carriage_cntrl_rsp =
        suppress_carriage_control_resp (message, peer_operation.data_length, connection,
              message_length, status);

      = nfc$change_bat_device_attr_resp =
        change_batch_device_attr_resp (message, peer_operation.data_length, connection,
              message_length, status);

      = nfc$start_batch_device_resp =
        start_batch_device_resp (message, peer_operation.data_length, connection, message_length,
              status);

      = nfc$stop_batch_device_resp =
        stop_batch_device_resp (message, peer_operation.data_length, connection, message_length,
              status);

      = nfc$position_file_resp =
        position_file_resp (message, peer_operation.data_length, connection, message_length,
              status);

      = nfc$terminate_transfer_resp =
        terminate_transfer_resp (message, peer_operation.data_length, connection, message_length,
              status);

      = nfc$add_ntf_remote_sys_msg =
        add_ntf_remote_system_message (message, connection, message_length, status);

      = nfc$delete_ntf_remote_sys_msg =
        delete_ntf_remote_system_msg (message, connection, message_length, status);

      = nfc$add_ntf_acc_rem_sys_msg =
        add_ntf_acc_remote_system_msg (message, connection, message_length, status);

      = nfc$send_ntf_remote_comm_resp =
        send_ntf_remote_command_resp (message, peer_operation.data_length, connection,
              message_length, status);

{  The following message type is used for automatic switching of control  }
{  facilities in the case that the higher priority control facility fails. }
{  (future enhancement) }

      = nfc$switch_control_facility =
        ;

{  The following message types are sent by SCF/VE.  }

      = nfc$add_file_availability =
        add_file_availability_msg (message, connection, message_length, status);

      = nfc$modify_file_availability =
        modify_file_availability_msg (message, connection, message_length, status);

      = nfc$delete_file_availability =
        delete_file_availability_msg (message, connection, message_length, status);

      = nfc$file_assignment_response =
        file_assignment_response (message, wait_list, message_length, status);

      = nfc$btf_ve_status =
        change_btf_ve_status (message, connection, message_length, status);

      = nfc$terminate_queue_output_resp =
        terminate_queue_output_response (peer_operation.data_length, connection, message,
              message_length, status);

{  The following message types are sent by OPES.  }

      = nfc$add_user =
        add_user_msg (message, connection, message_length, status);

      = nfc$start_batch_device =
        start_batch_device_msg (message, peer_operation.data_length, connection,
               message_length, status);

      = nfc$stop_batch_device =
        stop_batch_device_msg (message, peer_operation.data_length, connection,
               message_length, status);

      = nfc$terminate_transfer =
        terminate_transfer_msg (message, peer_operation.data_length, connection,
               message_length, status);

      = nfc$suppress_carriage_control =
        suppress_carriage_control_msg (message, peer_operation.data_length, connection,
               message_length, status);

      = nfc$select_file =
        select_file_msg (message, connection, message_length, status);

      = nfc$position_file_sou =
        position_file_msg (message, connection, message_length, status);

      = nfc$get_station_status =
        get_station_status_msg (message, message_length, connection, status);

      = nfc$get_device_status =
        get_device_status_msg (message, connection, status);

      = nfc$get_queue_status =
        get_queue_status_msg (message, connection, status);

      = nfc$get_queue_entry_list =
        get_queue_entry_list_msg (message, connection, message_length, status);

      = nfc$get_queue_entry =
        get_queue_entry_msg (message, connection, status);

      = nfc$change_batch_device_attr =
        change_batch_device_attributes (message, peer_operation.data_length, connection,
               message_length, status);

      = nfc$terminate_queue_output =
        terminate_queued_output (peer_operation.data_length, connection, message,
              message_length, status);

{  The following message types are sent by OPENTF.  }

      = nfc$delete_ntf_user_msg =
        delete_ntf_user_message (message, connection, message_length, status);

      = nfc$get_ntf_rem_sys_names_msg =
        get_ntf_remote_system_names_msg (message, connection, message_length, status);

      = nfc$get_ntf_rem_sys_opts_msg =
        get_ntf_remote_system_opts_msg (message, connection, message_length, status);

      = nfc$get_ntf_rem_sys_stat_msg =
        get_ntf_remote_system_stat_msg (message, connection, message_length, status);

      = nfc$send_ntf_remote_comm_msg =
        send_ntf_remote_command_message (message, connection, message_length, status);

      ELSE
        ;
      CASEND;
    IFEND;

  PROCEND determine_and_call_message_kind;
?? TITLE := 'nfp$status_control_fac_server', EJECT ??

{  PURPOSE:
{    This program implements the server application known as SCFS/VE.
{    SCFS is responsible for controlling the flow of output to devices.
{    SCFS/VE receives batch device status and control commands, and
{    SCFS/VE receives file status and control commands.  The staton
{    operator sends batch control commands to SCFS.  SCFS processes
{    some of these commands itself and sends others to the appropriate
{    SCF/VE or SCF/DI for processing.
{
{    SCFS is also responsible for controlling the transfer of NTF files to
{    batch streams.  SCFS/VE receives batch stream status and control commands,
{    and SCFS/VE receives file status and control commands.  The NTF operator
{    sends batch control commands to SCFS.  SCFS processes some of these
{    commands itself and sends others to the appropriate NTF/VE or SCF/DI for
{    processing.
{
{  DESCRIPTION:
{
{    - establish condition handler
{    - initialize SCFS application
{    LOOP
{      - get new connections
{      - determine the kind of incoming message and process the message
{      - remove a connection from the current list
{    LOOPEND

  PROGRAM nfp$status_control_fac_server
    (    parameter_list: clt$parameter_list;
     VAR status: ost$status);

    VAR
      activity_status: ost$activity_status,
      connection: ^nft$connection,
      establish_descriptor: pmt$established_handler,
      exit_condition: [STATIC, READ] pmt$condition := [pmc$block_exit_processing, [pmc$block_exit,
        pmc$program_termination, pmc$program_abort]],
      message: ^nft$message_sequence,
      peer_operation: nat$se_peer_operation,
      ready_index: integer,
      wait_connection_list: ^nft$wait_connection_list,
      wait_list: ^ost$i_wait_list;

?? NEWTITLE := 'exit_condition_handler', EJECT ??

{  PURPOSE:
{    In the case of an abnormal termination, all registered titles
{    are be deleted, open connections are closed and the server
{    application is detached from the current job.

    PROCEDURE exit_condition_handler
      (    condition: pmt$condition;
           condition_descriptor: ^pmt$condition_information;
           save_area: ^ost$stack_frame_save_area;
       VAR handler_status: ost$status);

      VAR
        alias_pt: ^nft$alias,
        connection_pt: ^nft$connection,
        file_id_is_valid: boolean,
        file_instance: ^bat$task_file_entry,
        file_name: amt$local_file_name,
        ignore_status: ost$status,
        local_status: ost$status;

      local_status.normal := TRUE;

      pmp$log ('Status and Control Facility Server dropping', local_status);

{  If the control_facility_name is equal to a null name, then SCFS failed to
{  register the title for the control facility during initialization.  SCFS
{  will drop because of this error and there won't be any titles to delete.

      IF control_facility_name <> osc$null_name THEN
        IF scfs_title <> NIL THEN
          nap$delete_server_title (server_name, scfs_title^, local_status);
        IFEND;

        IF scfs_ntf_title <> NIL THEN
          nap$delete_server_title (server_name, scfs_ntf_title^, local_status);
        IFEND;

        alias_pt := scfs_tables.first_station_name_alias;
        WHILE (alias_pt <> NIL) DO
          IF alias_pt^.station_title_registered THEN
            delete_station_alias_title (alias_pt^.name, nfc$station_title, local_status);
          IFEND;
          IF alias_pt^.alias_title_registered THEN
            delete_station_alias_title (alias_pt^.name, nfc$alias_title, local_status);
          IFEND;
          alias_pt := alias_pt^.link;
        WHILEND;

{  Terminate all connections by closing and returning the connection files.

        connection_pt := scfs_tables.first_connection;
        WHILE connection_pt <> NIL DO
          bap$validate_file_identifier (connection_pt^.id, file_instance, file_id_is_valid);
          IF file_id_is_valid THEN
            file_name := file_instance^.local_file_name;
            fsp$close_file (connection_pt^.id, local_status);
            amp$return (file_name, ignore_status);
          IFEND;
          connection_pt := connection_pt^.link;
        WHILEND;
      IFEND;

{  Detach the server job.

      IF scfs_title <> NIL THEN
        nap$detach_server_application (server_name, local_status);
      IFEND;

{  Cleanup the binary log file if logging was activated.

      IF scfs_event_logging AND (scfs_log_file <> NIL) THEN
        fsp$close_file (scfs_log_file_identifier, local_status);
        amp$return (scfs_log_file^, local_status);
      IFEND;

{ Status is from nfp$status_control_fac_server.  If the status is abnormal, then
{ is should be written to the system job log and the system log.

      IF NOT status.normal THEN
        osp$generate_log_message ($pmt$ascii_logset [pmc$system_log, pmc$job_log], status, local_status);
      IFEND;

      REPEAT
        clp$delete_variable (nfv$appl_def_segment_variables [nfc$appl_def_segment_for_scfs], ignore_status);
      UNTIL NOT ignore_status.normal;

    PROCEND exit_condition_handler;
?? OLDTITLE, EJECT ??
    status.normal := TRUE;

    pmp$establish_condition_handler (exit_condition, ^exit_condition_handler, ^establish_descriptor, status);

    initialize_scfs (parameter_list, scfs_event_logging, wait_list, message, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

{  The wait_list is used to keep track of the activites SCFS is waiting on.
{  The wait_connection_list contains more detailed information, with each entry
{  in the wait_connection_list corresonding to an entry in the wait_list.

    WHILE TRUE DO
      osp$i_await_activity_completion (wait_list^, ready_index, status);
      IF status.normal THEN
        CASE wait_list^ [ready_index].activity OF
        = nac$i_await_connection =
          get_new_connection ( wait_list, wait_connection_list, message, status);
          IF NOT status.normal THEN
            IF (status.condition = nae$invalid_request) OR
                  (status.condition = nae$server_not_attached) OR
                  (status.condition = nae$application_inactive) OR
                  (status.condition = nae$invalid_connect_data_change) THEN
              RETURN;
            IFEND;
          IFEND;

        = nac$i_await_data_available =
          connection := wait_connection_list^ [ready_index];
          nfp$get_connection_data (message, connection^.id, peer_operation, activity_status, activity_status.
                status);
          IF activity_status.status.normal THEN
            determine_and_call_message_kind (peer_operation, connection, message, wait_list,
                  wait_connection_list, status);
          ELSE
            remove_connection_from_list ( ready_index, wait_list, wait_connection_list, message,
                  status);
          IFEND;

        = osc$i_await_time =

{ Timer has expired.  Check for unreachable BTFS/DI titles done below.

        ELSE
          ;
        CASEND;

{ If wait_list await time is short this means there are timers running on
{ unreachable BTFS/DI titles, so check for expired ones before awaiting again.

        IF wait_list^ [2].milliseconds = unreachable_btfs_di_wait_time THEN
          check_unreachable_btfs_di_lists (wait_list, message);
        IFEND;

      IFEND;
    WHILEND;

  PROCEND nfp$status_control_fac_server;
?? OLDTITLE ??
MODEND nfm$status_control_fac_server;
