
*copyc OSD$DEFAULT_PRAGMATS
?? NEWTITLE := '170 NOS/VE REMOTE HOST ' ??
MODULE rhm$partner_job_exec ALIAS 'rhmjep';

{ 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) ??
*copyc ifd$machine_definition

  ?IF ifv$module_for_c180 = TRUE THEN
*copy OST$STATUS
  ?ELSE
*copy OST$STRING

    TYPE
      ost$status = record
        condition: mlt$status,
      recend,

      ost$status_condition = record
        condition: mlt$status,
      recend;

  ?IFEND
?? EJECT ??
*copyc RHT$FUNCTION_STATUS
*copyc RHC$CONSTANTS
*copyc RHC$CONDITION_LIMITS

?? TITLE := 'EXTERNAL PROCEDURES REFERENCED BY THIS MODULE' ??
?? SET (LIST := ON) ??
?? EJECT ??
*copyc MLP$RECEIVE_MESSAGE
*copyc RHP$LOG_STATUS
*copyc RHP$ROUTE_FILE
 PROCEDURE [XREF] pause (i: integer);
*copyc MLP$SEND_MESSAGE
*copyc MLP$SIGN_ON
*copyc MLP$ADD_SENDER
*copyc MLP$LOCATE_FREE_JOB_ENTRY
*copyc MLP$CREATE_JOB_ENTRY
*copyc MLP$DELETE_JOB_ENTRY
*copyc LGZOPEN
*copyc LGZPUT
*copyc LGZGET
*copyc LGZWEOR
*copyc LGZCLOS
*copyc FZMARK
*copyc LGZCODE
*copyc LGZFIRS
*copyc BIZCLOS
*copyc BIZWEOR
*copyc BIZGET
*copyc BIZPUT
*copyc BIZOPEN
*copyc PXIOTYP
*copyc ZUTPS2D
*copyc ZOSTSTR
*copyc ZUTPD2S
*copyc ZUTPRTF
*copyc ZUTPDNS
*copyc ZUTPSDN

  VAR
    destination: mlt$application_name,
    initialized: boolean := FALSE;

  CONST
    pjp_appl_name = rhc$partner_job_processor * 1073741824;

  TYPE
    nos_job_validation_info = record
      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;
?? TITLE := 'RHP$PARTNER_JOB_EXEC' ??
?? SET (LIST := ON) ??
?? EJECT ??

{ RHP$PARTNER_JOB_EXEC
{
{       This procedure receives and processes partner job function requests.
{
{       RHP$PARTNER_JOB_EXEC (APPLICATION_NAMES, EXEC_STATUS)
{
{ APPLICATION_NAMES: (input) This parameter contains the sending and receiving
{                    application names required for MLI communication.
{
{ 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$partner_job_exec;

    CONST
      ok = rhc$ok,
      submit_pj = rhc$submit_pj,
      status_pj = rhc$status_pj;

    TYPE
      pj_exec_states = (process_pending_msg, send_process_response),
      job_info = record
        case info_type: (name, validation) of
        = name =
          job_name: ALIGNED [0 MOD 8] utt$dc_name,
        = validation =
          job_validation: nos_job_validation_info,
        casend,
      recend,
      status_job_info_type = record
        case info_type: (status_name, status_validation) of
        = status_name =
          job_name: ALIGNED [0 MOD 8] utt$dc_name,
        = status_validation =
          job_validation: packed record
            fill1: 0 .. 03ffff(16),
            job_name: 0 .. 0ffffff(16),
            fill2: 0 .. 03ffff(16),
          recend,
        casend,
      recend;

    VAR
      quanta_work_completed: boolean,
      partner_job_exec_state: [STATIC] pj_exec_states := process_pending_msg,
      status: ost$status,
      message_info: [STATIC] rht$mli_message_info := [^partner_job_info.job_name, * , *
        , * ],
      partner_job_info: [STATIC] job_info,
      status_msg_length: 1 .. 20,
      status_msg: string (20),
      status_job_info: status_job_info_type,
      partner_job_status: rht$pj_status,
      message_length: mlt$message_length;

    IF NOT initialized THEN
      rhp$initialize_pj_environ;
      RETURN;
    IFEND;

    quanta_work_completed := FALSE;
    REPEAT
      CASE partner_job_exec_state OF

{ Check if NOS/VE making partner job request.

      = process_pending_msg =
        mlp$receive_message (pjp_appl_name, message_info.arbitrary_info, #LOC
              (status), message_info.message_area, message_length, #SIZE (partner_job_info.
              job_validation), 0, destination, status);
        IF status.condition = mlc$ok THEN
          log_status (dayfile_log_and_display, 'REQUEST FROM IRHF 180 RECEIVED.');
          CASE message_info.arbitrary_info OF

{ Submit NOS/170 partner job.

          = submit_pj =
            log_status (dayfile_log_and_display, 'ATTEMPT SUBMIT OF PARTNER JOB.');
            submit_partner_job (partner_job_info.job_validation, destination, partner_job_info.
                  job_name, message_info.arbitrary_info);
            log_status (dayfile_log_and_display, 'IRHF PARTNER JOB SUBMITTED');
            IF message_info.arbitrary_info = ok THEN
              message_info.message_length := #SIZE (partner_job_info.job_name);
            ELSE
              message_info.message_length := 0;
            IFEND;

{ Status NOS/170 partner job.

          = status_pj =
            status_job_info.job_name := partner_job_info.job_name;
            status_partner_job (status_job_info.job_validation.job_name,
                  partner_job_status);
            log_status (dayfile_log_and_display, 'STATUS NOSVE PARTNER JOB');
            message_info.arbitrary_info := partner_job_status;
            message_info.message_length := 0;
          CASEND;
          partner_job_exec_state := send_process_response;
        ELSE
          CASE status.condition OF
          = mlc$busy_interlock, mlc$receive_list_index_invalid =
            quanta_work_completed := TRUE;
          ELSE
            status_msg := 'MLI ERROR';
            STRINGREP (status_msg (11, 10), status_msg_length, status.condition);
{ Only output the error if Sense Swith 2 is turned on.
            log_status (dayfile_log_and_display, status_msg);
            quanta_work_completed := TRUE;
          CASEND;
        IFEND;

{ Send response back to NOS/VE remote host.

      = send_process_response =
        mlp$send_message (pjp_appl_name, message_info.arbitrary_info, #LOC
              (status), message_info.message_area, message_info.message_length,
              destination, status);
        CASE status.condition OF
        = mlc$ok =
          partner_job_exec_state := process_pending_msg;
        = mlc$busy_interlock, mlc$pool_buffer_not_avail,
              mlc$prior_msg_not_received =
        ELSE
          partner_job_exec_state := process_pending_msg;
        CASEND;
        quanta_work_completed := TRUE;
      CASEND;
    UNTIL quanta_work_completed;

  PROCEND rhp$partner_job_exec;
?? OLDTITLE ??
?? NEWTITLE := 'rhp$initialize_pj_environ', EJECT ??

  PROCEDURE rhp$initialize_pj_environ;

    VAR
      status_msg_length: 1 .. 20,
      unique: mlt$application_name,
      status: ost$status,
      status_msg: string (20);

    mlp$sign_on (pjp_appl_name, mlc$max_queued_messages, unique, status);
    CASE status.condition OF
    = mlc$ok =
    ELSE
      status_msg := 'mli error';
      STRINGREP (status_msg (11, 10), status_msg_length, status.condition);
      log_status (dayfile_log, status_msg);
      log_status (dayfile_log, '$RH INIT ERROR');
      IF status.condition = mlc$nosve_not_up THEN
        RETURN;
      IFEND;
      WHILE TRUE DO
        pause (1);
      WHILEND;
    CASEND;

    mlp$add_sender (pjp_appl_name, mlc$null_name, status);
    CASE status.condition OF
    = mlc$ok =
    ELSE
      status_msg := 'mli error';
      STRINGREP (status_msg (11, 10), status_msg_length, status.condition);
      log_status (dayfile_log, status_msg);
      log_status (dayfile_log, '$RH INIT ERROR');
      IF status.condition = mlc$nosve_not_up THEN
        RETURN;
      IFEND;
      WHILE TRUE DO
        pause (1);
      WHILEND;
    CASEND;

    log_status (dayfile_log_and_display, 'RH PJ INITIALIZED');
    initialized := TRUE;

  PROCEND rhp$initialize_pj_environ;

?? TITLE := 'SUBMIT PARTNER JOB', EJECT ??
?? SET (LIST := ON) ??

{
{       The purpose of this procedure is to generate and submit the A170/NOS
{ permanent file partner job.
{
{       SUBMIT_PARTNER_JOB (JOB_VALIDATION_INFO,JOB_NAME,SUBMIT_CONDITION)
{
{ JOB_VALIDATION_INFO: (input) This parameter contains all accounting
{       information required to validate the job to be submitted.
{
{ REQUESTORS_APPLICATION_NAME: (input) This parameter contains the name of the
{       application requesting the partner job submittal.  This application
{       is the application with whom the partner job will communicate.
{
{ JOB_NAME: (output) This parameter specifies the NOS job name given the
{       partner job by NOS upon routing to the input queue.
{
{ SUBMIT_CONDITION: (output) This parameter specifies the condition of the
{       partner job submittal.
{

  PROCEDURE submit_partner_job (
        job_validation_info: nos_job_validation_info;
        requestors_application_name: mlt$application_name;
    VAR job_name: utt$dc_name;
    VAR submit_condition: integer);

    TYPE
      rht$job_name_to_jsn = packed record
        pad1: 0 .. 3ffff(16),
        first_4_chars: 0 .. 0ffffff(16),
        last_3_chars: 0 .. 3ffff(16),
      recend,
      act_response_msg_rec = record
        pj_application_name: packed record
          pj_lfn: 0 .. 3ffffffffff(16),
          filler: 0 .. 3ffff(16),
        recend,
      recend;

    CONST
      partner_job_file_name = 'rhpjfil',
      acct_skeleton_file_name = 'rhaccnt',
      partner_job_dc_file_name = 22102012061114(8), {RHPJFIL}
      task_id_length = 1; { length is in CELL's, i.e. words }

    VAR
      route_status: rht$function_status,
      skeleton_card: string (140),
      substitute_card_image: string (140),
      c170_controlcards: [STATIC] packed ARRAY [0..9] of
                         0 .. 3FFFFFFF(16) :=
                         [ 2210202006(8), 2057000000(8), {RHPPFP.}
      ? IF rhv$nos_be = FALSE THEN
                           4700000000(8), 0            , {*      }
      ? ELSE
                           0120225134(8), 3452000000(8), {APR(11)}
      ? IFEND
                           0530112457(8), 0            , {EXIT.  }
                           0415045642(8), 4233333357(8), {DMD,77000.}
                           0            , 0             ],
      number_of_chars_read: integer,
      mark: file_mark,
      substitute_card_size: 0 .. 140,
      entry_located: boolean,
      job_unique_id: 0 .. 0ffffff(16),
      job_name_to_jsn_ptr: ^rht$job_name_to_jsn,
      create_status: mlt$create_status,
      partner_job_file: file,
      skeleton_file: file,
      local_file_info: [STATIC] rht$local_file_info,
      queue_file_info: [STATIC] rht$queue_file_info;

      { * GENERATE PARTNER JOB * }

      { Route partner job as batch origin.
      mlp$locate_free_job_entry (entry_located);
      IF entry_located THEN

{ Open and read from the RHACCNT template file and put the information
{ in the partner job to be submitted.
        lg#open (skeleton_file, acct_skeleton_file_name, old#, input#, first#);
        request_queue_device (partner_job_dc_file_name);
        bi#open (partner_job_file, partner_job_file_name, new#, output#, first#);

        /generate_partner_job/
        REPEAT
          skeleton_card := ' ';
          lg#get (skeleton_file, number_of_chars_read, skeleton_card);
          f#mark (skeleton_file, mark);
          IF mark = data# THEN
            rhp$sub_skel_parms (job_validation_info, skeleton_card,
               substitute_card_image);
            /cal_card_length/
            FOR substitute_card_size := 140 DOWNTO 1 DO
              IF substitute_card_image (substitute_card_size, 1) <> ' ' THEN
                EXIT /cal_card_length/;
              IFEND;
            FOREND /cal_card_length/;
            lg#put (partner_job_file, substitute_card_image (1, substitute_card_size));
          IFEND;
        UNTIL mark <> data#; {generate_partner_job}

        bi#put (partner_job_file, #LOC (c170_controlcards), #size(c170_controlcards));

        bi#weor (partner_job_file);
        bi#put (partner_job_file, #LOC (requestors_application_name), task_id_length);
        bi#close (partner_job_file, first#);
        lg#close (skeleton_file, first#);

      { * ROUTE PARTNER JOB * }

        local_file_info.fet.filename := partner_job_dc_file_name;
        route_file (pj_exec, local_file_info, queue_file_info, route_status);
        IF route_status = successful THEN
          job_name := local_file_info.fet.filename;
          job_name_to_jsn_ptr := #LOC (job_name);
          job_unique_id := job_name_to_jsn_ptr^.first_4_chars;
          mlp$create_job_entry (job_unique_id, create_status, true);
          IF create_status <> mlc$job_entry_created_ok THEN
            submit_condition := rhe$no_ml_free_entries_found;
          ELSE
            submit_condition := rhc$ok;
          IFEND;
        ELSE
          submit_condition := rhe$partner_job_not_executing;
          utp$return_file (partner_job_file_name);
        IFEND;
      ELSE
        submit_condition := rhe$no_ml_free_entries_found;
      IFEND;

  PROCEND submit_partner_job;

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

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

    PROCEDURE rhp$sub_skel_parms (
       job_validation_info: nos_job_validation_info;
       skeleton_card: string (140);
       VAR substitute_card: string (140));

? IF rhv$nos_be = 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),
      job_info = 'P,T5000.',
      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_length: 0 .. 10,
      name_string: string(31),
      in_buff_lngth: integer,
      out_buff_lngth: integer,
      max_replacement_length: 1 .. 31,
      keyword_sub: string (31),
? IF rhv$nos_be = 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$SUB_SKEL_PARMS' ??
?? EJECT ??

{ Replace keyword and copy to output buffer.  The parameter
{ SKELETON_CARD is the input buffer and SUBSTITUTE_CARD is
{ the output buffer.

    keyword_sub := ' ';
    out_buff_lngth := 1;
    in_buff_lngth := 1;
    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 := 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 := job_validation_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 := job_validation_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$nos_be = FALSE THEN
          utp$convert_string_to_dc_name(job_validation_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 := job_validation_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 (job_validation_info.charge_number,
              keyword_sub);
? IF rhv$nos_be = FALSE THEN
          IF job_validation_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 (job_validation_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) := job_validation_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) := job_validation_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 (job_validation_info.original_charge_number,
              keyword_sub);
? IF rhv$nos_be = FALSE THEN
          IF job_validation_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 (job_validation_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$sub_skel_parms;

?? 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 buffer.
{
{ REPLACEMENT_LENGTH: (Output) This parameter returns the length of the replacement string.
{
{ MAX_REPLACEMENT_LENGTH: (Input) This parameter is the maximum size of the field
{       being passed in.
{
{ 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$nos_be 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 := 'STATUS_PARTNER_JOB' ??
?? SET (LIST := ON) ??
?? EJECT ??

{
{      The purpose of this procedure is to determine if the specified job
{ is either in the input queue or executing, or if it is elswhere.
{
{      STATUS_PARTNER_JOB (JOB_NAME,PJ_STATUS)
{
{ JOB_NAME: (input) This parameter contains the A170/NOS job name of the
{           job whos status is to be determined.
{
{ PJ_STATUS: (output) This parameter indicates the status of the partner
{            job.  Possible values for this parameter are:  job_found
{                                                           job_not_found
{

  PROCEDURE status_partner_job (job_name: 0 .. 0ffffff(16);
    VAR partner_job_status: rht$pj_status);

  ? IF rhv$nos_be = FALSE THEN
    CONST
      qac_peek_function_code = 3,
      qac_peek_parameter_block_length = 11,
      file_found_qac_error_code = 0,
      file_not_found_qac_error_code = 7,
      job_not_found = rhc$job_not_found,
      job_found = rhc$job_found;

    TYPE
      qac_parameter_block = packed record
{ - - - - - - - - - - - - - - - - - - - - - - - - - - - - Word 0
        file_name: 0 .. 3ffffffffff(16),
        error_code: 0 .. 0ff(16),
        function_code: 0 .. 1ff(16),
        complete_bit: boolean,
{ - - - - - - - - - - - - - - - - - - - - - - - - - - - - Word 1
        fill1: 0 .. 3ffffffff(16),
        length_of_request_block: 0 .. 0ff(16),
        fwa_of_additional_info: ^CELL,
{ - - - - - - - - - - - - - - - - - - - - - - - - - - - - Word 2
        fill2: 0 .. 3ffffffffff(16),
        lwa_plus_1_of_msg_returned: ^CELL,
{ - - - - - - - - - - - - - - - - - - - - - - - - - - - - Word 3
        fill3: 0 .. 3ffffffffff(16),
        fwa_of_msg_returned: ^CELL,
{ - - - - - - - - - - - - - - - - - - - - - - - - - - - - Word 4
        fnt_ordinal: 0 .. 0fff(16),
        io_queue_table_ordinal: 0 .. 0fff(16),
        file_found_in_queue: 0 .. 0fff(16),
        fill4: 0 .. 3f(16),
        limit_address: ^CELL,

{ Selection Criteria
{ - - - - - - - - - - - - - - - - - - - - - - - - - - - - Word 5
        destination_famliy_name: 0 .. 3ffffffffff(16),
        batch_device_id: 0 .. 3f(16),
        origin_type_to_select: 0 .. 0fff(16),
{ - - - - - - - - - - - - - - - - - - - - - - - - - - - - Word 6
        destination_user_name: 0 .. 3ffffffffff(16),
        destination_user_index: 0 .. 3ffff(16),
{ - - - - - - - - - - - - - - - - - - - - - - - - - - - - Word 7
        job_sequence_number: 0 .. 0ffffff(16),
        selection_flags: packed record
          reserved_for_installation: 0 .. 7,
          reserved: 0 .. 3fff(16),
          recoverable_jobs: boolean,
          enabled_dlid: boolean,
          slid_source_lid: boolean,
          alid_alternate_dest_lid: boolean,
          dlid_destination_lid: boolean,
          access_level: boolean,
          ic_selection: boolean,
          include_ec_0_in_selection: boolean,
          hierarchical_ec: boolean,
          expicit_ec: boolean,
          disposition_code: boolean,
          forms_code: boolean,
          job_sequence_number: boolean,
          origin: boolean,
          destination_batch_id: boolean,
          destination_fm_un_ui: boolean,
          include_priority_0_in_selection: boolean,
          inhibit_duplicate_lfn_search: boolean,
          specific_ordinal_in_w4: boolean,       { Bit 0 }
        recend,
{ - - - - - - - - - - - - - - - - - - - - - - - - - - - - Word 8
        selection_queues: packed record
          reserved2: 0 .. 7,
          installation: 0 .. 1,
          reserved1: 0 .. 3,
          wait_queue: boolean,
          plot_queue: boolean,
          punch_queue: boolean,
          print_queue: boolean,
          executing_queue: boolean,
          input_queue: boolean,     { Bit 0 }
        recend,
        forms_code: 0 .. 0fff(16),
        disposition_code: 0 .. 0fff(16),
        external_characteristics: 0 .. 7,
        internal_characteristics: 0 .. 7,
        link_address: 0 .. 3ffff(16),
{ - - - - - - - - - - - - - - - - - - - - - - - - - - - - Word 9
        source_mainframe_logical_id: 0 .. 3ffff(16),
        destination_mainfram_logical_id: 0 .. 3ffff(16),
        fill9a: 0 .. 3f(16),
        alternate_dlid_list_address: 0 .. 3ffff(16),
{ - - - - - - - - - - - - - - - - - - - - - - - - - - - - Word 10
        security_level: 0 .. 0fff(16),
        reserved_for_cdc: 0 .. 0ffffffffffff(16),
{ - - - - - - - - - - - - - - - - - - - - - - - - - - - - Word 11
        reserved11: integer,

{ PEEK Function Portion
{ - - - - - - - - - - - - - - - - - - - - - - - - - - - - Word 12
        input_queue_count: 0 .. 0fff(16),
        executing_queue_count: 0 .. 0fff(16),
        print_queue_count: 0 .. 0fff(16),
        punch_queue_count: 0 .. 0fff(16),
        plot_queue_count: 0 .. 0fff(16),
{ - - - - - - - - - - - - - - - - - - - - - - - - - - - - Word 13
        fill13: 0 .. 0fffffffff(16),
        installation_queue_count: 0 .. 0fff(16),
        peek_reply_entry_length: 0 .. 0fff(16),
{ - - - - - - - - - - - - - - - - - - - - - - - - - - - - Word 14
        peek_information_bits: packed record
          remaining_bits: 0 .. 0fffffff(16),
          rest_of_remaining_bits: 0 .. 1fffffff(16),
          ordinal_of_entry_in_ejt: boolean,
          job_sequence_number: boolean,
          e0: 0 .. 1,
        recend,
{ - - - - - - - - - - - - - - - - - - - - - - - - - - - - Word 15
        reserved15: integer,
      recend,
      qac_peek_reply_buffer = packed record
{             * * * * Word 1 * * * *
        job_sequence_number: 0 .. 0ffffff(16),
        ordinal: 0 .. 0fff(16),
        queue: 0 .. 0fff(16),
        rt: 0 .. 3f(16),
        word_number: 0 .. 3f(16),
{             * * * * Word 2 * * * *
        service_class: 0 .. 3f(16),
        origin_type: 0 .. 3f(16),
        forms_code: 0 .. 0fff(16),
        disposition_code: 0 .. 0fff(16),
        external_characteristics: 0 .. 3f(16),
        internal_characteristics: 0 .. 3f(16),
        rt2: 0 .. 3f(16),
        word_number_2: 0 .. 3f(16),
{             * * * * Word 3 * * * *
        last_word_plus_one: ALIGNED [0 MOD 8] integer,
      recend;

    VAR
      qacpb_init_block: [STATIC] qac_parameter_block :=
        [0, 0, qac_peek_function_code, FALSE,  0, qac_peek_parameter_block_length,
         ^qac_reply_buffer, 0, ^qac_reply_buffer,
         0, ^qac_reply_buffer,  0, 0, 0, 0, ^qac_reply_buffer,
{        - - - - selection criteria (words 5 - 11) - - - -
         0, 0, 0,  0, 0,  0, [0, 0, FALSE, FALSE, FALSE, FALSE, FALSE, FALSE,
         FALSE, FALSE, FALSE, FALSE, FALSE, FALSE, TRUE, FALSE, FALSE, FALSE,
         FALSE, FALSE, FALSE],
         [0, 0, 0, FALSE, FALSE, FALSE, FALSE, TRUE, TRUE],
         0, 0, 0, 0, 0,  0, 0, 0, 0,  0, 0,  0,
{        - - - - peek function portion (words 12 - 15) - - - -
         0, 0, 0, 0, 0,  0, 0, 0,  [0, 0, FALSE, TRUE, 0],  0],
      qacpb: qac_parameter_block,
      qac_reply_buffer: [STATIC] qac_peek_reply_buffer := [0, 0, 0, 0, 1,
            0, 0, 0, 0, 0, 0, 0, 2,  0],
      qac_error_message: string (15),
      delete_status: mlt$delete_status,
      string_length: integer;

    PROCEDURE [XREF] rhpqac ALIAS 'rhpqac' (VAR qacpb: qac_parameter_block);

    qacpb := qacpb_init_block;
    qacpb.limit_address := ^qac_reply_buffer.last_word_plus_one;
    qacpb.job_sequence_number := job_name;
    qacpb.executing_queue_count := 1;
    qacpb.input_queue_count := 1;
    rhpqac (qacpb);
    IF qacpb.error_code =  file_found_qac_error_code THEN
      partner_job_status := job_found;
    ELSE
      partner_job_status := job_not_found;
      mlp$delete_job_entry (job_name, delete_status);
      IF (delete_status = mlc$job_entry_delete_failed) THEN
        log_status (dayfile_log_and_display,
             'job was not found in memory link table');
      IFEND;
      qac_error_message (1,12) := 'qac error = ';
      STRINGREP (qac_error_message (13, 3), string_length, qacpb.error_code);
      IF (qacpb.error_code = file_not_found_qac_error_code) THEN
        log_status (dayfile_log_and_display, qac_error_message (1,
                        12 + string_length));
      ELSE
        log_status (dayfile_log, qac_error_message (1, 12 + string_length));
      IFEND;
    IFEND;
  ? ELSE
    CONST
      qaf_count_function_code = 3,
      file_not_found_qaf_error_code = 2,
      qaf_job_name_zero_fill = 11011011011011011(2),
      job_not_found = rhc$job_not_found,
      job_found = rhc$job_found;

    TYPE
      qaf_parameter_block = packed record
{ - - - - - - - - - - - - - - - - - - - - - - - - - - - - Word 0
        job_name_first_four: 0 .. 0ffffff(16),
        job_name_zero_fill: 0 .. 3ffff(16),
        error_code: 0 .. 03f(16),
        queue_type: packed record
          reserved1: 0 .. 7(16),
          execution: boolean,
          special_output: boolean,
          punch: boolean,
          output: boolean,
          input: boolean,
        recend,
        function_code: 0 .. 7(16),
        complete_bit: boolean,
{ - - - - - - - - - - - - - - - - - - - - - - - - - - - - Word 1
        alter_flags: packed record
          fill1: 0 .. 3f(16),
          abort_evict: boolean,
          change_repeat_count: boolean,
          change_or_compare_fc: boolean,
          change_priority: boolean,
          change_terminal_id: boolean,
          send_to_central_site: boolean,
        recend,
        forms_code: 0 .. 0fff(16),
        disposition_code: 0 .. 0fff(16),
        fill2: 0 .. 1,
        repeat_count: 0 .. 1f(16),
        fwa_of_additional_info: 0 .. 3ffff(16),
{ - - - - - - - - - - - - - - - - - - - - - - - - - - - - Word 2
        source_mainframe_logical_id: 0 .. 3ffff(16),
        destination_mainfram_logical_id: 0 .. 3ffff(16),
        fnt_address: 0 .. 0fff(16),
        job_class: 0 .. 0fff(16),
{ - - - - - - - - - - - - - - - - - - - - - - - - - - - - Word 3
        return_routing_info: boolean,
        fill3: 0 .. 7ff(16),
        new_terminal_id: 0 .. 0fff(16),
        fill4: 0 .. 0fff(16),
        current_terminal_id: 0 .. 0fff(16),
        priority: 0 .. 0fff(16),
{ - - - - - - - - - - - - - - - - - - - - - - - - - - - - Word 4
        pre_dayfile_file_name: 0 .. 3ffffffffff(16),
        pre_dayfile_flag: boolean,
        class_2_inhibit: boolean,
        class_1_inhibit: boolean,
        inhibit_dup_file_search: boolean,
        ignore_file_list_specified: boolean,
        ignore_file_did_host_match: boolean,
        executing_job_count: 0 .. 0fff(16),
{ - - - - - - - - - - - - - - - - - - - - - - - - - - - - Word 5
        additional_did_words: 0 .. 0fff(16),
        input_file_count: 0 .. 0fff(16),
        output_file_count: 0 .. 0fff(16),
        punch_file_count: 0 .. 0fff(16),
        special_output_file_count: 0 .. 0fff(16),
      recend;

    VAR
      qafpb_init_block: [STATIC] qaf_parameter_block :=
        [0, 0, 0, [0, TRUE, FALSE, FALSE, FALSE, TRUE], qaf_count_function_code, FALSE,
         [0, FALSE, FALSE, FALSE, FALSE, FALSE, FALSE], 0, 0, 0, 0, 0, 0, 0, 0, 0,
         FALSE, 0, 0, 0, 0, 0, 0, FALSE, FALSE, FALSE, FALSE, FALSE, FALSE,
         0, 0, 0, 0, 0, 0],
      qafpb: qaf_parameter_block,
      qaf_error_message: string (15),
      delete_status: mlt$delete_status,
      string_length: integer;

    PROCEDURE [XREF] rhpqac ALIAS 'rhpqac' (VAR qafpb: qaf_parameter_block);

    qafpb := qafpb_init_block;
    qafpb.job_name_first_four := job_name;
    qafpb.job_name_zero_fill := qaf_job_name_zero_fill;
    rhpqac (qafpb);
    IF (qafpb.executing_job_count <> 0) OR
        (qafpb.input_file_count <> 0) THEN
      partner_job_status := job_found;
    ELSE
      partner_job_status := job_not_found;
      mlp$delete_job_entry (job_name, delete_status);
      IF (delete_status = mlc$job_entry_delete_failed) THEN
        log_status (dayfile_log_and_display,
             'job was not found in memory link table');
      IFEND;
      qaf_error_message (1,12) := 'qaf error = ';
      STRINGREP (qaf_error_message (13, 3), string_length, qafpb.error_code);
      IF (qafpb.error_code = file_not_found_qaf_error_code) THEN
        log_status (dayfile_log_and_display, qaf_error_message (1,
                        12 + string_length));
      ELSE
        log_status (dayfile_log, qaf_error_message (1, 12 + string_length));
      IFEND;
    IFEND;
  ? IFEND
  PROCEND status_partner_job;

MODEND rhm$partner_job_exec;
