?? NEWTITLE := 'Batch I/O Station Operator Utility' ??
?? LEFT := 1, RIGHT := 110 ??
?? FMT (FORMAT := ON, INDENT := 2) ??
?? SET (LIST := ON, LISTCTS := OFF) ??
MODULE nfm$operate_station;

{
{ PURPOSE:
{   This module is a command utility which contains command processors
{   for the Batch I/O Station Operator Utility.  Processors in this
{   module process the operator commands, and communicate with SCFS/VE
{   through CDCNET.
{

?? NEWTITLE := '  Global declarations' ??
?? PUSH (LISTEXT := ON) ??
*copyc amt$local_file_name
*copyc clt$parameter_list
*copyc clt$file_reference
*copyc clt$path_display_chunks
*copyc nft$file_vertical_print_density
*copyc nae$application_interfaces
*copyc nat$title
*copyc nfd$sou_intertask_communication
*copyc nfe$batch_transfer_services
*copyc nfe$sou_condition_codes
*copyc nft$file_transfer_state
*copyc nft$message_kind
*copyc nft$message_sequence
*copyc nft$parameter_value_length
*copyc nft$scfs_client_identifier
*copyc nft$sou_message_parameter_types
*copyc nft$term_to_application_acctg
*copyc oss$job_paged_literal
*copyc ost$status
*copyc pmd$local_queues
*copyc pmt$os_name
*copyc pmt$program_parameters
?? POP ??
*copyc avp$get_capability
*copyc avp$get_name_value
*copyc amp$return
*copyc clp$build_standard_title
*copyc clp$right_justify_string
*copyc clp$close_display
*copyc clp$convert_integer_to_string
*copyc clp$convert_string_to_real
*copyc clp$new_display_line
*copyc clp$open_display
*copyc clp$put_display
*copyc clp$put_partial_display
*copyc clp$read_variable
*copyc clp$reset_for_next_display_page
*copyc clp$end_scan_command_file
*copyc clp$get_set_count
*copyc clp$get_value
*copyc clp$pop_utility
*copyc clp$push_utility
*copyc clp$scan_command_file
*copyc clp$scan_parameter_list
*copyc clp$trimmed_string_size
*copyc fsp$close_file
*copyc fsp$open_file
*copyc jmp$determine_name_kind
*copyc jmp$get_job_attributes
*copyc jmp$get_output_status
*copyc jmp$get_result_size
*copyc jmp$system_job
*copyc nap$await_data_available
*copyc nap$begin_directory_search
*copyc nap$end_directory_search
*copyc nap$get_title_translation
*copyc nap$request_connection
*copyc nap$se_receive_data
*copyc nap$se_send_data
*copyc nfp$end_async_communication
*copyc nfp$get_async_task_message
*copyc nfp$get_parameter_value_length
*copyc nfp$put_async_task_message
*copyc nfp$put_parameter_value_length
*copyc nfp$request_asynchronous_task
*copyc nfp$send_message_on_connection
*copyc osp$append_status_parameter
*copyc osp$disestablish_cond_handler
*copyc osp$establish_block_exit_hndlr
*copyc osp$i_await_activity_completion
*copyc osp$set_status_abnormal
*copyc osp$set_status_condition
*copyc pmp$format_compact_date
*copyc pmp$format_compact_time
*copyc pmp$get_unique_name
*copyc pmp$get_microsecond_clock
*copyc pmp$get_user_identification
*copyc pmp$log
*copyc pmp$long_term_wait

?? TITLE := '  Utility global variables', EJECT ??
*copyc nft$byte_array

  TYPE
    nft$parameter_kind = 0 .. 07f(16),

    nft$parameter_type = PACKED RECORD
      length_indicated: BOOLEAN,
      param: nft$parameter_kind,
    RECEND;

  TYPE
    nft$queued_operator_message = RECORD
      link: ^nft$queued_operator_message,
      station: ost$name,
      device: ost$name,
      text: STRING (* <= nfc$maximum_message_length),
    RECEND;

  TYPE
    t$terminal_device_information = RECORD
      CASE use (get_job_attributes, get_junk_from_accounting_record) OF
      = get_job_attributes =
        attr_data: jmt$job_input_device,          {device info in string format}
      = get_junk_from_accounting_record =         {device info in record format}
        acctg_data: t$term_to_application_acctg,
      CASEND,
    RECEND;

  TYPE
    t$term_to_application_acctg = RECORD
      size: 0 .. jmc$job_input_device_size,   {for compatibility with jmt$job_input_device}
      acctg_record: nft$term_to_application_acctg,
    RECEND;

  TYPE
    t$device_list = RECORD
      name: ost$name,
      dtype: nft$device_type,
    RECEND;

  TYPE
    t$display_option = (display_all, display_brief);

  VAR
    operator_message_list: ^nft$queued_operator_message := NIL;

  VAR
    display_utility_name: [READ] ost$name := 'DISPLAY_STATION',
    operator_utility_name: [READ] ost$name := 'OPERATE_STATION',
    station_name: ost$name,
    station_operator: boolean := TRUE;

  VAR
    connection_made: BOOLEAN,
    network_file_open: BOOLEAN,
    async_task_active: BOOLEAN,
    debug_mode: pmt$debug_mode := pmc$debug_mode_off,
    network_file: ost$name,
    network_file_id: amt$file_identifier;

  VAR
    message: ^nft$message_sequence,
    message_length: INTEGER,
    msg_byte_count: INTEGER,
    message_type: ^nft$message_kind;

  VAR
    async_task_id: pmt$task_id,
    local_queue_id: pmt$queue_connection,
    transfer_count: 0 .. nfc$max_transfer_size;

?? EJECT ??

  VAR
    banner_highlight_fields: [READ] ARRAY [nft$banner_highlight_field] OF STRING (banner_highlight_size) :=
        [ {nfc$comment_banner} 'comment_banner',  {nfc$routing_banner} 'routing_banner',
          {nfc$site_banner} 'site_banner',        {nfc$user_file_name} 'user_file_name',
          {nfc$user_name} 'user_name'  ],

    boolean_values: [READ] ARRAY [BOOLEAN] OF STRING (3) :=
        [ {false} 'no',  {true} 'yes' ],

    carriage_control_actions: [READ] ARRAY [nft$carriage_control_action] OF STRING (cc_action_size) :=
        [ {nfc$pre_print} 'pre_print',                   {nfc$post_print} 'post_print',
          {nfc$pre_and_post_print} 'pre_print and post_print'  ],

    code_sets: [READ] ARRAY [nft$code_set] OF STRING (code_set_size) :=
        [ {nfc$ascii} 'ascii',                   {nfc$ascii_48} 'ascii48',
          {nfc$ascii_64} 'ascii64',              {nfc$ascii_95} 'ascii95',
          {nfc$ascii_128} 'ascii128',            {nfc$ebcdic} 'ebcdic',
          {nfc$ascii_256} 'ascii256',            {nfc$bcd} 'bcd',
          {nfc$site_defined} 'site_defined'],

    destination_unavail_actions: [READ] ARRAY [nft$destination_unavail_actions]
        OF STRING (dest_unavail_size) :=
        [ {nfc$stop_input_device} 'stop input device',
          {nfc$drop_input_job} 'drop input job'],

    device_statuses: [READ] ARRAY [nft$device_status] OF STRING (device_status_size) :=
        [ {nfc$device_active} 'active',       {nfc$device_stopped} 'stopped',
          {nfc$device_not_ready} 'not ready', {nfc$device_down} 'down',
          {nfc$device_loading_vfu} 'loading Device Load Procedure',
          {nfc$default_vfu_not_loadable} 'default Device Load Procedure not loadable',
          {nfc$device_stopped_by_system} 'stopped by system',
          {nfc$device_status_reserved_7} ' ',
          {nfc$device_status_reserved_8} ' ',
          {nfc$device_status_reserved_9} ' ',
          {nfc$device_status_reserved_10} ' ',
          {nfc$ntf_waiting_signon} ' ',
          {nfc$ntf_signon_initiated} ' ',
          {nfc$ntf_signed_on} ' ',
          {nfc$ntf_signon_failed} ' ',
          {nfc$ntf_signed_off} ' '],

    device_types: [READ] ARRAY [nft$device_type] OF STRING (device_type_size) :=
        [ {nfc$null_device} ' ',              {nfc$console} 'console',
          {nfc$reader} 'reader',              {nfc$printer} 'printer',
          {nfc$punch} 'punch',                {nfc$plotter} 'plotter',
          {nfc$ntf_remote_system_input} ' ',{nfc$ntf_job_receiver} ' ',
          {nfc$ntf_sysout_receiver} ' ',    {nfc$ntf_job_transmitter} ' ',
          {nfc$ntf_sysout_transmitter} ' '],

    file_transfer_statuses: [READ] ARRAY [nft$file_transfer_status] OF STRING (transfer_status_size) :=
        [ {nfc$idle} 'idle',
          {nfc$idle_device_disconnect} 'idle, device disconnect',
          {nfc$idle_vfu_not_loadable} 'idle, Device Load Procedure not loadable',
          {nfc$idle_transfer_error} 'idle, transfer error',
          {nfc$idle_accounting_limit} 'idle, accounting limit',
          {nfc$idle_operator_drop_file} 'idle, operator dropped file',
          {nfc$idle_operator_requeued_file} 'idle, operator requeued file',
          {nfc$idle_operator_hold_file} 'idle, operator hold file',
          {nfc$busy} 'busy',
          {nfc$suspended_device_not_ready} 'suspended, device not ready',
          {nfc$suspended_pm_message} 'suspended, PM message',
          {nfc$suspended_operator_command} 'suspended, operator command',
          {nfc$suspended_operator_posf_comd} 'suspended, operator position file',
          {nfc$suspended_vfu_being_loaded} 'suspended, Device Load Procedure being loaded',
          {nfc$busy_reserved_22} ' ',
          {nfc$busy_reserved_23} ' '   ],

    file_vpd_actions: [READ] ARRAY [nft$file_vertical_print_density] OF STRING (file_vpd_action_size) :=
        [ {nfc$vertical_print_density_none} 'none',
          {nfc$vertical_print_density_6} 'six',
          {nfc$vertical_print_density_7} 'seven',
          {nfc$vertical_print_density_8} 'eight',
          {nfc$vertical_print_density_9} 'nine',
          {nfc$vertical_print_density_10} 'ten',
          {nfc$vertical_print_density_11} 'eleven',
          {nfc$vertical_print_density_12} 'twelve'],

    format_effector_actions: [READ] ARRAY [nft$format_effector_actions] OF STRING (fe_action_size) :=
        [ {nfc$print_after_spacing} 'print_after_spacing',
          {nfc$print_before_spacing} 'print_before_spacing',
          {nfc$discard_print_line} 'discard_print_line'  ],

    output_data_modes: [READ] ARRAY [nft$output_data_mode] OF STRING (data_mode_size) :=
        [ {nfc$coded_mode} 'coded',  {nfc$transparent_mode} 'transparent' ],

    output_states: [READ] array [nft$file_transfer_state] OF string (output_state_size) :=
        [ {nfc$eligible_for_transfer}   'eligible to transfer',
          {nfc$hold_transfer}           'on hold',
          {nfc$not_eligible_for_output} 'not eligible to transfer',
          {nfc$selected_for_transfer}   'selected to transfer'     ],

    page_formats: [READ] ARRAY [nft$page_format] OF STRING (page_format_size) :=
        [ {amc$continuous_form} 'continuous',       {amc$burstable_form} 'burstable',
          {amc$non_burstable_form} 'non-burstable', {amc$untitled_form} 'untitled'    ],

    pm_message_actions: [READ] ARRAY [nft$pm_message_actions] OF STRING (pm_action_size) :=
        [ {nfc$print_pm_message} 'print',
          {nfc$display_message_to_operator} 'display',
          {nfc$discard_pm_message_line} 'discard'  ],

    station_usages: [READ] ARRAY [nft$io_station_usage] OF STRING (station_usage_size) :=
        [ {nfc$public_io_station} 'public',  {nfc$private_io_station} 'private' ,
          {nfc$ntf_remote_system_usage} 'ntf'],

    vfu_load_option_actions: [READ] ARRAY [nft$vfu_load_option] OF STRING (vfu_action_size) :=
        [ {nfc$vfu_not_present_or_load} 'VFU not present or loadable',
          {nfc$vfu_loaded_at_init} 'VFU loaded at initialization',
          {nfc$vfu_changeable_by_operator} 'VFU changeable by operator',
          {nfc$vfu_changeable_by_user} 'VFU changeable by user'  ],

    vpd_actions: [READ] ARRAY [nft$vertical_print_density] OF STRING (vpd_action_size) :=
        [ {nfc$six_only} 'six_only',                   {nfc$eight_only} 'eight_only',
          {nfc$six_any} 'six_any',                     {nfc$eight_any} 'eight_any' ];

  CONST
    banner_highlight_size = 14,
    cc_action_size = 24,
    code_set_size = 9,
    data_mode_size = 11,
    dest_unavail_size = 17,
    device_status_size = 42,
    device_type_size =  7,
    fe_action_size = 20,
    file_vpd_action_size = 6,
    output_state_size = 24,
    page_format_size = 13,
    pm_action_size = 7,
    station_usage_size = 7,
    transfer_status_size = 45,
    vfu_action_size = 28,
    vpd_action_size = 10;

  VAR
    message_types: [READ] ARRAY [nft$message_kind] OF string (message_type_size) :=
        [ {0-39}  REP 40 OF *,                           {40} 'SUPPRESS_CARRIAGE_CONTROL',
          {41} 'START_BATCH_DEVICE',                     {42} 'STOP_BATCH_DEVICE',
          {43} 'SUPPRESS_CARRIAGE_CONTROL',              {44} 'TERMINATE_TRANSFER',
          {45} 'CHANGE_BATCH_DEVICE_ATTRIBUTES',         {46} 'CHANGE_BATCH_DEVICE_ATTRIBUTES',
          {47} 'START_BATCH_DEVICE',                     {48} 'STOP_BATCH_DEVICE',
          {49} 'TERMINATE_TRANSFER',                     {50} 'POSITION_FILE',
          {51} 'OPERATOR_MESSAGE',
          {52-59}  REP 8 OF *,                           {60} 'ADD_USER',
          {61} 'ADD_USER_RESPONSE',                      {62} 'SELECT_FILE',
          {63} 'SELECT_FILE',                            {64} 'POSITION_FILE',
          {65} 'GET_STATION_STATUS',                     {66} 'STATION_STATUS_DATA',
          {67} 'GET_DEVICE_STATUS',                      {68} 'DEVICE_STATUS_DATA',
          {69} 'GET_QUEUE_STATUS',                       {70} 'QUEUE_STATUS_DATA',
          {71} 'GET_QUEUE_ENTRY_LIST',                   {72} 'QUEUE_ENTRY_LIST_DATA',
          {73} 'GET_QUEUE_ENTRY_DATA',                   {74} 'QUEUE_ENTRY_DATA',
          {75} 'TERMINATE_QUEUE_OUTPUT',                 {76} 'TERMINATE_QUEUE_OUTPUT',
          {77-95}  REP 19 OF *  ];

  CONST
    message_type_size = 30;

  VAR
    response_types: [READ] ARRAY [nft$message_kind] OF nft$message_kind :=
        [ {0-40}  REP 41 OF nfc$reserved_msg_type_0,
          {nfc$start_batch_device}          nfc$start_batch_device_resp,
          {nfc$stop_batch_device}           nfc$stop_batch_device_resp,
          {nfc$suppress_carriage_control}   nfc$suppress_carriage_cntrl_rsp,
          {nfc$terminate_transfer}          nfc$terminate_transfer_resp,
          {nfc$change_batch_device_attr}    nfc$change_bat_device_attr_resp,
          {46-59} REP 14 OF nfc$reserved_msg_type_0,
          {nfc$add_user}                    nfc$add_user_resp,
          {61} nfc$reserved_msg_type_0,
          {nfc$select_file}                 nfc$select_file_response,
          {63} nfc$reserved_msg_type_0,
          {nfc$position_file_sou}           nfc$position_file_resp,
          {nfc$get_station_status}          nfc$station_status_data,
          {66} nfc$reserved_msg_type_0,
          {nfc$get_device_status}           nfc$device_status_data,
          {68} nfc$reserved_msg_type_0,
          {nfc$get_queue_status}            nfc$queue_status_data,
          {70} nfc$reserved_msg_type_0,
          {nfc$get_queue_entry_list}        nfc$queue_entry_list_data,
          {72} nfc$reserved_msg_type_0,
          {nfc$get_queue_entry}             nfc$queue_entry_data,
          {74} nfc$reserved_msg_type_0,
          {nfc$terminate_queue_output}      nfc$terminate_queue_output_resp,
          {76} nfc$reserved_msg_type_0,
          {77-95}  REP 19 OF nfc$reserved_msg_type_0   ];

  VAR
    add_user_responses: [READ] ARRAY [nft$add_user_responses] OF STRING (response_desc_size) :=
        [ {nfc$message_accepted} '',
          {nfc$no_io_station_found} 'no io station found',
          {nfc$operator_already_assigned} 'operator already assigned',
          {nfc$operator_device_mismatch} 'operator device mismatch'   ],

    device_control_responses: [READ] ARRAY [nft$device_control_resp_codes] OF STRING (response_desc_size) :=
        [ {nfc$dc_message_accepted} '',
          {nfc$dc_msg_reject_btfsdi_down} 'BTFS DI down',
          {nfc$dc_msg_reject_unknown_ios} 'unknown io station',
          {nfc$dc_msg_reject_unknown_dev} 'unknown device',
          {nfc$dc_msg_reject_bad_dev_type} 'wrong device type',
          {nfc$dc_msg_reject_bad_data_mode} 'transparent output may only be positioned to BOI or EOI',
          {nfc$dc_msg_rej_unsupported_vfu} 'device cannot support the specified Device Load Procedure',
          {nfc$dc_msg_rej_vfu_ld_outstand} 'Device Load Procedure load request outstanding',
          {nfc$dc_msg_rej_image_not_found} 'Device Load Procedure load image not found',
          {nfc$dc_msg_rej_err_in_vfu_image} 'syntax error in Device Load Procedure load image',
          {nfc$dc_msg_rej_vfu_not_change} 'Device Load Procedure not changeable by operator',
          {nfc$dc_msg_rej_trm_undefined} 'terminal model is undefined',
          {nfc$dc_msg_rej_vfu_not_allow} 'Device Load Procedure not changeable when device is busy',
          {nfc$dc_msg_rej_low_di_memory} 'DI memory too low to process request',
          {nfc$dc_msg_rej_tip_reject_attr} 'TIP rejected attributes'],


    display_status_responses: [READ] ARRAY [nft$display_status_resp_codes] OF STRING (response_desc_size) :=
        [ {nfc$disp_msg_accepted} '',
          {nfc$disp_no_io_station} 'no io station',
          {nfc$disp_no_batch_device} 'no batch device',
          {nfc$disp_unknown_file_name} 'unknown file name'   ],

    select_file_responses: [READ] ARRAY [nft$select_file_response] OF STRING (response_desc_size) :=
        [ {nfc$self_msg_accepted} '',
          {nfc$self_msg_unknown_ios} 'unknown io station',
          {nfc$self_msg_unknown_device} 'unknown device',
          {nfc$self_msg_unknown_file} 'unknown file',
          {nfc$self_file_already_printing} 'file already printing',
          {nfc$self_wrong_device_type} 'invalid device type',
          {nfc$self_duplicate_file_name} 'file name must be unique'],

    terminate_queue_output_resps: [READ] array [nft$terqo_file_status_codes] of string (response_desc_size) :=
        [ {nfc$terqo_successful} '',
          {nfc$terqo_unknown_ios} 'unknown io station name',
          {nfc$terqo_unknown_file_name} 'unknown file name',
          {nfc$terqo_duplicate_file_names} 'file name must be unique',
          {nfc$terqo_file_in_transfer} 'file is being transferred',
          {nfc$terqo_message_rejected} 'message was rejected'];

  CONST
    no_response_code = 'no response code',
    response_desc_size = 57;

  VAR
    peer_operations: [READ] ARRAY [nat$se_peer_operation_kind] OF STRING (peer_operation_size) :=
        [ {nac$se_send_data} '',
          {nac$se_interrupt} 'Interrupt',
          {nac$se_synchronize} 'Synchronize',
          {nac$se_synchronize_confirm} 'Synchronize Confirm'  ];

  CONST
    peer_operation_size = 19;

?? TITLE := '  [XDCL] nfp$display_station', EJECT ??

  PROCEDURE [XDCL] nfp$display_station (parameter_list: clt$parameter_list;
    VAR status: ost$status);

{ PDT diss_pdt (
{   station_name, sn: name = $required
{   status)

    VAR
      scheduling_displays: boolean;

   status.normal := TRUE;

{  Determine if the site has defined the scheduling_displays capability, and if the current username has the
{  capability.  Pretend the user has the capability if the site has not defined it.

    avp$get_capability (avc$scheduling_displays, avc$user, scheduling_displays, status);
    IF NOT status.normal THEN
      IF (status.condition <> ave$unknown_field) AND (status.condition <> ave$field_was_deleted) THEN
        RETURN;
      ELSE

{       Ignore those two conditions.

        status.normal := TRUE;

      IFEND;
    ELSEIF NOT scheduling_displays THEN
      osp$set_status_abnormal (nfc$status_id, nfe$sou_invalid_user, 'DISPLAY_STATION', status);
      RETURN;
    IFEND;

    station_operator := FALSE;

    nfp$operate_station (parameter_list, status);

  PROCEND nfp$display_station;

?? TITLE := '  [XDCL] nfp$operate_station', EJECT ??

  PROCEDURE [XDCL] nfp$operate_station (parameter_list: clt$parameter_list;
    VAR status: ost$status);

{ PDT opes_pdt (
{   station_name, sn: name = $required
{   status)

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

  VAR
    opes_pdt: [STATIC, READ, cls$pdt] clt$parameter_descriptor_table := [^opes_pdt_names, ^opes_pdt_params];

  VAR
    opes_pdt_names: [STATIC, READ, cls$pdt_names_and_defaults] array [1 .. 3] of
  clt$parameter_name_descriptor := [['STATION_NAME', 1], ['SN', 1], ['STATUS', 2]];

  VAR
    opes_pdt_params: [STATIC, READ, cls$pdt_parameters] array [1 .. 2] of clt$parameter_descriptor := [

{ STATION_NAME SN }
    [[clc$required], 1, 1, 1, 1, clc$value_range_not_allowed, [NIL, clc$name_value, 1, osc$max_name_size]],

{ STATUS }
    [[clc$optional], 1, 1, 1, 1, clc$value_range_not_allowed, [NIL, clc$variable_reference,
  clc$array_not_allowed, clc$status_value]]];

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


{ table station_operator_comnds
{ command (change_batch_device_attributes, change_batch_device_attribute, chabda)     ..
{   change_batch_dev_attr_command
{ command (position_file, posf) position_file_command
{ command (suppress_carriage_control, supcc) suppress_carriage_ctrl_command
{ command (terminate_transfer, tert) terminate_transfer_command
{ command (stop_batch_device, stobd, stop) stop_batch_device_command
{ command (start_batch_device, stabd, start) start_batch_device_command
{ command (select_file, self) select_file_command
{ command (display_batch_device_status, disbds) display_batch_dev_status_commnd
{ command (display_station_status, disss) display_station_status_command
{ command (display_station_queue_status, dissqs) display_statn_q_status_command
{ command (display_station_queue_entry, display_station_queue_entries, dissqe)     ..
{   display_station_q_entry_command
{ command (terminate_queued_output, terminate_queue_output, terqo)   terminate_queued_output_command
{ command (quit, qui, end) quit_command

?? PUSH (LISTEXT := ON) ??

VAR
  station_operator_comnds: [STATIC, READ] ^clt$command_table := ^station_operator_comnds_entries,

  station_operator_comnds_entries: [STATIC, READ] array [1 .. 32] of clt$command_table_entry := [
  {} ['CHABDA                         ', clc$abbreviation_entry, clc$normal_usage_entry, 1,
        clc$automatically_log, clc$linked_call, ^change_batch_dev_attr_command],
  {} ['CHANGE_BATCH_DEVICE_ATTRIBUTE  ', clc$alias_entry, clc$normal_usage_entry, 1,
        clc$automatically_log, clc$linked_call, ^change_batch_dev_attr_command],
  {} ['CHANGE_BATCH_DEVICE_ATTRIBUTES ', clc$nominal_entry, clc$normal_usage_entry, 1,
        clc$automatically_log, clc$linked_call, ^change_batch_dev_attr_command],
  {} ['DISBDS                         ', clc$abbreviation_entry, clc$normal_usage_entry, 8,
        clc$automatically_log, clc$linked_call, ^display_batch_dev_status_commnd],
  {} ['DISPLAY_BATCH_DEVICE_STATUS    ', clc$nominal_entry, clc$normal_usage_entry, 8,
        clc$automatically_log, clc$linked_call, ^display_batch_dev_status_commnd],
  {} ['DISPLAY_STATION_QUEUE_ENTRIES  ', clc$alias_entry, clc$normal_usage_entry, 11,
        clc$automatically_log, clc$linked_call, ^display_station_q_entry_command],
  {} ['DISPLAY_STATION_QUEUE_ENTRY    ', clc$nominal_entry, clc$normal_usage_entry, 11,
        clc$automatically_log, clc$linked_call, ^display_station_q_entry_command],
  {} ['DISPLAY_STATION_QUEUE_STATUS   ', clc$nominal_entry, clc$normal_usage_entry, 10,
        clc$automatically_log, clc$linked_call, ^display_statn_q_status_command],
  {} ['DISPLAY_STATION_STATUS         ', clc$nominal_entry, clc$normal_usage_entry, 9,
        clc$automatically_log, clc$linked_call, ^display_station_status_command],
  {} ['DISSQE                         ', clc$abbreviation_entry, clc$normal_usage_entry, 11,
        clc$automatically_log, clc$linked_call, ^display_station_q_entry_command],
  {} ['DISSQS                         ', clc$abbreviation_entry, clc$normal_usage_entry, 10,
        clc$automatically_log, clc$linked_call, ^display_statn_q_status_command],
  {} ['DISSS                          ', clc$abbreviation_entry, clc$normal_usage_entry, 9,
        clc$automatically_log, clc$linked_call, ^display_station_status_command],
  {} ['END                            ', clc$abbreviation_entry, clc$normal_usage_entry, 13,
        clc$automatically_log, clc$linked_call, ^quit_command],
  {} ['POSF                           ', clc$abbreviation_entry, clc$normal_usage_entry, 2,
        clc$automatically_log, clc$linked_call, ^position_file_command],
  {} ['POSITION_FILE                  ', clc$nominal_entry, clc$normal_usage_entry, 2,
        clc$automatically_log, clc$linked_call, ^position_file_command],
  {} ['QUI                            ', clc$alias_entry, clc$normal_usage_entry, 13,
        clc$automatically_log, clc$linked_call, ^quit_command],
  {} ['QUIT                           ', clc$nominal_entry, clc$normal_usage_entry, 13,
        clc$automatically_log, clc$linked_call, ^quit_command],
  {} ['SELECT_FILE                    ', clc$nominal_entry, clc$normal_usage_entry, 7,
        clc$automatically_log, clc$linked_call, ^select_file_command],
  {} ['SELF                           ', clc$abbreviation_entry, clc$normal_usage_entry, 7,
        clc$automatically_log, clc$linked_call, ^select_file_command],
  {} ['STABD                          ', clc$alias_entry, clc$normal_usage_entry, 6,
        clc$automatically_log, clc$linked_call, ^start_batch_device_command],
  {} ['START                          ', clc$abbreviation_entry, clc$normal_usage_entry, 6,
        clc$automatically_log, clc$linked_call, ^start_batch_device_command],
  {} ['START_BATCH_DEVICE             ', clc$nominal_entry, clc$normal_usage_entry, 6,
        clc$automatically_log, clc$linked_call, ^start_batch_device_command],
  {} ['STOBD                          ', clc$alias_entry, clc$normal_usage_entry, 5,
        clc$automatically_log, clc$linked_call, ^stop_batch_device_command],
  {} ['STOP                           ', clc$abbreviation_entry, clc$normal_usage_entry, 5,
        clc$automatically_log, clc$linked_call, ^stop_batch_device_command],
  {} ['STOP_BATCH_DEVICE              ', clc$nominal_entry, clc$normal_usage_entry, 5,
        clc$automatically_log, clc$linked_call, ^stop_batch_device_command],
  {} ['SUPCC                          ', clc$abbreviation_entry, clc$normal_usage_entry, 3,
        clc$automatically_log, clc$linked_call, ^suppress_carriage_ctrl_command],
  {} ['SUPPRESS_CARRIAGE_CONTROL      ', clc$nominal_entry, clc$normal_usage_entry, 3,
        clc$automatically_log, clc$linked_call, ^suppress_carriage_ctrl_command],
  {} ['TERMINATE_QUEUED_OUTPUT        ', clc$nominal_entry, clc$normal_usage_entry, 12,
        clc$automatically_log, clc$linked_call, ^terminate_queued_output_command],
  {} ['TERMINATE_QUEUE_OUTPUT         ', clc$alias_entry, clc$normal_usage_entry, 12,
        clc$automatically_log, clc$linked_call, ^terminate_queued_output_command],
  {} ['TERMINATE_TRANSFER             ', clc$nominal_entry, clc$normal_usage_entry, 4,
        clc$automatically_log, clc$linked_call, ^terminate_transfer_command],
  {} ['TERQO                          ', clc$abbreviation_entry, clc$normal_usage_entry, 12,
        clc$automatically_log, clc$linked_call, ^terminate_queued_output_command],
  {} ['TERT                           ', clc$abbreviation_entry, clc$normal_usage_entry, 4,
        clc$automatically_log, clc$linked_call, ^terminate_transfer_command]];

?? POP ??

{ table station_display_comnds
{ command (display_batch_device_status, disbds) display_batch_dev_status_commnd
{ command (display_station_status, disss) display_station_status_command
{ command (display_station_queue_status, dissqs) display_statn_q_status_command
{ command (display_station_queue_entry, display_station_queue_entries, dissqe)       ..
{   display_station_q_entry_command
{ command (quit, qui, end) quit_command

?? PUSH (LISTEXT := ON) ??

VAR
  station_display_comnds: [STATIC, READ] ^clt$command_table := ^station_display_comnds_entries,

  station_display_comnds_entries: [STATIC, READ] array [1 .. 12] of clt$command_table_entry := [
  {} ['DISBDS                         ', clc$abbreviation_entry, clc$normal_usage_entry, 1,
        clc$automatically_log, clc$linked_call, ^display_batch_dev_status_commnd],
  {} ['DISPLAY_BATCH_DEVICE_STATUS    ', clc$nominal_entry, clc$normal_usage_entry, 1,
        clc$automatically_log, clc$linked_call, ^display_batch_dev_status_commnd],
  {} ['DISPLAY_STATION_QUEUE_ENTRIES  ', clc$alias_entry, clc$normal_usage_entry, 4,
        clc$automatically_log, clc$linked_call, ^display_station_q_entry_command],
  {} ['DISPLAY_STATION_QUEUE_ENTRY    ', clc$nominal_entry, clc$normal_usage_entry, 4,
        clc$automatically_log, clc$linked_call, ^display_station_q_entry_command],
  {} ['DISPLAY_STATION_QUEUE_STATUS   ', clc$nominal_entry, clc$normal_usage_entry, 3,
        clc$automatically_log, clc$linked_call, ^display_statn_q_status_command],
  {} ['DISPLAY_STATION_STATUS         ', clc$nominal_entry, clc$normal_usage_entry, 2,
        clc$automatically_log, clc$linked_call, ^display_station_status_command],
  {} ['DISSQE                         ', clc$abbreviation_entry, clc$normal_usage_entry, 4,
        clc$automatically_log, clc$linked_call, ^display_station_q_entry_command],
  {} ['DISSQS                         ', clc$abbreviation_entry, clc$normal_usage_entry, 3,
        clc$automatically_log, clc$linked_call, ^display_statn_q_status_command],
  {} ['DISSS                          ', clc$abbreviation_entry, clc$normal_usage_entry, 2,
        clc$automatically_log, clc$linked_call, ^display_station_status_command],
  {} ['END                            ', clc$abbreviation_entry, clc$normal_usage_entry, 5,
        clc$automatically_log, clc$linked_call, ^quit_command],
  {} ['QUI                            ', clc$alias_entry, clc$normal_usage_entry, 5,
        clc$automatically_log, clc$linked_call, ^quit_command],
  {} ['QUIT                           ', clc$nominal_entry, clc$normal_usage_entry, 5,
        clc$automatically_log, clc$linked_call, ^quit_command]];

?? POP ??

?? NEWTITLE := '  abort_handler', EJECT ??

  PROCEDURE abort_handler (condition: pmt$condition;
        condition_descriptor: ^pmt$condition_information;
        save_area: ^ost$stack_frame_save_area;
    VAR handler_status: ost$status);

      end_connection (handler_status);
      handler_status.normal := TRUE;

    PROCEND abort_handler;

?? OLDTITLE, EJECT ??

    CONST
      display_prompt = 'diss',
      full_prompt = 'ops';

    VAR
      error_message: string (28 + 31), { length of error message + max name length
      error_message_length: integer,
      ignored_optimization_flag: boolean,
      station_device_count: INTEGER,
      station_index: INTEGER,
      station_list: ^avt$name_list,
      station_list_size: avt$name_list_size,
      station_usage: nft$io_station_usage,
      value: clt$value,
      local_status: ost$status;

    status.normal := TRUE;

    clp$scan_parameter_list (parameter_list, opes_pdt, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    clp$get_value ('STATION_NAME', 1, 1, clc$low, value, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;
    station_name := value.name.value;

{ STATION_OPERATOR will be TRUE if OPERATE_STATION was called, else DISPLAY_STATION was called and
{ no further validation of the user's cability is necessary.

    IF station_operator AND NOT jmp$system_job () THEN

{ Check if the capability STATION_OPERATION is present in the user's validation. The presence of the
{ capability is only meaningful when a list of station names is not defined in the user's validation.

      avp$get_capability (avc$station_operation, avc$user, station_operator, status);
      IF NOT status.normal THEN
        RETURN;
      IFEND;

{ Check if a list of I/O station names is present in the user's validation.

      ALLOCATE station_list: [1..avc$maximum_name_list_size];

      station_list_size := 0;

      avp$get_name_value (avc$batch_io_station_list, avc$user, station_list^, station_list_size, status);
      IF status.normal THEN
        CASE station_list_size OF
        = 0 =
          station_operator := FALSE;

        = 1 =

{ The name values "ALL" and "NONE" are considered keywords if the name values are the only name
{ values in the list of I/O station names. A user can not be validated to operate a single I/O
{ station named "ALL" or a single station named "NONE".

          station_operator := ((station_list^ [1] = station_name) OR
                (station_list^ [1](1,5) = 'ALL  ')) AND
                (station_list^ [1](1,5) <> 'NONE ');

          IF NOT station_operator THEN
            IF (station_list^ [1](1,5) = 'NONE ') THEN
              osp$set_status_abnormal (nfc$status_id, nfe$sou_invalid_user, 'OPERATE_STATION', status);
            ELSE
              STRINGREP(error_message, error_message_length, 'OPERATE_STATION for station ',
                    station_name(1, clp$trimmed_string_size(station_name)) );
              osp$set_status_abnormal (nfc$status_id, nfe$sou_invalid_user, error_message(1,
                    error_message_length), status);
            IFEND;

            RETURN;
          IFEND;
        ELSE { The I/O station name list contains two or more station names.

          station_index :=1;
          station_operator := FALSE;

          WHILE (station_index <= station_list_size) AND (NOT station_operator) DO
            station_operator := (station_list^ [station_index] = station_name);
            station_index := station_index + 1;
          WHILEND;

          IF NOT station_operator THEN
            STRINGREP(error_message, error_message_length, 'OPERATE_STATION for station ',
                  station_name(1, clp$trimmed_string_size(station_name)) );
            osp$set_status_abnormal (nfc$status_id, nfe$sou_invalid_user, error_message(1,
                  error_message_length), status);
            RETURN;
          IFEND;

        CASEND;
      ELSEIF status.condition <> ave$unknown_field THEN

{ Return the error to the user. The AVE$UNKNONW_FIELD condition is ignored because the list of I/O station
{ names is an optional enhancement to OPES caller validation.

        RETURN;
      IFEND;

      FREE station_list;

      IF NOT station_operator THEN
        osp$set_status_abnormal (nfc$status_id, nfe$sou_invalid_user, 'OPERATE_STATION', status);
        RETURN;
      IFEND;
    IFEND;

    ALLOCATE message: [[REP nfc$maximum_send_message_length OF cell]];

    local_status.normal := TRUE;
    connection_made := FALSE;
    network_file_open := FALSE;
    async_task_active := FALSE;
    operator_message_list := NIL;

    osp$establish_block_exit_hndlr (^abort_handler);

 /connect/
    BEGIN
      establish_connection (status);
      IF NOT status.normal THEN
        IF (status.condition = nae$invalid_directory_search_id) OR
              (status.condition = nfe$service_not_found) OR
              (status.condition = nae$directory_search_complete) THEN
          osp$set_status_abnormal (nfc$status_id, nfe$station_title_not_active,
                station_name, status);
        ELSEIF status.condition = nae$server_response_timeout THEN
          osp$set_status_condition ( nfe$sou_scfs_no_response,
                status);
        IFEND;
        EXIT /connect/;
      IFEND;

      IF station_operator THEN
        add_user (status);
        IF NOT status.normal THEN
          EXIT /connect/;
        IFEND;

        start_async_task (status);
        IF NOT status.normal THEN
          EXIT /connect/;
        IFEND;
      ELSE

{       Only allow DISPLAY_STATION for public I/O stations.

        ignored_optimization_flag := FALSE;
        get_station_status (station_device_count, station_usage, ignored_optimization_flag, status);
        IF (NOT status.normal) OR (station_usage <> nfc$public_io_station) THEN
          osp$set_status_abnormal (nfc$status_id, nfe$station_title_not_active, station_name, status);
          EXIT /connect/;
        IFEND;
      IFEND;

      IF station_operator THEN
        clp$push_utility (operator_utility_name, clc$global_command_search,
            station_operator_comnds, NIL, status);
      ELSE
        clp$push_utility (display_utility_name, clc$global_command_search,
            station_display_comnds, NIL, status);
      IFEND;
      IF NOT status.normal THEN
        EXIT /connect/;
      IFEND;

      IF station_operator THEN
        clp$scan_command_file (clc$current_command_input, operator_utility_name, full_prompt, status);
      ELSE
        clp$scan_command_file (clc$current_command_input, display_utility_name, display_prompt, status);
      IFEND;

      clp$pop_utility (local_status);
      IF status.normal AND (NOT local_status.normal) THEN
        status := local_status;
      IFEND;
    END /connect/;

    local_status.normal := TRUE;
    end_connection (local_status);
    IF status.normal AND (NOT local_status.normal) THEN
      status := local_status;
    IFEND;
    local_status.normal := TRUE;
    osp$disestablish_cond_handler;

  PROCEND nfp$operate_station;

?? TITLE := '  establish_connection', EJECT ??

{
{   Procedure to connect the Operator Utility with SCFS/VE
{   via CDCNET.
{

  PROCEDURE establish_connection (VAR status: ost$status);

    CONST
      connect_wait_time = 60*1000 {1 minute},
      title_trans_wait_time = 30*1000 {0.5 minute};

    VAR
      client: nat$application_name,
      client_id: ^nft$scfs_client_identifier,
      connect_attributes: ^nat$create_attributes,
      control_facility_name: ost$name,
      i: 0 .. 255,
      ready_index: integer,
      recurrent_search: boolean,
      search_id: nat$directory_search_identifier,
      server_address: nat$network_address,
      title: ^nat$title_pattern,
      translation_attributes: ^nat$translation_attributes,
      translation_status: ost$status,
      unique_name: ost$name,
      wait_list: ^ost$i_wait_list,
      wait_time: nat$wait_time;


    status.normal := TRUE;
    translation_status.normal := TRUE;

    PUSH title: [osc$max_name_size + 5];
    title^ (1, 5) := 'SCFS$';
    title^ (6, *) := station_name;

    client := 'OSA$STATION_OPERATOR';
    recurrent_search := TRUE;

    nap$begin_directory_search (title^, client, recurrent_search, search_id, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    PUSH wait_list: [1 .. 2];
    wait_list^[1].activity := nac$i_await_title_translation;
    wait_list^[1].translation_request := search_id;
    wait_list^[2].activity := osc$i_await_time;
    wait_list^[2].milliseconds := title_trans_wait_time;
    osp$i_await_activity_completion (wait_list^, ready_index, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    IF ready_index = 2 THEN

{   Timeout.
      osp$set_status_condition ( nfe$service_not_found,  status);
    ELSE

{   Title translation found.
      wait_time := 0;
      PUSH connect_attributes: [1 .. 1];
      connect_attributes^[1].kind := nac$connect_data;
      PUSH connect_attributes^[1].connect_data: [[REP nfc$opes_ve_client_length+1 OF CELL]];
      RESET connect_attributes^[1].connect_data;
      NEXT client_id: [nfc$opes_ve_client_length] IN connect_attributes^[1].connect_data;
      client_id^.data_version := nfc$scfs_client_data_version;
      client_id^.identifier := nfc$opes_ve_client;

{  Get all the addresses that correspond to the title translation.

    /process_address/
      REPEAT
        translation_attributes := NIL;

        nap$get_title_translation ( search_id, wait_time, translation_attributes, server_address,
              translation_status);

        IF translation_status.normal THEN
          pmp$get_unique_name (unique_name, status);
          IF status.normal THEN
            network_file := unique_name;
            nap$request_connection (server_address, client, network_file, nac$cdna_session,
                 connect_attributes, connect_wait_time, status);
            IF status.normal THEN
              nap$end_directory_search (search_id, status);
              EXIT /process_address/;
            IFEND;
          IFEND;
        IFEND;

      UNTIL (NOT translation_status.normal);

    IFEND;

    IF NOT translation_status.normal THEN
      status := translation_status;
    IFEND;

    IF NOT status.normal THEN
      RETURN;
    IFEND;

    connection_made := TRUE;
    fsp$open_file (network_file, amc$record, NIL, NIL, NIL, NIL, NIL, network_file_id, status);
    network_file_open := status.normal;

  PROCEND establish_connection;

?? TITLE := '  end_connection', EJECT ??

{
{   Procedure to terminate the Operator Utility connection
{   with SCFS/VE.
{

  PROCEDURE end_connection (VAR status: ost$status);

    VAR
      local_status: ost$status;


    local_status.normal := TRUE;
    IF async_task_active THEN
      end_async_task (status);
    IFEND;

    IF connection_made THEN
      IF network_file_open THEN
        fsp$close_file (network_file_id, local_status);
        IF status.normal AND NOT local_status.normal THEN
          status := local_status;
        IFEND;
        local_status.normal := TRUE;
        amp$return (network_file, local_status);
      IFEND;
      connection_made := FALSE;
    IFEND;

    IF status.normal AND NOT local_status.normal THEN
      status := local_status;
    IFEND;

  PROCEND end_connection;

?? TITLE := '  start_async_task', EJECT ??

{
{   Procedure to start up an asynchronous task to receive and process
{   unsolicited output from SCFS via CDCNET.  The main task will be
{   in control of the connection with SCFS while processing an Operator
{   Utility command; the asynchronous task will be in control at all
{   other times.  The purpose is to allow prompt reception and display
{   of messages from SCFS to the station operator.
{

  PROCEDURE start_async_task (VAR status: ost$status);

    CONST
      nfc$sou_async_task_name = 'nfp$sou_asynchronous_task';

    VAR
      intertask_request: nft$sou_intertask_request,
      program_name: pmt$program_name;


    program_name := nfc$sou_async_task_name;
    nfp$request_asynchronous_task (program_name, debug_mode, async_task_id, local_queue_id, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;
    async_task_active := TRUE;
    intertask_request.request := nfc$sou_start_task;
    intertask_request.file := network_file;
    send_intertask_request (intertask_request, status);

  PROCEND start_async_task;

?? TITLE := '  end_async_task', EJECT ??

{
{   Procedure to end the asynchronous task that was run to process
{   unsolicited output from SCFS.  A request is sent to the async task
{   telling it to clean up and drop out.  The async task will send a
{   'complete' response before it terminates.
{

  PROCEDURE end_async_task (VAR status: ost$status);

    VAR
      intertask_request: nft$sou_intertask_request,
      end_status: ost$status;


    end_status.normal := TRUE;
    intertask_request.request := nfc$sou_end_task;
    send_intertask_request (intertask_request, end_status);

    end_status.normal := TRUE;
    nfp$end_async_communication (FALSE, end_status);
    async_task_active := FALSE;

  PROCEND end_async_task;

?? TITLE := '  send_intertask_request', EJECT ??

{
{   The purpose of this procedure is to send a request to the
{   asynchronous task and wait for a response.
{

  PROCEDURE send_intertask_request (intertask_request: nft$sou_intertask_request;
    VAR status: ost$status);

    CONST
      it_response_wait_time = 60*1000 {1 minute};

    VAR
      wait_list: ^ost$i_wait_list,
      ready_index: INTEGER,
      ignore_status: ost$status,
      intertask_response: nft$sou_intertask_response;


    nfp$put_async_task_message (async_task_id, ^intertask_request, #SIZE (intertask_request), status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    PUSH wait_list: [1 .. 2];
    wait_list^[1].activity := pmc$i_await_local_queue_message;
    wait_list^[1].qid := local_queue_id;
    wait_list^[2].activity := osc$i_await_time;
    wait_list^[2].milliseconds := it_response_wait_time;
    osp$i_await_activity_completion (wait_list^, ready_index, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    IF ready_index = 2 THEN  {timeout}
      osp$set_status_condition ( nfe$sou_async_task_no_response,  status);
      RETURN;
    ELSE  {message received}
      nfp$get_async_task_message (async_task_id, ^intertask_response, #SIZE (intertask_response), 0,
            transfer_count, status);
      IF NOT status.normal THEN
        RETURN;
      IFEND;
      IF transfer_count = 0 THEN
        osp$set_status_condition ( nfe$sou_async_task_no_response,  status);
      ELSEIF intertask_response.response <> nfc$sou_complete THEN
        osp$set_status_condition ( nfe$sou_invalid_intertask_resp,  status);
      IFEND;
    IFEND;

  PROCEND send_intertask_request;

?? TITLE := '  hold_async_task', EJECT ??

{
{   The purpose of this procedure is to request that the asynchronous
{   task temporarily stop communication with SCFS to allow the primary
{   task to do so.
{

  PROCEDURE hold_async_task (VAR status: ost$status);

    VAR
      ignore_status: ost$status,
      intertask_request: nft$sou_intertask_request;


    intertask_request.request := nfc$sou_hold;
    send_intertask_request (intertask_request, status);
    IF NOT status.normal THEN
      osp$set_status_condition ( nae$connection_terminated,status);
      clp$end_scan_command_file (operator_utility_name,ignore_status);
    IFEND;

  PROCEND hold_async_task;

?? TITLE := '  resume_async_task', EJECT ??

{
{   The purpose of this procedure is to allow the asynchronous task to
{   resume communication with SCFS.
{

  PROCEDURE resume_async_task (VAR status: ost$status);

    VAR
      local_status: ost$status,
      intertask_request: nft$sou_intertask_request;


    local_status.normal := TRUE;
    status.normal := TRUE;
 /display_msg/
    WHILE operator_message_list <> NIL DO
      display_operator_message (status);
      IF NOT status.normal THEN
        EXIT /display_msg/;
      IFEND;
    WHILEND /display_msg/;

    intertask_request.request := nfc$sou_resume;
    send_intertask_request (intertask_request, local_status);
    IF status.normal AND NOT local_status.normal THEN
      status := local_status;
    IFEND;

  PROCEND resume_async_task;

?? TITLE := '  send_scfs_message', EJECT ??

{
{   The purpose of this procedure is to send a message on connection
{   to SCFS and wait for a response.  If the expected response is not
{   received within a reasonable amount of time it will time out.
{

  PROCEDURE send_scfs_message (VAR status: ost$status);

    CONST
      pause_time = 500,     {1/2 second (milliseconds)}
      timeout_interval = 1*60*1000000;  {1 minute (microseconds)}

    VAR
      message_type_sent: nft$message_kind,
      message_received: BOOLEAN,
      time: INTEGER,
      end_time: INTEGER,
      ignore_status: ost$status;


    message_type_sent := message_type^;
    nfp$send_message_on_connection (message, message_length, network_file_id, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    pmp$get_microsecond_clock (time, ignore_status);
    end_time := time + timeout_interval;

 /get_response/
    BEGIN

   /wait_response/
      WHILE time < end_time DO
        get_network_message (message_received, status);
        IF NOT status.normal THEN
          RETURN;
        IFEND;

        IF NOT message_received THEN
          pmp$long_term_wait (pause_time, pause_time);
          pmp$get_microsecond_clock (time, ignore_status);
          CYCLE /wait_response/;
        IFEND;

        get_message_type;
        IF message_type^ = response_types [message_type_sent] THEN
          EXIT /get_response/;
        ELSEIF message_type^ = nfc$queue_entry_data THEN
          IF (message_type_sent = nfc$get_queue_entry_list) AND station_operator THEN

{ SCFS can reply to a Get_Queue_Entry_List message with a Get_Queue_Entry_List_Data message
{ as defined in the response type table, or SCFS can reply with a Get_Queue_Entry_Data
{ message instead.  This is done to reduce response time to the OPERATE_STATION command
{ "DISSQE ALL ALL".

            EXIT /get_response/;
          IFEND;
        ELSEIF message_type^ = nfc$device_status_data THEN
          IF (message_type_sent = nfc$get_station_status) THEN

{ SCFS can reply to a Get_Station_Status message with a Station_Status_Data message
{ as defined in the response type table, or SCFS can reply with a Device_Status_Data
{ message instead.  This is done to reduce response time to the OPERATE_STATION command
{ "DISBDS ALL ALL".

            EXIT /get_response/;
          IFEND;
        ELSEIF message_type^ = nfc$operator_message THEN
          queue_operator_message;
        IFEND;

      WHILEND /wait_response/;

      IF NOT message_received THEN
        osp$set_status_condition ( nfe$sou_scfs_no_response,
               status);
      IFEND;

    END /get_response/;

  PROCEND send_scfs_message;

?? TITLE := '  await_next_message', EJECT ??

{
{ The purpose of this procedure is to return the next non-operator message found on the
{ network.  The procedure will return an abnormal status if no such message is found within
{ the timeout period.
{

  PROCEDURE await_next_message (VAR status: ost$status);

    CONST
      pause_time = 500,     { 1/2 second in milliseconds }
      timeout_interval = 1*60*1000000;  { 1 minute in microseconds }

    VAR
      message_received: BOOLEAN,
      time: INTEGER,
      end_time: INTEGER,
      ignore_status: ost$status;

    pmp$get_microsecond_clock (time, ignore_status);
    end_time := time + timeout_interval;

 /get_next_response/
    BEGIN
   /wait_next_response/
      WHILE time < end_time DO
        get_network_message (message_received, status);
        IF NOT status.normal THEN
          RETURN;
        IFEND;

        IF NOT message_received THEN
          pmp$long_term_wait (pause_time, pause_time);
          pmp$get_microsecond_clock (time, ignore_status);
          CYCLE /wait_next_response/;
        IFEND;

        IF message_type^ = nfc$operator_message THEN
          queue_operator_message;
        ELSE
          EXIT /get_next_response/;
        IFEND;
      WHILEND /wait_next_response/;

      IF NOT message_received THEN
        osp$set_status_condition (nfe$sou_scfs_no_response, status);
      IFEND;

    END /get_next_response/;
  PROCEND await_next_message;

?? TITLE := '  get_network_message', EJECT ??

{
{   The purpose of this procedure is to get a the next message
{   from SCFS/VE from the network.
{

  PROCEDURE get_network_message (VAR message_received: BOOLEAN;
    VAR status: ost$status);

    CONST
      wait_time = 0;

    VAR
      data_area: ^nat$data_fragments,
      peer_operation: nat$se_peer_operation,
      activity_status: ost$activity_status;


    message_received := FALSE;
    nap$await_data_available (network_file_id, wait_time, wait_time, status);
    IF NOT status.normal THEN
      IF status.condition = nae$no_data_available THEN
        status.normal := TRUE;
      IFEND;
      RETURN;
    IFEND;

    PUSH data_area: [1 .. 1];
    data_area^ [1].address := message;
    data_area^ [1].length := #SIZE (message^);
    nap$se_receive_data (network_file_id, data_area^, osc$wait, peer_operation, activity_status, status);
    IF status.normal AND NOT activity_status.status.normal THEN
      status := activity_status.status;
    IFEND;
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    IF peer_operation.kind = nac$se_send_data THEN
      message_length := peer_operation.data_length;
      message_received := TRUE;
    ELSE
      osp$set_status_abnormal (nfc$status_id, nfe$sou_unexpected_network_req,
            peer_operations [peer_operation.kind], status);
    IFEND;

  PROCEND get_network_message;

?? TITLE := '  add_user', EJECT ??

{
{   Procedure to register the user with SCFS/VE as an I/O
{   station operator.
{

  PROCEDURE add_user (VAR status: ost$status);

*copy nft$add_user_msg

    VAR
      user_id: ost$user_identification,
      job_attributes: ^jmt$job_attribute_results,
      terminal_device_info: t$terminal_device_information,
      control_device_name: ost$name;


    control_device_name := osc$null_name;
    PUSH job_attributes: [1 .. 1];
    job_attributes^[1].key := jmc$job_input_device;
    PUSH job_attributes^ [1].job_input_device;
    jmp$get_job_attributes (job_attributes, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;
    IF job_attributes^[1].job_input_device^.size <> 0 THEN
      terminal_device_info.attr_data := job_attributes^[1].job_input_device^;
      control_device_name := terminal_device_info.acctg_data.acctg_record.device_name;
    IFEND;

    put_message_type (nfc$add_user);
    put_string_parameter ($INTEGER(nfc$station_or_control_facility), station_name);

    pmp$get_user_identification (user_id, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    put_string_parameter ($INTEGER(nfc$user_name), user_id.user);
    put_string_parameter ($INTEGER(nfc$family_name), user_id.family);
    IF control_device_name <> osc$null_name THEN
      put_string_parameter ($INTEGER(nfc$control_device_name), control_device_name);
    IFEND;
    put_null_parameter;
    send_scfs_message (status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    add_user_response (status);

  PROCEND add_user;

?? TITLE := '  check_file_ownership', EJECT ??
{   Verify that the current user is allowed to get the status for an output
{   file.

  PROCEDURE check_file_ownership
   (    system_file_name: STRING (* <= osc$max_name_size);
    VAR status: ost$status);

    VAR
      output_name: jmt$name,
      number_of_outputs_found: jmt$output_status_count,
      status_options_p: ^jmt$output_status_options,
      status_results_p: ^jmt$output_status_results,
      work_area_p: ^jmt$work_area;

    status.normal := TRUE;

{   Attempt to get the output queue file's status.

    PUSH status_options_p: [1 .. 1];
    status_options_p^ [1].key := jmc$name_list;
    status_options_p^ [1].name_list := NIL;
    PUSH status_options_p^ [1].name_list: [1 .. 1];
    status_options_p^ [1].name_list^ [1].kind := jmc$system_supplied_name;
    status_options_p^ [1].name_list^ [1].system_supplied_name := system_file_name;
    work_area_p := NIL;
    jmp$get_output_status (status_options_p, {output_status_results_keys_p} NIL,
          work_area_p, status_results_p, number_of_outputs_found, status);

  PROCEND check_file_ownership;

?? TITLE := '  change_batch_device_attributes command', EJECT ??

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

*copy nft$change_bd_attributes_msg

{
{  PDT chabda_pdt (
{    device_name, dn                      : name = $required
{    banner_highlight_field, bhf          : key comment_banner, cb, routing_banner, rb, site_banner, sb, ..
{                                               user_file_name, ufn, user_name, un = $optional
{    banner_page_count, bpc               : integer 0..3 = $optional
{    carriage_control_support, ccs        : key pre_print, post_print, both, b = $optional
{    code_set, cs                         : key ascii, ascii48, ascii64, ascii95, ascii128 = $optional
{    device_alias_1, da1                  : name or key none = $optional
{    device_alias_2, da2                  : name or key none = $optional
{    device_alias_3, da3                  : name or key none = $optional
{    external_characteristics_1, ec1      : string 0..6 = $optional
{    external_characteristics_2, ec2      : string 0..6 = $optional
{    external_characteristics_3, ec3      : string 0..6 = $optional
{    external_characteristics_4, ec4      : string 0..6 = $optional
{    file_acknowledgement, fa             : boolean = $optional
{    forms_code_1, fc1                    : string 0..6 = $optional
{    forms_code_2, fc2                    : string 0..6 = $optional
{    forms_code_3, fc3                    : string 0..6 = $optional
{    forms_code_4, fc4                    : string 0..6 = $optional
{    forms_size, fs                       : string 1..4 = $optional
{    maximum_file_size, mfs               : integer 0..99999999 = $optional
{    page_width, pw                       : integer 10..255 = $optional
{    terminal_model, tm                   : name = $optional
{    transmission_block_size, tbs         : integer 0..65535 = $optional
{    undefined_fe_action, ..
{    un_defined_fe_action, undfa, udfa    : key print_after_spacing, pas, print_before_spacing, pbs, ..
{                                               discard_print_line, dpl = $optional
{    unsupported_fe_action, ..
{    un_supported_fe_action, unsfa, usfa  : key print_after_spacing, pas, print_before_spacing, pbs, ..
{                                               discard_print_line, dpl = $optional
{    vertical_print_density, vpd          : key six_only, eight_only, six_any, eight_any = $optional
{    vfu_load_procedure, vlp              : name = $optional
{    status                               : var of status = $optional
{    )

?? PUSH (LISTEXT := ON) ??

  VAR
    chabda_pdt: [STATIC, READ, cls$pdt] clt$parameter_descriptor_table := [^chabda_pdt_names,
      ^chabda_pdt_params];

  VAR
    chabda_pdt_names: [STATIC, READ, cls$pdt_names_and_defaults] array [1 .. 57] of
      clt$parameter_name_descriptor := [['DEVICE_NAME', 1], ['DN', 1], ['BANNER_HIGHLIGHT_FIELD', 2], ['BHF',
      2], ['BANNER_PAGE_COUNT', 3], ['BPC', 3], ['CARRIAGE_CONTROL_SUPPORT', 4], ['CCS', 4], ['CODE_SET', 5],
      ['CS', 5], ['DEVICE_ALIAS_1', 6], ['DA1', 6], ['DEVICE_ALIAS_2', 7], ['DA2', 7], ['DEVICE_ALIAS_3', 8],
      ['DA3', 8], ['EXTERNAL_CHARACTERISTICS_1', 9], ['EC1', 9], ['EXTERNAL_CHARACTERISTICS_2', 10], ['EC2',
      10], ['EXTERNAL_CHARACTERISTICS_3', 11], ['EC3', 11], ['EXTERNAL_CHARACTERISTICS_4', 12], ['EC4', 12], [
      'FILE_ACKNOWLEDGEMENT', 13], ['FA', 13], ['FORMS_CODE_1', 14], ['FC1', 14], ['FORMS_CODE_2', 15], ['FC2'
      , 15], ['FORMS_CODE_3', 16], ['FC3', 16], ['FORMS_CODE_4', 17], ['FC4', 17], ['FORMS_SIZE', 18], ['FS',
      18], ['MAXIMUM_FILE_SIZE', 19], ['MFS', 19], ['PAGE_WIDTH', 20], ['PW', 20], ['TERMINAL_MODEL', 21], [
      'TM', 21], ['TRANSMISSION_BLOCK_SIZE', 22], ['TBS', 22], ['UNDEFINED_FE_ACTION', 23], [
      'UN_DEFINED_FE_ACTION', 23], ['UNDFA', 23], ['UDFA', 23], ['UNSUPPORTED_FE_ACTION', 24], [
      'UN_SUPPORTED_FE_ACTION', 24], ['UNSFA', 24], ['USFA', 24], ['VERTICAL_PRINT_DENSITY', 25], ['VPD', 25]
      , ['VFU_LOAD_PROCEDURE', 26], ['VLP', 26], ['STATUS', 27]];

  VAR
    chabda_pdt_params: [STATIC, READ, cls$pdt_parameters] array [1 .. 27] of clt$parameter_descriptor := [

{ DEVICE_NAME DN }
    [[clc$required], 1, 1, 1, 1, clc$value_range_not_allowed, [NIL, clc$name_value, 1, osc$max_name_size]],

{ BANNER_HIGHLIGHT_FIELD BHF }
    [[clc$optional], 1, 1, 1, 1, clc$value_range_not_allowed, [^chabda_pdt_kv2, clc$keyword_value]],

{ BANNER_PAGE_COUNT BPC }
    [[clc$optional], 1, 1, 1, 1, clc$value_range_not_allowed, [NIL, clc$integer_value, 0, 3]],

{ CARRIAGE_CONTROL_SUPPORT CCS }
    [[clc$optional], 1, 1, 1, 1, clc$value_range_not_allowed, [^chabda_pdt_kv4, clc$keyword_value]],

{ CODE_SET CS }
    [[clc$optional], 1, 1, 1, 1, clc$value_range_not_allowed, [^chabda_pdt_kv5, clc$keyword_value]],

{ DEVICE_ALIAS_1 DA1 }
    [[clc$optional], 1, 1, 1, 1, clc$value_range_not_allowed, [^chabda_pdt_kv6, clc$name_value, 1,
      osc$max_name_size]],

{ DEVICE_ALIAS_2 DA2 }
    [[clc$optional], 1, 1, 1, 1, clc$value_range_not_allowed, [^chabda_pdt_kv7, clc$name_value, 1,
      osc$max_name_size]],

{ DEVICE_ALIAS_3 DA3 }
    [[clc$optional], 1, 1, 1, 1, clc$value_range_not_allowed, [^chabda_pdt_kv8, clc$name_value, 1,
      osc$max_name_size]],

{ EXTERNAL_CHARACTERISTICS_1 EC1 }
    [[clc$optional], 1, 1, 1, 1, clc$value_range_not_allowed, [NIL, clc$string_value, 0, 6]],

{ EXTERNAL_CHARACTERISTICS_2 EC2 }
    [[clc$optional], 1, 1, 1, 1, clc$value_range_not_allowed, [NIL, clc$string_value, 0, 6]],

{ EXTERNAL_CHARACTERISTICS_3 EC3 }
    [[clc$optional], 1, 1, 1, 1, clc$value_range_not_allowed, [NIL, clc$string_value, 0, 6]],

{ EXTERNAL_CHARACTERISTICS_4 EC4 }
    [[clc$optional], 1, 1, 1, 1, clc$value_range_not_allowed, [NIL, clc$string_value, 0, 6]],

{ FILE_ACKNOWLEDGEMENT FA }
    [[clc$optional], 1, 1, 1, 1, clc$value_range_not_allowed, [NIL, clc$boolean_value]],

{ FORMS_CODE_1 FC1 }
    [[clc$optional], 1, 1, 1, 1, clc$value_range_not_allowed, [NIL, clc$string_value, 0, 6]],

{ FORMS_CODE_2 FC2 }
    [[clc$optional], 1, 1, 1, 1, clc$value_range_not_allowed, [NIL, clc$string_value, 0, 6]],

{ FORMS_CODE_3 FC3 }
    [[clc$optional], 1, 1, 1, 1, clc$value_range_not_allowed, [NIL, clc$string_value, 0, 6]],

{ FORMS_CODE_4 FC4 }
    [[clc$optional], 1, 1, 1, 1, clc$value_range_not_allowed, [NIL, clc$string_value, 0, 6]],

{ FORMS_SIZE FS }
    [[clc$optional], 1, 1, 1, 1, clc$value_range_not_allowed, [NIL, clc$string_value, 1, 4]],

{ MAXIMUM_FILE_SIZE MFS }
    [[clc$optional], 1, 1, 1, 1, clc$value_range_not_allowed, [NIL, clc$integer_value, 0, 99999999]],

{ PAGE_WIDTH PW }
    [[clc$optional], 1, 1, 1, 1, clc$value_range_not_allowed, [NIL, clc$integer_value, 10, 255]],

{ TERMINAL_MODEL TM }
    [[clc$optional], 1, 1, 1, 1, clc$value_range_not_allowed, [NIL, clc$name_value, 1, osc$max_name_size]],

{ TRANSMISSION_BLOCK_SIZE TBS }
    [[clc$optional], 1, 1, 1, 1, clc$value_range_not_allowed, [NIL, clc$integer_value, 0, 65535]],

{ UNDEFINED_FE_ACTION UN_DEFINED_FE_ACTION UNDFA UDFA }
    [[clc$optional], 1, 1, 1, 1, clc$value_range_not_allowed, [^chabda_pdt_kv23, clc$keyword_value]],

{ UNSUPPORTED_FE_ACTION UN_SUPPORTED_FE_ACTION UNSFA USFA }
    [[clc$optional], 1, 1, 1, 1, clc$value_range_not_allowed, [^chabda_pdt_kv24, clc$keyword_value]],

{ VERTICAL_PRINT_DENSITY VPD }
    [[clc$optional], 1, 1, 1, 1, clc$value_range_not_allowed, [^chabda_pdt_kv25, clc$keyword_value]],

{ VFU_LOAD_PROCEDURE VLP }
    [[clc$optional], 1, 1, 1, 1, clc$value_range_not_allowed, [NIL, clc$name_value, 1, osc$max_name_size]],

{ STATUS }
    [[clc$optional], 1, 1, 1, 1, clc$value_range_not_allowed, [NIL, clc$variable_reference,
      clc$array_not_allowed, clc$status_value]]];

  VAR
    chabda_pdt_kv2: [STATIC, READ, cls$pdt_names_and_defaults] array [1 .. 10] of ost$name := [
      'COMMENT_BANNER','CB','ROUTING_BANNER','RB','SITE_BANNER','SB','USER_FILE_NAME','UFN','USER_NAME','UN'];

  VAR
    chabda_pdt_kv4: [STATIC, READ, cls$pdt_names_and_defaults] array [1 .. 4] of ost$name := ['PRE_PRINT',
      'POST_PRINT','BOTH','B'];

  VAR
    chabda_pdt_kv5: [STATIC, READ, cls$pdt_names_and_defaults] array [1 .. 5] of ost$name := ['ASCII',
      'ASCII48','ASCII64','ASCII95','ASCII128'];

  VAR
    chabda_pdt_kv6: [STATIC, READ, cls$pdt_names_and_defaults] array [1 .. 1] of ost$name := ['NONE'];

  VAR
    chabda_pdt_kv7: [STATIC, READ, cls$pdt_names_and_defaults] array [1 .. 1] of ost$name := ['NONE'];

  VAR
    chabda_pdt_kv8: [STATIC, READ, cls$pdt_names_and_defaults] array [1 .. 1] of ost$name := ['NONE'];

  VAR
    chabda_pdt_kv23: [STATIC, READ, cls$pdt_names_and_defaults] array [1 .. 6] of ost$name := [
      'PRINT_AFTER_SPACING','PAS','PRINT_BEFORE_SPACING','PBS','DISCARD_PRINT_LINE','DPL'];

  VAR
    chabda_pdt_kv24: [STATIC, READ, cls$pdt_names_and_defaults] array [1 .. 6] of ost$name := [
      'PRINT_AFTER_SPACING','PAS','PRINT_BEFORE_SPACING','PBS','DISCARD_PRINT_LINE','DPL'];

  VAR
    chabda_pdt_kv25: [STATIC, READ, cls$pdt_names_and_defaults] array [1 .. 4] of ost$name := ['SIX_ONLY',
      'EIGHT_ONLY','SIX_ANY','EIGHT_ANY'];

?? POP ??

    TYPE
      longreal_conversion = record
        real_word1: real,
        real_word2: real,
      recend;

    VAR
      converted_device_forms_size: longreal_conversion,
      device_forms_size: clt$real,
      divisor: [STATIC] real := 0.5,
      real_forms_size: real,
      value: clt$value,
      code_set: nft$code_set,
      device_name: ost$name,
      banner_page_count: nft$banner_page_count,
      banner_highlight_field: nft$banner_highlight_field,
      carriage_control_action: nft$carriage_control_action,
      device_alias: ost$name,
      external_characteristics: nft$external_characteristics,
      file_acknowledge: BOOLEAN,
      forms_code: nft$forms_code,
      forms_size: nft$forms_size,
      maximum_file_size: nft$device_file_size,
      page_width: nft$page_width,
      str_value: string (80),
      terminal_model: nft$terminal_model,
      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$vertical_print_density,
      vfu_load_procedure: nft$vfu_load_procedure,
      local_status: ost$status;

    clp$scan_parameter_list (parameter_list, chabda_pdt, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    put_message_type (nfc$change_batch_device_attr);
    put_string_parameter ($INTEGER(nfc$io_station_name), station_name);

    clp$get_value ('DEVICE_NAME', 1, 1, clc$low, value, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;
    device_name := value.name.value;
    put_string_parameter ($INTEGER(nfc$device_name), device_name);

    clp$get_value ('BANNER_HIGHLIGHT_FIELD', 1, 1, clc$low, value, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;
    IF value.kind <> clc$unknown_value THEN
      IF (value.name.value = 'COMMENT_BANNER') OR (value.name.value = 'CB') THEN
        banner_highlight_field := nfc$comment_banner;
      ELSEIF (value.name.value = 'ROUTING_BANNER') OR (value.name.value = 'RB') THEN
        banner_highlight_field := nfc$routing_banner;
      ELSEIF (value.name.value = 'SITE_BANNER') OR (value.name.value = 'SB') THEN
        banner_highlight_field := nfc$site_banner;
      ELSEIF (value.name.value = 'USER_FILE_NAME') OR (value.name.value = 'UFN') THEN
        banner_highlight_field := nfc$user_file_name;
      ELSE
        banner_highlight_field := nfc$user_name;
      IFEND;
      put_parameter ($INTEGER(nfc$banner_highlight_field), ^banner_highlight_field,
            #SIZE(banner_highlight_field));
    IFEND;

    clp$get_value ('BANNER_PAGE_COUNT', 1, 1, clc$low, value, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;
    IF value.kind <> clc$unknown_value THEN
      banner_page_count := value.int.value;
      put_parameter ($INTEGER(nfc$banner_page_count), ^banner_page_count, #SIZE(banner_page_count));
    IFEND;

    clp$get_value ('CARRIAGE_CONTROL_SUPPORT', 1, 1, clc$low, value, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;
    IF value.kind <> clc$unknown_value THEN
      IF value.name.value = 'PRE_PRINT' THEN
        carriage_control_action := nfc$pre_print;
      ELSEIF value.name.value = 'POST_PRINT' THEN
        carriage_control_action := nfc$post_print;
      ELSE
        carriage_control_action := nfc$pre_and_post_print;
      IFEND;
      put_parameter ($INTEGER(nfc$carriage_control_action), ^carriage_control_action,
            #SIZE(carriage_control_action));
    IFEND;

    clp$get_value ('CODE_SET', 1, 1, clc$low, value, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;
    IF value.kind <> clc$unknown_value THEN
      IF value.name.value = 'ASCII' THEN
        code_set := nfc$ascii;
      ELSEIF value.name.value = 'ASCII48' THEN
        code_set := nfc$ascii_48;
      ELSEIF value.name.value = 'ASCII64' THEN
        code_set := nfc$ascii_64;
      ELSEIF value.name.value = 'ASCII95' THEN
        code_set := nfc$ascii_95;
      ELSEIF value.name.value = 'ASCII128' THEN
        code_set := nfc$ascii_128;
      IFEND;
      put_parameter ($INTEGER(nfc$code_set), ^code_set, #SIZE(code_set));
    IFEND;

    clp$get_value ('VERTICAL_PRINT_DENSITY', 1, 1, clc$low, value, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;
    IF value.kind <> clc$unknown_value THEN
      IF (value.name.value = 'SIX_ONLY') THEN
        vertical_print_density := nfc$six_only;
      ELSEIF (value.name.value = 'EIGHT_ONLY') THEN
        vertical_print_density := nfc$eight_only;
      ELSEIF (value.name.value = 'SIX_ANY') THEN
        vertical_print_density := nfc$six_any;
      ELSEIF (value.name.value = 'EIGHT_ANY') THEN
        vertical_print_density := nfc$eight_any;
      IFEND;
      put_parameter ($INTEGER(nfc$vertical_print_density), ^vertical_print_density,
            #SIZE(vertical_print_density));
    IFEND;


    clp$get_value ('DEVICE_ALIAS_1', 1, 1, clc$low, value, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;
    IF value.kind <> clc$unknown_value THEN
      IF value.name.value = 'NONE' THEN
        device_alias := ' ';
      ELSE
        device_alias := value.name.value;
      IFEND;
      put_string_parameter ($INTEGER(nfc$device_alias_1), device_alias);
    IFEND;

    clp$get_value ('DEVICE_ALIAS_2', 1, 1, clc$low, value, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;
    IF value.kind <> clc$unknown_value THEN
      IF value.name.value = 'NONE' THEN
        device_alias := ' ';
      ELSE
        device_alias := value.name.value;
      IFEND;
      put_string_parameter ($INTEGER(nfc$device_alias_2), device_alias);
    IFEND;

    clp$get_value ('DEVICE_ALIAS_3', 1, 1, clc$low, value, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;
    IF value.kind <> clc$unknown_value THEN
      IF value.name.value = 'NONE' THEN
        device_alias := ' ';
      ELSE
        device_alias := value.name.value;
      IFEND;
      put_string_parameter ($INTEGER(nfc$device_alias_3), device_alias);
    IFEND;

    clp$get_value ('EXTERNAL_CHARACTERISTICS_1', 1, 1, clc$low, value, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;
    IF value.kind <> clc$unknown_value THEN
      external_characteristics := value.str.value;
      put_string_parameter ($INTEGER(nfc$external_characteristics_1), external_characteristics);
    IFEND;

    clp$get_value ('EXTERNAL_CHARACTERISTICS_2', 1, 1, clc$low, value, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;
    IF value.kind <> clc$unknown_value THEN
      external_characteristics := value.str.value;
      put_string_parameter ($INTEGER(nfc$external_characteristics_2), external_characteristics);
    IFEND;

    clp$get_value ('EXTERNAL_CHARACTERISTICS_3', 1, 1, clc$low, value, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;
    IF value.kind <> clc$unknown_value THEN
      external_characteristics := value.str.value;
      put_string_parameter ($INTEGER(nfc$external_characteristics_3), external_characteristics);
    IFEND;

    clp$get_value ('EXTERNAL_CHARACTERISTICS_4', 1, 1, clc$low, value, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;
    IF value.kind <> clc$unknown_value THEN
      external_characteristics := value.str.value;
      put_string_parameter ($INTEGER(nfc$external_characteristics_4), external_characteristics);
    IFEND;

    clp$get_value ('FILE_ACKNOWLEDGEMENT', 1, 1, clc$low, value, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;
    IF value.kind <> clc$unknown_value THEN
      file_acknowledge := value.bool.value;
      put_parameter ($INTEGER(nfc$file_acknowledge), ^file_acknowledge, #SIZE(file_acknowledge));
    IFEND;

    clp$get_value ('FORMS_CODE_1', 1, 1, clc$low, value, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;
    IF value.kind <> clc$unknown_value THEN
      forms_code := value.str.value;
      put_string_parameter ($INTEGER(nfc$forms_code_1), forms_code);
    IFEND;

    clp$get_value ('FORMS_CODE_2', 1, 1, clc$low, value, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;
    IF value.kind <> clc$unknown_value THEN
      forms_code := value.str.value;
      put_string_parameter ($INTEGER(nfc$forms_code_2), forms_code);
    IFEND;

    clp$get_value ('FORMS_CODE_3', 1, 1, clc$low, value, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;
    IF value.kind <> clc$unknown_value THEN
      forms_code := value.str.value;
      put_string_parameter ($INTEGER(nfc$forms_code_3), forms_code);
    IFEND;

    clp$get_value ('FORMS_CODE_4', 1, 1, clc$low, value, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;
    IF value.kind <> clc$unknown_value THEN
      forms_code := value.str.value;
      put_string_parameter ($INTEGER(nfc$forms_code_4), forms_code);
    IFEND;

    clp$get_value ('FORMS_SIZE', 1, 1, clc$low, value, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;
    IF value.kind <> clc$unknown_value THEN
      clp$convert_string_to_real (value.str.value, device_forms_size, status);
      IF status.normal THEN
        #UNCHECKED_CONVERSION(device_forms_size.value , converted_device_forms_size);
        real_forms_size := converted_device_forms_size.real_word1;

{  Check that the forms size value is within the range allowed.  }

        IF ((real_forms_size*2.0) >= $REAL (nfc$min_forms_size)) AND
              ((real_forms_size*2.0) <= $REAL (nfc$max_forms_size)) THEN

{  Check that the forms size value is a multiple of 1/2.  }

          IF $REAL ($INTEGER (real_forms_size/divisor)) = (real_forms_size/divisor) THEN
            forms_size := $INTEGER (real_forms_size*2.0);
            put_parameter ($INTEGER(nfc$forms_size), ^forms_size, #SIZE(forms_size));
          ELSE
            osp$set_status_abnormal (nfc$status_id, nfe$sou_command_reject,
                  'CHANGE_BATCH_DEVICE_ATTRIBUTES', status);
            str_value (1, value.str.size) := value.str.value;
            str_value (1+value.str.size, 25) := ' is not a multiple of 1/2';
            osp$append_status_parameter (osc$status_parameter_delimiter,
                  str_value (1, value.str.size+25), status);
            RETURN;
          IFEND;
        ELSE
          osp$set_status_abnormal (nfc$status_id, nfe$sou_command_reject,
                'CHANGE_BATCH_DEVICE_ATTRIBUTES', status);
          str_value (1, value.str.size) := value.str.value;
          str_value (1+value.str.size, 39) := ' is outside range supported (.5 - 31.0)';
          osp$append_status_parameter (osc$status_parameter_delimiter,
                str_value (1, value.str.size+39), status);
          RETURN;
        IFEND;
      ELSE;
        RETURN;
      IFEND;
    IFEND;

    clp$get_value ('MAXIMUM_FILE_SIZE', 1, 1, clc$low, value, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;
    IF value.kind <> clc$unknown_value THEN
      maximum_file_size := value.int.value;
      put_parameter ($INTEGER(nfc$maximum_file_size), ^maximum_file_size, #SIZE(maximum_file_size));
    IFEND;

    clp$get_value ('PAGE_WIDTH', 1, 1, clc$low, value, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;
    IF value.kind <> clc$unknown_value THEN
      page_width := value.int.value;
      put_parameter ($INTEGER(nfc$page_width), ^page_width, #SIZE(page_width));
    IFEND;

    clp$get_value ('TERMINAL_MODEL', 1, 1, clc$low, value, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;
    IF value.kind <> clc$unknown_value THEN
      terminal_model := value.name.value;
      put_string_parameter ($INTEGER(nfc$terminal_model), terminal_model);
    IFEND;

    clp$get_value ('TRANSMISSION_BLOCK_SIZE', 1, 1, clc$low, value, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;
    IF value.kind <> clc$unknown_value THEN
      transmission_block_size := value.int.value;
      put_parameter ($INTEGER(nfc$transmission_block_size), ^transmission_block_size,
            #SIZE(transmission_block_size));
    IFEND;

    clp$get_value ('UNDEFINED_FE_ACTION', 1, 1, clc$low, value, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;
    IF value.kind <> clc$unknown_value THEN
      IF (value.name.value = 'PAS') OR (value.name.value = 'PRINT_AFTER_SPACING') THEN
        undefined_fe_action := nfc$print_after_spacing;
      ELSEIF (value.name.value = 'PBS') OR (value.name.value = 'PRINT_BEFORE_SPACING') THEN
        undefined_fe_action := nfc$print_before_spacing;
      ELSEIF (value.name.value = 'DPL') OR (value.name.value = 'DISCARD_PRINT_LINE') THEN
        undefined_fe_action := nfc$discard_print_line;
      IFEND;
      put_parameter ($INTEGER(nfc$undefined_fe_action), ^undefined_fe_action, #SIZE(undefined_fe_action));
    IFEND;

    clp$get_value ('UNSUPPORTED_FE_ACTION', 1, 1, clc$low, value, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;
    IF value.kind <> clc$unknown_value THEN
      IF (value.name.value = 'PAS') OR (value.name.value = 'PRINT_AFTER_SPACING') THEN
        unsupported_fe_action := nfc$print_after_spacing;
      ELSEIF (value.name.value = 'PBS') OR (value.name.value = 'PRINT_BEFORE_SPACING') THEN
        unsupported_fe_action := nfc$print_before_spacing;
      ELSEIF (value.name.value = 'DPL') OR (value.name.value = 'DISCARD_PRINT_LINE') THEN
        unsupported_fe_action := nfc$discard_print_line;
      IFEND;
      put_parameter ($INTEGER(nfc$unsupported_fe_action), ^unsupported_fe_action,
            #SIZE(unsupported_fe_action));
    IFEND;

    clp$get_value ('VFU_LOAD_PROCEDURE', 1, 1, clc$low, value, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;
    IF value.kind <> clc$unknown_value THEN
      vfu_load_procedure := value.name.value;
      put_string_parameter ($INTEGER(nfc$vfu_load_procedure), vfu_load_procedure);
    IFEND;

    put_null_parameter;

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

 /send_msg/
    BEGIN
      send_scfs_message (status);
      IF NOT status.normal THEN
        EXIT /send_msg/;
      IFEND;
      local_status.normal := TRUE;
      change_dev_attributes_response (local_status);
      IF status.normal AND NOT local_status.normal THEN
        status := local_status;
      IFEND;
    END /send_msg/;

    local_status.normal := TRUE;
    resume_async_task (local_status);
    IF status.normal AND NOT local_status.normal THEN
      status := local_status;
    IFEND;

  PROCEND change_batch_dev_attr_command;

?? TITLE := '  position_file command', EJECT ??

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

  CONST
    maximum_int_location = 65535,
    maximum_str_location = osc$max_string_size;

{ PDT posf_pdt (
{   device_name, dn       : name = $required
{   location, l           : list 1..2 of any = 1
{   units, u              : key lines, line, l, pages, page, p = page
{   direction, d          : key forward, f, backward, back, b = backward
{   starting_position, sp : key beginning, b, end, e, last_line_printed, llp = last_line_printed
{   preview, pv, p        : integer 1..10 = $optional
{   status                : var of status = $optional
{   )

?? PUSH (LISTEXT := ON) ??

  VAR
    posf_pdt: [STATIC, READ, cls$pdt] clt$parameter_descriptor_table := [^posf_pdt_names, ^posf_pdt_params];

  VAR
    posf_pdt_names: [STATIC, READ, cls$pdt_names_and_defaults] array [1 .. 14] of
      clt$parameter_name_descriptor := [['DEVICE_NAME', 1], ['DN', 1], ['LOCATION', 2], ['L', 2], ['UNITS', 3]
      , ['U', 3], ['DIRECTION', 4], ['D', 4], ['STARTING_POSITION', 5], ['SP', 5], ['PREVIEW', 6], ['PV', 6],
      ['P', 6], ['STATUS', 7]];

  VAR
    posf_pdt_params: [STATIC, READ, cls$pdt_parameters] array [1 .. 7] of clt$parameter_descriptor := [

{ DEVICE_NAME DN }
    [[clc$required], 1, 1, 1, 1, clc$value_range_not_allowed, [NIL, clc$name_value, 1, osc$max_name_size]],

{ LOCATION L }
    [[clc$optional_with_default, ^posf_pdt_dv2], 1, 2, 1, 1, clc$value_range_not_allowed, [NIL, clc$any_value
      ]],

{ UNITS U }
    [[clc$optional_with_default, ^posf_pdt_dv3], 1, 1, 1, 1, clc$value_range_not_allowed, [^posf_pdt_kv3,
      clc$keyword_value]],

{ DIRECTION D }
    [[clc$optional_with_default, ^posf_pdt_dv4], 1, 1, 1, 1, clc$value_range_not_allowed, [^posf_pdt_kv4,
      clc$keyword_value]],

{ STARTING_POSITION SP }
    [[clc$optional_with_default, ^posf_pdt_dv5], 1, 1, 1, 1, clc$value_range_not_allowed, [^posf_pdt_kv5,
      clc$keyword_value]],

{ PREVIEW PV P }
    [[clc$optional], 1, 1, 1, 1, clc$value_range_not_allowed, [NIL, clc$integer_value, 1, 10]],

{ STATUS }
    [[clc$optional], 1, 1, 1, 1, clc$value_range_not_allowed, [NIL, clc$variable_reference,
      clc$array_not_allowed, clc$status_value]]];

  VAR
    posf_pdt_kv3: [STATIC, READ, cls$pdt_names_and_defaults] array [1 .. 6] of ost$name := ['LINES','LINE','L'
      ,'PAGES','PAGE','P'];

  VAR
    posf_pdt_kv4: [STATIC, READ, cls$pdt_names_and_defaults] array [1 .. 5] of ost$name := ['FORWARD','F',
      'BACKWARD','BACK','B'];

  VAR
    posf_pdt_kv5: [STATIC, READ, cls$pdt_names_and_defaults] array [1 .. 6] of ost$name := ['BEGINNING','B',
      'END','E','LAST_LINE_PRINTED','LLP'];

  VAR
    posf_pdt_dv2: [STATIC, READ, cls$pdt_names_and_defaults] string (1) := '1';

  VAR
    posf_pdt_dv3: [STATIC, READ, cls$pdt_names_and_defaults] string (4) := 'page';

  VAR
    posf_pdt_dv4: [STATIC, READ, cls$pdt_names_and_defaults] string (8) := 'backward';

  VAR
    posf_pdt_dv5: [STATIC, READ, cls$pdt_names_and_defaults] string (17) := 'last_line_printed';

?? POP ??

*copy nft$position_file_msg

    VAR
      device_name: ost$name,
      direction: nft$position_file_direction,
      i: 1 .. clc$max_value_sets,
      int: integer,
      local_status: ost$status,
      location_integer: nft$position_file_locate_count,
      location_string_1: STRING (nfc$posf_max_string_length),
      location_string_2: STRING (nfc$posf_max_string_length),
      loc_value_1: clt$value,
      loc_value_2: clt$value,
      preview_line_count: nft$position_file_preview_count,
      set_count: 0 .. clc$max_value_sets,
      starting_position: nft$position_file_from_position,
      units: nft$position_file_units,
      value: clt$value,
      value_1: clt$value,
      value_2: clt$value,
      variable: clt$variable_reference;


    PROCEDURE convert_variable_to_value (variable: clt$variable_reference;
          VAR  value: clt$value;
          VAR status: ost$status);

      VAR
        string_pointer: ^ost$string;

      IF variable.upper_bound <> variable.lower_bound THEN
        osp$set_status_condition ( nfe$invalid_value_for_location,  status);
        RETURN;
      IFEND;

      CASE variable.value.kind OF

      = clc$integer_value =
        value.kind := clc$integer_value;
        value.int.value := variable.value.integer_value^ [1].value;

      = clc$string_value =
        value.kind := clc$string_value;
        string_pointer := #LOC (variable.value.string_value^ [1]);
        value.str.size := string_pointer^.size;
        value.str.value := string_pointer^.value (1, value.str.size);

      = clc$boolean_value, clc$status_value, clc$real_value =
        osp$set_status_condition ( nfe$invalid_value_for_location,  status);
        RETURN;

      CASEND;

    PROCEND convert_variable_to_value;


    clp$scan_parameter_list (parameter_list, posf_pdt, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    put_message_type (nfc$position_file_sou);
    put_string_parameter ($INTEGER(nfc$io_station_name), station_name);

    clp$get_value ('DEVICE_NAME', 1, 1, clc$low, value, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;
    device_name := value.name.value;
    put_string_parameter ($INTEGER(nfc$device_name), device_name);

{  The following code will get the 'location' parameter for the position_file command.  }
{  The checking is necessary until an scl parameter definition of the following is      }
{  supported:  location, l: integer 0..65536 or list 1..2 of string 1..255              }
{  This type of declaration will be supported at R1.3.1.                                }

    clp$get_set_count ('LOCATION', set_count, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    FOR i := 1 TO set_count DO
      clp$get_value ('LOCATION', i, 1, clc$low, value, status);
      IF NOT status.normal THEN
        RETURN;
      ELSEIF i=1 THEN
        value_1 := value;
      ELSE
        value_2 := value;
      IFEND;
    FOREND;

    CASE value_1.kind OF

    = clc$integer_value, clc$string_value =
      loc_value_1 := value_1;

    = clc$name_value =
      clp$read_variable (value_1.name.value, variable, status);
      IF status.normal THEN
        convert_variable_to_value (variable, loc_value_1, status);
        IF NOT status.normal THEN
          RETURN;
        IFEND;
      ELSEIF status.condition = cle$unknown_variable THEN
        RETURN;
      IFEND;

    = clc$variable_reference =
      convert_variable_to_value (value_1.var_ref, loc_value_1, status);
      IF NOT status.normal THEN
        RETURN;
      IFEND;

    ELSE  { reject all other value kinds }
      osp$set_status_condition ( nfe$invalid_value_for_location,  status);
      RETURN;

    CASEND;

    IF set_count = 2 THEN  { pick up second value }
      CASE value_2.kind OF

      = clc$integer_value, clc$string_value =
        loc_value_2 := value_2;

      = clc$name_value =
        clp$read_variable (value_2.name.value, variable, status);
        IF status.normal THEN
          convert_variable_to_value (variable, loc_value_2, status);
          IF NOT status.normal THEN
            RETURN;
          IFEND;
        ELSEIF status.condition = cle$unknown_variable THEN
          RETURN;
        IFEND;

      = clc$variable_reference =
        convert_variable_to_value (value_2.var_ref, loc_value_2, status);
        IF NOT status.normal THEN
          RETURN;
        IFEND;

      = clc$real_value, clc$boolean_value, clc$status_value =
        osp$set_status_condition ( nfe$invalid_value_for_location,  status);
        RETURN;

      CASEND;
    IFEND;
    IF set_count = 1 THEN
      IF loc_value_1.kind = clc$integer_value THEN
        int := loc_value_1.int.value;
        IF (int >= 0) AND (int <= maximum_int_location) THEN
          location_integer := int;
          put_parameter ($INTEGER(nfc$location_integer), ^location_integer, #SIZE(location_integer));
        ELSE
          osp$set_status_condition ( nfe$invalid_value_for_location,  status);
          RETURN;
        IFEND;
      ELSEIF loc_value_1.kind = clc$string_value THEN
        location_string_1 := loc_value_1.str.value;
        IF (strlength(location_string_1) > 0) AND (strlength(location_string_1) < maximum_str_location) THEN
          put_string_parameter ($INTEGER(nfc$location_string_1), location_string_1);
        ELSE
          osp$set_status_condition ( nfe$invalid_value_for_location,  status);
          RETURN;
        IFEND;
      IFEND;
    ELSEIF set_count = 2 THEN
      IF (loc_value_1.kind = clc$string_value) AND (loc_value_2.kind = clc$string_value) THEN
        location_string_1 := loc_value_1.str.value;
        location_string_2 := loc_value_2.str.value;
        IF ((strlength(location_string_1) > 0) AND (strlength(location_string_1) < maximum_str_location)) AND
           ((strlength(location_string_2) > 0) AND (strlength(location_string_2) < maximum_str_location)) THEN
          put_string_parameter ($INTEGER(nfc$location_string_1), location_string_1);
          put_string_parameter ($INTEGER(nfc$location_string_2), location_string_2);
        ELSE
          osp$set_status_condition ( nfe$invalid_value_for_location,  status);
          RETURN;
        IFEND;
      ELSE
        osp$set_status_condition ( nfe$invalid_value_for_location,  status);
        RETURN;
      IFEND;
    IFEND;

    clp$get_value ('UNITS', 1, 1, clc$low, value, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;
    IF (value.name.value = 'LINES') OR (value.name.value = 'LINE') OR (value.name.value = 'L') THEN
      units := nfc$position_file_line;
    ELSE {'PAGES'/'PAGE'/'P'}
      units := nfc$position_file_page;
    IFEND;
    put_parameter ($INTEGER(nfc$units), ^units, #SIZE(units));

    clp$get_value ('DIRECTION', 1, 1, clc$low, value, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;
    IF (value.name.value = 'FORWARD') OR (value.name.value = 'F') THEN
      direction := nfc$position_file_forwards;
    ELSE {'PAGES'/'PAGE'/'P'}
      direction := nfc$position_file_backwards;
    IFEND;
    put_parameter ($INTEGER(nfc$direction), ^direction, #SIZE(direction));

    clp$get_value ('STARTING_POSITION', 1, 1, clc$low, value, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;
    IF (value.name.value = 'BEGINNING') OR (value.name.value = 'B') THEN
      starting_position := nfc$beginning_of_file;
    ELSEIF (value.name.value = 'END') OR (value.name.value = 'E') THEN
      starting_position := nfc$end_of_file;
    ELSE {'LAST_LINE_PRINTED'/'LLP'}
      starting_position := nfc$last_line_printed;
    IFEND;
    put_parameter ($INTEGER(nfc$starting_position), ^starting_position, #SIZE(starting_position));

    clp$get_value ('PREVIEW', 1, 1, clc$low, value, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;
    IF value.kind <> clc$unknown_value THEN
      preview_line_count := value.int.value;
      put_parameter ($INTEGER(nfc$preview_line_count), ^preview_line_count, #SIZE(preview_line_count));
    IFEND;

    put_null_parameter;

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

 /send_msg/
    BEGIN
      send_scfs_message (status);
      IF NOT status.normal THEN
        EXIT /send_msg/;
      IFEND;
      local_status.normal := TRUE;
      device_control_response (nfc$position_file_resp, local_status);
      IF status.normal AND NOT local_status.normal THEN
        status := local_status;
      IFEND;
    END /send_msg/;

    local_status.normal := TRUE;
    resume_async_task (local_status);
    IF status.normal AND NOT local_status.normal THEN
      status := local_status;
    IFEND;

  PROCEND position_file_command;

?? TITLE := '  suppress_carriage_control command', EJECT ??

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

{ PDT supcc_pdt (
{   device_name, dn : NAME = $REQUIRED
{   STATUS)

?? PUSH (LISTEXT := ON) ??

  VAR
    supcc_pdt: [STATIC, READ, cls$pdt] clt$parameter_descriptor_table := [^supcc_pdt_names, ^supcc_pdt_params
      ];

  VAR
    supcc_pdt_names: [STATIC, READ, cls$pdt_names_and_defaults] array [1 .. 3] of
      clt$parameter_name_descriptor := [['DEVICE_NAME', 1], ['DN', 1], ['STATUS', 2]];

  VAR
    supcc_pdt_params: [STATIC, READ, cls$pdt_parameters] array [1 .. 2] of clt$parameter_descriptor := [

{ DEVICE_NAME DN }
    [[clc$required], 1, 1, 1, 1, clc$value_range_not_allowed, [NIL, clc$name_value, 1, osc$max_name_size]],

{ STATUS }
    [[clc$optional], 1, 1, 1, 1, clc$value_range_not_allowed, [NIL, clc$variable_reference,
      clc$array_not_allowed, clc$status_value]]];

?? POP ??
*copy nft$suppress_carriage_cntrl_msg

    VAR
      local_status: ost$status,
      value: clt$value,
      device_name: ost$name,
      suppress_format_control: nft$suppress_carriage_control;


    clp$scan_parameter_list (parameter_list, supcc_pdt, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    put_message_type (nfc$suppress_carriage_control);
    put_string_parameter ($INTEGER(nfc$io_station_name), station_name);

    clp$get_value ('DEVICE_NAME', 1, 1, clc$low, value, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;
    device_name := value.name.value;
    put_string_parameter ($INTEGER(nfc$device_name), device_name);

    suppress_format_control := TRUE;
    put_parameter ($INTEGER(nfc$suppress_format_control), ^suppress_format_control,
          #SIZE (suppress_format_control));

    put_null_parameter;

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

 /send_msg/
    BEGIN
      send_scfs_message (status);
      IF NOT status.normal THEN
        EXIT /send_msg/;
      IFEND;
      local_status.normal := TRUE;
      device_control_response (nfc$suppress_carriage_cntrl_rsp, local_status);
      IF status.normal AND NOT local_status.normal THEN
        status := local_status;
      IFEND;
    END /send_msg/;

    local_status.normal := TRUE;
    resume_async_task (local_status);
    IF status.normal AND NOT local_status.normal THEN
      status := local_status;
    IFEND;

  PROCEND suppress_carriage_ctrl_command;

?? TITLE := '  terminate_transfer command', EJECT ??

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

{ PDT tert_pdt (
{   device_name, dn : NAME = $REQUIRED
{   file_disposition, fd : KEY requeue, r, drop, d, hold, h = drop
{   STATUS)

?? PUSH (LISTEXT := ON) ??

  VAR
    tert_pdt: [STATIC, READ, cls$pdt] clt$parameter_descriptor_table := [^tert_pdt_names, ^tert_pdt_params];

  VAR
    tert_pdt_names: [STATIC, READ, cls$pdt_names_and_defaults] array [1 .. 5] of
      clt$parameter_name_descriptor := [['DEVICE_NAME', 1], ['DN', 1], ['FILE_DISPOSITION', 2], ['FD', 2], [
      'STATUS', 3]];

  VAR
    tert_pdt_params: [STATIC, READ, cls$pdt_parameters] array [1 .. 3] of clt$parameter_descriptor := [

{ DEVICE_NAME DN }
    [[clc$required], 1, 1, 1, 1, clc$value_range_not_allowed, [NIL, clc$name_value, 1, osc$max_name_size]],

{ FILE_DISPOSITION FD }
    [[clc$optional_with_default, ^tert_pdt_dv2], 1, 1, 1, 1, clc$value_range_not_allowed, [^tert_pdt_kv2,
      clc$keyword_value]],

{ STATUS }
    [[clc$optional], 1, 1, 1, 1, clc$value_range_not_allowed, [NIL, clc$variable_reference,
      clc$array_not_allowed, clc$status_value]]];

  VAR
    tert_pdt_kv2: [STATIC, READ, cls$pdt_names_and_defaults] array [1 .. 6] of ost$name := ['REQUEUE','R',
      'DROP','D','HOLD','H'];

  VAR
    tert_pdt_dv2: [STATIC, READ, cls$pdt_names_and_defaults] string (4) := 'drop';

?? POP ??
*copy nft$terminate_transfer_msg

    VAR
      local_status: ost$status,
      value: clt$value,
      device_name: ost$name,
      file_disposition: nft$file_disposition;


    clp$scan_parameter_list (parameter_list, tert_pdt, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    put_message_type (nfc$terminate_transfer);
    put_string_parameter ($INTEGER(nfc$io_station_name), station_name);

    clp$get_value ('DEVICE_NAME', 1, 1, clc$low, value, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;
    device_name := value.name.value;
    put_string_parameter ($INTEGER(nfc$device_name), device_name);

    clp$get_value ('FILE_DISPOSITION', 1, 1, clc$low, value, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;
    IF (value.name.value = 'HOLD') OR (value.name.value = 'H') THEN
      file_disposition := nfc$hold_file_in_q;
    ELSEIF (value.name.value = 'REQUEUE') OR (value.name.value = 'R') THEN
      file_disposition := nfc$requeue_file;
    ELSE {'DROP'/'D'}
      file_disposition := nfc$drop_file_from_q;
    IFEND;
    put_parameter ($INTEGER(nfc$file_disposition), ^file_disposition, #SIZE(file_disposition));

    put_null_parameter;

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

 /send_msg/
    BEGIN
      send_scfs_message (status);
      IF NOT status.normal THEN
        EXIT /send_msg/;
      IFEND;
      local_status.normal := TRUE;
      device_control_response (nfc$terminate_transfer_resp, local_status);
      IF status.normal AND NOT local_status.normal THEN
        status := local_status;
      IFEND;
    END /send_msg/;

    local_status.normal := TRUE;
    resume_async_task (local_status);
    IF status.normal AND NOT local_status.normal THEN
      status := local_status;
    IFEND;

  PROCEND terminate_transfer_command;

?? TITLE := '  stop_batch_device command', EJECT ??

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

{ PDT stobd_pdt (
{   device_name, dn : NAME = $REQUIRED
{   file_disposition, fd : KEY requeue, r, drop, d, hold, h, finish, f, suspend, s = suspend
{   STATUS)

?? PUSH (LISTEXT := ON) ??

  VAR
    stobd_pdt: [STATIC, READ, cls$pdt] clt$parameter_descriptor_table := [^stobd_pdt_names, ^stobd_pdt_params
      ];

  VAR
    stobd_pdt_names: [STATIC, READ, cls$pdt_names_and_defaults] array [1 .. 5] of
      clt$parameter_name_descriptor := [['DEVICE_NAME', 1], ['DN', 1], ['FILE_DISPOSITION', 2], ['FD', 2], [
      'STATUS', 3]];

  VAR
    stobd_pdt_params: [STATIC, READ, cls$pdt_parameters] array [1 .. 3] of clt$parameter_descriptor := [

{ DEVICE_NAME DN }
    [[clc$required], 1, 1, 1, 1, clc$value_range_not_allowed, [NIL, clc$name_value, 1, osc$max_name_size]],

{ FILE_DISPOSITION FD }
    [[clc$optional_with_default, ^stobd_pdt_dv2], 1, 1, 1, 1, clc$value_range_not_allowed, [^stobd_pdt_kv2,
      clc$keyword_value]],

{ STATUS }
    [[clc$optional], 1, 1, 1, 1, clc$value_range_not_allowed, [NIL, clc$variable_reference,
      clc$array_not_allowed, clc$status_value]]];

  VAR
    stobd_pdt_kv2: [STATIC, READ, cls$pdt_names_and_defaults] array [1 .. 10] of ost$name := ['REQUEUE','R',
      'DROP','D','HOLD','H','FINISH','F','SUSPEND','S'];

  VAR
    stobd_pdt_dv2: [STATIC, READ, cls$pdt_names_and_defaults] string (7) := 'suspend';

?? POP ??
*copy nft$stop_batch_device_msg

    VAR
      local_status: ost$status,
      value: clt$value,
      device_name: ost$name,
      file_disposition: nft$file_disposition;


    clp$scan_parameter_list (parameter_list, stobd_pdt, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    put_message_type (nfc$stop_batch_device);
    put_string_parameter ($INTEGER(nfc$io_station_name), station_name);

    clp$get_value ('DEVICE_NAME', 1, 1, clc$low, value, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;
    device_name := value.name.value;
    put_string_parameter ($INTEGER(nfc$device_name), device_name);

    clp$get_value ('FILE_DISPOSITION', 1, 1, clc$low, value, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;
    IF (value.name.value = 'HOLD') OR (value.name.value = 'H') THEN
      file_disposition := nfc$hold_file_in_q;
    ELSEIF (value.name.value = 'REQUEUE') OR (value.name.value = 'R') THEN
      file_disposition := nfc$requeue_file;
    ELSEIF (value.name.value = 'DROP') OR (value.name.value = 'D') THEN
      file_disposition := nfc$drop_file_from_q;
    ELSEIF (value.name.value = 'FINISH') OR (value.name.value = 'F') THEN
      file_disposition := nfc$complete_file;
    ELSE {'SUSPEND'/'S'}
      file_disposition := nfc$maintain_file_position;
    IFEND;
    put_parameter ($INTEGER(nfc$file_disposition), ^file_disposition, #SIZE(file_disposition));

    put_null_parameter;

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

 /send_msg/
    BEGIN
      send_scfs_message (status);
      IF NOT status.normal THEN
        EXIT /send_msg/;
      IFEND;
      local_status.normal := TRUE;
      device_control_response (nfc$stop_batch_device_resp, local_status);
      IF status.normal AND NOT local_status.normal THEN
        status := local_status;
      IFEND;
    END /send_msg/;

    local_status.normal := TRUE;
    resume_async_task (local_status);
    IF status.normal AND NOT local_status.normal THEN
      status := local_status;
    IFEND;

  PROCEND stop_batch_device_command;

?? TITLE := '  start_batch_device command', EJECT ??

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

{ PDT stabd_pdt (
{   device_name, dn : NAME = $REQUIRED
{   STATUS)

?? PUSH (LISTEXT := ON) ??

  VAR
    stabd_pdt: [STATIC, READ, cls$pdt] clt$parameter_descriptor_table := [^stabd_pdt_names, ^stabd_pdt_params
      ];

  VAR
    stabd_pdt_names: [STATIC, READ, cls$pdt_names_and_defaults] array [1 .. 3] of
      clt$parameter_name_descriptor := [['DEVICE_NAME', 1], ['DN', 1], ['STATUS', 2]];

  VAR
    stabd_pdt_params: [STATIC, READ, cls$pdt_parameters] array [1 .. 2] of clt$parameter_descriptor := [

{ DEVICE_NAME DN }
    [[clc$required], 1, 1, 1, 1, clc$value_range_not_allowed, [NIL, clc$name_value, 1, osc$max_name_size]],

{ STATUS }
    [[clc$optional], 1, 1, 1, 1, clc$value_range_not_allowed, [NIL, clc$variable_reference,
      clc$array_not_allowed, clc$status_value]]];

?? POP ??
*copy nft$start_batch_device_msg

    VAR
      local_status: ost$status,
      value: clt$value,
      device_name: ost$name;


    clp$scan_parameter_list (parameter_list, stabd_pdt, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    put_message_type (nfc$start_batch_device);
    put_string_parameter ($INTEGER(nfc$io_station_name), station_name);

    clp$get_value ('DEVICE_NAME', 1, 1, clc$low, value, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;
    device_name := value.name.value;
    put_string_parameter ($INTEGER(nfc$device_name), device_name);

    put_null_parameter;

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

 /send_msg/
    BEGIN
      send_scfs_message (status);
      IF NOT status.normal THEN
        EXIT /send_msg/;
      IFEND;
      local_status.normal := TRUE;
      device_control_response (nfc$start_batch_device_resp, local_status);
      IF status.normal AND NOT local_status.normal THEN
        status := local_status;
      IFEND;
    END /send_msg/;

    local_status.normal := TRUE;
    resume_async_task (local_status);
    IF status.normal AND NOT local_status.normal THEN
      status := local_status;
    IFEND;

  PROCEND start_batch_device_command;

?? TITLE := '  select_file command', EJECT ??

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

{ PDT self_pdt (
{   name, n : NAME = $REQUIRED
{   device_name, dn : NAME = $OPTIONAL
{   STATUS)

?? PUSH (LISTEXT := ON) ??

  VAR
    self_pdt: [STATIC, READ, cls$pdt] clt$parameter_descriptor_table := [^self_pdt_names, ^self_pdt_params];

  VAR
    self_pdt_names: [STATIC, READ, cls$pdt_names_and_defaults] array [1 .. 5] of
      clt$parameter_name_descriptor := [['NAME', 1], ['N', 1], ['DEVICE_NAME', 2], ['DN', 2], ['STATUS', 3]];

  VAR
    self_pdt_params: [STATIC, READ, cls$pdt_parameters] array [1 .. 3] of clt$parameter_descriptor := [

{ NAME N }
    [[clc$required], 1, 1, 1, 1, clc$value_range_not_allowed, [NIL, clc$name_value, 1, osc$max_name_size]],

{ DEVICE_NAME DN }
    [[clc$optional], 1, 1, 1, 1, clc$value_range_not_allowed, [NIL, clc$name_value, 1, osc$max_name_size]],

{ STATUS }
    [[clc$optional], 1, 1, 1, 1, clc$value_range_not_allowed, [NIL, clc$variable_reference,
      clc$array_not_allowed, clc$status_value]]];

?? POP ??
*copy nft$select_file_msg

    VAR
      local_status: ost$status,
      value: clt$value,
      system_file_name: ost$name,
      device_name: ost$name;


    clp$scan_parameter_list (parameter_list, self_pdt, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    put_message_type (nfc$select_file);
    put_string_parameter ($INTEGER(nfc$io_station_name), station_name);

    clp$get_value ('NAME', 1, 1, clc$low, value, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;
    system_file_name := value.name.value;
    put_string_parameter ($INTEGER(nfc$system_file_name), system_file_name);

    clp$get_value ('DEVICE_NAME', 1, 1, clc$low, value, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;
    IF value.kind <> clc$unknown_value THEN
      device_name := value.name.value;
    put_string_parameter ($INTEGER(nfc$device_name), device_name);
    IFEND;

    put_null_parameter;

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

 /send_msg/
    BEGIN
      send_scfs_message (status);
      IF NOT status.normal THEN
        EXIT /send_msg/;
      IFEND;
      local_status.normal := TRUE;
      select_file_response (local_status);
      IF status.normal AND NOT local_status.normal THEN
        status := local_status;
      IFEND;
    END /send_msg/;

    local_status.normal := TRUE;
    resume_async_task (local_status);
    IF status.normal AND NOT local_status.normal THEN
      status := local_status;
    IFEND;

  PROCEND select_file_command;

?? TITLE := '  display_batch_device_status command', EJECT ??

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

{ PDT disbds_pdt (
{   device_name, dn : LIST OF NAME OR KEY printers, plotters, punches, readers, all = $REQUIRED
{   display_option, do : KEY all, a, brief, b = brief
{   output, o : FILE = $OUTPUT
{   STATUS)

?? PUSH (LISTEXT := ON) ??

  VAR
    disbds_pdt: [STATIC, READ, cls$pdt] clt$parameter_descriptor_table := [^disbds_pdt_names,
      ^disbds_pdt_params];

  VAR
    disbds_pdt_names: [STATIC, READ, cls$pdt_names_and_defaults] array [1 .. 7] of
      clt$parameter_name_descriptor := [['DEVICE_NAME', 1], ['DN', 1], ['DISPLAY_OPTION', 2], ['DO', 2], [
      'OUTPUT', 3], ['O', 3], ['STATUS', 4]];

  VAR
    disbds_pdt_params: [STATIC, READ, cls$pdt_parameters] array [1 .. 4] of clt$parameter_descriptor := [

{ DEVICE_NAME DN }
    [[clc$required], 1, clc$max_value_sets,1, 1, clc$value_range_not_allowed, [^disbds_pdt_kv1,
      clc$name_value, 1, osc$max_name_size]],

{ DISPLAY_OPTION DO }
    [[clc$optional_with_default, ^disbds_pdt_dv2], 1, 1, 1, 1, clc$value_range_not_allowed, [^disbds_pdt_kv2,
      clc$keyword_value]],

{ OUTPUT O }
    [[clc$optional_with_default, ^disbds_pdt_dv3], 1, 1, 1, 1, clc$value_range_not_allowed, [NIL,
      clc$file_value]],

{ STATUS }
    [[clc$optional], 1, 1, 1, 1, clc$value_range_not_allowed, [NIL, clc$variable_reference,
      clc$array_not_allowed, clc$status_value]]];

  VAR
    disbds_pdt_kv1: [STATIC, READ, cls$pdt_names_and_defaults] array [1 .. 5] of ost$name := ['PRINTERS',
      'PLOTTERS','PUNCHES','READERS','ALL'];

  VAR
    disbds_pdt_kv2: [STATIC, READ, cls$pdt_names_and_defaults] array [1 .. 4] of ost$name := ['ALL','A',
      'BRIEF','B'];

  VAR
    disbds_pdt_dv2: [STATIC, READ, cls$pdt_names_and_defaults] string (5) := 'brief';

  VAR
    disbds_pdt_dv3: [STATIC, READ, cls$pdt_names_and_defaults] string (7) := '$OUTPUT';

?? POP ??

*copy clv$display_variables
?? NEWTITLE := '    abort_handler', EJECT ??

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

      close_display;

    PROCEND abort_handler;

?? TITLE := '    close_display', EJECT ??

    PROCEDURE close_display;

      VAR
        ignore_status: ost$status;

      IF output_open THEN
        clp$close_display (display_control, ignore_status);
        output_open := FALSE;
      IFEND;

    PROCEND close_display;

*copy clp$new_page_procedure
?? TITLE := 'put_subtitle', EJECT ??

{  Dummy routine for new page procedure (no subtitles created).

    PROCEDURE [INLINE] put_subtitle (display_control: clt$display_control;
      VAR status: ost$status);

    PROCEND put_subtitle;

?? TITLE := '    request_device_status', EJECT ??

{   Procedure to send device status request to SCFS, for specified
{   device.  Wait for returned device status data to display.

    PROCEDURE request_device_status (dev_name: ost$name);

      put_message_type (nfc$get_device_status);
      put_string_parameter ($INTEGER(nfc$io_station_name), station_name);
      put_string_parameter ($INTEGER(nfc$device_name), dev_name);
      put_null_parameter;

      send_scfs_message (status);
      IF NOT status.normal THEN
        RETURN;
      IFEND;
      display_device_status (output_file, display_option, display_control, status);
      IF NOT status.normal THEN
        RETURN;
      IFEND;

    PROCEND request_device_status;

?? OLDTITLE, EJECT ??

*copy nft$get_device_status_msg

    VAR
      local_status: ost$status,
      value: clt$value,
      display_option: t$display_option,
      output_file: clt$file,
      name_count: 0 .. clc$max_value_sets,
      device_name: ost$name,
      i: 1 .. clc$max_value_sets,
      station_device_count: INTEGER,
      station_usage: nft$io_station_usage,
      device_found: BOOLEAN,
      j: INTEGER,
      device_type: nft$device_type,
      device_list: ^ARRAY [1 .. *] OF t$device_list,
      error_message: STRING (osc$max_string_size),
      optimized_reply: boolean,
      output_open: BOOLEAN,
      display_control: clt$display_control;


    clp$scan_parameter_list (parameter_list, disbds_pdt, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    clp$get_value ('DISPLAY_OPTION', 1, 1, clc$low, value, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;
    IF (value.name.value = 'BRIEF') OR (value.name.value = 'B') THEN
      display_option := display_brief;
    ELSE
      display_option := display_all;
    IFEND;

    clp$get_value ('OUTPUT', 1, 1, clc$low, value, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;
    output_file := value.file;

    clp$get_set_count ('DEVICE_NAME', name_count, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    device_list := NIL;
    station_device_count := 0;
    IF async_task_active THEN
      hold_async_task (status);
      IF NOT status.normal THEN
        RETURN;
      IFEND;
    IFEND;

 /get_status/
    BEGIN
      output_open := FALSE;
      osp$establish_block_exit_hndlr (^abort_handler);
      clp$open_display (output_file, ^clp$new_page_procedure, display_control, status);
      IF NOT status.normal THEN
        EXIT /get_status/;
      IFEND;
      output_open := TRUE;
      clv$titles_built := FALSE;
      clv$command_name := 'display_batch_device_status';
      IF display_control.page_width < clc$narrow_page_width THEN
        clv$page_width := clc$narrow_page_width;
      ELSEIF display_control.page_width > clc$wide_page_width THEN
        clv$page_width := clc$wide_page_width;
      ELSE
        clv$page_width := display_control.page_width;
      IFEND;

      FOR i := 1 TO name_count DO
        clp$get_value ('DEVICE_NAME', i, 1, clc$low, value, status);
        IF NOT status.normal THEN
          EXIT /get_status/;
        IFEND;
        device_name := value.name.value;

        IF (device_name = 'ALL') OR (device_name = 'PRINTERS') OR (device_name = 'PLOTTERS')
              OR (device_name = 'PUNCHES') OR (device_name = 'READERS') THEN
          IF station_device_count = 0 THEN
            optimized_reply := (device_name = 'ALL');
            get_station_status (station_device_count, station_usage, optimized_reply, status);
            IF NOT status.normal THEN
              EXIT /get_status/;
            IFEND;

            IF (station_device_count <> 0) AND (NOT optimized_reply) THEN
              PUSH device_list: [1 .. station_device_count];
              get_device_list (device_list, status);
              IF NOT status.normal THEN
                EXIT /get_status/;
              IFEND;
            IFEND;
          IFEND;
          IF optimized_reply THEN

{ The In/Out parameter OPTIMIZED_REPLY indicates that SCFS replied to the Get_Station_Status
{ message a Batch_Device_Status message instead of the Station_Status_Data message.  This is
{ done to reduce the response time for the command "DISBDS ALL ALL".

            display_device_status (output_file, display_option, display_control, status);
          ELSE

            IF device_name = 'PRINTERS' THEN
              device_type := nfc$printer;
            ELSEIF device_name = 'PLOTTERS' THEN
              device_type := nfc$plotter;
            ELSEIF device_name = 'PUNCHES' THEN
              device_type := nfc$punch;
            ELSEIF device_name = 'READERS' THEN
              device_type := nfc$reader;
            IFEND;

            device_found := FALSE;
            FOR j := 1 TO station_device_count DO
              IF (device_name = 'ALL') OR (device_type = device_list^[j].dtype) THEN
                device_found := TRUE;
                request_device_status (device_list^[j].name);
                IF NOT status.normal THEN
                  EXIT /get_status/;
                IFEND;
              IFEND;
            FOREND;

            IF NOT device_found THEN
              error_message (1, 3) := 'NO ';
              error_message (4, *) := device_name;
              IF device_name = 'ALL' THEN
                error_message (4, *) := 'DEVICES';
              IFEND;
              error_message (stringsize (error_message) + 1, *) := ' CONFIGURED';
              clp$put_display (display_control, error_message, clc$trim, status);
              EXIT /get_status/;
            IFEND;
          IFEND;
        ELSE    {device_name not a keyword}
          request_device_status (device_name);
          IF NOT status.normal THEN
            EXIT /get_status/;
          IFEND;
        IFEND;
      FOREND;
    END /get_status/;

    close_display;
    osp$disestablish_cond_handler;

    local_status.normal := TRUE;
    IF async_task_active THEN
      resume_async_task (local_status);
      IF status.normal AND NOT local_status.normal THEN
        status := local_status;
      IFEND;
    IFEND;

  PROCEND display_batch_dev_status_commnd;

?? TITLE := '  get_station_status', EJECT ??

{
{   The purpose of this procedure is to obtain status data for this
{   i/o station from SCFS.  This is accomplished by sending a Get
{   Station Status message to SCFS, and waiting for the Station
{   Status Data message to be returned.  The procedure then scans
{   through the Station Status Data message to obtain the station
{   device count and station usage.  The procedure exits with the
{   message sequence pointer set to the first parameter after the
{   device count.  It is assumed that the device count appears after
{   the station usage, per the SCFS Protocol Specification.
{   The device count is preset to zero and the station usage is preset
{   to nfc$private_io_station before sending the message to SCFS or
{   cracking the response.
{

  PROCEDURE get_station_status
    (VAR device_count: INTEGER;
     VAR station_usage: nft$io_station_usage;
     VAR optimized_reply: boolean;
     VAR status: ost$status);

*copy nft$station_status_msg

    VAR
      byte_array: ^nft$byte_array,
      parameter: ^nft$station_status_msg_param,
      value_length: INTEGER,
      response_code: ^nft$display_status_resp_codes,
      station_status_device_count: ^INTEGER,
      station_status_station_usage: ^nft$io_station_usage,
      param_string: ^STRING (* <= osc$max_string_size);

    status.normal := TRUE;

    build_get_station_status_msg(optimized_reply);
    send_scfs_message (status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    response_code := NIL;
    station_status_device_count := NIL;
    station_status_station_usage := NIL;
    device_count := 0;
    station_usage := nfc$private_io_station;
    get_message_type;
    get_parameter_type (parameter);
    optimized_reply := (parameter <> NIL) and (message_type^ = nfc$device_status_data);

    IF NOT optimized_reply THEN
   /get_station_status_items/
      WHILE (parameter <> NIL) AND (parameter^.param <> nfc$null_parameter) AND (msg_byte_count > 0) DO
        get_parameter_length (parameter^.length_indicated, value_length);

        IF parameter^.param = nfc$response_code THEN
          NEXT response_code IN message;
        ELSEIF parameter^.param = nfc$count_of_devices THEN
          NEXT station_status_device_count IN message;
          device_count := station_status_device_count^;
          EXIT /get_station_status_items/;
        ELSEIF parameter^.param = nfc$station_usage THEN
          NEXT station_status_station_usage IN message;
          station_usage := station_status_station_usage^;
        ELSE
  {       ERROR ----   Ignore parameter value.
          NEXT byte_array: [1 .. value_length] IN message;
        IFEND;

        get_parameter_type (parameter);
      WHILEND /get_station_status_items/;

      IF response_code = NIL THEN
        osp$set_status_abnormal (nfc$status_id, nfe$sou_message_reject,
              'GET_STATION_STATUS', status);
        osp$append_status_parameter (osc$status_parameter_delimiter, no_response_code, status);
        RETURN;
      ELSEIF response_code^ <> nfc$disp_msg_accepted THEN
        osp$set_status_abnormal (nfc$status_id, nfe$sou_message_reject,
              'GET_STATION_STATUS', status);
        osp$append_status_parameter (osc$status_parameter_delimiter,
              display_status_responses [response_code^], status);
        RETURN;
      IFEND;

      IF (station_status_device_count = NIL) OR (station_status_station_usage = NIL) THEN
        osp$set_status_abnormal (nfc$status_id, nfe$sou_message_format_error,
              'STATION_STATUS_DATA', status);
        RETURN;
      IFEND;
    IFEND;

  PROCEND get_station_status;

?? TITLE := '  build_get_station_status_msg', EJECT ??

{
{   The purpose of this procedure is to to place in the message
{   sequence buffer the Get Station Status message to be sent
{   to SCFS.  The reason a separate procedure is used here to do
{   practically nothing is to avoid multiple symbol definition in
{   the ordinals defining the parameters in the Get Station Status
{   and the Station Status Data messages.  Cybil is too dumb
{   to recognize when multiple definitions give equal values.

  PROCEDURE build_get_station_status_msg(optimized_reply: BOOLEAN);

*copy nft$get_station_status_msg

    VAR
      optimization_option: nft$optimize_list;

    put_message_type (nfc$get_station_status);
    put_string_parameter ($INTEGER(nfc$io_station_name), station_name);
    IF optimized_reply THEN
      optimization_option := nfc$do_optimize;
    ELSE
      optimization_option := nfc$do_not_optimize;
    IFEND;
    put_parameter ($INTEGER(nfc$optimize_device_list), ^optimization_option, #SIZE(optimization_option));
    put_null_parameter;

  PROCEND build_get_station_status_msg;

?? TITLE := '  get_device_list', EJECT ??

{
{   The purpose of this procedure is to obtain a list of device
{   names and types from the Station Status Data message,
{   received from SCFS.  The sequence pointer in the message
{   buffer is positioned at the first parameter following the
{   list of device status parameters.
{

  PROCEDURE get_device_list (VAR device_list: ^ARRAY [1 .. *] OF t$device_list;
    VAR status: ost$status);

*copy nft$station_status_msg

    VAR
      byte_array: ^nft$byte_array,
      parameter: ^nft$station_status_msg_param,
      value_length: INTEGER,
      station_status_device_count: ^INTEGER,
      device_name_status: ^nft$device_status_data,
      device_count: INTEGER,
      i: INTEGER,
      param_string: ^STRING (* <= osc$max_string_size);


    get_parameter_type (parameter);

    device_count := UPPERBOUND (device_list^);
    i := 0;
    WHILE (parameter <> NIL) AND (parameter^.param <> nfc$null_parameter) AND (msg_byte_count > 0)
          AND (i < device_count) DO
      get_parameter_length (parameter^.length_indicated, value_length);
      IF parameter^.param = nfc$device_name_status THEN
        i := i+1;
        NEXT device_name_status: [value_length - 3] IN message;
        device_list^ [i].name := device_name_status^.name;
        device_list^ [i].dtype := device_name_status^.device_type;
      ELSE
{       ERROR ----   Ignore parameter value.
        NEXT byte_array: [1 .. value_length] IN message;
      IFEND;

      get_parameter_type (parameter);
    WHILEND;

    IF i < device_count THEN
      osp$set_status_abnormal (nfc$status_id, nfe$sou_message_format_error,
            'STATION_STATUS_DATA', status);
    IFEND;

  PROCEND get_device_list;

?? TITLE := '  display_station_status command', EJECT ??

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

{ PDT disss_pdt (
{   output, o : FILE = $OUTPUT
{   STATUS)

?? PUSH (LISTEXT := ON) ??

  VAR
    disss_pdt: [STATIC, READ, cls$pdt] clt$parameter_descriptor_table := [^disss_pdt_names, ^disss_pdt_params
      ];

  VAR
    disss_pdt_names: [STATIC, READ, cls$pdt_names_and_defaults] array [1 .. 3] of
      clt$parameter_name_descriptor := [['OUTPUT', 1], ['O', 1], ['STATUS', 2]];

  VAR
    disss_pdt_params: [STATIC, READ, cls$pdt_parameters] array [1 .. 2] of clt$parameter_descriptor := [

{ OUTPUT O }
    [[clc$optional_with_default, ^disss_pdt_dv1], 1, 1, 1, 1, clc$value_range_not_allowed, [NIL,
      clc$file_value]],

{ STATUS }
    [[clc$optional], 1, 1, 1, 1, clc$value_range_not_allowed, [NIL, clc$variable_reference,
      clc$array_not_allowed, clc$status_value]]];

  VAR
    disss_pdt_dv1: [STATIC, READ, cls$pdt_names_and_defaults] string (7) := '$OUTPUT';

?? POP ??

*copy clv$display_variables
?? NEWTITLE := '    abort_handler', EJECT ??

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

      close_display;

    PROCEND abort_handler;

?? TITLE := '    close_display', EJECT ??

    PROCEDURE close_display;

      VAR
        ignore_status: ost$status;

      IF output_open THEN
        clp$close_display (display_control, ignore_status);
        output_open := FALSE;
      IFEND;

    PROCEND close_display;

*copy clp$new_page_procedure
?? TITLE := 'put_subtitle', EJECT ??

{  Dummy routine for new page procedure (no subtitles created).

    PROCEDURE [INLINE] put_subtitle (display_control: clt$display_control;
      VAR status: ost$status);

    PROCEND put_subtitle;

?? OLDTITLE, EJECT ??

*copy nft$get_station_status_msg

    VAR
      local_status: ost$status,
      output_file: clt$file,
      value: clt$value,
      output_open: BOOLEAN,
      display_control: clt$display_control;


    clp$scan_parameter_list (parameter_list, disss_pdt, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    put_message_type (nfc$get_station_status);
    put_string_parameter ($INTEGER(nfc$io_station_name), station_name);

    clp$get_value ('OUTPUT', 1, 1, clc$low, value, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;
    output_file := value.file;

    put_null_parameter;

    IF async_task_active THEN
      hold_async_task (status);
      IF NOT status.normal THEN
        RETURN;
      IFEND;
    IFEND;

 /get_status/
    BEGIN
      send_scfs_message (status);
      IF NOT status.normal THEN
        EXIT /get_status/;
      IFEND;

      output_open := FALSE;
      osp$establish_block_exit_hndlr (^abort_handler);
      clp$open_display (output_file, ^clp$new_page_procedure, display_control, status);
      IF NOT status.normal THEN
        EXIT /get_status/;
      IFEND;
      output_open := TRUE;
      clv$titles_built := FALSE;
      clv$command_name := 'display_station_status';

      display_station_status (output_file, display_control, status);
    END /get_status/;

    close_display;
    osp$disestablish_cond_handler;

    local_status.normal := TRUE;
    IF async_task_active THEN
      resume_async_task (local_status);
      IF status.normal AND NOT local_status.normal THEN
        status := local_status;
      IFEND;
    IFEND;

  PROCEND display_station_status_command;

?? TITLE := '  display_station_queue_status command', EJECT ??

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

{ PDT dissqs_pdt (
{   display_option, do : KEY all, a, brief, b = brief
{   output, o : FILE = $OUTPUT
{   STATUS)

?? PUSH (LISTEXT := ON) ??

  VAR
    dissqs_pdt: [STATIC, READ, cls$pdt] clt$parameter_descriptor_table := [^dissqs_pdt_names,
      ^dissqs_pdt_params];

  VAR
    dissqs_pdt_names: [STATIC, READ, cls$pdt_names_and_defaults] array [1 .. 5] of
      clt$parameter_name_descriptor := [['DISPLAY_OPTION', 1], ['DO', 1], ['OUTPUT', 2], ['O', 2], ['STATUS',
      3]];

  VAR
    dissqs_pdt_params: [STATIC, READ, cls$pdt_parameters] array [1 .. 3] of clt$parameter_descriptor := [

{ DISPLAY_OPTION DO }
    [[clc$optional_with_default, ^dissqs_pdt_dv1], 1, 1, 1, 1, clc$value_range_not_allowed, [^dissqs_pdt_kv1,
      clc$keyword_value]],

{ OUTPUT O }
    [[clc$optional_with_default, ^dissqs_pdt_dv2], 1, 1, 1, 1, clc$value_range_not_allowed, [NIL,
      clc$file_value]],

{ STATUS }
    [[clc$optional], 1, 1, 1, 1, clc$value_range_not_allowed, [NIL, clc$variable_reference,
      clc$array_not_allowed, clc$status_value]]];

  VAR
    dissqs_pdt_kv1: [STATIC, READ, cls$pdt_names_and_defaults] array [1 .. 4] of ost$name := ['ALL','A',
      'BRIEF','B'];

  VAR
    dissqs_pdt_dv1: [STATIC, READ, cls$pdt_names_and_defaults] string (5) := 'brief';

  VAR
    dissqs_pdt_dv2: [STATIC, READ, cls$pdt_names_and_defaults] string (7) := '$OUTPUT';

?? POP ??

*copy clv$display_variables
?? NEWTITLE := '    abort_handler', EJECT ??

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

      close_display;

    PROCEND abort_handler;

?? TITLE := '    close_display', EJECT ??

    PROCEDURE close_display;

      VAR
        ignore_status: ost$status;

      IF output_open THEN
        clp$close_display (display_control, ignore_status);
        output_open := FALSE;
      IFEND;

    PROCEND close_display;

*copy clp$new_page_procedure
?? TITLE := 'put_subtitle', EJECT ??

{  Dummy routine for new page procedure (no subtitles created).

    PROCEDURE [INLINE] put_subtitle (display_control: clt$display_control;
      VAR status: ost$status);

    PROCEND put_subtitle;

?? OLDTITLE, EJECT ??

*copy nft$get_station_status_msg

    VAR
      local_status: ost$status,
      display_option: t$display_option,
      output_file: clt$file,
      value: clt$value,
      output_open: BOOLEAN,
      display_control: clt$display_control;


    clp$scan_parameter_list (parameter_list, dissqs_pdt, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    put_message_type (nfc$get_queue_status);
    put_string_parameter ($INTEGER(nfc$io_station_name), station_name);

    clp$get_value ('DISPLAY_OPTION', 1, 1, clc$low, value, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;
    IF (value.name.value = 'BRIEF') OR (value.name.value = 'B') THEN
      display_option := display_brief;
    ELSE
      display_option := display_all;
    IFEND;

    clp$get_value ('OUTPUT', 1, 1, clc$low, value, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;
    output_file := value.file;

    put_null_parameter;

    IF async_task_active THEN
      hold_async_task (status);
      IF NOT status.normal THEN
        RETURN;
      IFEND;
    IFEND;

 /get_status/
    BEGIN
      send_scfs_message (status);
      IF NOT status.normal THEN
        EXIT /get_status/;
      IFEND;

      output_open := FALSE;
      osp$establish_block_exit_hndlr (^abort_handler);
      clp$open_display (output_file, ^clp$new_page_procedure, display_control, status);
      IF NOT status.normal THEN
        EXIT /get_status/;
      IFEND;
      output_open := TRUE;
      clv$titles_built := FALSE;
      clv$command_name := 'display_station_queue_status';

      display_queue_status (output_file, display_option, display_control, status);
    END /get_status/;

    close_display;
    osp$disestablish_cond_handler;

    local_status.normal := TRUE;
    IF async_task_active THEN
      resume_async_task (local_status);
      IF status.normal AND NOT local_status.normal THEN
        status := local_status;
      IFEND;
    IFEND;

  PROCEND display_statn_q_status_command;

?? TITLE := '  Display_Station_Queue_Entry command', EJECT ??

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

{ PDT dissqe_pdt (
{   name, names, n : LIST OF NAME OR KEY top_ten, all = $REQUIRED
{   display_option, do : KEY all, a, brief, b = brief
{   output, o : FILE = $OUTPUT
{   STATUS)

?? PUSH (LISTEXT := ON) ??

  VAR
    dissqe_pdt: [STATIC, READ, cls$pdt] clt$parameter_descriptor_table := [^dissqe_pdt_names,
      ^dissqe_pdt_params];

  VAR
    dissqe_pdt_names: [STATIC, READ, cls$pdt_names_and_defaults] array [1 .. 8] of
      clt$parameter_name_descriptor := [['NAME', 1], ['NAMES', 1], ['N', 1], ['DISPLAY_OPTION', 2], ['DO', 2]
      , ['OUTPUT', 3], ['O', 3], ['STATUS', 4]];

  VAR
    dissqe_pdt_params: [STATIC, READ, cls$pdt_parameters] array [1 .. 4] of clt$parameter_descriptor := [

{ NAME NAMES N }
    [[clc$required], 1, clc$max_value_sets,1, 1, clc$value_range_not_allowed, [^dissqe_pdt_kv1,
      clc$name_value, 1, osc$max_name_size]],

{ DISPLAY_OPTION DO }
    [[clc$optional_with_default, ^dissqe_pdt_dv2], 1, 1, 1, 1, clc$value_range_not_allowed, [^dissqe_pdt_kv2,
      clc$keyword_value]],

{ OUTPUT O }
    [[clc$optional_with_default, ^dissqe_pdt_dv3], 1, 1, 1, 1, clc$value_range_not_allowed, [NIL,
      clc$file_value]],

{ STATUS }
    [[clc$optional], 1, 1, 1, 1, clc$value_range_not_allowed, [NIL, clc$variable_reference,
      clc$array_not_allowed, clc$status_value]]];

  VAR
    dissqe_pdt_kv1: [STATIC, READ, cls$pdt_names_and_defaults] array [1 .. 2] of ost$name := ['TOP_TEN','ALL'
      ];

  VAR
    dissqe_pdt_kv2: [STATIC, READ, cls$pdt_names_and_defaults] array [1 .. 4] of ost$name := ['ALL','A',
      'BRIEF','B'];

  VAR
    dissqe_pdt_dv2: [STATIC, READ, cls$pdt_names_and_defaults] string (5) := 'brief';

  VAR
    dissqe_pdt_dv3: [STATIC, READ, cls$pdt_names_and_defaults] string (7) := '$OUTPUT';

?? POP ??

*copy clv$display_variables
?? NEWTITLE := '    abort_handler', EJECT ??

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

      close_display;

    PROCEND abort_handler;

?? TITLE := '    close_display', EJECT ??

    PROCEDURE close_display;

      VAR
        ignore_status: ost$status;

      IF output_open THEN
        clp$close_display (display_control, ignore_status);
        output_open := FALSE;
      IFEND;

    PROCEND close_display;

*copy clp$new_page_procedure

?? TITLE := '    display_queue_entry', EJECT ??

    PROCEDURE display_queue_entry
     (    display_option: t$display_option;
          ignore_unknown_file_error: boolean;
      VAR display_control: clt$display_control;
      VAR status:ost$status);

?? NEWTITLE := '      put_display_line', EJECT ??

      PROCEDURE put_display_line
       (    label: STRING (*);
            value: STRING (*));

        VAR
          label_str: STRING (label_size);

        label_str := label;
        IF label <> ' ' THEN
          label_str (label_size - 2, 3) := ' : ';
        IFEND;

        clp$put_partial_display (display_control, label_str, clc$no_trim, amc$start, status);
        IF NOT status.normal THEN
          EXIT display_queue_entry;
        IFEND;
        clp$put_partial_display (display_control, value, clc$trim, amc$terminate, status);
        IF NOT status.normal THEN
          EXIT display_queue_entry;
        IFEND;

      PROCEND put_display_line;

?? OLDTITLE, EJECT ??

*copy nft$queue_entry_data_msg

      CONST
        label_size = 31;

      VAR
        byte_array: ^nft$byte_array,
        continuation_param_found :BOOLEAN,
        copies: ^INTEGER,
        date: ost$date,
        destination_name: ^STRING (* <= osc$max_name_size),
        device_name: ^STRING (* <= osc$max_name_size),
        device_type: ^nft$device_type,
        external_characteristics: ^STRING (* <= jmc$ext_characteristics_size),
        family_name: ^STRING (* <= osc$max_name_size),
        file_length: ^nft$file_size,
        forms_code: ^STRING (* <= jmc$forms_code_size),
        io_station_name: ^STRING (* <= osc$max_name_size),
        output_data_mode: ^nft$output_data_mode,
        output_state: ^nft$file_transfer_state,
        page_format: ^nft$page_format,
        page_length: ^nft$page_length,
        page_width: ^nft$page_width,
        parameter: ^nft$queue_entry_msg_parameter,
        position_in_queue: ^INTEGER,
        priority: ^nft$priority,
        response_code: ^nft$display_status_resp_codes,
        str: ost$string,
        system_file_name: ^STRING (* <= osc$max_name_size),
        system_job_name: ^STRING (* <= osc$max_name_size),
        time: ost$time,
        time_enqueued: ^ost$date_time,
        user_file_name: ^STRING (* <= osc$max_name_size),
        user_job_name: ^STRING (* <= osc$max_name_size),
        user_name: ^STRING (* <= osc$max_name_size),
        value_length: INTEGER,
        vertical_print_density: ^nft$file_vertical_print_density,
        vfu_load_procedure: ^STRING (* <= osc$max_name_size);

{ If there is more than one file with the same user_file_name, or if SCFS is responding to
{ an OPERATE_STATION request which requested an optimized display of all queue files
{ queued to the I/O station, SCFS will send the queue data for each of the files.  The
{ station name and response code will not be repeated in the message from SCFS since they
{ are identical.  The information for each file will be delimited by the null parameter,
{ so the parameters and values will continue to be parsed while the message length remains
{ greater than zero.  If the data for all of the files exceeds the maximum size of a
{ message, SCFS will send a continuation parameter at the end of the message instead of
{ the null parameter.

      io_station_name := NIL;
      response_code := NIL;

      get_message_type;
      get_parameter_type (parameter);

      REPEAT
      /get_parameters_for_each_entry/
        WHILE (msg_byte_count > 0) AND (parameter <> NIL) DO

{ Assume that all file information will fit into the first Queue_Entry_Data message.

          continuation_param_found := FALSE;

          copies := NIL;
          destination_name := NIL;
          device_name := NIL;
          device_type := NIL;
          external_characteristics := NIL;
          family_name := NIL;
          file_length := NIL;
          forms_code := NIL;
          output_data_mode := NIL;
          output_state := NIL;
          page_format := NIL;
          page_length := NIL;
          page_width := NIL;
          position_in_queue := NIL;
          priority := NIL;
          system_file_name := NIL;
          system_job_name := NIL;
          time_enqueued := NIL;
          user_file_name := NIL;
          user_job_name := NIL;
          user_name := NIL;
          vertical_print_density := NIL;
          vfu_load_procedure := NIL;

       /get_parameters/
          WHILE (parameter <> NIL) AND ((parameter^.param <> nfc$null_parameter) AND
                (parameter^.param <> nfc$queue_entry_data_continues)) DO
            get_parameter_length (parameter^.length_indicated, value_length);
            IF value_length = 0 THEN
              get_parameter_type (parameter);
              CYCLE /get_parameters/;
            IFEND;

            CASE parameter^.param OF

            = nfc$io_station_name =
              NEXT io_station_name: [value_length] IN message;

            = nfc$response_code =
              NEXT response_code IN message;

            = nfc$system_file_name =
              NEXT system_file_name: [value_length] IN message;

            = nfc$user_file_name =
              NEXT user_file_name: [value_length] IN message;

            = nfc$time_enqueued =
              NEXT time_enqueued IN message;

            = nfc$position_in_queue =
              NEXT position_in_queue IN message;

            = nfc$priority =
              NEXT priority IN message;

            = nfc$copies =
              NEXT copies IN message;

            = nfc$create_job_family_name =
              NEXT family_name: [value_length] IN message;

            = nfc$create_system_job_name =
              NEXT system_job_name: [value_length] IN message;

            = nfc$create_user_job_name =
              NEXT user_job_name: [value_length] IN message;

            = nfc$destination_name =
              NEXT destination_name: [value_length] IN message;

            = nfc$device_type =
              NEXT device_type IN message;

            = nfc$file_length =
              NEXT file_length IN message;

            = nfc$output_data_mode =
              NEXT output_data_mode IN message;

            = nfc$scfs_output_status =
              NEXT output_state IN message;

            = nfc$device_name =
              NEXT device_name: [value_length] IN message;

            = nfc$external_characteristics =
              NEXT external_characteristics: [value_length] IN message;

            = nfc$forms_code =
              NEXT forms_code: [value_length] IN message;

            = nfc$page_format =
              NEXT page_format IN message;

            = nfc$page_length =
              NEXT page_length IN message;

            = nfc$page_width =
              NEXT page_width IN message;

            = nfc$vertical_print_density =
              NEXT vertical_print_density IN message;

            = nfc$vfu_load_procedure =
              NEXT vfu_load_procedure: [value_length] IN message;

            = nfc$creating_user_name =
              NEXT user_name: [value_length] IN message;

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

            CASEND;

            get_parameter_type (parameter);
          WHILEND /get_parameters/;


          IF response_code = NIL THEN
            osp$set_status_abnormal (nfc$status_id, nfe$sou_message_reject,
                  'GET_QUEUE_ENTRY', status);
            osp$append_status_parameter (osc$status_parameter_delimiter, no_response_code, status);
            RETURN;
          ELSEIF (response_code^ = nfc$disp_unknown_file_name) AND ignore_unknown_file_error THEN
            RETURN;
          ELSEIF response_code^ <> nfc$disp_msg_accepted THEN
            osp$set_status_abnormal (nfc$status_id, nfe$sou_command_reject,
                  'DISPLAY_STATION_QUEUE_ENTRY', status);
            osp$append_status_parameter (osc$status_parameter_delimiter,
                  display_status_responses [response_code^], status);
            RETURN;
          IFEND;

          IF system_file_name <> NIL THEN
            put_display_line ('System_Supplied_File_Name', system_file_name^);
          IFEND;

          IF (display_option = display_all) THEN
            IF (copies <> NIL) THEN
              clp$convert_integer_to_string (copies^, 10, FALSE, str, status);
              put_display_line ('  Copies', str.value (1, str.size));
            IFEND;

            IF (destination_name <> NIL) THEN
              put_display_line ('  Destination_Name', destination_name^);
            IFEND;

            IF (device_name <> NIL) THEN
              put_display_line ('  Device_Name', device_name^);
            IFEND;

            IF (device_type <> NIL) THEN
              put_display_line ('  Device_Type', device_types [device_type^]);
            IFEND;

            IF (external_characteristics <> NIL) THEN
              put_display_line ('  External_Characteristics', external_characteristics^);
            IFEND;

            IF (family_name <> NIL) THEN
              put_display_line ('  Family_Name', family_name^);
            IFEND;
          IFEND;

          IF file_length <> NIL THEN
            clp$convert_integer_to_string ($INTEGER(file_length^), 10, FALSE, str, status);
            put_display_line ('  File_Length', str.value (1, str.size));
          IFEND;

          IF (display_option = display_all) THEN
            IF (forms_code <> NIL) THEN
              put_display_line ('  Forms_Code', forms_code^);
            IFEND;

            IF (output_data_mode <> NIL) THEN
              put_display_line ('  Output_Data_Mode', output_data_modes [output_data_mode^]);
            IFEND;
          IFEND;

          IF (output_state <> NIL) AND (output_state^ <= nfc$selected_for_transfer) THEN
            put_display_line ('  Output_State', output_states [output_state^]);
          IFEND;

          IF (display_option = display_all) THEN
            IF (page_format <> NIL) THEN
              put_display_line ('  Page_Format', page_formats [page_format^]);
            IFEND;

            IF (page_length <> NIL) THEN
              clp$convert_integer_to_string ($INTEGER(page_length^), 10, FALSE, str, status);
              put_display_line ('  Page_Length', str.value (1, str.size));
            IFEND;

            IF (page_width <> NIL) THEN
              clp$convert_integer_to_string ($INTEGER(page_width^), 10, FALSE, str, status);
              put_display_line ('  Page_Width', str.value (1, str.size));
            IFEND;

            IF (position_in_queue <> NIL) THEN
              clp$convert_integer_to_string (position_in_queue^, 10, FALSE, str, status);
              put_display_line ('  Position_In_Queue', str.value (1, str.size));
            IFEND;

            IF (priority <> NIL) THEN
              clp$convert_integer_to_string (priority^, 10, FALSE, str, status);
              put_display_line ('  Priority', str.value (1, str.size));
            IFEND;

            IF (system_job_name <> NIL) THEN
              put_display_line ('  System_Supplied_Job_Name', system_job_name^);
            IFEND;

            IF (time_enqueued <> NIL) THEN
              pmp$format_compact_date (time_enqueued^, osc$iso_date, date, status);
              IF NOT status.normal THEN
                RETURN;
              IFEND;
              pmp$format_compact_time (time_enqueued^, osc$hms_time, time, status);
              IF NOT status.normal THEN
                RETURN;
              IFEND;
              str.value := date.iso;
              str.value (13, *) := time.hms;
              put_display_line ('  Time_Enqueued', str.value);
            IFEND;
          IFEND;

          IF user_name <> NIL THEN
            put_display_line ('  User_Name', user_name^);
          IFEND;

          IF user_file_name <> NIL THEN
            put_display_line ('  User_Supplied_File_Name', user_file_name^);
          IFEND;

          IF (display_option = display_all) THEN
            IF (user_job_name <> NIL) THEN
              put_display_line ('  User_Supplied_Job_Name', user_job_name^);
            IFEND;

            IF (vertical_print_density <> NIL) THEN
              put_display_line ('  Vertical_Print_Density', file_vpd_actions [vertical_print_density^]);
            IFEND;

            IF (vfu_load_procedure <> NIL) THEN
              put_display_line ('  VFU_Load_Procedure', vfu_load_procedure^);
            IFEND;
          IFEND;

          IF (display_control.line_number < display_control.page_length) OR
                (display_control.page_format = amc$continuous_form) THEN
            clp$put_display (display_control, ' ', clc$trim, status);
          IFEND;

          IF (msg_byte_count > 0) THEN
            get_parameter_type (parameter);
          IFEND;


        WHILEND /get_parameters_for_each_entry/;

        continuation_param_found := (parameter  <> NIL) AND
              (parameter^.param = nfc$queue_entry_data_continues);

        IF continuation_param_found THEN

{ All of the information for the files could not fit in one message. Get the next message.

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

          get_message_type;
          get_parameter_type (parameter);

          IF (message_type^ <> nfc$queue_entry_data) THEN
            RETURN;
          IFEND;
        IFEND;
      UNTIL NOT continuation_param_found;
    PROCEND display_queue_entry;

?? TITLE := 'put_subtitle', EJECT ??

{  Dummy routine for new page procedure (no subtitles created).

    PROCEDURE [INLINE] put_subtitle (display_control: clt$display_control;
      VAR status: ost$status);

    PROCEND put_subtitle;

?? TITLE := '    request_queue_entry', EJECT ??

{   Procedure to send request for queue entry to SCFS, for specified
{   file name.

    PROCEDURE request_queue_entry (output_file_name: STRING (* <= osc$max_name_size);
          ignore_unknown_file_error: boolean);

      put_message_type (nfc$get_queue_entry);
      put_string_parameter ($INTEGER(nfc$io_station_name), station_name);
      put_string_parameter ($INTEGER(nfc$system_file_name), output_file_name);
      put_null_parameter;

      send_scfs_message (status);
      IF NOT status.normal THEN
        RETURN;
      IFEND;
      display_queue_entry (display_option, ignore_unknown_file_error, display_control, status);

    PROCEND request_queue_entry;

?? OLDTITLE, EJECT ??

*copy nft$get_queue_entry_msg

    VAR
      display_control: clt$display_control,
      display_option: t$display_option,
      error_message: STRING (osc$max_string_size),
      file_index: jmt$output_status_count,
      i: 1 .. clc$max_value_sets,
      j: INTEGER,
      list_type: nft$all_or_top_10_q_entries,
      local_status: ost$status,
      name_count: 0 .. clc$max_value_sets,
      number_of_outputs_found: jmt$output_status_count,
      output_file: clt$file,
      output_file_name: ost$name,
      output_index: jmt$output_status_count,
      output_name: jmt$name,
      output_open: BOOLEAN,
      queue_entry_count: INTEGER,
      result_size: ost$segment_length,
      status_options_p: ^jmt$output_status_options,
      status_results_keys_p: ^jmt$results_keys,
      status_results_p: ^jmt$output_status_results,
      system_file_list: ^ARRAY [1 .. *] OF ost$name,
      value: clt$value,
      work_area_p: ^jmt$work_area;

    clp$scan_parameter_list (parameter_list, dissqe_pdt, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    clp$get_value ('DISPLAY_OPTION', 1, 1, clc$low, value, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;
    IF (value.name.value = 'BRIEF') OR (value.name.value = 'B') THEN
      display_option := display_brief;
    ELSE
      display_option := display_all;
    IFEND;

    clp$get_value ('OUTPUT', 1, 1, clc$low, value, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;
    output_file := value.file;

    clp$get_set_count ('NAME', name_count, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    system_file_list := NIL;
    IF async_task_active THEN
      hold_async_task (status);
      IF NOT status.normal THEN
        RETURN;
      IFEND;
    IFEND;

 /get_entries/
    BEGIN
      output_open := FALSE;
      osp$establish_block_exit_hndlr (^abort_handler);
      clp$open_display (output_file, ^clp$new_page_procedure, display_control, status);
      IF NOT status.normal THEN
        EXIT /get_entries/;
      IFEND;
      output_open := TRUE;
      clv$titles_built := FALSE;
      clv$command_name := 'display_station_queue_entries';

      FOR i := 1 TO name_count DO
        clp$get_value ('NAME', i, 1, clc$low, value, status);
        IF NOT status.normal THEN
          EXIT /get_entries/;
        IFEND;
        output_file_name := value.name.value;

        IF (output_file_name = 'ALL') OR (output_file_name = 'TOP_TEN') THEN
          IF output_file_name = 'ALL' THEN
            list_type := nfc$all_q_entries;
          ELSE
            list_type := nfc$top_10_q_entries;
          IFEND;

{ The STATION_OPERATOR value used below signals SCFS that OPERATE_STATION is making the
{ request and the Queue_Entry_List_Data message is not required.  DISPLAY_STATION requires
{ the Queue_Entry_List_Data message because the message contains a list of system file
{ names each of which must be checked for ownership by the DISPLAY_STATION user before
{ information about the queue file can be displayed.

          get_queue_entry_list (list_type, queue_entry_count, station_operator, status);
          IF NOT status.normal THEN
            EXIT /get_entries/;
          IFEND;

          get_message_type;

          IF message_type^ = nfc$queue_entry_data THEN

{ SCFS has sent the list of attributes of all of the files queued.  Display the attributes
{ and exit the procedure. If no files are queued, an abnormal status will  be returned.

            display_queue_entry (display_option, FALSE, display_control, status);
            IF (NOT status.normal) AND (status.condition = nfe$sou_command_reject) THEN
              error_message := 'NO FILES QUEUED';
              clp$put_display (display_control, error_message, clc$trim, status);
              EXIT /get_entries/;
            ELSE
              IF async_task_active THEN
                resume_async_task (local_status);
                IF status.normal AND NOT local_status.normal THEN
                  status := local_status;
                IFEND;
              IFEND;
              RETURN;
            IFEND;
            EXIT /get_entries/;
          IFEND;

{ SCFS has sent a list of system file names for files queued to the I/O station.  Process
{ the list.
          IF queue_entry_count = 0 THEN  {no entries to display}
            error_message := 'NO FILES QUEUED';
            clp$put_display (display_control, error_message, clc$trim, status);
            EXIT /get_entries/;
          IFEND;

          PUSH system_file_list: [1 .. queue_entry_count];
          get_system_file_list (system_file_list, status);
          IF NOT status.normal THEN
            EXIT /get_entries/;
          IFEND;
          status_results_p := NIL;
       /get_entry/
          FOR j := 1 TO queue_entry_count DO
            IF NOT station_operator THEN
              check_file_ownership (system_file_list^ [j], local_status);
              IF NOT local_status.normal THEN
                CYCLE /get_entry/;
              IFEND;
            IFEND;
            request_queue_entry (system_file_list^ [j], {ignore_unknown_file_error} TRUE);
            IF NOT status.normal THEN
              EXIT /get_entries/;
            IFEND;
          FOREND /get_entry/;
        ELSE
          IF station_operator THEN
            request_queue_entry (output_file_name, {ignore_unknown_file_error} FALSE);
            IF NOT status.normal THEN
              EXIT /get_entries/;
            IFEND;
          ELSE
            PUSH status_options_p: [1 .. 1];
            status_options_p^ [1].key := jmc$name_list;
            status_options_p^ [1].name_list := NIL;
            PUSH status_options_p^ [1].name_list: [1 .. 1];
            jmp$determine_name_kind (output_file_name, status_options_p^ [1].name_list^ [1], status);
            IF NOT status.normal THEN
              EXIT /get_entries/;
            IFEND;

            PUSH status_results_keys_p: [1 .. 1];
            status_results_keys_p^ [1] := jmc$system_file_name;
            jmp$get_result_size ({number_of_items} 1, #SEQ (status_results_keys_p^), result_size);
            PUSH work_area_p: [[REP result_size OF cell]];
            RESET work_area_p;
            jmp$get_output_status (status_options_p, status_results_keys_p, work_area_p,
                  status_results_p, number_of_outputs_found, status);

            WHILE (NOT status.normal) AND (status.condition = jme$work_area_too_small) DO
              status.normal := TRUE;
              jmp$get_result_size (number_of_outputs_found + 1, #SEQ (status_results_keys_p^), result_size);
              PUSH work_area_p: [[REP result_size OF cell]];
              RESET work_area_p;
              jmp$get_output_status (status_options_p, status_results_keys_p, work_area_p,
                    status_results_p, number_of_outputs_found, status);
            WHILEND;
            IF NOT status.normal THEN
              EXIT /get_entries/;
            IFEND;

            FOR output_index := 1 TO number_of_outputs_found DO
              request_queue_entry (status_results_p^ [output_index]^ [1].system_file_name,
                    {ignore_unknown_file_error} TRUE);
              IF NOT status.normal THEN
                EXIT /get_entries/;
              IFEND;
            FOREND;
          IFEND;
        IFEND;

      FOREND;

    END /get_entries/;

    close_display;
    osp$disestablish_cond_handler;

    local_status.normal := TRUE;
    IF async_task_active THEN
      resume_async_task (local_status);
      IF status.normal AND NOT local_status.normal THEN
        status := local_status;
      IFEND;
    IFEND;

  PROCEND display_station_q_entry_command;
?? TITLE := '  terminate_queued_output_command', EJECT ??

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

{ PDT terqo_pdt (
{   name, names, n : LIST OF NAME = $REQUIRED
{   STATUS)

?? PUSH (LISTEXT := ON) ??

  VAR
    terqo_pdt: [STATIC, READ, cls$pdt] clt$parameter_descriptor_table := [^terqo_pdt_names, ^terqo_pdt_params
  ];

  VAR
    terqo_pdt_names: [STATIC, READ, cls$pdt_names_and_defaults] array [1 .. 4] of
  clt$parameter_name_descriptor := [['NAME', 1], ['NAMES', 1], ['N', 1], ['STATUS', 2]];

  VAR
    terqo_pdt_params: [STATIC, READ, cls$pdt_parameters] array [1 .. 2] of clt$parameter_descriptor := [

{ NAME NAMES N }
    [[clc$required], 1, clc$max_value_sets,1, 1, clc$value_range_not_allowed, [NIL, clc$name_value, 1,
  osc$max_name_size]],

{ STATUS }
    [[clc$optional], 1, 1, 1, 1, clc$value_range_not_allowed, [NIL, clc$variable_reference,
  clc$array_not_allowed, clc$status_value]]];

?? POP ??
    VAR
      index: 0 .. clc$max_value_sets,
      local_status: ost$status,
      name_count: 0 .. clc$max_value_sets,
      value: clt$value;
?? NEWTITLE := '    get_terqo_response', EJECT ??

    PROCEDURE get_terqo_response
      (VAR status: ost$status);

      VAR
        byte_array: ^nft$byte_array,
        io_station_name: ost$name,
        file_name: ost$name,
        file_status_code: ^nft$terqo_file_status_codes,
        name_string: ^string ( * <= osc$max_name_size),
        parameter: ^nft$term_q_output_resp_param,
        value_length: integer;

*copy nft$terminate_q_output_resp_msg
?? EJECT ??
      file_name := osc$null_name;
      io_station_name := osc$null_name;

      get_message_type;
      get_parameter_type (parameter);

      WHILE (parameter <> NIL) AND (parameter^.param <> nfc$null_parameter) AND (msg_byte_count > 0) DO
        get_parameter_length (parameter^.length_indicated, value_length);
        CASE parameter^.param OF
        = nfc$io_station_name =
          NEXT name_string: [value_length] IN message;
          io_station_name := name_string^;

        = nfc$system_user_file_name =
          NEXT name_string: [value_length] IN message;
          file_name := name_string^;

        = nfc$file_status_code =
          NEXT file_status_code IN message;

        CASEND;
        get_parameter_type (parameter);
      WHILEND;

      IF file_status_code = NIL THEN
        osp$set_status_abnormal (nfc$status_id, nfe$sou_message_reject, 'TERMINATE_QUEUED_OUTPUT', status);
        osp$append_status_parameter (osc$status_parameter_delimiter, no_response_code, status);
      ELSEIF file_status_code^ <> nfc$terqo_successful THEN
        osp$set_status_abnormal (nfc$status_id, nfe$sou_command_reject, 'TERMINATE_QUEUED_OUTPUT', status);
        osp$append_status_parameter (osc$status_parameter_delimiter,
              terminate_queue_output_resps [file_status_code^], status);
      IFEND;

    PROCEND get_terqo_response;
?? TITLE := '    request_file_termination', EJECT ??

    PROCEDURE request_file_termination
      (    system_file_name: ost$name;
       VAR status: ost$status);

*copy nft$terminate_queued_output_msg

      put_message_type (nfc$terminate_queue_output);
      put_string_parameter ($integer (nfc$io_station_name), station_name);
      put_string_parameter ($integer (nfc$system_user_file_name), system_file_name);

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

    PROCEND request_file_termination;
?? OLDTITLE, EJECT ??
    clp$scan_parameter_list (parameter_list, terqo_pdt, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    clp$get_set_count ('NAME', name_count, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

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

    FOR index := 1 TO name_count DO
      clp$get_value ('NAME', index, 1, clc$low, value, status);
      IF NOT status.normal THEN
        RETURN;
      IFEND;

      request_file_termination (value.name.value, status);
      IF NOT status.normal THEN
        RETURN;
      IFEND;

      get_terqo_response (status);
      IF NOT status.normal THEN
        RETURN;
      IFEND;
    FOREND;

    local_status.normal := TRUE;
    resume_async_task (local_status);
    IF status.normal AND NOT local_status.normal THEN
      status := local_status;
    IFEND;

  PROCEND terminate_queued_output_command;
?? TITLE := '  get_queue_entry_list', EJECT ??


{ This procedure will request information about all queue file entries for this I/O
{ station from SCFS.  This is accomplished by sending a Get_Queue_Entry_List message to
{ SCFS, and waiting for the Queue_Entry_List_Data message or Queue_Entry_Data message to
{ be returned.  If the Queue_Entry_List_Data message is returned, the procedure then scans
{ through the message to obtain the Number_of_Files parameter, which indicates the number
{ of queue entries for which data is provided.  The procedure will then exit with the
{ message sequence pointer positioned at the parameter following the Number_of_Files
{ parameter.


  PROCEDURE get_queue_entry_list (list_type: nft$all_or_top_10_q_entries;
    VAR q_entry_count: INTEGER;
        request_optimized_reply: BOOLEAN;
    VAR status: ost$status);

*copy nft$q_entry_list_data_msg

    VAR
      byte_array: ^nft$byte_array,
      parameter: ^nft$q_entry_list_data_msg_param,
      value_length: INTEGER,
      response_code: ^nft$display_status_resp_codes,
      q_entry_file_count: ^INTEGER,
      param_string: ^STRING (* <= osc$max_string_size);


    build_get_q_entry_list_msg (list_type, request_optimized_reply);
    send_scfs_message (status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    response_code := NIL;
    q_entry_file_count := NIL;
    q_entry_count := 0;
    get_message_type;

    IF message_type^ = nfc$queue_entry_list_data THEN

      get_parameter_type (parameter);

   /get_entry_count/
      WHILE (parameter <> NIL) AND (parameter^.param <> nfc$null_parameter) AND (msg_byte_count > 0) DO
        get_parameter_length (parameter^.length_indicated, value_length);

        IF parameter^.param = nfc$response_code THEN
          NEXT response_code IN message;
        ELSEIF parameter^.param = nfc$number_of_files THEN
          NEXT q_entry_file_count IN message;
          q_entry_count := q_entry_file_count^;
          EXIT /get_entry_count/;
        ELSE
  {       ERROR ----   Ignore parameter value.
          NEXT byte_array: [1 .. value_length] IN message;
        IFEND;

        get_parameter_type (parameter);
      WHILEND /get_entry_count/;

      IF response_code = NIL THEN
        osp$set_status_abnormal (nfc$status_id, nfe$sou_message_reject,
              'GET_QUEUE_ENTRY_LIST', status);
        osp$append_status_parameter (osc$status_parameter_delimiter, no_response_code, status);
        RETURN;
      ELSEIF response_code^ <> nfc$disp_msg_accepted THEN
        osp$set_status_abnormal (nfc$status_id, nfe$sou_message_reject,
              'GET_QUEUE_ENTRY_LIST', status);
        osp$append_status_parameter (osc$status_parameter_delimiter,
              display_status_responses [response_code^], status);
        RETURN;
      IFEND;

      IF q_entry_file_count = NIL THEN
        osp$set_status_abnormal (nfc$status_id, nfe$sou_message_format_error,
              'GET_QUEUE_ENTRY_LIST', status);
        RETURN;
      IFEND;
{ ELSE the message is the Queue_Entry_Data message returned by SCFS
{ because Request_Optimized_Reply was specified as TRUE.  Return and
{ allow the caller to process the message.

    IFEND;
  PROCEND get_queue_entry_list;

?? TITLE := '  build_get_q_entry_list_msg', EJECT ??

{
{ The purpose of this procedure is to place the Get_Queue_Entry_List message in the
{ sequence buffer.  The value Request_Optimized_Response signals SCFS that OPERATE_STATION
{ is making this request and can process the Queue_Entry_Data message without a preceeding
{ Queue_Entry_List_Data message.

  PROCEDURE build_get_q_entry_list_msg (list_type:nft$all_or_top_10_q_entries,
        request_optimized_reply: BOOLEAN);

*copy nft$get_q_entry_list_msg

    VAR
      optimization_option: nft$optimize_list;

    put_message_type (nfc$get_queue_entry_list);
    put_string_parameter ($INTEGER(nfc$io_station_name), station_name);
    put_parameter ($INTEGER(nfc$all_or_top_ten), ^list_type, #SIZE(list_type));

    IF request_optimized_reply THEN
      optimization_option := nfc$do_optimize;
    ELSE
      optimization_option := nfc$do_not_optimize;
    IFEND;
    put_parameter ($INTEGER(nfc$optimize_queue_list), ^optimization_option, #SIZE(optimization_option));
    put_null_parameter;

  PROCEND build_get_q_entry_list_msg;

?? TITLE := '  get_system_file_list', EJECT ??

{
{   The purpose of this procedure is to obtain the list of system
{   file names from the Queue Entry List Data message, received
{   from SCFS.  Upon entry, the message sequence pointer is positioned
{   at the parameter just after the Number of Files parameter.
{

  PROCEDURE get_system_file_list (VAR system_file_list: ^ARRAY [1 .. *] OF ost$name;
    VAR status: ost$status);

*copy nft$q_entry_list_data_msg

    VAR
      byte_array: ^nft$byte_array,
      parameter: ^nft$q_entry_list_data_msg_param,
      value_length: INTEGER,
      count_of_files: ^INTEGER,
      file_and_priority: ^nft$file_and_priority,
      file_count: INTEGER,
      i: INTEGER,
      param_string: ^STRING (* <= osc$max_string_size);


    get_parameter_type (parameter);

    file_count := UPPERBOUND (system_file_list^);
    i := 0;
    WHILE (parameter <> NIL) AND (parameter^.param <> nfc$null_parameter) AND (msg_byte_count > 0)
          AND (i < file_count) DO
      get_parameter_length (parameter^.length_indicated, value_length);
      IF parameter^.param = nfc$sys_file_and_priority THEN
        i := i+1;
        NEXT file_and_priority: [value_length - 8] IN message;
        system_file_list^ [i] := file_and_priority^.name;
      ELSE
{       ERROR ----   Ignore parameter value.
        NEXT byte_array: [1 .. value_length] IN message;
      IFEND;

      get_parameter_type (parameter);
    WHILEND;

    IF i < file_count THEN
      osp$set_status_abnormal (nfc$status_id, nfe$sou_message_format_error,
            'QUEUE_ENTRY_LIST_DATA', status);
    IFEND;

  PROCEND get_system_file_list;

?? TITLE := '  quit command', EJECT ??

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

{ PDT quit_pdt (
{   STATUS)

?? PUSH (LISTEXT := ON) ??

  VAR
    quit_pdt: [STATIC, READ, cls$pdt] clt$parameter_descriptor_table := [^quit_pdt_names, ^quit_pdt_params];

  VAR
    quit_pdt_names: [STATIC, READ, cls$pdt_names_and_defaults] array [1 .. 1] of
      clt$parameter_name_descriptor := [['STATUS', 1]];

  VAR
    quit_pdt_params: [STATIC, READ, cls$pdt_parameters] array [1 .. 1] of clt$parameter_descriptor := [

{ STATUS }
    [[clc$optional], 1, 1, 1, 1, clc$value_range_not_allowed, [NIL, clc$variable_reference,
      clc$array_not_allowed, clc$status_value]]];

?? POP ??

    clp$scan_parameter_list (parameter_list, quit_pdt, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    IF station_operator THEN
      clp$end_scan_command_file (operator_utility_name, status);
    ELSE
      clp$end_scan_command_file (display_utility_name, status);
    IFEND;

  PROCEND quit_command;

?? TITLE := '  queue_operator_message', EJECT ??

{
{   The purpose of this procedure is to queue an operator
{   message from SCFS in a link list until it can be
{   displayed.
{

  PROCEDURE queue_operator_message;

*copy nft$operator_message

    VAR
      byte_array: ^nft$byte_array,
      text_string: ^STRING (* <= nfc$maximum_message_length),
      name_string: ^STRING (* <= osc$max_name_size),
      device_name: ost$name,
      io_station_name: ost$name,
      parameter: ^nft$operator_message_parameter,
      value_length: INTEGER,
      queued_msg_pp: ^^nft$queued_operator_message;


    io_station_name := ' ';
    device_name := ' ';
    text_string := NIL;

    get_parameter_type (parameter);

    WHILE (parameter <> NIL) AND (parameter^.param <> nfc$null_parameter) AND (msg_byte_count > 0) DO
      get_parameter_length (parameter^.length_indicated, value_length);

      CASE parameter^.param OF

      = nfc$io_station_name =
        NEXT name_string: [value_length] IN message;
        io_station_name := name_string^;

      = nfc$device_name =
        NEXT name_string: [value_length] IN message;
        device_name := name_string^;

      = nfc$text =
        NEXT text_string: [value_length] IN message;

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

      CASEND;

      get_parameter_type (parameter);
    WHILEND;

    IF text_string = NIL THEN
    RETURN;
    IFEND;

    queued_msg_pp := ^operator_message_list;
    WHILE queued_msg_pp^ <> NIL DO
      queued_msg_pp := ^queued_msg_pp^^.link;
    WHILEND;
    ALLOCATE queued_msg_pp^: [STRLENGTH (text_string^)];
    queued_msg_pp^^.link := NIL;
    queued_msg_pp^^.station := io_station_name;
    queued_msg_pp^^.device := device_name;
    queued_msg_pp^^.text := text_string^;
    IF operator_message_list = NIL THEN
      operator_message_list := queued_msg_pp^;
    IFEND;

  PROCEND queue_operator_message;

?? TITLE := '  display_operator_message', EJECT ??

{
{   The purpose of this procedure is to display an unsolicited
{   message to the station operator from SCFS/VE.
{

  PROCEDURE display_operator_message (VAR status: ost$status);

*copy clv$display_variables
?? NEWTITLE := '    abort_handler', EJECT ??

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

      close_display;

    PROCEND abort_handler;

?? TITLE := '    close_display', EJECT ??

    PROCEDURE close_display;

      VAR
        ignore_status: ost$status;

      IF output_open THEN
        clp$close_display (display_control, ignore_status);
        output_open := FALSE;
      IFEND;

    PROCEND close_display;

?? TITLE := '    put_display_line', EJECT ??

    PROCEDURE put_display_line (label: STRING (*);
          value: STRING (*));

      VAR
        label_str: STRING (label_size);

      label_str := label;
      IF label <> ' ' THEN
        label_str (label_size - 2, 3) := ' : ';
      IFEND;

      clp$put_partial_display (display_control, label_str, clc$no_trim, amc$start, status);
      IF NOT status.normal THEN
        close_display;
        EXIT display_operator_message;
      IFEND;
      clp$put_partial_display (display_control, value, clc$trim, amc$terminate, status);
      IF NOT status.normal THEN
        close_display;
        EXIT display_operator_message;
      IFEND;

    PROCEND put_display_line;


?? OLDTITLE, EJECT ??

    CONST
      device_label = 'Device   : ',
      device_label_size = 11,
      label_size = 31,
      unit_separator = $CHAR (01f(16));

    VAR
      output_file: [READ] clt$file := [clc$standard_output],
      q_msg: ^nft$queued_operator_message,
      msg_size: 0 .. osc$max_string_size,
      line_size: 0 .. osc$max_string_size,
      i : 1 .. osc$max_string_size,
      display_control: clt$display_control,
      output_open: BOOLEAN,
      start_pos: 1..80,
      str_length: 0 .. osc$max_name_size,
      text: string (80),
      text_length: 0..80;

    IF operator_message_list <> NIL THEN

  /display/
    BEGIN
      output_open := FALSE;
      osp$establish_block_exit_hndlr (^abort_handler);
      clp$open_display (output_file, NIL, display_control, status);
      IF NOT status.normal THEN
        EXIT /display/;
      IFEND;
      output_open := TRUE;
      IF display_control.page_width < clc$narrow_page_width THEN
        clv$page_width := clc$narrow_page_width;
      ELSEIF display_control.page_width > clc$wide_page_width THEN
        clv$page_width := clc$wide_page_width;
      ELSE
        clv$page_width := display_control.page_width;
      IFEND;

      q_msg := operator_message_list;

{  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 (q_msg^.device);
      text (start_pos, str_length) := q_msg^.device (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 (q_msg^.station);
      text (start_pos, str_length) := q_msg^.station (1, str_length);
      text_length := text_length + str_length;

      clp$put_display (display_control, text (1, text_length), clc$trim, status);
      IF NOT status.normal THEN
        EXIT /display/;
      IFEND;

      line_size := clv$page_width - 1;
      msg_size := stringsize (q_msg^.text);

      WHILE msg_size > 0 DO
     /scan_msg/
        FOR i := 1 TO msg_size DO
          IF i >= line_size THEN
            EXIT /scan_msg/;
          ELSEIF q_msg^.text (i) = unit_separator THEN
            q_msg^.text (i) := ' ';
            EXIT /scan_msg/;
          IFEND;
        FOREND /scan_msg/;

        clp$put_display (display_control, q_msg^.text (1, i), clc$trim, status);
        IF NOT status.normal THEN
          EXIT /display/
        IFEND;
        q_msg^.text := q_msg^.text (i+1, *);
        msg_size :=msg_size - i;
      WHILEND;

      operator_message_list := q_msg^.link;
      FREE q_msg;

      put_display_line (' ', ' ');
    END /display/;

      close_display;
      osp$disestablish_cond_handler;
    IFEND;

  PROCEND display_operator_message;

?? TITLE := '  add_user_response', EJECT ??

  PROCEDURE add_user_response (VAR status:ost$status);

*copy nft$add_user_resp_msg

    VAR
      byte_array: ^nft$byte_array,
      name_string: ^STRING (* <= osc$max_name_size),
      response_code: ^nft$add_user_responses,
      parameter: ^nft$add_user_resp_msg_parameter,
      value_length: INTEGER;


    response_code := NIL;
    get_message_type;
    get_parameter_type (parameter);

 /get_params/
    WHILE (parameter <> NIL) AND (parameter^.param <> nfc$null_parameter) AND (msg_byte_count > 0) DO
      get_parameter_length (parameter^.length_indicated, value_length);

      CASE parameter^.param OF

      = nfc$station_or_control_facility =
        NEXT name_string: [value_length] IN message;
        station_name := name_string^;

      = nfc$response_code =
        NEXT response_code IN message;
        EXIT /get_params/;

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

      CASEND;

      get_parameter_type (parameter);
    WHILEND /get_params/;

    IF response_code = NIL THEN
      osp$set_status_abnormal (nfc$status_id, nfe$sou_message_reject, 'ADD_USER', status);
      osp$append_status_parameter (osc$status_parameter_delimiter, no_response_code, status);
    ELSEIF response_code^ <> nfc$message_accepted THEN
      osp$set_status_abnormal (nfc$status_id, nfe$sou_command_reject, 'OPERATE_STATION', status);
      osp$append_status_parameter (osc$status_parameter_delimiter,
            add_user_responses [response_code^], status);
    IFEND;

  PROCEND add_user_response;

?? TITLE := '  change_dev_attributes_response', EJECT ??

  PROCEDURE change_dev_attributes_response (VAR status:ost$status);

    CONST
      chabda_param_size = 26;

*copy nft$change_bd_attr_resp_msg

{  This array of values is used to identify which change_batch_device_attributes
{  parameter the DI found a problem with during validation.  }
{  If a problem was found during validation, the "invalid_chg_request" }
{  parameter would be sent up on the chabda response.  This is what signals  }
{  OPES that there was a problem found.  }

    VAR
      chabda_parameters: [READ] ARRAY [nft$change_bda_resp_parameters] OF STRING (chabda_param_size) :=
        [ {nfc$null_parameter} 'ERROR',
          {nfc$io_station_name} 'ERROR',
          {nfc$device_name} 'DEVICE_NAME',
          {nfc$device_alias_1} 'DEVICE_ALIAS_1',
          {nfc$device_alias_2} 'DEVICE_ALIAS_2',
          {nfc$device_alias_3} 'DEVICE_ALIAS_3',
          {nfc$file_acknowledgement} 'FILE_ACKNOWLEDGEMENT',
          {nfc$terminal_model} 'TERMINAL_MODEL',
          {nfc$transmission_block_size} 'TRANSMISSION_BLOCK_SIZE',
          {nfc$maximum_file_size} 'MAXIMUM_FILE_SIZE',
          {nfc$page_width} 'PAGE_WIDTH',
          {nfc$page_length} 'PAGE_LENGTH',
          {nfc$banner_page_count} 'BANNER_PAGE_COUNT',
          {nfc$banner_highlight_field} 'BANNER_HIGHLIGHT_FIELD',
          {nfc$carriage_control_action} 'CARRIAGE_CONTROL_SUPPORT',
          {nfc$forms_code_1} 'FORMS_CODE_1',
          {nfc$forms_code_2} 'FORMS_CODE_2',
          {nfc$forms_code_3} 'FORMS_CODE_3',
          {nfc$forms_code_4} 'FORMS_CODE_4',
          {nfc$external_characteristics_1} 'EXTERNAL_CHARACTERISTICS_1',
          {nfc$external_characteristics_2} 'EXTERNAL_CHARACTERISTICS_2',
          {nfc$external_characteristics_3} 'EXTERNAL_CHARACTERISTICS_3',
          {nfc$external_characteristics_4} 'EXTERNAL_CHARACTERISTICS_4',
          {nfc$code_set} 'CODE_SET',
          {nfc$vertical_print_density} 'VERTICAL_PRINT_DENSITY',
          {nfc$vfu_load_procedure} 'VFU_LOAD_PROCEDURE',
          {nfc$forms_size} 'FORMS_SIZE',
          {nfc$undefined_fe_action} 'UNDEFINED_FE_ACTION',
          {nfc$unsupported_fe_action} 'UNSUPPORTED_FE_ACTION',
          {29 - 65} REP 37 OF 'ERROR'];
    VAR
      device_name: ost$name,
      invalid_param: ^nft$change_bda_resp_parameters,
      io_station_name: ost$name,
      byte_array: ^nft$byte_array,
      name_string: ^STRING (* <= osc$max_name_size),
      parameter: ^nft$change_bd_attr_resp_param,
      response_code: ^nft$device_control_resp_codes,
      value_length: INTEGER;


    device_name := ' ';
    invalid_param := NIL;
    io_station_name := ' ';
    response_code := NIL;

    get_message_type;
    get_parameter_type (parameter);

 /get_params/
    WHILE (parameter <> NIL) AND (parameter^.param <> nfc$null_parameter) AND (msg_byte_count > 0) DO
      get_parameter_length (parameter^.length_indicated, value_length);

      CASE parameter^.param OF

      = nfc$io_station_name =
        NEXT name_string: [value_length] IN message;
        io_station_name := name_string^;

      = nfc$device_name =
        NEXT name_string: [value_length] IN message;
        device_name := name_string^;

      = nfc$response_code =
        NEXT response_code IN message;

      = nfc$invalid_chg_request =
        NEXT invalid_param IN message;
        EXIT /get_params/

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

      CASEND;

      get_parameter_type (parameter);
    WHILEND /get_params/;

{  If the "invalid request" parameter is returned on the chabda response
{  message, this indicates that the DI found an attribute validation
{  problem with one of the attributes specified on the chabda command.
{  The invalid parameter is sent along to indicate which parameter the
{  validation error occured on.  In the case where there is a problem with
{  the chabda command, the entire command is rejected and no other attributes
{  (if there were others specified) will be updated.

    IF invalid_param <> NIL THEN
      osp$set_status_abnormal (nfc$status_id, nfe$attribute_error_on_command,
            'CHANGE_BATCH_DEVICE_ATTRIBUTES', status);
      osp$append_status_parameter (osc$status_parameter_delimiter,
            chabda_parameters [invalid_param^], status);
    ELSEIF response_code = NIL THEN
      osp$set_status_abnormal (nfc$status_id, nfe$sou_message_reject,
            'CHANGE_BATCH_DEVICE_ATTRIBUTES', status);
      osp$append_status_parameter (osc$status_parameter_delimiter, no_response_code, status);
    ELSEIF response_code^ <> nfc$dc_msg_accepted THEN
      osp$set_status_abnormal (nfc$status_id, nfe$sou_command_reject,
            'CHANGE_BATCH_DEVICE_ATTRIBUTES', status);
      osp$append_status_parameter (osc$status_parameter_delimiter,
            device_control_responses [response_code^], status);
    IFEND;

  PROCEND change_dev_attributes_response;

?? TITLE := '  device_control_response', EJECT ??

  PROCEDURE device_control_response (msg_type: nft$message_kind;
    VAR status:ost$status);

*copy nft$device_control_resp_msg

    VAR
      byte_array: ^nft$byte_array,
      name_string: ^STRING (* <= osc$max_name_size),
      response_code: ^nft$device_control_resp_codes,
      device_name: ost$name,
      io_station_name: ost$name,
      parameter: ^nft$device_control_resp_param,
      value_length: INTEGER;


    device_name := ' ';
    io_station_name := ' ';
    response_code := NIL;

    get_message_type;
    get_parameter_type (parameter);

 /get_params/
    WHILE (parameter <> NIL) AND (parameter^.param <> nfc$null_parameter) AND (msg_byte_count > 0) DO
      get_parameter_length (parameter^.length_indicated, value_length);

      CASE parameter^.param OF

      = nfc$io_station_name =
        NEXT name_string: [value_length] IN message;
        io_station_name := name_string^;

      = nfc$device_name =
        NEXT name_string: [value_length] IN message;
        device_name := name_string^;

      = nfc$response_code =
        NEXT response_code IN message;
        EXIT /get_params/;

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

      CASEND;

      get_parameter_type (parameter);
    WHILEND /get_params/;

    IF response_code = NIL THEN
      osp$set_status_abnormal (nfc$status_id, nfe$sou_message_reject, message_types [msg_type], status);
      osp$append_status_parameter (osc$status_parameter_delimiter, no_response_code, status);
    ELSEIF response_code^ <> nfc$dc_msg_accepted THEN
      osp$set_status_abnormal (nfc$status_id, nfe$sou_command_reject, message_types [msg_type], status);
      osp$append_status_parameter (osc$status_parameter_delimiter,
            device_control_responses [response_code^], status);
    IFEND;

  PROCEND device_control_response;

?? TITLE := '  select_file_response', EJECT ??

  PROCEDURE select_file_response (VAR status:ost$status);

*copy nft$select_file_response_msg

    VAR
      byte_array: ^nft$byte_array,
      name_string: ^STRING (* <= osc$max_name_size),
      response_code: ^nft$select_file_response,
      device_name: ost$name,
      io_station_name: ost$name,
      parameter: ^nft$select_file_resp_parameter,
      value_length: INTEGER;


    device_name := ' ';
    io_station_name := ' ';
    response_code := NIL;

    get_message_type;
    get_parameter_type (parameter);

 /get_params/
    WHILE (parameter <> NIL) AND (parameter^.param <> nfc$null_parameter) AND (msg_byte_count > 0) DO
      get_parameter_length (parameter^.length_indicated, value_length);

      CASE parameter^.param OF

      = nfc$io_station_name =
        NEXT name_string: [value_length] IN message;
        io_station_name := name_string^;

      = nfc$system_file_name =
        NEXT name_string: [value_length] IN message;

      = nfc$response_code =
        NEXT response_code IN message;
        EXIT /get_params/;

      = nfc$device_name =
        NEXT name_string: [value_length] IN message;
        device_name := name_string^;

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

      CASEND;

      get_parameter_type (parameter);
    WHILEND /get_params/;

    IF response_code = NIL THEN
      osp$set_status_abnormal (nfc$status_id, nfe$sou_message_reject, 'SELECT_FILE', status);
      osp$append_status_parameter (osc$status_parameter_delimiter, no_response_code, status);
    ELSEIF response_code^ <> nfc$self_msg_accepted THEN
      osp$set_status_abnormal (nfc$status_id, nfe$sou_command_reject, 'SELECT_FILE', status);
      osp$append_status_parameter (osc$status_parameter_delimiter,
            select_file_responses [response_code^], status);
    IFEND;

  PROCEND select_file_response;

?? TITLE := '  display_device_status', EJECT ??

  PROCEDURE display_device_status (output_file: clt$file;
        display_option: t$display_option;
    VAR display_control: clt$display_control;
    VAR status:ost$status);

?? NEWTITLE := '    put_display_line', EJECT ??

    PROCEDURE put_display_line (label: STRING (*);
          value: STRING (*));

      VAR
        label_str: STRING (label_size);

      label_str := label;
      IF label <> ' ' THEN
        label_str (label_size - 2, 3) := ' : ';
      IFEND;

      clp$put_partial_display (display_control, label_str, clc$no_trim, amc$start, status);
      IF NOT status.normal THEN
        EXIT display_device_status;
      IFEND;
      clp$put_partial_display (display_control, value, clc$trim, amc$terminate, status);
      IF NOT status.normal THEN
        EXIT display_device_status;
      IFEND;

    PROCEND put_display_line;

?? OLDTITLE, EJECT ??

*copy nft$device_status_data_msg

    CONST
      unit_separator = $CHAR (01f(16)),
      label_size = 31;

    VAR
      banner_highlight_field: ^nft$banner_highlight_field,
      banner_page_count: ^nft$banner_page_count,
      carriage_control_action: ^nft$carriage_control_action,
      code_set: ^nft$code_set,
      destination_name: ^STRING (* <= osc$max_name_size),
      device_alias: ARRAY [1 .. 4] OF ^STRING (* <= osc$max_name_size),    { [4] is dummy }
      device_forms_size: real,
      device_name: ^STRING (* <= osc$max_name_size),
      device_status: ^nft$device_status,
      device_type: ^nft$device_type,
      external_characteristics: ARRAY [1 .. 4] OF ^STRING (* <= jmc$ext_characteristics_size),
      family_name: ^STRING (* <= osc$max_name_size),
      file_acknowledge: ^BOOLEAN,
      file_transfer_status: ^nft$file_transfer_status,
      forms_code: ARRAY [1 .. 4] OF ^STRING (* <= jmc$forms_code_size),
      forms_size: ^nft$forms_size,
      fs_vpd_specified: boolean,
      i: 1 .. osc$max_string_size,
      input_bytes_transferred: ^nft$input_job_size,
      byte_array: ^nft$byte_array,
      io_station_name: ^STRING (* <= osc$max_name_size),
      labl: ost$name,
      last_message: ^STRING (*  <= osc$max_string_size ),
      line_size: 0 .. osc$max_string_size,
      max_file_size: ^nft$device_file_size,
      msg_size: 0 .. osc$max_string_size,
      owner_status: ost$status,
      page_length: ^nft$page_length,
      page_width: ^nft$page_width,
      parameter: ^nft$device_sd_msg_param,
      percent_complete: ^nft$file_position,
      response_code: ^nft$display_status_resp_codes,
      response_code_required: BOOLEAN,
      str: ost$string,
      str_length: integer,
      str_value: string (80),
      suppress_carriage_control: ^BOOLEAN,
      system_file_name: ^STRING (* <= osc$max_name_size),
      system_job_name: ^STRING (* <= osc$max_name_size),
      terminal_model: ^STRING (* <= nfc$max_terminal_model_size),
      transmission_block_size: ^nft$transmit_block_size,
      undefined_fe_action: ^nft$format_effector_actions,
      unsupported_fe_action: ^nft$format_effector_actions,
      user_file_name: ^STRING (* <= osc$max_name_size),
      user_job_name: ^STRING (* <= osc$max_name_size),
      user_name: ^STRING (* <= osc$max_name_size),
      value_length: INTEGER,
      vfu_load_option: ^nft$vfu_load_option,
      vertical_print_density: ^nft$vertical_print_density,
      vfu_load_procedure: ^STRING (* <= osc$max_name_size);


    response_code_required := TRUE;

    get_message_type;
    get_parameter_type(parameter);

    WHILE (msg_byte_count > 0) AND (parameter <> NIL) DO
      banner_highlight_field := NIL;
      banner_page_count := NIL;
      carriage_control_action := NIL;
      code_set := NIL;
      destination_name := NIL;
      device_name := NIL;
      device_status := NIL;
      device_type := NIL;
      family_name := NIL;
      file_acknowledge := NIL;
      file_transfer_status := NIL;
      forms_size := NIL;
      fs_vpd_specified := FALSE;
      input_bytes_transferred := NIL;
      io_station_name := NIL;
      last_message := NIL;
      max_file_size := NIL;
      page_length := NIL;
      page_width := NIL;
      percent_complete := NIL;
      response_code := NIL;
      suppress_carriage_control := NIL;
      system_file_name := NIL;
      system_job_name := NIL;
      terminal_model := NIL;
      transmission_block_size := NIL;
      undefined_fe_action := NIL;
      unsupported_fe_action := NIL;
      user_file_name := NIL;
      user_job_name := NIL;
      user_name := NIL;
      vfu_load_option := NIL;
      vertical_print_density := NIL;
      vfu_load_procedure := NIL;

      FOR i := 1 TO 4 DO
        device_alias [i] := NIL;
        external_characteristics [i] := NIL;
        forms_code [i] := NIL;
      FOREND;

      owner_status.normal := FALSE;


   /get_parameters/
      WHILE (parameter <> NIL) AND (parameter^.param <> nfc$null_parameter) AND (msg_byte_count > 0) DO
        get_parameter_length (parameter^.length_indicated, value_length);
        IF value_length = 0 THEN
          get_parameter_type (parameter);
          CYCLE /get_parameters/;
        IFEND;

        CASE parameter^.param OF

        = nfc$io_station_name =
          NEXT io_station_name: [value_length] IN message;

        = nfc$device_name =
          NEXT device_name: [value_length] IN message;

        = nfc$response_code =
          NEXT response_code IN message;

        = nfc$device_status =
          NEXT device_status IN message;

        = nfc$device_type =
          NEXT device_type IN message;

        = nfc$file_transfer_status_param =
          NEXT file_transfer_status IN message;

        = nfc$terminal_model =
          NEXT terminal_model: [value_length] IN message;

        = nfc$file_acknowledgement =
          NEXT file_acknowledge IN message;

        = nfc$maximum_file_size =
          NEXT max_file_size IN message;

        = nfc$page_length =
          NEXT page_length IN message;

        = nfc$page_width =
          NEXT page_width IN message;

        = nfc$banner_page_count =
          NEXT banner_page_count IN message;

        = nfc$banner_highlight_field =
          NEXT banner_highlight_field IN message;

        = nfc$transmission_block_size =
          NEXT transmission_block_size IN message;

        = nfc$carriage_control_action =
          NEXT carriage_control_action IN message;

        = nfc$suppress_carriage_control =
          NEXT suppress_carriage_control IN message;

        = nfc$forms_code_1 =
          NEXT forms_code [1]: [value_length] IN message;

        = nfc$forms_code_2 =
          NEXT forms_code [2]: [value_length] IN message;

        = nfc$forms_code_3 =
          NEXT forms_code [3]: [value_length] IN message;

        = nfc$forms_code_4 =
          NEXT forms_code [4]: [value_length] IN message;

        = nfc$external_characteristics_1 =
          NEXT external_characteristics [1]: [value_length] IN message;

        = nfc$external_characteristics_2 =
          NEXT external_characteristics [2]: [value_length] IN message;

        = nfc$external_characteristics_3 =
          NEXT external_characteristics [3]: [value_length] IN message;

        = nfc$external_characteristics_4 =
          NEXT external_characteristics [4]: [value_length] IN message;

        = nfc$device_alias_1 =
          NEXT device_alias [1]: [value_length] IN message;

        = nfc$device_alias_2 =
          NEXT device_alias [2]: [value_length] IN message;

        = nfc$device_alias_3 =
          NEXT device_alias [3]: [value_length] IN message;

        = nfc$percent_complete =
          NEXT percent_complete IN message;

        = nfc$last_unsolicited_msg =
          IF value_length <> 0 THEN
            NEXT last_message: [value_length] IN message;
          IFEND;

        = nfc$system_file_name =
          NEXT system_file_name: [value_length] IN message;
          check_file_ownership (system_file_name^, owner_status);

        = nfc$user_file_name =
          NEXT user_file_name: [value_length] IN message;

        = nfc$system_job_name =
          NEXT system_job_name: [value_length] IN message;

        = nfc$user_job_name =
          NEXT user_job_name: [value_length] IN message;

        = nfc$user_name =
          NEXT user_name: [value_length] IN message;

        = nfc$family_name =
          NEXT family_name: [value_length] IN message;

        = nfc$code_set =
          NEXT code_set IN message;

        = nfc$forms_size =
          NEXT forms_size IN message;

  {  Flag the fact that the forms_size value was specified and that page_length
  {  should not be displayed

          fs_vpd_specified := TRUE;

        = nfc$undefined_fe_action =
          NEXT undefined_fe_action IN message;

        = nfc$unsupported_fe_action =
          NEXT unsupported_fe_action IN message;

        = nfc$vertical_print_density =
          NEXT vertical_print_density IN message;

  {  Flag the fact that the vertical_print_density value was specified and that page_length
  {  should not be displayed

          fs_vpd_specified := TRUE;

        = nfc$vfu_load_procedure =
          NEXT vfu_load_procedure: [value_length] IN message;

        = nfc$vfu_load_option =
          NEXT vfu_load_option IN message;

        = nfc$destination_name =
          NEXT destination_name: [value_length] IN message;

        = nfc$input_bytes_transferred =
          NEXT input_bytes_transferred IN message;

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

        CASEND;

        get_parameter_type (parameter);
      WHILEND /get_parameters/;

      IF response_code_required THEN
        IF response_code = NIL THEN
          osp$set_status_abnormal (nfc$status_id, nfe$sou_message_reject,
                'GET_DEVICE_STATUS', status);
          osp$append_status_parameter (osc$status_parameter_delimiter, no_response_code, status);
          RETURN;
        ELSEIF response_code^ <> nfc$disp_msg_accepted THEN
          osp$set_status_abnormal (nfc$status_id, nfe$sou_command_reject,
                'DISPLAY_BATCH_DEVICE_STATUS', status);
          osp$append_status_parameter (osc$status_parameter_delimiter,
                display_status_responses [response_code^], status);
          RETURN;
        IFEND;

        response_code_required := FALSE;
      IFEND;

      IF device_name <> NIL THEN
        put_display_line ('Device_Name', device_name^);
      IFEND;

      IF (display_option = display_all) THEN
        IF (banner_highlight_field <> NIL) THEN
          put_display_line ('  Banner_Highlight_Field', banner_highlight_fields [banner_highlight_field^]);
        IFEND;

        IF (banner_page_count <> NIL) THEN
          clp$convert_integer_to_string ($INTEGER(banner_page_count^), 10, FALSE, str, status);
          put_display_line ('  Banner_Page_Count', str.value (1, str.size));
        IFEND;

        IF (carriage_control_action <> NIL) THEN
          put_display_line ('  Carriage_Control_Action', carriage_control_actions [carriage_control_action^]);
        IFEND;

        IF (code_set <> NIL) THEN
          put_display_line ('  Code_Set', code_sets [code_set^]);
        IFEND;

        IF (device_alias [1] <> NIL) THEN
          put_display_line ('  Device_Alias_1', device_alias [1]^);
        IFEND;

        IF (device_alias [2] <> NIL) THEN
          put_display_line ('  Device_Alias_2', device_alias [2]^);
        IFEND;

        IF (device_alias [3] <> NIL) THEN
          put_display_line ('  Device_Alias_3', device_alias [3]^);
        IFEND;
      IFEND;

      IF device_status <> NIL THEN
        put_display_line ('  Device_Status', device_statuses [device_status^]);
      IFEND;

      IF (display_option = display_all) THEN
        IF (device_type <> NIL) THEN
          put_display_line ('  Device_Type', device_types [device_type^]);
        IFEND;

        IF (external_characteristics [1] <> NIL) THEN
          put_display_line ('  External_Characteristics_1', external_characteristics [1]^);
        IFEND;

        IF (external_characteristics [2] <> NIL) THEN
          put_display_line ('  External_Characteristics_2', external_characteristics [2]^);
        IFEND;

        IF (external_characteristics [3] <> NIL) THEN
          put_display_line ('  External_Characteristics_3', external_characteristics [3]^);
        IFEND;

        IF (external_characteristics [4] <> NIL) THEN
          put_display_line ('  External_Characteristics_4', external_characteristics [4]^);
        IFEND;

        IF (file_acknowledge <> NIL) THEN
          put_display_line ('  File_Acknowledgement', boolean_values [file_acknowledge^]);
        IFEND;
      IFEND;

      IF file_transfer_status <> NIL THEN
        put_display_line ('  File_Transfer_Status', file_transfer_statuses [file_transfer_status^]);
      IFEND;

      IF (display_option = display_all) THEN
        IF (forms_code [1] <> NIL) THEN
          put_display_line ('  Forms_Code_1', forms_code [1]^);
        IFEND;

        IF (forms_code [2] <> NIL) THEN
          put_display_line ('  Forms_Code_2', forms_code [2]^);
        IFEND;

        IF (forms_code [3] <> NIL) THEN
          put_display_line ('  Forms_Code_3', forms_code [3]^);
        IFEND;

        IF (forms_code [4] <> NIL) THEN
          put_display_line ('  Forms_Code_4', forms_code [4]^);
        IFEND;

        IF (forms_size <> NIL) THEN

  {  forms size for a device is stored internally as double the value }

          device_forms_size := $REAL (forms_size^)/2.0;
          STRINGREP (str_value, str_length, device_forms_size:5:1);
          put_display_line ('  Forms_Size', str_value (1, str_length));
        IFEND;
      IFEND;

      IF (input_bytes_transferred <> NIL) THEN
        clp$convert_integer_to_string ($INTEGER(input_bytes_transferred^), 10, FALSE, str, status);
        put_display_line ('  Input_Bytes_Transferred', str.value (1, str.size));
      IFEND;

      IF (display_option = display_all) THEN
        IF (destination_name <> NIL) AND ((station_operator) OR (owner_status.normal)) THEN
          put_display_line ('  Job_Destination_Name', destination_name^);
        IFEND;
      IFEND;

      IF last_message <> NIL THEN
        labl := '  Last_Unsolicited_Message';
        line_size := display_control.page_width - label_size - 1;
        msg_size := stringsize (last_message^);

        WHILE msg_size > 0 DO
       /scan_msg/
          FOR i := 1 TO msg_size DO
            IF i >= line_size THEN
              EXIT /scan_msg/;
            ELSEIF last_message^ (i) = unit_separator THEN
              last_message^ (i) := ' ';
              EXIT /scan_msg/;
            IFEND;
          FOREND /scan_msg/;

          put_display_line (labl, last_message^ (1, i));
          labl := ' ';
          last_message^ := last_message^ (i+1, *);
          msg_size :=msg_size - i;
        WHILEND;
      IFEND;

      IF (display_option = display_all) THEN
        IF (page_length <> NIL) AND (NOT fs_vpd_specified) THEN
          clp$convert_integer_to_string ($INTEGER(page_length^), 10, FALSE, str, status);
          put_display_line ('  Page_Length', str.value (1, str.size));
        IFEND;

        IF (page_width <> NIL) THEN
          clp$convert_integer_to_string ($INTEGER(page_width^), 10, FALSE, str, status);
          put_display_line ('  Page_Width', str.value (1, str.size));
        IFEND;

        IF (max_file_size <> NIL) THEN
          IF max_file_size^ = 0 THEN
            str.value := 'unlimited';
            str.size := 9;
          ELSE
            clp$convert_integer_to_string ($INTEGER(max_file_size^), 10, FALSE, str, status);
          IFEND;
          put_display_line ('  Maximum_File_Size', str.value (1, str.size));
        IFEND;

        IF (suppress_carriage_control <> NIL) THEN
          put_display_line ('  Suppress_Carriage_Control', boolean_values [suppress_carriage_control^]);
        IFEND;

        IF (terminal_model <> NIL) THEN
          put_display_line ('  Terminal_Model', terminal_model^);
        IFEND;

        IF (transmission_block_size <> NIL) THEN
          clp$convert_integer_to_string ($INTEGER(transmission_block_size^), 10, FALSE, str, status);
          put_display_line ('  Transmission_Block_Size', str.value (1, str.size));
        IFEND;

        IF (undefined_fe_action <> NIL) THEN
          put_display_line ('  Undefined_FE_Action', format_effector_actions [undefined_fe_action^]);
        IFEND;

        IF (unsupported_fe_action <> NIL) THEN
          put_display_line ('  Unsupported_FE_Action', format_effector_actions [unsupported_fe_action^]);
        IFEND;

        IF (vertical_print_density <> NIL) THEN
          put_display_line ('  Vertical_Print_Density', vpd_actions
                [vertical_print_density^]);
        IFEND;

        IF (vfu_load_option <> NIL) THEN
          put_display_line ('  VFU_Load_Option', vfu_load_option_actions [vfu_load_option^]);
        IFEND;

        IF (vfu_load_procedure <> NIL) THEN
          put_display_line ('  VFU_Load_Procedure', vfu_load_procedure^);
        IFEND;

        IF (family_name <> NIL) AND ((station_operator) OR (owner_status.normal)) THEN
          put_display_line ('  Family_Name', family_name^);
        IFEND;

        IF (user_name <> NIL) AND ((station_operator) OR (owner_status.normal)) THEN
          put_display_line ('  Login_User_Name', user_name^);
        IFEND;
      IFEND;

      IF (percent_complete <> NIL) THEN
        clp$convert_integer_to_string ($INTEGER(percent_complete^), 10, FALSE, str, status);
        put_display_line ('  Percent_Complete', str.value (1, str.size));
      IFEND;

      IF (display_option = display_all) THEN
        IF (system_file_name <> NIL) THEN
          put_display_line ('  System_Supplied_File_Name', system_file_name^);
        IFEND;

        IF (system_job_name <> NIL) AND ((station_operator) OR (owner_status.normal)) THEN
          put_display_line ('  System_Supplied_Job_Name', system_job_name^);
        IFEND;

        IF (user_file_name <> NIL) AND ((station_operator) OR (owner_status.normal)) THEN
          put_display_line ('  User_Supplied_File_Name', user_file_name^);
        IFEND;

        IF (user_job_name <> NIL) AND ((station_operator) OR (owner_status.normal)) THEN
          put_display_line ('  User_Supplied_Job_Name', user_job_name^);
        IFEND;
      IFEND;
      IF (display_control.line_number < display_control.page_length) OR
            (display_control.page_format = amc$continuous_form) THEN
        clp$put_display (display_control, ' ', clc$trim, status);
      IFEND;
      IF (msg_byte_count > 0) THEN
        get_parameter_type (parameter);
      IFEND;
    WHILEND;

  PROCEND display_device_status;

?? TITLE := '  display_station_status', EJECT ??

  PROCEDURE display_station_status (output_file: clt$file;
    VAR display_control: clt$display_control;
    VAR status:ost$status);

?? NEWTITLE := '    put_display_line', EJECT ??

    PROCEDURE put_display_line (label: STRING (*);
          value: STRING (*));

      VAR
        label_str: STRING (label_size);

      label_str := label;
      IF label <> ' ' THEN
        label_str (label_size - 2, 3) := ' : ';
      IFEND;

      clp$put_partial_display (display_control, label_str, clc$no_trim, amc$start, status);
      IF NOT status.normal THEN
        EXIT display_station_status;
      IFEND;
      clp$put_partial_display (display_control, value, clc$trim, amc$terminate, status);
      IF NOT status.normal THEN
        EXIT display_station_status;
      IFEND;

    PROCEND put_display_line;

?? OLDTITLE, EJECT ??

*copy nft$station_status_msg

    CONST
      device_status_size = 32,
      file_status_size = 9,
      label_size = 35,
      line = '  ----------------------------------------------------------------------';

    VAR
      byte_array: ^nft$byte_array,
      control_facility_name: ^STRING (* <= osc$max_name_size),
      count_of_devices: ^INTEGER,
      default_job_destination: ^STRING (* <= osc$max_name_size),
      destination_unavailable_action: ^nft$destination_unavail_actions,
      device_name: STRING (33),
      device_status: STRING (16),
      device_statuses: [STATIC, READ] ARRAY [nft$device_status] OF STRING (device_status_size) :=
          [ {nfc$device_active} 'active',       {nfc$device_stopped} 'stopped',
            {nfc$device_not_ready} 'not ready', {nfc$device_down} 'down',
            {nfc$device_loading_vfu} 'loading DLP',
            {nfc$default_vfu_not_loadable} 'can''t load DLP',
            {nfc$device_stopped_by_system} 'system stopped',
            {nfc$device_status_reserved_7} ' ',
            {nfc$device_status_reserved_8} ' ',
            {nfc$device_status_reserved_9} ' ',
            {nfc$device_status_reserved_10} ' ',
            {nfc$ntf_waiting_signon} ' ',
            {nfc$ntf_signon_initiated} ' ',
            {nfc$ntf_signed_on} ' ',
            {nfc$ntf_signon_failed} ' ',
            {nfc$ntf_signed_off} ' '],
      device_status_data: ^ARRAY [1 .. *] OF ^nft$device_status_data,
      device_type: STRING (10),
      dev_count: INTEGER,
      display_line: STRING(80),
      empty_value: STRING(4),
      file_transfer_status: STRING (11),
      file_transfer_statuses: [STATIC, READ] ARRAY [nft$file_transfer_status] OF STRING (file_status_size) :=
          [ REP 8 OF 'idle',
            {nfc$busy} 'busy',
            REP 7 OF 'suspended'],
      file_acknowledge: ^BOOLEAN,
      i: 1 .. 3,
      io_station_alias: ARRAY [1 .. 3] OF ^STRING (* <= osc$max_name_size),
      io_station_name: ^STRING (* <= osc$max_name_size),
      num_files_queued: ^INTEGER,
      parameter: ^nft$station_status_msg_param,
      pm_message_action: ^nft$pm_message_actions,
      required_console_device: ^STRING (* <= osc$max_name_size),
      response_code: ^nft$display_status_resp_codes,
      station_usage: ^nft$io_station_usage,
      string_length: INTEGER,
      str: ost$string,
      value_length: INTEGER;

    control_facility_name := NIL;
    count_of_devices := NIL;
    default_job_destination := NIL;
    destination_unavailable_action := NIL;
    device_name := ' ';
    device_status := ' ';
    device_type := ' ';
    device_status_data := NIL;
    dev_count := 0;
    empty_value := 'none';
    file_acknowledge := NIL;
    io_station_name := NIL;
    num_files_queued := NIL;
    pm_message_action := NIL;
    required_console_device := NIL;
    response_code := NIL;
    station_usage := NIL;
    FOR i := 1 TO 3 DO
      io_station_alias [i] := NIL;
    FOREND;

    get_message_type;
    get_parameter_type (parameter);

 /get_parameters/
    WHILE (parameter <> NIL) AND (parameter^.param <> nfc$null_parameter) AND (msg_byte_count > 0) DO
      get_parameter_length (parameter^.length_indicated, value_length);
      IF value_length = 0 THEN
        get_parameter_type (parameter);
        CYCLE /get_parameters/;
      IFEND;

      CASE parameter^.param OF

      = nfc$io_station_name =
        NEXT io_station_name: [value_length] IN message;

      = nfc$control_facility =
        NEXT control_facility_name: [value_length] IN message;

      = nfc$response_code =
        NEXT response_code IN message;

      = nfc$number_of_files_queued =
        NEXT num_files_queued IN message;

      = nfc$station_usage =
        NEXT station_usage IN message;

      = nfc$file_acknowledgement =
        NEXT file_acknowledge IN message;

      = nfc$count_of_devices =
        IF count_of_devices <> NIL THEN
          osp$set_status_abnormal (nfc$status_id, nfe$sou_message_format_error,
                'STATION_STATUS_DATA', status);
          RETURN;
        IFEND;
        NEXT count_of_devices IN message;
        PUSH device_status_data: [1 .. count_of_devices^];

      = nfc$device_name_status =
        dev_count := dev_count +1;
        IF (count_of_devices = NIL) OR (dev_count > count_of_devices^) THEN
          osp$set_status_abnormal (nfc$status_id, nfe$sou_message_format_error,
                'STATION_STATUS_DATA', status);
          RETURN;
        IFEND;
        NEXT device_status_data^ [dev_count]: [value_length -3] IN message;

      = nfc$req_console_device =
        NEXT required_console_device: [value_length] IN message;

      = nfc$io_station_alias_1 =
        NEXT io_station_alias [1]: [value_length] IN message;

      = nfc$io_station_alias_2 =
        NEXT io_station_alias [2]: [value_length] IN message;

      = nfc$io_station_alias_3 =
        NEXT io_station_alias [3]: [value_length] IN message;

      = nfc$default_job_destination =
        NEXT default_job_destination: [value_length] IN message;

      = nfc$destination_unavail_action =
        NEXT destination_unavailable_action IN message;

      = nfc$pm_message_action =
        NEXT pm_message_action IN message;


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

      CASEND;

      get_parameter_type (parameter);
    WHILEND /get_parameters/;

    IF response_code = NIL THEN
      osp$set_status_abnormal (nfc$status_id, nfe$sou_message_reject,
            'GET_STATION_STATUS', status);
      osp$append_status_parameter (osc$status_parameter_delimiter, no_response_code, status);
      RETURN;
    ELSEIF response_code^ <> nfc$disp_msg_accepted THEN
      osp$set_status_abnormal (nfc$status_id, nfe$sou_message_reject,
            'GET_STATION_STATUS', status);
      osp$append_status_parameter (osc$status_parameter_delimiter,
            display_status_responses [response_code^], status);
      RETURN;
    IFEND;

    IF (count_of_devices <> NIL) AND (dev_count <> count_of_devices^) THEN
      osp$set_status_abnormal (nfc$status_id, nfe$sou_message_format_error,
            'STATION_STATUS_DATA', status);
      RETURN;
    IFEND;

    IF io_station_name <> NIL THEN
      put_display_line ('Station_Name', io_station_name^);
    IFEND;

    IF control_facility_name <> NIL THEN
      put_display_line ('  Control_Facility_Name', control_facility_name^);
    IFEND;

    IF default_job_destination <> NIL THEN
      put_display_line ('  Default_Job_Destination', default_job_destination^);
    IFEND;

    IF destination_unavailable_action <> NIL THEN
      put_display_line ('  Destination_Unavailable_Action', destination_unavail_actions
            [destination_unavailable_action^]);
    IFEND;

    IF file_acknowledge <> NIL THEN
      put_display_line ('  File_Acknowledgement', boolean_values [file_acknowledge^]);
    IFEND;

    IF num_files_queued <> NIL THEN
      clp$convert_integer_to_string (num_files_queued^, 10, FALSE, str, status);
      put_display_line ('  Number_Of_Files_Queued', str.value (1, str.size));
    IFEND;

    IF pm_message_action <> NIL THEN
      put_display_line ('  PM_Message_Action', pm_message_actions [pm_message_action^]);
    IFEND;

    IF required_console_device <> NIL THEN
      put_display_line ('  Required_Console_Device', required_console_device^);
    ELSE
      put_display_line ('  Required_Console_Device', empty_value);
    IFEND;

    IF io_station_alias [1] <> NIL THEN
      put_display_line ('  Station_Alias_1', io_station_alias [1]^);
    IFEND;

    IF io_station_alias [2] <> NIL THEN
      put_display_line ('  Station_Alias_2', io_station_alias [2]^);
    IFEND;

    IF io_station_alias [3] <> NIL THEN
      put_display_line ('  Station_Alias_3', io_station_alias [3]^);
    IFEND;

    IF station_usage <> NIL THEN
      put_display_line ('  Station_Usage', station_usages [station_usage^]);
    IFEND;

    IF count_of_devices <> NIL THEN
      clp$convert_integer_to_string (count_of_devices^, 10, FALSE, str, status);
      put_display_line ('  Count_Of_Devices', str.value (1, str.size));

      put_display_line (' ', ' ');

      device_name := 'Device_Name';
      device_type := 'Type';
      device_status := 'Device_Status';
      file_transfer_status := 'File_Status';

      STRINGREP (display_line, string_length, '  ', device_name, device_type,
            device_status, file_transfer_status);
      clp$put_display (display_control, display_line (1, string_length), clc$trim, status);
      IF NOT status.normal THEN
        EXIT display_station_status;
      IFEND;

      clp$put_display (display_control, line, clc$trim, status);
      IF NOT status.normal THEN
        EXIT display_station_status;
      IFEND;

      FOR dev_count := 1 TO count_of_devices^ DO
        device_name := device_status_data^ [dev_count]^.name;
        device_type := device_types [device_status_data^ [dev_count]^.
              device_type];
        device_status := device_statuses [device_status_data^ [dev_count]^.
              device_status];
        file_transfer_status := file_transfer_statuses [device_status_data^
              [dev_count]^.file_xfer_status];

        STRINGREP (display_line, string_length, '  ', device_name, device_type,
              device_status, file_transfer_status);
        clp$put_display (display_control, display_line (1, string_length), clc$trim, status);
        IF NOT status.normal THEN
          EXIT display_station_status;
        IFEND;
      FOREND;
    IFEND;

  PROCEND display_station_status;

?? TITLE := '  display_queue_status', EJECT ??

  PROCEDURE display_queue_status (output_file: clt$file;
        display_option: t$display_option;
    VAR display_control: clt$display_control;
    VAR status:ost$status);

?? NEWTITLE := '    build_private_station_dest', EJECT ??

    PROCEDURE build_private_station_dest (destination_and_status: nft$q_status_data;
      VAR private_destination: ^string (*));

      CONST
        comma_blank = ', ',
        blanks_and_commas_length = 4;

      VAR
        destination_length: 0 .. 0ff(16),
        operator_family_length: 0 .. 0ff(16),
        operator_name_length: 0 .. 0ff(16),
        position: 0 .. 0ff(16),
        private_destination_length: 0 .. 0ff(16);


      operator_name_length := stringsize (destination_and_status.operator_name);
      operator_family_length := stringsize (destination_and_status.operator_family);
      destination_length := stringsize (destination_and_status.name);
      private_destination_length := blanks_and_commas_length + operator_name_length + operator_family_length +
            destination_length;

      ALLOCATE private_destination: [private_destination_length];

      position := 1;
      private_destination^ (position, destination_length) := destination_and_status.name;
      position := position + destination_length;
      private_destination^ (position, 2) := comma_blank;
      position := position + 2;
      private_destination^ (position, operator_name_length) := destination_and_status.operator_name;
      position := position + operator_name_length;
      private_destination^ (position, 2) := comma_blank;
      position := position + 2;
      private_destination^ (position, operator_family_length) := destination_and_status.operator_family;

    PROCEND build_private_station_dest;
?? TITLE := '    put_display_line', EJECT ??

    PROCEDURE put_display_line (label: STRING (*);
          value: STRING (*));

      VAR
        label_str: STRING (label_size);

      label_str := label;
      IF label <> ' ' THEN
        label_str (label_size - 2, 3) := ' : ';
      IFEND;

      clp$put_partial_display (display_control, label_str, clc$no_trim, amc$start, status);
      IF NOT status.normal THEN
        EXIT display_queue_status;
      IFEND;
      clp$put_partial_display (display_control, value, clc$trim, amc$terminate, status);
      IF NOT status.normal THEN
        EXIT display_queue_status;
      IFEND;

    PROCEND put_display_line;

?? OLDTITLE, EJECT ??

*copy nft$queue_status_data_msg

    CONST
      label_size = 31;

    VAR
      byte_array: ^nft$byte_array,
      io_station_name: ^STRING (* <= osc$max_name_size),
      response_code: ^nft$display_status_resp_codes,
      file_count: ^INTEGER,
      count_ext_characteristics: ^INTEGER,
      ext_chrstcs_and_status: ^ARRAY [1 .. *] OF ^nft$q_status_data,
      count_forms_codes: ^INTEGER,
      forms_codes_and_status: ^ARRAY [1 .. *] OF ^nft$q_status_data,
      count_devices: ^INTEGER,
      device_names_and_status: ^ARRAY [1 .. *] OF ^nft$q_status_data,
      count_destinations: ^INTEGER,
      destinations_and_status: ^ARRAY [1 .. *] OF ^nft$q_status_data,
      count_device_types: ^INTEGER,
      device_types_and_status: ^ARRAY [1 .. *] OF ^nft$q_status_data,
      ec_count: INTEGER,
      fc_count: INTEGER,
      dev_count: INTEGER,
      dest_count: INTEGER,
      dt_count: INTEGER,
      parameter: ^nft$queue_status_msg_parameter,
      private_station_destination: ^string (*),
      value_length: INTEGER,
      str: ost$string;


    io_station_name := NIL;
    response_code := NIL;
    file_count := NIL;
    count_ext_characteristics := NIL;
    ext_chrstcs_and_status := NIL;
    count_forms_codes := NIL;
    forms_codes_and_status := NIL;
    count_devices := NIL;
    device_names_and_status := NIL;
    count_destinations := NIL;
    destinations_and_status := NIL;
    count_device_types := NIL;
    device_types_and_status := NIL;
    ec_count := 0;
    fc_count := 0;
    dev_count := 0;
    dest_count := 0;
    dt_count := 0;

    get_message_type;
    get_parameter_type (parameter);

 /get_parameters/
    WHILE (parameter <> NIL) AND (parameter^.param <> nfc$null_parameter) AND (msg_byte_count > 0) DO
      get_parameter_length (parameter^.length_indicated, value_length);
      IF value_length = 0 THEN
        get_parameter_type (parameter);
        CYCLE /get_parameters/;
      IFEND;

      CASE parameter^.param OF

      = nfc$io_station_name =
        NEXT io_station_name: [value_length] IN message;

      = nfc$response_code =
        NEXT response_code IN message;

      = nfc$file_count =
        NEXT file_count IN message;

      = nfc$ext_chars_count =
        IF count_ext_characteristics <> NIL THEN
          osp$set_status_abnormal (nfc$status_id, nfe$sou_message_format_error,
                'QUEUE_STATUS_DATA', status);
          RETURN;
        IFEND;
        NEXT count_ext_characteristics IN message;
        IF count_ext_characteristics^ > 0 THEN
          PUSH ext_chrstcs_and_status: [1 .. count_ext_characteristics^];
        IFEND;

      = nfc$ext_char_and_files =
        ec_count := ec_count + 1;
        IF (count_ext_characteristics = NIL) OR (ec_count > count_ext_characteristics^) THEN
          osp$set_status_abnormal (nfc$status_id, nfe$sou_message_format_error,
                'QUEUE_STATUS_DATA', status);
          RETURN;
        IFEND;
        NEXT ext_chrstcs_and_status^ [ec_count]: [value_length - nfc$fixed_q_status_data_length] IN message;

      = nfc$forms_code_count =
        IF count_forms_codes <> NIL THEN
          osp$set_status_abnormal (nfc$status_id, nfe$sou_message_format_error,
                'QUEUE_STATUS_DATA', status);
          RETURN;
        IFEND;
        NEXT count_forms_codes IN message;
        IF count_forms_codes^ > 0 THEN
          PUSH forms_codes_and_status: [1 .. count_forms_codes^];
        IFEND;

      = nfc$forms_code_and_files =
        fc_count := fc_count + 1;
        IF (count_forms_codes = NIL) OR (fc_count > count_forms_codes^) THEN
          osp$set_status_abnormal (nfc$status_id, nfe$sou_message_format_error,
                'QUEUE_STATUS_DATA', status);
          RETURN;
        IFEND;
        NEXT forms_codes_and_status^ [fc_count]: [value_length - nfc$fixed_q_status_data_length] IN message;

      = nfc$device_count =
        IF count_devices <> NIL THEN
          osp$set_status_abnormal (nfc$status_id, nfe$sou_message_format_error,
                'QUEUE_STATUS_DATA', status);
          RETURN;
        IFEND;
        NEXT count_devices IN message;
        IF count_devices^ > 0 THEN
          PUSH device_names_and_status: [1 .. count_devices^];
        IFEND;

      = nfc$device_names_and_files =
        dev_count := dev_count + 1;
        IF (count_devices = NIL) OR (dev_count > count_devices^) THEN
          osp$set_status_abnormal (nfc$status_id, nfe$sou_message_format_error,
                'QUEUE_STATUS_DATA', status);
          RETURN;
        IFEND;
        NEXT device_names_and_status^ [dev_count]: [value_length - nfc$fixed_q_status_data_length] IN message;

      = nfc$destination_count =
        IF count_destinations <> NIL THEN
          osp$set_status_abnormal (nfc$status_id, nfe$sou_message_format_error,
                'QUEUE_STATUS_DATA', status);
          RETURN;
        IFEND;
        NEXT count_destinations IN message;
        IF count_destinations^ > 0 THEN
          PUSH destinations_and_status: [1 .. count_destinations^];
        IFEND;

      = nfc$destinations_and_files =
        dest_count := dest_count + 1;
        IF (count_destinations = NIL) OR (dest_count > count_destinations^) THEN
          osp$set_status_abnormal (nfc$status_id, nfe$sou_message_format_error,
                'QUEUE_STATUS_DATA', status);
          RETURN;
        IFEND;
        NEXT destinations_and_status^ [dest_count]: [value_length - nfc$fixed_q_status_data_length] IN
              message;

      = nfc$device_type_count =
        IF count_device_types <> NIL THEN
          osp$set_status_abnormal (nfc$status_id, nfe$sou_message_format_error,
                'QUEUE_STATUS_DATA', status);
          RETURN;
        IFEND;
        NEXT count_device_types IN message;
        IF count_device_types^ > 0 THEN
          PUSH device_types_and_status: [1 .. count_device_types^];
        IFEND;

      = nfc$device_types_and_files =
        dt_count := dt_count + 1;
        IF (count_device_types = NIL) OR (dt_count > count_device_types^) THEN
          osp$set_status_abnormal (nfc$status_id, nfe$sou_message_format_error,
                'QUEUE_STATUS_DATA', status);
          RETURN;
        IFEND;
        NEXT device_types_and_status^ [dt_count]: [value_length - nfc$fixed_q_status_data_length] IN message;

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

      CASEND;

      get_parameter_type (parameter);
    WHILEND /get_parameters/;

    IF response_code = NIL THEN
      osp$set_status_abnormal (nfc$status_id, nfe$sou_message_reject,
            'GET_QUEUE_STATUS', status);
      osp$append_status_parameter (osc$status_parameter_delimiter, no_response_code, status);
      RETURN;
    ELSEIF response_code^ <> nfc$disp_msg_accepted THEN
      osp$set_status_abnormal (nfc$status_id, nfe$sou_message_reject,
            'GET_QUEUE_STATUS', status);
      osp$append_status_parameter (osc$status_parameter_delimiter,
            display_status_responses [response_code^], status);
      RETURN;
    IFEND;

    IF ((count_ext_characteristics <> NIL) AND (ec_count <> count_ext_characteristics^))
          OR ((count_forms_codes <> NIL) AND (fc_count <> count_forms_codes^))
          OR ((count_devices <> NIL) AND (dev_count <> count_devices^))
          OR ((count_destinations <> NIL) AND (dest_count <> count_destinations^))
          OR ((count_device_types <> NIL) AND (dt_count <> count_device_types^)) THEN
      osp$set_status_abnormal (nfc$status_id, nfe$sou_message_format_error,
            'QUEUE_STATUS_DATA', status);
      RETURN;
    IFEND;

    IF io_station_name <> NIL THEN
      put_display_line ('Station_Name', io_station_name^);
    IFEND;

    IF (file_count <> NIL) THEN
      clp$convert_integer_to_string (file_count^, 10, FALSE, str, status);
      put_display_line ('Number_Of_Files', str.value (1, str.size));
    IFEND;

    IF (display_option = display_all) THEN
      IF (count_destinations <> NIL) THEN
        FOR dest_count := 1 TO count_destinations^ DO
          IF destinations_and_status^ [dest_count]^.name = station_name THEN
            put_display_line ('  Destination', destinations_and_status^ [dest_count]^.name);
          ELSE
            build_private_station_dest (destinations_and_status^ [1]^, private_station_destination);
            put_display_line ('  Destination', private_station_destination^);
            FREE private_station_destination;
          IFEND;
          clp$convert_integer_to_string (destinations_and_status^ [dest_count]^.oldest_age,
                10, FALSE, str, status);
          put_display_line ('    Age_of_Oldest_File', str.value (1, str.size));
          clp$convert_integer_to_string (destinations_and_status^ [dest_count]^.average_age,
                10, FALSE, str, status);
          put_display_line ('    Average_Age_of_Files', str.value (1, str.size));
          clp$convert_integer_to_string (destinations_and_status^ [dest_count]^.file_count,
                10, FALSE, str, status);
          put_display_line ('    File_Count', str.value (1, str.size));
          clp$convert_integer_to_string (destinations_and_status^ [dest_count]^.total_size,
                10, FALSE, str, status);
          put_display_line ('    Total_File_Size', str.value (1, str.size));
        FOREND;
      IFEND;

      IF (count_devices <> NIL) THEN
        FOR dev_count := 1 TO count_devices^ DO
          put_display_line ('  Device_Name', device_names_and_status^ [dev_count]^.name);
          clp$convert_integer_to_string (device_names_and_status^ [dev_count]^.oldest_age,
                10, FALSE, str, status);
          put_display_line ('    Age_of_Oldest_File', str.value (1, str.size));
          clp$convert_integer_to_string (device_names_and_status^ [dev_count]^.average_age,
                10, FALSE, str, status);
          put_display_line ('    Average_Age_of_Files', str.value (1, str.size));
          clp$convert_integer_to_string (device_names_and_status^ [dev_count]^.file_count,
                10, FALSE, str, status);
          put_display_line ('    File_Count', str.value (1, str.size));
          clp$convert_integer_to_string (device_names_and_status^ [dev_count]^.total_size,
                10, FALSE, str, status);
          put_display_line ('    Total_File_Size', str.value (1, str.size));
        FOREND;
      IFEND;
    IFEND;

    IF count_device_types <> NIL THEN
      FOR dt_count := 1 TO count_device_types^ DO
        put_display_line ('  Device_Type', device_types_and_status^ [dt_count]^.name);
        clp$convert_integer_to_string (device_types_and_status^ [dt_count]^.oldest_age,
              10, FALSE, str, status);
        put_display_line ('    Age_of_Oldest_File', str.value (1, str.size));
        clp$convert_integer_to_string (device_types_and_status^ [dt_count]^.average_age,
              10, FALSE, str, status);
        put_display_line ('    Average_Age_of_Files', str.value (1, str.size));
        clp$convert_integer_to_string (device_types_and_status^ [dt_count]^.file_count,
              10, FALSE, str, status);
        put_display_line ('    File_Count', str.value (1, str.size));
        clp$convert_integer_to_string (device_types_and_status^ [dt_count]^.total_size,
              10, FALSE, str, status);
        put_display_line ('    Total_File_Size', str.value (1, str.size));
      FOREND;
    IFEND;

    IF (display_option = display_all) THEN
      IF (count_ext_characteristics <> NIL) THEN
        FOR ec_count := 1 TO count_ext_characteristics^ DO
          put_display_line ('  External_Characteristics', ext_chrstcs_and_status^ [ec_count]^.name);
          clp$convert_integer_to_string (ext_chrstcs_and_status^ [ec_count]^.oldest_age,
                10, FALSE, str, status);
          put_display_line ('    Age_of_Oldest_File', str.value (1, str.size));
          clp$convert_integer_to_string (ext_chrstcs_and_status^ [ec_count]^.average_age,
                10, FALSE, str, status);
          put_display_line ('    Average_Age_of_Files', str.value (1, str.size));
          clp$convert_integer_to_string (ext_chrstcs_and_status^ [ec_count]^.file_count,
                10, FALSE, str, status);
          put_display_line ('    File_Count', str.value (1, str.size));
          clp$convert_integer_to_string (ext_chrstcs_and_status^ [ec_count]^.total_size,
                10, FALSE, str, status);
          put_display_line ('    Total_File_Size', str.value (1, str.size));
        FOREND;
      IFEND;

      IF (count_forms_codes <> NIL) THEN
        FOR fc_count := 1 TO count_forms_codes^ DO
          put_display_line ('  Forms_Code', forms_codes_and_status^ [fc_count]^.name);
          clp$convert_integer_to_string (forms_codes_and_status^ [fc_count]^.oldest_age,
                10, FALSE, str, status);
          put_display_line ('    Age_of_Oldest_File', str.value (1, str.size));
          clp$convert_integer_to_string (forms_codes_and_status^ [fc_count]^.average_age,
                10, FALSE, str, status);
          put_display_line ('    Average_Age_of_Files', str.value (1, str.size));
          clp$convert_integer_to_string (forms_codes_and_status^ [fc_count]^.file_count,
                10, FALSE, str, status);
          put_display_line ('    File_Count', str.value (1, str.size));
          clp$convert_integer_to_string (forms_codes_and_status^ [fc_count]^.total_size,
                10, FALSE, str, status);
          put_display_line ('    Total_File_Size', str.value (1, str.size));
        FOREND;
      IFEND;
    IFEND;


  PROCEND display_queue_status;

?? TITLE := '  put_parameter', EJECT ??

{
{   Procedure to put a parameter into a message to be sent to SCFS.
{

  PROCEDURE put_parameter (parameter_kind: 0 .. 07f(16);
        parameter_value: ^CELL;
        parameter_size: nft$message_length);

    VAR
      param_type: ^nft$parameter_type,
      param_length: ^nft$parameter_value_length,
      param_length_size: nft$message_length,
      value_ptr: ^STRING (nfc$maximum_message_length),
      param_val: ^STRING (*),
      ignore_status: ost$status;


    NEXT param_type IN message;
    param_type^.length_indicated := (parameter_size > 1);
    param_type^.param := parameter_kind;
    message_length := message_length + 1;
    IF parameter_size > 1 THEN
      nfp$put_parameter_value_length (parameter_size, message, param_length_size, ignore_status);
      message_length := message_length + param_length_size;
    IFEND;
    NEXT param_val: [parameter_size] IN message;
    value_ptr := parameter_value;
    #UNCHECKED_CONVERSION (value_ptr^ (1, parameter_size), param_val^);
    message_length := message_length + parameter_size;
  PROCEND put_parameter;

?? TITLE := '  put_string_parameter', EJECT ??

{
{   Procedure to put a string type parameter into a message to be sent to SCFS.
{

  PROCEDURE put_string_parameter (parameter_kind: 0 .. 07f(16);
        parameter_value: STRING (* <= nfc$maximum_message_length));

    VAR
      length: 0 .. nfc$maximum_message_length;


    length := stringsize (parameter_value);
    IF length = 0 THEN
      length := 1;
    IFEND;
    put_parameter (parameter_kind, ^parameter_value, length);

  PROCEND put_string_parameter;

?? TITLE := '  put_null_parameter', EJECT ??

{
{   Procedure to add a null parameter type to the end of a message to be sent to SCFS.
{

  PROCEDURE put_null_parameter;

    CONST
      null_parameter = 0;

    VAR
      param_type: ^nft$parameter_type;


    NEXT param_type IN message;
    param_type^.length_indicated := FALSE;
    param_type^.param := null_parameter;
    message_length := message_length + 1;
  PROCEND put_null_parameter;

?? TITLE := '  get_parameter_length', EJECT ??

{
{   This procedure obtains the length of the next parameter value
{   in the message buffer from SCFS.  The length field, if
{   indicated, should be the next element in the message sequence.
{

  PROCEDURE get_parameter_length (length_indicated: BOOLEAN;
    VAR length: INTEGER);

    VAR
      param_length: ^nft$parameter_value_length,
      ignore_status: ost$status;


    IF length_indicated THEN
      nfp$get_parameter_value_length (message, msg_byte_count, length, ignore_status);
    ELSE
      length := 1;
    IFEND;
    msg_byte_count := msg_byte_count - length;

  PROCEND get_parameter_length;

?? TITLE := '  [INLINE] get_message_type', EJECT ??

{
{   Inline code to get the message type from the beginning of a
{   message received from SCFS.
{

  PROCEDURE [INLINE] get_message_type;


    RESET message;
    NEXT message_type IN message;
    msg_byte_count := message_length - 1;

  PROCEND get_message_type;

?? TITLE := '  [INLINE] put_message_type', EJECT ??

{
{   Inline code to initialize the message buffer to be sent to
{   SCFS by storing the specified message type at the beginning.
{

  PROCEDURE [INLINE] put_message_type (msg_type: nft$message_kind);


    RESET message;
    NEXT message_type IN message;
    message_type^ := msg_type;
    message_length := 1;

  PROCEND put_message_type;

?? TITLE := '  [INLINE] get_parameter_type', EJECT ??

{
{   Inline code to get the next parameter type from a
{   message received from SCFS.
{

  PROCEDURE [INLINE] get_parameter_type (VAR param: ^CELL);


    NEXT param IN message;
    msg_byte_count := msg_byte_count - 1;

  PROCEND get_parameter_type;

?? TITLE := '  stringsize', EJECT ??

{
{   Function to determine the length of a string, excluding trailing blanks.
{

  FUNCTION stringsize (str: string ( * )): integer;

    VAR
      str_length: ost$string_size;

    str_length := STRLENGTH (str);
    WHILE (str_length > 0) AND (str (str_length) = ' ') DO
      str_length := str_length - 1;
    WHILEND;
    stringsize := str_length;

  FUNCEND stringsize;

MODEND nfm$operate_station;
