?? RIGHT := 110 ??
MODULE ram$write_correction_package;
*copyc osd$default_pragmats
?? PUSH (LISTEXT := ON) ??
*copyc rae$error_messages
*copyc rav$correction_package_header
*copyc rav$corp
*copyc rav$elements
*copyc rat$correction_package_header
*copyc rat$correction_package
*copyc amp$open
*copyc amp$close
*copyc amp$set_segment_eoi
*copyc amp$get_segment_pointer
*copyc clp$scan_parameter_list
*copyc clp$get_value
*copyc osp$set_status_abnormal
?? POP ??

{    pdt gencp_pdt (
{      correction_package, cp: file = $required
{      status)

?? PUSH (LISTEXT := ON) ??

  VAR
    gencp_pdt: [STATIC, READ, cls$pdt] clt$parameter_descriptor_table := [^gencp_pdt_names, ^gencp_pdt_params
      ];

  VAR
    gencp_pdt_names: [STATIC, READ, cls$pdt_names_and_defaults] array [1 .. 3] of
      clt$parameter_name_descriptor := [['CORRECTION_PACKAGE', 1], ['CP', 1], ['STATUS', 2]];

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

{ CORRECTION_PACKAGE CP }
    [[clc$required], 1, 1, 1, 1, clc$value_range_not_allowed, [NIL, clc$file_value]],

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

?? POP ??
*copyc rah$write_correction_package

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

    VAR
      correction: ^SEQ ( * ),
      current_correction: ^SEQ ( * ),
      i: rat$element_index,
      out: amt$segment_pointer,
      out_package: ^SEQ ( * ),
      out_psrs: ^array [1 .. * ] of rat$psr_ident,
      output_elements: ^rat$correction_package,
      output_fid: amt$file_identifier,
      output_file: clt$file,
      output_header: ^rat$correction_package_header,
      psr_info: ^array [1 .. * ] of rat$psr_ident,
      psrs: ^array [1 .. * ] of rat$psr_ident,
      value: clt$value;

    status.normal := TRUE;

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

    clp$get_value ('CORRECTION_PACKAGE', 1, 1, clc$low, value, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;
    output_file := value.file;

    IF rav$correction_package_header^.number_of_elements > 0 THEN
      amp$open (output_file.local_file_name, amc$segment, NIL, output_fid, status);
      IF NOT status.normal THEN
        RETURN;
      IFEND;

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

      RESET out.sequence_pointer;
      NEXT output_header IN out.sequence_pointer;
      output_header^ := rav$correction_package_header^;
      NEXT output_elements: [1 .. output_header^.number_of_elements] IN out.sequence_pointer;

      FOR i := 1 TO output_header^.number_of_elements DO
        output_elements^ [i] := rav$elements^ [i];
        current_correction := #PTR (rav$elements^ [i].correction_package, rav$corp.sequence_pointer^);
        RESET rav$corp.sequence_pointer TO current_correction;
        NEXT correction: [[REP rav$elements^ [i].size OF cell]] IN rav$corp.sequence_pointer;
        NEXT out_package: [[REP rav$elements^ [i].size OF cell]] IN out.sequence_pointer;
        out_package^ := correction^;
        output_elements^ [i].correction_package := #REL (out_package, out.sequence_pointer^);
        IF output_elements^ [i].number_of_psrs > 0 THEN
          psr_info := #PTR (rav$elements^ [i].psr_info, rav$corp.sequence_pointer^);
          RESET rav$corp.sequence_pointer TO psr_info;
          NEXT psrs: [1 .. rav$elements^ [i].number_of_psrs] IN rav$corp.sequence_pointer;
          NEXT out_psrs: [1 .. output_elements^ [i].number_of_psrs] IN out.sequence_pointer;
          out_psrs^ := psrs^;
          output_elements^ [i].psr_info := #REL (out_psrs, out.sequence_pointer^);
        IFEND;
      FOREND;
      amp$set_segment_eoi (output_fid, out, status);
      IF NOT status.normal THEN
        RETURN;
      IFEND;

      rav$correction_package_header^.number_of_elements := 0;

      amp$close (output_fid, status);
      IF NOT status.normal THEN
        RETURN;
      IFEND;
    ELSE
      osp$set_status_abnormal ('RA', rae$no_correction_package, ' ', status);
      RETURN;
    IFEND;
  PROCEND rap$write_correction_package;
MODEND ram$write_correction_package;
