
*copyc OSD$DEFAULT_PRAGMATS
?? NEWTITLE := '170 NOS/VE REMOTE HOST' ??
MODULE rhmqrf;

{ Select target 170 operating system.
*IF ($string($name(wev$target_operating_system))='NOS')

  ?VAR rhv$nos_be: boolean := FALSE ?;
*ELSE

  ?VAR rhv$nos_be: boolean := TRUE ?;
*IFEND
?? NEWTITLE := 'GLOBAL TYPE DECLARATIONS' ??
?? SET (LIST := ON) ??
?? EJECT ??
*copyc RHT$FUNCTION_STATUS

?? TITLE := 'EXTERNAL PROCEDURES REFERENCED BY THIS MODULE' ??
?? SET (LIST := ON) ??
?? EJECT ??
*copyc ZUTPS2D
*copyc RHP$LOG_STATUS
*copyc ZUTPDNS
*copyc ZUTPSDN
*copyc ZUTPI2S
?? SET (LIST := ON) ??

? IF rhv$nos_be = FALSE THEN
    TYPE

      valid_family_rec = packed record
        family: 0 .. 3ffffffffff(16),
        filler1: 0 .. 3f(16),
        reply_code: 0 .. 0fff(16),
      recend,

      perm_file_info_rec = packed record
        family_name: 0 .. 3ffffffffff(16),
        zero: 0 .. 3ffff(16),
        filler1: integer,
        user_name: 0 .. 3ffffffffff(16),
        filler2: 0 .. 3ffff(16),
      recend;


  PROCEDURE [XREF] rhpgpfp (VAR perm_file_info: perm_file_info_rec);

  PROCEDURE [XREF] rhpvfam (VAR valid_family_info: valid_family_rec);

  PROCEDURE [XREF] rhpglvl (VAR level_number: integer);
? IFEND
?? TITLE := 'ROUTE_FILE' ??
?? EJECT ??

{ ROUTE_FILE
{
{     The purpose of this procedure is to provide a means by which
{ a CYBIL procedure can route a local file to a system queue.
{
{           ROUTE_FILE (QUEUE_TYPE,LOCAL_FILE_INFO,QUEUE_FILE_INFO,ROUTE_STATUS)
{
{ QUEUE_TYPE: (input) This parameter specifies the destination queue
{             to which the file is to be routed.
{
{ LOCAL_FILE_INFO: (input) This parameter specifies all information
{                  pertinent to local file access.
{
{ QUEUE_FILE_INFO: (input) This parameter communicates all queue file
{                  attributes needed for IRHF routing.
{
{ ROUTE_STATUS: (output) This parameter indicates to the calling
{               procedure the completion status of the route function,
{               i.e. the success or failure of the route.  The
{               following status values may be returned by this
{               request:     unsuccessful
{                            successful
{

  PROCEDURE [XDCL] route_file (exec_type: rht$irhf_exec_types;
    VAR local_file_info: rht$local_file_info;
        queue_file_info: rht$queue_file_info;
    VAR route_status: rht$function_status);
  ? IF rhv$nos_be = FALSE THEN
    CONST
      input_forms_code = 010010001000(2), { display code for RH }
      pr_disposition_code = 010000010010(2), { display code for PR }
      in_disposition_code = 001110001111(2), { display code for NO }
      communication_task = 000011010100(2),  { display code for CT }
      batch_service_class = 000010000011(2), { display code for BC }
      input_q_disposition_code = 001001001110(2), { display code for IN }
      wait_disposition_code = 2724(8), { display code for WT }
      invalid_family = 7777(8),
      a9_ascii_ex_code = 6,
      ascii_ic_code = 1,
      display_code_ic_code = 0,
      system_origin_type = 0,
      local_batch_origin_type = 1,
      export_import_origin_type = 2,
      null_equipment_code_67 = 55,
      a170_repeat_count_max = 1f(16),
      no_rerun = 512, {1000(8)}
      input_flags = no_rerun;

    TYPE
      route_parameter_block = packed record
{- - - - - - - - - - - - - - - - - - - - - - Word 0
        lfn: 0 .. 3ffffffffff(16),
        ec: 0 .. 3f(16),
        f: boolean,
        filler1: 0 .. 0f(16),
        ot: 0 .. 3f(16),
        c: boolean,
{- - - - - - - - - - - - - - - - - - - - - - Word 1
        zero: 0 .. 0fff(16),
        forms: 0 .. 0fff(16),
        disp: 0 .. 0fff(16),
        ex: 0 .. 7,
        forced_service_class: boolean,
        ic: 0 .. 3,
        flags: route_flags,
{- - - - - - - - - - - - - - - - - - - - - - Word 2
        source_lid: 0 .. 3ffff(16),
        destination_lid: 0 .. 3ffff(16),
        tid: - 7fffff(16) .. 7fffff(16),
{- - - - - - - - - - - - - - - - - - - - - - Word 3
        user_job_name: 0 .. 3ffffffffff(16),
        reserved3: 0 .. 1f(16),
        b: boolean,
        priority: 0 .. 0fff(16),
{- - - - - - - - - - - - - - - - - - - - - - Word 4
        spacing: 0 .. 0fff(16),
        service_class: 0 .. 0fff(16),
        abort_code: 0 .. 0fff(16),
        reserved4b: 0 .. 7f(16),
        rc: 0 .. 1f(16),
        reserved4c: 0 .. 0fff(16),
{- - - - - - - - - - - - - - - - - - - - - - Word 5
        reserved5: integer,
{- - - - - - - - - - - - - - - - - - - - - - Word 6
        reserved6: integer,
{- - - - - - - - - - - - - - - - - - - - - - Word 7
        data_declaration : 0 .. 0fff(16),
        eoi_random_address : 0 .. 0ffffff(16),
        reserved7 : 0 .. 3f(16),
        extended_flags: extended_route_flags,
{- - - - - - - - - - - - - - - - - - - - - - Word 8
        owner_user_name : 0 .. 3ffffffffff(16),
        irtaddr : 0 .. 3ffff(16),
{- - - - - - - - - - - - - - - - - - - - - - Word 9
        owner_family_name : 0 .. 3ffffffffff(16),
        ertaddr : 0 .. 3ffff(16),
{- - - - - - - - - - - - - - - - - - - - - - Word 10
        creator_user_name : 0 .. 3ffffffffff(16),
        control_point : 0 .. 3f(16),
        subsystem_id : 0 .. 0fff(16),
{- - - - - - - - - - - - - - - - - - - - - - Word 11
        creator_family_name : 0 .. 3ffffffffff(16),
        reserved11 : 0 .. 3ffff(16),
{- - - - - - - - - - - - - - - - - - - - - - Word 12
        reserved12: integer,
{- - - - - - - - - - - - - - - - - - - - - - Word 13
        reserved13: integer,
{- - - - - - - - - - - - - - - - - - - - - - Word 14
        reserved14: integer,
{- - - - - - - - - - - - - - - - - - - - - - Word 15
{ Separate the charge numbers into 2 parts as we cannot
{ compile something that is defined to be more than 48 bits.
{ The same holds true for the project numbers.

        charge_number1: 0 .. 3fffffff(16),
        charge_number2: 0 .. 3fffffff(16),
{- - - - - - - - - - - - - - - - - - - - - - Word 16 and 17
        project_number1a: 0 .. 3fffffff(16),
        project_number1b: 0 .. 3fffffff(16),
        project_number2a: 0 .. 3fffffff(16),
        project_number2b: 0 .. 3fffffff(16),
      recend,
      extended_route_flags = packed record
        reserved1: 0 .. 07f(16),
        charge_project_req: boolean,
        no_validation_needed: boolean,
        special_requeue_op: boolean,
        use_encrypted_password : boolean,
        use_original_default_service : boolean,
        cp_and_ssid_specified : boolean,
        do_not_validate_password :boolean,
        subsystem_call : boolean,
        create_user_name_or_family_name : boolean,
        owner_user_name_or_family_name : boolean,
        data_decl : boolean,
      recend,
      route_flags = packed record
        return_system_file_name: boolean,
        accounting: boolean,
        pfc_580_spacing_code: boolean,
        repeat_count: boolean,
        ujn_specified: boolean,
        return_error_code: boolean,
        reserved3: 0 .. 1,
        forms_code: boolean,
        priority: boolean,
        internal_characteristics: boolean,
        external_characteristics: boolean,
        extended_parameter_block: boolean,
        reserved4: 0 .. 1,
        disposition_code: boolean,
        dlid_slid: boolean,
        tid: boolean,
        route_to_central_site: boolean,
        end_of_job: boolean,
      recend,
      forms_conversion_buffer_record = record
        case i: integer of
        = 1 =
          dc_string: array [1 .. 1] of packed array [0 .. 9] of 0 .. 3f(16),
        = 2 =
          forms_rec: packed record
            forms: 0 .. 0fff(16),
            filler: 0 .. 0ffffffffffff(16),
          recend,
        casend,
      recend,
      ujn_conversion_buffer_record = record
        case l: integer of
        = 1 =
          dc_string: array [1 .. 1] of packed array [0 .. 9] of 0 .. 3f(16),
        = 2 =
          ujn_rec: packed record
            ujn: 0 .. 3ffffffffff(16),
            filler2: 0 .. 3ffff(16),
          recend,
        casend,
      recend,
      charge_conversion_buffer_rec = record
        case o: integer of
        = 1 =
          dc_string: array [1 .. 4] of packed array [0 .. 9] of 0 .. 3f(16),
        = 2 =
          charge_rec: packed record
            charge1: 0 .. 3fffffff(16),
            charge2: 0 .. 3fffffff(16),
            filler1: integer,
            filler2: integer,
            filler3: integer,
          recend,
        casend,
      recend,
      project_conversion_buffer_rec = record
        case p: integer of
        = 1 =
          dc_string: array [1 .. 4] of packed array [0 .. 9] of 0 .. 3f(16),
        = 2 =
          project_rec: packed record
            project1a: 0 .. 3fffffff(16),
            project1b: 0 .. 3fffffff(16),
            project2a: 0 .. 3fffffff(16),
            project2b: 0 .. 3fffffff(16),
            filler1: integer,
            filler2: integer,
          recend,
        casend,
      recend,
      lid_conversion_buffer_record = record
        case k: integer of
        = 1 =
          dc_string: array [1 .. 1] of packed array [0 .. 9] of 0 .. 3f(16),
        = 2 =
          lid_rec: packed record
            lid: 0 .. 3ffff(16),
            filler: 0 .. 3ffffffffff(16),
          recend,
        casend,
      recend,
      implicit_dc_string_record = packed record
        implicit_text_size: integer,
        dc_string: array [1 .. 26] of packed array [0 .. 9] of 0 .. 3f(16),
      recend,
      tid_block_rec = packed record
        destination_family_name: utt$dc_name,
        filler1: 0 .. 3ffff(16),
        destination_user_number: utt$dc_name,
        filler2: 0 .. 3ffff(16),
      recend;

    VAR
      routepb_initial: [STATIC] route_parameter_block :=
        [0, 0, TRUE, 0, 0, FALSE, 0, 0, 0, 0, FALSE, 0,
        [TRUE, FALSE, FALSE, FALSE, FALSE, TRUE, 0, TRUE, FALSE,
         TRUE, TRUE, FALSE, 0, TRUE, FALSE, FALSE, TRUE, FALSE],
        0, 0, 0, 0, 0, FALSE, 0, 0, batch_service_class, 0, 0, 0, 0, 0, 0,
{  The following 11 words are needed to make an extended DSP block call.
        0, 0, 0,[0, FALSE, FALSE, FALSE, FALSE, FALSE, FALSE, FALSE,
        FALSE, FALSE, FALSE, FALSE],
        0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0],
      implicit_dc_string: implicit_dc_string_record,
      routepb: route_parameter_block,
      forms_conversion_buffer: forms_conversion_buffer_record,
      dc_string_word_index: integer,
      dc_string_char_index: 0 .. 9,
      source_index: ost$string_index,
      eol: boolean,
      perm_file_info: perm_file_info_rec,
      valid_family_info: valid_family_rec,
      ujn_conversion_buffer: ujn_conversion_buffer_record,
      lid_conversion_buffer: lid_conversion_buffer_record,
      charge_conversion_buffer: charge_conversion_buffer_rec,
      project_conversion_buffer: project_conversion_buffer_rec,
      irtaddr_ptr: ^implicit_dc_string_record,
      irt_address_ptr: ^integer,
      tid_block: tid_block_rec,
      tid_blk_ptr: ^tid_block_rec,
      tid_blk_addr_ptr: ^integer,
      error_code_length: 1 .. 2,
      route_error_message: string (27),
      route_error_occurred: boolean,
      dc_name: utt$dc_name,
      route_exec_type: rht$irhf_exec_types,
      dc_family_name: utt$dc_name,
      dc_user_name: utt$dc_name,
      owner_family: utt$dc_name,
      owner_user: utt$dc_name,
      level_number: integer,
      str: string(31),
      i: integer,
      j: integer,
      file_name_length: 0 .. 7;

?? SET (LIST := OFF) ??
{ This call to rhxqrm needs to be here so the route_parameter_block
{     TYPE may be used by this XREF.
*copyc RHP$ROUTE
?? SET (LIST := ON) ??

{ Insert parameters into the route parameter block.  The route parameter
{ block is defined in the NOS REFERENCE SET VOLUME 4 PROGRAM INTERFACE manual.

    route_exec_type := exec_type;
    routepb := routepb_initial;
    routepb.lfn := local_file_info.fet.filename;
    CASE route_exec_type OF
    = transmit_exec =

{ This sends a 180 job submitted from NOS to the NOS input queue.
      routepb.flags.extended_parameter_block := true;
      routepb.extended_flags.special_requeue_op := true;
      routepb.flags.forms_code := false;
      routepb.flags.internal_characteristics :=false;
      routepb.flags.external_characteristics :=false;
      routepb.flags.disposition_code := false;
    = receive_exec =

{ This sends a job to the NOS output queue.
      routepb.ot := local_batch_origin_type; { fix for C180 acquire }
      { ROUTEpb.ot:=queue_file_info.A170.origin_type;
      dc_string_word_index := 1;
      dc_string_char_index := 0;
      source_index := 1;
      eol := FALSE;
      utp$convert_string_to_dc_string (utc$ascii64, forms_conversion_buffer.dc_string, dc_string_word_index,
            dc_string_char_index, queue_file_info.a170.form_code, source_index, eol);
      IF (forms_conversion_buffer.forms_rec.forms = 2925) THEN
        routepb.flags.forms_code := FALSE;         {5555(8)=blanks}
      ELSE
        routepb.flags.forms_code := TRUE;
        routepb.forms := forms_conversion_buffer.forms_rec.forms;
      IFEND;
      routepb.flags.accounting := TRUE;
      utp$convert_string_to_dc_name(queue_file_info.a170.user_number_of_owner.a170_owner_user_num,
          dc_user_name);
      utp$convert_string_to_dc_name(
         queue_file_info.a170.family_name_of_creator.a170_creator_family_name, dc_family_name);
      routepb.flags.extended_parameter_block := true;
      routepb.extended_flags.use_original_default_service := true;
      routepb.extended_flags.create_user_name_or_family_name := true;
      routepb.extended_flags.owner_user_name_or_family_name := true;
      routepb.owner_user_name:= dc_user_name;
      routepb.creator_user_name:= dc_user_name;

{ Validate that the family exists on NOS.  If it does not then use
{ the default NOS family that the IRHF170 job runs under.

      valid_family_info.family := dc_family_name;
      valid_family_info.filler1 := 0;
      valid_family_info.reply_code := 0;
      rhpvfam (valid_family_info);
      IF valid_family_info.reply_code = invalid_family THEN

{ The family does not exist on NOS, get the default NOS family.

        rhpgpfp (perm_file_info); { get default family and user }
        routepb.owner_family_name := perm_file_info.family_name;
        routepb.creator_family_name := perm_file_info.family_name;
      ELSE  { family was valid on NOS. }
        routepb.creator_family_name := dc_family_name;
        routepb.owner_family_name := dc_family_name;
      IFEND;
      routepb.disp := pr_disposition_code;
      routepb.ex := a9_ascii_ex_code;
      routepb.ic := ascii_ic_code;
      routepb.flags.repeat_count := TRUE;
      IF (queue_file_info.a170.logical_identifier.a170_logical_identifier <> ' ') THEN
        routepb.flags.dlid_slid := TRUE;
        dc_string_word_index := 1;
        dc_string_char_index := 0;
        source_index := 1;
        eol := FALSE;
        utp$convert_string_to_dc_string (utc$ascii64, lid_conversion_buffer.dc_string, dc_string_word_index,
              dc_string_char_index, queue_file_info.a170.logical_identifier.a170_logical_identifier,
              source_index, eol);
        routepb.destination_lid := lid_conversion_buffer.lid_rec.lid;
      IFEND;
      IF queue_file_info.a170.implicit_text_size <> 0 THEN

{  Get the information off of the implicit routing text field
{  in order to route the file to the correct NOS output queue.

        IF queue_file_info.a170.implicit_routing_text (1,6) = 'IRHNVE' THEN
          utp$convert_string_to_dc_name(
              queue_file_info.a170.implicit_routing_text (59, 7), owner_family);
          utp$convert_string_to_dc_name(
              queue_file_info.a170.implicit_routing_text (74, 7), owner_user);
          routepb.owner_user_name := owner_user;
          routepb.creator_user_name := owner_user;
          routepb.owner_family_name := owner_family;
          routepb.creator_family_name := owner_family;
          IF queue_file_info.a170.implicit_routing_text (49,2) = 'TO' THEN
            routepb.disp := wait_disposition_code;
          IFEND;
          IF queue_file_info.a170.implicit_routing_text (21,7) <> '       ' THEN
            utp$convert_string_to_dc_name(queue_file_info.a170.implicit_routing_text (21,7),
                dc_family_name);
            tid_block.destination_family_name := dc_family_name;
            utp$convert_string_to_dc_name(queue_file_info.a170.implicit_routing_text (35,7),
                dc_user_name);
            tid_block.destination_user_number := dc_user_name;
            tid_block.filler1 := 0;
            tid_block.filler2 := 0;
            tid_blk_ptr := ^tid_block;
            tid_blk_addr_ptr := #LOC (tid_blk_ptr);
            routepb.tid := -(tid_blk_addr_ptr^);
            routepb.flags.tid := TRUE;
            routepb.flags.route_to_central_site := FALSE;
            routepb.ot := export_import_origin_type;
          IFEND;
        ELSE
          dc_string_word_index := 1;
          dc_string_char_index := 0;
          source_index := 1;
          eol := FALSE;
          utp$convert_string_to_dc_string (utc$ascii64, implicit_dc_string.dc_string,
              dc_string_word_index, dc_string_char_index,
              queue_file_info.a170.implicit_routing_text, source_index, eol);
          implicit_dc_string.implicit_text_size :=
              queue_file_info.a170.implicit_text_size;

{ Set the address of the implicit text field in the route parameter block.
          irtaddr_ptr := ^implicit_dc_string;
          irt_address_ptr := #LOC (irtaddr_ptr);
          routepb.irtaddr := irt_address_ptr^;
        IFEND;
      IFEND;
      IF queue_file_info.a170.repeat_count - 1 <= a170_repeat_count_max THEN
        routepb.rc := queue_file_info.a170.repeat_count - 1;
      ELSE
        routepb.rc := a170_repeat_count_max;
        log_status (dayfile_log, 'repeat_count>A170_repeat_count_max');
        log_status (dayfile_log, 'repeat_count set:=A170_repeat_count_max');
      IFEND;
      routepb.flags.ujn_specified := TRUE;
      str := ' ';
      j := 1;
      FOR i := 1 TO 7 DO
        IF ((queue_file_info.a170.user_number_of_owner.a170_owner_user_num (i) >= 'A') AND
            (queue_file_info.a170.user_number_of_owner.a170_owner_user_num (i) <= 'Z')) OR
           ((queue_file_info.a170.user_number_of_owner.a170_owner_user_num (i) >= '0') AND
            (queue_file_info.a170.user_number_of_owner.a170_owner_user_num (i) <= '9')) OR
            (queue_file_info.a170.user_number_of_owner.a170_owner_user_num (i) = '*') THEN
          str (j) := queue_file_info.a170.user_number_of_owner.a170_owner_user_num (i);
          j := j + 1;
        IFEND;
      FOREND;
      dc_string_word_index := 1;
      dc_string_char_index := 0;
      source_index := 1;
      eol := FALSE;
      utp$convert_string_to_dc_string (utc$ascii64, ujn_conversion_buffer.dc_string,
          dc_string_word_index, dc_string_char_index, str (1, 7), source_index, eol);
      routepb.user_job_name := ujn_conversion_buffer.ujn_rec.ujn;
      rhpglvl (level_number);
      IF (level_number >= 664) THEN

{ Convert the charge number.

        str := ' ';
        j := 1;
        FOR i := 1 TO 31 DO
          IF ((queue_file_info.a170.user_charge_number (i) >= 'A') AND
              (queue_file_info.a170.user_charge_number (i) <= 'Z')) OR
             ((queue_file_info.a170.user_charge_number (i) >= '0') AND
              (queue_file_info.a170.user_charge_number (i) <= '9')) OR
              (queue_file_info.a170.user_charge_number (i) = '*') THEN
            str (j) := queue_file_info.a170.user_charge_number (i);
            j := j + 1;
          IFEND;
        FOREND;
        dc_string_word_index := 1;
        dc_string_char_index := 0;
        source_index := 1;
        eol := FALSE;
        utp$convert_string_to_dc_string (utc$ascii64, charge_conversion_buffer.dc_string,
            dc_string_word_index, dc_string_char_index, str (1, 10), source_index, eol);
        routepb.charge_number1 := charge_conversion_buffer.charge_rec.charge1;
        routepb.charge_number2 := charge_conversion_buffer.charge_rec.charge2;

{ Convert the project number.

        str := ' ';
        j := 1;
        FOR i := 1 TO 31 DO
          IF ((queue_file_info.a170.user_project_number (i) >= 'A') AND
              (queue_file_info.a170.user_project_number (i) <= 'Z')) OR
             ((queue_file_info.a170.user_project_number (i) >= '0') AND
              (queue_file_info.a170.user_project_number (i) <= '9')) OR
              (queue_file_info.a170.user_project_number (i) = '*') THEN
            str (j) := queue_file_info.a170.user_project_number (i);
            j := j + 1;
          IFEND;
        FOREND;
        dc_string_word_index := 1;
        dc_string_char_index := 0;
        source_index := 1;
        eol := FALSE;
        utp$convert_string_to_dc_string (utc$ascii64, project_conversion_buffer.dc_string,
            dc_string_word_index, dc_string_char_index, str (1, 20), source_index, eol);
        routepb.project_number1a := project_conversion_buffer.project_rec.project1a;
        routepb.project_number1b := project_conversion_buffer.project_rec.project1b;
        routepb.project_number2a := project_conversion_buffer.project_rec.project2a;
        routepb.project_number2b := project_conversion_buffer.project_rec.project2b;
        routepb.extended_flags.charge_project_req := TRUE;
      IFEND;

    = pj_exec, prif_pj_exec =

{ This sends a NOS partner job to the NOS input queue.
      routepb.ot := local_batch_origin_type;
      routepb.forms := input_flags;
      routepb.disp := in_disposition_code;
      routepb.flags.internal_characteristics := FALSE;
      routepb.flags.external_characteristics := FALSE;
      rhpglvl (level_number);
      IF (level_number > 638) or (route_exec_type = prif_pj_exec) THEN
        routepb.service_class := communication_task;
        routepb.forced_service_class := TRUE;
        routepb.extended_flags.no_validation_needed := TRUE;
        routepb.flags.extended_parameter_block :=TRUE;
        IF route_exec_type = prif_pj_exec THEN
          routepb.extended_flags.subsystem_call := TRUE;
        IFEND;
      IFEND;
    CASEND;

    IF route_exec_type = pj_exec THEN
      rhppjr (routepb);
    ELSE
      rhpqrm (routepb);
    IFEND;
    route_error_occurred := false;
    IF routepb.ec = 0 THEN
      IF route_exec_type = pj_exec THEN
        local_file_info.fet.filename := routepb.lfn;
      IFEND;
      route_status := successful;
    ELSEIF (route_exec_type = receive_exec) THEN { retry receiving the file. }
{       Use default parameters if possible.
      routepb.c := FALSE;
      IF routepb.ec = 18 THEN  {18 = Forms code not alphanumeric.
        routepb.flags.forms_code := FALSE;
      ELSEIF routepb.ec = 32 THEN  {32 = Invalid origin type.
        routepb.tid := 0;
        routepb.flags.tid := FALSE;
        routepb.flags.route_to_central_site := TRUE;
      IFEND;
      rhpqrm (routepb);
      IF routepb.ec = 0 THEN
        route_status := successful;
      ELSE
        route_error_occurred := true;
      IFEND;
    ELSE
      route_error_occurred := true;
    IFEND;
    IF route_error_occurred THEN
      CASE routepb.ec OF
      = 6 =
        log_status (dayfile_log_and_display, 'Immediate routing, no file was found');
      = 13 =
        log_status (dayfile_log_and_display, 'Incorrect LID specified, file not routed');
      = 17 =
        log_status (dayfile_log_and_display, 'Incorrect TID specified, file not routed');
      = 28 =
        log_status (dayfile_log_and_display, 'An invalid charge command has been encountered');
        log_status (dayfile_log_and_display, 'Verify that the PROFILC file exists and that it is ok');
      = 37 =
        log_status (dayfile_log_and_display, 'Incorrect service class, file not routed');
      ELSE
        route_error_message (1, 12) := 'Route error ';
        STRINGREP (route_error_message (13, 3), error_code_length, routepb.ec);
        route_error_message (13 + error_code_length, 5) := ' for ';
        dc_name := local_file_info.fet.filename;
        utp$convert_dc_name_to_string (dc_name, route_error_message (18 + error_code_length, 7),
            file_name_length);
        log_status (dayfile_log_and_display, route_error_message);
      CASEND;
      route_status := unsuccessful;
    IFEND;

  ? ELSE
    CONST
      pr_disposition_code = 010000010010(2), { display code for PR }
      input_q_disposition_code = 001001001110(2), { display code for IN }
      a9_ascii_ex_code = 6,
      ascii_ic_code = 1,
      display_code_ic_code = 0,
      nosbe_priority = 4095, {7777B
      a170_repeat_count_max = 1f(16),
      input_flags = 768; {01400B - dont_catalog_input and seven_char_jsn_spec

    TYPE
      route_parameter_block = packed record
{- - - - - - - - - - - - - - - - - - - - - - Word 0
        lfn: 0 .. 3ffffffffff(16),
        ec: 0 .. 3f(16),
        filler1: 0 .. 7ff(16),
        c: boolean,
{- - - - - - - - - - - - - - - - - - - - - - Word 1
        zero: 0 .. 0fff(16),
        forms: 0 .. 0fff(16),
        disp: 0 .. 0fff(16),
        ex: 0 .. 7,
        filler2: boolean,
        ic: 0 .. 3,
        flags: route_flags,
{- - - - - - - - - - - - - - - - - - - - - - Word 2
        source_lid: 0 .. 3ffff(16),
        destination_lid: 0 .. 3ffff(16),
        filler3: 0 .. 0fff(16),
        tid: 0 .. 0fff(16),
{- - - - - - - - - - - - - - - - - - - - - - Word 3
        user_job_name: 0 .. 3ffffffffff(16),
        filler4: 0 .. 1f(16),
        b: boolean,
        priority: 0 .. 0fff(16),
{- - - - - - - - - - - - - - - - - - - - - - Word 4
        pre_dayfile: 0 .. 3ffffffffff(16),
        filler5: boolean,
        rc: 0 .. 1f(16),
        filler6: 0 .. 0fff(16),
{- - - - - - - - - - - - - - - - - - - - - - Word 5
        reserved1: 0 .. 3ffffffffff(16),
        fwa_of_routing_packet: ^CELL,
      recend,

      routing_info_packet = packed record
{ - - - - - - - - - - - - - - - - -  - - - - - - - - - - - Word 0
        fill1: 0 .. 3ffffffffff(16),
        imp_text_length: 0 .. 0fff(16),
        imp_text_word_count: 0 .. 3f(16),
{ - - - - - - - - - - - - - - - - - - - - - - - - - - - - Word 1 thru 26
        implicit_routing_text: array [1 .. 26] of packed array [0 .. 9]
            of 0 .. 63,
{ - - - - - - - - - - - - - - - - - - - - - - - - - - - - Word 27
        fill2: 0 .. 3ffffffffff(16),
        exp_text_length: 0 .. 0fff(16),
        exp_text_word_count: 0 .. 3f(16),
{ - - - - - - - - - - - - - - - - - - - - - - - - - - - - Word 28 thru 53
        explicit_routing_text: array [1 .. 26] of integer,
{ - - - - - - - - - - - - - - - - - - - - - - - - - - - - Word 54
        fill3: 0 .. 0ffffffffffff(16),
        data_declaration: 0 .. 0fff(16),
{ - - - - - - - - - - - - - - - - - - - - - - - - - - - - Word 55
        id: 0 .. 3f(16),
        fill4a: 0 .. 3f(16),
        fill4: 0 .. 0ffffffffffff(16),
{ - - - - - - - - - - - - - - - - - - - - - - - - - - - - Word 56
        dest_user_number: 0 .. 3ffffffffff(16),
        fill5: 0 .. 3ffff(16),
{ - - - - - - - - - - - - - - - - - - - - - - - - - - - - Word 57
        dest_family_name: 0 .. 3ffffffffff(16),
        fill6: 0 .. 3ffff(16),
{ - - - - - - - - - - - - - - - - - - - - - - - - - - - - Word 58 thru 63
        reserved58_63: array [1 ..5] of integer,
      recend,

      route_flags = packed record
        return_system_file_name: boolean,
        routing_info_specified: boolean,
        pfc_580_spacing_code: boolean,
        repeat_count: boolean,
        dayfile_attached: boolean,
        return_error_code: boolean,
        pre_dayfile_specified: boolean,
        forms_code: boolean,
        priority: boolean,
        internal_characteristics: boolean,
        external_characteristics: boolean,
        append_unique_char_to_fid: boolean,
        file_ident_specified: boolean,
        disposition_code: boolean,
        dlid_slid: boolean,
        tid: boolean,
        route_to_central_site: boolean,
        end_of_job: boolean,
      recend,
      forms_conversion_buffer_record = record
        case k: integer of
        = 1 =
          dc_string: array [1 .. 1] of packed array [0 .. 9] of 0 .. 3f(16),
        = 2 =
          forms_rec: packed record
            forms: 0 .. 0fff(16),
            filler: 0 .. 0ffffffffffff(16),
          recend,
        casend,
      recend,
      fid_conversion_buffer_record = record
        case l: integer of
        = 1 =
          dc_string: array [1 .. 1] of packed array [0 .. 9] of 0 .. 3f(16),
        = 2 =
          fid_rec: packed record
            fid: 0 .. 3ffffffffff(16),
            filler2: 0 .. 3ffff(16),
          recend,
        casend,
      recend,
      lid_conversion_buffer_record = record
        case m: integer of
        = 1 =
          dc_string: array [1 .. 1] of packed array [0 .. 9] of 0 .. 3f(16),
        = 2 =
          lid_rec: packed record
            lid: 0 .. 3ffff(16),
            filler: 0 .. 3ffffffffff(16),
          recend,
        casend,
      recend,
      tid_conversion_buffer_record = record
        case n: integer of
        = 1 =
          dc_string: array [1 .. 1] of packed array [0 .. 9] of 0 .. 3f(16),
        = 2 =
          tid_rec: packed record
            tid: 0 .. 0fff(16),
            filler: 0 .. 0ffffffffffff(16),
          recend,
        casend,
      recend;

    VAR
      routepb_initial: [STATIC] route_parameter_block :=
        [0, 0, 0, FALSE, 0, 0, 0, 0, FALSE, 0, [TRUE, FALSE, FALSE,
        FALSE, FALSE, TRUE, FALSE, TRUE, FALSE, TRUE, TRUE, FALSE,
        FALSE, TRUE, FALSE, FALSE, TRUE, FALSE], 0, 0, 0, 0, 0, 0,
        FALSE, 0, 0, FALSE, 0, 0, 0, NIL],
      routepb: route_parameter_block,
      routeip_init_block: [STATIC] routing_info_packet :=
{     - - - - implicit routing info - - - -
        [0, 0, 0, [REP 26 OF [REP 10 OF 0]],
{     - - - - explicit routing info - - - -
         0, 0, 0, [REP 26 OF 0],
{     - - - - initialize rest of block (words 55 thru 63)
         0, 0, 0, 0, 0, 0, 0, 0, 0, [REP 5 OF 0]],
      routeip: routing_info_packet,
      forms_conversion_buffer: forms_conversion_buffer_record,
      dc_string_word_index: integer,
      dc_string_char_index: 0 .. 9,
      source_index: ost$string_index,
      eol: boolean,
      fid_conversion_buffer: fid_conversion_buffer_record,
      lid_conversion_buffer: lid_conversion_buffer_record,
      tid_conversion_buffer: tid_conversion_buffer_record,
      error_code_length: 1 .. 2,
      route_error_message: string (27),
      route_error_occurred: boolean,
      dc_name: utt$dc_name,
      route_exec_type: rht$irhf_exec_types,
      str: string(7),
      i: integer,
      j: integer,
      file_name_length: 0 .. 7;

?? SET (LIST := OFF) ??
{ This call to rhxqrm needs to be here so the route_parameter_block
{     TYPE may be used by this XREF.
*copy RHP$ROUTE
?? SET (LIST := ON) ??

{ Insert parameters into the route parameter block.

    route_exec_type := exec_type;
    routepb := routepb_initial;
    routeip := routeip_init_block;
    routepb.lfn := local_file_info.fet.filename;
    routepb.fwa_of_routing_packet := #LOC (routeip);
    CASE route_exec_type OF
    = transmit_exec =
      routepb.flags.forms_code := false;
      routepb.flags.internal_characteristics :=false;
      routepb.flags.external_characteristics :=false;
      routepb.flags.disposition_code := false;
    = receive_exec =
      dc_string_word_index := 1;
      dc_string_char_index := 0;
      source_index := 1;
      eol := FALSE;
      utp$convert_string_to_dc_string (utc$ascii64, forms_conversion_buffer.dc_string, dc_string_word_index,
            dc_string_char_index, queue_file_info.a170.form_code, source_index, eol);
      IF (forms_conversion_buffer.forms_rec.forms = 2925) THEN
        routepb.flags.forms_code := FALSE;         {5555(8)=blanks}
      ELSE
        routepb.flags.forms_code := TRUE;
        routepb.forms := forms_conversion_buffer.forms_rec.forms;
      IFEND;
      routepb.disp := pr_disposition_code;
      routepb.ex := a9_ascii_ex_code;
      routepb.ic := ascii_ic_code;
      routepb.flags.repeat_count := TRUE;
      IF (queue_file_info.a170.logical_identifier.a170_logical_identifier <> ' ') THEN
        routepb.flags.dlid_slid := TRUE;
        dc_string_word_index := 1;
        dc_string_char_index := 0;
        source_index := 1;
        eol := FALSE;
        utp$convert_string_to_dc_string (utc$ascii64, lid_conversion_buffer.dc_string, dc_string_word_index,
              dc_string_char_index, queue_file_info.a170.logical_identifier.a170_logical_identifier,
              source_index, eol);
        routepb.destination_lid := lid_conversion_buffer.lid_rec.lid;
      IFEND;
      IF queue_file_info.a170.implicit_text_size <> 0 THEN
        dc_string_word_index := 1;
        dc_string_char_index := 0;
        source_index := 1;
        eol := FALSE;
        IF queue_file_info.a170.implicit_routing_text (1,6) = 'IRHNBE' THEN
          routepb.flags.tid := TRUE;
          routepb.flags.route_to_central_site := FALSE;
          utp$convert_string_to_dc_string (utc$ascii64, tid_conversion_buffer.dc_string, dc_string_word_index,
                dc_string_char_index, queue_file_info.a170.implicit_routing_text (9,2), source_index, eol);
          routepb.tid := tid_conversion_buffer.tid_rec.tid;
        ELSE
          utp$convert_string_to_dc_string (utc$ascii64, routeip.implicit_routing_text, dc_string_word_index,
                dc_string_char_index, queue_file_info.a170.implicit_routing_text, source_index, eol);
          routeip.imp_text_length := queue_file_info.a170.implicit_text_size;
          routepb.flags.routing_info_specified := TRUE;
        IFEND;
      IFEND;
      IF queue_file_info.a170.repeat_count - 1 <= a170_repeat_count_max THEN
        routepb.rc := queue_file_info.a170.repeat_count - 1;
      ELSE
        routepb.rc := a170_repeat_count_max;
        log_status (dayfile_log, 'repeat_count>A170_repeat_count_max');
        log_status (dayfile_log, 'repeat_count set:=A170_repeat_count_max');
      IFEND;
      routepb.flags.file_ident_specified := TRUE;
      routepb.flags.append_unique_char_to_fid := TRUE;
      str := 'V000000';
      j := 1;
      IF (queue_file_info.a170.user_number_of_owner.a170_owner_user_num (1) >= 'A') AND
         (queue_file_info.a170.user_number_of_owner.a170_owner_user_num (1) <= 'Z') THEN
        str (j) := queue_file_info.a170.user_number_of_owner.a170_owner_user_num (1);
        j := 2;
      IFEND;
      FOR i := 2 TO 7 DO
        IF ((queue_file_info.a170.user_number_of_owner.a170_owner_user_num (i) >= 'A') AND
           (queue_file_info.a170.user_number_of_owner.a170_owner_user_num (i) <= 'Z')) OR
           ((queue_file_info.a170.user_number_of_owner.a170_owner_user_num (i) >= '0') AND
           (queue_file_info.a170.user_number_of_owner.a170_owner_user_num (i) <= '9')) THEN
          str (j) := queue_file_info.a170.user_number_of_owner.a170_owner_user_num (i);
          j := j + 1;
        IFEND;
      FOREND;
      dc_string_word_index := 1;
      dc_string_char_index := 0;
      source_index := 1;
      eol := FALSE;
      utp$convert_string_to_dc_string (utc$ascii64, fid_conversion_buffer.dc_string,
            dc_string_word_index, dc_string_char_index, str, source_index, eol);
      routepb.user_job_name := fid_conversion_buffer.fid_rec.fid;
    = pj_exec, prif_pj_exec =
      routepb.forms := input_flags;
      routepb.disp := input_q_disposition_code;
      routepb.b := TRUE;
      routepb.priority := nosbe_priority;
      routepb.flags.file_ident_specified := TRUE;
      routepb.flags.priority := TRUE;
      routepb.flags.internal_characteristics := FALSE;
      routepb.flags.external_characteristics := FALSE;
    CASEND;

    IF route_exec_type = pj_exec THEN
      rhppjr (routepb);
    ELSE
      rhpqrm (routepb);
    IFEND;
    route_error_occurred := false;
    IF routepb.ec = 0 THEN
      IF route_exec_type = pj_exec THEN
        local_file_info.fet.filename := routepb.lfn;
      IFEND;
      route_status := successful;
    ELSEIF (route_exec_type = receive_exec) THEN { retry receiving the file. }
      routepb.c := FALSE;
      IF routepb.ec = 18 THEN  {18 = Forms code not alphanumeric.
        routepb.flags.forms_code := FALSE;
        rhpqrm (routepb);  { CALL DSP  with no forms code}
      IFEND;
      IF routepb.ec = 0 THEN
        route_status := successful;
      ELSE
        route_error_occurred := true;
      IFEND;
    ELSE
      route_error_occurred := true;
    IFEND;
    IF route_error_occurred THEN
      CASE routepb.ec OF
      = 6 =
        log_status (dayfile_log_and_display, 'Immediate routing, no file was found');
      = 17 =
        log_status (dayfile_log_and_display, 'Incorrect TID specified, file not routed');
      ELSE
        route_error_message (1, 12) := 'Route error ';
        STRINGREP (route_error_message (13, 3), error_code_length, routepb.ec);
        route_error_message (13 + error_code_length, 5) := ' for ';
        dc_name := local_file_info.fet.filename;
        utp$convert_dc_name_to_string (dc_name, route_error_message (18 + error_code_length, 7),
            file_name_length);
        log_status (dayfile_log_and_display, route_error_message);
      CASEND;
      route_status := unsuccessful;
    IFEND;
  ? IFEND

  PROCEND route_file;

MODEND rhmqrf;
