/*
 *  Example 22-1:        Sort a file
 */
SORTEM: PROCEDURE RETURNS(FIXED BINARY(31));
  
    /*
     * Include the declarations of the SORT procedures required
     * for a sort using the file interface.     
     */
    %INCLUDE SOR$PASS_FILES;  /* SORT File Specification Procedure */ /* <co>(1) */
    %INCLUDE SOR$BEGIN_SORT;  /* SORT Initialization Procedure */
    %INCLUDE SOR$SORT_MERGE;  /* Procedure to Initiate SORT */
    %INCLUDE SOR$END_SORT;    /* SORT Termination Procedure */

    /*
     * Include constants & return status variable.
     */
    %INCLUDE $DSCDEF;         /* Include data type definitions */
    %INCLUDE $FABDEF;         /* FAB declarations */
    %INCLUDE $STSDEF;         /* Declarations for return status value */

    /*
     * Additional constants not currently available in PLISTARLET.
     * (SORT constants described in the SOR$BEGIN_SORT documentation.)
     */
    %REPLACE ASCENDING_ORDER BY 0;
    %REPLACE DESCENDING_ORDER BY 1;

    /*
     * Declare the input and output files; these are logical names
     * which must be defined before the program is run.
     */
    DECLARE
        INPUT_FILE  CHARACTER(6) STATIC INIT('INFILE'),    /* <co>(2) */
        OUTPUT_FILE CHARACTER(7) STATIC INIT('OUTFILE');

    /*
     * Declare the key buffer array required to sort the first 80
     * characters of any record.  (Note that while the Sort documentation
     * describes this as an array, it is more obviously expressed in
     * PL/I as a structure.  An array of FIXED BIN(15) elements could
     * be used instead.)
     */
    DECLARE
        1 KEY_BUFFER STATIC,
          2 NUMBER_OF_KEYS FIXED BINARY(15) INIT(1),    /* <co>(3) */
          2 KEY_TYPE   FIXED BINARY(15) INIT(DSC$K_DTYPE_T), /* character */
          2 KEY_ORDER  FIXED BINARY(15) INIT(ASCENDING_ORDER),
          2 START_POS  FIXED BINARY(15) INIT(0),
          2 KEY_LENGTH FIXED BINARY(15) INIT(80),
        LONGEST_RECORD FIXED BINARY(15) STATIC INIT(80);

    /*
     * Call the SORT routines in the required order.
     * After each call to Sort, check STS$SUCCESS.
     */
    STS$VALUE = SOR$PASS_FILES(
                        INPUT_FILE,     /* Input file name */
                        OUTPUT_FILE,    /* Output file name */ /* <co>(4) */
                        FAB$C_REL,      /* File organization */
                        FAB$C_VAR );    /* Record type */
    IF ^STS$SUCCESS 
    THEN 
        GOTO ERROR;

    STS$VALUE = SOR$BEGIN_SORT(KEY_BUFFER,LONGEST_RECORD);
    IF ^STS$SUCCESS 
    THEN 
        GOTO ERROR;

    STS$VALUE = SOR$SORT_MERGE();
    IF ^STS$SUCCESS 
    THEN 
        GOTO ERROR;

    STS$VALUE = SOR$END_SORT();
    IF ^STS$SUCCESS 
    THEN 
        GOTO ERROR;

    RETURN(1);

ERROR:
    PUT SKIP(2) EDIT ('SORT FAILED.  ERROR CODE',STS$VALUE) (A,X,F(8));
    RETURN(STS$VALUE);

    END SORTEM;