IDENTIFICATION DIVISION. PROGRAM-ID. PRLISTA. *================================================================* * PROGRAMA QUE DEVUELVE UNA LISTA DE REGISTROS * *================================================================* ****************************************************************** * *================================================================* * E N V I R O N M E N T D I V I S I O N * *================================================================* * ENVIRONMENT DIVISION. * *===================== CONFIGURATION SECTION. *===================== * SPECIAL-NAMES. DECIMAL-POINT IS COMMA. * *================================================================* * D A T A D I V I S I O N * *================================================================* * DATA DIVISION. * *======================= WORKING-STORAGE SECTION. *======================= * * ----------------- * CAMPOS CONSTANTES * ----------------- 01 WK-CONSTANTES. 05 WK-SIN-DATOS PIC S9(3) COMP-3 VALUE +100. * * ------------------------- * AREAS PARA COMUNICACIONES * ------------------------- EXEC SQL INCLUDE SQLCA END-EXEC. * * ------- * INDICES * ------- 01 WI-INDICES. 05 WI-NUM-ITEM PIC S9(4) COMP VALUE 0. * * ----------------- * CAMPOS DE TRABAJO * ----------------- 01 VARIABLES HOST. 05 TABLA1-CAMPO1 PIC XX. 05 TABLA1-CAMPO2 PIC XX. 05 TABLA1-CAMPO3 PIC XX. 05 TABLA1-CAMPO4 PIC XX. 05 TABLA1-CAMPO5 PIC XX. * *-> Tabla DB2 : TBPRU01 - COPY CON EL DECLARE DE LA TABLA. * ----------------- * DECLARACION DEL CURSOR * ----------------- *-> Instr. SQL : DECLARE - Declarar un Cursor EXEC SQL DECLARE CURSOR CUR_TBPRU01 FOR SELECT CAMPO1, CAMPO2, CAMPO3, CAMPO4, CAMPO5 FROM TBPRU01 WHERE CAMPO1 = :CLAVE-CAMPO1 AND CAMPO2 > :CLAVE-CAMPO2 ORDER BY CAMPO1 ASC, CAMPO2 ASC END-EXEC . *=============== LINKAGE SECTION. *=============== * 01 ENTRADA. 05 ENT-CAMPO1 PIC XX. 05 ENT-CAMPO2 PIC XX. 01 SALIDA. 05 SAL-ULTIMA-CLAVE PIC XXXX. 05 SAL-RECONSULTAR PIC X. 05 SAL-DATOS OCCURS 5 TIMES. 10 SAL-CAMPO1 PIC XX. 10 SAL-CAMPO2 PIC XX. 10 SAL-CAMPO3 PIC XX. 10 SAL-CAMPO4 PIC XX. 10 SAL-CAMPO5 PIC XX. * *================================================================* * P R O C E D U R E D I V I S I O N * *================================================================* * PROCEDURE DIVISION USING ENTRADA SALIDA. * ****************************************************************** * | 0000 - PRINCIPAL * *--|------------------+----------><----------+-------------------* * 1| EJECUTA EL INICIO DEL PROGRAMA * * 2| EJECUTA EL PROCESO DEL PROGRAMA * * 3| EJECUTA EL FINAL DEL PROGRAMA * ****************************************************************** 00000-PRINCIPAL. * *-> <1> * PERFORM 10000-INICIO * *-> <2> * PERFORM 20000-PROCESO * *-> <3> * PERFORM 90000-FINAL . ****************************************************************** * | 10000 - INICIO * *--|------------------+----------><----------+-------------------* * | SE REALIZA EL TRATAMIENTO DE INICIO: * * 1| Inicialización de Áreas de Trabajo y validacion entrada * * 2| Validacion de los datos de entrada * * 3| Apertura del cursor y primera lectura * ****************************************************************** 10000-INICIO. * *-> <1> * INITIALIZE SALIDA WX-TRABAJO WI-INDICES * *-> <2> Añadir validacion de los campos de entrada * IF ENT-CAMPO1 EQUAL SPACES OR LOW-VALUES DISPLAY 'LA CLAVE ESTA VACIA' PERFORM 90000-FINAL END-IF *-> <3> * IF SAL-ULTIMA-CLAVE EQUAL SPACES OR LOW-VALUES MOVE ENT-CAMPO1 TO CLAVE-CAMPO1 MOVE ENT-CAMPO2 TO CLAVE-CAMPO2 ELSE MOVE SAL-ULTIMA-CLAVE(1:2) TO CLAVE-CAMPO1 MOVE SAL-ULTIMA-CLAVE(3:2) TO CLAVE-CAMPO2 END-IF PERFORM 20100-OPEN-CURSOR-TBPRU01 * PERFORM 20200-FETCH-TBPRU01 * IF SQLCODE EQUAL WK-SIN-DATOS * Si es la primera LLamada es que no hay datos IF SAL-ULTIMA-CLAVE = SPACES OR LOW-VALUES DISPLAY 'NO HAY DATOS PARA ESA CLAVE' END-IF ELSE ADD 1 TO WI-NUM-ITEM END-IF . ****************************************************************** * | 20000 - PROCESO * *--|------------------+----------><----------+-------------------* * | SE REALIZA EL TRATAMIENTO DE LOS DATOS: * * 1| Realiza el tratamiento de cada registro leido * ****************************************************************** 20000-PROCESO. * *-> <1> * PERFORM UNTIL SQLCODE EQUAL WK-SIN-DATOS OR WI-NUM-ITEM > 5 * PERFORM 20300-MOVER-A-SAL-TABLA * MOVE TABLA1-CAMPO1 TO SAL-ULTIMA-CLAVE(1:2) MOVE TABLA1-CAMPO2 TO SAL-ULTIMA-CLAVE(3:2) * PERFORM 20200-FETCH-TBPRU01 END-PERFORM * IF SQLCODE EQUAL WK-SIN-DATOS MOVE 'N' TO SAL-RECONSULTAR MOVE SPACES TO SAL-ULTIMA-CLAVE PERFORM 20400-CLOSE-TBPRU01 ELSE MOVE 'S' TO SAL-RECONSULTAR MOVE TABLA1-CAMPO1 TO SAL-ULTIMA-CLAVE(1:2) MOVE TABLA1-CAMPO2 TO SAL-ULTIMA-CLAVE(3:2) PERFORM 20400-CLOSE-TBPRU01 END-IF . ****************************************************************** * | 20100 - OPEN - TBPRU01 * *--|------------------+----------><----------+-------------------* * | * * 1| Apertura de la tabla y tratamiento del sqlcode * ****************************************************************** 20100-OPEN-CURSOR-TBPRU01. * *-> <1> *-> Instr. SQL : OPEN - Abrir un Cursor EXEC SQL OPEN CUR_TBPRU01 END-EXEC * IF SQLCODE EQUAL ZERO CONTINUE ELSE DISPLAY 'ERROR EN EL OPEN DEL CURSOR. SQLCODE: 'SQLCODE PERFORM 90000-FINAL END-IF * . ****************************************************************** * | 20200 - FETCH - TBPRU01 * *--|------------------+----------><----------+-------------------* * | * * 1| Lectura de la tabla y tratamiento del sqlcode * ****************************************************************** 20200-FETCH-TBPRU01. * *-> <1> * *-> Instr. SQL : FETCH - Leer un Cursor EXEC SQL FETCH CUR_TABLA INTO :TABLA1-CAMPO1, :TABLA1-CAMPO2, :TABLA1-CAMPO3, :TABLA1-CAMPO4, :TABLA1-CAMPO5 END-EXEC * EVALUATE TRUE WHEN SQLCODE EQUAL ZERO ADD 1 TO WI-NUM-ITEM WHEN SQLCODE EQUAL WK-SIN-DATOS * Fin de Cursor DISPLAY 'FIN DE DATOS DEL CURSOR' WHEN OTHER * Error al Leer un Cursor DISPLAY 'ERROR EN FETCH CURSOR. SQLCODE: 'SQLCODE PERFORM 90000-FINAL END-EVALUATE * . * ****************************************************************** * | 20400-MOVER-A-SAL-TABLA * *--|------------------+----------><----------+-------------------* * | * ****************************************************************** 20300-MOVER-A-SAL-TABLA. * MOVE TABLA1-CAMPO1 TO SAL-CAMPO1(WI-NUM-ITEM) MOVE TABLA1-CAMPO2 TO SAL-CAMPO2(WI-NUM-ITEM) MOVE TABLA1-CAMPO3 TO SAL-CAMPO3(WI-NUM-ITEM) MOVE TABLA1-CAMPO4 TO SAL-CAMPO4(WI-NUM-ITEM) MOVE TABLA1-CAMPO5 TO SAL-CAMPO5(WI-NUM-ITEM) . * ****************************************************************** * | 20300 - CLOSE - TBPRU01 * *--|------------------+----------><----------+-------------------* * | * * 1| Cierre de la tabla y tratamiento del sqlcode * ****************************************************************** 20400-CLOSE-TBPRU01. * *-> <1> * *-> Instr. SQL : CLOSE - Cerrar un Cursor EXEC SQL CLOSE CUR_TBPRU01 END-EXEC * IF SQLCODE EQUAL ZERO CONTINUE ELSE DISPLAY 'ERROR EN CLOSE CURSOR. SQLCODE: 'SQLCODE PERFORM 90000-FINAL END-IF * . * ****************************************************************** * | 90000 - FINAL * *--|------------------+----------><----------+-------------------* * | FINALIZA LA EJECUCION DEL PROGRAMA * ****************************************************************** 90000-FINAL. * * GOBACK . *================ Fin del Programa PRLISTA ================*