?? RIGHT := 110 ??
?? NEWTITLE := 'INSTALL_SOFTWARE Utility: DISPLAY_PACKING_LIST Interface.' ??
MODULE ram$display_packing_list;

{ PURPOSE:
{   This module contains the procedures that display the contents of
{   a packing list.
{
{ DESIGN:
{   The compiled module resides in RAF$LIBRARY.
{
{ NOTES:
{

?? NEWTITLE := 'Global Declarations Referenced by This Module', EJECT ??
?? PUSH (LISTEXT := ON) ??
*copyc ost$status
*copyc pmt$condition
*copyc rac$max_line
*copyc rac$packing_list_level
*copyc rac$special_product_designators
*copyc rae$install_software_cc
*copyc rat$subproduct_info_pointers
*copyc rat$sequence_descriptor_types
*copyc rat$subproduct_info_p
*copyc rat$subproduct_info_types
?? POP ??
*copyc amp$get_segment_pointer
*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$get_path_name
*copyc clp$horizontal_tab_display
*copyc clp$new_display_line
*copyc clp$open_display_reference
*copyc clp$put_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$append_status_file
*copyc osp$append_status_parameter
*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$display_psrs_answered
*copyc rap$write_strings
*copyc rav$installation_path_option
*copyc rav$order_medium
*copyc rav$subproduct_type

  TYPE
    group_sort_list_p = ^array [ * ] of group_sort_record;

  TYPE
    group_sort_record = record
      case 1 .. 2 of
      = 1 =
        group: ost$name,
        subproduct_name: rat$subproduct_name,
      = 2 =
        sort_data: string (2 * osc$max_name_size)
      casend,
    recend;

  TYPE
    subproduct_sort_list_p = ^array [ * ] of subproduct_sort_record;

  TYPE
    subproduct_sort_record = record
      path_container_p: ^rat$path_container,
      psrs_answered_p: ^rat$psrs_answered,
      licensed_product_size: rat$subproduct_size,
      attributes_p: ^rat$subproduct_attributes,
      case 1 .. 2 of
      = 1 =
        licensed_product: rat$licensed_product,
        name: rat$subproduct_name,
      = 2 =
        sort_data: string (2 * osc$max_name_size)
      casend,
    recend;


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

{ PURPOSE:
{   This procedure displays information about the contents of a
{   packing list file.
{
{ DESIGN:
{   A packing list file is opened and information from the SIFs in the
{   packing list are displayed to the output file.
{
{ NOTES:

  PROCEDURE [XDCL] rap$display_packing_list
    (    packing_list_path_p: ^fst$file_reference;
         subtitle_p: ^string(*);
         idb_title_path_p: ^fst$file_reference;
         display_option: ost$name;
         output_file_path_p: ^fst$file_reference;
     VAR status: ost$status);

    VAR
      default_ring_attributes: amt$ring_attributes,
      display_control: clt$display_control,
      display_opened: boolean,
      display_status: ost$status,
      local_status: ost$status,
      packing_list_fid: amt$file_identifier,
      packing_list_opened: boolean,
      packing_list_seq_p: ^rat$packing_list_sequence;

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

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

      rap$write_strings ('Contents of packing list: ', subtitle_p^, 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;

      IF packing_list_opened THEN
        fsp$close_file (packing_list_fid, ignore_status)
      IFEND

    PROCEND abort_handler;
*copyc clp$new_page_procedure
?? OLDTITLE, EJECT ??

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

    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 (output_file_path_p^, ^clp$new_page_procedure, fsc$list,
          default_ring_attributes, display_control, status);
    IF NOT status.normal THEN
      display_opened := FALSE;
      RETURN;
    IFEND;

  /main/
    BEGIN

      open_packing_list (packing_list_path_p^, packing_list_seq_p, packing_list_opened,
            packing_list_fid, status);
      IF NOT status.normal THEN
        EXIT /main/;
      IFEND;


      display_header (idb_title_path_p, packing_list_seq_p, display_control, status);
      IF NOT status.normal THEN
        EXIT /main/;
      IFEND;

      display_product_information (display_option, packing_list_seq_p,
            display_control, status);
      IF NOT status.normal THEN
        EXIT /main/;
      IFEND;

    END /main/;

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

    IF packing_list_opened THEN
      fsp$close_file (packing_list_fid, local_status);
    IFEND;

    IF status.normal AND (NOT local_status.normal) THEN
      status := local_status;
    ELSEIF status.normal AND (NOT display_status.normal) THEN
      status := display_status;
    IFEND;

    osp$disestablish_cond_handler;

  PROCEND rap$display_packing_list;

?? TITLE := 'calculate_licensed_product_size', EJECT ??

{ PURPOSE:
{   This procedure calculates the size of each of the licensed
{   products.
{
{ DESIGN:
{   The size of all subproducts under a licensed product are added
{   to calculate the size of the licensed_product.
{
{ NOTES:
{   Subproducts that are of type CORRECTION are not included in the total.
{   Subproducts that are AUTO_INSTALL = FALSE are not included in the total.
{

  PROCEDURE calculate_licensed_product_size
    (    subproduct_list_p: subproduct_sort_list_p);


    VAR
      i: rat$subproduct_count,
      last_licensed_product: rat$licensed_product,
      last_subproduct_index: rat$subproduct_count,
      licensed_product_size: rat$subproduct_size;


    last_licensed_product := '';
    last_subproduct_index := 0;
    licensed_product_size := 0;

    FOR i := 1 TO UPPERBOUND (subproduct_list_p^) DO

      IF subproduct_list_p^ [i].licensed_product <> last_licensed_product THEN

        IF last_subproduct_index <> 0 THEN
          subproduct_list_p^ [last_subproduct_index].licensed_product_size := licensed_product_size;
          licensed_product_size := 0;
        IFEND;

        IF (subproduct_list_p^ [i].attributes_p^.auto_install) AND
              (subproduct_list_p^ [i].attributes_p^.subproduct_type <> rac$correction) THEN
          licensed_product_size := subproduct_list_p^ [i].attributes_p^.size;
        IFEND;

        last_licensed_product := subproduct_list_p^ [i].licensed_product;
        last_subproduct_index := i;

      ELSE

        IF (subproduct_list_p^ [i].attributes_p^.auto_install) AND
              (NOT subproduct_list_p^ [i].attributes_p^.hidden) THEN
          licensed_product_size := licensed_product_size + subproduct_list_p^ [i].attributes_p^.size;
        IFEND;

      IFEND;

    FOREND;

    subproduct_list_p^ [last_subproduct_index].licensed_product_size := licensed_product_size;

  PROCEND calculate_licensed_product_size;

?? TITLE := 'convert_bytes_to_megabytes', EJECT ??

{ PURPOSE:
{   This procedure converts the size of a subproduct from bytes
{   to megabytes and returns the value in a string for display
{   purposes.
{
{ DESIGN:
{   The bytes are converted to megabytes by dividing the bytes by
{   one million.  Then the megabytes are put into a string.
{
{ NOTES:
{
{

  PROCEDURE convert_bytes_to_megabytes
    (    bytes: rat$subproduct_size;
     VAR mbytes_string: string (osc$max_string_size);
     VAR mbytes_length: integer);


    VAR
      decimal_places: integer,
      largest_decimal_place: integer,
      length: integer,
      real_subproduct_size: real,
      temp_string: string (osc$max_string_size);

    decimal_places := 2;
    largest_decimal_place := 6;
    mbytes_string := '';

    real_subproduct_size := $REAL (bytes) / 1000000.0;

    STRINGREP (temp_string, length, real_subproduct_size);
    STRINGREP (mbytes_string, mbytes_length, real_subproduct_size: length: decimal_places);
    mbytes_string (1, largest_decimal_place) := mbytes_string (mbytes_length - largest_decimal_place + 1, * );
    mbytes_length := largest_decimal_place;

  PROCEND convert_bytes_to_megabytes;
?? TITLE := 'display_groups', EJECT ??

{ PURPOSE:
{   This procedure displays information that is stored in
{   the packing list sequence descriptor and packing list header.
{
{ DESIGN:
{   Information from the attributes record of the subproduct information
{   file is sorted and displayed to the display file.
{   The first array is large enough to hold all of the entries.
{   The second array is created for the sort.  It only contains the entries
{   that have a # sign as their first character.  The second array is created
{   for the sort.  Otherwise all of the blank entries would come first in the
{   sort.
{
{ NOTES:
{
{

  PROCEDURE display_groups
    (    subproduct_list_p: subproduct_sort_list_p;
     VAR display_control: clt$display_control;
     VAR status: ost$status);



    VAR
      display_status: ost$status,
      first_subproduct_in_group: boolean,
      group_index: 0 .. (rac$max_additional_products * rac$max_number_of_subproducts),
      group_p: group_sort_list_p,
      i: rat$subproduct_count,
      index: 0 .. (rac$max_additional_products * rac$max_number_of_subproducts),
      j: 0 .. (rac$max_additional_products * rac$max_number_of_subproducts),
      limited_group_p: group_sort_list_p,
      last_group: ost$name,
      subproduct_count: rat$subproduct_count;

    status.normal := TRUE;
    display_status.normal := TRUE;
    last_group := '';
    subproduct_count := UPPERBOUND (subproduct_list_p^);

    PUSH group_p: [1 .. rac$max_additional_products * subproduct_count];
    index := 0;
    group_index := 0;

    FOR i := 1 TO subproduct_count DO

      FOR j := 1 TO rac$max_additional_products DO

        index := index + 1;
        group_p^ [index].group := '';
        group_p^ [index].subproduct_name := '';

        IF subproduct_list_p^ [i].attributes_p^.additional_products [j] (1, 1) = rac$group_designator THEN
          group_index := group_index + 1;
          group_p^ [group_index].group := subproduct_list_p^ [i].attributes_p^.additional_products [j];
          group_p^ [group_index].subproduct_name := subproduct_list_p^ [i].name;
        IFEND;

      FOREND;

    FOREND;

    IF group_index > 0 THEN

      PUSH limited_group_p: [1 .. group_index];
      FOR j := 1 TO group_index DO
        limited_group_p^ [j] := group_p^ [j];
      FOREND;

      sort_groups (limited_group_p);
      IF NOT status.normal THEN
        RETURN;
      IFEND;

      FOR j := 1 TO group_index DO

        IF last_group <> limited_group_p^ [j].group THEN

          IF display_control.line_number > display_control.page_length - 4 THEN
            display_control.line_number := display_control.page_length;
          IFEND;

          IF j <> 1 THEN
            rap$write_strings (')', '', FALSE, 0, display_control, display_status);
          IFEND;

          rap$write_strings ('', '', FALSE, 0, display_control, display_status);
          rap$write_strings ('Group Name: ',
                limited_group_p^ [j].group(2,clp$trimmed_string_size(limited_group_p^[j].group)-1),
                FALSE, 0, display_control, display_status);
          rap$write_strings ('Member Subproducts: (', '', TRUE, 0, display_control, display_status);
          first_subproduct_in_group := TRUE;
          last_group := limited_group_p^ [j].group;

        IFEND;

        IF first_subproduct_in_group THEN
          rap$write_strings ('', limited_group_p^ [j].subproduct_name
                (1, clp$trimmed_string_size (limited_group_p^ [j].subproduct_name)), TRUE, 0,
                display_control, display_status);
          first_subproduct_in_group := FALSE;
        ELSE
          rap$write_strings (' ', limited_group_p^ [j].subproduct_name
                (1, clp$trimmed_string_size (limited_group_p^ [j].subproduct_name)), TRUE, 0, display_control,
                display_status);
        IFEND;

      FOREND;

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

    IFEND;

    IF status.normal AND (NOT display_status.normal) THEN
      status := display_status;
    IFEND;

  PROCEND display_groups;
?? TITLE := 'display_header', EJECT ??

{ PURPOSE:
{   This procedure displays the groups and the subproducts in
{   each group.
{
{ DESIGN:
{   Information from the packing list sequence descriptor
{   and packing list sequence header are displayed to the output file.
{
{ NOTES:
{
{

  PROCEDURE display_header
   (     idb_title_path_p: ^fst$file_reference;
     VAR packing_list_seq_p: ^rat$packing_list_sequence;
     VAR display_control: clt$display_control;
     VAR status: ost$status);


    VAR
      additional_tape_vsn_p: ^rat$tape_vsn,
      additional_volume_p: rat$additional_volume_p,
      date: ost$date,
      display_status: ost$status,
      i: rat$tape_count,
      packing_list_header_p: ^rat$packing_list_header,
      sequence_descriptor_p: ^rat$sequence_descriptor,
      tape_list_p: ^rat$tape_vsns,
      time: ost$time;

    status.normal := TRUE;
    display_status.normal := TRUE;

    RESET packing_list_seq_p;
    NEXT sequence_descriptor_p IN packing_list_seq_p;
    NEXT packing_list_header_p IN packing_list_seq_p;

    IF idb_title_path_p <> NIL THEN
      rap$write_strings ('IDB Catalog:       ', idb_title_path_p^ , FALSE, 20, display_control,
            display_status);
    IFEND;
    rap$write_strings ('Order Identifier:  ', packing_list_header_p^.order_identifier, FALSE, 0,
          display_control, display_status);
    rap$write_strings ('Order Type:        ', rav$subproduct_type [packing_list_header_p^.order_type], FALSE,
          0, display_control, display_status);

    pmp$format_compact_date (sequence_descriptor_p^.sequence_creation_date_time, osc$iso_date, date, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    pmp$format_compact_time (sequence_descriptor_p^.sequence_creation_date_time, osc$hms_time, time, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    rap$write_strings ('Order Creation:    ', date.iso , TRUE, 0,
          display_control, display_status);
    rap$write_strings (' ', time.hms, FALSE, 0, display_control, display_status);

    rap$write_strings ('Order Medium:      ', rav$order_medium [packing_list_header_p^.order_medium], FALSE,
          0, display_control, display_status);

    IF packing_list_header_p^.order_medium = rac$disk THEN

      rap$write_strings ('File Location:     ', packing_list_header_p^.
            disk_path (1, clp$trimmed_string_size (packing_list_header_p^.disk_path)), FALSE, 0,
            display_control, display_status);

    ELSEIF packing_list_header_p^.order_medium = rac$tape THEN

      tape_list_p := #PTR (packing_list_header_p^.tape_vsns_p, packing_list_seq_p^);
      display_vsns (tape_list_p^, packing_list_seq_p, display_control, status)

    IFEND;

    IF status.normal AND (NOT display_status.normal) THEN
      status := display_status;
    IFEND;

  PROCEND display_header;

?? TITLE := 'display_installation_path', EJECT ??

{ PURPOSE:
{   This procedure displays the installation path options that have
{   been defined and also those that must be defined.
{
{ DESIGN:
{   The installation path option in the attributes record is
{   translated into informative messages for the user.
{
{ NOTES:
{
{


  PROCEDURE display_installation_path
    (    subproduct_record: subproduct_sort_record;
     VAR display_control: clt$display_control;
     VAR status: ost$status);


    VAR
      display_status: ost$status,
      i: rat$path_container_length,
      index: 0 .. osc$max_string_size,
      length: integer,
      installation_path_index: rat$path_container_index,
      installation_path_string: string (osc$max_string_size),
      path_indent: 0 .. rac$max_line,
      path_string: string (osc$max_string_size);

    status.normal := TRUE;
    display_status.normal := TRUE;
    installation_path_string := ':';
    index := 2;
    path_indent := 11;


    installation_path_index := subproduct_record.attributes_p^.installation_path.path_container_index;

    FOR i := 1 TO subproduct_record.attributes_p^.installation_path.path_length DO
      path_string := '';
      STRINGREP (path_string, length, subproduct_record.path_container_p^ [installation_path_index] (1,
            clp$trimmed_string_size (subproduct_record.path_container_p^ [installation_path_index])), '.');
      installation_path_string (index, length) := path_string (1, length);
      installation_path_index := installation_path_index + 1;
      index := index + length;
    FOREND;
    index := index - 2;    {Remove trailing period '.'}

    rap$write_strings ('    Path: ', installation_path_string (1, index), FALSE, path_indent, display_control,
          display_status);

    installation_path_index := subproduct_record.attributes_p^.installation_path.path_container_index;

    IF (subproduct_record.attributes_p^.installation_path_option = rac$definable_master_catalog) OR
          (subproduct_record.attributes_p^.installation_path_option = rac$definable_family_name) THEN

      IF subproduct_record.path_container_p^ [installation_path_index] = '$UNDEFINED' THEN
        rap$write_strings ('    The Family Name MUST be defined prior to installation.', '', FALSE, 0,
              display_control, display_status);
      ELSE
        rap$write_strings ('    The Family Name is site changeable. ', '', FALSE, 0, display_control,
              display_status);
      IFEND;

    IFEND;

    IF (subproduct_record.attributes_p^.installation_path_option = rac$definable_master_catalog) OR
          (subproduct_record.attributes_p^.installation_path_option = rac$definable_user_name) THEN

      IF subproduct_record.path_container_p^ [installation_path_index + 1] = '$UNDEFINED' THEN
        rap$write_strings ('    The User Name MUST be defined prior to installation.', '', FALSE, 0,
              display_control, display_status);
      ELSE
        rap$write_strings ('    The User Name is site changeable. ', '', FALSE, 0, display_control,
              display_status);
      IFEND;

    IFEND;

    IF status.normal AND (NOT display_status.normal) THEN
      status := display_status;
    IFEND;

  PROCEND display_installation_path;

?? TITLE := 'display_product_brief', EJECT ??

{ PURPOSE:
{   This procedure displays information about the subproducts
{   when the display option = BRIEF and the order type is RELEASE.
{
{ DESIGN:
{   Information from the attributes record of the subproduct information
{   file is displayed to the display file.
{
{ NOTES:
{
{

  PROCEDURE display_product_brief
    (    subproduct_list_p: subproduct_sort_list_p;
         order_type: rat$subproduct_type;
         display_option: ost$name;
     VAR display_control: clt$display_control;
     VAR status: ost$status);


    VAR
      display_status: ost$status,
      i: rat$subproduct_count,
      j: rat$subproduct_count,
      last_licensed_product: rat$licensed_product,
      length: integer,
      licensed_product_size: rat$subproduct_size,
      mbytes_length: integer,
      mbytes_string: string (osc$max_string_size),
      primary_index: rat$subproduct_count,
      primary_subproduct: boolean;

    status.normal := TRUE;
    display_status.normal := TRUE;
    last_licensed_product := '';
    mbytes_string := '';


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

    IF order_type = rac$release THEN
      rap$write_strings ('Licensed Product Name           Level                         Size (Megabytes)', '',
            FALSE, 0, display_control, display_status);
      rap$write_strings ('', '', FALSE, 0, display_control, display_status);
    IFEND;

    FOR i := 1 TO UPPERBOUND (subproduct_list_p^) DO

      IF display_control.line_number > display_control.page_length - 9 THEN
        display_control.line_number := display_control.page_length;
      IFEND;

      IF last_licensed_product <> subproduct_list_p^ [i].licensed_product THEN
        last_licensed_product := subproduct_list_p^ [i].licensed_product;

        find_primary_subproduct (subproduct_list_p, i, primary_index, primary_subproduct);

        IF order_type = rac$release THEN
          rap$write_strings ('', subproduct_list_p^ [i].attributes_p^.licensed_product, TRUE, 0,
                display_control, display_status);

          IF primary_subproduct THEN
            rap$write_strings (' ', subproduct_list_p^ [primary_index].attributes_p^.level, TRUE, 0,
                  display_control, display_status);
          ELSE
            rap$write_strings (' ', '{No level available}           ', TRUE, 0, display_control,
                  display_status);
          IFEND;

{ The size of the licensed product is stored in the first subproduct of that licensed product.}
          convert_bytes_to_megabytes (subproduct_list_p^ [i].licensed_product_size, mbytes_string,
                mbytes_length);
          rap$write_strings (mbytes_string (1, mbytes_length), '', FALSE, 0, display_control, display_status);

        ELSE
          rap$write_strings ('Licensed Product ', subproduct_list_p^ [i].attributes_p^.licensed_product,
                FALSE, 0, display_control, display_status);
        IFEND;

      IFEND;

{Only display the subproduct information if one of these conditions occurs.}
      IF (order_type = rac$correction) OR (NOT subproduct_list_p^ [i].attributes_p^.auto_install) OR
            (subproduct_list_p^ [i].attributes_p^.installation_path_option <> rac$not_definable) OR
            ((subproduct_list_p^ [i].attributes_p^.subproduct_type = rac$correction) AND
            (order_type = rac$release)) THEN

        display_subproduct (subproduct_list_p^ [i], order_type, display_option, display_control,
              display_status);

        IF order_type = rac$release THEN

          IF i < UPPERBOUND (subproduct_list_p^) THEN

          /write_header/
            FOR j := i TO UPPERBOUND (subproduct_list_p^) DO

              IF subproduct_list_p^ [j].licensed_product <> last_licensed_product THEN
                rap$write_strings (
                      'Licensed Product Name          Level                         Size (Megabytes)'
                      , '', FALSE, 0, display_control, display_status);
                rap$write_strings (
                      'Licensed Product Name          Level                         Size (Megabytes)', '',
                        FALSE, 0, display_control, display_status);
                rap$write_strings ('', '', FALSE, 0, display_control, display_status);
              IFEND;

              EXIT /write_header/;

            FOREND /write_header/;

          IFEND;

        IFEND;

      IFEND;

    FOREND;

    IF status.normal AND (NOT display_status.normal) THEN
      status := display_status;
    IFEND;

  PROCEND display_product_brief;

?? TITLE := 'display_product_full', EJECT ??

{ PURPOSE:
{   This procedure displays information about the subproducts
{   when the display option = FULL and the order type is RELEASE.
{
{ DESIGN:
{   Information from the attributes record of the subproduct information
{   file is displayed to the display file.
{
{ NOTES:
{
{

  PROCEDURE display_product_full
    (    subproduct_list_p: subproduct_sort_list_p;
         order_type: rat$subproduct_type;
         display_option: ost$name;
     VAR display_control: clt$display_control;
     VAR status: ost$status);


    VAR
      auto_install: string (osc$max_name_size),
      display_status: ost$status,
      i: rat$subproduct_count,
      indent: string (osc$max_string_size),
      last_licensed_product: rat$licensed_product,
      licensed_product_size: rat$subproduct_size,
      mbytes_length: integer,
      mbytes_string: string (osc$max_string_size),
      primary_index: rat$subproduct_count,
      primary_subproduct: boolean;

    status.normal := TRUE;
    display_status.normal := TRUE;
    indent := '';
    last_licensed_product := '';
    mbytes_string := '';

    FOR i := 1 TO UPPERBOUND (subproduct_list_p^) DO
      IF display_control.line_number > display_control.page_length - 9 THEN
        display_control.line_number := display_control.page_length;
      IFEND;

      IF subproduct_list_p^ [i].licensed_product <> last_licensed_product THEN
        find_primary_subproduct (subproduct_list_p, i, primary_index, primary_subproduct);

        convert_bytes_to_megabytes (subproduct_list_p^ [i].licensed_product_size, mbytes_string,
              mbytes_length);
        last_licensed_product := subproduct_list_p^ [i].licensed_product;
        rap$write_strings ('', '', FALSE, 0, display_control, display_status);
        rap$write_strings ('Licensed Product ', subproduct_list_p^ [i].licensed_product, TRUE, 0,
              display_control, display_status);

        rap$write_strings ('        Size: ', mbytes_string (1, mbytes_length), TRUE, 0, display_control,
              display_status);
        rap$write_strings (' Megabytes', '', FALSE, 0, display_control, display_status);

        IF primary_subproduct THEN
          rap$write_strings ('    Level: ', subproduct_list_p^ [primary_index].attributes_p^.level, FALSE, 0,
                display_control, display_status);
        ELSE
          rap$write_strings ('    Level: ', '{No level available}', FALSE, 0, display_control,
                display_status);
        IFEND;

      IFEND;


      display_subproduct (subproduct_list_p^ [i], order_type, display_option, display_control,
            display_status);

    FOREND;

    IF order_type = rac$release THEN
      display_groups (subproduct_list_p, display_control, status);
      rap$write_strings ('', '', FALSE, 0, display_control, display_status);
    IFEND;

    IF status.normal AND (NOT display_status.normal) THEN
      status := display_status;
    IFEND;

  PROCEND display_product_full;

?? TITLE := 'display_product_information', EJECT ??

{ PURPOSE:
{   This procedure builds the sorted information array and calls
{   another procedure to display the information.
{
{ DESIGN:
{   Specific information from each SIF in the packing list is put
{   into an array and that array is sorted.  Then the information
{   in the array is displayed by another procedure.
{
{ NOTES:
{
{

  PROCEDURE display_product_information
    (    display_option: ost$name;
     VAR packing_list_seq_p: ^rat$packing_list_sequence;
     VAR display_control: clt$display_control;
     VAR status: ost$status);


    VAR
      attributes_p: ^rat$subproduct_attributes,
      disk_subproducts_p: ^rat$disk_subproduct_indexer,
      i: rat$subproduct_count,
      packing_list_header_p: ^rat$packing_list_header,
      seq_p: ^cell,
      sequence_descriptor_p: ^rat$sequence_descriptor,
      sif_info_header_p: ^rat$subproduct_info_header,
      sif_sequence_descriptor_p: ^rat$sequence_descriptor,
      subproduct_count: rat$subproduct_count,
      subproduct_list_p: subproduct_sort_list_p,
      subproduct_seq_p: ^rat$subproduct_info_sequence,
      tape_subproducts_p: ^rat$tape_subproduct_indexer;

    status.normal := TRUE;

    RESET packing_list_seq_p;
    NEXT sequence_descriptor_p IN packing_list_seq_p;
    NEXT packing_list_header_p IN packing_list_seq_p;

    IF packing_list_header_p^.order_medium = rac$disk THEN
      disk_subproducts_p := #PTR (packing_list_header_p^.disk_subproduct_indexer_p, packing_list_seq_p^);
    ELSEIF packing_list_header_p^.order_medium = rac$tape THEN
      tape_subproducts_p := #PTR (packing_list_header_p^.tape_subproduct_indexer_p, packing_list_seq_p^);
    IFEND;

    subproduct_count := packing_list_header_p^.subproduct_count;
    PUSH subproduct_list_p: [1 .. subproduct_count];

    FOR i := 1 TO subproduct_count DO

      IF packing_list_header_p^.order_medium = rac$disk THEN
        seq_p := #PTR (disk_subproducts_p^ [i].subproduct_seq_p, packing_list_seq_p^);
        RESET packing_list_seq_p TO seq_p;
        NEXT subproduct_seq_p: [[REP disk_subproducts_p^ [i].subproduct_seq_length OF cell]] IN
              packing_list_seq_p;
      ELSEIF packing_list_header_p^.order_medium = rac$tape THEN
        seq_p := #PTR (tape_subproducts_p^ [i].subproduct_seq_p, packing_list_seq_p^);
        RESET packing_list_seq_p TO seq_p;
        NEXT subproduct_seq_p: [[REP tape_subproducts_p^ [i].subproduct_seq_length OF cell]] IN
              packing_list_seq_p;
      IFEND;

      RESET subproduct_seq_p;
      NEXT sif_sequence_descriptor_p IN subproduct_seq_p;
      NEXT sif_info_header_p IN subproduct_seq_p;
      attributes_p := #PTR (sif_info_header_p^.attributes_p, subproduct_seq_p^);

{Enter the needed information in the information array.}
      subproduct_list_p^ [i].licensed_product := attributes_p^.licensed_product;
      subproduct_list_p^ [i].name := attributes_p^.name;
      subproduct_list_p^ [i].licensed_product_size := 0;
      subproduct_list_p^ [i].attributes_p := attributes_p;
      subproduct_list_p^ [i].path_container_p := #PTR (sif_info_header_p^.path_container_p,
            subproduct_seq_p^);
      subproduct_list_p^ [i].psrs_answered_p := #PTR (sif_info_header_p^.psrs_answered_p,
            subproduct_seq_p^);

    FOREND;

    sort_subproduct_info (subproduct_list_p);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    calculate_licensed_product_size (subproduct_list_p);

    IF (display_option = 'FULL') OR (display_option = 'F') THEN
      display_product_full (subproduct_list_p, packing_list_header_p^.order_type, display_option,
            display_control, status);
    ELSE
      display_product_brief (subproduct_list_p, packing_list_header_p^.order_type, display_option,
            display_control, status);
    IFEND;

  PROCEND display_product_information;

?? TITLE := 'display_subproduct', EJECT ??

{ PURPOSE:
{   This procedure displays information about a subproduct.
{
{ DESIGN:
{   Information from the attributes record of the subproduct information
{   file is displayed to the display file.
{
{ NOTES:
{
{

  PROCEDURE display_subproduct
    (    subproduct_record: subproduct_sort_record;
         order_type: rat$subproduct_type;
         display_option: ost$name;
     VAR display_control: clt$display_control;
     VAR status: ost$status);


    VAR
      auto_install: string (osc$max_name_size),
      display_status: ost$status,
      i: rat$subproduct_count,
      mbytes_length: integer,
      mbytes_string: string (osc$max_string_size);


    status.normal := TRUE;
    display_status.normal := TRUE;

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

    rap$write_strings ('  Subproduct ', subproduct_record.name
          (1, clp$trimmed_string_size (subproduct_record.name)), TRUE, 0, display_control, display_status);

    IF order_type = rac$release THEN
      rap$write_strings (' (', rav$subproduct_type [subproduct_record.attributes_p^.subproduct_type]
            (1, clp$trimmed_string_size (rav$subproduct_type [subproduct_record.attributes_p^.
            subproduct_type])), TRUE, 0, display_control, display_status);
      rap$write_strings (') ', '', TRUE, 0, display_control, display_status);
    IFEND;

    IF subproduct_record.attributes_p^.auto_install = TRUE THEN
      auto_install := 'YES'
    ELSE
      auto_install := 'NO'
    IFEND;
    rap$write_strings (' Auto Install: ', auto_install, FALSE, 0, display_control, display_status);

    IF display_option = 'FULL' THEN
      rap$write_strings ('    Description: ', subproduct_record.attributes_p^.description, FALSE, 0,
            display_control, display_status);
    IFEND;

    rap$write_strings ('    Level: ', subproduct_record.attributes_p^.level, TRUE, 0, display_control,
          display_status);

    convert_bytes_to_megabytes (subproduct_record.attributes_p^.size, mbytes_string, mbytes_length);
    rap$write_strings ('              Size: ', mbytes_string (1, mbytes_length), TRUE, 0, display_control,
          display_status);
    rap$write_strings (' Megabytes', '', FALSE, 0, display_control, display_status);

    IF subproduct_record.attributes_p^.subproduct_type = rac$correction THEN
      rap$write_strings ('    Corrects Level: ', subproduct_record.attributes_p^.correction_base_level, FALSE,
            0, display_control, display_status);
    IFEND;

    IF (display_option = 'FULL') OR (subproduct_record.attributes_p^.installation_path_option <>
          rac$not_definable) THEN

      display_installation_path (subproduct_record, display_control, status);
      IF NOT status.normal THEN
        RETURN;
      IFEND;
    IFEND;

    IF subproduct_record.attributes_p^.subproduct_type = rac$correction THEN
      rap$display_psrs_answered (subproduct_record.psrs_answered_p, display_control, status);
      IF NOT status.normal THEN
        RETURN;
      IFEND;
    IFEND;

    IF status.normal AND (NOT display_status.normal) THEN
      status := display_status;
    IFEND;

  PROCEND display_subproduct;
?? TITLE := 'display_vsns', EJECT ??

{ PURPOSE:
{   This procedure displays the external vsns and recorded vsns
{   from a packing list.
{
{ DESIGN:
{   Information from the packing list sequence is displayed to the output file.
{
{ NOTES:
{
{

  PROCEDURE display_vsns
    (    tape_list: rat$tape_vsns;
         packing_list_seq_p: ^rat$packing_list_sequence;
     VAR display_control: clt$display_control;
     VAR status: ost$status);

    VAR
      additional_tape_vsn_p: ^rat$tape_vsn,
      additional_volume_p: rat$additional_volume_p,
      display_status: ost$status,
      i: rat$tape_count,
      index: integer,
      length: integer,
      tape_vsn_indent: integer,
      tape_list_p: ^rat$tape_vsns,
      tape_string: string (osc$max_string_size),
      tape_vsn_string: string (osc$max_string_size);

    status.normal := TRUE;
    display_status.normal := TRUE;
    tape_vsn_indent := 19;

    index := 1;
    tape_vsn_string := '';
    FOR i := 1 TO UPPERBOUND (tape_list) DO

      tape_string := '';
      IF i = 1 THEN
        STRINGREP (tape_string, length, '''', tape_list [i].
              external_vsn (1, clp$trimmed_string_size (tape_list [i].external_vsn)), '''');
      ELSE
        STRINGREP (tape_string, length, ', ''', tape_list [i].
              external_vsn (1, clp$trimmed_string_size (tape_list [i].external_vsn)), '''');
      IFEND;
      tape_vsn_string (index, length) := tape_string (1, length);
      index := index + length;

      additional_volume_p := tape_list [i].additional_volume_p;

      WHILE additional_volume_p <> NIL DO

        additional_tape_vsn_p := #PTR (additional_volume_p, packing_list_seq_p^);

        tape_string := '';
        STRINGREP (tape_string, length, ', ''', additional_tape_vsn_p^.
              external_vsn (1, clp$trimmed_string_size (additional_tape_vsn_p^.external_vsn)), '''');
        tape_vsn_string (index, length) := tape_string (1, length);
        index := index + length;

        additional_volume_p := additional_tape_vsn_p^.additional_volume_p;

      WHILEND;
    FOREND;

    rap$write_strings ('External VSNs:     ', tape_vsn_string (1, index), FALSE, tape_vsn_indent,
          display_control, display_status);

    index := 1;
    tape_vsn_string := '';
    FOR i := 1 TO UPPERBOUND (tape_list) DO

      tape_string := '';
      IF i = 1 THEN
        STRINGREP (tape_string, length, '''', tape_list [i].
              recorded_vsn (1, clp$trimmed_string_size (tape_list [i].recorded_vsn)), '''');
      ELSE
        STRINGREP (tape_string, length, ', ''', tape_list [i].
              recorded_vsn (1, clp$trimmed_string_size (tape_list [i].recorded_vsn)), '''');
      IFEND;
      tape_vsn_string (index, length) := tape_string (1, length);
      index := index + length;

      additional_volume_p := tape_list [i].additional_volume_p;

      WHILE additional_volume_p <> NIL DO

        additional_tape_vsn_p := #PTR (additional_volume_p, packing_list_seq_p^);

        tape_string := '';
        STRINGREP (tape_string, length, ', ''', additional_tape_vsn_p^.
              recorded_vsn (1, clp$trimmed_string_size (additional_tape_vsn_p^.recorded_vsn)), '''');
        tape_vsn_string (index, length) := tape_string (1, length);
        index := index + length;

        additional_volume_p := additional_tape_vsn_p^.additional_volume_p;

      WHILEND;
    FOREND;

    rap$write_strings ('Recorded VSNs:     ', tape_vsn_string (1, index), FALSE, tape_vsn_indent,
          display_control, display_status);

    IF status.normal AND (NOT display_status.normal) THEN
      status := display_status;
    IFEND;

  PROCEND display_vsns;

?? TITLE := 'find_primary_subproduct', EJECT ??

{ PURPOSE:
{   This procedure finds the primary subproduct of a licensed
{   product.
{
{ DESIGN:
{   Information from the information array is checked until the
{   primary subproduct is found.  If there is no primary subproduct,
{   a boolean is set to false.
{
{ NOTES:
{
{

  PROCEDURE find_primary_subproduct
    (    subproduct_list_p: subproduct_sort_list_p;
         index: rat$subproduct_count;
     VAR primary_index: rat$subproduct_count;
     VAR primary_subproduct: boolean);

    VAR
      last_licensed_product: rat$licensed_product;

    last_licensed_product := subproduct_list_p^ [index].licensed_product;
    primary_index := index;
    primary_subproduct := FALSE;

  /find_primary/
    WHILE NOT primary_subproduct DO

      IF (subproduct_list_p^ [primary_index].licensed_product = last_licensed_product) AND
            (subproduct_list_p^ [primary_index].attributes_p^.primary) THEN

        primary_subproduct := TRUE;

      ELSEIF subproduct_list_p^ [primary_index].licensed_product <> last_licensed_product THEN

        EXIT /find_primary/;

      ELSE

        IF primary_index < UPPERBOUND (subproduct_list_p^) THEN
          primary_index := primary_index + 1;
        ELSE
          EXIT /find_primary/;
        IFEND;

      IFEND;

    WHILEND /find_primary/;

  PROCEND find_primary_subproduct;

?? TITLE := 'open_packing_list', EJECT ??

{ PURPOSE:
{   This procedure opens a file and validates that it is a packing
{   list.
{
{ DESIGN:
{   The file is opened and the sequence descriptor is tested to see
{   if the file is a packing list.
{
{ NOTES:
{
{

  PROCEDURE open_packing_list
    (    packing_list_path: fst$file_reference;
     VAR packing_list_seq_p: ^rat$packing_list_sequence;
     VAR packing_list_opened: boolean;
     VAR packing_list_fid: amt$file_identifier;
     VAR status: ost$status);


    VAR
      attachment_option: array [1 .. 2] of fst$attachment_option,
      packing_list_header_p: ^rat$packing_list_header,
      seg_p: amt$segment_pointer,
      sequence_descriptor_p: ^rat$sequence_descriptor;

    status.normal := TRUE;

    attachment_option [1].selector := fsc$access_and_share_modes;
    attachment_option [1].access_modes.selector := fsc$specific_access_modes;
    attachment_option [1].access_modes.value := $fst$file_access_options [fsc$read];
    attachment_option [1].share_modes.selector := fsc$determine_from_access_modes;
    attachment_option [2].selector := fsc$create_file;
    attachment_option [2].create_file := FALSE;

    packing_list_opened := TRUE;
    fsp$open_file (packing_list_path, amc$segment, ^attachment_option, NIL, NIL, NIL, NIL, packing_list_fid,
          status);
    IF NOT status.normal THEN
      packing_list_opened := FALSE;
      RETURN;
    IFEND;

    amp$get_segment_pointer (packing_list_fid, amc$sequence_pointer, seg_p, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    packing_list_seq_p := seg_p.sequence_pointer;
    NEXT sequence_descriptor_p IN packing_list_seq_p;

    IF (sequence_descriptor_p = NIL) OR (sequence_descriptor_p^.sequence_type <> rac$packing_list_sequence)
          THEN
      osp$set_status_abnormal ('RA', rae$not_a_packing_list, '', status);
      osp$append_status_file (osc$status_parameter_delimiter, packing_list_path, status);
      RETURN;
    IFEND;

    IF sequence_descriptor_p^.sequence_level <> rac$packing_list_level THEN
      osp$set_status_abnormal ('RA', rae$incompatible_sequence_level, 'PACKING LIST', status);
      osp$append_status_parameter (osc$status_parameter_delimiter, sequence_descriptor_p^.sequence_level,
            status);
      RETURN;
    IFEND;

  PROCEND open_packing_list;
?? TITLE := 'sort_groups', EJECT ??

{ PURPOSE:
{   The purpose of this procedure is to sort the group_list
{   by group by subproduct name.
{
{ DESIGN:
{   The sorting is performed by a shell sort.
{
{
{ NOTES:
{

  PROCEDURE sort_groups
    (    group_p: group_sort_list_p);

    VAR
      current: integer,
      gap: integer,
      start: integer,
      swap: group_sort_record;


    gap := UPPERBOUND (group_p^);

    WHILE gap > 1 DO
      gap := 2 * (gap DIV 4) + 1;

      FOR start := LOWERBOUND (group_p^) TO UPPERBOUND (group_p^) - gap DO
        current := start;

        WHILE (current > 0) AND (group_p^ [current].sort_data > group_p^ [current + gap].sort_data) DO
          swap := group_p^ [current];
          group_p^ [current] := group_p^ [current + gap];
          group_p^ [current + gap] := swap;
          current := current - gap;
        WHILEND;

      FOREND;

    WHILEND;

  PROCEND sort_groups;

?? TITLE := 'sort_subproduct_info', EJECT ??

{ PURPOSE:
{   The purpose of this procedure is to sort the subproduct_info_list
{   by licensed product and by subproduct name.
{
{ DESIGN:
{   The procedure uses a shell sort.
{
{ NOTES:
{

  PROCEDURE sort_subproduct_info
    (    subproduct_list_p: subproduct_sort_list_p);

    VAR
      current: integer,
      gap: integer,
      start: integer,
      swap: subproduct_sort_record;


    gap := UPPERBOUND (subproduct_list_p^);

    WHILE gap > 1 DO
      gap := 2 * (gap DIV 4) + 1;

      FOR start := LOWERBOUND (subproduct_list_p^) TO UPPERBOUND (subproduct_list_p^) - gap DO
        current := start;

        WHILE (current > 0) AND (subproduct_list_p^ [current].
              sort_data > subproduct_list_p^ [current + gap].sort_data) DO
          swap := subproduct_list_p^ [current];
          subproduct_list_p^ [current] := subproduct_list_p^ [current + gap];
          subproduct_list_p^ [current + gap] := swap;
          current := current - gap;
        WHILEND;

      FOREND;

    WHILEND;

  PROCEND sort_subproduct_info;

MODEND ram$display_packing_list;





