?? RIGHT := 110 ??
?? NEWTITLE := 'CREATE_SUBPRODUCT_CORRECTION subutility: DISPLAY_CORRECTION_ATTRIB command.' ??
MODULE ram$display_correction_attrib;

{ PURPOSE:
{   This module contains the procedures to display the attributes of the
{   correction being created by CREATE SUBPRODUCT CORRECTION.
{
{ DESIGN:
{   The compiled module resides in RAF$LIBRARY.
{
{ NOTES:
{

?? NEWTITLE := 'Global Declarations Referenced by This Module', EJECT ??
?? PUSH (LISTEXT := ON) ??
*copyc rae$package_software_cc
*copyc ost$status
*copyc pft$array_index
*copyc pmt$condition
?? POP ??
*copyc clp$build_path_subtitle
*copyc clp$build_standard_title
*copyc clp$close_display
*copyc clp$convert_integer_to_real
*copyc clp$convert_integer_to_rjstring
*copyc clp$convert_integer_to_string
*copyc clp$convert_real_to_string
*copyc clp$evaluate_parameters
*copyc clp$get_path_name
*copyc clp$horizontal_tab_display
*copyc clp$new_display_line
*copyc clp$open_display_reference
*copyc clp$put_display
*copyc clp$put_partial_display
*copyc clp$reset_for_next_display_page
*copyc clp$right_justify_string
*copyc clp$trimmed_string_size
*copyc clv$display_variables
*copyc clv$nil_display_control
*copyc fsp$close_file
*copyc fsp$open_file
*copyc osp$disestablish_cond_handler
*copyc osp$establish_block_exit_hndlr
*copyc osp$set_status_abnormal
*copyc pmp$format_compact_date
*copyc pmp$format_compact_time
*copyc rap$convert_path_to_str
*copyc rap$display_psrs_answered
*copyc rap$write_strings
*copyc rav$correction_process_record

?? OLDTITLE ??
?? NEWTITLE := 'Global Declarations Declared by This Module', EJECT ??

  CONST
    max_line_size = 80;

?? OLDTITLE ??
?? NEWTITLE := '[XDCL] rap$display_correction_attrib', EJECT ??

{ PURPOSE:
{   This procedure displays the attributes of the correction being created
{   by CREATE SUBPRODUCT CORRECTION.
{
{ DESIGN:
{   This procedure uses the standard clp$display commands to display the
{   attributes to the output file.  It is patterned after ram$display_sif.
{
{ NOTES:
{

  PROCEDURE [XDCL] rap$display_correction_attrib
    (    parameter_list: clt$parameter_list;
     VAR status: ost$status);


{ PROCEDURE disca_pdt (
{   display_hidden_values: (hidden) boolean = FALSE
{   output, o: file = $output
{   status)

?? PUSH (LISTEXT := ON) ??

    VAR
      pdt: [STATIC, READ, cls$declaration_section] record
        header: clt$pdt_header,
        names: array [1 .. 4] of clt$pdt_parameter_name,
        parameters: array [1 .. 3] of clt$pdt_parameter,
        type1: record
          header: clt$type_specification_header,
          default_value: string (5),
        recend,
        type2: record
          header: clt$type_specification_header,
          default_value: string (7),
        recend,
        type3: record
          header: clt$type_specification_header,
        recend,
      recend := [[1, [88, 8, 8, 13, 38, 55, 580], clc$command, 4, 3, 0, 0, 1, 0, 3, 'DISCA_PDT'],
            [['DISPLAY_HIDDEN_VALUES          ', clc$nominal_entry, 1],
            ['O                              ', clc$abbreviation_entry, 2],
            ['OUTPUT                         ', clc$nominal_entry, 2],
            ['STATUS                         ', clc$nominal_entry, 3]], [
{ PARAMETER 1
      [1, clc$hidden_entry, clc$non_secure_parameter, $clt$parameter_spec_methods [clc$specify_by_name],
            clc$pass_by_value, clc$immediate_evaluation, clc$standard_parameter_checking, 3,
            clc$optional_default_parameter, 0, 5],
{ PARAMETER 2
      [3, clc$normal_usage_entry, clc$non_secure_parameter, $clt$parameter_spec_methods
            [clc$specify_by_name, clc$specify_positionally], clc$pass_by_value, clc$immediate_evaluation,
            clc$standard_parameter_checking, 3, clc$optional_default_parameter, 0, 7],
{ PARAMETER 3
      [4, clc$normal_usage_entry, clc$non_secure_parameter, $clt$parameter_spec_methods [clc$specify_by_name],
            clc$pass_by_reference, clc$immediate_evaluation, clc$standard_parameter_checking, 3,
            clc$optional_parameter, 0, 0]],
{ PARAMETER 1
      [[1, 0, clc$boolean_type], 'FALSE'],
{ PARAMETER 2
      [[1, 0, clc$file_type], '$output'],
{ PARAMETER 3
      [[1, 0, clc$status_type]]];

?? POP ??

    CONST
      p$display_hidden_values = 1,
      p$output = 2,
      p$status = 3;

    VAR
      pvt: array [1 .. 3] of clt$parameter_value;


    VAR
      default_ring_attributes: amt$ring_attributes,
      display_control: clt$display_control,
      display_opened: boolean,
      display_option: ost$name,
      display_status: ost$status,
      length: integer,
      local_status: ost$status;

?? TITLE := 'put_subtitle', EJECT ??

    PROCEDURE [INLINE] put_subtitle
      (VAR display_control: clt$display_control;
       VAR status: ost$status);

      rap$write_strings ('DISPLAY CORRECTION ATTRIBUTES', '', FALSE, 0, display_control, display_status);

    PROCEND put_subtitle;
?? NEWTITLE := 'abort_handler', EJECT ??

{ PURPOSE:
{   This procedure cleans up when an abort situation occurs
{   within the block structure.
{
{ DESIGN:
{   If the files have been opened, they will be closed before the
{   the procedure returns.
{
{ NOTES:
{
{

    PROCEDURE abort_handler
      (    condition: pmt$condition;
           condition_information: ^pmt$condition_information;
           save_area: ^ost$stack_frame_save_area;
       VAR handler_status: ost$status);

      VAR
        ignore_status: ost$status;

      IF display_opened THEN
        clp$close_display (display_control, ignore_status);
      IFEND;

    PROCEND abort_handler;
?? PUSH (LISTEXT := ON) ??
*copyc clp$new_page_procedure
?? POP ??
?? OLDTITLE, EJECT ??

    status.normal := TRUE;
    display_status.normal := TRUE;
    display_opened := FALSE;
    display_control := clv$nil_display_control;
    #SPOIL (display_control);
    clv$titles_built := FALSE;
    clv$command_name := 'display_correction_attributes';

    clp$evaluate_parameters (parameter_list, #SEQ (pdt), NIL, ^pvt, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    IF NOT rav$correction_process_record.correction_in_progress THEN
      osp$set_status_abnormal ('RA', rae$defc_command_not_called, 'DISPLAY_CORRECTION_ATTRIBUTES', status);
      RETURN;
    IFEND;

    default_ring_attributes.r1 := #RING (^default_ring_attributes);
    default_ring_attributes.r2 := #RING (^default_ring_attributes);
    default_ring_attributes.r3 := #RING (^default_ring_attributes);

    osp$establish_block_exit_hndlr (^abort_handler);

    display_opened := TRUE;
    clp$open_display_reference (pvt [p$output].value^.file_value^, ^clp$new_page_procedure, fsc$list,
          default_ring_attributes, display_control, status);
    IF NOT status.normal THEN
      display_opened := FALSE;
      RETURN;
    IFEND;

  /main/
    BEGIN
      display_catalogs_and_levels (rav$correction_process_record, display_control, status);
      IF NOT status.normal THEN
        RETURN;
      IFEND;

      display_correction_attributes (rav$correction_process_record.new_subproduct_info_pointers,
            pvt [p$display_hidden_values].value^.boolean_value.value, display_control, status);
      IF NOT status.normal THEN
        RETURN;
      IFEND;

      IF rav$correction_process_record.new_subproduct_info_pointers.psrs_answered_p <> NIL THEN
        rap$write_strings ('', '', FALSE, 0, display_control, display_status);
        rap$write_strings (' This CREATE_SUBPRODUCT_CORRECTION Session', '', FALSE, 0,
              display_control, display_status);
        rap$display_psrs_answered (rav$correction_process_record.new_subproduct_info_pointers.psrs_answered_p,
              display_control, status);
        IF NOT status.normal THEN
          RETURN;
        IFEND;
      IFEND;

      IF rav$correction_process_record.previous_correction_sif.file_opened THEN
        rap$write_strings ('', '', FALSE, 0, display_control, display_status);
        rap$write_strings (' The Previous Correction ', '', FALSE, 0, display_control,
              display_status);
        rap$display_psrs_answered (rav$correction_process_record.previous_correction_sif.
              subproduct_info_pointers.psrs_answered_p, display_control, status);
        IF NOT status.normal THEN
          RETURN;
        IFEND;
      IFEND;

    END /main/;

    IF display_opened THEN
      clp$close_display (display_control, display_status);
    IFEND;

    osp$disestablish_cond_handler;

  PROCEND rap$display_correction_attrib;

?? OLDTITLE ??
?? NEWTITLE := 'display_catalogs_and_levels', EJECT ??

{ PURPOSE:
{   This procedure displays the catalogs and their levels.
{
{ DESIGN:
{
{ NOTES:
{
{

  PROCEDURE display_catalogs_and_levels
    (    rav$correction_process_record: rat$correction_process_record;
     VAR display_control: clt$display_control;
     VAR status: ost$status);

    VAR
      base_subproduct_info_pointers: rat$subproduct_info_pointers,
      current_subproduct_info_ptrs: rat$subproduct_info_pointers,
      display_status: ost$status,
      previous_correction_pointers: rat$subproduct_info_pointers;

    status.normal := TRUE;
    display_status.normal := TRUE;
    base_subproduct_info_pointers := rav$correction_process_record.base_level_sif.subproduct_info_pointers;
    current_subproduct_info_ptrs := rav$correction_process_record.current_level_sif.subproduct_info_pointers;

    rap$write_strings (' Base Level PACS Catalog: ', base_subproduct_info_pointers.attributes_p^.
          pacs_catalog_path.path (1, base_subproduct_info_pointers.attributes_p^.pacs_catalog_path.size),
          FALSE, 0, display_control, display_status);

    rap$write_strings (' Base Level: ', base_subproduct_info_pointers.attributes_p^.level, FALSE, 0,
          display_control, display_status);
    rap$write_strings ('', '', FALSE, 0, display_control, display_status);

    rap$write_strings (' Current Level PACS Catalog: ', current_subproduct_info_ptrs.attributes_p^.
          pacs_catalog_path.path (1, current_subproduct_info_ptrs.attributes_p^.pacs_catalog_path.size),
          FALSE, 0, display_control, display_status);

    rap$write_strings (' Current Level: ', current_subproduct_info_ptrs.attributes_p^.level, FALSE, 0,
          display_control, display_status);
    rap$write_strings ('', '', FALSE, 0, display_control, display_status);

    IF rav$correction_process_record.previous_correction_sif.file_opened THEN
      previous_correction_pointers := rav$correction_process_record.previous_correction_sif.
            subproduct_info_pointers;
      rap$write_strings (' Previous Correction PACS Catalog: ',
            previous_correction_pointers.attributes_p^.pacs_catalog_path.
            path (1, previous_correction_pointers.attributes_p^.pacs_catalog_path.size), FALSE, 0,
            display_control, display_status);

      rap$write_strings (' Previous Correction Level: ', previous_correction_pointers.attributes_p^.level,
            FALSE, 0, display_control, display_status);
      rap$write_strings ('', '', FALSE, 0, display_control, display_status);
    IFEND;

    IF NOT display_status.normal THEN
      status := display_status;
    IFEND;

  PROCEND display_catalogs_and_levels;

?? OLDTITLE ??
?? NEWTITLE := 'display_correction_attributes', EJECT ??

{ PURPOSE:
{   This procedure displays the subproduct attributes.
{
{ DESIGN:
{   Each of the fields is read from the attributes record and displayed to
{   the output file.
{
{ NOTES:
{
{

  PROCEDURE display_correction_attributes
    (    subproduct_info_pointers: rat$subproduct_info_pointers;
         display_hidden_values: boolean;
     VAR display_control: clt$display_control;
     VAR status: ost$status);

    VAR
      attributes: rat$subproduct_attributes,
      display_status: ost$status,
      i: pft$array_index,
      installation_path: rat$path,
      installation_path_p: ^rat$path_container,
      installer_path: rat$path,
      installer_path_p: ^rat$path_container,
      package_software_ref_p: ^fst$file_reference,
      path_ref_p: ^fst$file_reference,
      path_container_index: rat$path_container_index,
      path_container_p: ^rat$path_container,
      sequence_descriptor: rat$sequence_descriptor;

*copy rav$installation_path_option
*copy rav$installation_scheme
*copy rav$subproduct_priority
*copy rav$subproduct_type

    status.normal := TRUE;
    display_status.normal := TRUE;
    attributes := subproduct_info_pointers.attributes_p^;
    path_container_p := subproduct_info_pointers.path_container_p;
    sequence_descriptor := subproduct_info_pointers.sequence_descriptor_p^;

    rap$write_strings ('', '', FALSE, 0, display_control, display_status);

    rap$write_strings (' Attributes of Subproduct ', attributes.name, FALSE, 0, display_control,
          display_status);

    rap$write_strings ('', '', FALSE, 0, display_control, display_status);

    rap$write_strings (' Additional Products:        ', '', TRUE, 0, display_control, display_status);

    IF attributes.additional_products [1] = '' THEN
      rap$write_strings ('NONE', '', FALSE, 0, display_control, display_status);

    ELSE

      FOR i := 1 TO rac$max_additional_products DO

        IF attributes.additional_products [i] <> '' THEN

          IF i = 1 THEN
            rap$write_strings ('', attributes.additional_products [i], FALSE, 0, display_control,
                  display_status);
          ELSE
            rap$write_strings ('                             ', attributes.additional_products [i], FALSE,
                  0, display_control, display_status);
          IFEND;

        IFEND;

      FOREND;

    IFEND;

    rap$write_strings (' Description:                ', attributes.description, FALSE, 0, display_control,
          display_status);

    rap$write_strings (' Development Group:          ', attributes.development_group, FALSE, 0,
          display_control, display_status);

    rap$write_strings (' Installation Scheme:        ', rav$installation_scheme
          [attributes.installation_scheme], FALSE, 0, display_control, display_status);

    PUSH installer_path_p: [1 .. attributes.installer_procedure.path_length];
    FOR i := 1 TO attributes.installer_procedure.path_length  DO
      path_container_index := i + attributes.installer_procedure.path_container_index - 1;
      installer_path_p^ [i] := path_container_p^ [path_container_index];
    FOREND;

    rap$convert_path_to_str (installer_path_p^, installer_path);

    IF attributes.installer_procedure.path_length <> 0 THEN
      rap$write_strings (' Installer Procedure:        ', installer_path.path (1, installer_path.size),
            FALSE, 0, display_control, display_status);
    ELSE
      rap$write_strings (' Installer Procedure:        ', 'NONE', FALSE, 0, display_control, display_status);
    IFEND;

    rap$write_strings (' Level:                      ', attributes.level, FALSE, 0, display_control,
          display_status);

    rap$write_strings (' Licensed Product:           ', attributes.licensed_product, FALSE, 0,
          display_control, display_status);

    rap$write_strings (' Dependencies:               ', '', TRUE, 0, display_control, display_status);

    IF attributes.dependencies [1] = '' THEN
      rap$write_strings ('NONE', '', FALSE, 0, display_control, display_status);

    ELSE

      FOR i := 1 TO rac$max_dependencies DO

        IF attributes.dependencies [i] <> '' THEN

          IF i = 1 THEN
            rap$write_strings (attributes.dependencies [i], '', FALSE, 0, display_control, display_status);
          ELSE
            rap$write_strings ('                             ', attributes.dependencies [i], FALSE, 0,
                  display_control, display_status);
          IFEND;

        IFEND;

      FOREND;

    IFEND;

    PUSH installation_path_p: [1 .. attributes.installation_path.path_length];
    FOR i := attributes.installation_path.path_container_index TO
          (attributes.installation_path.path_container_index +
          attributes.installation_path.path_length - 1) DO
      installation_path_p^ [i] := path_container_p^ [i];
    FOREND;

    rap$convert_path_to_str (installation_path_p^, installation_path);

    rap$write_strings (' Installation Path:          ', installation_path.path (1, installation_path.size),
          FALSE, 0, display_control, display_status);

    rap$write_strings (' PACS Catalog Path:          ', attributes.pacs_catalog_path.
          path (1, attributes.pacs_catalog_path.size), FALSE, 0, display_control,
          display_status);

    rap$write_strings (' Subproduct Type:            ', rav$subproduct_type [attributes.subproduct_type],
          FALSE, 0, display_control, display_status);

    IF attributes.auto_install = TRUE THEN
      rap$write_strings (' Auto Install:               TRUE', '', FALSE, 0, display_control, display_status);
    ELSE
      rap$write_strings (' Auto Install:               FALSE', '', FALSE, 0, display_control, display_status);
    IFEND;

    rap$write_strings (' Date Level:                 ', attributes.date_level, FALSE, 0, display_control,
          display_status);

    IF attributes.hidden = TRUE THEN
      rap$write_strings (' Hidden:                     TRUE', '', FALSE, 0, display_control, display_status);
    ELSE
      rap$write_strings (' Hidden:                     FALSE', '', FALSE, 0, display_control, display_status);
    IFEND;

    rap$write_strings (' Installation Path Option:   ', rav$installation_path_option
          [attributes.installation_path_option], FALSE, 0, display_control, display_status);

    IF attributes.primary = TRUE THEN
      rap$write_strings (' Primary Subproduct:         TRUE', '', FALSE, 0, display_control, display_status);
    ELSE
      rap$write_strings (' Primary Subproduct:         FALSE', '', FALSE, 0, display_control, display_status);
    IFEND;

    IF attributes.files_stamped = TRUE THEN
      rap$write_strings (' Files Stamped:              TRUE', '', FALSE, 0, display_control, display_status);
    ELSE
      rap$write_strings (' Files Stamped:              FALSE', '', FALSE, 0, display_control, display_status);
    IFEND;

    rap$write_strings (' Correction Base Level:      ', attributes.correction_base_level, FALSE, 0,
          display_control, display_status);

    rap$write_strings (' SIF Identifier:             ', attributes.sif_identifier, FALSE, 0,
          display_control, display_status);

    IF display_hidden_values THEN

      rap$write_strings (' Internal Level:             ', attributes.internal_level, FALSE, 0,
            display_control, display_status);

      rap$write_strings (' Subproduct Priority:        ', rav$subproduct_priority
            [attributes.subproduct_priority], FALSE, 0, display_control, display_status);

    IFEND;

  PROCEND display_correction_attributes;

?? OLDTITLE ??
?? NEWTITLE := 'write_string_and_integer', EJECT ??

{ PURPOSE:
{   This procedure writes a string and a integer to the output display.
{
{ DESIGN:
{   The string and the integer are combined into one string and a procedure
{   writes them to output.
{
{ NOTES:
{
{

  PROCEDURE write_string_and_integer
    (    string_a: string ( * );
         integer_a: integer;
         continue_line: boolean;
     VAR display_control: clt$display_control;
     VAR display_status: ost$status);

    VAR
      ignore_status: ost$status,
      line_a: string (2 * fsc$max_path_size),
      line_b: string (2 * fsc$max_path_size),
      line_size_a: integer,
      line_size_b: integer;

    IF NOT display_status.normal THEN
      RETURN;
    IFEND;

    line_a := '';
    STRINGREP (line_a, line_size_a, integer_a);

    line_b := '';
    STRINGREP (line_b, line_size_b, string_a, line_a (2, line_size_a - 1));

    IF continue_line THEN
      clp$put_partial_display (display_control, line_b (1, line_size_b), clc$no_trim, amc$continue,
            ignore_status);
    ELSE
      clp$put_partial_display (display_control, line_b (1, line_size_b), clc$no_trim, amc$terminate,
            ignore_status);
    IFEND;

  PROCEND write_string_and_integer;

MODEND ram$display_correction_attrib;
