?? RIGHT := 110 ??
?? NEWTITLE := 'PACKAGE_SOFTWARE Utility: VERIFY_SUBPRODUCT Subcommand.' ??
MODULE ram$verify_subproduct;

{ PURPOSE:
{   This module contains the procedures that verify a subproduct's
{   subproduct information file against its PACS catalog.
{
{ DESIGN:
{   The information stored in the SUBPRODUCT_INFORMATION_FILE is compared
{   with information created by the permanent file procedures.
{   The compiled module resides in RAF$LIBRARY.
{
{ NOTES:
{

?? NEWTITLE := 'Global Declarations Referenced by This Module', EJECT ??
?? PUSH (LISTEXT := ON) ??
*copyc clc$standard_file_names
*copyc ost$status
*copyc pmt$condition
*copyc rac$sif_file_name
*copyc rae$package_software_cc
*copyc rat$path
*copyc rat$subproduct_info_pointers
*copyc rat$subproduct_info_types
*copyc rat$subproduct_verify_errors
*copyc rat$subproduct_verify_options
*copyc rat$validation_selections
?? POP ??
*copyc amp$flush
*copyc amp$get_segment_pointer
*copyc clp$get_system_file_id
*copyc clp$trimmed_string_size
*copyc fsp$close_file
*copyc mmp$create_segment
*copyc mmp$create_segment
*copyc mmp$delete_scratch_segment
*copyc mmp$delete_segment
*copyc ocp$checksum
*copyc osp$append_status_file
*copyc osp$append_status_parameter
*copyc osp$disestablish_cond_handler
*copyc osp$establish_block_exit_hndlr
*copyc osp$generate_error_message
*copyc osp$generate_message
*copyc osp$set_status_abnormal
*copyc pfp$convert_fs_path_to_pf_path
*copyc pfp$convert_string_to_fs_path
*copyc pfp$find_directory_array
*copyc pfp$find_next_info_record
*copyc pfp$get_item_info
*copyc pfp$get_multi_item_info
*copyc rap$convert_path_to_str
*copyc rap$get_file_information
*copyc rap$get_sif_pointers
*copyc rap$locate_element
*copyc rap$open_file
*copyc rap$test_permits
*copyc rap$write_file_from_memory
*copyc osv$lower_to_upper

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

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

{ PURPOSE:
{   This procedure verifies a subproduct's SIF against its PACS catalog.
{   It will also update the information in the SIF which has changed
{   because of a backup and restore.
{
{ DESIGN:
{   The information stored in the subproduct information file is written
{   to a memory segment.  Then the subproduct information file is closed.
{   The information in the SIF memory segment is compared to the information
{   gathered by using the permanent file procedures.
{   If the reconcile_effects_of_restore verify option is used, the
{   subproduct information file is opened in write mode and rewritten with
{   the updated information.
{   with information created by the permanent file procedures.
{   If the VERIFY OPTION is:
{   1) BRIEF
{   The modification date and time is checked.
{   Verification stops when the first error is encountered.
{
{   2) FULL
{   The modification date and time is checked.
{   The attributes checksum is checked.
{   All files and catalogs are compared.
{   Verification does NOT stop on first error.
{   Offline residence of a file is checked.
{
{   3) RECONCILE_EFFECTS_OF_RESTORE
{   The modification date and time is checked.
{   The attributes checksum is checked.
{   The modification date and time are updated if needed and the attributes
{   checksum verifies.
{   The pacs catalog path is updated if necessary.
{   The subproduct size field is updated.
{   Offline residence of a file is checked.
{
{   4) MANUFACTURING
{   The modification date and time is checked.
{   Verification stops when the first error is encountered.
{   Offline residence of a file is checked.
{
{   Modification date and time will change if the file has been backed up and
{   restored or if the file has been modified.  To determine if the file has been
{   backed up and restored, the attributes checksum is checked.  If the
{   attributes checksum has also changed the file has been modified.

{   The compiled module resides in RAF$LIBRARY.
{
{ NOTES:
{

  PROCEDURE [XDCL] rap$verify_subproduct_interface
    (    pacs_ref_p: ^fst$file_reference;
         verify_option: ost$name;
         sif_identifier: ost$name;
     VAR status: ost$status);



    VAR
      amt_nil_segment_p: amt$segment_pointer,
      attributes_p: ^rat$subproduct_attributes,
      file_segment_p: amt$segment_pointer,
      file_sequence_p: ^rat$subproduct_info_sequence,
      ignore_status: ost$status,
      local_status: ost$status,
      memory_segment_p: mmt$segment_pointer,
      memory_seq_p: ^rat$subproduct_info_sequence,
      message_status: ost$status,
      response_fid: amt$file_identifier,
      sif_file_id: amt$file_identifier,
      sif_length: integer,
      sif_memory_size: integer,
      sif_ref: string (fsc$max_path_size),
      subproduct_info_pointers: rat$subproduct_info_pointers,
      subproduct_info_sequence_size: integer,
      upper_case_verify_option: ost$name,
      verify_errors: rat$subproduct_verify_errors,
      verify_options: rat$subproduct_verify_options,
      validation_selections: rat$validation_selections;

?? 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.  If the sequence has been created,
{   it will be deleted before 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 memory_segment_p.seq_pointer <> NIL THEN
        mmp$delete_segment (memory_segment_p, 1, ignore_status);
        memory_segment_p.seq_pointer := NIL;
      IFEND;

    PROCEND abort_handler;

?? OLDTITLE, EJECT ??

    status.normal := TRUE;
    amt_nil_segment_p.sequence_pointer := NIL;
    memory_segment_p.kind := mmc$sequence_pointer;
    memory_segment_p.seq_pointer := NIL;
    verify_errors := $rat$subproduct_verify_errors [];
    validation_selections := $rat$validation_selections [rac$loading_cycle_only, rac$no_rings_below_11,
          rac$no_permits];

    #TRANSLATE (osv$lower_to_upper, verify_option, upper_case_verify_option);

    IF upper_case_verify_option = 'BRIEF' THEN
      verify_options := $rat$subproduct_verify_options
            [rac$test_mod_date_time, rac$stop_on_first_error];
    ELSEIF upper_case_verify_option = 'FULL' THEN
      verify_options := $rat$subproduct_verify_options [rac$test_mod_date_time, rac$test_attributes_checksum,
            rac$test_offline_residence];
    ELSEIF upper_case_verify_option = 'RECONCILE_EFFECTS_OF_RESTORE' THEN
      verify_options := $rat$subproduct_verify_options
            [rac$test_mod_date_time, rac$test_attributes_checksum, rac$reconcile_mod_date_time,
            rac$reconcile_pacs_catalog, rac$calculate_size, rac$test_offline_residence];
    ELSEIF upper_case_verify_option = 'MANUFACTURING' THEN
      verify_options := $rat$subproduct_verify_options
            [rac$test_mod_date_time, rac$stop_on_first_error, rac$test_offline_residence];
    ELSE
      osp$set_status_abnormal ('RA', rae$incorrect_verify_option, upper_case_verify_option, status);
      RETURN;
    IFEND;

    STRINGREP (sif_ref, sif_length, pacs_ref_p^, '.', rac$sif_file_name);

    osp$establish_block_exit_hndlr (^abort_handler);

  /main/
    BEGIN

      write_sif_to_memory (^sif_ref (1, sif_length), sif_memory_size, memory_segment_p,
            subproduct_info_pointers, status);
      IF NOT status.normal THEN
        RETURN;
      IFEND;

      rap$get_sif_pointers (amt_nil_segment_p, memory_segment_p, ^sif_ref (1, sif_length),
            subproduct_info_pointers, status);
      IF NOT status.normal THEN
        EXIT /main/;
      IFEND;
      attributes_p := subproduct_info_pointers.attributes_p;

{
{   Validate that the value of the PACS catalog path as stored in the
{   subproduct information file is equal to the value of the PACS catalog
{   path given on the procedure call.
{

      IF pacs_ref_p^ <> attributes_p^.pacs_catalog_path.path (1, attributes_p^.pacs_catalog_path.size) THEN

        IF rac$reconcile_pacs_catalog IN verify_options THEN
          attributes_p^.pacs_catalog_path.path := pacs_ref_p^;
          attributes_p^.pacs_catalog_path.size := #SIZE (pacs_ref_p^);

        ELSE

          IF rac$stop_on_first_error IN verify_options THEN
            osp$set_status_abnormal ('RA', rae$pacs_catalog_name_changed, attributes_p^.
                  pacs_catalog_path.path (1, attributes_p^.pacs_catalog_path.size), status);
            RETURN;
          ELSE
            verify_errors := verify_errors + $rat$subproduct_verify_errors [rac$pacs_catalog_moved];
          IFEND;

        IFEND;

      IFEND;

      IF sif_identifier <> '' THEN
        { Verify that the SIF identifier has not changed.

         IF sif_identifier <> attributes_p^.sif_identifier THEN
          osp$set_status_abnormal ('RA', rae$sif_identifier_changed, attributes_p^.
                name, status);
          RETURN;
         IFEND;

      IFEND;

{   Determine if the PACS catalog has changed.

      rap$verify_subproduct (pacs_ref_p, validation_selections, TRUE, verify_options, verify_errors,
            subproduct_info_pointers, status);
      IF NOT status.normal THEN
        EXIT /main/;
      IFEND;

      osp$set_status_abnormal ('RA', rae$pacs_verify_successful, '', message_status);
      osp$append_status_file (osc$status_parameter_delimiter, pacs_ref_p^, message_status);
      osp$generate_message (message_status, ignore_status);
      clp$get_system_file_id (clc$job_command_response, response_fid, status);
      IF NOT status.normal THEN
        EXIT /main/;
      IFEND;

      amp$flush (response_fid, osc$nowait, status);

      IF upper_case_verify_option = 'RECONCILE_EFFECTS_OF_RESTORE' THEN
        rap$write_file_from_memory (sif_ref (1, sif_length), sif_memory_size,
              subproduct_info_pointers.subproduct_info_seq_p, status);
      IFEND;

    END /main/;

    IF memory_segment_p.seq_pointer <> NIL THEN
      mmp$delete_segment (memory_segment_p, 1, local_status);
      memory_segment_p.seq_pointer := NIL;
      IF status.normal AND (NOT local_status.normal) THEN
        status := local_status;
      IFEND;
    IFEND;

    osp$disestablish_cond_handler;

  PROCEND rap$verify_subproduct_interface;

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

{ PURPOSE:
{   This procedure will verify that the PACS catalog has not changed
{   since the SUBPRODUCT INFORMATION FILE was written.
{
{ DESIGN:
{   The information in the SUBPRODUCT INFORMATION FILE is compared to the
{   information gathered by the PF procedures to see if any changes
{   have been made in the PACS catalog since the subproduct information file was written.
{
{ NOTES:
{
{

  PROCEDURE [XDCL] rap$verify_subproduct
        (pacs_ref_p: ^fst$file_reference;
         validation_selections: rat$validation_selections;
         sif_present: boolean;
     VAR verify_options: rat$subproduct_verify_options;
     VAR verify_errors {input} : rat$subproduct_verify_errors;
     VAR subproduct_info_pointers {input} : rat$subproduct_info_pointers;
     VAR status: ost$status);


    VAR
      catalog_element_count: integer,
      catalog_element_p: ^rat$element,
      fs_path: fst$path,
      ignore_cycle_reference: fst$cycle_reference,
      ignore_cycle_selector: clt$cycle_selector,
      ignore_open_position: fst$open_position,
      ignore_status: ost$status,
      local_status: ost$status,
      number_of_path_elements: fst$number_of_path_elements,
      pacs_path_p: ^pft$path,
      path_index: integer,
      pf_info_seq_p: pft$p_info,
      pf_segment_pointer: mmt$segment_pointer,
      subproduct_size: integer;

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

{ PURPOSE:
{   This procedure cleans up when an abort situation occurs
{   within the block structure.
{
{ DESIGN:
{   If the sequence has been created, it will be deleted before
{   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 pf_segment_pointer.seq_pointer <> NIL THEN
        mmp$delete_segment (pf_segment_pointer, 1, ignore_status);
        pf_segment_pointer.seq_pointer := NIL;
      IFEND;

    PROCEND abort_handler;

?? OLDTITLE, EJECT ??


    status.normal := TRUE;
    catalog_element_p := NIL;
    pf_segment_pointer.kind := mmc$sequence_pointer;
    pf_segment_pointer.seq_pointer := NIL;
    subproduct_size := 0;

    catalog_element_count := subproduct_info_pointers.attributes_p^.first_level_element_count;

    IF sif_present THEN
      catalog_element_count := catalog_element_count + 1;
    IFEND;

{  Convert the pacs catalog, which is in file reference format to PF format. }

    pfp$convert_string_to_fs_path (pacs_ref_p^, fs_path, number_of_path_elements, ignore_cycle_reference,
          ignore_open_position, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    PUSH pacs_path_p: [1 .. number_of_path_elements];
    pfp$convert_fs_path_to_pf_path (fs_path, pacs_path_p, ignore_cycle_reference, ignore_cycle_selector,
          status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;
    path_index := UPPERBOUND (pacs_path_p^) + 1;

    osp$establish_block_exit_hndlr (^abort_handler);

  /main/
    BEGIN

{
{   Create a segment for the permanent file procedures.  All information that is
{   gathered by the permanent file procedures is written to this segment.
{

      mmp$create_segment (NIL, mmc$sequence_pointer, 1, pf_segment_pointer, status);
      IF NOT status.normal THEN
        EXIT /main/;
      IFEND;

      pf_info_seq_p := pf_segment_pointer.seq_pointer;
      RESET pf_info_seq_p;

      process_catalog_information (catalog_element_p, pacs_path_p^, path_index,
            catalog_element_count, pf_info_seq_p, validation_selections, sif_present,
            subproduct_info_pointers, verify_options, verify_errors, subproduct_size, status);
      IF NOT status.normal THEN
        EXIT /main/;
      IFEND;

      IF rac$calculate_size IN verify_options THEN
        subproduct_info_pointers.attributes_p^.size := subproduct_size;
      IFEND;

      IF NOT (verify_errors = $rat$subproduct_verify_errors []) THEN
        issue_error_message (pacs_ref_p, subproduct_info_pointers.attributes_p, verify_errors, status);
      IFEND;

    END /main/;

    IF pf_segment_pointer.seq_pointer <> NIL THEN
      mmp$delete_segment (pf_segment_pointer, 1, local_status);
      pf_segment_pointer.seq_pointer := NIL;
      IF status.normal AND (NOT local_status.normal) THEN
        status := local_status;
      IFEND;
    IFEND;

    osp$disestablish_cond_handler;

  PROCEND rap$verify_subproduct;

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

{ PURPOSE:
{   This procedure finds all elements that are in
{   the subproduct information file and not in the PACS catalog.
{
{ DESIGN:
{   The pointer to the catalog element is passed to this procedure.
{   All elements in that catalog that are in the subproduct information file
{   are compared with the entries for the same catalog as described by the
{   permanent files directory.  When an element is in the SIF, but not in
{   the permanent files directory, an error message will be displayed.
{
{ NOTES:
{

  PROCEDURE find_unmatched_elements
    (    pf_directory_p: pft$p_directory_array;
         catalog_ref_p: ^fst$file_reference;
         catalog_element_p: ^rat$element;
         subproduct_info_pointers {input, output} : rat$subproduct_info_pointers;
     VAR verify_errors: rat$subproduct_verify_errors);

    VAR
      element_found: boolean,
      element_p: ^rat$element,
      file_length: integer,
      file_name: string (fsc$max_path_size),
      i: pft$array_index,
      ignore_status: ost$status,
      message_status: ost$status;


{
{   Start searching at the beginning of the element list when a NIL catalog_element_p is
{   passed to this procedure.  This will happen whenever the PACS catalog is checked
{   because it is not in the element list.
{

    IF catalog_element_p = NIL THEN
      element_p := subproduct_info_pointers.element_list_p;
    ELSE
      element_p := #PTR (catalog_element_p^.first_element_down_p,
            subproduct_info_pointers.subproduct_info_seq_p^);
    IFEND;

    WHILE element_p <> NIL DO
      element_found := FALSE;

    IF element_p^.active_element THEN

      /search_loop/
        FOR i := 1 TO UPPERBOUND (pf_directory_p^) DO

          IF element_p^.name = pf_directory_p^ [i].name THEN

            IF ((element_p^.element_type = rac$file) AND (pf_directory_p^ [i].name_type = pfc$file_name)) OR
                  ((element_p^.element_type = rac$catalog) AND (pf_directory_p^ [i].name_type =
                  pfc$catalog_name)) THEN
              element_found := TRUE;
            IFEND;

            EXIT /search_loop/;

          IFEND;

        FOREND /search_loop/;

        IF NOT element_found THEN

          STRINGREP (file_name, file_length, catalog_ref_p, '.', element_p^.name);

          IF element_p^.element_type = rac$file THEN
            osp$set_status_abnormal ('RA', rae$file_missing_from_pacs, '', message_status);
          ELSE {rac$catalog}
            osp$set_status_abnormal ('RA', rae$catalog_missing_from_pacs, '', message_status);
          IFEND;

          osp$append_status_file (osc$status_parameter_delimiter, file_name (1, file_length), message_status);
          osp$generate_error_message (message_status, ignore_status);
          verify_errors := verify_errors + $rat$subproduct_verify_errors [rac$unmatched_element];

        IFEND;

      IFEND;

{
{   The last element in a catalog has its next_element_across_p set to NIL.
{

      element_p := #PTR (element_p^.next_element_across_p, subproduct_info_pointers.subproduct_info_seq_p^);

    WHILEND;

  PROCEND find_unmatched_elements;

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

{ PURPOSE:
{
{ DESIGN:
{
{
{ NOTES:
{

  PROCEDURE issue_error_message
    (    pacs_ref_p: ^fst$file_reference;
         attributes_p: ^rat$subproduct_attributes;
     VAR verify_errors: rat$subproduct_verify_errors;
     VAR status: ost$status);

    VAR
      ignore_status: ost$status,
      message_status: ost$status;

    IF rac$pacs_catalog_moved IN verify_errors THEN
      osp$set_status_abnormal ('RA', rae$pacs_catalog_moved, attributes_p^.name, message_status);
      osp$append_status_parameter (osc$status_parameter_delimiter, attributes_p^.
            pacs_catalog_path.path (1, attributes_p^.pacs_catalog_path.size), message_status);
      osp$append_status_file (osc$status_parameter_delimiter, pacs_ref_p^, message_status);
      osp$generate_error_message (message_status, ignore_status);
    IFEND;

    IF NOT (verify_errors = $rat$subproduct_verify_errors []) THEN
      osp$set_status_abnormal ('RA', rae$pacs_does_not_verify, attributes_p^.name, status);
      osp$append_status_file (osc$status_parameter_delimiter, pacs_ref_p^, status);
    IFEND;

  PROCEND issue_error_message;

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

{ PURPOSE:
{   This procedure gathers information about a catalog
{   and compares this information with the information in
{   SUBPRODUCT INFORMATION FILE.
{
{ DESIGN:
{   This procedure gathers information about a catalog using
{   the permanent file procedures.  PFP$GET_ITEM_INFO only
{   returns information about the catalog.  This is used to check
{   the catalog permits.  PFP$GET_MULTI_ITEM_INFO returns information
{   about all the files and catalogs one level down from the input catalog.
{   The directory_p^ contains an array of records.  Each record contains
{   the name of one element, its type (file or catalog) and the offset into
{   the permanent file sequence where more information about the element
{   can be found.
{
{ NOTES:
{   The subproduct size is a close estimation of the size of the
{   backup file of this catalog.

  PROCEDURE process_catalog_information
        (catalog_element_p: ^rat$element;
         catalog_path: pft$path;
         path_index: integer;
         catalog_element_count: integer;
         pf_info_seq_p: pft$p_info;
         validation_selections: rat$validation_selections;
         sif_present: boolean;
     VAR subproduct_info_pointers: rat$subproduct_info_pointers;
     VAR verify_options {input} : rat$subproduct_verify_options;
     VAR verify_errors {input} : rat$subproduct_verify_errors;
     VAR subproduct_size {input} : integer;
     VAR status: ost$status);


    VAR
      catalog_string: rat$path,
      current_subproduct_size: integer,
      checksum_files: boolean,
      directory_p: pft$p_directory_array,
      element_p: ^rat$element,
      element_found: boolean,
      file_path: rat$path,
      group: pft$group,
      i: pft$array_index,
      ignore_status: ost$status,
      info_record_p: pft$p_info_record,
      local_status: ost$status,
      message_status: ost$status,
      new_catalog_count: integer,
      path_p: ^pft$path,
      pf_element: rat$element,
      pf_info_item_seq_p: pft$p_info,
      validation_errors: boolean;


    status.normal := TRUE;
    group.group_type := pfc$public;
    validation_errors := FALSE;

    IF rac$calculate_contents_checksum IN verify_options THEN
      checksum_files := TRUE;
      { When checksum_files is TRUE, the contents checksum will be calculated by RAP$GET_FILE_INFORMATION.
    ELSE
      checksum_files := FALSE;
    IFEND;

    pf_element.name := catalog_path [UPPERBOUND (catalog_path)];
    pf_element.permit.defined := FALSE;
    pf_element.permit.permit_selections := $pft$permit_selections [];
    pf_element.permit.share_requirements := $pft$share_requirements [];
    pf_element.permit.application_info := '';
    pf_element.element_type := rac$catalog;
    pf_element.element_count := 0;

    pf_info_item_seq_p := pf_info_seq_p;

    pfp$get_item_info (catalog_path, group, $pft$catalog_info_selections
          [pfc$catalog_directory, pfc$catalog_permits, pfc$indirect_catalog_permits],
          $pft$file_info_selections [], pf_info_item_seq_p, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    pf_info_item_seq_p := pf_info_seq_p;
    pfp$find_next_info_record (pf_info_item_seq_p, info_record_p, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    pfp$find_directory_array (info_record_p, directory_p, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    rap$convert_path_to_str (catalog_path, catalog_string);

    rap$test_permits (validation_selections, ^catalog_string.path (1, catalog_string.size), info_record_p,
          directory_p^ [1].info_offset, validation_errors, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    IF validation_errors = TRUE THEN
      verify_errors := verify_errors + $rat$subproduct_verify_errors [rac$permit_errors];
      IF rac$stop_on_first_error IN verify_options THEN
        RETURN;
      IFEND;
    IFEND;

    pf_info_item_seq_p := pf_info_seq_p;
    pfp$get_multi_item_info (catalog_path, group, $pft$catalog_info_selections
          [pfc$catalog_directory, pfc$catalog_permits, pfc$indirect_catalog_permits],
          $pft$file_info_selections [pfc$file_directory, pfc$file_permits, pfc$file_description,
          pfc$file_cycles, pfc$cycle_label_descriptor], pf_info_item_seq_p, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    pf_info_item_seq_p := pf_info_seq_p;
    pfp$find_next_info_record (pf_info_item_seq_p, info_record_p, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    IF rac$calculate_size IN verify_options THEN
      { This formula was created through trial and error.
      { This same formula is also used in ram$create_element_list.
      current_subproduct_size := subproduct_size + ((info_record_p^.body_size *
            ((UPPERBOUND (catalog_path) DIV 2) * UPPERBOUND (catalog_path) + 91)) DIV 10);
    IFEND;

    pfp$find_directory_array (info_record_p, directory_p, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    IF directory_p = NIL THEN {EMPTY CATALOG}
      IF catalog_element_count <> 0 THEN
        find_unmatched_elements (directory_p, ^catalog_string.path (1, catalog_string.size),
              catalog_element_p, subproduct_info_pointers, verify_errors);
      IFEND;
      RETURN;
    IFEND;

{
{   Increase the size the path container by 1 and fill the first
{   elements of the array with the catalog path.
{

    PUSH path_p: [1 .. UPPERBOUND (catalog_path) + 1];
    FOR i := 1 TO UPPERBOUND (catalog_path) DO
      path_p^ [i] := catalog_path [i];
    FOREND;

  /directory_loop/
    FOR i := 1 TO UPPERBOUND (directory_p^) DO

      IF sif_present AND (directory_p^ [i].name = rac$sif_file_name) THEN
        CYCLE /directory_loop/;
      IFEND;

{
{   Add the last name to the path.  This may be a file or a catalog name.
{

      path_p^ [UPPERBOUND (path_p^)] := directory_p^ [i].name;

      rap$convert_path_to_str (path_p^, file_path);

      element_p := subproduct_info_pointers.element_list_p;
      rap$locate_element (path_p, path_index, subproduct_info_pointers.subproduct_info_seq_p, element_p,
            element_found);

      IF element_found THEN

        IF element_p^.active_element THEN

          IF directory_p^ [i].name_type = pfc$file_name THEN

            rap$get_file_information (^file_path.path (1, file_path.size), path_p^, info_record_p,
                  directory_p^ [i].info_offset, validation_selections, checksum_files, validation_errors,
                  pf_element, status);
            IF NOT status.normal THEN
              RETURN;
            IFEND;

            IF validation_errors = TRUE THEN
              verify_errors := verify_errors + $rat$subproduct_verify_errors [rac$other_errors];
              IF rac$stop_on_first_error IN verify_options THEN
                RETURN;
              IFEND;
            IFEND;

            IF rac$calculate_size IN verify_options THEN
              current_subproduct_size := current_subproduct_size + pf_element.size;
            IFEND;

            process_file_information (^file_path.path (1, file_path.size), verify_options,
                  subproduct_info_pointers, pf_element, element_p^, verify_errors, status);
            IF NOT status.normal THEN
              RETURN;
            IFEND;

        ELSE {pfc$catalog_name}

          new_catalog_count := element_p^.element_count;

            process_catalog_information (element_p, path_p^, path_index, new_catalog_count,
                  pf_info_item_seq_p, validation_selections, FALSE, subproduct_info_pointers, verify_options,
                    verify_errors, current_subproduct_size, status);
            IF NOT status.normal THEN
              RETURN;
            IFEND;
          IFEND;

        IFEND;

      ELSE {Element NOT found}

        IF directory_p^ [i].name_type = pfc$file_name THEN
          osp$set_status_abnormal ('RA', rae$extra_file_in_pacs, '', message_status);
        ELSE
          osp$set_status_abnormal ('RA', rae$extra_catalog_in_pacs, '', message_status);
        IFEND;

        osp$append_status_file (osc$status_parameter_delimiter, file_path.path (1, file_path.size),
              message_status);
        osp$generate_error_message (message_status, ignore_status);
        verify_errors := verify_errors + $rat$subproduct_verify_errors [rac$unmatched_element];

      IFEND;

      IF (verify_errors <> $rat$subproduct_verify_errors []) AND
            (rac$stop_on_first_error IN verify_options) THEN
        RETURN;
      IFEND;

    FOREND /directory_loop/;


    find_unmatched_elements (directory_p, ^catalog_string.path (1, catalog_string.size), catalog_element_p,
          subproduct_info_pointers, verify_errors);


    IF rac$calculate_size IN verify_options THEN
      subproduct_size := current_subproduct_size;
    IFEND;

  PROCEND process_catalog_information;

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

{ PURPOSE:
{   This procedure compare the information for one file element in the
{   subproduct information file with the information provided for the
{   same element by the permanent file procedures.
{
{ DESIGN:
{   The information from the subproduct information file and from the
{   permanent files procedures is passed into the procedure.  According
{   to the verify options, different fields are tested or reconciled.
{
{ NOTES:
{

  PROCEDURE process_file_information
    (    file_ref_p: ^fst$file_reference;
         verify_options: rat$subproduct_verify_options;
         subproduct_info_pointers {input, output} : rat$subproduct_info_pointers;
     VAR pf_element: rat$element;
     VAR element: rat$element;
     VAR verify_errors {input} : rat$subproduct_verify_errors;
     VAR status: ost$status);


    VAR
      attribute_override: array [1 .. 1] of fst$file_cycle_attribute,
      attributes_p: ^rat$subproduct_attributes,
      current_verify_options: rat$subproduct_verify_options,
      file_id: amt$file_identifier,
      file_opened: boolean,
      file_seg_p: amt$segment_pointer,
      ignore_status: ost$status,
      message_status: ost$status;

?? 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 file_opened THEN
        fsp$close_file (file_id, ignore_status);
        file_opened := FALSE;
      IFEND;

    PROCEND abort_handler;

?? OLDTITLE, EJECT ??


    status.normal := TRUE;
    attributes_p := subproduct_info_pointers.attributes_p;
    current_verify_options := verify_options;
    file_opened := FALSE;

    IF rac$test_mod_date_time IN current_verify_options THEN

      IF pf_element.modification_date_time <> element.modification_date_time THEN

        IF rac$stop_on_first_error IN current_verify_options THEN
          osp$set_status_abnormal ('RA', rae$mod_date_time_changed, '', message_status);
          osp$append_status_file (osc$status_parameter_delimiter, file_ref_p^, message_status);
          osp$generate_error_message (message_status, ignore_status);
          verify_errors := verify_errors + $rat$subproduct_verify_errors [rac$unmatched_date_time];
          RETURN;
        IFEND;

{
{   Since the file's modification date and time changed if the file was backed
{   up and restored, the contents checksum is checked to be sure that the file has really
{   changed.
{

        current_verify_options := current_verify_options + $rat$subproduct_verify_options
              [rac$test_contents_checksum];

      IFEND;

    IFEND;

    IF rac$get_attributes_checksum IN current_verify_options THEN
      element.attributes_checksum := pf_element.attributes_checksum;
    IFEND;

    IF rac$test_attributes_checksum IN current_verify_options THEN

      IF pf_element.attributes_checksum <> element.attributes_checksum THEN
        osp$set_status_abnormal ('RA', rae$attributes_checksum_changed, '', message_status);
        osp$append_status_file (osc$status_parameter_delimiter, file_ref_p^, message_status);
        osp$generate_error_message (message_status, ignore_status);
        verify_errors := verify_errors + $rat$subproduct_verify_errors [rac$unmatched_attrib_checksum];
        RETURN;
      IFEND;

    IFEND;

    IF (rac$test_contents_checksum IN current_verify_options) AND
          (NOT attributes_p^.calculate_contents_checksum) THEN
      osp$set_status_abnormal ('RA', rae$unable_to_compare_checksums, attributes_p^.name, message_status);
      osp$append_status_parameter (osc$status_parameter_delimiter, attributes_p^.
            pacs_catalog_path.path (1, attributes_p^.pacs_catalog_path.size), message_status);
      osp$generate_error_message (message_status, ignore_status);
      verify_errors := verify_errors + $rat$subproduct_verify_errors [rac$no_contents_checksum];
      RETURN;

    IFEND;

    IF ((rac$test_contents_checksum IN current_verify_options) AND
       NOT (rac$calculate_contents_checksum IN current_verify_options) AND
       (pf_element.size <> 0)) THEN

{
{   Open the file in read mode to compute the checksum.
{

      attribute_override [1].selector := fsc$file_organization;
      attribute_override [1].file_organization := amc$sequential;

      rap$open_file (file_ref_p, amc$segment, fsc$read, FALSE, ^attribute_override, file_id, file_opened,
            status);
      IF NOT status.normal THEN
        RETURN;
      IFEND;

      osp$establish_block_exit_hndlr (^abort_handler);

    /main/
      BEGIN

        amp$get_segment_pointer (file_id, amc$sequence_pointer, file_seg_p, status);
        IF NOT status.normal THEN
          EXIT /main/;
        IFEND;

        RESET file_seg_p.sequence_pointer;
        pf_element.contents_checksum := ocp$checksum (file_seg_p.sequence_pointer);

      END /main/;

      fsp$close_file (file_id, ignore_status);
      osp$disestablish_cond_handler;

    ELSEIF (rac$test_offline_residence IN current_verify_options) THEN

{
{   Open the file in read mode to test for offline residence of the file.  An
{   abnormal status is returned from the open if the file is currently being
{   stored offline (ie. archived.)
{
{   In the future, it is recommended that the error indicating offline residence
{   be recorded, and the verification process continued to allow searching for
{   all files that are offline.  The process will still abort eventually; however,
{   it would wait until all errors are detected.
{

      attribute_override [1].selector := fsc$file_organization;
      attribute_override [1].file_organization := amc$sequential;

      rap$open_file (file_ref_p, amc$segment, fsc$read, FALSE, ^attribute_override, file_id, file_opened,
            status);
      IF NOT status.normal THEN
        RETURN;
      IFEND;

      fsp$close_file (file_id, ignore_status);

    IFEND;

    IF (rac$test_contents_checksum IN current_verify_options) AND
          (pf_element.contents_checksum <> element.contents_checksum) THEN
      osp$set_status_abnormal ('RA', rae$contents_checksum_changed, '', message_status);
      osp$append_status_file (osc$status_parameter_delimiter, file_ref_p^, message_status);
      osp$generate_error_message (message_status, ignore_status);
      verify_errors := verify_errors + $rat$subproduct_verify_errors [rac$unmatched_contents_checksum];
      RETURN;
    IFEND;

    IF rac$reconcile_mod_date_time IN current_verify_options THEN
      element.modification_date_time := pf_element.modification_date_time;
    IFEND;

    IF rac$get_attributes_checksum IN current_verify_options THEN
      element.attributes_checksum := pf_element.attributes_checksum;
    IFEND;

    IF rac$calculate_contents_checksum IN current_verify_options THEN
      element.contents_checksum := pf_element.contents_checksum;
    IFEND;

  PROCEND process_file_information;

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

{ PURPOSE:
{   This procedure writes a subproduct information file to memory.
{
{ DESIGN:
{   This procedure creates a scratch memory segment, opens the subproduct
{   information file, and writes the contents of the subproduct information
{   file to the memory segment.
{
{ NOTES:
{

  PROCEDURE write_sif_to_memory
    (    sif_ref_p: ^fst$file_reference;
     VAR subproduct_info_sequence_size: integer;
     VAR memory_segment_p: mmt$segment_pointer;
     VAR suproduct_info_pointers: rat$subproduct_info_pointers;
     VAR status: ost$status);

    VAR
      file_opened: boolean,
      file_segment_p: amt$segment_pointer,
      file_sequence_p: ^rat$subproduct_info_sequence,
      memory_seq_p: ^rat$subproduct_info_sequence,
      sif_file_id: amt$file_identifier;

?? 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.  If the sequence has been created,
{   it will be deleted before 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 file_opened THEN
        fsp$close_file (sif_file_id, ignore_status);
        file_opened := FALSE;
      IFEND;

      IF memory_segment_p.seq_pointer <> NIL THEN
        mmp$delete_segment (memory_segment_p, 1, ignore_status);
        memory_segment_p.seq_pointer := NIL;
      IFEND;

    PROCEND abort_handler;

?? OLDTITLE, EJECT ??

{ Create a scratch memory segment.

    mmp$create_segment (NIL, mmc$sequence_pointer, 1, memory_segment_p, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

{
{ Open the subproduct information file and put its contents into a memory segment.
{

    file_opened := TRUE;
    rap$open_file (sif_ref_p, amc$segment, fsc$read, FALSE, NIL, sif_file_id, file_opened, status);
    IF NOT status.normal THEN
      file_opened := FALSE;
      RETURN;
    IFEND;

  /main/
    BEGIN

      amp$get_segment_pointer (sif_file_id, amc$sequence_pointer, file_segment_p, status);
      IF NOT status.normal THEN
        EXIT /main/;
      IFEND;

      subproduct_info_sequence_size := #SIZE (file_segment_p.sequence_pointer^);

      RESET file_segment_p.sequence_pointer;
      NEXT file_sequence_p: [[REP subproduct_info_sequence_size OF cell]] IN file_segment_p.sequence_pointer;
      IF file_sequence_p = NIL THEN
        osp$set_status_abnormal ('RA', rae$accessed_beyond_memory_seg, '', status);
        RETURN;
      IFEND;

      RESET memory_segment_p.seq_pointer;
      NEXT memory_seq_p: [[REP subproduct_info_sequence_size OF cell]] IN memory_segment_p.seq_pointer;
      IF memory_seq_p = NIL THEN
        osp$set_status_abnormal ('RA', rae$accessed_beyond_memory_seg, '', status);
        RETURN;
      IFEND;

      memory_seq_p^ := file_sequence_p^;

    END /main/;

    IF file_opened THEN
      fsp$close_file (sif_file_id, status);
      IF NOT status.normal    THEN
        file_opened := FALSE;
      IFEND;
    IFEND;

    osp$disestablish_cond_handler;

  PROCEND write_sif_to_memory;

MODEND ram$verify_subproduct;
