?? RIGHT := 110 ??
?? NEWTITLE := 'PACKAGE_SOFTWARE Utility: Module RAM$DISPLAY_SIF.' ??
MODULE ram$display_sif;

{ PURPOSE:
{   This module contains the procedures to display the information in the SIF
{   sequence.
{
{ DESIGN:
{   The subproduct attributes, the element list or both may be displayed.
{   The compiled module resides in RAF$LIBRARY.
{
{ NOTES:
{
{

?? NEWTITLE := 'Global Declarations Referenced by This Module', EJECT ??
?? PUSH (LISTEXT := ON) ??
*copyc ost$status
*copyc pft$array_index
*copyc pmt$condition
*copyc rae$package_software_cc
*copyc rat$subproduct_info_pointers
*copyc rat$sequence_descriptor_types
*copyc rat$subproduct_info_p
*copyc rat$subproduct_info_types
*copyc rat$upper_level_permit
?? POP ??
*copyc clp$build_path_subtitle
*copyc clp$build_standard_title
*copyc clp$close_display
*copyc clp$convert_integer_to_rjstring
*copyc clp$convert_integer_to_string
*copyc clp$get_path_name
*copyc clp$get_set_count
*copyc clp$get_value
*copyc clp$horizontal_tab_display
*copyc clp$new_display_line
*copyc clp$open_display
*copyc clp$put_display
*copyc clp$put_partial_display
*copyc clp$reset_for_next_display_page
*copyc clp$right_justify_string
*copyc clp$scan_parameter_list
*copyc clp$trimmed_string_size
*copyc clv$display_variables
*copyc clv$nil_display_control
*copyc osp$disestablish_cond_handler
*copyc osp$establish_block_exit_hndlr
*copyc osp$set_status_abnormal
*copyc osv$upper_to_lower
*copyc pmp$format_compact_date
*copyc pmp$format_compact_time
*copyc rap$add_name_to_path_ref
*copyc rap$display_psrs_answered

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

  VAR
    installation_path_ref_p: ^fst$file_reference,
    pacs_catalog_ref_p: ^fst$file_reference,
    scratch_seq_p: ^SEQ ( * );

?? TITLE := 'rap$display_sif [XDCL]', EJECT ??

{ PURPOSE:
{   This procedure determines which parts of the SIF are to be
{   displayed and calls the appropriate procedure.
{
{ DESIGN:
{   The SIF is NEXT'd to read the info_header_p.  Within the info_header_p
{   are pointers to the subproduct attributes record and the beginning
{   of the element list.
{   The value of the installation path is determined.
{   Then the subproduct_attributes, element_list or both are displayed.
{
{ NOTES:
{
{

  PROCEDURE [XDCL] rap$display_sif
    (    subproduct_info_ptrs: rat$subproduct_info_pointers;
         catalog_ref_p: ^fst$file_reference;
     VAR scratch_sequence_p: ^SEQ ( * );
     VAR status: ost$status);

    VAR
      display_control: clt$display_control,
      display_hidden_values: boolean,
      display_opened: boolean,
      element_p: ^rat$element,
      file_ref_p: ^fst$file_reference,
      i: 0 .. clc$max_value_sets,
      input_file_id: amt$file_identifier,
      local_file_for_subtitle: clt$file,
      local_status: ost$status,
      ref_created: boolean,
      upper_level_permit: rat$upper_level_permit,
      value: clt$value,
      value_set_count: 0 .. clc$max_value_sets;

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

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

{     add subtitles here if needed}

    PROCEND put_subtitle;

?? NEWTITLE := 'abort_handler', EJECT ??

{ PURPOSE:
{   This procedure cleans up when an abort situation occurs
{   within the block structure.
{
{ DESIGN:
{   If the file has been opened, it 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;
*copy clp$new_page_procedure
*copy clp$put_path_subtitle
?? OLDTITLE, EJECT ??

    status.normal := TRUE;
    display_opened := FALSE;
    pacs_catalog_ref_p := catalog_ref_p;
    scratch_seq_p := scratch_sequence_p;

    element_p := #PTR (subproduct_info_ptrs.info_header_p^.element_list_p,
          subproduct_info_ptrs.subproduct_info_seq_p^);

    translate_path_container_to_ref (subproduct_info_ptrs.attributes_p^.installation_path,
          subproduct_info_ptrs, installation_path_ref_p, scratch_seq_p, ref_created);

    display_control := clv$nil_display_control;
    clv$titles_built := FALSE;
    clv$command_name := 'display_subproduct_information';

    clp$get_value ('DISPLAY_HIDDEN_VALUES', 1, 1, clc$low, value, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;
    display_hidden_values := value.bool.value;

    clp$get_value ('OUTPUT', 1, 1, clc$low, value, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;
    osp$establish_block_exit_hndlr (^abort_handler);

    display_opened := TRUE;
    clp$open_display (value.file, ^clp$new_page_procedure, display_control, status);
    IF NOT status.normal THEN
      display_opened := FALSE;
      RETURN;
    IFEND;

  /main/
    BEGIN

      clp$get_set_count ('DISPLAY_OPTION', value_set_count, status);
      IF NOT status.normal THEN
        EXIT /main/;
      IFEND;

      FOR i := 1 TO value_set_count DO
        clp$get_value ('DISPLAY_OPTION', i, 1, clc$low, value, status);
        IF NOT status.normal THEN
          EXIT /main/;
        IFEND;

        IF (value.name.value (1, value.name.size) = 'SUBPRODUCT_ATTRIBUTES') OR
              (value.name.value (1, value.name.size) = 'SA') OR
              (value.name.value (1, value.name.size) = 'ALL') OR (value.name.value (1, value.name.size) =
              'A') THEN
          display_attributes_info (subproduct_info_ptrs, display_hidden_values, display_control, status);
          IF NOT status.normal THEN
            EXIT /main/;
          IFEND;

          IF subproduct_info_ptrs.psrs_answered_p <> NIL THEN

            write_strings ('', '', FALSE, display_control);
            write_strings (' This SUBPRODUCT_CORRECTION ', '', FALSE, display_control);

            rap$display_psrs_answered (subproduct_info_ptrs.psrs_answered_p, display_control, status);
            IF NOT status.normal THEN
              EXIT /main/;
            IFEND;

          IFEND;

        IFEND;

        IF (value.name.value (1, value.name.size) = 'ELEMENT_LIST') OR
              (value.name.value (1, value.name.size) = 'EL') OR
              (value.name.value (1, value.name.size) = 'ALL') OR (value.name.value (1, value.name.size) =
              'A') THEN

          file_ref_p := NIL;
          display_inst_catalog_info (file_ref_p, subproduct_info_ptrs, display_control, upper_level_permit,
                status);
          IF NOT status.normal THEN
            EXIT /main/;
          IFEND;

          file_ref_p := NIL;
          display_elements (file_ref_p, subproduct_info_ptrs, element_p,
                upper_level_permit, display_control, status);
          IF NOT status.normal THEN
            EXIT /main/;
          IFEND;
        IFEND;
      FOREND;

    END /main/;

    IF display_opened THEN
      clp$close_display (display_control, local_status);
      IF status.normal AND (NOT local_status.normal) THEN
        status := local_status;
      IFEND;
    IFEND;

    osp$disestablish_cond_handler;

  PROCEND rap$display_sif;

?? TITLE := 'display_attributes_info', EJECT ??

{ PURPOSE:
{   This procedure displays all of the subproduct attributes.
{
{ DESIGN:
{   If the licensed_product field has not been defined, none of the
{   other fields are displayed.
{   Each of the fields is read from the attributes record and displayed to
{   the output file.
{
{ NOTES:
{
{

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

    VAR
      attributes_p: ^rat$subproduct_attributes,
      i: pft$array_index,
      package_software_ref_p: ^fst$file_reference,
      path_ref_p: ^fst$file_reference,
      path_container_p: ^rat$path_container,
      ref_created: boolean,
      sequence_descriptor_p: ^rat$sequence_descriptor;

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

    status.normal := TRUE;
    attributes_p := subproduct_seq_p.attributes_p;
    path_container_p := subproduct_seq_p.path_container_p;
    sequence_descriptor_p := subproduct_seq_p.sequence_descriptor_p;

    write_strings ('', '', FALSE, display_control);

    write_strings (' Attributes of subproduct ', attributes_p^.name, FALSE, display_control);

    write_strings ('', '', FALSE, display_control);

    IF attributes_p^.licensed_product = '' THEN
      write_strings (' {Subproduct attributes not defined.}', '', FALSE, display_control);
      RETURN;
    IFEND;

    write_strings (' Additional Products:        ', '', TRUE, display_control);

    IF attributes_p^.additional_products [1] = '' THEN
      write_strings ('NONE', '', FALSE, display_control);

    ELSE

      FOR i := 1 TO rac$max_additional_products DO

        IF attributes_p^.additional_products [i] <> '' THEN

          IF i = 1 THEN
            write_strings ('', attributes_p^.additional_products [i], FALSE, display_control);
          ELSE
            write_strings ('                             ', attributes_p^.additional_products [i], FALSE,
                  display_control);
          IFEND;

        IFEND;

      FOREND;

    IFEND;

    write_strings (' Description:                ', attributes_p^.description, FALSE, display_control);

    write_strings (' Development Group:          ', attributes_p^.development_group, FALSE, display_control);

    write_strings (' Installation Scheme:        ', rav$installation_scheme
          [attributes_p^.installation_scheme], FALSE, display_control);

    translate_path_container_to_ref (attributes_p^.installer_procedure, subproduct_seq_p, path_ref_p,
          scratch_seq_p, ref_created);

    IF ref_created THEN
      write_strings (' Installer Procedure:        :', path_ref_p^, FALSE, display_control);
    ELSE
      write_strings (' Installer Procedure:        ', 'NONE', FALSE, display_control);
    IFEND;

    write_strings (' Level:                      ', attributes_p^.level, FALSE, display_control);

    write_strings (' Licensed Product:           ', attributes_p^.licensed_product, FALSE, display_control);

    write_strings (' Dependencies:               ', '', TRUE, display_control);

    IF attributes_p^.dependencies [1] = '' THEN
      write_strings ('NONE', '', FALSE, display_control);

    ELSE

      FOR i := 1 TO rac$max_dependencies DO

        IF attributes_p^.dependencies [i] <> '' THEN

          IF i = 1 THEN
            write_strings (attributes_p^.dependencies [i], '', FALSE, display_control);
          ELSE
            write_strings ('                             ', attributes_p^.dependencies [i], FALSE,
                  display_control);
          IFEND;

        IFEND;

      FOREND;

    IFEND;

    write_strings (' Installation Path:          :', installation_path_ref_p^, FALSE, display_control);

    write_strings (' PACS Catalog Path:          ', attributes_p^.pacs_catalog_path.path (1,
          attributes_p^.pacs_catalog_path.size), FALSE, display_control);

    write_strings (' Subproduct Type:            ', rav$subproduct_type [attributes_p^.subproduct_type],
            FALSE, display_control);

    IF attributes_p^.auto_install = TRUE THEN
      write_strings (' Auto Install:               TRUE', '', FALSE, display_control);
    ELSE
      write_strings (' Auto Install:               FALSE', '', FALSE, display_control);
    IFEND;

    write_strings (' Date Level:                 ', attributes_p^.date_level, FALSE, display_control);

    IF attributes_p^.hidden = TRUE THEN
      write_strings (' Hidden:                     TRUE', '', FALSE, display_control);
    ELSE
      write_strings (' Hidden:                     FALSE', '', FALSE, display_control);
    IFEND;

    write_strings (' Installation Path Option:   ', rav$installation_path_option
          [attributes_p^.installation_path_option], FALSE, display_control);

    IF attributes_p^.primary = TRUE THEN
      write_strings (' Primary Subproduct:         TRUE', '', FALSE, display_control);
    ELSE
      write_strings (' Primary Subproduct:         FALSE', '', FALSE, display_control);
    IFEND;

    IF attributes_p^.files_stamped = TRUE THEN
      write_strings (' Files Stamped:              TRUE', '', FALSE, display_control);
    ELSE
      write_strings (' Files Stamped:              FALSE', '', FALSE, display_control);
    IFEND;

    write_strings (' Correction Base Level:      ', attributes_p^.correction_base_level, FALSE,
          display_control);

    write_strings (' Sizes:', '', FALSE, display_control);

    write_string_and_integer ('    Product Class Files:     ', attributes_p^.product_file_size, FALSE,
            display_control);

    write_string_and_integer ('    Service Critical Files:  ', attributes_p^.service_critical_file_size,
            FALSE, display_control);

    write_string_and_integer ('    User Permanent Files:    ', attributes_p^.user_permanent_file_size,
            FALSE, display_control);

    write_string_and_integer ('    Subproduct Backup:       ', attributes_p^.size, FALSE, display_control);

    write_strings (' SIF Identifier:             ', attributes_p^.sif_identifier, FALSE, display_control);

    IF attributes_p^.correction_base_sif_identifier <> '' THEN
      write_strings (' CRESC Base SIF Identifier:  ', attributes_p^.correction_base_sif_identifier, FALSE,
            display_control);
    IFEND;

    IF display_hidden_values THEN

      write_strings (' Internal Level:             ', attributes_p^.internal_level, FALSE, display_control);

      write_strings (' Subproduct Priority:        ', rav$subproduct_priority
            [attributes_p^.subproduct_priority], FALSE, display_control);

    IFEND;

  PROCEND display_attributes_info;

?? TITLE := 'display_catalog_element', EJECT ??

{ PURPOSE:
{   This procedure displays the information about a catalog that is
{   stored in the element list.
{
{ DESIGN:
{   The PACS catalog path is displayed when available.
{   If the installation catalog path is displayed when available.
{   If the catalog has a permit defined, the permit and catalog name
{   The catalog permits are display by calling another procedure.
{   are passed back to the calling procedure.
{
{ NOTES:
{
{

  PROCEDURE display_catalog_element
    (    element_p: ^rat$element;
         path_ref_p: ^fst$file_reference;
         upper_level_permit: rat$upper_level_permit;
         subproduct_seq_p: rat$subproduct_info_pointers;
     VAR catalog_permit: rat$upper_level_permit;
     VAR display_control: clt$display_control;
     VAR status: ost$status);


    status.normal := TRUE;

    write_strings ('', '', FALSE, display_control);

    IF pacs_catalog_ref_p <> NIL THEN
      write_strings (pacs_catalog_ref_p^, '.', TRUE, display_control);
      write_strings (path_ref_p^, '', FALSE, display_control);
    IFEND;

    IF installation_path_ref_p <> NIL THEN
      write_strings (':', installation_path_ref_p^, TRUE, display_control);
      write_strings ('.', path_ref_p^, FALSE, display_control);
    IFEND;

    write_strings ('', '', FALSE, display_control);

    write_string_and_integer ('  Type: CATALOG   Element Count: ', element_p^.element_count, FALSE,
          display_control);

    display_permit (element_p^.permit, upper_level_permit, subproduct_seq_p, display_control, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    catalog_permit.permit := element_p^.permit;

    IF element_p^.permit.defined = TRUE THEN
      catalog_permit.catalog := path_ref_p^;
      catalog_permit.size := clp$trimmed_string_size (path_ref_p^);
    IFEND;

  PROCEND display_catalog_element;

?? TITLE := 'display_elements', EJECT ??

{ PURPOSE:
{   This procedure determines if the element is a catalog or a file and
{   calls the appropriate procedure to display that type.
{
{ DESIGN:
{   For the number of elements in the catalog, if the element is a file,
{   the file is displayed.  If the element is a catalog, the catalog is displayed
{   and then DISPLAY_ELEMENTS calls itself with the parameters for the new catalog.
{   The next_element_across_p points to the next element in the same catalog.
{   The first_element_down_p points to the first element in the new catalog.
{
{ NOTES:
{
{

  PROCEDURE display_elements
    (    path_ref_p: ^fst$file_reference;
         subproduct_seq_p: rat$subproduct_info_pointers;
     VAR element_p: ^rat$element;
     VAR upper_level_permit: rat$upper_level_permit;
     VAR display_control: clt$display_control;
     VAR status: ost$status);

    VAR
      i: pft$array_index,
      new_path_ref_p: ^fst$file_reference,
      first_element_down_p: ^rat$element,
      catalog_permit: rat$upper_level_permit;

    status.normal := TRUE;

    WHILE element_p <> NIL DO

      IF element_p^.active_element THEN

        rap$add_name_to_path_ref (path_ref_p, element_p^.name, scratch_seq_p, new_path_ref_p);
        IF element_p^.element_type = rac$file THEN
          display_file_element (element_p, new_path_ref_p, subproduct_seq_p, upper_level_permit,
                display_control, status);
          IF NOT status.normal THEN
            RETURN;
          IFEND;

        ELSE

          display_catalog_element (element_p, new_path_ref_p, upper_level_permit, subproduct_seq_p,
               catalog_permit, display_control, status);
          IF NOT status.normal THEN
            RETURN;
          IFEND;

          first_element_down_p := #PTR (element_p^.first_element_down_p,
                subproduct_seq_p.subproduct_info_seq_p^);

          IF catalog_permit.permit.defined = TRUE THEN
            display_elements (new_path_ref_p, subproduct_seq_p, first_element_down_p,
                  catalog_permit, display_control, status);
          ELSE
            display_elements (new_path_ref_p, subproduct_seq_p, first_element_down_p,
                  upper_level_permit, display_control, status);
          IFEND;
          IF NOT status.normal THEN
            RETURN;
          IFEND;

        IFEND;

      IFEND;

      IF element_p^.next_element_across_p <> NIL THEN
        element_p := #PTR (element_p^.next_element_across_p, subproduct_seq_p.subproduct_info_seq_p^);
      ELSE
        element_p := NIL;
      IFEND;

    WHILEND;

  PROCEND display_elements;

?? TITLE := 'display_file_element', EJECT ??

{ PURPOSE:
{   This procedure displays information about a file in the element list.
{
{ DESIGN:
{   The PACS catalog path is displayed when available.
{   If the installation catalog path is displayed when available.
{   Each of the fields in the element list are displayed.
{   The permits are display by calling another procedure.
{
{ NOTES:
{
{

  PROCEDURE display_file_element
    (    element_p: ^rat$element;
         path_ref_p: ^fst$file_reference;
         subproduct_seq_p: rat$subproduct_info_pointers;
     VAR upper_level_permit: rat$upper_level_permit;
     VAR display_control: clt$display_control;
     VAR status: ost$status);


    VAR
      attributes_p: ^rat$subproduct_attributes,
      date: ost$date,
      i: pft$array_index,
      merge_path_ref_p: ^fst$file_reference,
      path_container_p: ^rat$path_container,
      ref_created: boolean,
      time: ost$time;

*copy rav$correction_format

    status.normal := TRUE;
    attributes_p := subproduct_seq_p.attributes_p;
    path_container_p := subproduct_seq_p.path_container_p;


    write_strings ('', '', FALSE, display_control);

    IF pacs_catalog_ref_p <> NIL THEN
      write_strings (pacs_catalog_ref_p^, '.', TRUE, display_control);
      write_strings (path_ref_p^, '', FALSE, display_control);
    IFEND;

    IF installation_path_ref_p <> NIL THEN
      write_strings (':', installation_path_ref_p^, TRUE, display_control);
      write_strings ('.', path_ref_p^, FALSE, display_control);
    IFEND;

    write_strings ('', '', FALSE, display_control);

    write_strings ('  Type: FILE:', '', TRUE, display_control);

    write_string_and_integer ('   Size: ', element_p^.size, TRUE, display_control);

    IF element_p^.ring_attributes.r1 = 0 THEN

      write_strings ('   Rings: ', '{none defined}', FALSE, display_control);

    ELSE

      write_string_and_integer ('   Rings: (', element_p^.ring_attributes.r1, TRUE, display_control);
      write_string_and_integer (' ', element_p^.ring_attributes.r2, TRUE, display_control);
      write_string_and_integer (' ', element_p^.ring_attributes.r3, TRUE, display_control);
      write_strings (')', '', FALSE, display_control);

    IFEND;

    write_string_and_integer ('  Contents Checksum: ', element_p^.contents_checksum, TRUE, display_control);

    write_string_and_integer ('  Attributes Checksum: ', element_p^.attributes_checksum, FALSE,
          display_control);

    IF element_p^.correction_base_contents_cksum <> 0 THEN

      write_string_and_integer ('  Correction Base Contents Checksum: ',
            element_p^.correction_base_contents_cksum, FALSE, display_control);

      write_string_and_integer ('  PRE_GENC Contents Checksum: ', element_p^.pre_genc_contents_checksum,
            FALSE, display_control);
    IFEND;

    IF element_p^.storage_class = rmc$msc_system_permanent_files THEN
      write_strings ('  Class: SERVICE_CRITICAL_PRODUCT', '', TRUE, display_control);
    ELSEIF element_p^.storage_class = rmc$msc_product_files THEN
      write_strings ('  Class: PRODUCT', '', TRUE, display_control);
    ELSEIF element_p^.storage_class = rmc$msc_user_permanent_files THEN
      write_strings ('  Class: USER_PERMANENT_FILES', '', TRUE, display_control);
    IFEND;

    write_strings ('   Format: ', rav$correction_format [element_p^.correction_format], FALSE,
          display_control);

    pmp$format_compact_date (element_p^.modification_date_time, osc$iso_date, date, status);
    pmp$format_compact_time (element_p^.modification_date_time, osc$millisecond_time, time, status);

    write_strings ('  Last Modification: ', date.iso, TRUE, display_control);

    write_strings (' ', time.millisecond, FALSE, display_control);

    display_permit (element_p^.permit, upper_level_permit, subproduct_seq_p, display_control, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    translate_path_container_to_ref (element_p^.library_merge, subproduct_seq_p, merge_path_ref_p,
          scratch_seq_p, ref_created);

    IF ref_created THEN
      write_strings ('  Merge with: :', merge_path_ref_p^, FALSE, display_control);
    ELSE
      write_strings ('  Merge with: ', '{None defined}', FALSE, display_control);
    IFEND;

  PROCEND display_file_element;


?? TITLE := 'display_inst_catalog_info', EJECT ??

{ PURPOSE:
{   This procedure displays information about the installation catalog
{   that is stored in the subproduct attributes record.
{
{ DESIGN:
{   The PACS catalog path is displayed if available.
{   Then the installation catalog path is displayed if available.
{   The catalog permits are display by calling another procedure.
{
{ NOTES:
{
{

  PROCEDURE display_inst_catalog_info
    (    file_ref_p: ^fst$file_reference;
         subproduct_seq_p: rat$subproduct_info_pointers;
     VAR display_control: clt$display_control;
     VAR upper_level_permit: rat$upper_level_permit;
     VAR status: ost$status);


    VAR
      attributes_p: ^rat$subproduct_attributes;


    status.normal := TRUE;
    attributes_p := subproduct_seq_p.attributes_p;

    write_strings ('', '', FALSE, display_control);

    write_strings (' Element list of subproduct ', subproduct_seq_p.attributes_p^.name, FALSE,
          display_control);

    write_strings ('', '', FALSE, display_control);

    IF pacs_catalog_ref_p <> NIL THEN
      write_strings (pacs_catalog_ref_p^, '', FALSE, display_control);
    IFEND;


    IF installation_path_ref_p <> NIL THEN
      write_strings (':', installation_path_ref_p^, FALSE, display_control);
    IFEND;

    write_strings ('', '', FALSE, display_control);

    write_string_and_integer ('  Type: CATALOG   Element Count: ', attributes_p^.first_level_element_count,
          FALSE, display_control);
    upper_level_permit.permit.defined := FALSE;

    display_permit (attributes_p^.catalog_permit, upper_level_permit, subproduct_seq_p, display_control,
           status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    upper_level_permit.catalog := '';
    upper_level_permit.size := 0;
    upper_level_permit.permit := attributes_p^.catalog_permit;

    write_strings ('', '', FALSE, display_control);

  PROCEND display_inst_catalog_info;

?? TITLE := 'display_permit', EJECT ??

{ PURPOSE:
{   This procedure displays the permits of a catalog or file.
{
{ DESIGN:
{   An element's permit and upper_level_permit are passed to this procedure.
{   If an element has permits defined, they are displayed.  If no permits
{   are defined for this element, upper_level_permits will be displayed if they exist.
{
{ NOTES:
{
{

  PROCEDURE display_permit
    (    element_permit: rat$permit;
         upper_level_permit: rat$upper_level_permit;
         subproduct_seq_p: rat$subproduct_info_pointers;
     VAR display_control: clt$display_control;
     VAR status: ost$status);

    VAR
      attributes_p: ^rat$subproduct_attributes,
      counter: integer,
      i: pft$array_index,
      path_container_p: ^rat$path_container,
      permit: rat$permit,
      permit_options: pft$permit_options;

*copy rav$permit_names

    status.normal := TRUE;
    attributes_p := subproduct_seq_p.attributes_p;
    path_container_p := subproduct_seq_p.path_container_p;

    write_strings ('  Permit: ', '', TRUE, display_control);

    IF (element_permit.defined = FALSE) AND (upper_level_permit.permit.defined = FALSE) THEN
      write_strings ('NO PERMITS', '', FALSE, display_control);
      RETURN;
    IFEND;

    IF (element_permit.defined = FALSE) AND (upper_level_permit.permit.defined = TRUE) THEN
      permit := upper_level_permit.permit;
    ELSE
      permit := element_permit;
    IFEND;

    IF permit.permit_selections = $pft$permit_selections [] THEN

      write_strings ('  am=(NONE)  ', '', FALSE, display_control);

    ELSE

      counter := 0;

      FOR permit_options := LOWERVALUE (pft$permit_options) TO UPPERVALUE (pft$permit_options) DO

        IF permit_options IN permit.permit_selections THEN
          counter := counter + 1;

          IF counter = 1 THEN
            write_strings ('  am=(', rav$permit_names [permit_options] (1,
                clp$trimmed_string_size (rav$permit_names [permit_options])), TRUE, display_control);
          ELSE;
          write_strings (' ', rav$permit_names [permit_options] (1,
                clp$trimmed_string_size (rav$permit_names [permit_options])), TRUE, display_control);
          IFEND;

        IFEND;

      FOREND;

      write_strings (')  ', '', TRUE, display_control);

    IFEND;

    IF permit.share_requirements = $pft$share_requirements [] THEN

      write_strings ('  sm=(NONE)  ', '', FALSE, display_control);

    ELSE

      counter := 0;
      FOR permit_options := LOWERVALUE (pft$permit_options) TO UPPERVALUE (pft$permit_options) DO

        IF permit_options IN permit.share_requirements THEN

          counter := counter + 1;

          IF counter = 1 THEN
            write_strings ('  sm=(', rav$permit_names [permit_options] (1,
                clp$trimmed_string_size (rav$permit_names [permit_options])), TRUE, display_control);
          ELSE;
          write_strings (' ', rav$permit_names [permit_options] (1,
                clp$trimmed_string_size (rav$permit_names [permit_options])), TRUE, display_control);
          IFEND;

        IFEND;

      FOREND;

      write_strings (')  ', '', TRUE, display_control);

    IFEND;

    write_strings ('  ai=''', permit.application_info (1, clp$trimmed_string_size (permit.application_info)),
          TRUE, display_control);
    write_strings ('''', '', FALSE, display_control);

    IF (element_permit.defined = FALSE) AND (upper_level_permit.permit.defined = TRUE) THEN

      IF installation_path_ref_p <> NIL THEN

        write_strings ('  {Defined by catalog :', installation_path_ref_p^, TRUE, display_control);

      ELSEIF pacs_catalog_ref_p <> NIL THEN

        write_strings ('  {Defined by catalog :', pacs_catalog_ref_p^, TRUE, display_control);

      IFEND;

      IF upper_level_permit.size = 0 THEN

        write_strings ('}', '', FALSE, display_control);

      ELSE

        write_strings ('.', upper_level_permit.catalog (1,
              clp$trimmed_string_size (upper_level_permit.catalog)), TRUE, display_control);
        write_strings ('}', '', FALSE, display_control);

      IFEND;

    IFEND;

  PROCEND display_permit;

?? TITLE := 'translate_path_container_to_ref', EJECT ??

{ PURPOSE:
{   This procedure takes a set of path containers and converts
{   them into a file reference.
{
{ DESIGN:
{   rap$add_name_to_path_ref is used to build the file_reference
{   from the path containers.
{
{ NOTES:
{
{

  PROCEDURE translate_path_container_to_ref
    (    path_container_index: rat$path_container_indexer;
         subproduct_seq_p: rat$subproduct_info_pointers;
     VAR ref_p: ^fst$file_reference;
     VAR sequence_p: ^SEQ ( * );
     VAR ref_created: boolean);

    VAR
      file_ref_p: ^fst$file_reference,
      first_path_index: pft$array_index,
      i: pft$array_index,
      last_path_index: pft$array_index,
      new_file_ref_p: ^fst$file_reference,
      path_container_p: ^rat$path_container;


    path_container_p := subproduct_seq_p.path_container_p;
    ref_created := FALSE;

    IF path_container_index.path_length = 0 THEN
      ref_p := NIL;
      RETURN;
    IFEND;

    first_path_index := path_container_index.path_container_index;
    last_path_index := path_container_index.path_container_index + path_container_index.path_length - 1;

    file_ref_p := NIL;

    FOR i := first_path_index TO last_path_index DO
      rap$add_name_to_path_ref (file_ref_p, path_container_p^ [i], sequence_p, new_file_ref_p);
      PUSH file_ref_p: [#SIZE (new_file_ref_p^)];
      file_ref_p^ := new_file_ref_p^;
    FOREND;

    NEXT ref_p: [#SIZE (file_ref_p^)] IN sequence_p;
    ref_p^ (1, * ) := file_ref_p^;
    ref_created := TRUE;

  PROCEND translate_path_container_to_ref;

?? TITLE := 'write_strings', EJECT ??

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

  PROCEDURE write_strings
    (    string_a: string ( * );
         string_b: string ( * );
         continue_line: boolean;
     VAR display_control: clt$display_control);


    VAR
      ignore_status: ost$status,
      line: string (2 * fsc$max_path_size),
      line_size: integer;


    line := '';
    STRINGREP (line, line_size, string_a, string_b);

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

  PROCEND write_strings;

?? TITLE := '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
      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;


    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_sif;
