?? TITLE := 'QUEUE FILE TRANSFER FACILITY INITIATOR' ??

?? LEFT := 1, RIGHT := 110 ??
?? FMT (FORMAT := ON, INDENT := 2) ??
?? SET (LIST := ON, LISTCTS := OFF) ??
MODULE nfm$qtf_initiator;

{  PURPOSE:
{             This module does the actual transfer of a queue file.  It only
{             transfers one file at a time but may transfer several files over
{             a connection in succession.  It may also use several connections
{             in succession.  QTFI gets what connection to use and file to
{             transfer from the parent task, QTFC.
{
{  ALGORITHM:
{             Set up communication with parent task through job local queues.
{
{             Loop waiting for messages using osp$i_await_activity_completion.
{               Get message from job local queue.
{               For each message kind:
{               - file transfer message:
{                 Transfer file.
{
{               - connection termination message:
{                 Terminate connection.
{
{               - task termination message:
{                 Ready task for termination.
{                 Exit.
{
{               - any other message kind
{                 Communication error with parent task.
{

?? EJECT ??
*copyc osc$queue_transfer_client
*copyc ost$status
*copyc osv$lower_to_upper
*copyc nft$intertask_message
*copyc nft$transfer_modes

*copyc amp$change_file_attributes
*copyc amp$put_next
*copyc amp$return
*copyc clp$convert_integer_to_string
*copyc clp$trimmed_string_size
*copyc fsp$close_file
*copyc fsp$open_file
*copyc jmp$emit_communication_stat
*copyc jmp$get_attribute_defaults
*copyc jmp$open_input_file
*copyc jmp$open_output_file
*copyc jmp$open_qfile
*copyc jmp$print_file
*copyc nap$await_server_response
*copyc nap$get_attributes
*copyc nap$store_attributes
*copyc nfc$external_characteristic_a9
*copyc nfc$normal_string
*copyc nfc$parameter_29_definitions
*copyc nfc$parameter_31_definitions
*copyc nfc$parameter_32_definitions
*copyc nfc$parameter_33_definitions
*copyc nfc$qtf_name_constants
*copyc nfe$exception_condition_codes
*copyc nfp$begin_asynchronous_task
*copyc nfp$create_wait_queue_file_name
*copyc nfp$deallocate_dirs_from_head
*copyc nfp$end_async_communication
*copyc nfp$format_message_to_job_log
*copyc nfp$get_async_task_message
*copyc nfp$put_async_task_message
*copyc nfp$initialize_control_block
*copyc nfp$receive_command
*copyc nfp$send_command
*copyc nfp$send_queue_file
*copyc osp$i_await_activity_completion
*copyc osp$output_status_message
*copyc osp$set_status_abnormal
*copyc pmp$disestablish_cond_handler
*copyc pmp$establish_condition_handler
*copyc pmp$get_unique_name
*copyc pmp$log
*copyc pmp$wait
*copyc rfp$store
?? NEWTITLE := 'QTFI Module Global Variables', EJECT ??
*copyc nfv$qtf_parameter_rules
*copyc nfv$qtf_required_params_on_cmds

  CONST
    qtfi_tenth_of_a_second = 100,          {  This is in milliseconds.
    qtfi_unknown_job_name = 'XXXX';

  VAR
    qtfi_connection_file_name: amt$local_file_name := osc$null_name;

?? TITLE := 'end_and_finish_protocol', EJECT ??

{ PURPOSE:
{   This procedure is used to finish the protocol with the server
{   before terminating the connection.

  PROCEDURE end_and_finish_protocol
    (VAR control_block: nft$control_block);

    VAR
      etp_legal_resp_commands: nft$command_set,
      etp_parameter_set: nft$parameter_set,
      etpr_ignored_params: nft$parameter_set,
      etpr_modified_params: nft$parameter_set,
      etpr_received_params: nft$parameter_set,
      fini_parameter_set: nft$parameter_set,
      local_status: ost$status;

    local_status.normal := TRUE;

    etp_legal_resp_commands := $nft$command_set [nfc$etpr];
    etp_parameter_set := $nft$parameter_set [];
    fini_parameter_set := $nft$parameter_set [];

    nfp$send_command (nfc$etp, etp_parameter_set, $nft$parameter_set[ ], $nft$parameter_set[ ],
          control_block, local_status);
    IF local_status.normal THEN
      nfp$receive_command (etp_legal_resp_commands, nfv$qtf_required_params_on_cmds, control_block,
            etpr_received_params, etpr_ignored_params, etpr_modified_params, local_status);
      IF local_status.normal THEN
        nfp$send_command (nfc$fini, fini_parameter_set, $nft$parameter_set[ ], $nft$parameter_set[ ],
              control_block, local_status);
      IFEND;
    IFEND;

  PROCEND end_and_finish_protocol;
?? NEWTITLE := 'generate_error_file', EJECT ??

{ PURPOSE:
{   This procedure opens up and writes a listing file if a queue
{   file could not be transferred to the remote destination.  The
{   resulting listing file is sent back to the source destination
{   via QTF.

  PROCEDURE generate_error_file
    (    error_file: fst$file_reference;
         control_block: nft$control_block;
         qtf_file_descriptor: nft$application_file_descriptor;
     VAR status: ost$status);

    CONST
      comment_banner_line     = ' Comment_Banner        : ',
      destination_line        = ' Destination           : ',
      insertion_location  = 26,
      login_family_line       = ' Login_Family          : ',
      login_user_line         = ' Login_User            : ',
      output_destination_line = ' Output_Destination    : ',
      remote_host_dir_line    = ' Remote Host Directive : ',
      system_file_name_line   = ' System_File_Name      : ',
      system_job_name_line    = ' System_Job_Name       : ',
      user_file_name_line     = ' User_File_Name        : ',
      user_job_name_line      = ' User_Job_Name         : ';

    VAR
      byte_address: amt$file_byte_address,
      default_creation_attributes: ^fst$file_cycle_attributes,
      directive_entry: ^nft$directive_entry,
      error_file_id: amt$file_identifier,
      ignore_status: ost$status,
      output_text_line: string (insertion_location + osc$max_name_size);

    status.normal := TRUE;

    PUSH default_creation_attributes: [1 .. 4];

    default_creation_attributes^ [1].selector := fsc$file_contents_and_processor;
    default_creation_attributes^ [1].file_contents := amc$legible;
    default_creation_attributes^ [1].file_processor := amc$unknown_processor;

    default_creation_attributes^ [2].selector := fsc$page_length;
    default_creation_attributes^ [2].page_length := 60;

    default_creation_attributes^ [3].selector := fsc$page_width;
    default_creation_attributes^ [3].page_width := 132;

    default_creation_attributes^ [4].selector := fsc$page_format;
    default_creation_attributes^ [4].page_format := amc$burstable_form;

    fsp$open_file (error_file, amc$record, NIL, default_creation_attributes, NIL, NIL, NIL, error_file_id,
          status);
    IF status.normal THEN
      IF qtf_file_descriptor.file_kind = nfc$input_file THEN
        output_text_line := system_job_name_line;
        output_text_line(insertion_location, jmc$system_supplied_name_size) :=
            control_block.send_file_name.value;
        amp$put_next (error_file_id, ^output_text_line, #SIZE(output_text_line), byte_address, ignore_status);

        output_text_line := user_job_name_line;
        output_text_line(insertion_location, jmc$system_supplied_name_size) :=
            control_block.send_job_name.value;
        amp$put_next (error_file_id, ^output_text_line, #SIZE(output_text_line), byte_address, ignore_status);
      ELSEIF qtf_file_descriptor.file_kind = nfc$output_file THEN
        output_text_line := comment_banner_line;
        output_text_line(insertion_location, jmc$system_supplied_name_size) :=
            qtf_file_descriptor.output_descriptor.comment_banner;
        amp$put_next (error_file_id, ^output_text_line, #SIZE(output_text_line), byte_address, ignore_status);

        output_text_line := login_family_line;
        output_text_line(insertion_location, jmc$system_supplied_name_size) :=
            qtf_file_descriptor.output_descriptor.login_family;
        amp$put_next (error_file_id, ^output_text_line, #SIZE(output_text_line), byte_address, ignore_status);

        output_text_line := login_user_line;
        output_text_line(insertion_location, jmc$system_supplied_name_size) :=
            qtf_file_descriptor.output_descriptor.login_user;
        amp$put_next (error_file_id, ^output_text_line, #SIZE(output_text_line), byte_address, ignore_status);

        output_text_line := output_destination_line;
        output_text_line(insertion_location, jmc$system_supplied_name_size) :=
            qtf_file_descriptor.output_descriptor.output_destination;
        amp$put_next (error_file_id, ^output_text_line, #SIZE(output_text_line), byte_address, ignore_status);

        output_text_line := system_file_name_line;
        output_text_line(insertion_location, jmc$system_supplied_name_size) :=
            control_block.send_file_name.value;
        amp$put_next (error_file_id, ^output_text_line, #SIZE(output_text_line), byte_address, ignore_status);

        output_text_line := user_file_name_line;
        output_text_line(insertion_location, jmc$system_supplied_name_size) :=
            control_block.send_job_name.value;
        amp$put_next (error_file_id, ^output_text_line, #SIZE(output_text_line), byte_address, ignore_status);

        output_text_line := user_job_name_line;
        output_text_line(insertion_location, jmc$system_supplied_name_size) :=
            qtf_file_descriptor.output_descriptor.user_job_name;

        amp$put_next (error_file_id, ^output_text_line, #SIZE(output_text_line), byte_address, ignore_status);
      ELSE { generic queue file.

        output_text_line := destination_line;
        output_text_line(insertion_location, osc$max_name_size) :=
              qtf_file_descriptor.generic_descriptor.destination;
        amp$put_next (error_file_id, ^output_text_line, #SIZE(output_text_line), byte_address, ignore_status);

        output_text_line := remote_host_dir_line;
        output_text_line(insertion_location,
              qtf_file_descriptor.generic_descriptor.remote_host_directive.size) :=
              qtf_file_descriptor.generic_descriptor.remote_host_directive.parameters;
        amp$put_next (error_file_id, ^output_text_line, #SIZE(output_text_line), byte_address, ignore_status);

        output_text_line := system_file_name_line;
        output_text_line(insertion_location, jmc$system_supplied_name_size) :=
            control_block.send_file_name.value;
        amp$put_next (error_file_id, ^output_text_line, #SIZE(output_text_line), byte_address, ignore_status);

      IFEND;
      output_text_line := '  ';
      amp$put_next (error_file_id, ^output_text_line, #SIZE(output_text_line), byte_address, ignore_status);

      directive_entry := control_block.received_operator_messages.head;
      WHILE directive_entry <> NIL DO
        amp$put_next (error_file_id, ^directive_entry^.line, #SIZE (directive_entry^.line), byte_address,
                ignore_status);
        directive_entry := directive_entry^.link;
      WHILEND;

      directive_entry := control_block.received_user_messages.head;
      WHILE directive_entry <> NIL DO
        amp$put_next (error_file_id, ^directive_entry^.line, #SIZE (directive_entry^.line), byte_address,
              ignore_status);
        directive_entry := directive_entry^.link;
      WHILEND;

      osp$output_status_message (error_file_id, osc$full_message_level, osc$standard_status_message_hdr,
            control_block.state_of_transfer, ignore_status);

      fsp$close_file (error_file_id, status);
    IFEND;

  PROCEND generate_error_file;
?? TITLE := 'print_output_error_file', EJECT ??

{ PURPOSE:
{   This procedure is called when a queue file could not be
{   transferred to the remote destination or the job could not
{   execute on the remote destination.  An output queue file is
{   generated and sent back to the user on the originating system.

  PROCEDURE print_output_error_file
    (    qtf_file_descriptor: nft$application_file_descriptor;
         control_block: nft$control_block);

    CONST
      min_print_options = 1,
      max_generic_options = 8,
      max_print_options = 23;

    VAR
      comment_banner: jmt$output_comment_banner,
      control_family: ost$name,
      control_user: ost$name,
      default_attributes: ^jmt$default_attribute_results,
      device: jmt$output_device,
      error_file: ^fst$file_reference,
      external_characteristics: jmt$external_characteristics,
      forms_code: jmt$forms_code,
      generate_unique_name: boolean,
      local_status: ost$status,
      new_file_attributes: ^amt$file_attributes,
      operator_family: ost$name,
      originating_account: avt$account_name,
      originating_family: ost$name,
      originating_project: avt$project_name,
      originating_user: ost$name,
      output_destination: ost$name,
      output_destination_usage: jmt$destination_usage,
      output_priority: jmt$output_priority,
      print_file_options: ^jmt$output_submission_options,
      routing_banner: jmt$output_routing_banner,
      source_logical_id: jmt$source_logical_id,
      station: jmt$station,
      station_operator: jmt$station_operator,
      system_file_name: jmt$system_supplied_name,
      unique_name: ost$name,
      user_file_name: jmt$user_supplied_name,
      user_information: jmt$user_information,
      user_job_name: jmt$user_supplied_name,
      vfu_load_procedure: jmt$vfu_load_procedure,
      wait_queue_file_name: amt$local_file_name;

?? OLDTITLE, EJECT ??
    local_status.normal := TRUE;

    generate_unique_name := TRUE;
    IF (qtf_file_descriptor.file_kind = nfc$input_file) AND
          (qtf_file_descriptor.input_descriptor.output_disposition.key = jmc$wait_queue_path) THEN
      IF qtf_file_descriptor.input_descriptor.user_job_name <> osc$null_name THEN
        user_job_name := qtf_file_descriptor.input_descriptor.user_job_name;
      ELSE
        user_job_name := qtfi_unknown_job_name;
      IFEND;
      nfp$create_wait_queue_file_name (qtf_file_descriptor.input_descriptor.control_family,
            qtf_file_descriptor.input_descriptor.control_user, user_job_name,
            wait_queue_file_name, local_status);
      generate_unique_name := NOT local_status.normal;
      error_file := ^wait_queue_file_name;
    IFEND;
    IF generate_unique_name THEN
      pmp$get_unique_name (unique_name, local_status);
      error_file := ^unique_name;
    IFEND;

    generate_error_file (error_file^, control_block, qtf_file_descriptor, local_status);

{ IF generate_unique_name is FALSE, the error file would have been created in
{ the user's $wait_queue and there is no reason to print the file.

    IF (NOT local_status.normal) OR (NOT generate_unique_name) THEN
      PUSH new_file_attributes: [1..1];
      new_file_attributes^ [1].key := amc$ring_attributes;
      new_file_attributes^ [1].ring_attributes.r1 := osc$user_ring;
      new_file_attributes^ [1].ring_attributes.r2 := osc$user_ring;
      new_file_attributes^ [1].ring_attributes.r3 := osc$user_ring;

      amp$change_file_attributes(error_file^, new_file_attributes, local_status);
      IF NOT local_status.normal THEN
        nfp$format_message_to_job_log(local_status);
        pmp$log('***QTF Initiator: Error changing ring attributes of wait queue file.', local_status);
      IFEND;

      amp$return (error_file^, local_status);
      RETURN;
    IFEND;

    IF qtf_file_descriptor.file_kind = nfc$generic_file THEN
      PUSH print_file_options: [min_print_options .. max_generic_options];
      print_file_options^ [1].key := jmc$comment_banner;
      print_file_options^ [1].comment_banner := 'QTF/VE Error Report';

      print_file_options^ [2].key := jmc$output_destination;
      print_file_options^ [2].output_destination := qtf_file_descriptor.generic_descriptor.destination;

      print_file_options^ [3].key := jmc$output_destination_usage;
      print_file_options^ [3].output_destination_usage := jmc$qtf_usage;

      print_file_options^ [4].key := jmc$origin_application_name;
      print_file_options^ [4].origin_application_name := osc$queue_transfer_client;

      print_file_options^ [5].key := jmc$routing_banner;
      print_file_options^ [5].routing_banner := 'QTF/VE Error Report';

      print_file_options^ [6].key := jmc$user_file_name;
      print_file_options^ [6].user_file_name := 'OUTPUT';

      print_file_options^ [7].key := jmc$user_job_name;
      print_file_options^ [7].user_job_name := qtf_file_descriptor.generic_descriptor.system_file_name;

      print_file_options^ [8].key := jmc$source_logical_id;
      print_file_options^ [8].source_logical_id := control_block.transfer_pid;
    ELSE
      PUSH print_file_options: [min_print_options .. max_print_options];
      print_file_options^ [1].key := jmc$implicit_routing_text;

      IF qtf_file_descriptor.file_kind = nfc$output_file THEN
        comment_banner := qtf_file_descriptor.output_descriptor.comment_banner;
        control_family := qtf_file_descriptor.output_descriptor.control_family;
        control_user := qtf_file_descriptor.output_descriptor.control_user;
        device := qtf_file_descriptor.output_descriptor.device;
        external_characteristics := qtf_file_descriptor.output_descriptor.external_characteristics;
        forms_code := qtf_file_descriptor.output_descriptor.forms_code;
        operator_family := qtf_file_descriptor.output_descriptor.output_destination_family;
        originating_family := qtf_file_descriptor.output_descriptor.login_family;
        originating_user := qtf_file_descriptor.output_descriptor.login_user;
        originating_account := qtf_file_descriptor.output_descriptor.login_account;
        originating_project := qtf_file_descriptor.output_descriptor.login_project;
        output_destination := qtf_file_descriptor.output_descriptor.output_destination;
        output_priority := qtf_file_descriptor.output_descriptor.output_priority;
        routing_banner := qtf_file_descriptor.output_descriptor.routing_banner;
        source_logical_id := qtf_file_descriptor.output_descriptor.source_logical_id;
        station := qtf_file_descriptor.output_descriptor.station;
        station_operator := qtf_file_descriptor.output_descriptor.station_operator;
        user_file_name := qtf_file_descriptor.output_descriptor.user_file_name;
        user_information := qtf_file_descriptor.output_descriptor.user_information;
        user_job_name := qtf_file_descriptor.output_descriptor.user_job_name;
        vfu_load_procedure := qtf_file_descriptor.output_descriptor.vfu_load_procedure;

        print_file_options^ [1].implicit_routing_text := ^qtf_file_descriptor.output_descriptor.
              implicit_routing_text;

      ELSEIF qtf_file_descriptor.file_kind = nfc$input_file THEN
        comment_banner := qtf_file_descriptor.input_descriptor.comment_banner;
        control_family := qtf_file_descriptor.input_descriptor.control_family;
        control_user := qtf_file_descriptor.input_descriptor.control_user;
        device := qtf_file_descriptor.input_descriptor.device;
        external_characteristics := qtf_file_descriptor.input_descriptor.external_characteristics;
        forms_code := qtf_file_descriptor.input_descriptor.forms_code;
        operator_family := qtf_file_descriptor.input_descriptor.output_destination_family;
        originating_family := qtf_file_descriptor.input_descriptor.originating_login_family;
        originating_user := qtf_file_descriptor.input_descriptor.originating_login_user;
        originating_account := qtf_file_descriptor.input_descriptor.originating_login_account;
        originating_project := qtf_file_descriptor.input_descriptor.originating_login_project;
        output_destination := qtf_file_descriptor.input_descriptor.output_destination;
        output_destination_usage := qtf_file_descriptor.input_descriptor.output_destination_usage;
        output_priority := qtf_file_descriptor.input_descriptor.output_priority;
        routing_banner := qtf_file_descriptor.input_descriptor.routing_banner;
        source_logical_id := qtf_file_descriptor.input_descriptor.source_logical_id;
        station := qtf_file_descriptor.input_descriptor.station;
        station_operator := qtf_file_descriptor.input_descriptor.station_operator;
        user_file_name := 'OUTPUT';
        user_information := qtf_file_descriptor.input_descriptor.user_information;
        user_job_name := qtf_file_descriptor.input_descriptor.user_job_name;
        vfu_load_procedure := qtf_file_descriptor.input_descriptor.vfu_load_procedure;

        print_file_options^ [1].implicit_routing_text := ^qtf_file_descriptor.input_descriptor.
              implicit_routing_text;
      IFEND;

      print_file_options^ [2].key := jmc$output_destination_usage;
      print_file_options^ [3].key := jmc$station;

      IF source_logical_id <> osc$null_name THEN
        print_file_options^ [2].output_destination_usage := jmc$qtf_usage;
        print_file_options^ [3].station := station;
      ELSEIF qtf_file_descriptor.file_kind = nfc$input_file THEN
        print_file_options^ [2].output_destination_usage := output_destination_usage;
        print_file_options^ [3].station := station;
      ELSEIF qtf_file_descriptor.file_kind = nfc$output_file THEN
        PUSH default_attributes: [1 .. 2];
        default_attributes^[1].key := jmc$output_destination_usage;
        default_attributes^[2].key := jmc$station;

        jmp$get_attribute_defaults (jmc$batch, default_attributes, local_status);
        IF local_status.normal THEN
          print_file_options^ [2].output_destination_usage := default_attributes^[1].output_destination_usage;
          print_file_options^ [3].station := default_attributes^[2].station;
        IFEND;
      IFEND;

      print_file_options^ [4].key := jmc$output_destination_family;
      print_file_options^ [4].output_destination_family := operator_family;

      print_file_options^ [5].key := jmc$control_family;
      print_file_options^ [5].control_family := control_family;

      print_file_options^ [6].key := jmc$control_user;
      print_file_options^ [6].control_user := control_user;

      print_file_options^ [7].key := jmc$login_family;
      print_file_options^ [7].login_family := originating_family;

      print_file_options^ [8].key := jmc$login_user;
      print_file_options^ [8].login_user := originating_user;

      print_file_options^ [9].key := jmc$login_account;
      print_file_options^ [9].login_account := originating_account;

      print_file_options^ [10].key := jmc$login_project;
      print_file_options^ [10].login_project := originating_project;

      print_file_options^ [11].key := jmc$comment_banner;
      print_file_options^ [11].comment_banner := comment_banner;

      print_file_options^ [12].key := jmc$routing_banner;
      print_file_options^ [12].routing_banner := routing_banner;

      print_file_options^ [13].key := jmc$output_destination;
      IF source_logical_id <> osc$null_name THEN
        print_file_options^ [13].output_destination := source_logical_id;
      ELSE
        print_file_options^ [13].output_destination := output_destination;
      IFEND;

      print_file_options^ [14].key := jmc$station_operator;
      print_file_options^ [14].station_operator := station_operator;

      print_file_options^ [15].key := jmc$user_job_name;
      print_file_options^ [15].user_job_name := user_job_name;

      print_file_options^ [16].key := jmc$device;
      print_file_options^ [16].device := device;

      print_file_options^ [17].key := jmc$external_characteristics;
      print_file_options^ [17].external_characteristics := external_characteristics;

      print_file_options^ [18].key := jmc$forms_code;
      print_file_options^ [18].forms_code := forms_code;

      print_file_options^ [19].key := jmc$output_priority;
      print_file_options^ [19].output_priority := output_priority;

      print_file_options^ [20].key := jmc$user_information;
      print_file_options^ [20].user_information := ^user_information;

      print_file_options^ [21].key := jmc$user_file_name;
      print_file_options^ [21].user_file_name := user_file_name;

      print_file_options^ [22].key := jmc$vfu_load_procedure;
      print_file_options^ [22].vfu_load_procedure := vfu_load_procedure;

      print_file_options^ [23].key := jmc$origin_application_name;
      print_file_options^ [23].origin_application_name := osc$queue_transfer_client;
    IFEND;


    jmp$print_file (error_file^, print_file_options, system_file_name, local_status);

    amp$return (error_file^, local_status);

  PROCEND print_output_error_file;
?? TITLE := 'retry_print_output_error_file', EJECT ??

{ PURPOSE:
{   This procedure is called if the error listing printed by
{   print_output_error_file fails to transfer. The name of the
{   error listing is changed from OUTPUT to QTFERR to allow
{   QTFI to distinguish between error listings queued from this
{   procedure, and those queued from print_output_error_file.
{   The attributes of the new error listing default mainly from
{   the job attributes of the system job where QTFI executes.

  PROCEDURE retry_print_output_error_file
    (    qtf_file_descriptor: nft$application_file_descriptor;
         control_block: nft$control_block);

    CONST
      min_retry_print_options = 1,
      max_retry_print_options = 16;

    VAR
      error_file: ^fst$file_reference,
      local_status: ost$status,
      print_file_options: ^jmt$output_submission_options,
      system_file_name : jmt$system_supplied_name,
      unique_name: ost$name;

    local_status.normal := TRUE;

    pmp$get_unique_name (unique_name, local_status);
    error_file := ^unique_name;

    generate_error_file (error_file^, control_block, qtf_file_descriptor, local_status);

    IF (NOT local_status.normal) THEN
      amp$return (error_file^, local_status);
      RETURN;
    IFEND;

    PUSH print_file_options: [min_retry_print_options .. max_retry_print_options];

    print_file_options^ [1].key := jmc$comment_banner;
    print_file_options^ [1].comment_banner := qtf_file_descriptor.output_descriptor.login_user;

    print_file_options^ [2].key := jmc$control_family;
    print_file_options^ [2].control_family := qtf_file_descriptor.output_descriptor.control_family;

    print_file_options^ [3].key := jmc$control_user;
    print_file_options^ [3].control_user := qtf_file_descriptor.output_descriptor.control_user;

    print_file_options^ [4].key := jmc$login_account;
    print_file_options^ [4].login_account := qtf_file_descriptor.output_descriptor.login_account;

    print_file_options^ [5].key := jmc$login_family;
    print_file_options^ [5].login_family := qtf_file_descriptor.output_descriptor.login_family;

    print_file_options^ [6].key := jmc$login_project;
    print_file_options^ [6].login_project := qtf_file_descriptor.output_descriptor.login_project;

    print_file_options^ [7].key := jmc$login_user;
    print_file_options^ [7].login_user := qtf_file_descriptor.output_descriptor.login_user;

    print_file_options^ [8].key := jmc$origin_application_name;
    print_file_options^ [8].origin_application_name := osc$queue_transfer_client;

    print_file_options^ [9].key := jmc$output_destination_family;
    print_file_options^ [9].output_destination_family :=
        qtf_file_descriptor.output_descriptor.output_destination_family;

    print_file_options^ [10].key := jmc$output_priority;
    print_file_options^ [10].output_priority := qtf_file_descriptor.output_descriptor.output_priority;

    print_file_options^ [11].key := jmc$routing_banner;
    print_file_options^ [11].routing_banner := qtf_file_descriptor.output_descriptor.login_user;

    print_file_options^ [12].key := jmc$station_operator;
    print_file_options^ [12].station_operator := qtf_file_descriptor.output_descriptor.station_operator;

    print_file_options^ [13].key := jmc$user_file_name;
    print_file_options^ [13].user_file_name := 'QTFERR';

    print_file_options^ [14].key := jmc$user_information;
    print_file_options^ [14].user_information := ^qtf_file_descriptor.output_descriptor.user_information;

    print_file_options^ [15].key := jmc$user_job_name;
    print_file_options^ [15].user_job_name := 'QTFERR';

    print_file_options^ [16].key := jmc$vfu_load_procedure;
    print_file_options^ [16].vfu_load_procedure := qtf_file_descriptor.output_descriptor.vfu_load_procedure;

    jmp$print_file (error_file^, print_file_options, system_file_name, local_status);

    amp$return (error_file^, local_status);

  PROCEND retry_print_output_error_file;
?? TITLE := 'ready_task_for_termination', EJECT ??

{ PURPOSE:
{   This procedure makes sure everything is cleaned up so the task
{   can go down with expected results.  The QTFC task issued the
{   message to QTFI and QTFC is expecting a normal termination.

  PROCEDURE ready_task_for_termination
    (    qtfc_task_id: pmt$task_id;
         control_block: nft$control_block);

    VAR
      local_status: ost$status,
      retry_count: 0 .. 10,
      task_terminated_msg: nft$intertask_message;


    task_terminated_msg.kind := nfc$qtf_task_terminated;
    nfp$put_async_task_message (qtfc_task_id, ^task_terminated_msg, #SIZE (task_terminated_msg),
          local_status);

    retry_count := 0;
    REPEAT
      nfp$end_async_communication (TRUE, local_status);
      IF NOT local_status.normal THEN

{ QTFI should wait for 100 milliseconds.  This is done to insure that the
{ last message sent was picked up by QTFC.

        pmp$wait (qtfi_tenth_of_a_second, qtfi_tenth_of_a_second);
      IFEND;
      retry_count := retry_count + 1;
    UNTIL local_status.normal OR (retry_count = 10);

{ This makes sure that QTFI will end communication with QTFC and terminate.
{ If QTFI can't end communications, this assumes that QTFC is going down and is
{ not able to talk to QTFI.

    IF retry_count = 10 THEN
      nfp$end_async_communication (FALSE, local_status);
    IFEND;

    IF control_block.path.path_connected THEN
      fsp$close_file (control_block.path.network_file_id, local_status);
    IFEND;

  PROCEND ready_task_for_termination;
?? TITLE := 'stop_transfer_protocol', EJECT ??

{ PURPOSE:
{   This procedure is used to finish the transfer protocol with the
{   server, indicating a file transfer is completed.

  PROCEDURE stop_transfer_protocol
    (    qtf_file_descriptor: nft$application_file_descriptor;
     VAR control_block: nft$control_block;
     VAR status: ost$status);

    VAR
      local_status: ost$status,
      stop_legal_resp_commands: nft$command_set,
      stop_parameter_set: nft$parameter_set,
      stopr_ignored_params: nft$parameter_set,
      stopr_modified_params: nft$parameter_set,
      stopr_received_params: nft$parameter_set;


    status.normal := TRUE;

    stop_legal_resp_commands := $nft$command_set [nfc$stopr];
    stop_parameter_set := $nft$parameter_set [nfc$state_of_transfer];

    IF control_block.path.path_connected THEN
      nfp$send_command (nfc$stop, stop_parameter_set, $nft$parameter_set[ ],
            $nft$parameter_set[ ], control_block, status);
      IF status.normal THEN
        nfp$receive_command (stop_legal_resp_commands, nfv$qtf_required_params_on_cmds, control_block,
              stopr_received_params, stopr_ignored_params, stopr_modified_params, status);
      IFEND;
    IFEND;
    IF (NOT control_block.state_of_transfer.normal) AND
       NOT ((control_block.state_of_transfer.condition = nfe$receiver_problem_retry)
        OR (control_block.state_of_transfer.condition = nfe$sender_problem_retry)) AND
       NOT(control_block.negotiate_protocol) THEN

      IF qtf_file_descriptor.file_kind = nfc$output_file THEN
        IF (qtf_file_descriptor.output_descriptor.originating_application_name <>
           osc$queue_transfer_client) THEN

{ QTFI has NOT generated this file as an error listing. Generate an error listing for the first time.

          print_output_error_file (qtf_file_descriptor, control_block);

        ELSE { file_kind = nfc$output_file AND originating_application = osc$queue_transfer_client

{ QTFI has generated this file as an error listing and this file failed to transfer.
{ If the user_file_name of this file is NOT QTFERR, then make a second attempt to
{ generate & print an error listing. IF user_file_name is QTFERR, then this file is
{ QTFI's second attempt to print an error-listing. QTFI will not attempt a third listing.

          IF qtf_file_descriptor.output_descriptor.user_file_name(1,6) <> 'QTFERR' THEN
            retry_print_output_error_file (qtf_file_descriptor, control_block);
          ELSE
            pmp$log ('***QTFI, STOP_TRANSFER_PROTOCOL: unable to transfer file or error listing.',
              local_status);
          IFEND;

        IFEND;
      ELSE { (file_kind = nfc$input_file) OR (file_kind = nfc$generic_file)
        print_output_error_file (qtf_file_descriptor, control_block);
      IFEND;
    IFEND;
    IF (control_block.received_operator_messages.head <> NIL) THEN
      nfp$deallocate_dirs_from_head( control_block.received_operator_messages, local_status);
    IFEND;
    IF (control_block.received_user_messages.head <> NIL) THEN
      nfp$deallocate_dirs_from_head( control_block.received_user_messages, local_status);
    IFEND;

  PROCEND  stop_transfer_protocol;
?? TITLE := 'terminate_connection', EJECT ??

{ PURPOSE:
{   This procedure is called when the current connection is no longer
{   needed.  The connection file is closed but not returned.  QTFC
{   will return the connection.
{
{ NOTE:
{   qtfi_connection_file_name is a global variable.

  PROCEDURE terminate_connection
    (    qtfc_task_id: pmt$task_id;
         connection_file_name: amt$local_file_name;
     VAR control_block: nft$control_block);

    VAR
      connection_terminated_msg: nft$intertask_message,
      local_status: ost$status;


    local_status.normal := TRUE;

    IF (control_block.path.network_file <> NIL) AND (connection_file_name =
          control_block.path.network_file^) AND control_block.path.path_connected THEN
      end_and_finish_protocol (control_block);
      qtfi_connection_file_name := osc$null_name;
      control_block.transfer_pid := osc$null_name;
      control_block.path.network_file := NIL;
      control_block.path.path_connected := FALSE;
      fsp$close_file (control_block.path.network_file_id, local_status);
    IFEND;

    connection_terminated_msg.kind := nfc$qtf_connection_terminated;
    nfp$put_async_task_message (qtfc_task_id, ^connection_terminated_msg, #SIZE (connection_terminated_msg),
          local_status);

  PROCEND terminate_connection;
?? TITLE := 'transfer_file', EJECT ??

{ PURPOSE:
{   This procedure does most of the work to transfer a file.  If the
{   file transfer does not complete normally and the file is an
{   output file, QTFI will create an error listing and submit it to
{   be printed at the source mainframe.

  PROCEDURE transfer_file
    (    qtfc_task_id: pmt$task_id;
         file_transfer_msg: nft$intertask_message;
     VAR control_block: nft$control_block;
     VAR status: ost$status);

    VAR
      consistent_protocol_state: boolean,
      open_access_level: amt$access_level,
      queue_file_identifier: amt$file_identifier,
      stop_transfer_status: ost$status,
      system_file_name: jmt$system_supplied_name,
      transfer_mode: nft$transfer_modes,
      transfer_status_msg: nft$intertask_message;

?? NEWTITLE := 'generate_qtf_statistic', EJECT ??
{
{     The purpose of this request is to emit the origin QTF statistic.
{
{       GENERATE_QTF_STATISTIC(FILE_DESCRIPTOR,SOURCE_LOGICAL_IDENTIFIER,
{            TRANSFER_LOGICAL_IDENTIFIER)
{
{ FILE_DESCRIPTOR : (input) Attributes of queue file.
{
{ SOURCE_LOGICAL_IDENTIFIER : (input) Initiating mainframe name.
{
{ TRANSFER_LOGICAL_IDENTIFIER : (input) Received mainframe name.
{
    PROCEDURE generate_qtf_statistic
      (      file_descriptor: nft$application_file_descriptor;
             source_logical_identifier: string(*<=nfc$p24_max_param_size);
             transfer_logical_identifier: string(*<=nfc$p24_max_param_size));

 VAR
      local_status: ost$status,
      qtf_statistic: jmt$qtf_statistic_data,
      statistic_data: jmt$comm_acct_statistic_data;

{ If the source lid is set, this is a store and forward case, no stat.

    IF (file_descriptor.file_kind = nfc$output_file) THEN
      IF (file_descriptor.output_descriptor.source_logical_id <> '') THEN
        RETURN;
      ELSE
        qtf_statistic.user_identification.user :=
             file_descriptor.output_descriptor.login_user;
        qtf_statistic.user_identification.family :=
             file_descriptor.output_descriptor.login_family;
        qtf_statistic.account_name :=
             file_descriptor.output_descriptor.login_account;
        qtf_statistic.project_name :=
             file_descriptor.output_descriptor.login_project;

{ Output file statistic uses system_job_name and user_file_name for
{ tracking purposes.

        qtf_statistic.system_job_name :=
             file_descriptor.output_descriptor.system_job_name;
        qtf_statistic.user_job_name :=
             file_descriptor.output_descriptor.user_file_name;
        qtf_statistic.file_size :=
             file_descriptor.output_descriptor.file_size;
        qtf_statistic.origin_mainframe_name :=
             source_logical_identifier;
        qtf_statistic.dest_mainframe_name :=
             transfer_logical_identifier;
      IFEND;
    ELSEIF (file_descriptor.file_kind = nfc$input_file) THEN
      IF (file_descriptor.input_descriptor.source_logical_id <> '') THEN
        RETURN;
      ELSE
        qtf_statistic.user_identification.user :=
             file_descriptor.input_descriptor.originating_login_user;
        qtf_statistic.user_identification.family :=
             file_descriptor.input_descriptor.originating_login_family;
        qtf_statistic.account_name :=
             file_descriptor.input_descriptor.originating_login_account;
        qtf_statistic.project_name :=
             file_descriptor.input_descriptor.originating_login_project;
        qtf_statistic.system_job_name :=
             file_descriptor.input_descriptor.originating_system_job_name;
        qtf_statistic.user_job_name :=
             file_descriptor.input_descriptor.user_job_name;
        qtf_statistic.file_size :=
             file_descriptor.input_descriptor.job_size;
        qtf_statistic.origin_mainframe_name :=
             source_logical_identifier;
        qtf_statistic.dest_mainframe_name :=
             transfer_logical_identifier;
      IFEND;
    ELSE
      osp$set_status_abnormal( nfc$status_id, nfe$bts_internal_error,
             'QTF_INITIATOR - generate_qtf_statistic, bad file_kind',
             local_status );
      nfp$format_message_to_job_log( local_status );
    IFEND;

    statistic_data.statistic_id := jmc$ca_origin_qf_transfer;
    statistic_data.origin_queue_file_transfer := ^qtf_statistic;
    jmp$emit_communication_stat( statistic_data );

    PROCEND generate_qtf_statistic;
?? OLDTITLE ??
?? NEWTITLE := 'negotiate_file_transfer', EJECT ??

{ PURPOSE:
{   This procedure does the file transfer negotiation.  It sets up
{   the RFT and receives the RPOS.  These two protocol commands are
{   considered the file transfer negotiation.

    PROCEDURE negotiate_file_transfer
      (    transfer_file_descriptor: nft$application_file_descriptor;
       VAR control_block: nft$control_block;
       VAR transfer_mode: nft$transfer_modes;
       VAR status: ost$status);

      VAR
        go_parameter_set: nft$parameter_set,
        rft_legal_resp_commands: nft$command_set,
        rft_parameter_set: nft$parameter_set,
        rpos_ignored_params: nft$parameter_set,
        rpos_modified_params: nft$parameter_set,
        rpos_received_params: nft$parameter_set;

?? NEWTITLE := 'set_transfer_mode', EJECT ??

{ PURPOSE:
{   This function will determine what the transfer mode should be
{   given the data declaration set in the protocol negotiation.

      FUNCTION set_transfer_mode
        (    transfer_file_descriptor: nft$application_file_descriptor;
             rft_parameters: nft$parameter_set;
             rpos_received_parameters: nft$parameter_set;
             rpos_modified_parameters: nft$parameter_set;
             control_block: nft$control_block): nft$transfer_modes;

        VAR
          data_mode: jmt$data_mode;


        IF control_block.data_declaration = nfc$p31_host_dependent_uh THEN
          set_transfer_mode := nfc$ve_to_ve_mode;
        ELSEIF control_block.data_declaration = nfc$p31_undef_unstructured_uu THEN
          set_transfer_mode := nfc$transparent_data_mode;
        ELSEIF control_block.data_declaration = nfc$p31_undefined_structured_us THEN
          set_transfer_mode := nfc$rhf_structured_mode;
        ELSEIF (control_block.data_declaration = nfc$p31_ascii_c6) OR
              (control_block.data_declaration = nfc$p31_ascii_c8) OR
              (control_block.data_declaration = nfc$p31_unspecified) OR
              ((NOT (nfc$data_declaration IN rft_parameters)) AND
              (NOT (nfc$data_declaration IN rpos_received_parameters)) AND
              (NOT (nfc$data_declaration IN rpos_modified_parameters))) THEN
          IF transfer_file_descriptor.file_kind = nfc$output_file THEN
            data_mode := transfer_file_descriptor.output_descriptor.data_mode;
          ELSEIF transfer_file_descriptor.file_kind = nfc$input_file THEN
            data_mode := transfer_file_descriptor.input_descriptor.data_mode;
          IFEND;
          IF data_mode = jmc$rhf_structure THEN
            set_transfer_mode := nfc$rhf_structured_mode;
          ELSE
            set_transfer_mode := nfc$coded_data_mode;
          IFEND;
        IFEND;

      FUNCEND set_transfer_mode;
?? TITLE := 'set_up_rft', EJECT ??

{ PURPOSE:
{   This procedure sets up all the parameters in the RFT based on
{   the queue file attributes.

      PROCEDURE set_up_rft
        (    file_desc: nft$application_file_descriptor;
         VAR rft_parameter_set: nft$parameter_set;
         VAR control_block: nft$control_block);

        VAR
          data_declaration: jmt$data_declaration,
          data_mode: jmt$data_mode,
          file_disposition: jmt$disposition_code,
          implicit_routing_text: jmt$implicit_routing_text,
          index: nft$protocol_parameters,
          output_disposition: jmt$output_disposition,
          nam_optimum_attributes: ^nat$get_attributes,
          remote_host_directive: jmt$remote_host_directive,
          source_lid: nft$parameter_24_definition,
          system_routing_text: jmt$system_routing_text,
          user_text_directive: [STATIC] ^nft$directive_entry := NIL;

?? NEWTITLE := 'build_implicit_routing_text', EJECT ??
{ PURPOSE:
{   This procedure builds the implicit routing text from selected
{   attributes of the queue file.  The format of implicit routing
{   text is defined in the QTF Design direction.
{
{ NOTE:
{   Implicit routing text has the format of:
{     <osid><sjn>';'<login parameters>';'<print file parameters>
{   where osid = 'NV1' and sjn is the system job name of the input
{   queue file being transferred to a remote system.
{
{   If an attribute has a value of NONE or NORMAL, then the parameter
{   will not be included in the implicit routing text.

        PROCEDURE build_implicit_routing_text
          (    file_desc: nft$application_file_descriptor;
           VAR implicit_routing_text: jmt$implicit_routing_text);

          CONST
            blank_fill = ' ',
            semicolon = ';',
            max_key_size = 4,
            min_key_size = 2,
            key_size_3 = 3;

          TYPE
            login_parameters = (user, family, user_job_name, account, project),
            prif_parameters = (disposition_code, output_destination_usage, station, output_destination,
                  operator_user, operator_family, device, forms_code, external_characteristics,
                  vertical_print_density, vfu_load_proc, routing_banner, comment_banner, copies, output_class,
                  output_priority, purge_delay, latest_print_time, earliest_print_time);

          VAR
            copy_count_str: ost$string,
            irt_param_length: 0 .. jmc$implicit_routing_text_size,
            irt_parameter: string (jmc$implicit_routing_text_size),
            local_status: ost$status,
            login_index: login_parameters,
            login_keys: [STATIC, READ] array [login_parameters] of string (max_key_size) := ['U=', 'FN=',
                  'UJN=', 'A=', 'P='],
            prif_index: prif_parameters,
            prif_keys: [STATIC, READ] array [prif_parameters] of string (max_key_size) := ['DC=', 'DU=', 'S=',
                  'ODE=', 'OU=', 'OF=', 'D=', 'FC=', 'EC=', 'VPD=', 'VLP=', 'RB=', 'CB=', 'C=', 'OC=', 'OP=',
                  'PD=', 'LPT=', 'EPT='];

?? NEWTITLE := 'map_vpd_to_irt_parameter', EJECT ??

{ PURPOSE:
{   This procedure maps an ordinal value of the vertical print
{   density to a keyword value.

          PROCEDURE map_vpd_to_irt_parameter
            (    vertical_print_density: jmt$vertical_print_density;
             VAR  irt_parameter: string (jmc$implicit_routing_text_size));

            CASE vertical_print_density OF
            = jmc$vertical_print_density_file =
              irt_parameter (max_key_size + 1, * ) := 'FILE';

            = jmc$vertical_print_density_6 =
              irt_parameter (max_key_size + 1, * ) := 'SIX';

            = jmc$vertical_print_density_8 =
              irt_parameter (max_key_size + 1, * ) := 'EIGHT';

            = jmc$vertical_print_density_none, jmc$vertical_print_density_7, jmc$vertical_print_density_9,
                  jmc$vertical_print_density_10, jmc$vertical_print_density_11,
                  jmc$vertical_print_density_12 =

{ These print densities do not have key values at R.1.2.3.

              irt_parameter := ' ';

            ELSE
              irt_parameter := ' ';

            CASEND;

          PROCEND map_vpd_to_irt_parameter;
?? OLDTITLE, EJECT ??
          IF (file_desc.file_kind = nfc$output_file) or (file_desc.file_kind = nfc$generic_file) THEN
            implicit_routing_text.size := 0;
            implicit_routing_text.text := osc$null_name;
          ELSEIF file_desc.file_kind = nfc$input_file THEN
            implicit_routing_text.text := nfc$p33_nos_ve_text_identifier;
            implicit_routing_text.text (nfc$p33_nos_ve_text_id_length + 1, jmc$system_supplied_name_size) :=
                  file_desc.input_descriptor.system_job_name;
            implicit_routing_text.size := nfc$p33_nos_ve_text_id_length + jmc$system_supplied_name_size;

            implicit_routing_text.text (implicit_routing_text.size + 1) := semicolon;
            implicit_routing_text.size := implicit_routing_text.size + 1;

            FOR login_index := user TO project DO
              irt_parameter := login_keys [login_index];
              CASE login_index OF
              = user =
                irt_parameter (min_key_size + 1, * ) := file_desc.input_descriptor.originating_login_user;

              = family =
                irt_parameter (key_size_3 + 1, * ) := file_desc.input_descriptor.originating_login_family;

              = user_job_name =
                IF file_desc.input_descriptor.user_job_name <> ' ' THEN
                  irt_parameter (max_key_size + 1, * ) := file_desc.input_descriptor.user_job_name;
                ELSE
                  irt_parameter := ' ';
                IFEND;

              = account =
                IF file_desc.input_descriptor.originating_login_account <> ' ' THEN
                  irt_parameter (min_key_size + 1, * ) := file_desc.input_descriptor.
                        originating_login_account;
                ELSE
                  irt_parameter := ' ';
                IFEND;

              = project =
                IF file_desc.input_descriptor.originating_login_project <> ' ' THEN
                  irt_parameter (min_key_size + 1, * ) := file_desc.input_descriptor.
                        originating_login_project;
                ELSE
                  irt_parameter := ' ';
                IFEND;

              ELSE
                irt_parameter := ' ';

              CASEND;
              IF irt_parameter <> ' ' THEN
                irt_param_length := clp$trimmed_string_size (irt_parameter);
                IF ((irt_param_length + implicit_routing_text.size) <= jmc$implicit_routing_text_size) THEN
                  implicit_routing_text.text (implicit_routing_text.size + 1,
                        irt_param_length) := irt_parameter (1, irt_param_length);
                  implicit_routing_text.size := implicit_routing_text.size + irt_param_length;

                  implicit_routing_text.text (implicit_routing_text.size + 1) := blank_fill;
                  implicit_routing_text.size := implicit_routing_text.size + 1;
                IFEND;
              IFEND;
            FOREND;

            implicit_routing_text.text (implicit_routing_text.size) := semicolon;

            FOR prif_index := disposition_code TO earliest_print_time DO
              irt_parameter := prif_keys [prif_index];
              CASE prif_index OF
              = disposition_code =
                IF file_desc.input_descriptor.output_disposition.key = jmc$wait_queue_path THEN
                  irt_parameter (key_size_3 + 1, * ) := nfc$p33_imp_wait_queue_value_wt;
                ELSE
                  irt_parameter := ' ';
                IFEND;

              = output_destination_usage =
                IF (file_desc.input_descriptor.output_destination_usage <>jmc$qtf_usage) OR
                      ((file_desc.input_descriptor.output_destination_usage = jmc$qtf_usage) AND
                      (file_desc.input_descriptor.output_destination <> file_desc.input_descriptor.
                      originating_login_family)) THEN
                  irt_parameter (key_size_3 + 1, * ) := file_desc.input_descriptor.output_destination_usage;
                ELSE
                  irt_parameter := ' ';
                IFEND;

              = station =
                irt_parameter (min_key_size + 1, * ) := file_desc.input_descriptor.station;

              = output_destination =
                irt_parameter (max_key_size + 1, * ) := file_desc.input_descriptor.output_destination;

              = operator_user =
                irt_parameter (key_size_3 + 1, * ) := file_desc.input_descriptor.station_operator;

              = operator_family =
                irt_parameter (key_size_3 + 1, * ) := file_desc.input_descriptor.output_destination_family;

              = device =
                irt_parameter (min_key_size + 1, * ) := file_desc.input_descriptor.device;

              = forms_code =
                IF file_desc.input_descriptor.forms_code <> nfc$normal_string THEN
                  irt_parameter (key_size_3 + 1, * ) := '''';
                  irt_parameter (key_size_3 + 2, * ) := file_desc.input_descriptor.forms_code;
                  irt_parameter (key_size_3 + 2 + clp$trimmed_string_size
                        (file_desc.input_descriptor.forms_code), * ) := '''';
                ELSE
                  irt_parameter := ' ';
                IFEND;

              = external_characteristics =
                IF file_desc.input_descriptor.external_characteristics <> nfc$normal_string THEN
                  irt_parameter (key_size_3 + 1, * ) := '''';
                  irt_parameter (key_size_3 + 2, * ) := file_desc.input_descriptor.external_characteristics;
                  irt_parameter (key_size_3 + 2 + clp$trimmed_string_size
                        (file_desc.input_descriptor.external_characteristics), * ) := '''';
                ELSE
                  irt_parameter := ' ';
                IFEND;

              = vertical_print_density =
                map_vpd_to_irt_parameter (file_desc.input_descriptor.vertical_print_density, irt_parameter);

              = vfu_load_proc =
                IF file_desc.input_descriptor.vfu_load_procedure = osc$null_name THEN
                  irt_parameter := ' ';
                ELSE
                  irt_parameter (max_key_size + 1, * ) := file_desc.input_descriptor.vfu_load_procedure;
                IFEND;

              = routing_banner =
                IF file_desc.input_descriptor.routing_banner = osc$null_name THEN
                  irt_parameter := ' ';
                ELSE
                  irt_parameter (key_size_3 + 1, * ) := '''';
                  irt_parameter (key_size_3 + 2, * ) := file_desc.input_descriptor.routing_banner;
                  irt_parameter (key_size_3 + 2 + clp$trimmed_string_size
                        (file_desc.input_descriptor.routing_banner), * ) := '''';
                IFEND;

              = comment_banner =
                IF file_desc.input_descriptor.comment_banner = osc$null_name THEN
                  irt_parameter := ' ';
                ELSE
                  irt_parameter (key_size_3 + 1, * ) := '''';
                  irt_parameter (key_size_3 + 2, * ) := file_desc.input_descriptor.comment_banner;
                  irt_parameter (key_size_3 + 2 + clp$trimmed_string_size
                        (file_desc.input_descriptor.comment_banner), * ) := '''';
                IFEND;

              = copies =
                clp$convert_integer_to_string (file_desc.input_descriptor.copies, 10, FALSE, copy_count_str,
                      local_status);
                irt_parameter (min_key_size + 1, * ) := copy_count_str.value;

              = output_class =
                IF file_desc.input_descriptor.output_class <> nfc$normal_string THEN
                  irt_parameter (key_size_3 + 1, * ) := file_desc.input_descriptor.output_class;
                ELSE
                  irt_parameter := ' ';
                IFEND;

              = output_priority =
                irt_parameter (key_size_3 + 1, * ) := file_desc.input_descriptor.output_priority;

              = purge_delay, latest_print_time, earliest_print_time =

{ These parameters are not supported until SCL allows time variables.  Check with QFM ERS for
{ availability and make sure QTFS will accept these parameters.

                irt_parameter := ' ';

              ELSE
                irt_parameter := ' ';

              CASEND;
              IF irt_parameter <> ' ' THEN
                irt_param_length := clp$trimmed_string_size (irt_parameter);
                IF ((irt_param_length + implicit_routing_text.size) <= jmc$implicit_routing_text_size) THEN
                  implicit_routing_text.text (implicit_routing_text.size + 1,
                        irt_param_length) := irt_parameter (1, irt_param_length);
                  implicit_routing_text.size := implicit_routing_text.size + irt_param_length;

                  IF implicit_routing_text.size < jmc$implicit_routing_text_size THEN
                    implicit_routing_text.text (implicit_routing_text.size + 1) := blank_fill;
                    implicit_routing_text.size := implicit_routing_text.size + 1;
                  IFEND;
                IFEND;
              IFEND;
            FOREND;

            IF implicit_routing_text.text (implicit_routing_text.size) = blank_fill THEN
              implicit_routing_text.size := implicit_routing_text.size - 1;
            IFEND;
          IFEND;

        PROCEND build_implicit_routing_text;
?? TITLE := 'build_parameter_29_echo_text', EJECT ??

{ PURPOSE:
{   This procedure will create the echo text (parameter 29) with the
{   values for the user specified LOGIN_FAMILY and the DATA_MODE of
{   RHF_STRUCTURED.  The data mode needs to be transferred for a
{   store and forward queue file.

        PROCEDURE build_parameter_29_echo_text
          (    login_family: ost$name;
               data_declaration: jmt$data_declaration;
               data_mode: jmt$data_mode;
               protocol_in_use: nft$parameter_00_values;
               originating_application_name: ost$name;
           VAR rft_parameter_set: nft$parameter_set;
           VAR parameter_29_list_head: nft$parameter_29_list_head);

          VAR
            created_echo_text: boolean,
            echo_text_size: ost$non_negative_integers,
            p29_text: [STATIC] nft$parameter_29_definition;

          created_echo_text := FALSE;
          echo_text_size := 0;

          IF (login_family <> osc$null_name) AND (protocol_in_use = nfc$p00_a102) THEN
            created_echo_text := TRUE;
            p29_text.value ((echo_text_size + 1), nfc$p29_login_family_param_len) :=
                  nfc$p29_login_family_parameter;
            echo_text_size := echo_text_size + nfc$p29_login_family_param_len;
            p29_text.value ((echo_text_size + 1), * ) := login_family;
            echo_text_size := clp$trimmed_string_size (p29_text.value);
          IFEND;

          IF NOT ((data_declaration = nfc$p31_ascii_64) OR (data_declaration = nfc$p31_undefined_unstructured)
                OR (data_declaration = nfc$p31_ascii_extended) OR (data_declaration = nfc$p31_host_dependent)
                OR (data_declaration = nfc$p31_undefined_structured)) AND (data_mode = jmc$rhf_structure) THEN

            IF created_echo_text THEN

{ separate the two parameters by a comma

              echo_text_size := echo_text_size + 1;
              p29_text.value (echo_text_size, * ) := ',';
            ELSE
              created_echo_text := TRUE;
            IFEND;
            p29_text.value ((echo_text_size + 1), nfc$p29_data_mode_param_length) :=
                  nfc$p29_data_mode_parameter;
            echo_text_size := echo_text_size + nfc$p29_data_mode_param_length;
            p29_text.value ((echo_text_size + 1), nfc$p29_rhf_structured_length) :=
                  nfc$p29_rhf_structured_value;
            echo_text_size := echo_text_size + nfc$p29_rhf_structured_length;
          IFEND;

          IF originating_application_name = osc$queue_transfer_client THEN
            IF created_echo_text THEN

{ separate the two parameters by a comma

              echo_text_size := echo_text_size + 1;
              p29_text.value (echo_text_size, * ) := ',';
            ELSE
              created_echo_text := TRUE;
            IFEND;
            p29_text.value ((echo_text_size +1), nfc$p29_qtfi_info_length) :=
                  nfc$p29_qtfi_info;
            echo_text_size := echo_text_size + nfc$p29_qtfi_info_length;
            p29_text.value ((echo_text_size + 1), nfc$p29_qtfi_info_err_file_len) :=
                  nfc$p29_qtfi_info_err_file;
            echo_text_size := echo_text_size + nfc$p29_qtfi_info_err_file_len;
          IFEND;

          IF created_echo_text THEN
            p29_text.size := echo_text_size;
            p29_text.link := NIL;
            parameter_29_list_head.first_text := ^p29_text;
            parameter_29_list_head.last_text := ^p29_text;
            rft_parameter_set := rft_parameter_set + $nft$parameter_set [nfc$echo];
          IFEND;

        PROCEND build_parameter_29_echo_text;

?? TITLE := 'truncate_name', EJECT ??

{ PURPOSE:
{   Truncate family, user and job name to maximum of 7 characters.
{
{ NOTE:
{   Only allowed characters include A-Z, 0..9, $, #, and @.

        PROCEDURE truncate_name
          (    original_name : ost$name;
           VAR return_string : string(31);
           VAR return_size : 0 .. 7);

          CONST
            maximum_name_length = 7;

          VAR
            index: 1 .. 31,
            original_name_length: 1 .. 31,
            scratch_index: 1 .. 31;

          original_name_length := clp$trimmed_string_size (original_name);

          return_size := 0;
          scratch_index := 1;

        /check_character/
          FOR index := 1 TO original_name_length DO
            IF (($INTEGER (original_name (index)) >= $INTEGER (nfc$p26_1st_range1_a101)) AND
                ($INTEGER (original_name (index)) <= $INTEGER (nfc$p26_last_range1_a101))) OR
                (($INTEGER (original_name (index)) >= $INTEGER (nfc$p26_1st_range2_a101)) AND
                ($INTEGER (original_name (index)) <= $INTEGER (nfc$p26_last_range2_a101))) OR
                ($INTEGER (original_name (index)) = $INTEGER (nfc$p26_special1_a101)) OR
                ($INTEGER (original_name (index)) = $INTEGER (nfc$p26_special2_a101)) THEN
              return_string (scratch_index) := original_name (index);
              scratch_index := scratch_index + 1;
              return_size := return_size + 1;
              IF return_size = maximum_name_length THEN
                EXIT /check_character/
              IFEND;
            IFEND;
          FOREND /check_character/;

        PROCEND truncate_name;
?? TITLE := 'build_system_routing_text', EJECT ??

{ PURPOSE:
{   This procedure builds the system routing text from selected
{   attributes of the queue file.  The format of system routing text
{   is defined in the QTF Design direction.  The system routing text
{   format is also used by NOS and NOS/BE

        PROCEDURE build_system_routing_text
          (    file_desc: nft$application_file_descriptor;
           VAR system_routing_text: jmt$system_routing_text);

          CONST
            period = '.',
            srt_identifier_length = 3,
            srt_key_long_length = 5,
            srt_key_short_length = 4,
            user_job_name_prefix = '#';

          TYPE
            system_routing_text_parameters = (srt_control_family_name, srt_control_user_name,
                  srt_owner_family_name, srt_owner_user_name, srt_charge_part_1, srt_charge_part_2,
                  srt_project_part_1, srt_project_part_2, srt_project_part_3, srt_project_part_4,
                  srt_disposition_code, srt_external_characteristics, srt_forms_code, srt_copies,
                  srt_user_job_name);

          VAR
            copy_count: jmt$output_copy_count,
            copy_count_str: ost$string,
            disposition_code: jmt$disposition_code,
            external_characteristics: jmt$external_characteristics,
            forms_code: jmt$forms_code,
            local_status: ost$status,
            login_charge: avt$account_name,
            login_family: ost$name,
            login_project: avt$project_name,
            login_user: ost$name,
            srt_parameter: string (jmc$system_routing_text_size),
            srt_parameter_length: 0 .. jmc$system_routing_text_size,
            system_routing_text_keys: [STATIC] array [system_routing_text_parameters] of
                  string (srt_key_long_length) := [',CFM=', ',CUN=', ',OFM=', ',OUN=', ',CH1=', ',CH2=',
                  ',PJ1=', ',PJ2=', ',PJ3=', ',PJ4=', ',DC=', ',EC=', ',FC=', ',REP=', ',UJN='],
            system_routing_text_param: system_routing_text_parameters,
            temp_size: 0 .. 7,
            temp_string: string(31),
            user_job_name: jmt$user_supplied_name;


{ The system routing text identifier was set in the procedure initialize_control_block.

          system_routing_text.parameters (srt_identifier_length + 1, * ) := '';
          system_routing_text.size := srt_identifier_length;

          IF file_desc.file_kind = nfc$output_file THEN
            copy_count := file_desc.output_descriptor.copies;
            IF file_desc.output_descriptor.output_disposition_key <> jmc$wait_queue_path THEN
              IF (file_desc.output_descriptor.disposition_code = 'IN') OR
                 (file_desc.output_descriptor.disposition_code = 'IX') OR
                 (file_desc.output_descriptor.disposition_code = 'NO') THEN
                disposition_code := 'LP';
              ELSEIF  file_desc.output_descriptor.disposition_code = 'TO' THEN
                disposition_code := 'WT';
              ELSE
                disposition_code := file_desc.output_descriptor.disposition_code;
              IFEND;
            ELSE
              disposition_code := 'WT';
            IFEND;
            external_characteristics := file_desc.output_descriptor.external_characteristics;
            forms_code := file_desc.output_descriptor.forms_code;
            login_charge := file_desc.output_descriptor.login_account;
            login_family := file_desc.output_descriptor.login_family;
            login_project := file_desc.output_descriptor.login_project;
            login_user := file_desc.output_descriptor.login_user;
            user_job_name := file_desc.output_descriptor.user_file_name;
          ELSEIF file_desc.file_kind = nfc$input_file THEN
            copy_count := file_desc.input_descriptor.copies;
            disposition_code := file_desc.input_descriptor.disposition_code;
            external_characteristics := file_desc.input_descriptor.external_characteristics;
            forms_code := file_desc.input_descriptor.forms_code;
            login_charge := file_desc.input_descriptor.originating_login_account;
            login_family := file_desc.input_descriptor.originating_login_family;
            login_project := file_desc.input_descriptor.originating_login_project;
            login_user := file_desc.input_descriptor.originating_login_user;
            user_job_name := file_desc.input_descriptor.user_job_name;
          IFEND;

          FOR system_routing_text_param := srt_control_family_name TO srt_user_job_name DO
            srt_parameter := system_routing_text_keys [system_routing_text_param];
            CASE system_routing_text_param OF
            = srt_control_family_name, srt_owner_family_name =
              truncate_name (login_family, temp_string, temp_size);
              srt_parameter (srt_key_long_length + 1, temp_size ) := temp_string (1, temp_size);

            = srt_control_user_name, srt_owner_user_name =
              truncate_name (login_user, temp_string, temp_size);
              srt_parameter (srt_key_long_length + 1, temp_size ) := temp_string (1, temp_size);

            = srt_charge_part_1 =
              IF login_charge <> ' ' THEN
                srt_parameter (srt_key_long_length + 1, 7) := login_charge;
              ELSE
                srt_parameter := ' ';
              IFEND;

            = srt_charge_part_2 =
              srt_parameter_length := clp$trimmed_string_size (login_charge);
              IF srt_parameter_length > 7 THEN
                srt_parameter (srt_key_long_length + 1, 3) := login_charge (8, 3);
              ELSE
                srt_parameter := ' ';
              IFEND;

            = srt_project_part_1 =
              IF login_project <> ' ' THEN
                srt_parameter (srt_key_long_length + 1, 7) := login_project;
              ELSE
                srt_parameter := ' ';
              IFEND;

            = srt_project_part_2 =
              srt_parameter_length := clp$trimmed_string_size (login_project);
              IF srt_parameter_length > 7 THEN
                srt_parameter (srt_key_long_length + 1, 3) := login_project (8, 3);
              ELSE
                srt_parameter := ' ';
              IFEND;

            = srt_project_part_3 =
              srt_parameter_length := clp$trimmed_string_size (login_project);
              IF srt_parameter_length > 10 THEN
                srt_parameter (srt_key_long_length + 1, 7) := login_project (11, 7);
              ELSE
                srt_parameter := ' ';
              IFEND;

            = srt_project_part_4 =
              srt_parameter_length := clp$trimmed_string_size (login_project);
              IF srt_parameter_length > 17 THEN
                srt_parameter (srt_key_long_length + 1, 3) := login_project (18, 3);
              ELSE
                srt_parameter := ' ';
              IFEND;

            = srt_disposition_code =
              IF disposition_code <> '' THEN
                srt_parameter (srt_key_short_length + 1, * ) := disposition_code;
              ELSE
                srt_parameter := ' ';
              IFEND;

            = srt_external_characteristics =
              IF (file_desc.file_kind = nfc$output_file) AND (external_characteristics <> '') AND
                    (external_characteristics <> nfc$normal_string) THEN
                srt_parameter (srt_key_short_length + 1, * ) := external_characteristics (1, 2);
              ELSEIF (file_desc.file_kind = nfc$output_file) AND
                    (external_characteristics = nfc$normal_string) THEN
                srt_parameter (srt_key_short_length + 1, * ) := nfc$external_characteristic_a9;
              ELSE
                srt_parameter := ' ';
              IFEND;

            = srt_forms_code =
              IF (file_desc.file_kind = nfc$output_file) AND (forms_code <> '') AND
                    (forms_code <> nfc$normal_string) THEN
                srt_parameter (srt_key_short_length + 1, * ) := forms_code (1, 2);
              ELSE
                srt_parameter := ' ';
              IFEND;

            = srt_copies =
              clp$convert_integer_to_string ((copy_count - 1), 10, FALSE, copy_count_str, local_status);
              srt_parameter (srt_key_long_length + 1, * ) := copy_count_str.value;

            = srt_user_job_name =
              IF user_job_name <> '' THEN
                IF (user_job_name (1, 1) = user_job_name_prefix) THEN
                  user_job_name := user_job_name (2, *);
                IFEND;
                truncate_name (user_job_name, temp_string, temp_size);

{ If necessary, alter the UJN specification on the system routing text so that
{ it does not end with '$PRI'. NOS will reject the file transfer if a UJN is
{ specified with '$PRI' as the last four characters.

                IF control_block.protocol_in_use = nfc$p00_a101 THEN
                  IF temp_size > 3 THEN
                      IF temp_string ((temp_size - 3), 4) = '$PRI' THEN
                          temp_string((temp_size - 3), 4) := '$PRX' ;
                      IFEND;
                  IFEND;
                IFEND;

                srt_parameter (srt_key_long_length + 1, temp_size) := temp_string (1, temp_size);
              ELSE
                srt_parameter (srt_key_long_length + 1, * ) := qtfi_unknown_job_name;
              IFEND;

            CASEND;
            IF srt_parameter <> '' THEN
              srt_parameter_length := clp$trimmed_string_size (srt_parameter);
              IF ((srt_parameter_length + system_routing_text.size) <= jmc$system_routing_text_size) THEN
                system_routing_text.parameters (system_routing_text.size + 1,
                      srt_parameter_length) := srt_parameter;
                system_routing_text.size := system_routing_text.size + srt_parameter_length;
              IFEND;
            IFEND;
          FOREND;

          IF system_routing_text.size < jmc$system_routing_text_size THEN
            system_routing_text.parameters (system_routing_text.size + 1, 1) := period;
            system_routing_text.size := system_routing_text.size + 1;
          IFEND;

        PROCEND build_system_routing_text;
?? TITLE := 'set_data_declaration_param', EJECT ??

{ PURPOSE:
{   This function maps a string value data declaration to an ordinal
{   value.  The protocol engine will take  the ordinal valu and use
{   it to in the RFT.

        FUNCTION set_data_declaration_param
          (    data_declaration: jmt$data_declaration;
               data_mode: jmt$data_mode): nft$parameter_31_type;

          IF data_declaration = 'C6' THEN
            set_data_declaration_param := nfc$p31_ascii_c6;
          ELSEIF data_declaration = 'C8' THEN
            set_data_declaration_param := nfc$p31_ascii_c8;
          ELSEIF data_declaration = 'UH' THEN
            set_data_declaration_param := nfc$p31_host_dependent_uh;
          ELSEIF data_declaration = 'US' THEN
            set_data_declaration_param := nfc$p31_undefined_structured_us;
          ELSEIF (data_declaration = 'UU') OR ((data_declaration = '') AND (data_mode = jmc$transparent_data))
                THEN
            set_data_declaration_param := nfc$p31_undef_unstructured_uu;
          ELSE
            set_data_declaration_param := nfc$p31_unspecified;
          IFEND;

        FUNCEND set_data_declaration_param;
?? OLDTITLE, EJECT ??

{ These are the required parameters for the QTF RFT command:
{   Parameters 00, 16, 21, 22, 25, 26, 27
{ All the others are optional parameters.

        rft_parameter_set := $nft$parameter_set [nfc$protocol_id, nfc$file_name, nfc$mode_of_access,
              nfc$host_type, nfc$transfer_lid, nfc$job_name, nfc$physical_id];

        IF file_desc.file_kind = nfc$output_file THEN
          control_block.file_size := file_desc.output_descriptor.file_size;                        {P06}
          control_block.transfer_lid := file_desc.output_descriptor.output_destination;            {P25}
          control_block.send_file_name.value := file_desc.output_descriptor.system_file_name;      {P16}
          control_block.send_job_name.value := file_desc.output_descriptor.user_file_name;         {P26}
          data_declaration := file_desc.output_descriptor.data_declaration;
          data_mode := file_desc.output_descriptor.data_mode;
          file_disposition := file_desc.output_descriptor.disposition_code;
          implicit_routing_text := file_desc.output_descriptor.implicit_routing_text;
          remote_host_directive := file_desc.output_descriptor.remote_host_directive;
          source_lid.value := file_desc.output_descriptor.source_logical_id;
          system_routing_text := file_desc.output_descriptor.system_routing_text;
        ELSEIF file_desc.file_kind = nfc$input_file THEN
          control_block.file_size := file_desc.input_descriptor.job_size;                          {P06}
          control_block.transfer_lid := file_desc.input_descriptor.job_destination_family;         {P25}
          control_block.send_file_name.value := file_desc.input_descriptor.system_job_name;        {P16}
          IF file_desc.input_descriptor.user_job_name <> '' THEN                                   {P26}
            control_block.send_job_name.value := file_desc.input_descriptor.user_job_name;
          ELSE
            control_block.send_job_name.value := qtfi_unknown_job_name;
          IFEND;
          data_declaration := file_desc.input_descriptor.data_declaration;
          data_mode := file_desc.input_descriptor.data_mode;
          file_disposition := file_desc.input_descriptor.disposition_code;
          implicit_routing_text := file_desc.input_descriptor.implicit_routing_text;
          output_disposition := file_desc.input_descriptor.output_disposition;
          remote_host_directive := file_desc.input_descriptor.remote_host_directive;
          source_lid.value := file_desc.input_descriptor.source_logical_id;
          system_routing_text := file_desc.input_descriptor.system_routing_text;
        ELSEIF file_desc.file_kind = nfc$generic_file THEN
          control_block.file_size := 1;                                                            {P06}
          control_block.transfer_lid := file_desc.generic_descriptor.destination;                  {P25}
          control_block.send_file_name.value := file_desc.generic_descriptor.system_file_name;     {P16}
          control_block.send_job_name.value := file_desc.generic_descriptor.system_file_name;      {P26}
          data_declaration := 'UH';
          implicit_routing_text.size := 0;
          implicit_routing_text.text := '';
          remote_host_directive := file_desc.generic_descriptor.remote_host_directive;
          source_lid.value := control_block.transfer_pid;
          system_routing_text.parameters := '';
          system_routing_text.size := 0;

        IFEND;
        control_block.send_file_name.size := clp$trimmed_string_size (control_block.send_file_name.value);
        control_block.send_job_name.size := clp$trimmed_string_size (control_block.send_job_name.value);
        control_block.transfer_lid_length := clp$trimmed_string_size (control_block.transfer_lid);

        FOR index := nfc$protocol_id TO nfc$implicit_routing_text DO
          CASE index OF
          = nfc$facilities =                { Parameter 03 }
            IF control_block.path.network_type = nfc$network_nam THEN
              rft_parameter_set := rft_parameter_set + $nft$parameter_set [nfc$facilities];
            IFEND;

          = nfc$user_text_directive =       { Parameter 05 }
            IF remote_host_directive.size <> 0 THEN
              IF user_text_directive <> NIL THEN
                FREE user_text_directive;
              IFEND;
              ALLOCATE user_text_directive: [remote_host_directive.size];
              user_text_directive^.link := NIL;
              user_text_directive^.line := '';

              #TRANSLATE (osv$lower_to_upper, remote_host_directive.parameters, user_text_directive^.line);
              control_block.send_directives := user_text_directive;
              rft_parameter_set := rft_parameter_set + $nft$parameter_set [nfc$user_text_directive];
            IFEND;

          = nfc$file_length =               { Parameter 06 }
            rft_parameter_set := rft_parameter_set + $nft$parameter_set [nfc$file_length];

          = nfc$max_block_size =            { Parameter 12 }
            IF (control_block.path.network_type = nfc$network_nam) AND
               (control_block.protocol_in_use = nfc$p00_a102) THEN
              PUSH nam_optimum_attributes: [1..2];
              nam_optimum_attributes^ [1].kind := nac$optimum_transfer_unit_incr;
              nam_optimum_attributes^ [2].kind := nac$optimum_transfer_unit_size;
              nap$get_attributes(control_block.path.network_file^, nam_optimum_attributes^, status);
              IF status.normal THEN
                control_block.data_block_size := nam_optimum_attributes^ [2].optimum_transfer_unit_size;
                IF nam_optimum_attributes^ [1].optimum_transfer_unit_incr > 0 THEN
                  WHILE control_block.data_block_size < 10240 DO
                    control_block.data_block_size := control_block.data_block_size +
                        nam_optimum_attributes^ [1].optimum_transfer_unit_incr;
                  WHILEND;
                IFEND;
                control_block.data_block_size := control_block.data_block_size - data_header_length;
              IFEND;
              IF (NOT status.normal) OR (control_block.data_block_size < 512) THEN
                control_block.data_block_size := nfc$p12_nam_default;
              IFEND;
            ELSE

{ By using LCN or the A101 protocol, the data_block_size
{ will be set to the LCN default block size

              control_block.data_block_size := nfc$p12_lcn_default;
            IFEND;
            rft_parameter_set := rft_parameter_set + $nft$parameter_set [nfc$max_block_size];

          = nfc$file_disposition =          { Parameter 17 }
            IF file_desc.file_kind = nfc$input_file THEN

{ nfc$p17_input_return, 'IN', is the default for all input files.

              control_block.disposition_code := nfc$p17_input_return;

              IF (file_disposition = 'IX') OR (output_disposition.key = jmc$local_output_disposition) THEN
                control_block.disposition_code := nfc$p17_input_no_return;
              IFEND;
            ELSEIF file_desc.file_kind = nfc$output_file THEN

{ nfc$p17_line_printer, 'LP', is the default for all output files.
{ Some file_disposition codes (like 'NO' and 'TO') need to be masked
{ to the default nfc$p17_line_printer value because they are not valid
{ values for RFT parameter 17, but are valid for RFT parameter 32.

              control_block.disposition_code := nfc$p17_line_printer;

              IF (file_disposition = 'SP') OR ((file_disposition = '') AND
                    (file_desc.output_descriptor.device_type = jmc$output_device_plotter)) THEN
                control_block.disposition_code := nfc$p17_special_output;

              ELSEIF (file_disposition = 'PU') OR ((file_disposition = '') AND
                    (file_desc.output_descriptor.device_type = jmc$output_device_punch)) THEN
                control_block.disposition_code := nfc$p17_hollerith_card_punch;

              ELSEIF file_disposition = 'P8' THEN
                control_block.disposition_code := nfc$p17_binary_checksummed_cp;

              ELSEIF file_disposition = 'PB' THEN
                control_block.disposition_code := nfc$p17_binary_card_punch;
              IFEND;

            ELSEIF file_desc.file_kind = nfc$generic_file THEN
              control_block.disposition_code := nfc$p17_generic_queue;
            IFEND;

            rft_parameter_set := rft_parameter_set + $nft$parameter_set [nfc$file_disposition];

          = nfc$acknowledgment_window =  { Parameter 18 }

{ This parameter is being sent to correct a NOS QTF bug using NAM.   It should be taken out when
{ the NOS bug is fixed.

            IF control_block.path.network_type = nfc$network_nam THEN
              control_block.acknowledgment_window := 2;
              rft_parameter_set := rft_parameter_set + $nft$parameter_set [nfc$acknowledgment_window];
            IFEND;

          = nfc$minimum_timeout_interval =  { Parameter 20 }

{ The minimum timeout inteval is set in the control block so the
{ protocol engine will take care of this parameter.

          = nfc$source_lid =                { Parameter 24 }
            IF source_lid.value <> '' THEN
              control_block.source_lid.value := source_lid.value;
            ELSE
              control_block.source_lid.value := control_block.transfer_pid;
            IFEND;
            control_block.source_lid.size := clp$trimmed_string_size (control_block.source_lid.value);
            rft_parameter_set := rft_parameter_set + $nft$parameter_set [nfc$source_lid];

          = nfc$echo =                      { Parameter 29 }

{ This parameter is used to specify the desired login family on the remote system for a job in a
{ VE - VE transfer.  If the login family was specified on the SUBJ command or on the login
{ statement of the job file, the login family field in the input file descriptor will contain the
{ value.  If no parameter was specified, (use the default value on the remote system),  the login
{ family field will be blank.  This parameter will also be used to pass the data_mode of
{ RHF_STRUCTURED queues files for a data_declaration of UNSPECIFIED.

            IF file_desc.file_kind = nfc$input_file THEN
              build_parameter_29_echo_text (file_desc.input_descriptor.login_family, data_declaration,
                    data_mode, control_block.protocol_in_use,
                    file_desc.input_descriptor.originating_application_name, rft_parameter_set,
                    control_block.send_echo_text);
            ELSE
              build_parameter_29_echo_text (osc$null_name, data_declaration, data_mode,
                    control_block.protocol_in_use, file_desc.output_descriptor.originating_application_name,
                    rft_parameter_set, control_block.send_echo_text);
            IFEND;

          = nfc$data_declaration =          { Parameter 31 }
            control_block.data_declaration := set_data_declaration_param (data_declaration, data_mode);
            IF control_block.data_declaration <> nfc$p31_unspecified THEN
              rft_parameter_set := rft_parameter_set + $nft$parameter_set [nfc$data_declaration];
            IFEND;

          = nfc$system_routing_text =       { Parameter 32 }
            IF (file_desc.file_kind = nfc$input_file) OR (file_desc.file_kind = nfc$output_file) THEN
              IF system_routing_text.size <> 0 THEN
                control_block.send_systems_routing_text := system_routing_text;
              ELSE
                build_system_routing_text (file_desc, control_block.send_systems_routing_text);
              IFEND;
              rft_parameter_set := rft_parameter_set + $nft$parameter_set [nfc$system_routing_text];
            IFEND;

          = nfc$implicit_routing_text =     { Parameter 33 }
            IF implicit_routing_text.size <> 0 THEN
              control_block.send_implicit_routing_text := implicit_routing_text;
            ELSE
              build_implicit_routing_text (file_desc, control_block.send_implicit_routing_text);
            IFEND;

{ Implicit routing text will have been created if the input file
{ originated on a NOS/VE machine.

            IF control_block.send_implicit_routing_text.size <> 0 THEN
              rft_parameter_set := rft_parameter_set + $nft$parameter_set [nfc$implicit_routing_text];
            IFEND;

          ELSE
            ;
          CASEND;
        FOREND;

      PROCEND set_up_rft;
?? OLDTITLE, EJECT ??
      status.normal := TRUE;

      set_up_rft (transfer_file_descriptor, rft_parameter_set, control_block);

      go_parameter_set := $nft$parameter_set [];
      rft_legal_resp_commands := $nft$command_set [nfc$rpos, nfc$rneg];

      nfp$send_command (nfc$rft, rft_parameter_set, $nft$parameter_set[ ], $nft$parameter_set[ ],
            control_block, status);
      IF status.normal THEN
        nfp$receive_command (rft_legal_resp_commands, nfv$qtf_required_params_on_cmds, control_block,
              rpos_received_params, rpos_ignored_params, rpos_modified_params, status);

        IF (status.normal) AND (control_block.last_command_sent = nfc$rft) AND
              (control_block.last_command_received = nfc$rpos) THEN
          transfer_mode := set_transfer_mode (transfer_file_descriptor, rft_parameter_set,
                rpos_received_params, rpos_modified_params, control_block);

          nfp$send_command (nfc$go, go_parameter_set, $nft$parameter_set[ ], $nft$parameter_set[ ],
                control_block, status);

        ELSEIF (status.normal) AND (control_block.last_command_sent = nfc$rft) AND
              (control_block.last_command_received = nfc$rneg) AND (control_block.negotiate_protocol) THEN

{ Make sure the protocol is set to A101.

          control_block.protocol_in_use := nfc$p00_a101;
          control_block.state_of_transfer.normal := TRUE;

          stop_transfer_protocol (transfer_file_descriptor, control_block, status);
          IF status.normal THEN

{ control_block.protocol_in_use has been set to the A101 protocol by the protocol engine.

            control_block.negotiate_protocol := FALSE;
            negotiate_file_transfer (transfer_file_descriptor, control_block, transfer_mode, status);
          IFEND;
        IFEND;
      IFEND;

    PROCEND negotiate_file_transfer;
?? TITLE := 'open_connection', EJECT ??

{ PURPOSE:
{   This procedure opens the connection that was created by QTFC.
{   The connection file should only be opened if the connection is a
{   new connection, but should be checked if this procedure is called
{   again for multiple file transfers over the same connection.
{
{ NOTE:
{   qtfi_connection_file_name is a global variable.

    PROCEDURE open_connection
      (    connection_info: nft$intertask_message;
       VAR connection_path: nft$network_connection;
       VAR status: ost$status);

      CONST
        access_mode = amc$record,
        wait_time = 15000;   { 15000 milliseconds }

      VAR
        ignore_status: ost$status,
        namve_attributes: ^nat$change_attributes,
        rhfam_attributes: ^rft$change_attributes;

      status.normal := TRUE;
      IF connection_path.path_connected THEN
        IF (connection_path.network_file <> NIL) AND ((connection_path.network_file^ <>
              connection_info.connection_file) OR (connection_path.network_type <>
              connection_info.connection_kind)) THEN
          osp$set_status_abnormal ('NF', nfe$qtfc_qtfi_communication_err, ' ', status);
        IFEND;
      ELSE
        IF connection_info.connection_kind = nfc$unknown_network THEN
          osp$set_status_abnormal(nfc$status_id,nfe$bts_internal_error,
               'QTF Initiator - open_connection - invalid network kind',status);
          nfp$format_message_to_job_log (status);
          RETURN; {----->
        IFEND;
        IF connection_info.connection_kind = nfc$network_nam THEN
          nap$await_server_response (connection_info.connection_file, wait_time, status);
          IF NOT status.normal THEN
            RETURN; {----->
          IFEND;
        IFEND;
        fsp$open_file (connection_info.connection_file, access_mode, NIL, NIL, NIL, NIL, NIL,
              connection_path.network_file_id, status);
        IF NOT status.normal THEN
          RETURN; {----->
        IFEND;
        CASE connection_info.connection_kind OF
        = nfc$network_nam =
          control_block.send_facilities := control_block.send_facilities +
                $nft$parameter_03_value_set [nfc$ss_ack_required];
          control_block.transfer_facilities := control_block.send_facilities;

          PUSH namve_attributes: [1 .. 1];
          namve_attributes^ [1].kind := nac$data_transfer_timeout;
          namve_attributes^ [1].data_transfer_timeout := control_block.time_out * nfc$milliseconds;
          nap$store_attributes (connection_path.network_file_id, namve_attributes^, status);
        = nfc$network_lcn =
          PUSH rhfam_attributes: [1 .. 1];
          rhfam_attributes^ [1].key := rfc$data_transfer_timeout;
          rhfam_attributes^ [1].data_transfer_timeout := control_block.time_out * nfc$milliseconds;
          rfp$store (connection_path.network_file_id, rhfam_attributes^, status);
        ELSE
        CASEND;
        IF NOT status.normal THEN
          fsp$close_file (connection_path.network_file_id, ignore_status);
          RETURN; {----->
        IFEND;

        qtfi_connection_file_name := connection_info.connection_file;
        connection_path.network_file := ^qtfi_connection_file_name;
        connection_path.path_connected := TRUE;
        connection_path.network_type := connection_info.connection_kind;
      IFEND;

    PROCEND open_connection;
?? TITLE := 'set_qtf_transfer_status', EJECT ??

{ PURPOSE:
{   This function maps a status from nfp$send_queue_file to a
{   QTF transfer status for QTFC to interpret.

    FUNCTION set_qtf_transfer_status
      (    task_status: ost$status;
           state_of_transfer: ost$status): nft$qtf_transfer_status;

      IF task_status.normal AND state_of_transfer.normal THEN
        set_qtf_transfer_status := nfc$qtf_transfer_complete;
      ELSEIF NOT state_of_transfer.normal THEN
        IF ((state_of_transfer.condition = nfe$receiver_problem_retry) OR
              (state_of_transfer.condition = nfe$sender_problem_retry)) THEN
          set_qtf_transfer_status := nfc$qtf_transfer_failed_retry;
        ELSE
          set_qtf_transfer_status := nfc$qtf_transfer_failed_noretry;
        IFEND;
      ELSEIF NOT task_status.normal THEN
        set_qtf_transfer_status := nfc$qtf_transfer_aborted;
      IFEND;

    FUNCEND set_qtf_transfer_status;
?? OLDTITLE, EJECT ??
    status.normal := TRUE;
    stop_transfer_status.normal := TRUE;

    IF control_block.transfer_pid = osc$null_name THEN
      control_block.transfer_pid := file_transfer_msg.host_pid;
      control_block.transfer_pid_length := clp$trimmed_string_size (file_transfer_msg.host_pid);
    IFEND;

    IF file_transfer_msg.qtf_file_descriptor.file_kind = nfc$output_file THEN
      system_file_name := file_transfer_msg.qtf_file_descriptor.output_descriptor.system_file_name;
    ELSEIF file_transfer_msg.qtf_file_descriptor.file_kind = nfc$input_file THEN
      system_file_name := file_transfer_msg.qtf_file_descriptor.input_descriptor.system_job_name;
    ELSEIF file_transfer_msg.qtf_file_descriptor.file_kind = nfc$generic_file THEN
      system_file_name := file_transfer_msg.qtf_file_descriptor.generic_descriptor.system_file_name;
    IFEND;

    open_connection (file_transfer_msg, control_block.path, status);
    IF status.normal THEN
      negotiate_file_transfer (file_transfer_msg.qtf_file_descriptor, control_block, transfer_mode, status);
      IF status.normal AND (control_block.last_command_received = nfc$rpos) AND
            (control_block.last_command_sent = nfc$go) THEN
        IF transfer_mode = nfc$rhf_structured_mode THEN
          open_access_level := amc$record;
        ELSE
          open_access_level := amc$segment;
        IFEND;

        IF file_transfer_msg.qtf_file_descriptor.file_kind = nfc$input_file THEN
          jmp$open_input_file (system_file_name, open_access_level, jmc$qtf_usage,
                file_transfer_msg.qtf_file_descriptor.q_file_password, queue_file_identifier, status);
        ELSEIF file_transfer_msg.qtf_file_descriptor.file_kind = nfc$output_file THEN
          jmp$open_output_file (system_file_name, open_access_level, jmc$qtf_usage,
                file_transfer_msg.qtf_file_descriptor.q_file_password, queue_file_identifier, status);
        ELSE { file_transfer_msg.qtf_file_descriptor.file_kind = nfc$generic_file
          jmp$open_qfile (system_file_name, open_access_level, nfc$qtf_namve_client_name,
                file_transfer_msg.qtf_file_descriptor.q_file_password, queue_file_identifier, status);
        IFEND;
        nfp$send_queue_file (control_block.path.network_file_id, queue_file_identifier,
              system_file_name, control_block.transfer_facilities, transfer_mode,
              control_block.data_block_size, control_block.time_out, control_block.protocol_in_use,
              control_block.path.network_type, control_block.protocol_trace,
              consistent_protocol_state, control_block.state_of_transfer, status);

{ If nfp$send_queue_file returns an abnormal status retry the file and
{ do NOT print an error listing for the user.

        IF (NOT status.normal) AND (NOT control_block.state_of_transfer.normal) THEN
          control_block.state_of_transfer.condition := nfe$sender_problem_retry;
        IFEND;
      IFEND;
      stop_transfer_protocol (file_transfer_msg.qtf_file_descriptor, control_block, stop_transfer_status);
      IF status.normal AND (NOT stop_transfer_status.normal) THEN

{ If NEGOTIATE_FILE_TRANSFER or NFP$SEND_QUEUE_FILE returns an abnormal status, that abnormal status should
{ override an abnormal status from STOP_TRANSFER_PROTOCOL.

        status := stop_transfer_status;
      IFEND
    IFEND;

{ Notify QTFC of the status by sending a file transfer status message.

    transfer_status_msg.kind := nfc$qtf_file_transfer_status;
    transfer_status_msg.qtf_system_file_name := system_file_name;
    transfer_status_msg.qtf_transfer_status := set_qtf_transfer_status
          (status, control_block.state_of_transfer);
    transfer_status_msg.remote_job_name := control_block.user_job_name;

{ Emit communications accounting statistic for all input and output file transfers.

    IF (file_transfer_msg.qtf_file_descriptor.file_kind = nfc$input_file) OR
          (file_transfer_msg.qtf_file_descriptor.file_kind = nfc$output_file) THEN
      generate_qtf_statistic( file_transfer_msg.qtf_file_descriptor,
           control_block.source_lid.value(1,control_block.source_lid.size),
           control_block.transfer_lid(1,control_block.transfer_lid_length));
    IFEND;

    transfer_status_msg.qtf_task_status := status;
    nfp$put_async_task_message (qtfc_task_id, ^transfer_status_msg, #SIZE (transfer_status_msg), status);

  PROCEND transfer_file;
?? TITLE := 'nfp$qtf_initiator', EJECT ??

{ PURPOSE:
{   This is the main procedure for QTFI.

  PROGRAM nfp$qtf_initiator
    (    parameters: pmt$program_parameters;
     VAR status: ost$status);

    VAR
      control_block: nft$control_block,
      control_block_needs_initialized: boolean,
      establish_descriptor: pmt$established_handler,
      exit_condition: [STATIC, READ] pmt$condition := [pmc$block_exit_processing,
            [pmc$block_exit, pmc$program_termination, pmc$program_abort]],
      intertask_message: nft$intertask_message,
      qtfc_task_id: pmt$task_id,
      queue_id: pmt$queue_connection,
      ready_index: integer,       { This has to be an integer for osp$i_await_activity_completion.
      transfer_count: nft$intertask_transfer_size,
      wait_list: ^ost$i_wait_list;

?? NEWTITLE := 'exit_condition_handler', EJECT ??

{ PURPOSE:
{   This is a block exit condition handler that gets called whenever
{   QTFI aborts or exits on an abnormal status.

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

      VAR
        ignore_status: ost$status,
        intertask_message: nft$intertask_message,
        message_status: ost$status,
        retry_count: 0 .. 10,
        transfer_count: nft$intertask_transfer_size;


      pmp$log ('Queue file Transfer Facility Initiator is dropping', ignore_status);
      fsp$close_file (control_block.path.network_file_id, handler_status);

      intertask_message.kind := nfc$abnormal_child_task_abort;
      nfp$put_async_task_message (qtfc_task_id, ^intertask_message, #SIZE (intertask_message),
            message_status);

      IF message_status.normal THEN
        REPEAT
          nfp$get_async_task_message (qtfc_task_id, ^intertask_message, #SIZE (intertask_message), 0,
                transfer_count, message_status);
        UNTIL ((message_status.normal) AND (transfer_count = 0)) OR NOT message_status.normal;
      IFEND;

      nfp$end_async_communication (message_status.normal, handler_status);
      IF message_status.normal AND (NOT handler_status.normal) THEN
        retry_count := 0;
        REPEAT

{ QTFI should wait for 100 milliseconds.  This is done to insure that the
{ last message sent was picked up by QTFC.

          pmp$wait (qtfi_tenth_of_a_second, qtfi_tenth_of_a_second);
          nfp$end_async_communication (message_status.normal, handler_status);
          retry_count := retry_count + 1;
        UNTIL handler_status.normal OR (retry_count = 10);

{ This makes sure that QTFI will end communication with QTFC and terminate.
{ If QTFI can't end communications, this assumes that QTFC is going down and is
{ not able to talk to QTFI.

        IF retry_count = 10 THEN
          nfp$end_async_communication (FALSE, handler_status);
        IFEND;
      IFEND;

    PROCEND exit_condition_handler;
?? TITLE := 'initialize_control_block', EJECT ??

{ PURPOSE:
{   This procedure makes a call to initialize the control block
{   used by the protocol engine.

    PROCEDURE initialize_control_block
      (    parameter_rules: ^nft$parameter_rules_array;
       VAR control_block: nft$control_block;
       VAR control_block_needs_initialized: boolean;
       VAR status: ost$status);

      CONST
        application = nfc$application_qtf,
        data_declaration = nfc$p31_host_dependent_uh,
        initial_protocol = nfc$p00_a102,
        mode_of_access = nfc$take;

      VAR
        allowed_facilities: nft$parameter_03_value_set,
        requested_facilities: nft$parameter_03_value_set,
        required_facilities: nft$parameter_03_value_set;


      status.normal := TRUE;

      allowed_facilities := $nft$parameter_03_value_set [nfc$multiple_data_phase_params,
            nfc$collective_text_string, nfc$temporary_hold, nfc$go_command_parameters, nfc$later_resumption,
            nfc$restart_permitted, nfc$checkmark_ack_required, nfc$ss_ack_required, nfc$data_compression];
      requested_facilities := $nft$parameter_03_value_set [];
      required_facilities := $nft$parameter_03_value_set [];

      nfp$initialize_control_block (application, data_declaration, requested_facilities, required_facilities,
            allowed_facilities, initial_protocol, mode_of_access, parameter_rules, control_block);

      control_block.protocol_in_use := nfc$p00_a102;
      control_block.path.network_file := NIL;
      control_block.path.path_connected := FALSE;
      control_block.transfer_pid := osc$null_name;
      control_block.send_systems_routing_text.parameters := nfc$p32_cyber_id;
      control_block.send_systems_routing_text.size := nfc$p32_cyber_id_length;
      control_block.mode_of_access := nfc$take;
      control_block.mode_of_access_option := nfc$p21_make_only;
      control_block.local_host_type := nfc$p22_nos_ve_qtf;

      control_block_needs_initialized := FALSE;

    PROCEND initialize_control_block;
?? OLDTITLE, EJECT ??
    status.normal := TRUE;
    control_block_needs_initialized := TRUE;

    nfp$begin_asynchronous_task (parameters, qtfc_task_id, queue_id, status);
    IF NOT status.normal THEN
      RETURN; {----->
    IFEND;

    pmp$establish_condition_handler (exit_condition, ^exit_condition_handler, ^establish_descriptor, status);
    IF NOT status.normal THEN
      RETURN; {----->
    IFEND;
    PUSH wait_list: [1 .. 1];
    wait_list^ [1].activity := pmc$i_await_local_queue_message;
    wait_list^ [1].qid := queue_id;

    WHILE TRUE DO
      osp$i_await_activity_completion (wait_list^, ready_index, status);
      IF NOT status.normal THEN
        osp$set_status_abnormal(nfc$status_id,nfe$bts_internal_error,
             'QTF controller - invalid local queue status',status);
        nfp$format_message_to_job_log( status );
        RETURN;
      IFEND;
      IF (wait_list^ [ready_index].activity = pmc$i_await_local_queue_message) THEN
        nfp$get_async_task_message (qtfc_task_id, ^intertask_message, #SIZE (intertask_message), 0,
              transfer_count, status);
        IF status.normal AND (transfer_count > 0) THEN
          CASE intertask_message.kind OF
          = nfc$qtf_file_transfer =
            IF control_block_needs_initialized THEN
              initialize_control_block (^nfv$qtf_parameter_rules, control_block,
                    control_block_needs_initialized, status);
              IF NOT status.normal THEN
                RETURN; {----->
              IFEND;
            IFEND;
            transfer_file (qtfc_task_id, intertask_message, control_block, status);

          = nfc$qtf_terminate_connection =
            terminate_connection (qtfc_task_id, intertask_message.connect_file_name, control_block);
            control_block_needs_initialized := TRUE;

          = nfc$qtf_terminate_task =
            ready_task_for_termination (qtfc_task_id, control_block);
            pmp$disestablish_cond_handler (exit_condition, status);
            RETURN; {----->

          = nfc$btf_file_transfer, nfc$btf_file_transfer_status, nfc$qtf_file_transfer_status,
                nfc$qtf_connection_terminated, nfc$qtf_task_terminated =

{ These message kinds should not be received.

            osp$set_status_abnormal(nfc$status_id,nfe$bts_internal_error,
               'QTF controller - invalid local queue message',status);
            nfp$format_message_to_job_log( status );
            RETURN;

          ELSE
            osp$set_status_abnormal(nfc$status_id,nfe$bts_internal_error,
               'QTF controller - invalid local queue message',status);
            nfp$format_message_to_job_log( status );
            RETURN;
          CASEND;
        IFEND;

      IFEND;
    WHILEND;

  PROCEND nfp$qtf_initiator;
MODEND nfm$qtf_initiator;
