?? RIGHT := 110 ??
?? NEWTITLE := 'DEFINE_SUBPRODUCT Subutility: DEFINE_CORRECTION_FORMAT Subcommand.' ??
MODULE ram$define_correction_format;

{ PURPOSE:
{   This module defines each or all of the correction_format fields in the element_list.
{
{ DESIGN:
{   The element list is searched for the correct file.  Then the
{   correction format 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 cld$path_description
*copyc fst$file_reference
*copyc ost$status
*copyc rae$package_software_cc
*copyc rat$subproduct_info_p
*copyc rat$subproduct_info_types
?? POP ??
*copyc clp$scan_parameter_list
*copyc clp$trimmed_string_size
*copyc clp$get_value
*copyc osp$append_status_file
*copyc osp$set_status_abnormal
*copyc osp$generate_error_message
*copyc rap$get_file_path_and_ref
*copyc rap$locate_element
*copyc rav$correction_format
*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 ??

{ PURPOSE:
{   This command interface sets the correction_format 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 correction_format
{   is updated.  If ALL elements are selected, all files in the
{   element list are updated.
{
{ NOTES:
{
{

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

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


{ pdt defcf_pdt (
{   file, files, f        : file or key all = all
{   correction_format, cf : key object_library, source_library, ..
{                           replacement = $required
{   status                : var of status = $optional
{   )

?? PUSH (LISTEXT := ON) ??

  VAR
    defcf_pdt: [STATIC, READ, cls$pdt] clt$parameter_descriptor_table := [^defcf_pdt_names, ^defcf_pdt_params
      ];

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

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

{ FILE FILES F }
    [[clc$optional_with_default, ^defcf_pdt_dv1], 1, 1, 1, 1, clc$value_range_not_allowed, [^defcf_pdt_kv1,
      clc$file_value]],

{ CORRECTION_FORMAT CF }
    [[clc$required], 1, 1, 1, 1, clc$value_range_not_allowed, [^defcf_pdt_kv2, clc$keyword_value]],

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

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

  VAR
    defcf_pdt_kv2: [STATIC, READ, cls$pdt_names_and_defaults] array [1 .. 3] of ost$name := ['OBJECT_LIBRARY',
      'SOURCE_LIBRARY','REPLACEMENT'];

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

?? POP ??

    VAR
      attributes_p: ^rat$subproduct_attributes,
      correction_format: rat$correction_format,
      correction_format_ordinal: rat$correction_format,
      element_found: boolean,
      element_p: ^rat$element,
      path_index: 0 .. fsc$max_path_size,
      path_p: ^pft$path,
      path_ref_p: ^fst$file_reference,
      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;

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

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

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

  /initialize_value/
    FOR correction_format_ordinal := LOWERVALUE (rat$correction_format)
          TO UPPERVALUE (rat$correction_format) DO
      IF rav$correction_format [correction_format_ordinal] = value.name.value (1, value.name.size) THEN
        correction_format := correction_format_ordinal;
        EXIT /initialize_value/;
      IFEND;
    FOREND /initialize_value/;

    IF attributes_p^.subproduct_type = rac$correction THEN
      osp$set_status_abnormal ('RA', rae$defcf_command_ignored, '', status);
      RETURN;
    IFEND;

    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, path_p, path_ref_p, status);
      IF NOT status.normal THEN
        RETURN;
      IFEND;

      IF (#SIZE (path_ref_p^) < #SIZE (rav$pacs_catalog_ref_p^)) OR
            (rav$pacs_catalog_ref_p^ <> 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, path_ref_p^, status);
        RETURN;
      IFEND;

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

      rap$locate_element (path_p, 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, path_ref_p^, status);
        RETURN;
      IFEND;

      IF element_p^.element_type = rac$file THEN
        rap$add_correction_format (correction_format, 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, path_ref_p^, status);
        RETURN;
      IFEND;

    ELSE {ALL}
      rap$add_correction_format (correction_format, attributes_p^.first_level_element_count, element_p,
            subproduct_info_seq_p);
    IFEND;

  PROCEND rap$define_correction_format;

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

{ PURPOSE:
{   This procedure sets the correction_format 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.
{   Before a file's correction format is set to object library or source library,
{   the elements file content and structure must equal the requested correction format.
{
{ NOTES:
{

  PROCEDURE [XDCL] rap$add_correction_format
    (    correction_format: rat$correction_format;
         element_count: rat$element_count;
     VAR element_p: ^rat$element;
     VAR subproduct_info_seq_p: ^rat$subproduct_info_sequence);


    VAR
      file_name: string (osc$max_name_size),
      first_element_down_p: ^rat$element,
      i: rat$path_container_index,
      ignore_status: ost$status,
      length: integer,
      message_status: ost$status,
      next_element_count: rat$element_count;


    FOR i := 1 TO element_count DO
      IF element_p^.element_type = rac$file THEN
        IF (correction_format = element_p^.file_contents_and_structure) OR
              (correction_format = rac$replacement) THEN
          element_p^.correction_format := correction_format;
        ELSE
          length := clp$trimmed_string_size (element_p^.name);
          osp$set_status_abnormal ('RA', rae$invalid_format_for_file, element_p^.name (1, length),
                message_status);
          osp$generate_error_message (message_status, ignore_status);
        IFEND;

      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^);
        rap$add_correction_format (correction_format, 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 rap$add_correction_format;

MODEND ram$define_correction_format;
