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

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

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

  ?VAR rhv$prif_for_nosbe: boolean := TRUE ?;
*IFEND

?? NEWTITLE := 'GLOBAL TYPE DECLARATIONS' ??
?? SET (LIST := OFF) ??
?? EJECT ??
*copyc RHT$FUNCTION_STATUS
*copyc RHC$CONSTANTS

?? TITLE := 'EXTERNAL PROCEDURES REFERENCED BY THIS MODULE' ??
?? SET (LIST := OFF) ??
?? EJECT ??
*copyc BIZOPEN
*copyc BIZCLOS
*copyc BIZPUT
*copyc BIZWEOR
*copyc FZMARK
*copyc LGZCLOS
*copyc LGZGET
*copyc LGZOPEN
*copyc LGZPUT
*copyc RHP$LOG_STATUS
*copyc RHV$SIGNAL
*copyc RHP$RECEIVE_MESSAGE_OS
*copyc RHP$SEND_MESSAGE_OS
*copyc RHP$OPEN_FILE
*copyc RHP$CLOSE_FILE
*copyc RHP$ROUTE_FILE
*copyc RHP$RETURN_FILE

  PROCEDURE [XREF] qfrec (lfn: integer;
        an170: integer;
        an180: integer;
    VAR fet_pointer: ^n7t$fet;
    VAR qfrec_status: integer);
*copyc ZUTPDNS
*copyc ZUTPRTF
*copyc ZUTPS2D
*copyc ZUTPSDN

?? SET (LIST := ON) ??
?? TITLE := 'RHP$QUEUE_FILE_RECEIVE_EXEC' ??
?? EJECT ??

{ RHP$QUEUE_FILE_RECEIVE_EXEC
{
{     This procedure is responsible for receiving queue files from
{ its partner application.  This includes the responsibilities of
{ protocol maintenance, reception control, and final file disposition.
{
{     RHP$QUEUE_FILE_RECEIVE_EXEC (APPLICATION_NAMES,EXEC_STATUS)
{
{ APPLICATION_NAMES: (input) This parameter contains the sending and
{     receiving application names required for MLI communications.
{
{ EXEC_STATUS: (output) This parameter indicates to the calling procedure
{     the processing status of the executive.  The following status
{     values may be returned:
{               beginning
{               middle
{               unrecoverable_error

  PROCEDURE [XDCL] rhp$queue_file_receive_exec ALIAS 'rhmqfr' (VAR
    application_names: rht$mli_application_names;
    VAR exec_status: rht$exec_status);


    TYPE
      receive_states = (fetch_control, fetch_data, dispose, respond),
      substitute_info_type = RECORD
        job_info: string(8),
        user_name: string(9),
        password: string(31),
        family_name: string(9),
        charge_number: string(31),
        project_number: string(31),
        original_user_name: string(9),
        original_family_name: string(9),
        original_charge_number: string(31),
        original_project_number: string(31),
      recend;

    CONST
      completed = rhc$completed,
      boi = rhc$beginning_of_information,
      moi = rhc$middle_of_information,
      eoi = rhc$end_of_information,
      err = rhc$error,
      errmsg_file_name = 'rhermsg',
      errmsg_dc_file_name = 22100522152307(8),
      rhreclf_file_name = 'rhreclf',
      rhreclf_dc_file_name = 22102205031406(8); { RHRECLF }

    VAR
      errmsg_local_file_info: [STATIC] rht$local_file_info,
      errmsg: [STATIC] packed ARRAY [0..35] of
              0 .. 03fffffff(16) :=
              [ 0061000000(8), 0000000000(8),  {1}
                0060000000(8), 0000000000(8),  {0}
                0040005500(8), 5501050122(8),  { --ER}
                0122011701(8), 2200550055(8),  {ROR--}
                0040004001(8), 1601170123(8),  {  NOS}
                0040012401(8), 2201010103(8),  { TRAC}
                0113004001(8), 1401110115(8),  {K LIM}
                0111012400(8), 4001220105(8),  {IT RE}
                0101010301(8), 1001050104(8),  {ACHED}
                0040004001(8), 2401100105(8),  {  THE}
                0040010601(8), 1101140105(8),  { FILE}
                0040012701(8), 0101230040(8),  { WAS }
                0124011700(8), 4001140101(8),  {TO LA}
                0122010701(8), 0500400124(8),  {RGE T}
                0117040001(8), 0201050040(8),  {O BE }
                0120012201(8), 1101160124(8),  {PRINT}
                0105010400(8), 5600000000(8),  {ED.}
                0062000000(8), 0000000000(8) ],  {2}
      fet_pointer: ^n7t$fet,
      errmsg_file: file,
      quanta_work_completed: boolean,
      receive_state: [STATIC] receive_states := fetch_control,
      sender_name: mlt$application_name,
      status: ost$status,
      receive_status: [STATIC] (ok, error) := ok,
      route_status: rht$function_status,
      abnormal_mli_stat_message: string(33),
      string_length: 1 .. 33,
      local_file_info: [STATIC] rht$local_file_info,
      queue_file_info: [STATIC] rht$queue_file_info,
      message_info: [STATIC] rht$mli_message_info, { kludge for CYBIL bug }
      new_print_file: file,
      detailed_status,
      qfrec_status: integer;

?? TITLE := 'RHP$PRIF_SKELETON_PARAMETERS' ??
?? SET (LIST := ON) ??
?? EJECT ??

{ RHP$PRIF_SKELETON_PARAMETERS
{
{        The purpose of this procedure is to substitute keywords with their
{  actual value and return a new card with the substituted values.
{
{       RHP$PRIF_SKELETON_PARAMETERS (SUBSTITUTE_INFO, SKELETON_CARD,
{             SUBSTITUTE_CARD);
{
{ SUBSTITUTE_INFO: (Input) This parameter contains all accounting
{
{ SKELETON_CARD: (Input) This parameter contains one skeleton record from
{       the skeleton file (Created at deadstart time with the name PRACCNT).
{
{ SUBSTITUTE_CARD: (Output) This parameter returns a copy of the skeleton
{       record with values substituted for the keywords.
{

    PROCEDURE rhp$prif_skeleton_parameters (
       substitute_info: substitute_info_type;
       skeleton_card: string (140);
       VAR substitute_card: string (140));

? IF rhv$prif_for_nosbe = FALSE THEN
    TYPE

      valid_family_info_rec = packed record
        family_name: 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_info_rec);
?IFEND

    CONST
      max_string_length = 140,
      invalid_family = 7777(8),
      skel_job = 'JOB',
      skel_user = 'USER',
      skel_password = 'PASSWORD',
      skel_family = 'FAMILY',
      skel_charge = 'CHARGE',
      skel_project = 'PROJECT',
      skel_orig_user = 'ORGUSER',
      skel_orig_family = 'ORGFAMILY',
      skel_orig_charge = 'ORGCHARGE',
      skel_orig_project = 'ORGPROJECT';

    VAR
      keyword_sub: string (31),
      keyword_length: 0 .. 10,
      name_string: string (31),
      in_buff_lngth: integer,
      out_buff_lngth: integer,
      max_replacement_length: 1 .. 31,
? IF rhv$prif_for_nosbe = FALSE THEN
      perm_file_info: perm_file_info_rec,
      valid_family_info: valid_family_info_rec,
      dc_family_name: utt$dc_name,
      result_length: 0 .. 7,
? IFEND
      replacement_length: 1 .. 31;

?? TITLE := 'RHP$PRIF_SKELETON_PARAMETERS' ??
?? SET (LIST := ON) ??
?? EJECT ??
{ Replace keyword and copy to output buffer.  The parameter
{ SKELETON_CARD is the input buffer and SUBSTITUTE_CARD is
{ the output buffer.

    out_buff_lngth := 1;
    in_buff_lngth := 1;
    keyword_sub := ' ';
    substitute_card := ' ';
    /sub_keyword/
    REPEAT
      IF (skeleton_card (in_buff_lngth, 1) = '&') THEN

{  If skeleton card has an '&', then replace the value of the
{  attribute specified into the job template.
        IF (skeleton_card (in_buff_lngth+1, 3) = skel_job) THEN
          keyword_sub := substitute_info.job_info;
          max_replacement_length := 8;
          substitute_keyword (substitute_card, replacement_length,
              out_buff_lngth, max_replacement_length, keyword_sub);
          keyword_length := 3;
        ELSEIF (skeleton_card (in_buff_lngth+1, 4) = skel_user) THEN

          keyword_sub := substitute_info.user_name;
          max_replacement_length := 9;
          substitute_keyword (substitute_card, replacement_length,
              out_buff_lngth, max_replacement_length, keyword_sub);
          keyword_length := 4;
        ELSEIF (skeleton_card (in_buff_lngth+1, 8) = skel_password) THEN

          keyword_sub := substitute_info.password;
          max_replacement_length := 31;
          substitute_keyword (substitute_card, replacement_length,
              out_buff_lngth, max_replacement_length, keyword_sub);
          keyword_length := 8;
        ELSEIF (skeleton_card (in_buff_lngth+1, 6) = skel_family) THEN

? IF rhv$prif_for_nosbe = FALSE THEN
          utp$convert_string_to_dc_name(substitute_info.family_name (1,7),
              dc_family_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_name := 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 }
            utp$convert_dc_name_to_string (perm_file_info.family_name,
                keyword_sub (1,7), result_length);
          ELSE  { family was valid on NOS. }
            utp$convert_dc_name_to_string (dc_family_name,
                keyword_sub (1,7), result_length);
          IFEND;
          max_replacement_length := 7;
? ELSE
          keyword_sub := substitute_info.family_name;
          max_replacement_length := 9;
? IFEND
          substitute_keyword (substitute_card, replacement_length,
              out_buff_lngth, max_replacement_length, keyword_sub);
          keyword_length := 6;
        ELSEIF (skeleton_card (in_buff_lngth+1,6) = skel_charge) THEN

{ Use only login charge numbers that are alpha-numberic.
          create_valid_170_string (substitute_info.charge_number,
              keyword_sub);
? IF rhv$prif_for_nosbe = FALSE THEN
          IF substitute_info.charge_number = ' ' THEN
            keyword_sub := '*.';
          IFEND;
? IFEND
          max_replacement_length := 31;
          substitute_keyword (substitute_card, replacement_length,
              out_buff_lngth, max_replacement_length, keyword_sub);
          keyword_length := 6;
        ELSEIF (skeleton_card (in_buff_lngth+1,7) = skel_project) THEN

{ Use only login project numbers that are alpha-numberic.
          create_valid_170_string (substitute_info.project_number,
              keyword_sub);
          max_replacement_length := 31;
          substitute_keyword (substitute_card, replacement_length,
              out_buff_lngth, max_replacement_length, keyword_sub);
          keyword_length := 7;
        ELSEIF (skeleton_card (in_buff_lngth+1,7) = skel_orig_user) THEN

{ Use only login user names that are alpha-numberic.
          name_string (1,9) := substitute_info.original_user_name;
          create_valid_170_string (name_string, keyword_sub);
          max_replacement_length := 9;
          substitute_keyword (substitute_card, replacement_length,
              out_buff_lngth, max_replacement_length, keyword_sub);
          keyword_length := 7;
        ELSEIF (skeleton_card (in_buff_lngth+1,9) = skel_orig_family) THEN

{ Use only login family names that are alpha-numberic.
          name_string (1,9) := substitute_info.original_family_name;
          create_valid_170_string (name_string, keyword_sub);
          max_replacement_length := 9;
          substitute_keyword (substitute_card, replacement_length,
              out_buff_lngth, max_replacement_length, keyword_sub);
          keyword_length := 9;
        ELSEIF (skeleton_card (in_buff_lngth+1,9) = skel_orig_charge) THEN

{ Use only login charge numbers that are alpha-numberic.
          create_valid_170_string (substitute_info.original_charge_number,
              keyword_sub);
? IF rhv$prif_for_nosbe = FALSE THEN
          IF substitute_info.original_charge_number = ' ' THEN
            keyword_sub := '*.';
          IFEND;
? IFEND
          max_replacement_length := 31;
          substitute_keyword (substitute_card, replacement_length,
              out_buff_lngth, max_replacement_length, keyword_sub);
          keyword_length := 9;
        ELSEIF (skeleton_card (in_buff_lngth+1,10) = skel_orig_project) THEN

{ Use only login project numbers that are alpha-numberic.
          create_valid_170_string (substitute_info.original_project_number,
              keyword_sub);
          max_replacement_length := 31;
          substitute_keyword (substitute_card, replacement_length,
              out_buff_lngth, max_replacement_length, keyword_sub);
          keyword_length := 10;
        ELSE  { the '&' is not followed by a defined keyword, leave it on the command line.
          substitute_card (out_buff_lngth, 1) := skeleton_card (in_buff_lngth, 1);
          replacement_length := 1;
          keyword_length := 0;

        IFEND;
        out_buff_lngth := out_buff_lngth + replacement_length;
        in_buff_lngth := in_buff_lngth + keyword_length + 1;
        keyword_sub := ' ';
      ELSE
        substitute_card (out_buff_lngth, 1) := skeleton_card (in_buff_lngth, 1);
        in_buff_lngth := in_buff_lngth + 1;
        out_buff_lngth := out_buff_lngth + 1;
      IFEND;
    UNTIL (out_buff_lngth > max_string_length) OR (in_buff_lngth > max_string_length); {sub_keyword}

    IF NOT (out_buff_lngth > max_string_length) THEN

{ Set the remaining parts of the command card to blank.
      substitute_card (out_buff_lngth, max_string_length - out_buff_lngth + 1)  := ' ';
    IFEND;

  PROCEND rhp$prif_skeleton_parameters;
?? TITLE := 'SUBSTITUTE_KEYWORD' ??
?? SET (LIST := ON) ??
?? EJECT ??

{ SUBSTITUTE_KEYWORD
{
{        This procedure will substitute a given value for the keyword
{ in an output buffer.
{
{        SUBSTITUTE_KEYWORD (SUBSTITUTE_CARD, REPLACEMENT_LENGTH
{             OUT_BUFF_LNGTH, MAX_REPLACEMENT_LENGTH, KEYWORD_SUB)
{
{ SUBSTITUTE_CARD: (Output) This parameter returns a copy of the input buffer
{       with the keyword replaced.
{
{ REPLACEMENT_LENGTH (Output) This parameter returns the length of the
{       replacement string.
{
{ OUT_BUFF_LNGTH (Input) This parameter is the current size of the output buffer.
{
{ MAX_REPLACEMENT_LENGTH (Input) This parameter is the maximum length of the field
{       to be replaced.
{
{ KEYWORD_SUB: (Input) This parameter is what is replaced into the output
{       buffer.
{

  PROCEDURE substitute_keyword
       (VAR substitute_card: string (140);
       VAR replacement_length: 1 .. 31;
       out_buff_lngth: integer;
       max_replacement_length: 1 .. 31;
       keyword_sub: string(31));

    VAR index: 1 .. 31;

{ Calculate length of the replacement string.

      replacement_length := 1;
    /cal_replacement_lngth/
      FOR index := 1 to max_replacement_length DO
        IF keyword_sub (index, 1) <> ' ' THEN
          replacement_length := index;
        IFEND;
      FOREND /cal_replacement_lngth/;

{ Replace keyword and copy to output buffer.}

      substitute_card (out_buff_lngth, replacement_length) :=
          keyword_sub (1, replacement_length);

  PROCEND substitute_keyword;
?? OLDTITLE, NEWTITLE := 'PROCEDURE create_valid_170_string', EJECT ??

{ CREATE_VALID_170_STRING
{
{        This procedure will create a valid 170 string (delete all $ from
{ the passed parameter and put into the new string.  The only values that
{ will be changed are the charge number, project number, orignal user name,
{ original family name, original charge number, and original project number.
{
{        CREATE_VALID_170_STRING (KEYWORD_STRING, KEYWORD_SUB)
{
{ KEYWORD_STRING: (Input) This parameter is the value of the old string to be changed.
{
{ KEYWORD_SUB: (Output) This parameter is the value of the new string created.
{
  PROCEDURE create_valid_170_string (keyword_string: string (31);
      VAR keyword_sub: string (31));

    CONST max_keyword_string_size = 31;

    VAR keyword_sub_size,
        keyword_string_size: 1 .. max_keyword_string_size;

{ Use only strings that are alpha-numberic.
    keyword_sub := ' ';
    keyword_sub_size := 1;
    FOR keyword_string_size := 1 TO max_keyword_string_size DO
      IF ((keyword_string (keyword_string_size) >= 'A') AND
        (keyword_string (keyword_string_size) <= 'Z')) OR
        ((keyword_string (keyword_string_size) >= 'a') AND
        (keyword_string (keyword_string_size) <= 'z')) OR
        ((keyword_string (keyword_string_size) >= '0') AND
        (keyword_string (keyword_string_size) <= '9')) OR
? IF rhv$prif_for_nosbe THEN
        (keyword_string (keyword_string_size) = '=') OR
        (keyword_string (keyword_string_size) = ',') OR
        (keyword_string (keyword_string_size) = '.') OR
? IFEND
        (keyword_string (keyword_string_size) = '*') THEN
        keyword_sub (keyword_sub_size) := keyword_string (keyword_string_size);
        keyword_sub_size := keyword_sub_size + 1;
      IFEND;
    FOREND;

  PROCEND create_valid_170_string;

?? TITLE := 'RHP$CREATE_PRIF_JOB' ??
?? SET (LIST := ON) ??
?? EJECT ??

{ RHP$CREATE_PRIF_JOB
{
{     This procedure will create a job to route a PRINT_FILE to an RBF terminal.
{
{        RHP$CREATE_PRIF_JOB;
{
{
  PROCEDURE rhp$create_prif_job;

    TYPE
      substitute_info_type = RECORD
        job_info: string(8),
        user_name: string(9),
        password: string(31),
        family_name: string(9),
        charge_number: string(31),
        project_number: string(31),
        original_user_name: string (9),
        original_family_name: string (9),
        original_charge_number: string (31),
        original_project_number: string (31),
      RECEND;

    CONST
      prif_skeleton_file_name = 'praccnt',
? IF rhv$prif_for_nosbe = TRUE THEN
      apr_command = 'APR(11)',
      nosbe_request_command = 'REQUEST,LFN,Q.',
? IFEND
      copy_command = 'COPY,INPUT,LFN.';

    VAR
      substitute_info: substitute_info_type,
      skeleton_file: file,
      skeleton_card: string(140),
      substitute_card: string(140),
      mark: file_mark,
      number_of_chars_read: integer,
      substitute_card_size: 0 .. 140,
      print_file: file,
      banner_string: string(8),
      banner_string_size,
      max_banner_string_size: 1 .. 8,
      repeat_message: string(6),
      repeat_message_size: integer,
      text_size: integer,
      route_command: string (255);

      banner_string := ' ';
      banner_string_size := 1;
      FOR max_banner_string_size := 1 TO 7 DO
        IF ((queue_file_info.a170.user_number_of_owner.a170_owner_user_num (max_banner_string_size)>='A') AND
            (queue_file_info.a170.user_number_of_owner.a170_owner_user_num (max_banner_string_size)<='Z')) OR
           ((queue_file_info.a170.user_number_of_owner.a170_owner_user_num (max_banner_string_size)>='a') AND
            (queue_file_info.a170.user_number_of_owner.a170_owner_user_num (max_banner_string_size)<='z')) OR
           ((queue_file_info.a170.user_number_of_owner.a170_owner_user_num (max_banner_string_size)>='0') AND
            (queue_file_info.a170.user_number_of_owner.a170_owner_user_num (max_banner_string_size)<='9')) OR
            (queue_file_info.a170.user_number_of_owner.a170_owner_user_num (max_banner_string_size)='*') THEN
          banner_string (banner_string_size) :=
              queue_file_info.a170.user_number_of_owner.a170_owner_user_num (max_banner_string_size);
          banner_string_size := banner_string_size + 1;
        IFEND;
      FOREND;
      banner_string (banner_string_size) := '.';
      substitute_info.job_info := banner_string;
      substitute_info.user_name := queue_file_info.a170.user_number_of_owner.
         a170_owner_user_num;
      substitute_info.family_name := queue_File_info.a170.family_name_of_creator.
         a170_creator_family_name;
      substitute_info.password := queue_file_info.a170.user_password;
      substitute_info.charge_number := queue_file_info.a170.user_charge_number;
      substitute_info.project_number := queue_file_info.a170.user_project_number;

{ The original login USER, FAMILY, CHARGE, and PROJECT needs to be saved also in case a
{ site wants to use them in their partner job template files when creating 170
{ partner jobs.
      substitute_info.original_user_name := queue_file_info.a170.original_user_name.
         a170_original_user_name;
      substitute_info.original_family_name := queue_File_info.a170.original_family_name.
         a170_original_family_name;
      substitute_info.original_charge_number := queue_file_info.a170.original_charge_number;
      substitute_info.original_project_number := queue_file_info.a170.original_project_number;
      lg#open (skeleton_file, prif_skeleton_file_name, old#, input#, first#);
      request_queue_device (rhreclf_dc_file_name);
      bi#open (print_file, rhreclf_file_name, new#, output#, first#);
      /generate_pj_commands/
      REPEAT
        skeleton_card := ' ';
        lg#get (skeleton_file, number_of_chars_read, skeleton_card);
        f#mark (skeleton_file, mark);
        IF (mark = data#) THEN
          rhp$prif_skeleton_parameters (substitute_info, skeleton_card,
             substitute_card);
          /calculate_card_length/
          FOR substitute_card_size := 140 DOWNTO 1 DO
            IF substitute_card (substitute_card_size,1) <> ' ' THEN
              EXIT /calculate_card_length/;
            IFEND;
          FOREND /calculate_card_length/;
          lg#put (print_file, substitute_card (1,substitute_card_size));
        IFEND;
      UNTIL mark <> data#;  { generate pj commands }
      lg#close (skeleton_file, first#);
? IF rhv$prif_for_nosbe = TRUE THEN
      lg#put(print_file, nosbe_request_command);
? IFEND
      lg#put (print_file, copy_command);
      route_command (1,10) := 'ROUTE,LFN,';
      IF queue_file_info.a170.repeat_count > 1 THEN
        STRINGREP (repeat_message, repeat_message_size,
            'REP=',queue_file_info.a170.repeat_count-1,',');
        route_command (11,repeat_message_size) := repeat_message(1,repeat_message_size);
        text_size := queue_file_info.a170.dual_state_routing_text_size;
        route_command (11+repeat_message_size,text_size) :=
           queue_file_info.a170.dual_state_routing_text;
        route_command (text_size+11+repeat_message_size,1) := '.';
        lg#put (print_file,
          route_command (1, text_size+11+repeat_message_size));
      ELSE
        route_command (11,queue_file_info.a170.dual_state_routing_text_size) :=
           queue_file_info.a170.dual_state_routing_text;
        route_command (queue_file_info.a170.dual_state_routing_text_size+11,1) := '.';
        lg#put (print_file,
            route_command (1, queue_file_info.a170.dual_state_routing_text_size+11));
      IFEND;
? IF rhv$prif_for_nosbe = TRUE THEN
      lg#put(print_file, apr_command);
? IFEND
      bi#weor (print_file);
      bi#close (print_file, asis#);
    PROCEND rhp$create_prif_job;
?? SET (LIST := ON) ??
?? TITLE := 'RHP$QUEUE_FILE_RECEIVE_EXEC' ??
?? EJECT ??

{ * * * * * * *   R E C E I V E   A   Q U E U E   F I L E   * * * * * * *

    quanta_work_completed := FALSE;
    REPEAT
      CASE receive_state OF

{ Fetch control information to receive a queue file.

      = fetch_control =
        message_info.message_area_length := #SIZE (queue_file_info.equalizer);
        message_info.message_area := ^queue_file_info.equalizer;
        rhp$receive_message_os (application_names.application.application_name,
          message_info.arbitrary_info, rhv$signal, message_info.message_area,
          message_info.message_length, message_info.message_area_length,
          0 { index for receive any pending msg }, sender_name, status);
        IF (status.normal) OR (status.condition=mlc$signal_failed_ignored) THEN
          CASE message_info.arbitrary_info OF
          = boi =
            IF (queue_file_info.a170.dual_state_routing_text_size <> 0) THEN
              { create a partner job to do PRINT_FILE with ROUTE control card. }
              rhp$create_prif_job;
            IFEND;
            local_file_info.fet.filename := rhreclf_dc_file_name;
            request_queue_device (rhreclf_dc_file_name);
            IF (queue_file_info.a170.dual_state_routing_text_size <> 0) THEN
              bi#open (new_print_file, rhreclf_file_name, old#, output#, asis#);
            ELSE
              rhp$open_file (local_file_info);
            IFEND;
            receive_state := fetch_data;
            exec_status := middle;
            log_status (dayfile_log_and_display, 'BEGIN XFER NOSVE OUTPUT');
          = moi, eoi, err =
            exec_status := beginning;
          ELSE
            exec_status := unrecoverable_error;
          CASEND;
        ELSE
          CASE status.condition OF
          = mlc$busy_interlock, mlc$receive_list_index_invalid =
            exec_status := beginning;
          = mlc$nosve_not_up =
            log_status (dayfile_log, '$loss of dual state environment');
            exec_status := unrecoverable_error;
          ELSE
            abnormal_mli_stat_message(1,29) := 'receive msg mli abnorm cond =';
            STRINGREP (abnormal_mli_stat_message (30,3), string_length, status.condition);
            log_status (dayfile_log_and_display, abnormal_mli_stat_message(1, 29 + string_length));
            exec_status := unrecoverable_error;
        CASEND;
        IFEND;
        quanta_work_completed := TRUE;

{ Fetch data from transmitter.

      = fetch_data =

{ Initialize the abnormal termination to be returned to be 0.

        fet_pointer^.abnormal_termination := 0;
        qfrec (local_file_info.fet.filename, application_names.application.
              application_name, 0, fet_pointer, qfrec_status);
? IF rhv$prif_for_nosbe = FALSE THEN
        IF fet_pointer^.abnormal_termination = 1 THEN

{ File could not be printed because of a NOS track limit was hit.

          receive_status := error;
          exec_status := middle;
          receive_state := dispose;
        ELSE
? IFEND
        CASE qfrec_status OF
        = moi =

{ temporarily exit to process other work

          receive_state := fetch_data;
          exec_status := middle;
          quanta_work_completed := TRUE;
        = eoi =

{ end of xfer

          receive_state := dispose;
          receive_status := ok;
        ELSE
          receive_status := error;
          exec_status := unrecoverable_error;
          receive_state := dispose;
        CASEND;
? IF rhv$prif_for_nosbe = FALSE THEN
        IFEND;
? IFEND

{ Route local file to queue.

      = dispose =
       IF queue_file_info.a170.dual_state_routing_text_size = 0 THEN
         rhp$close_file (local_file_info);
       ELSE
         bi#close(new_print_file, first#);
       IFEND;
        IF receive_status = ok THEN
          IF queue_file_info.a170.dual_state_routing_text_size = 0 THEN
            route_file (receive_exec, local_file_info, queue_file_info,
              route_status);
          ELSE
            route_file (prif_pj_exec, local_file_info, queue_file_info,
              route_status);
          IFEND;
          IF route_status = successful THEN
            message_info.arbitrary_info := completed;
          ELSE
? IF rhv$prif_for_nosbe = FALSE THEN
            IF queue_file_info.a170.dual_state_routing_text_size = 0 THEN
              return_file (local_file_info);
            ELSE
              utp$return_file (rhreclf_file_name);
            IFEND;
? ELSE
            return_file (local_file_info);
? IFEND
            message_info.arbitrary_info := err;
          IFEND;
          message_info.message_length := 0;
          receive_state := respond;
          log_status (dayfile_log_and_display, 'END XFER NOSVE OUTPUT');
        ELSE
          return_file (local_file_info);
          IF exec_status = middle THEN

? IF rhv$prif_for_nosbe = FALSE THEN

{ A NOS track limit was reached, print an error file for the user.

            bi#open (errmsg_file, errmsg_file_name, new#, output#, first#);
            bi#put (errmsg_file, #LOC (errmsg), #SIZE (errmsg));
            bi#close (errmsg_file, first#);
            errmsg_local_file_info.fet.filename := errmsg_dc_file_name;
            IF queue_file_info.a170.dual_state_routing_text_size = 0 THEN
              route_file (receive_exec, errmsg_local_file_info, queue_file_info,
                  route_status);
            ELSE
              route_file (prif_pj_exec, errmsg_local_file_info, queue_file_info,
                  route_status);
            IFEND;
            IF route_status <> successful THEN
              return_file (errmsg_local_file_info);
            IFEND;
            log_status (display_in_system_log,
                'A file was too large to be printed and was returned.');
? IFEND
            message_info.arbitrary_info := err;
            message_info.message_length := 0;
            receive_state := respond;
          ELSE
            message_info.message_area := ^queue_file_info.equalizer;
            receive_status := ok;
            receive_state := fetch_control;
            quanta_work_completed := TRUE;
          IFEND;
          log_status (dayfile_log_and_display, 'ERROR END XFER NOSVE OUTPUT');
        IFEND;

{ Tell transmitter status of receive.

      = respond =
        rhp$send_message_os (application_names.application.application_name,
          message_info.arbitrary_info, rhv$signal, message_info.message_area,
          message_info.message_length, application_names.destination.application_name,
          status);
        IF status.normal THEN
          message_info.message_area := ^queue_file_info.equalizer;
          receive_status := ok;
          receive_state := fetch_control;
          exec_status := middle;
        ELSE
          CASE status.condition OF
          = mlc$busy_interlock, mlc$pool_buffer_not_avail,
            mlc$prior_msg_not_received =
            exec_status := middle;
          = mlc$receiver_not_signed_on =
            exec_status := beginning;
            IF message_info.arbitrary_info <> err THEN
              receive_status := error;
              message_info.arbitrary_info := err;
            IFEND;
            quanta_work_completed := TRUE;
          ELSE
            abnormal_mli_stat_message (1,26) := 'send msg mli abnorm cond =';
            STRINGREP (abnormal_mli_stat_message (27,3), string_length, status.condition);
            log_status (dayfile_log, abnormal_mli_stat_message(1,26+string_length));
            message_info.message_area := ^queue_file_info.equalizer;
            receive_status := ok;
            receive_state := fetch_control;
            exec_status := unrecoverable_error;
          CASEND;
          IFEND;
          quanta_work_completed := TRUE;
        CASEND;
      UNTIL quanta_work_completed;

  PROCEND rhp$queue_file_receive_exec;

MODEND rhmqfr;
