
  ?VAR
    icv$fake_out_madify: boolean := FALSE?;

*copyc OSD$DEFAULT_PRAGMATS
  MODULE icm$partner_job_exec_real;

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

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

  ?VAR icv$nos_be: boolean := TRUE ?;
*IFEND

?? PUSH (LISTEXT := ON) ??
    ?IF icv$fake_out_madify = TRUE THEN
*copy OST$STATUS
*copyc OSV$TASK_PRIVATE_HEAP
    ?IFEND

*copy OST$STRING

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

    TYPE
      ost$status_condition = 0 .. 999999;

*copyc BIZCLOS
*copyc BIZOPEN
*copyc BIZPUT
*copyc BIZWEOR
*copyc LGZOPEN
*copyc LGZCLOS
*copyc LGZGET
*copyc LGZPUT
*copyc LGZCODE
*copyc FZMARK
*copyc ICT$PARTNER_MESSAGES
*copyc ICP$ACQUIRE_FROM_NOS_QUEUE
*copyc ICP$ROUTE_TO_NOS_INPUT_QUEUE
*copyc MLP$ADD_SENDER
*copyc MLP$CREATE_JOB_ENTRY
*copyc MLP$DELETE_JOB_ENTRY
*copyc MLP$FORCE_JOB_SIGN_OFF
*copyc MLP$FIND_SIGNED_ON_JOB
*copyc mld$jsn
*copyc MLP$LOCATE_FREE_JOB_ENTRY
*copyc MLP$RECEIVE_MESSAGE
*copyc MLP$SEND_MESSAGE
*copyc MLP$SIGN_OFF
*copyc MLP$SIGN_ON
*copyc MLP$TERMINATE_SIGNED_ON_JOB
*copyc ZN7PMSG
*copyc ZUTPS2D
*copyc ZOSTSTR
*copyc ZUTPD2S
*copyc ZUTPDNS
*copyc ZUTPSDN
?? POP ??

?? OLDTITLE, NEWTITLE := 'TYPE DECLARATIONS', EJECT ??

    TYPE

      ict$mli_status = set of mlt$status,

      ict$operating_states = (initialize_flags, signon, addspl,
        wait_for_request, send_response),

      ict$ra_word_0 = packed record
        fill1: 0 .. 0ffffffffff(16),
        fill2: 0 .. 01f(16),
        cfo,
        idledown,
        pause,
        sw6,
        sw5,
        sw4,
        sw3,
        sw2,
        sw1: boolean,
        fill3: 0 .. 03f(16),
      recend,

      ict$job_name_to_jsn = packed record
        pad1: 0 .. 3ffff(16),
        first_four_char: 0 .. 0ffffff(16),
        last_three_char: 0 .. 3ffff(16),
      recend,

      ict$be_job_name_to_jsn = packed record
        pad1: 0 .. 3ffff(16),
        last_seven_chars: 0 .. 3ffffffffff(16),
      recend,

      ict$pj_exec_failure = (signon_failed, addspl_failed, receive_failed,
        arbinfo_failure, send_failed, okee_dokee),

      dc_validation_information_type = record
        job_info: array[1..10] of packed array[0..9] of 0..3f(16),
        user_name: array[1..2] of packed array[0..9] of 0..3f(16),
        family_name: array [1..2] of packed array[0..9] of 0..3f(16),
        password: array[1..4] of packed array[0..9] of 0..3f(16),
        charge_number: array[1..4] of packed array[0..9] of 0..3f(16),
        project_number: array[1..4] of packed array[0..9] of 0..3f(16),

{ The following are the NOS/VE login attributes of the user who is trying
{ to use the command.  These attributes are put in so a site can validate
{ a user to use Interstate Communications.
        original_user_name: array[1..2] of packed array[0..9] of 0..3f(16),
        original_family_name: array [1..2] of packed array[0..9] of 0..3f(16),
        original_charge_number: array[1..4] of packed array[0..9] of 0..3f(16),
        original_project_number: array[1..4] of packed array[0..9] of 0..3f(16),
      recend,
      job_validation_info_type = record
        job_info: string(78),
        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;
?? OLDTITLE, NEWTITLE := 'STATIC VARIABLES', EJECT ??

    VAR
      current_state: ict$operating_states := initialize_flags,
      status: ost$status, { special definition for A170 modules }
      mli_retry_status: ict$mli_status := $ict$mli_status [mlc$busy_interlock,
        mlc$pool_buffer_not_avail, mlc$prior_msg_not_received,
        mlc$receive_list_full, mlc$receive_list_index_invalid],
      mli_ignore_status: ict$mli_status := $ict$mli_status
        [mlc$dup_permits_ignored, mlc$msgs_from_sender_queued, mlc$ok,
        mlc$queued_msgs_lost, mlc$signal_failed_ignored,
        mlc$signal_to_c170_ignored],
      mli_fatal_status: ict$mli_status := $ict$mli_status [mlc$ant_full,
        mlc$bad_c170_parameter, mlc$c170_c170_illegal, mlc$illegal_function,
        mlc$max_msgs_too_large, mlc$max_signons_this_appl,
        mlc$max_signons_this_task, mlc$message_too_long,
        mlc$mli_internal_error, mlc$nosve_not_up, mlc$permit_list_full,
        mlc$receiver_name_syntax_error, mlc$sender_name_syntax_error,
        mlc$system_name_no_match, mlc$message_truncated,
        mlc$receiver_not_signed_on, mlc$sender_not_permitted,
        mlc$sender_not_signed_on],
      abort: ict$pj_exec_failure := okee_dokee,
      length_returned: mlt$message_length,
      nosve_application: mlt$application_name,
      msg: ict$general_message,
      pj_exec_debug: BOOLEAN,
      ra_word_0: ict$ra_word_0,
      substitute_card_size: integer,
      signal_record: mlt$signal_record := [0, * , * ],
      signal: mlt$signal := ^signal_record,
      unique: mlt$application_name,
      arbinfo: mlt$arbitrary_info,
      mli_terminate_status: mlt$terminate_status,
      entry_located: boolean,
      job_unique_id: mlt$partner_job_unique_id,
      create_status: mlt$create_status,
      find_status: mlt$find_status,
      delete_status: mlt$delete_status,
      forced_sign_off_status: mlt$forced_sign_off_status,
      initiate_request_ptr: ^ict$initiate_partner_request,
      status_request_ptr: ^ict$status_partner_request,
      terminate_request_ptr: ^ict$terminate_partner_request,
      delete_request_ptr: ^ict$delete_partner_request,
      initiate_response: ict$initiate_partner_response,
      status_response: ict$status_partner_response,
      terminate_response: ict$terminate_partner_response,
      delete_response: ict$delete_partner_response,
      partner_job_file: file,
      skeleton_file: file,
      partner_job_name: ict$partner_job_name,
      job_name_to_jsn_ptr: ^ict$job_name_to_jsn,
      be_job_name: mlt$partner_job_unique_id,
      be_job_name_to_jsn_ptr: ^ict$be_job_name_to_jsn,
      route_status: ict$route_partner_status,
      queue_status: ict$partner_queue_status;

?? OLDTITLE, NEWTITLE := 'CONSTANT DECLARATIONS', EJECT ??

    CONST
      partner_job_file_name = 'icpjfil',
      partner_job_dc_file_name = 11032012061114(8),    { ICPJFIL }
      acct_skeleton_file_name = 'icaccnt',
      job_dayfile = 3;

?? OLDTITLE, NEWTITLE := 'EXTERNAL REFERENCES', EJECT ??

    PROCEDURE [XREF] getword (address: integer;
          word: ^cell);

    PROCEDURE [XREF] pause (time: integer);

    VAR
      mlv$terminate: [XREF] boolean,
      mlv$fatal_error: [XREF] boolean;

?? OLDTITLE, NEWTITLE := 'PROCEDURE log', EJECT ??

{ The purpose of this routine is to issue a dayfile message.

    PROCEDURE log (message: string ( * );
          dayfile: 0 .. 7;
          force: boolean);

      VAR
        display_code_string: array [1 .. 8] of packed array [0 .. 9] of 0 .. 3f(16),
        display_code_in_words: integer,
        display_code_in_characters: 0 .. 9,
        result_length: ost$string_index,
        end_of_line: boolean;

      IF (NOT pj_exec_debug) AND (dayfile = job_dayfile) AND (NOT force) THEN
        RETURN;
      IFEND;
      result_length := 1;
      display_code_in_words := 1;
      display_code_in_characters := 0;
      end_of_line := TRUE;
      utp$convert_string_to_dc_string (utc$ascii64, display_code_string, display_code_in_words,
            display_code_in_characters, message, result_length, end_of_line);
      n7p$issue_dayfile_message (#LOC (display_code_string), dayfile);

    PROCEND log;
?? OLDTITLE, NEWTITLE := 'PROCEDURE log_vrbl', EJECT ??

{ The purpose of this routine is to issue a dayfile message with a
{ variable value appended to it.

    PROCEDURE log_vrbl (message: string ( * );
          value: integer;
          dayfile: 0 .. 7;
          force: boolean);

      VAR
        new_string: ^string ( * ),
        new_string_length,
        string_length: integer;

      string_length := STRLENGTH (message);
      PUSH new_string: [string_length + 10];
      new_string^ (1, string_length) := message (1, string_length);
      new_string^ (string_length + 1, 10) := '          ';
      STRINGREP (new_string^ (string_length + 1, 10), new_string_length, value);
      log (new_string^, dayfile, force);

    PROCEND log_vrbl;

?? OLDTITLE, NEWTITLE := 'PROCEDURE dump', EJECT ??
    PROCEDURE dump (abort: ict$pj_exec_failure;
          error_status: ^cell;
          error_length: integer);

      CONST
        ordinal_size_of_word = 15;

      VAR
        new_error_status: ^packed array [1 .. 100] of packed array [1 .. ordinal_size_of_word] of 0 .. 15,
        size_limit,
        ordinal_char,
        number_of_ordinal_words,
        number_of_ordinal_chars: integer,
        message: string (17);

      log_vrbl (' hex data for pj_exec condition =', ORD (abort), job_dayfile,
            TRUE);
      message := ' ';
      new_error_status := error_status;
      size_limit := error_length;
      IF size_limit > 100 THEN
        size_limit := 100;
      IFEND;
      FOR number_of_ordinal_words := 1 TO size_limit DO
        FOR number_of_ordinal_chars := 1 TO ordinal_size_of_word DO
          ordinal_char := new_error_status^ [number_of_ordinal_words] [number_of_ordinal_chars];
          IF ordinal_char > 9 THEN
            ordinal_char := ordinal_char + 37(16);
          ELSE
            ordinal_char := ordinal_char + 30(16);
          IFEND;
          message (number_of_ordinal_chars + 1) := CHR (ordinal_char);
        FOREND;
        log (message, job_dayfile, TRUE);
      FOREND;

    PROCEND dump;
?? OLDTITLE, NEWTITLE := 'PROCEDURE route_partner_job', EJECT ??
    PROCEDURE route_partner_job (file_name: ict$nos_file_name;
      VAR partner_job_name: ict$partner_job_name;
      VAR route_status: ict$route_partner_status);

      VAR
        routepb: ict$route_parameter_block,
        routepb_init: [STATIC] ict$route_parameter_block := [0, 0, FALSE,
          0, 0, FALSE, 0, input_flags, in_disposition_code, 0, FALSE, 0, [TRUE, 0, FALSE,
          FALSE, 0, TRUE, 0, TRUE, FALSE, FALSE, FALSE, 0, FALSE, TRUE, FALSE, FALSE, TRUE,
          FALSE], 0, 0, 0, FALSE, 0, 0, 0, 0, 0, 0, 0, 0, 0],
        error_code_length: 1 .. 2;

      routepb := routepb_init;
      routepb.lfn := file_name;
      ? IF icv$nos_be = FALSE THEN
        routepb.f := TRUE;
        routepb.ot := local_batch_origin_type;
      ? ELSE
        routepb.flags.file_ident_specified := TRUE;
        routepb.flags.priority := TRUE;
        routepb.b := TRUE;
        routepb.priority := nosbe_priority;
      ? IFEND
      icp$route_to_nos_input_queue (routepb);
      log_vrbl (' route status ', routepb.ec, job_dayfile, FALSE);
      IF routepb.ec = 0 THEN
        partner_job_name := routepb.lfn;
        route_status := icc$partner_route_ok;
      ELSE
        route_status := icc$partner_route_failed;
      IFEND;

    PROCEND route_partner_job;
?? OLDTITLE, NEWTITLE := 'PROCEDURE find_partner_queue', EJECT ??
    PROCEDURE find_partner_queue (partner_job_name: ict$partner_job_name;
      VAR queue_status: ict$partner_queue_status);

    ? IF icv$nos_be = FALSE THEN
      VAR
        qacpb: [STATIC] ict$qac_parameter_block := [0, 0, 0, FALSE, 0, 0, NIL,
          0, NIL, 0, NIL, 0, 0, 0, 0, NIL, * , * , 0, 0, FALSE, 0, 0, FALSE,
          FALSE, 0, 0, 0, 0, 0, * , * , * , 0, 0, * , * , * , * ];

      qacpb.fcn := qac_peek_function_code;
      qacpb.complete_bit := FALSE;
      qacpb.request_block_length := peek_request_length;
      qacpb.ordinal := 0;
      qacpb.queue := 0;
      qacpb.jsn := partner_job_name;
      qacpb.jsn_option := TRUE;
      qacpb.input_queue_flag := TRUE;
      qacpb.execution_queue_flag := TRUE;
      qacpb.link_addr := 0;
      qacpb.first := #LOC (qacpb.fill13);
      qacpb.inn := qacpb.first;
      qacpb.out := qacpb.first;
      qacpb.limit := #LOC (qacpb.fill14);
{ First, in, out, and limit must be legitimate even tho unused by QAC

      icp$acquire_from_nos_queue (qacpb);
      log_vrbl (' acquire input status ', qacpb.err, job_dayfile, FALSE);
      log_vrbl (' incnt ', qacpb.incnt, job_dayfile, FALSE);
      log_vrbl (' excnt ', qacpb.excnt, job_dayfile, FALSE);

      IF qacpb.incnt <> 0 THEN
        queue_status := icc$partner_queue_input;
      ELSEIF qacpb.excnt <> 0 THEN
          queue_status := icc$partner_queue_executing;
      ELSE
        queue_status := icc$partner_not_in_queues;
      IFEND;
    ? ELSE
      VAR
        qafpbi: [STATIC] ict$qaf_parameter_block := [0, 0, [0, TRUE, FALSE,
          FALSE, FALSE, TRUE], qaf_count_function_code, FALSE, 0, 0, 0, 0, 0,
          0, 0, 0, 0, 0, 0],
        qafpb: ict$qaf_parameter_block;

      qafpb := qafpbi;
      qafpb.partner_job_name := partner_job_name;
      icp$acquire_from_nos_queue (qafpb);
      log_vrbl (' acquire input status ', qafpb.err, job_dayfile, FALSE);
      log_vrbl (' incnt ', qafpb.incnt, job_dayfile, FALSE);
      log_vrbl (' excnt ', qafpb.excnt, job_dayfile, FALSE);

      IF qafpb.incnt <> 0 THEN
        queue_status := icc$partner_queue_input;
      ELSEIF qafpb.excnt <> 0 THEN
        queue_status := icc$partner_queue_executing;
      ELSE
        queue_status := icc$partner_not_in_queues;
      IFEND;
    ? IFEND

    PROCEND find_partner_queue;
{ ICP$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.
{
{       ICP$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 ICACCNT).
{
{ SUBSTITUTE_CARD: (Output) This parameter returns a copy of the skeleton
{       record with values substituted for the keywords.

    PROCEDURE icp$sub_skel_parms (
       job_validation_info: job_validation_info_type;
       skeleton_card: string (140);
       VAR substitute_card: string (140));

? IF icv$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),
      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,
      max_replacement_length: 1 .. 78,
      keyword_sub: string (78),
      name_string: string (31),
      in_buff_lngth: integer,
      out_buff_lngth: integer,
? IF icv$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 .. 78;
?? OLDTITLE, NEWTITLE := 'PROCEDURE icp$sub_skel_parms', EJECT ??

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

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

{  If input buffer 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_validation_info.job_info;
          max_replacement_length := 78;
          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 icv$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 icv$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.  This is used for the
{ $SYSTEM user (entering a dual state command from the NOS/VE console.
          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.  This is used for the
{ $SYSTEM family (entering a dual state command from the NOS/VE console.
          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 icv$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 icp$sub_skel_parms;
?? OLDTITLE, NEWTITLE := 'PROCEDURE substitute_keyword', 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
{
{ 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 size 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 .. 78;
       out_buff_lngth: integer;
       max_replacement_length: 1 .. 78;
       keyword_sub: string(78));

    VAR index: 1 .. 78;

{ Calculate length of the replacement string.

      replacement_length := 1;
    /cal_replacement_lngth/
      FOR index := 1 to 78 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 (78));

    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 icv$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;
?? OLDTITLE, NEWTITLE := 'PROCEDURE create_job_validation_record', EJECT ??

{ CREATE_JOB_VALIDATION_RECORD
{
{        This procedure will create the job validation record used for
{ substitution into the Interstate Communications template file (ICACCNT).
{
{        CREATE_JOB_VALIDATION_RECORD (DC_VALIDATION_RECORD, JOB_VALIDATION_RECORD)
{
{ DC_VALIDATION_RECORD: (Input) This parameter has the values of the various
{       attributes that are replaced onto the partner job template file.
{
{ JOB_VALIDATION_RECORD: (Output) This parameter will contain the values of the various
{       attributes that are replaced onto the partner job template file.
{
  PROCEDURE create_job_validation_record (dc_validation_record: ^dc_validation_information_type;
       VAR job_validation_record: job_validation_info_type);

    VAR display_code_in_words: integer,
        display_code_in_chars: 0..9,
        result_length: ost$string_length,
        end_of_line: boolean;

    job_validation_record.job_info := ' ';
    job_validation_record.user_name := ' ';
    job_validation_record.password := ' ';
    job_validation_record.family_name := ' ';
    job_validation_record.charge_number := ' ';
    job_validation_record.project_number := ' ';
    job_validation_record.original_user_name := ' ';
    job_validation_record.original_family_name := ' ';
    job_validation_record.original_charge_number := ' ';
    job_validation_record.original_project_number := ' ';
    display_code_in_words := 1;
    display_code_in_chars := 0;
    utp$convert_dc_string_to_string(utc$ascii64, dc_validation_record^.job_info,
      display_code_in_words, display_code_in_chars, job_validation_record.job_info,
      result_length, end_of_line);
    display_code_in_words := 1;
    display_code_in_chars := 0;
    utp$convert_dc_string_to_string(utc$ascii64, dc_validation_record^.user_name,
      display_code_in_words, display_code_in_chars, job_validation_record.user_name,
      result_length, end_of_line);
    display_code_in_words := 1;
    display_code_in_chars := 0;
    utp$convert_dc_string_to_string(utc$ascii64, dc_validation_record^.password,
      display_code_in_words, display_code_in_chars, job_validation_record.password,
      result_length, end_of_line);
    display_code_in_words := 1;
    display_code_in_chars := 0;
    utp$convert_dc_string_to_string (utc$ascii64, dc_validation_record^.family_name,
      display_code_in_words, display_code_in_chars, job_validation_record.family_name,
      result_length, end_of_line);
    display_code_in_words := 1;
    display_code_in_chars := 0;
    utp$convert_dc_string_to_string(utc$ascii64, dc_validation_record^.charge_number,
      display_code_in_words, display_code_in_chars, job_validation_record.charge_number,
      result_length, end_of_line);
    display_code_in_words := 1;
    display_code_in_chars := 0;
    utp$convert_dc_string_to_string(utc$ascii64, dc_validation_record^.project_number,
      display_code_in_words, display_code_in_chars, job_validation_record.project_number,
      result_length, end_of_line);
    display_code_in_words := 1;
    display_code_in_chars := 0;
    utp$convert_dc_string_to_string(utc$ascii64, dc_validation_record^.original_user_name,
      display_code_in_words, display_code_in_chars, job_validation_record.original_user_name,
      result_length, end_of_line);
    display_code_in_words := 1;
    display_code_in_chars := 0;
    utp$convert_dc_string_to_string(utc$ascii64, dc_validation_record^.original_family_name,
      display_code_in_words, display_code_in_chars, job_validation_record.original_family_name,
      result_length, end_of_line);
    display_code_in_words := 1;
    display_code_in_chars := 0;
    utp$convert_dc_string_to_string(utc$ascii64, dc_validation_record^.original_charge_number,
      display_code_in_words, display_code_in_chars, job_validation_record.original_charge_number,
      result_length, end_of_line);
    display_code_in_words := 1;
    display_code_in_chars := 0;
    utp$convert_dc_string_to_string(utc$ascii64, dc_validation_record^.original_project_number,
      display_code_in_words, display_code_in_chars, job_validation_record.original_project_number,
      result_length, end_of_line);

  PROCEND create_job_validation_record;
?? OLDTITLE, NEWTITLE := 'PROCEDURE icp$partner_job_exec_real', EJECT ??

    PROCEDURE [XDCL] icp$partner_job_exec_real ALIAS 'icppjer';
      VAR
        dc_validation_information: ^dc_validation_information_type,
        job_validation_record: job_validation_info_type,
        skeleton_card: string(140),
        substitute_card: string(140),
        card_length: integer,
        file_mark_returned: file_mark;

      CASE current_state OF

{ Initialize debug flags.
      = initialize_flags =
        getword (0, #LOC (ra_word_0));
        pj_exec_debug := ra_word_0.sw2;

{ Sign on to the Memory Link.

      = signon =
        mlp$sign_on (icc$pj_exec_application_name, 1, unique, status);
        IF status.condition = mlc$nosve_not_up THEN
          mlv$terminate := TRUE;
          RETURN;
        IFEND;
        IF status.condition IN mli_retry_status THEN
          RETURN;
        IFEND;
        IF status.condition = mlc$nosve_not_up THEN
          mlv$terminate := TRUE;
          RETURN;
        IFEND;
        IF status.condition IN mli_fatal_status THEN
          abort := signon_failed;
          dump (abort, #LOC (status), #SIZE (status));
          RETURN;
        IFEND;

{ Permit any application to send to us.

      = addspl =
        mlp$add_sender (icc$pj_exec_application_name, mlc$null_name, status);
        IF status.condition IN mli_retry_status THEN
          RETURN;
        IFEND;
        IF status.condition = mlc$nosve_not_up THEN
          mlv$terminate := TRUE;
          RETURN;
        IFEND;
        IF status.condition IN mli_fatal_status THEN
          abort := addspl_failed;
          dump (abort, #LOC (status), #SIZE (status));
          RETURN;
        IFEND;

{ Process partner job requests from NOS/VE.

      = wait_for_request =

        mlp$receive_message (icc$pj_exec_application_name, arbinfo, signal,
              #LOC (msg), length_returned, #SIZE (msg), 0, nosve_application,
              status);
        IF status.condition IN mli_retry_status THEN
          RETURN;
        IFEND;
        IF status.condition = mlc$nosve_not_up THEN
          mlv$terminate := TRUE;
          RETURN;
        IFEND;
        IF status.condition IN mli_fatal_status THEN
          abort := receive_failed;
          dump (abort, #LOC (status), #SIZE (status));
          RETURN;
        IFEND;

        CASE arbinfo OF

{ Initiate partner job request.

        = ORD (icc$initiate_partner_request) =

          mlp$locate_free_job_entry (entry_located);

          IF entry_located THEN

            initiate_request_ptr := #LOC (msg);
            dc_validation_information := #loc(initiate_request_ptr^.
              validation_image);
            create_job_validation_record (dc_validation_information,
                job_validation_record);

{ Open and read ICACCNT 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#);
            /job_card_loop/
            REPEAT
              skeleton_card := ' ';
              lg#get(skeleton_file,card_length,skeleton_card);
              f#mark(skeleton_file,file_mark_returned);
              IF file_mark_returned = data# THEN
                icp$sub_skel_parms(job_validation_record,skeleton_card,substitute_card);
                /find_string_size/
                FOR substitute_card_size := 140 DOWNTO 1 DO
                  IF substitute_card (substitute_card_size, 1) <> ' ' THEN
                    EXIT /find_string_size/;
                  IFEND;
                FOREND /find_string_size/;
                lg#put (partner_job_file, substitute_card(1,substitute_card_size));
              IFEND;
            UNTIL (file_mark_returned <> data#);

            bi#put (partner_job_file, #LOC (initiate_request_ptr^.partner_image [1]),
                  initiate_request_ptr^.commands_length);
            bi#weor (partner_job_file);
            bi#put (partner_job_file, #LOC (initiate_request_ptr^.partner_image
                  [initiate_request_ptr^.commands_length + 1]),
                  initiate_request_ptr^.data_length);
            bi#close (partner_job_file, first#);
            lg#close(skeleton_file,first#);

            route_partner_job (partner_job_dc_file_name, partner_job_name,
                  route_status);
            CASE route_status OF

            = icc$partner_route_ok =

              job_name_to_jsn_ptr := #LOC (partner_job_name);
              job_unique_id := job_name_to_jsn_ptr^.first_four_char;

? IF icv$nos_be = TRUE THEN
{ NOS/BE has seven character jsn's
              be_job_name_to_jsn_ptr := #LOC (partner_job_name);
              be_job_name := be_job_name_to_jsn_ptr^.last_seven_chars;
? IFEND;
{ The following shift ensures that a C170 application name is always different
{ from any C180 application name.

              initiate_response.partner_identification.application_name :=
                    job_unique_id *  4000(16);
? IF icv$nos_be = FALSE THEN
              initiate_response.partner_identification.job_name :=
                    job_unique_id;
? ELSE
              initiate_response.partner_identification.job_name :=
                    be_job_name;
? IFEND
              initiate_response.partner_identification.job_unique_id :=
                    job_unique_id;

              mlp$create_job_entry (job_unique_id, create_status, FALSE);
              IF create_status = mlc$job_entry_created_ok THEN
                initiate_response.initiate_status := ORD
                      (icc$partner_started_ok);
              ELSE
                initiate_response.initiate_status := ORD
                      (icc$partner_job_limit_exceeded);
              IFEND;

            = icc$partner_route_failed =

              initiate_response.initiate_status := ORD
                    (icc$partner_start_failed);

            ELSE

            CASEND;

          ELSE

            initiate_response.initiate_status := ORD
                  (icc$partner_job_limit_exceeded);

          IFEND;


{ Status partner job request.

        = ORD (icc$status_partner_request) =

          status_request_ptr := #LOC (msg);

          mlp$find_signed_on_job (status_request_ptr^.partner_identification.
                job_unique_id, find_status);

          IF find_status = mlc$job_signed_on THEN

            status_response.partner_status := ORD (icc$partner_signed_on);

          ELSE

            find_partner_queue (status_request_ptr^.partner_identification.
                  job_name, queue_status);

            CASE queue_status OF

            = icc$partner_queue_input =
              status_response.partner_status := ORD
                    (icc$partner_in_input_queue);

            = icc$partner_queue_executing =
              status_response.partner_status := ORD
                    (icc$partner_not_signed_on);

            = icc$partner_not_in_queues =
              status_response.partner_status := ORD (icc$partner_not_found);

            ELSE

            CASEND;

          IFEND;


{ Terminate partner job request.

        = ORD (icc$terminate_partner_request) =

          terminate_request_ptr := #LOC (msg);

          mlp$find_signed_on_job (terminate_request_ptr^.
                partner_identification.job_unique_id, find_status);

          IF find_status = mlc$job_signed_on THEN

            mlp$terminate_signed_on_job (terminate_request_ptr^.
                  partner_identification.job_unique_id, mli_terminate_status);
            IF mli_terminate_status = mlc$job_terminated THEN
              terminate_response.terminate_status := ORD
                    (icc$partner_terminated_ok);
            ELSE
              terminate_response.terminate_status := ORD
                    (icc$no_term_not_found);
            IFEND;

          ELSE

            find_partner_queue (terminate_request_ptr^.partner_identification.
                  job_name, queue_status);

            CASE queue_status OF

            = icc$partner_queue_input =
              terminate_response.terminate_status := ORD
                    (icc$no_term_in_input_queue);

            = icc$partner_queue_executing =
              terminate_response.terminate_status := ORD
                    (icc$no_term_not_signed_on);

            = icc$partner_not_in_queues =
              terminate_response.terminate_status := ORD
                    (icc$no_term_not_found);

            ELSE

            CASEND;

          IFEND;


{ Delete partner job request.

        = ORD (icc$delete_partner_request) =

          delete_request_ptr := #LOC (msg);

          mlp$delete_job_entry (delete_request_ptr^.partner_identification.
                job_unique_id, delete_status);

          IF delete_status = mlc$job_entry_deleted_ok THEN
            delete_response.delete_status := ORD (icc$partner_deleted_ok);
          ELSE
            delete_response.delete_status := ORD (icc$no_delete_not_found);
          IFEND;


        ELSE

        CASEND;

      = send_response =
        CASE arbinfo OF
        = ORD (icc$initiate_partner_request) =
          mlp$send_message (icc$pj_exec_application_name, ORD
                (icc$initiate_partner_response), signal, #LOC
                (initiate_response), #SIZE (initiate_response),
                nosve_application, status);

        = ORD (icc$status_partner_request) =

          mlp$send_message (icc$pj_exec_application_name, ORD
                (icc$status_partner_response), signal, #LOC (status_response),
                #SIZE (status_response), nosve_application, status);

        = ORD (icc$terminate_partner_request) =

          mlp$send_message (icc$pj_exec_application_name, ORD
                (icc$terminate_partner_response), signal, #LOC
                (terminate_response), #SIZE (terminate_response),
                nosve_application, status);

        = ORD (icc$delete_partner_request) =

          mlp$send_message (icc$pj_exec_application_name, ORD
                (icc$delete_partner_response), signal, #LOC (delete_response),
                #SIZE (delete_response), nosve_application, status);
        CASEND;
        IF status.condition IN mli_retry_status THEN
          RETURN;
        IFEND;
        IF status.condition = mlc$nosve_not_up THEN
          mlv$terminate := TRUE;
          RETURN;
        IFEND;
        IF status.condition IN mli_fatal_status THEN
          abort := send_failed;
          dump (abort, #LOC (status), #SIZE (status));
        IFEND;

        current_state := wait_for_request;
        RETURN;
      CASEND;

      current_state := SUCC (current_state);

    PROCEND icp$partner_job_exec_real;

  MODEND icm$partner_job_exec_real;
