?? RIGHT := 110 ??
MODULE ram$write_cp_to_scratch_file;
*copyc osd$default_pragmats
?? PUSH (LISTEXT := ON) ??
*copyc rav$correction_package_header
*copyc rav$corp
*copyc rav$elements
*copyc rat$correction_package_header
*copyc rat$correction_package
*copyc rac$status_id
*copyc rae$error_messages
*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 write_cp_pdt (
{     output, o: file = $required
{     status)

?? PUSH (LISTEXT := ON) ??

  VAR
    write_cp_pdt: [STATIC, READ, cls$pdt] clt$parameter_descriptor_table := [^write_cp_pdt_names,
      ^write_cp_pdt_params];

  VAR
    write_cp_pdt_names: [STATIC, READ, cls$pdt_names_and_defaults] array [1 .. 3] of
      clt$parameter_name_descriptor := [['OUTPUT', 1], ['O', 1], ['STATUS', 2]];

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

{ OUTPUT O }
    [[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_cp_to_scratch_file

  PROCEDURE [XDCL] rap$write_cp_to_scratch_file (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,
      temp_seq: ^SEQ ( * ),
      value: clt$value;

    status.normal := TRUE;

    temp_seq := rav$corp.sequence_pointer;

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

    clp$get_value ('OUTPUT', 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, temp_seq^);
        RESET temp_seq TO current_correction;
        NEXT correction: [[REP rav$elements^ [i].size OF cell]] IN temp_seq;
        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, temp_seq^);
          RESET temp_seq TO psr_info;
          NEXT psrs: [1 .. rav$elements^ [i].number_of_psrs] IN temp_seq;
          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;

      amp$close (output_fid, status);
      IF NOT status.normal THEN
        RETURN;
      IFEND;
    ELSE
      osp$set_status_abnormal (rac$status_id, rae$no_current_correction, '', status);
    IFEND;
  PROCEND rap$write_cp_to_scratch_file;
MODEND ram$write_cp_to_scratch_file;
