?? RIGHT := 110 ??
?? NEWTITLE := 'DEFINE_SUBPRODUCT Subutility: DEFINE_RING_ATTRIBUTES subcommand.' ??
MODULE ram$define_ring_attributes;

{ PURPOSE:
{   This module sets each or all of the ring_attributes fields in the element_list.
{
{ DESIGN:
{   The element list is searched for the correct file.  Then
{   the ring_attributes field is updated.  If ALL elements are selected,
{   all files in the element list are updated.
{   The compiled module resides in RAF$LIBRARY.
{
{ NOTES:
{

?? NEWTITLE := 'Global Declarations Referenced by This Module', EJECT ??
?? PUSH (LISTEXT := ON) ??
*copyc rae$package_software_cc
?? POP ??
*copyc clp$convert_file_ref_to_string
*copyc clp$get_fs_path_elements
*copyc clp$get_value
*copyc clp$scan_parameter_list
*copyc clp$trimmed_string_size
*copyc fsp$convert_fs_structure_to_pf
*copyc osp$append_status_file
*copyc osp$set_status_abnormal
*copyc rap$get_file_path_and_ref
*copyc rap$locate_element
*copyc rav$subproduct_info_pointers
*copyc rav$pacs_catalog_p
*copyc rav$pacs_catalog_ref_p
*copyc rav$defs_scratch_segment

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

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

{ PURPOSE:
{   This command interface sets the ring attributes field for a
{   file or all files in the current subproduct.
{
{ DESIGN:
{   The file is validated as part of the current subproduct.
{   The file is located in the element_list and its ring attributes
{   are updated.  If ALL elements are selected, all files in the
{   element list are updated.
{
{ NOTES:
{

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


{ pdt defra_pdt (
{   file, files, f      : file or key all = all
{   ring_attributes, ra : list 3 of integer 1..15 = $required
{   status              : var of status = $optional
{   )

?? PUSH (LISTEXT := ON) ??

  VAR
    defra_pdt: [STATIC, READ, cls$pdt] clt$parameter_descriptor_table := [^defra_pdt_names, ^defra_pdt_params
      ];

  VAR
    defra_pdt_names: [STATIC, READ, cls$pdt_names_and_defaults] array [1 .. 6] of
      clt$parameter_name_descriptor := [['FILE', 1], ['FILES', 1], ['F', 1], ['RING_ATTRIBUTES', 2], ['RA', 2]
      , ['STATUS', 3]];

  VAR
    defra_pdt_params: [STATIC, READ, cls$pdt_parameters] array [1 .. 3] of clt$parameter_descriptor := [

{ FILE FILES F }
    [[clc$optional_with_default, ^defra_pdt_dv1], 1, 1, 1, 1, clc$value_range_not_allowed, [^defra_pdt_kv1,
      clc$file_value]],

{ RING_ATTRIBUTES RA }
    [[clc$required], 3, 3, 1, 1, clc$value_range_not_allowed, [NIL, clc$integer_value, 1, 15]],

{ STATUS }
    [[clc$optional], 1, 1, 1, 1, clc$value_range_not_allowed, [NIL, clc$variable_reference,
      clc$array_not_allowed, clc$status_value]]];

  VAR
    defra_pdt_kv1: [STATIC, READ, cls$pdt_names_and_defaults] array [1 .. 1] of ost$name := ['ALL'];

  VAR
    defra_pdt_dv1: [STATIC, READ, cls$pdt_names_and_defaults] string (3) := 'all';

?? POP ??

    VAR
      attributes_p: ^rat$subproduct_attributes,
      element_found: boolean,
      element_p: ^rat$element,
      file_path_index: integer,
      file_path_p: ^pft$path,
      file_path_ref_p: ^fst$file_reference,
      length: integer,
      ring_attributes: rat$ring_attributes,
      subproduct_info_seq_p: ^rat$subproduct_info_sequence,
      value: clt$value;


    status.normal := TRUE;
    attributes_p := rav$subproduct_info_pointers.attributes_p;
    element_p := rav$subproduct_info_pointers.element_list_p;
    subproduct_info_seq_p := rav$subproduct_info_pointers.subproduct_info_seq_p;

    IF attributes_p^.first_level_element_count = 0 THEN
      osp$set_status_abnormal ('RA', rae$error_pacs_catalog_empty, '', status);
      RETURN;
    IFEND;

    clp$scan_parameter_list (parameter_list, defra_pdt, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    clp$get_value ('RING_ATTRIBUTES', 1, 1, clc$low, value, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;
    ring_attributes.r1 := value.int.value;

    clp$get_value ('RING_ATTRIBUTES', 2, 1, clc$low, value, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;
    ring_attributes.r2 := value.int.value;

    clp$get_value ('RING_ATTRIBUTES', 3, 1, clc$low, value, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;
    ring_attributes.r3 := value.int.value;

    clp$get_value ('FILE', 1, 1, clc$low, value, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    IF value.kind = clc$file_value THEN

      RESET rav$defs_scratch_segment.sequence_p TO rav$defs_scratch_segment.reset_p;

      rap$get_file_path_and_ref ('FILE', rav$defs_scratch_segment.sequence_p, file_path_p, file_path_ref_p,
            status);
      IF NOT status.normal THEN
        RETURN;
      IFEND;

      IF (#SIZE (file_path_ref_p^) < #SIZE (rav$pacs_catalog_ref_p^)) OR
            (rav$pacs_catalog_ref_p^ <> file_path_ref_p^ (1, #SIZE (rav$pacs_catalog_ref_p^))) THEN
        osp$set_status_abnormal ('RA', rae$not_in_pacs_catalog, '', status);
        osp$append_status_file (osc$status_parameter_delimiter, file_path_ref_p^, status);
        RETURN;
      IFEND;

      file_path_index := UPPERBOUND (rav$pacs_catalog_p^) + 1;

      rap$locate_element (file_path_p, file_path_index, subproduct_info_seq_p, element_p, element_found);

      IF NOT element_found THEN
        osp$set_status_abnormal ('RA', rae$not_in_pacs_catalog, '', status);
        osp$append_status_file (osc$status_parameter_delimiter, file_path_ref_p^, status);
        RETURN;
      IFEND;

      IF element_p^.element_type = rac$file THEN
        add_ring_attributes (ring_attributes, 1, element_p, subproduct_info_seq_p);
      ELSE
        osp$set_status_abnormal ('RA', rae$expecting_file, '', status);
        osp$append_status_file (osc$status_parameter_delimiter, file_path_ref_p^, status);
        RETURN;
      IFEND;

    ELSE { value.kind = clc$name_value  ( key ALL ) }

      add_ring_attributes (ring_attributes, attributes_p^.first_level_element_count, element_p,
            subproduct_info_seq_p);
    IFEND;


  PROCEND rap$define_ring_attributes;

?? TITLE := 'add_ring_attributes', EJECT ??

{ PURPOSE:
{   This procedure sets the ring_attributes field for a file or
{   all files in the element list.
{
{ DESIGN:
{   This procedure is given an element pointer and the number of elements in that
{   element.  If the element is of type FILE, then only that one element will be updated.
{   If the element is of type CATALOG, all files in the catalog will be updated as well
{   as all files in all of the subcatalogs.
{
{ NOTES:
{

  PROCEDURE add_ring_attributes
    (    ring_attributes: rat$ring_attributes;
         element_count: rat$element_count;
     VAR element_p: ^rat$element;
     VAR subproduct_info_seq_p: ^rat$subproduct_info_sequence);


    VAR
      i: rat$path_container_index,
      next_element_count: rat$element_count,
      first_element_down_p: ^rat$element;


    FOR i := 1 TO element_count DO
      IF element_p^.element_type = rac$file THEN
        element_p^.ring_attributes := ring_attributes;
      ELSEIF (element_p^.element_type = rac$catalog) AND (element_p^.element_count <> 0) THEN
        next_element_count := element_p^.element_count;
        first_element_down_p := #PTR (element_p^.first_element_down_p, subproduct_info_seq_p^);
        add_ring_attributes (ring_attributes, next_element_count, first_element_down_p,
              subproduct_info_seq_p);
      IFEND;

      IF i < element_count THEN
        element_p := #PTR (element_p^.next_element_across_p, subproduct_info_seq_p^);
      IFEND;
    FOREND;

  PROCEND add_ring_attributes;

MODEND ram$define_ring_attributes;
