
*copyc OSD$DEFAULT_PRAGMATS
?? NEWTITLE := 'NOS/VE  Remote Host :' ??
MODULE rhm$output_file_transmit;

?? NEWTITLE := 'Global Type Declarations' ??
?? SET (LIST := ON) ??
?? EJECT ??
*copyc rhd$nos_ve_types
*copyc jme$queued_file_conditions
*copyc CLH$CONVERT_STRING_TO_INTEGER
*copyc ost$user_identification
*copyc TMC$WAIT_TIMES
*copyc RHC$CONDITION_LIMITS

?? TITLE := 'External Procedures Referenced By This Module' ??
?? SET (LIST := ON) ??
?? EJECT ??
*copyc AMP$GET_SEGMENT_POINTER
*copyc AMP$SET_SEGMENT_EOI
*copyc AMP$SET_SEGMENT_POSITION
*copyc AMP$OPEN
*copyc AMP$CLOSE
*copyc AMP$PUT_NEXT
*copyc AMP$RETURN
*copyc clp$trimmed_string_size
*copyc MLP$SEND_MESSAGE
*copyc MLP$RECEIVE_MESSAGE
*copyc RHV$SIGNAL
*copyc OSP$FORMAT_MESSAGE
*copyc OSP$SET_STATUS_ABNORMAL
*copyc PMP$LONG_TERM_WAIT
*copyc PMP$WAIT
*copyc jmp$set_output_completed
*copyc jmp$acquire_modified_output
*copyc jmp$acquire_new_output
*copyc jmp$close_output_file
*copyc jmp$modified_output_exists
*copyc jmp$new_output_exists
*copyc jmp$open_output_file
*copyc jmp$terminated_output_exists
*copyc jmp$set_output_initiated
*copyc jmp$terminate_acquired_output
*copyc SYP$MEMORY_LINK_DATA_CONVERSION
*copyc PMP$FORMAT_COMPACT_DATE
*copyc PMP$FORMAT_COMPACT_TIME
*copyc PMP$GET_DATE
*copyc PMP$GET_TIME
*copyc PMP$LOG
*copyc PMP$ESTABLISH_CONDITION_HANDLER
*copyc pmp$disestablish_cond_handler
*copyc PMP$CONTINUE_TO_CAUSE
*copyc RHP$SET_STATUS_ABNORMAL

?? TITLE := 'Variables Used By This Module' ??
?? SET (LIST := ON) ??
?? EJECT ??

  VAR
    local_file_acquired: boolean,
    banner_file_open: boolean;

?? TITLE := '[XDCL] rhp$queue_file_transmit_exec' ??
?? SET (LIST := ON) ??
?? EJECT ??

{ RHP$QUEUE_FILE_TRANSMIT_EXEC
{
{     This procedure is responsible for the acquisition and subsequent
{ transfer of a queued file to its receiving partner application.  This
{ transfer includes the responsibilities of performing protocol
{ maintenance, file transmission control, and final file disposition.
{
{     RHP$QUEUE_FILE_TRANSMIT_EXEC (QUEUE_FILE_PASSWORD, APPLICATION_NAMES,
{              DATA_BUFFER_POINTER, EXEC_STATUS
{
{ QUEUE_FILE_PASSWORD: (input) This is the password assigned by queued files
{        that is required in order to open a file in the output queue.
{
{ APPLICATION_NAMES: (input) This parameter contains the sending and
{     receiving application names required for MLI communication.
{
{ DATA_BUFFER_POINTER: (input) This parameter contains the address
{     of a buffer that will be used to transmit data from.
{
{ FILES_PROCESSED: (output) This parameter indicates to the calling
{     procedure if their were files to be processed.
{

  PROCEDURE [XDCL] rhp$queue_file_transmit_exec ALIAS 'rhmqat'
    (    queue_file_password: jmt$queue_file_password;
     VAR application_names: rht$mli_application_names;
         data_buffer_pointer: rht$file_data_buffer_pointer;
     VAR files_processed: boolean);

?? EJECT ??

    PROCEDURE handle_termination
      (    cond: pmt$condition;
           cd: ^pmt$condition_information;
           sa: ^ost$stack_frame_save_area;
       VAR ch_status: ost$status);

      VAR
        term_file_status: ost$status;

      IF break_active THEN
        RETURN;
      IFEND;
      break_active := TRUE;

{ Close banner file.

      IF banner_file_open THEN
        amp$close (banner_file_info.file_identifier, term_file_status);
      IFEND;
      amp$return (banner_file_info.local_file_name, term_file_status);

{ Close and return the queue file.

      IF output_file_open THEN
        jmp$close_output_file (output_file_id, term_file_status);
      IFEND;

      IF local_file_acquired THEN
        transmit_complete := FALSE;
        jmp$set_output_completed (jmc$dual_state_usage, system_file_name,
              transmit_complete, status);
      IFEND;

{ Terminate IRHF 170 processing by sending EOI.

      message_info.message_length := 0;
      message_info.arbitrary_info := eoi;

    /send_eoi/
      REPEAT
        mlp$send_message (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 NOT status.normal THEN
          CASE status.condition OF
          = mlc$busy_interlock, mlc$pool_buffer_not_avail =
            pmp$wait (1000, 1000);
          ELSE
            rhp$set_status_abnormal (status);
            log_status (status, msg_status);
            EXIT /send_eoi/;
          CASEND;
        IFEND;
      UNTIL status.normal; { send_eoi }

    PROCEND handle_termination;

?? EJECT ??
{ Begin RHP$QUEUE_FILE_TRANSMIT_EXEC

    CONST
      boi = rhc$beginning_of_information,
      eoi = rhc$end_of_information,
      buffer_size_in_words = (mlc$max_message_length DIV (64 * 8)) * 64,
      completed = rhc$completed,
      err = rhc$error;

    VAR
      msg_status: ost$status,
      status: ost$status,
      output_file_id: amt$file_identifier,
      output_file_open: boolean,
      system_file_name: jmt$system_supplied_name,
      output_descriptor: jmt$output_descriptor,
      sender_application_name: mlt$application_name,
      transmit_complete: boolean,
      banner_file_eoi: boolean,
      banner_file_info: rht$local_file_info,
      queue_file_info: [XDCL] rht$queue_file_info,
      cond_desc: [STATIC, READ] pmt$condition :=
            [pmc$condition_combination, $pmt$condition_combination
            [pmc$block_exit_processing]],
      estab_handler: pmt$established_handler,
      local_status: ost$status,
      break_active: boolean,
      conversion_message_length: integer,
      priority_msg_not_received_count: 0 .. 20,
      segment_pointer: amt$segment_pointer,
      conversion_info: syt$conversion_info,
      message_info: [STATIC] rht$mli_message_info := [ * , 0, * , * ];

{ * * * * * * *   T R A N S M I T   A    Q U E U E   F I L E   * * * * * * *

{ Initialize.

    break_active := FALSE;
    banner_file_open := FALSE;
    local_file_acquired := FALSE;
    output_file_open := FALSE;
    queue_file_info.machine_type := c180;

    pmp$establish_condition_handler (cond_desc, ^handle_termination,
          ^estab_handler, local_status);

{ Set files_processed to TRUE - if no output exists then set it to FALSE
{ in order to wait for more.

    files_processed := TRUE;

{ Acquire a file in the output queue ready for transmission to NOS/170.

  /output_file_transmit/
    BEGIN

      WHILE jmp$terminated_output_exists (jmc$dual_state_usage) DO
        jmp$terminate_acquired_output (jmc$dual_state_usage, system_file_name,
              status);
        IF NOT status.normal THEN
          log_status (status, msg_status);
          status.normal := TRUE;
          EXIT /output_file_transmit/;
        IFEND;
      WHILEND;

      IF jmp$modified_output_exists (jmc$dual_state_usage) THEN
        jmp$acquire_modified_output (jmc$dual_state_usage, output_descriptor,
              status);
      ELSEIF jmp$new_output_exists (jmc$dual_state_usage) THEN
        jmp$acquire_new_output (jmc$dual_state_usage, output_descriptor,
              status);
      ELSE
        files_processed := FALSE;
        EXIT /output_file_transmit/;
      IFEND;
      IF NOT status.normal THEN
        IF status.condition = jme$output_queue_is_empty THEN
          status.normal := TRUE;
        ELSE
          log_status (status, msg_status);
        IFEND;
        EXIT /output_file_transmit/;
      IFEND;
      system_file_name := output_descriptor.system_file_name;
      IF output_descriptor.remote_host_directive.size <> 0 THEN
        output_descriptor.remote_host_directive.size := clp$trimmed_string_size (
        output_descriptor.remote_host_directive.parameters (1, output_descriptor.remote_host_directive.size));
      IFEND;

      local_file_acquired := TRUE;
      jmp$set_output_initiated (jmc$dual_state_usage, system_file_name,
            status);
      IF NOT status.normal THEN
        log_status (status, msg_status);
        transmit_complete := FALSE;
        jmp$set_output_completed (jmc$dual_state_usage, system_file_name,
              transmit_complete, status);
        IF NOT status.normal THEN
          log_status (status, msg_status);
        IFEND;
        local_file_acquired := FALSE;
        EXIT /output_file_transmit/;
      IFEND;

{ Check to see if routing job wants no output sent.
{ IF it does, then delete the file from the output queue.

      IF output_descriptor.implicit_routing_text.text (44, 7) = 'DC = NO' THEN
        transmit_complete := TRUE;
        jmp$set_output_completed (jmc$dual_state_usage, system_file_name,
              transmit_complete, status);
        IF NOT status.normal THEN
          log_status (status, msg_status);
        IFEND;
        local_file_acquired := FALSE;
        EXIT /output_file_transmit/;
      IFEND;

{ Save information required by the nos/170 route to send the file to its
{destination.

      save_170_queue_file_info (output_descriptor, queue_file_info);

{ Transmit file information to nos.

      message_info.message_area := ^queue_file_info.equalizer;
      message_info.message_length := #SIZE (queue_file_info.equalizer);
      message_info.arbitrary_info := boi;

    /send_file_info/
      REPEAT
        mlp$send_message (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 NOT status.normal THEN
          CASE status.condition OF
          = mlc$busy_interlock, mlc$pool_buffer_not_avail,
                mlc$prior_msg_not_received, mlc$receiver_not_signed_on =
            pmp$long_term_wait (tmc$infinite_wait, 5000);
          ELSE
            rhp$set_status_abnormal (status);
            log_status (status, msg_status);
            transmit_complete := FALSE;
            jmp$set_output_completed (jmc$dual_state_usage, system_file_name,
                  transmit_complete, status);
            IF NOT status.normal THEN
              log_status (status, msg_status);
            IFEND;
            local_file_acquired := FALSE;
            EXIT /output_file_transmit/;
          CASEND;
        IFEND;
      UNTIL status.normal; {send_file_info}

{ Generate banner for nos/ve output file.

      banner_file_info.local_file_name := 'rh_temp_banner_file';
      banner_file_eoi := FALSE;
      generate_banner (banner_file_info, output_descriptor, status);

{ Transmit the banner to nos/170.
{     If error occurs, continue on and transmit the output file.

    /transmit_banner/
      BEGIN

        open_file (banner_file_info, amc$variable, status);
        IF status.normal THEN
          banner_file_open := TRUE;
          amp$get_segment_pointer (banner_file_info.file_identifier,
                amc$sequence_pointer, segment_pointer, status);
          IF NOT status.normal THEN
            log_status (status, msg_status);
            amp$close (banner_file_info.file_identifier, status);
            banner_file_open := FALSE;
            amp$return (banner_file_info.local_file_name, status);
            EXIT /transmit_banner/;
          IFEND;
        ELSE
          log_status (status, msg_status);
          amp$return (banner_file_info.local_file_name, status);
          EXIT /transmit_banner/;
        IFEND;

        conversion_info.file_pointer := segment_pointer.sequence_pointer;
        RESET conversion_info.file_pointer;
        conversion_info.save_area := 0;
        conversion_info.conversion_type := syc$ascii_to_8_in_12;
        message_info.arbitrary_info := rhc$middle_of_information;

      /transmit_banner_data/
        REPEAT
          conversion_message_length := buffer_size_in_words;
          syp$memory_link_data_conversion (^conversion_info,
                data_buffer_pointer, conversion_message_length);
          IF conversion_message_length <> buffer_size_in_words THEN
            banner_file_eoi := TRUE;
            segment_pointer.sequence_pointer := conversion_info.file_pointer;
            amp$set_segment_position (banner_file_info.file_identifier,
                  segment_pointer, status);
            IF NOT status.normal THEN
              log_status (status, msg_status);
              EXIT /transmit_banner_data/;
            IFEND;
          IFEND;

          message_info.message_area := data_buffer_pointer;
          message_info.message_length := conversion_message_length * 8;

        /send_banner_data/
          REPEAT
            mlp$send_message (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
              IF banner_file_eoi THEN
                EXIT /transmit_banner_data/;
              IFEND;
            ELSE
              CASE status.condition OF
              = mlc$busy_interlock, mlc$pool_buffer_not_avail,
                    mlc$prior_msg_not_received, mlc$receiver_not_signed_on =
                pmp$long_term_wait (tmc$infinite_wait, 5000);
              ELSE
                rhp$set_status_abnormal (status);
                log_status (status, msg_status);
                EXIT /transmit_banner_data/;
              CASEND;
            IFEND;
          UNTIL status.normal; {send_banner_data}

        UNTIL FALSE; {transmit_banner_data}

        amp$close (banner_file_info.file_identifier, status);
        banner_file_open := FALSE;
        IF NOT status.normal THEN
          log_status (status, msg_status);
        IFEND;
        amp$return (banner_file_info.local_file_name, status);

      END /transmit_banner/;

{ Transmit the output queue file.

      status.normal := TRUE;
      message_info.arbitrary_info := rhc$middle_of_information;
      output_file_open := TRUE;
      jmp$open_output_file (system_file_name, amc$segment,
            jmc$dual_state_usage, queue_file_password, output_file_id, status);
      IF status.normal THEN
        amp$get_segment_pointer (output_file_id, amc$sequence_pointer,
              segment_pointer, status);
        IF NOT status.normal THEN
          IF status.condition = ame$read_of_empty_segment THEN
            message_info.arbitrary_info := eoi;
            message_info.message_length := 0;
          ELSE
            log_status (status, msg_status);
            message_info.arbitrary_info := err;
          IFEND;
        IFEND;
      ELSE
        log_status (status, msg_status);
        message_info.arbitrary_info := err;
      IFEND;

      IF NOT status.normal THEN {Send a status to the 170}
        jmp$close_output_file (output_file_id, status);
        output_file_open := FALSE;
        IF NOT status.normal THEN
          log_status (status, msg_status);
        IFEND;
        transmit_complete := (message_info.arbitrary_info = eoi) OR
              (message_info.arbitrary_info = err);
        jmp$set_output_completed (jmc$dual_state_usage, system_file_name,
              transmit_complete, status);
        local_file_acquired := FALSE;
        IF NOT status.normal THEN
          log_status (status, msg_status);
        IFEND;

      /send_file_status/
        REPEAT
          mlp$send_message (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 NOT status.normal THEN
            CASE status.condition OF
            = mlc$busy_interlock, mlc$pool_buffer_not_avail,
                  mlc$prior_msg_not_received, mlc$receiver_not_signed_on =
              pmp$long_term_wait (tmc$infinite_wait, 5000);
            ELSE
              rhp$set_status_abnormal (status);
              log_status (status, msg_status);
              EXIT /send_file_status/;
            CASEND;
          IFEND;
        UNTIL status.normal; {send_file_status}
        EXIT /output_file_transmit/;
      IFEND;

      conversion_info.file_pointer := segment_pointer.sequence_pointer;
      RESET conversion_info.file_pointer;
      conversion_info.save_area := 0;
      conversion_info.conversion_type := syc$ascii_t_records_to_812;
      message_info.arbitrary_info := rhc$middle_of_information;
      priority_msg_not_received_count := 0;

    /transmit_output_data/
      REPEAT
        status.normal := TRUE;

{ Get converted data from queue file

        conversion_message_length := buffer_size_in_words;
        syp$memory_link_data_conversion (^conversion_info, data_buffer_pointer,
              conversion_message_length);
        IF conversion_message_length <> buffer_size_in_words THEN
          message_info.arbitrary_info := eoi;
          segment_pointer.sequence_pointer := conversion_info.file_pointer;
          amp$set_segment_position (output_file_id, segment_pointer, status);
          IF NOT status.normal THEN
            log_status (status, msg_status);
          IFEND;
        IFEND;

        message_info.message_area := data_buffer_pointer;
        message_info.message_length := conversion_message_length * 8;

      /send_output_data/
        REPEAT
          mlp$send_message (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
            IF message_info.arbitrary_info = eoi THEN
              EXIT /transmit_output_data/;
            IFEND;
            priority_msg_not_received_count := 0;
          ELSE
            CASE status.condition OF
            = mlc$busy_interlock, mlc$pool_buffer_not_avail,
                  mlc$receiver_not_signed_on =
              pmp$long_term_wait (tmc$infinite_wait, 5000);
          = mlc$prior_msg_not_received =

{ IF a prior message is not received after approximately 100 seconds,
{ then stop sending the output file and terminate it.

              IF priority_msg_not_received_count < 20 THEN
                priority_msg_not_received_count := priority_msg_not_received_count + 1;
                pmp$long_term_wait (tmc$infinite_wait, 5000);
              ELSE
                EXIT /transmit_output_data/;
              IFEND;
            ELSE
              rhp$set_status_abnormal (status);
              log_status (status, msg_status);
              jmp$close_output_file (output_file_id, status);
              output_file_open := FALSE;
              IF NOT status.normal THEN
                log_status (status, msg_status);
              IFEND;
              transmit_complete := FALSE;
              jmp$set_output_completed (jmc$dual_state_usage, system_file_name,
                    transmit_complete, status);
              local_file_acquired := FALSE;
              IF NOT status.normal THEN
                log_status (status, msg_status);
              IFEND;
              EXIT /output_file_transmit/;
            CASEND;
          IFEND;
        UNTIL status.normal; {send_output_data}

      UNTIL FALSE; {transmit_output_data}

{ Check if data was routed to nos's output queue okay.

    /get_route_status/
      REPEAT

        { Check 170 status

        mlp$receive_message (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 pending msg} ,
              sender_application_name, status);
        IF status.normal THEN
          IF NOT (message_info.arbitrary_info = completed) THEN
            osp$set_status_abnormal (rhc$remote_host_id,
                  rhe$unable_to_route_file, system_file_name, status);
            log_status (status, msg_status);
            osp$set_status_abnormal (rhc$remote_host_id,
                  rhe$unable_to_complete_transfer,
                  output_descriptor.login_user, status);
            log_status (status, msg_status);
            EXIT /get_route_status/;
          IFEND;
        ELSE
          CASE status.condition OF
          = mlc$busy_interlock, mlc$receive_list_index_invalid =
            pmp$long_term_wait (tmc$infinite_wait, 5000);
          ELSE
            rhp$set_status_abnormal (status);
            log_status (status, msg_status);
            EXIT /get_route_status/;
          CASEND;
        IFEND;
      UNTIL status.normal; {get_route_status}

{ Release the queue file.

      jmp$close_output_file (output_file_id, status);
      output_file_open := FALSE;
      IF NOT status.normal THEN
        log_status (status, msg_status);
      IFEND;
      transmit_complete := TRUE;
      jmp$set_output_completed (jmc$dual_state_usage, system_file_name,
            transmit_complete, status);
      local_file_acquired := FALSE;
      IF NOT status.normal THEN
        log_status (status, msg_status);
      IFEND;

    END /output_file_transmit/;

    pmp$disestablish_cond_handler (cond_desc, local_status);

  PROCEND rhp$queue_file_transmit_exec;

?? TITLE := 'save_170_queue_file_info' ??
?? SET (LIST := ON) ??
?? EJECT ??

  PROCEDURE save_170_queue_file_info
    (    output_descriptor: jmt$output_descriptor;
     VAR queue_file_info: rht$queue_file_info);

    VAR
      forms_code: jmt$forms_code,
      conversion_status: rht$status;

    convert_ascii88_to_ascii812 (output_descriptor.system_file_name,
          queue_file_info.c180.file_name.c180_file_name, conversion_status);

    forms_code := output_descriptor.forms_code;
    IF forms_code = 'NORMAL' THEN
      forms_code := '';
    IFEND;

    queue_file_info.c180.form_code_char1.ascii88_char := forms_code (1);
    queue_file_info.c180.form_code_char2.ascii88_char := forms_code (2);

    queue_file_info.c180.repeat_count := output_descriptor.copies;
    convert_ascii88_to_ascii812 (output_descriptor.login_user,
          queue_file_info.c180.user_number_of_owner.c180_owner_user_num,
          conversion_status);
    convert_ascii88_to_ascii812 (output_descriptor.login_family,
          queue_file_info.c180.family_name_of_creator.c180_creator_family_name,
          conversion_status);
    convert_ascii88_to_ascii812 (output_descriptor.login_account,
          queue_file_info.c180.user_charge_number, conversion_status);
    convert_ascii88_to_ascii812 (output_descriptor.login_project,
          queue_file_info.c180.user_project_number, conversion_status);

    convert_ascii88_to_ascii812 (output_descriptor.source_logical_id,
          queue_file_info.c180.logical_identifier.c180_logical_identifier,
          conversion_status);
    convert_ascii88_to_ascii812 (output_descriptor.implicit_routing_text.text,
          queue_file_info.c180.implicit_routing_text, conversion_status);
    queue_file_info.c180.implicit_text_size :=
          output_descriptor.implicit_routing_text.size;
    queue_file_info.c180.dual_state_routing_text_size :=
          output_descriptor.remote_host_directive.size;
    IF output_descriptor.remote_host_directive.size <> 0 THEN
      convert_ascii88_to_ascii812 (output_descriptor.dual_state_user,
            queue_file_info.c180.user_number_of_owner.c180_owner_user_num,
            conversion_status);
      convert_ascii88_to_ascii812 (output_descriptor.dual_state_family_name,
            queue_file_info.c180.family_name_of_creator.
            c180_creator_family_name, conversion_status);
      convert_ascii88_to_ascii812 (output_descriptor.dual_state_password,
            queue_file_info.c180.user_password, conversion_status);

{ If the RHD parameter is used on the PRIF command, then save the dual state
{ account and project numbers in queue file info rather than the login project
{ and account numbers.

      convert_ascii88_to_ascii812 (output_descriptor.dual_state_account,
            queue_file_info.c180.user_charge_number, conversion_status);
      convert_ascii88_to_ascii812 (output_descriptor.dual_state_project,
            queue_file_info.c180.user_project_number, conversion_status);
      convert_ascii88_to_ascii812 (output_descriptor.remote_host_directive.
            parameters, queue_file_info.c180.dual_state_routing_text,
            conversion_status);

{ The original login USER, FAMILY, PROJECT, and ACCOUNT must be saved if
{ the user specified the DSRP parameter on the PRIF command.

      convert_ascii88_to_ascii812 (output_descriptor.login_user,
            queue_file_info.c180.original_user_name.c180_original_user_name,
            conversion_status);
      convert_ascii88_to_ascii812 (output_descriptor.login_family,
            queue_file_info.c180.original_family_name.
            c180_original_family_name, conversion_status);
      convert_ascii88_to_ascii812 (output_descriptor.login_account,
            queue_file_info.c180.original_charge_number, conversion_status);
      convert_ascii88_to_ascii812 (output_descriptor.login_project,
            queue_file_info.c180.original_project_number, conversion_status);
    IFEND;

  PROCEND save_170_queue_file_info;
?? TITLE := 'log_status' ??
?? SET (LIST := ON) ??
?? EJECT ??
{ LOG_STATUS
{
{        The purpose of this procedure is to format and log an error
{ to the job log.
{
{         LOG_STATUS (MESSAGE_STATUS, STATUS)
{
{ MESSAGE_STATUS: (input) This parameter contains the status to format and
{                 write to the job log.
{
{ STATUS: (output) This parameter returns the success or failure of logging
{         the error.
{

  PROCEDURE log_status
    (    message_status: ost$status;
     VAR status: ost$status);

    VAR
      message: ost$status_message,
      message_area: ^ost$status_message,
      message_line_count: ^ost$status_message_line_count,
      message_line_index: 1 .. osc$max_status_message_lines,
      message_line_size: ^ost$status_message_line_size,
      message_line: ^string ( * ),
      page_width: ost$status_message_line_size;


    status.normal := TRUE;
    page_width := osc$max_status_message_line;
    osp$format_message (message_status, osc$full_message_level, page_width,
          message, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;
    message_area := ^message;
    RESET message_area;
    NEXT message_line_count IN message_area;
    FOR message_line_index := 1 TO message_line_count^ DO
      NEXT message_line_size IN message_area;
      NEXT message_line: [message_line_size^] IN message_area;
      pmp$log (message_line^, status);
      IF NOT status.normal THEN
        RETURN;
      IFEND;
    FOREND;

  PROCEND log_status;
?? TITLE := 'open_file' ??
?? SET (LIST := ON) ??
?? EJECT ??

{ OPEN_FILE
{
{     The purpose of this procedure is to open the local file identified
{ by local_file_info for read only.
{
{     OPEN_FILE (LOCAL_FILE_INFO, STATUS)
{
{ LOCAL_FILE_INFO: (input) This parameter specifies all information
{     required for local file identification and access.
{
{ STATUS: (output) This parameter returns the status of the open.
{

  PROCEDURE open_file
    (VAR local_file_info: rht$local_file_info;
         record_type: amt$record_type;
     VAR status: ost$status);

    VAR
      open_attr: array [1 .. 1] of amt$access_selection;

{ Set attributes to open a file for read only.

    open_attr [1].key := amc$access_mode;
    open_attr [1].access_mode := $pft$usage_selections [pfc$read];

{ Open the file.

    amp$open (local_file_info.local_file_name, amc$segment, ^open_attr,
          local_file_info.file_identifier, status);

  PROCEND open_file;

?? TITLE := 'CONVERT_ASCII88_TO_ASCII812' ??
?? SET (LIST := ON) ??
?? EJECT ??

{ CONVERT_ASCII88_TO_ASCII812
{
{       The purpose of this procedure is to convert an 8/8 ascii string to
{ an A170 8/12 ascii string.
{
{        CONVERT_ASCII88_TO_ASCII812 (ASCII88_STRING,
{              ASCII812_STRING, CONVERSION_STATUS)
{
{ ASCII88_STRING: (input) This parameter contains the 8/8 ascii string which
{                 is to be converted.
{
{ ASCII812_STRING: (output) This parameter contains the 8/12 ascii string which
{                  is the result of the conversion.
{
{ CONVERSION_STATUS: (output) This parameter indicates the success or failure
{                    of the conversion.  If the output string is not large
{                    enough to complete the conversion of the entire input
{                    string then a status of non_fatal_error will be returned
{                    otherwise the conversion will be successful.  In either
{                    case, conversion of as much of the string as is possible
{                    will be performed.
{
{

  PROCEDURE convert_ascii88_to_ascii812
    (    ascii88_string: string ( * );
     VAR ascii812_string: array [ * ] of rht$c180_ascii812_word;
     VAR conversion_status: rht$status);

    VAR
      ascii88_string_length: 0 .. 256,
      ascii812_string_lbound: integer,
      ascii812_string_ubound: integer,
      words_required: integer,
      last_word_index: integer,
      chars_in_last_word: 1 .. 5,
      word_index: integer,
      ascii88_char_index: 0 .. 256,
      ascii812_char_index: 2 .. 5;

    ascii88_string_length := STRLENGTH (ascii88_string);
    ascii812_string_lbound := LOWERBOUND (ascii812_string);
    ascii812_string_ubound := UPPERBOUND (ascii812_string);
    words_required := (ascii88_string_length + 4) DIV 5;
    IF (ascii812_string_ubound - ascii812_string_lbound + 1) <
          words_required THEN
      last_word_index := ascii812_string_ubound;
      chars_in_last_word := 5;
      conversion_status := non_fatal_error;
    ELSE
      last_word_index := ascii812_string_lbound + words_required - 1;
      chars_in_last_word := ascii88_string_length - (words_required - 1) * 5;
      conversion_status := successful;
    IFEND;
    ascii88_char_index := 0;
    FOR word_index := ascii812_string_lbound TO last_word_index - 1 DO
      ascii88_char_index := ascii88_char_index + 1;
      ascii812_string [word_index].ascii812_char1.filler := 0;
      ascii812_string [word_index].ascii812_char1.ascii88_char :=
            ascii88_string (ascii88_char_index);
      FOR ascii812_char_index := 2 TO 5 DO
        ascii88_char_index := ascii88_char_index + 1;
        ascii812_string [word_index].ascii812_char2_5 [ascii812_char_index].
              filler := 0;
        ascii812_string [word_index].ascii812_char2_5 [ascii812_char_index].
              ascii88_char := ascii88_string (ascii88_char_index);
      FOREND;
    FOREND;
    ascii88_char_index := ascii88_char_index + 1;
    ascii812_string [last_word_index].ascii812_char1.filler := 0;
    ascii812_string [last_word_index].ascii812_char1.ascii88_char :=
          ascii88_string (ascii88_char_index);
    FOR ascii812_char_index := 2 TO chars_in_last_word DO
      ascii88_char_index := ascii88_char_index + 1;
      ascii812_string [last_word_index].ascii812_char2_5 [ascii812_char_index].
            filler := 0;
      ascii812_string [last_word_index].ascii812_char2_5 [ascii812_char_index].
            ascii88_char := ascii88_string (ascii88_char_index);
    FOREND;

  PROCEND convert_ascii88_to_ascii812;

?? TITLE := 'generate_banner' ??
?? SET (LIST := ON) ??
?? EJECT ??
{ GENERATE_BANNER
{
{     This procedure generates a banner page for all output files
{ being sent to NOS/170 for printing.
{
{      GENERATE_BANNER (OUTPUT_DESCRIPTOR, BANNER_FILE_INFO)
{
{ BANNER_FILE_INFO: (input, output) This parameter specifies all information
{     required to create the banner file.
{
{ OUTPUT_DESCRIPTOR: (input) This parameter contains the values of the job
{     output attributes for a file to be printed.
{
{ STATUS: (output) This parameter returns the status of the request.
{

  PROCEDURE generate_banner
    (VAR banner_file_info: rht$local_file_info;
         output_descriptor: jmt$output_descriptor;
     VAR status: ost$status);

    CONST
      long_line_length = 96,
      line_length = 20;

    VAR
      date: ost$date,
      date_to_print: string (31),
      output_line: string (long_line_length),
      time: ost$time,
      time_to_print: string (31),
      index: 1 .. 20,
      space_lines_count: 1 .. 7,
      eject: [STATIC, READ] string (20) := '1                    ',
      double_space: [STATIC, READ] string (20) := '0                   ',
      bottom_of_page: [STATIC, READ] string (20) := '2                   ',
      open_attr: array [1 .. 5] of amt$access_selection,
      byte_address: amt$file_byte_address,
      msg_status: ost$status;

{ Open the file which will contain the banner.

    open_attr [1].key := amc$open_position;
    open_attr [1].open_position := amc$open_at_boi;
    open_attr [2].key := amc$record_type;
    open_attr [2].record_type := amc$variable;
    open_attr [3].key := amc$access_mode;
    open_attr [3].access_mode := $pft$usage_selections
          [pfc$append, pfc$shorten, pfc$modify, pfc$read];
    open_attr [4].key := amc$file_organization;
    open_attr [4].file_organization := amc$sequential;
    open_attr [5].key := amc$block_type;
    open_attr [5].block_type := amc$system_specified;
    amp$open (banner_file_info.local_file_name, amc$record, ^open_attr,
          banner_file_info.file_identifier, status);
    IF NOT status.normal THEN
      log_status (status, msg_status);
      RETURN;
    IFEND;
    banner_file_open := TRUE;

{ Start at top of page.

    amp$put_next (banner_file_info.file_identifier, ^eject, line_length,
          byte_address, status);
    IF status.normal THEN
      amp$put_next (banner_file_info.file_identifier, ^double_space,
            line_length, byte_address, status);
      amp$put_next (banner_file_info.file_identifier, ^double_space,
            line_length, byte_address, status);
      amp$put_next (banner_file_info.file_identifier, ^double_space,
            line_length, byte_address, status);
    IFEND;
    IF NOT status.normal THEN
      log_status (status, msg_status);
    IFEND;

{ Get the current date and time.

    pmp$get_date (osc$mdy_date, date, status);
    IF NOT status.normal THEN
      log_status (status, msg_status);
    IFEND;

    pmp$get_time (osc$hms_time, time, status);
    IF NOT status.normal THEN
      log_status (status, msg_status);
    IFEND;

    output_line := ' ';
    output_line (15, 18) := 'PRINTED         = ';
    output_line (33, 8) := date.mdy;
    output_line (42, 8) := time.hms;
    amp$put_next (banner_file_info.file_identifier, ^output_line,
          long_line_length, byte_address, status);
    IF NOT status.normal THEN
      log_status (status, msg_status);
    IFEND;

{ Get the time the file was submitted to be printed.

    pmp$format_compact_date (output_descriptor.output_submission_time,
          osc$mdy_date, date, status);
    IF NOT status.normal THEN
      log_status (status, msg_status);
    IFEND;
    pmp$format_compact_time (output_descriptor.output_submission_time,
          osc$hms_time, time, status);
    IF NOT status.normal THEN
      log_status (status, msg_status);
    IFEND;

    output_line := ' ';
    output_line (15, 18) := 'CREATED         = ';
    output_line (33, 8) := date.mdy;
    output_line (42, 8) := time.hms;
    amp$put_next (banner_file_info.file_identifier, ^output_line,
          long_line_length, byte_address, status);
    IF NOT status.normal THEN
      log_status (status, msg_status);
    IFEND;
    output_line := ' ';
    output_line (15, 18) := 'FAMILY          = ';
    output_line (33, * ) := output_descriptor.control_family;
    amp$put_next (banner_file_info.file_identifier, ^output_line,
          long_line_length, byte_address, status);
    IF NOT status.normal THEN
      log_status (status, msg_status);
    IFEND;
    output_line := ' ';
    output_line (15, 18) := 'USER NAME       = ';
    output_line (33, * ) := output_descriptor.control_user;
    amp$put_next (banner_file_info.file_identifier, ^output_line,
          long_line_length, byte_address, status);
    IF NOT status.normal THEN
      log_status (status, msg_status);
    IFEND;
    output_line := ' ';
    output_line (15, 18) := 'USER JOB NAME   = ';
    output_line (33, * ) := output_descriptor.user_job_name;
    amp$put_next (banner_file_info.file_identifier, ^output_line,
          long_line_length, byte_address, status);
    IF NOT status.normal THEN
      log_status (status, msg_status);
    IFEND;
    output_line := ' ';
    output_line (15, 18) := 'SYSTEM JOB NAME = ';
    output_line (33, * ) := output_descriptor.system_job_name;
    amp$put_next (banner_file_info.file_identifier, ^output_line,
          long_line_length, byte_address, status);
    IF NOT status.normal THEN
      log_status (status, msg_status);
    IFEND;
    output_line := ' ';
    output_line (15, 18) := 'FILE NAME       = ';
    output_line (33, * ) := output_descriptor.user_file_name;
    amp$put_next (banner_file_info.file_identifier, ^output_line,
          long_line_length, byte_address, status);
    IF NOT status.normal THEN
      log_status (status, msg_status);
    IFEND;
    output_line := ' ';
    output_line (15, * ) := output_descriptor.comment_banner;
    amp$put_next (banner_file_info.file_identifier, ^output_line,
          long_line_length, byte_address, status);
    IF NOT status.normal THEN
      log_status (status, msg_status);
    IFEND;
    output_line := ' ';
    output_line (15, * ) := output_descriptor.site_information;
    amp$put_next (banner_file_info.file_identifier, ^output_line,
          long_line_length, byte_address, status);
    IF NOT status.normal THEN
      log_status (status, msg_status);
    IFEND;
    amp$put_next (banner_file_info.file_identifier, ^double_space, line_length,
          byte_address, status);
    amp$put_next (banner_file_info.file_identifier, ^double_space, line_length,
          byte_address, status);
    IF NOT status.normal THEN
      log_status (status, msg_status);
    IFEND;

    form_a_large_letter_row (banner_file_info,
          output_descriptor.routing_banner, status);

    amp$put_next (banner_file_info.file_identifier, ^bottom_of_page,
          line_length, byte_address, status);
    IF NOT status.normal THEN
      log_status (status, msg_status);
    IFEND;

{ Close the banner file.

    amp$close (banner_file_info.file_identifier, status);
    banner_file_open := FALSE;
    IF NOT status.normal THEN
      log_status (status, msg_status);
    IFEND;
    status.normal := TRUE;

  PROCEND generate_banner;

?? TITLE := 'form_a_large_letter_row' ??
?? SET (LIST := ON) ??
?? EJECT ??

{ FORM_A_LARGE_LETTER_ROW
{
{      This procedure will generate 10 large characters if called
{  10 times with row increased by 1 each time.
{
{      FORM_A_LARGE_LETTER_ROW (BANNER_FILE_INFO, INPUT_STRING STATUS)
{
{  BANNER_FILE_INFO : (input output) This parameter specifies all information
{     required to create the banner file.
{
{  INPUT_STRING : (input) This parameter specifies the character
{     string to make large letters from.
{
{  STATUS: (output) This parameter returns the status of the request.
{

  PROCEDURE form_a_large_letter_row
    (VAR banner_file_info: rht$local_file_info;
         input_string: string (31);
     VAR status: ost$status);

    CONST
      banner_line_length = 132,
      line_length = 20,
      max_character_images = 68,
      max_char_across_page = 10,
      numbers_position = 27,
      special_chars_position = 37,
      number_of_special_chars = 32,
      number_of_rows = 10,
      number_of_columns = 10;

    TYPE
      char_image_table_type = array [1 .. max_character_images] of array
            [1 .. number_of_rows] of string (number_of_columns),
      lowercase_to_uppercase = array ['a' .. 'z'] of 'A' .. 'Z',
      number_types = array [1 .. 10] of '0' .. '9',
      special_character_types = array [1 .. number_of_special_chars] of ' ' ..
            '~';

    VAR
      index: 1 .. 10,
      int: integer,
      msg_status: ost$status,
      row: 1 .. 10,
      line: string (132),
      byte_address: amt$file_byte_address,
      sp_index: 1 .. 32,
      character: char,
      char_image_table_index: integer,
      double_space: [STATIC, READ] string (20) := '0                   ',
      string_position_index: integer,
      new_char_string: string (10),
      uppercase: [STATIC, READ] lowercase_to_uppercase := ['A', 'B', 'C', 'D',
            'E', 'F', 'G', 'H', 'I', 'J', 'K', 'L', 'M', 'N', 'O', 'P', 'Q',
            'R', 'S', 'T', 'U', 'V', 'W', 'X', 'Y', 'Z'],
      special_character: [STATIC, READ] special_character_types := ['+', '-',
            '*', '/', '\', '(', ')', '$', '#', '=', ' ', ',', '.', '_', '!',
            '{', '}', '|', '[', ']', ':', '%', '<', '>', ';', '"', '&', '?',
            '`', '@', '^', '~'],
      table_index_array: [STATIC] array [1 .. max_char_across_page] of integer,
      char_image_table: [STATIC, READ] char_image_table_type := [

?? SET (LIST := OFF) ??
?? FMT (FORMAT := OFF) ??

{                   a_letter: 001
    [' AAAAAAAA ',
     'AAAAAAAAAA',
     'AA      AA',
     'AA      AA',
     'AA      AA',
     'AAAAAAAAAA',
     'AAAAAAAAAA',
     'AA      AA',
     'AA      AA',
     'AA      AA'],
{                   b_letter: 002
    ['BBBBBBBBB ',
     'BBBBBBBBBB',
     'BB      BB',
     'BB      BB',
     'BBBBBBBBB ',
     'BBBBBBBBB ',
     'BB      BB',
     'BB      BB',
     'BBBBBBBBBB',
     'BBBBBBBBB '],
{                   c_letter: 003
    [' CCCCCCCC ',
     'CCCCCCCCCC',
     'CC       C',
     'CC        ',
     'CC        ',
     'CC        ',
     'CC        ',
     'CC       C',
     'CCCCCCCCCC',
     ' CCCCCCCC '],
{                   d_letter: 004
    ['DDDDDDDDD ',
     'DDDDDDDDDD',
     'DD      DD',
     'DD      DD',
     'DD      DD',
     'DD      DD',
     'DD      DD',
     'DD      DD',
     'DDDDDDDDDD',
     'DDDDDDDDD '],
{                   e_letter: 005
    ['EEEEEEEEEE',
     'EEEEEEEEEE',
     'EE        ',
     'EE        ',
     'EEEEEE    ',
     'EEEEEE    ',
     'EE        ',
     'EE        ',
     'EEEEEEEEEE',
     'EEEEEEEEEE'],
{                   f_letter: 006
    ['FFFFFFFFFF',
     'FFFFFFFFFF',
     'FF        ',
     'FF        ',
     'FFFFFF    ',
     'FFFFFF    ',
     'FF        ',
     'FF        ',
     'FF        ',
     'FF        '],
{                   g_letter: 007
    [' GGGGGGGG ',
     'GGGGGGGGGG',
     'GG        ',
     'GG        ',
     'GG   GGGGG',
     'GG   GGGGG',
     'GG      GG',
     'GG      GG',
     'GGGGGGGGGG',
     ' GGGGGGGGG'],
{                   h_letter: 008
    ['HH      HH',
     'HH      HH',
     'HH      HH',
     'HH      HH',
     'HHHHHHHHHH',
     'HHHHHHHHHH',
     'HH      HH',
     'HH      HH',
     'HH      HH',
     'HH      HH'],
{                   i_letter: 009
    ['IIIIIIIIII',
     'IIIIIIIIII',
     '    II    ',
     '    II    ',
     '    II    ',
     '    II    ',
     '    II    ',
     '    II    ',
     'IIIIIIIIII',
     'IIIIIIIIII'],
{                   j_letter: 010
    ['  JJJJJJJJ',
     '  JJJJJJJJ',
     '     JJ   ',
     '     JJ   ',
     '     JJ   ',
     '     JJ   ',
     'JJ   JJ   ',
     'JJ   JJ   ',
     'JJJJJJJ   ',
     ' JJJJJ    '],
{                   k_letter: 011
    ['KK      KK',
     'KK     KK ',
     'KK   KK   ',
     'KK KK     ',
     'KKKKK     ',
     'KK  KK    ',
     'KK   KK   ',
     'KK    KK  ',
     'KK     KK ',
     'KK      KK'],
{                   l_letter: 012
    ['LL        ',
     'LL        ',
     'LL        ',
     'LL        ',
     'LL        ',
     'LL        ',
     'LL        ',
     'LL        ',
     'LLLLLLLLLL',
     'LLLLLLLLLL'],
{                   m_letter: 013
    ['MM      MM',
     'MMMM  MMMM',
     'MM MMMM MM',
     'MM  MM  MM',
     'MM  MM  MM',
     'MM      MM',
     'MM      MM',
     'MM      MM',
     'MM      MM',
     'MM      MM'],
{                   n_letter: 014
    ['NN      NN',
     'NNN     NN',
     'NN N    NN',
     'NN NN   NN',
     'NN  NN  NN',
     'NN  NN  NN',
     'NN   NN NN',
     'NN    N NN',
     'NN     NNN',
     'NN      NN'],
{                   o_letter: 015
    [' OOOOOOOO ',
     'OOOOOOOOOO',
     'OO      OO',
     'OO      OO',
     'OO      OO',
     'OO      OO',
     'OO      OO',
     'OO      OO',
     'OOOOOOOOOO',
     ' OOOOOOOO '],
{                   p_letter: 016
    ['PPPPPPPPP ',
     'PPPPPPPPPP',
     'PP      PP',
     'PP      PP',
     'PPPPPPPPPP',
     'PPPPPPPPP ',
     'PP        ',
     'PP        ',
     'PP        ',
     'PP        '],
{                   q_letter: 017
    [' QQQQQQQQ ',
     'QQQQQQQQQQ',
     'QQ      QQ',
     'QQ      QQ',
     'QQ      QQ',
     'QQ      QQ',
     'QQ  QQQ QQ',
     'QQ    QQQQ',
     'QQQQQQQQQ ',
     ' QQQQQQ QQ'],
{                   r_letter: 018
    ['RRRRRRRRR ',
     'RRRRRRRRRR',
     'RR      RR',
     'RR      RR',
     'RRRRRRRRRR',
     'RRRRRRRRR ',
     'RR   RR   ',
     'RR    RR  ',
     'RR     RR ',
     'RR      RR'],
{                   s_letter: 019
    [' SSSSSSSS ',
     'SSSSSSSSSS',
     'SS       S',
     'SS        ',
     'SSSSSSSSS ',
     ' SSSSSSSSS',
     '        SS',
     'S       SS',
     'SSSSSSSSSS',
     ' SSSSSSSS '],
{                   t_letter: 020
    ['TTTTTTTTTT',
     'TTTTTTTTTT',
     '    TT    ',
     '    TT    ',
     '    TT    ',
     '    TT    ',
     '    TT    ',
     '    TT    ',
     '    TT    ',
     '    TT    '],
{                   u_letter: 021
    ['UU      UU',
     'UU      UU',
     'UU      UU',
     'UU      UU',
     'UU      UU',
     'UU      UU',
     'UU      UU',
     'UU      UU',
     'UUUUUUUUUU',
     ' UUUUUUUU '],
{                   v_letter: 022
    ['VV      VV',
     'VV      VV',
     ' VV    VV ',
     ' VV    VV ',
     ' VV    VV ',
     ' VV    VV ',
     '  VV  VV  ',
     '  VV  VV  ',
     '   VVVV   ',
     '    VV    '],
{                   w_letter: 023
    ['WW      WW',
     'WW      WW',
     'WW      WW',
     'WW      WW',
     'WW  WW  WW',
     'WW  WW  WW',
     'WW  WW  WW',
     'WW WWWW WW',
     ' WWW  WWW ',
     ' WW    WW '],
{                   x_letter: 024
    ['XX      XX',
     ' XX    XX ',
     '  XX  XX  ',
     '   XXXX   ',
     '    XX    ',
     '   XXXX   ',
     '  XX  XX  ',
     ' XX    XX ',
     'XX      XX',
     'XX      XX'],
{                   y_letter: 025
    ['YY      YY',
     ' YY    YY ',
     '  YY  YY  ',
     '   YYYY   ',
     '    YY    ',
     '    YY    ',
     '    YY    ',
     '    YY    ',
     '    YY    ',
     '    YY    '],
{                   z_letter: 026
    ['ZZZZZZZZZZ',
     'ZZZZZZZZZ ',
     '      ZZ  ',
     '     ZZ   ',
     '    ZZ    ',
     '    ZZ    ',
     '   ZZ     ',
     '  ZZ      ',
     ' ZZZZZZZZZ',
     'ZZZZZZZZZZ'],
{                   zero: 027
    ['   0000   ',
     '  000000  ',
     ' 00    00 ',
     '00      00',
     '00      00',
     '00      00',
     '00      00',
     ' 00    00 ',
     '  000000  ',
     '   0000   '],
{                   one: 028
    ['    11    ',
     '  1111    ',
     '  1 11    ',
     '    11    ',
     '    11    ',
     '    11    ',
     '    11    ',
     '    11    ',
     '1111111111',
     '1111111111'],
{                   two: 029
    [' 22222222 ',
     '2222222222',
     '2       22',
     '        22',
     '       22 ',
     '     22   ',
     '   22     ',
     ' 22       ',
     '2222222222',
     '2222222222'],
{                   three: 030
    ['3333333333',
     '333333333 ',
     '      33  ',
     '     33   ',
     '    333   ',
     '      333 ',
     '       33 ',
     '3       33',
     '333333333 ',
     ' 3333333  '],
{                   four: 031
    ['     444  ',
     '    4444  ',
     '   44 44  ',
     '  44  44  ',
     ' 44   44  ',
     '4444444444',
     '4444444444',
     '      44  ',
     '      44  ',
     '      44  '],
{                   five: 032
    ['5555555555',
     '5555555555',
     '55        ',
     '55        ',
     '555555555 ',
     '5555555555',
     '        55',
     '5       55',
     '5555555555',
     ' 55555555 '],
{                   six: 033
    [' 66666666 ',
     '6666666666',
     '66       6',
     '66        ',
     '666666666 ',
     '6666666666',
     '66      66',
     '66      66',
     '6666666666',
     ' 66666666 '],
{                   seven: 034
    ['7777777777',
     '7777777777',
     '       77 ',
     '     77   ',
     '   77     ',
     '  77      ',
     ' 77       ',
     ' 77       ',
     '77        ',
     '77        '],
{                   eight: 035
    [' 88888888 ',
     '8888888888',
     '88      88',
     '88      88',
     ' 88888888 ',
     ' 88888888 ',
     '88      88',
     '88      88',
     '8888888888',
     ' 88888888 '],
{                   nine: 036
    [' 99999999 ',
     '9999999999',
     '99      99',
     '99      99',
     '9999999999',
     ' 999999999',
     '        99',
     '9       99',
     '9999999999',
     ' $$$$$$$$ '],
{                   plus: 037
    ['          ',
     '          ',
     '   ++++   ',
     '   ++++   ',
     '++++++++++',
     '++++++++++',
     '   ++++   ',
     '   ++++   ',
     '          ',
     '          '],
{                   minus: 038
    ['          ',
     '          ',
     '          ',
     '          ',
     ' -------- ',
     ' -------- ',
     '          ',
     '          ',
     '          ',
     '          '],
{                   asterisk: 039
    ['          ',
     '          ',
     '          ',
     '  *    *  ',
     '   *  *   ',
     '* ****** *',
     '   *  *   ',
     '  *    *  ',
     '          ',
     '          '],
{                   slash: 040
    ['         /',
     '        //',
     '       // ',
     '      //  ',
     '     //   ',
     '    //    ',
     '   //     ',
     '  //      ',
     ' //       ',
     '/         '],
{                   reverse_slash: 041
    ['\         ',
     '\\        ',
     ' \\       ',
     '  \\      ',
     '   \\     ',
     '    \\    ',
     '     \\   ',
     '      \\  ',
     '       \\ ',
     '         \'],
{                   left_paren: 042
    ['       (  ',
     '     ((   ',
     '    ((    ',
     '   ((     ',
     '   ((     ',
     '   ((     ',
     '   ((     ',
     '    ((    ',
     '     ((   ',
     '       (  '],
{                   right_paren: 043
    ['  ))       ',
     '   ))     ',
     '    ))    ',
     '     ))   ',
     '     ))   ',
     '     ))   ',
     '     ))   ',
     '    ))    ',
     '   ))     ',
     '  )       '],
{                   dollar_sign: 044
    ['    $$    ',
     ' $$$$$$$$ ',
     '$$$$$$$$$$',
     '$$  $$    ',
     '$$$$$$$$$ ',
     ' $$$$$$$$$',
     '    $$  $$',
     '$$$$$$$$$$',
     ' $$$$$$$$ ',
     '    $$    '],
{                   number_sign: 045
    ['          ',
     '   ##  ## ',
     '   #   #  ',
     ' #########',
     '  ##  ##  ',
     '  #   #   ',
     '######### ',
     ' ##  ##   ',
     ' #   #    ',
     '          '],
{                   equals: 046
    ['          ',
     '          ',
     '          ',
     '==========',
     '==========',
     '          ',
     '==========',
     '==========',
     '          ',
     '          '],
{                   blank: 047
    ['          ',
     '          ',
     '          ',
     '          ',
     '          ',
     '          ',
     '          ',
     '          ',
     '          ',
     '          '],
{                   comma: 048
    ['          ',
     '          ',
     '          ',
     '          ',
     '          ',
     '   ,,,    ',
     '  ,,,,,   ',
     '   ,,,,   ',
     '     ,    ',
     '    ,     '],
{                   period: 049
    ['          ',
     '          ',
     '          ',
     '          ',
     '          ',
     '          ',
     '          ',
     '   ....   ',
     '  ......  ',
     '   ....   '],
{                   underline: 050
    ['          ',
     '          ',
     '          ',
     '          ',
     '          ',
     '          ',
     '          ',
     '          ',
     '__________',
     '__________'],
{                   exclamation: 051
    ['    !!    ',
     '    !!    ',
     '    !!    ',
     '    !!    ',
     '    !!    ',
     '    !!    ',
     '    !!    ',
     '          ',
     '    !!    ',
     '    !!    '],
{                   left_brace: 052
    ['   {{{{{{ ',
     '  {{      ',
     '  {{      ',
     '   {{     ',
     '{{{       ',
     '{{{       ',
     '   {{     ',
     '  {{      ',
     '  {{      ',
     '   {{{{{{ '],
{                   right_brace: 053
   [' }}}}}}   ',
    '      }}  ',
    '      }}  ',
    '     }}   ',
    '       }}}',
    '       }}}',
    '     }}   ',
    '      }}  ',
    '      }}  ',
    ' }}}}}}   '],
{                   vertical_line: 054
    ['    ||    ',
     '    ||    ',
     '    ||    ',
     '    ||    ',
     '    ||    ',
     '    ||    ',
     '    ||    ',
     '    ||    ',
     '    ||    ',
     '    ||    '],
{                   left_bracket: 055
    ['   [[[[[  ',
     '   [[     ',
     '   [[     ',
     '   [[     ',
     '   [[     ',
     '   [[     ',
     '   [[     ',
     '   [[     ',
     '   [[     ',
     '   [[[[[  '],
{                   right_bracket: 056
    ['  ]]]]]   ',
     '     ]]   ',
     '     ]]   ',
     '     ]]   ',
     '     ]]   ',
     '     ]]   ',
     '     ]]   ',
     '     ]]   ',
     '     ]]   ',
     '  ]]]]]   '],
{                   colon: 057
    ['          ',
     '          ',
     '   ::::   ',
     '  ::::::  ',
     '   ::::   ',
     '          ',
     '   ::::   ',
     '  ::::::  ',
     '   ::::   ',
     '          '],
{                   percent: 058
    ['%%%%    %%',
     '%  %   %% ',
     '%%%%  %%  ',
     '     %%   ',
     '    %%    ',
     '   %%     ',
     '  %%      ',
     ' %%   %%%%',
     '%%    %  %',
     '%     %%%%'],
{                   less_than: 059
    ['          ',
     '          ',
     '       << ',
     '     <<   ',
     '   <<     ',
     ' <<       ',
     '   <<     ',
     '     <<   ',
     '       << ',
     '          '],
{                   greater_than: 060
    ['          ',
     '          ',
     ' >>       ',
     '   >>     ',
     '     >>   ',
     '       >> ',
     '     >>   ',
     '   >>     ',
     ' >>       ',
     '          '],
{                   semi_colon: 061
    ['          ',
     '   ;;;    ',
     '  ;;;;;   ',
     '   ;;;    ',
     '          ',
     '   ;;;    ',
     '  ;;;;;   ',
     '   ;;;;   ',
     '     ;    ',
     '    ;     '],
{                   quotes: 062
    ['  "    "  ',
     ' """  """ ',
     '  ""   "" ',
     '  "    "  ',
     '          ',
     '          ',
     '          ',
     '          ',
     '          ',
     '          '],
{                   ampersand: 063
     ['   &&&    ',
      ' &&   &&  ',
      '&&     && ',
      '&&     && ',
      ' &&   &&  ',
      '   &&&    ',
      ' && &&    ',
      '&&   && &&',
      '&&    &&  ',
      '  &&&& && '],
{                   question_mark: 064
     ['   ????   ',
      ' ??    ?? ',
      ' ??    ?? ',
      '      ??  ',
      '     ??   ',
      '    ??    ',
      '    ??    ',
      '          ',
      '    ??    ',
      '    ??    '],
{                   accent: 065
     ['  ``      ',
      '   ``     ',
      '    ``    ',
      '          ',
      '          ',
      '          ',
      '          ',
      '          ',
      '          ',
      '          '],
{                    at_sign: 066
     ['  @@@@@@  ',
      ' @@@@@@@@ ',
      '@@      @@',
      '@       @@',
      ' @@@@@  @@',
      '@@@@@@@ @@',
      '@@   @@ @@',
      '@@   @@ @@',
      ' @@@@@@@@@',
      '  @@@@ @@ '],
{                   circumflex: 067
     ['    ^     ',
      '   ^^^    ',
      '  ^^ ^^   ',
      '^^     ^^ ',
      '          ',
      '          ',
      '          ',
      '          ',
      '          ',
      '          '],
{                   tilde: 068
     ['  ~~     ',
      ' ~~~~    ~',
      '~~  ~~  ~~',
      '~    ~~~~ ',
      '      ~~  ',
      '          ',
      '          ',
      '          ',
      '          ',
      '          ']
?? FMT (FORMAT := ON) ??
?? SET (LIST := ON) ??
      ];

    string_position_index := 1;
    WHILE string_position_index < 30 DO

{ Generate an index list into the char_image_table on the first pass.

      new_char_string := input_string (string_position_index, 10);

    /generate_index_table/
      FOR index := 1 TO max_char_across_page DO
        character := new_char_string (index);

{ Check if character  is a special function and convert to a blank.

        IF character < ' ' THEN
          character := ' ';
        IFEND;

        CASE character OF
        = 'A' .. 'Z', 'a' .. 'z' =
          IF (character >= 'a') AND (character <= 'z') THEN
            character := uppercase [character];
          IFEND;
          int := $INTEGER (character) - 64; { 64=40(16)

        = '0' .. '9' =
          int := $INTEGER (character) - 48 + numbers_position; { 48=30(16)

        ELSE

        /check_if_special_char/
          FOR sp_index := 1 TO number_of_special_chars DO
            IF character = special_character [sp_index] THEN
              EXIT /check_if_special_char/;
            IFEND;
          FOREND /check_if_special_char/;
          int := sp_index + special_chars_position - 1;
        CASEND;

{ Save the index to the char_image_table.

        table_index_array [index] := int;
      FOREND /generate_index_table/;

{ generate large letters.

      FOR row := 1 TO 10 DO
        FOR index := 1 TO 4 DO { Blank receiving line.
          line ((index * 33) - 32, 33) := '                                 ';
        FOREND;

        FOR index := 1 TO max_char_across_page DO
          char_image_table_index := table_index_array [index];
          line (13 * index - 10, 10) := char_image_table [
                char_image_table_index] [row];
        FOREND;
        amp$put_next (banner_file_info.file_identifier, ^line,
              banner_line_length, byte_address, status);
      FOREND;
      amp$put_next (banner_file_info.file_identifier, ^double_space,
            line_length, byte_address, status);
      string_position_index := string_position_index + 10;
    WHILEND;

  PROCEND form_a_large_letter_row;

MODEND rhm$output_file_transmit;
