Sentencia SORT en un programa COBOL

Hemos visto en otros artículos como hacer un SORT en un JCL. En este artículo veremos como hacerlo en un programa cobol.
¿Utilidad? Depende. Lo cierto es que pudiendo hacerlo por JCL, no tiene caso hacerlo en un programa. Pero quién sabe! Tal vez alguno de los lectores puedan darnos una idea de su uso práctico : D

SORT:

La sentencia SORT en cobol sirve para ordenar registros por un campo clave que le indiquemos. Podremos elegir varias claves y definir si el orden será ascendente o descendente.
Para el ejemplo, hemos creado un fichero temporal en nuestro programa que utilizaremos para generar en él la información ordenada. Como registros a ordenar, utilizaremos una tabla interna, de tal forma que no necesitaremos utilizar ficheros en ningún momento.
La información ordenada se cargará desde el fichero temporal al registro de salida, que podría utilizarse a lo largo de la ejecución.
Nosotros nos pararemos cuando tengamos nuestra información ordenada, y la "displayaremos" mostrándola por SYSOUT.

 IDENTIFICATION DIVISION.
 PROGRAM-ID. PRGSORT.
*
 ENVIRONMENT DIVISION.
 CONFIGURATION SECTION.
 SPECIAL-NAMES.
 DECIMAL-POINT IS COMMA.
*
 INPUT-OUTPUT SECTION.
 FILE-CONTROL.
* Fichero temporal donde guardaremos la información ordenada
 SELECT TABLA-SORT ASSIGN TO DISK "SORTWORK".
*
 DATA DIVISION.
 FILE SECTION.
* Definición del fichero temporal
 SD TABLA-SORT
 DATA RECORD IS ELEMENTO-SORT.
 01 ELEMENTO-SORT.
    05 SORT-CLAVE1 PIC X.
    05 SORT-CLAVE2 PIC X(3).
    05 SORT-CAMPO PIC X(10).
    05 SORT-INDICADOR PIC X.
*
 WORKING-STORAGE SECTION.
* Formato del registro de salida
 01 VARIABLES.
    05 WA-REGISTRO.
       10 WA-SORT-CLAVE1 PIC X.
       10 WA-SORT-CLAVE2 PIC X(3).
       10 WA-SORT-CAMPO PIC X(10).
       10 WA-SORT-INDICADOR PIC X.
* Switches que utilizaremos en los bucles
 01 SWITCHES.
    05 SW-FIN-TABLA-SORT PIC X(1).
       88 SI-FIN-TABLA-SORT VALUE 'S'.
       88 NO-FIN-TABLA-SORT VALUE 'N'.
* Tabla interna con los datos a ordenar
 01 TABLA.
    05 WT-TBL-LISTA.
       10 PIC X(15) VALUE 'F216CAMPO02802S'.
       10 PIC X(15) VALUE 'M144CAMPO17114N'.
       10 PIC X(15) VALUE 'Q651CAMPO24536S'.
       10 PIC X(15) VALUE 'F217CAMPO03312N'.
       10 PIC X(15) VALUE 'T487CAMPO44914S'.
       10 PIC X(15) VALUE 'O372CAMPO52113N'.
       10 PIC X(15) VALUE 'F457CAMPO61224N'.
       10 PIC X(15) VALUE 'L547CAMPO73985N'.
       10 PIC X(15) VALUE 'L354CAMPO89173N'.
       10 PIC X(15) VALUE 'W516CAMPO92815N'.
    05 REDEFINES WT-TBL-LISTA.
       10 WT-TBL-ELEMENTO OCCURS 15
                           INDEXED BY WI-ELEM.
          15 WT-TBL-CLAVE1 PIC X.
          15 WT-TBL-CLAVE2 PIC X(3).
          15 WT-TBL-CAMPO PIC X(10).
          15 WT-TBL-INDICADOR PIC X.
* Formato del registro a ordenar
 01 WR-ELEMENTO-SORT.
   05 WR-SORT-CLAVE1 PIC X.
   05 WR-SORT-CLAVE2 PIC X(3).
   05 WR-SORT-CAMPO PIC X(10).
   05 WR-SORT-INDICADOR PIC X.
*
 PROCEDURE DIVISION.
*
    PERFORM 1000-INICIO
    PERFORM 2000-PROCESO
    PERFORM 9000-FINAL
    .
*
 1000-INICIO.
*
    INITIALIZE VARIABLES
    .
*
 2000-PROCESO.
* Proceso de SORT
* Indicamos las claves por las que ordenaremos ON ASCENDING ó 
* ON DESCENDING

    SORT TABLA-SORT
     ON ASCENDING KEY SORT-CLAVE1
     ON DESCENDING KEY SORT-CLAVE2
     INPUT PROCEDURE 2100-PROCESO-ENTRADA
     OUTPUT PROCEDURE 2200-PROCESO-SALIDA
* En la INPUT PROCEDURE cargamos los datos a ordenar
* En la OUTPUT PROCEDURE guardamos la información ordenada 
* en variables del programa

* Controlamos el retorno del SORT con SORT-RETURN
    IF SORT-RETURN NOT = ZEROS
       DISPLAY 'ERROR EN EL SORT:' SORT-RETURN
    END-IF
    .
*
 2100-PROCESO-ENTRADA.
* Cargamos los datos a ordenar(los de la tabla interna) en el
* fichero temporal donde se realizará la ordenación
* (ELEMENTO-SORT) con la sentencia RELEASE.
    PERFORM VARYING WI-ELEM
       FROM 1 BY 1
      UNTIL WT-TBL-CLAVE1(WI-ELEM) = LOW-VALUES
            OR WI-ELEM = 16
*
        MOVE WT-TBL-CLAVE1(WI-ELEM) TO WR-SORT-CLAVE1
        MOVE WT-TBL-CLAVE2(WI-ELEM) TO WR-SORT-CLAVE2
        MOVE WT-TBL-CAMPO(WI-ELEM) TO WR-SORT-CAMPO
        MOVE WT-TBL-INDICADOR(WI-ELEM) TO WR-SORT-INDICADOR
*
        RELEASE ELEMENTO-SORT FROM WR-ELEMENTO-SORT
        DISPLAY 'ELEMENTO-SORT:'WR-ELEMENTO-SORT
    END-PERFORM
    .
*
 2200-PROCESO-SALIDA.
* Recuperamos los datos ordenados del fichero temporal con la
* sentencia RETURN y los displayamos
    SET NO-FIN-TABLA-SORT TO TRUE
*
    PERFORM UNTIL SI-FIN-TABLA-SORT

     RETURN TABLA-SORT INTO WR-ELEMENTO-SORT
     AT END
            SET SI-FIN-TABLA-SORT TO TRUE
     NOT AT END
            MOVE WR-SORT-CLAVE1 TO WA-SORT-CLAVE1
            MOVE WR-SORT-CLAVE2 TO WA-SORT-CLAVE2
            MOVE WR-SORT-CAMPO TO WA-SORT-CAMPO
            MOVE WR-SORT-INDICADOR TO WA-SORT-INDICADOR
*
            DISPLAY 'REGISTRO->' WA-REGISTRO
*
     END-RETURN
    END-PERFORM
    .
*
 9000-FINAL.
*
    STOP RUN
    .
*

RESULTADO:

REGISTRO->F457CAMPO61224N
REGISTRO->F217CAMPO03312N
REGISTRO->F216CAMPO02802S
REGISTRO->L547CAMPO73985N
REGISTRO->L354CAMPO89173N
REGISTRO->M144CAMPO17114N
REGISTRO->O372CAMPO52113N
REGISTRO->Q651CAMPO24536S
REGISTRO->T487CAMPO44914S
REGISTRO->W516CAMPO92815N