IDENTIFICATION DIVISION. PROGRAM-ID. CRUCENN. ****************************************************************** * *================================================================* * 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. * *==================== INPUT-OUTPUT SECTION. *==================== * FILE-CONTROL. * SELECT FICHERO1 ASSIGN TO FICHERO1 STATUS IS FS-FICHERO1. * SELECT FICHERO2 ASSIGN TO FICHERO2 STATUS IS FS-FICHERO2. * SELECT SALIDA ASSIGN TO SALIDA STATUS IS FS-SALIDA. * * *================================================================* * D A T A D I V I S I O N * *================================================================* * DATA DIVISION. * *============ FILE SECTION. *============ * * Fichero de entrada FD FICHERO1 RECORDING MODE IS F BLOCK CONTAINS 0 RECORDS RECORD CONTAINS 20 CHARACTERS. 01 REG-FICHERO1 PIC X(20). * * Fichero de salida FD FICHERO2 RECORDING MODE IS F BLOCK CONTAINS 0 RECORDS RECORD CONTAINS 20 CHARACTERS. 01 REG-FICHERO2 PIC X(20). * Fichero de salida FD SALIDA RECORDING MODE IS F BLOCK CONTAINS 0 RECORDS RECORD CONTAINS 31 CHARACTERS. 01 REG-SALIDA PIC X(31). * * *======================= WORKING-STORAGE SECTION. *======================= * * ---------------------- * BANDERAS E INDICADORES * ---------------------- 01 WB-BANDERAS. 05 WB-FIN-FICHERO1 PIC X(1) VALUE 'N'. 88 FIN-FICHERO1 VALUE 'S'. * 05 WB-FIN-FICHERO2 PIC X(1) VALUE 'N'. 88 FIN-FICHERO2 VALUE 'S'. * 05 WB-FIN-TABLA PIC X(1) VALUE ' '. 88 FIN-TABLA VALUE 'S'. 88 NO-FIN-TABLA VALUE 'N'. * * * ------- * INDICES * ------- 01 WI-INDICES. 05 WI-INDICE PIC 9(6) COMP-4. * * * ----------------- * CAMPOS DE TRABAJO * ----------------- 01 WX-TRABAJO. 05 WX-CLV-FICHERO1. 10 WX-CLAVE1 PIC X(9). 05 WX-CLV-FICHERO2. 10 WX-CLAVE2 PIC X(9). 05 WX-CLAVE1-ANT 05 WX-CLAVE2-ANT PIC X(9). * --------------- * TABLAS * --------------- 01 WT-TABLAS. 05 WT-TABLA-FICHERO2 OCCURS 5 TIMES. 10 WT-CLAVE-FICHERO2 PIC X(9). 10 WT-CAMPO-FICHERO2 PIC X(11). * --------------- * FILE STATUS * --------------- 01 FS-STATUS. 05 FS-FICHERO1 PIC XX. 88 FS-FICHERO1-OK VALUE '00'. 88 FS-FICHERO1-EOF VALUE '10'. 05 FS-FICHERO2 PIC XX. 88 FS-FICHERO2-OK VALUE '00'. 88 FS-FICHERO2-EOF VALUE '10'. 05 FS-SALIDA PIC XX. 88 FS-SALIDA-OK VALUE '00'. 88 FS-SALIDA-EOF VALUE '10'. * * --------------------- * REGISTROS DE FICHEROS * --------------------- 01 WR-FICHERO1. 05 WR-FICHERO1-CLAVE PIC X(9). 05 WR-FICHERO1-CAMPO1 PIC X(11). 01 WR-FICHERO2. 05 WR-FICHERO2-CLAVE PIC X(9). 05 WR-FICHERO2-CAMPO2 PIC X(11). 01 WR-SALIDA. 05 WR-SALIDA-CLAVE PIC X(9). 05 WR-SALIDA-CAMPO1 PIC X(11). 05 WR-SALIDA-CAMPO2 PIC X(11). * *================================================================* * P R O C E D U R E D I V I S I O N * *================================================================* * PROCEDURE DIVISION. * ****************************************************************** * | 0000 - PRINCIPAL * *--|------------------+----------><----------+-------------------* ****************************************************************** 00000-PRINCIPAL. * *-> <1> * PERFORM 10000-INICIO * *-> <2> * PERFORM 20000-PROCESO UNTIL FIN-FICHERO1 OR FIN-FICHERO2 * *-> <3> * PERFORM 90000-FINAL . * ****************************************************************** * | 10000 - INICIO * ****************************************************************** 10000-INICIO. * INITIALIZE WX-TRABAJO WR-SALIDA * PERFORM 11000-ABRIR-FICHEROS * PERFORM LEER-FICHERO1 * * Control de Fichero de Entrada Vacio IF FS-FICHERO1-EOF DISPLAY 'FICHERO DE ENTRADA 1 VACIO' PERFORM 90000-FINAL END-IF * PERFORM LEER-FICHERO2 * * Control de Fichero de Entrada Vacio IF FS-FICHERO2-EOF DISPLAY 'FICHERO DE ENTRADA 2 VACIO' PERFORM 90000-FINAL END-IF MOVE WX-CLAVE1 TO WX-CLAVE1-ANT MOVE WX-CLAVE2 TO WX-CLAVE2-ANT MOVE 1 TO WI-INDICE2 PERFORM CARGAR-TABLA . * ****************************************************************** * 11000 - ABRIR FICHEROS * ****************************************************************** 11000-ABRIR-FICHEROS. * OPEN INPUT FICHERO1 OUTPUT FICHERO2 SALIDA * IF NOT FS-FICHERO1-OK DISPLAY 'ERROR EN OPEN DEL FICHERO FICHERO1:'FS-FICHERO1 PERFORM 90000-FINAL END-IF * IF NOT FS-FICHERO2-OK DISPLAY 'ERROR EN OPEN DEL FICHERO FICHERO2:'FS-FICHERO2 PERFORM 90000-FINAL END-IF * IF NOT FS-SALIDA-OK DISPLAY 'ERROR EN OPEN DEL FICHERO SALIDA:'FS-SALIDA PERFORM 90000-FINAL END-IF . * ****************************************************************** * | 20000 - PROCESO * *--|------------------+----------><----------+-------------------* * Escribiremos en el fichero de salida aquellos registros que * * existan en ambos ficheros. * ****************************************************************** 20000-PROCESO. * EVALUATE TRUE WHEN WX-CLV-FICHERO1 = WT-CLAVE-FICHERO2(1) * Bucle para cada registro del fichero 1 con misma clave PERFORM UNTIL WX-CLV-FICHERO1 NOT EQUAL WX-CLAVE1-ANT OR FIN-FICHERO1 * Bucle para cada registro del fichero 2 con la misma * clave (los tenemos en nuestra tabla interna) PERFORM UNTIL WI-INDICE2 > 5 OR (WT-CLAVE-FICHERO2(WI-INDICE2) EQUAL SPACES OR LOW-VALUES) OR FIN-FICHERO2 PERFORM INFORMAR-SALIDA PERFORM ESCRIBIR-SALIDA ADD 1 TO WI-INDICE2 END-PERFORM * Inicializamos el índice de la tabla interna * para recorrerla con el siguiente registro del * fichero 1 MOVE 1 TO WI-INDICE2 PERFORM LEER-FICHERO1 END-PERFORM * Guardamos la ultima clave del fichero 1 MOVE WX-CLAVE1 TO WX-CLAVE1-ANT PERFORM CARGAR-TABLA WHEN WX-CLV-FICHERO1 < WT-CLAVE2-TABLA(1) * La clave del fichero 1 no existe en el fichero 2 PERFORM LEER-FICHERO1 WHEN WX-CLV-FICHERO1 > WT-CLAVE2-TABLA(1) * La clave del fichero 2 no existe en el fichero 1 PERFORM LEER-FICHERO2 END-EVALUATE . * ****************************************************************** * CARGAR TABLA * ****************************************************************** CARGAR-TABLA. * MOVE 1 TO WI-INDICE * Guardamos todos los registros del fichero 2 que tengan la * misma clave PERFORM UNTIL WX-CLV-FICHERO2 NOT EQUAL WX-CLAVE2-ANT OR FIN-FICHERO2 MOVE WR-FICHERO2-CLAVE TO WT-CLAVE2-TABLA(WI-INDICE) MOVE WR-FICHERO2-CAMPO2 TO WT-CAMPO2-TABLA(WI-INDICE) PERFORM LEER-FICHERO2 ADD 1 TO WI-INDICE END-PERFORM * Guardamos la última clave del fichero 2 MOVE WX-CLAVE2 TO WX-CLAVE2-ANT . * ****************************************************************** * INFORMAR SALIDA * ****************************************************************** INFORMAR-SALIDA. * * Informamos el fichero de salida con la clave, el CAMPO1 * y el CAMPO2 MOVE WR-FICHERO1-CAMPO1 TO WR-SALIDA-CAMPO1 MOVE WT-CAMPO-FICHERO2(WI-INDICE2) TO WR-SALIDA-CAMPO2 MOVE WR-FICHERO1-CLAVE TO WR-SALIDA-CLAVE . * ****************************************************************** * | 90000 - FINAL * *--|------------------+----------><----------+-------------------* * | FINALIZA LA EJECUCION DEL PROGRAMA * * 1| Cierre de ficheros de programa * * 2| Finalización del Programa * ****************************************************************** 90000-FINAL. * PERFORM 91000-CERRAR-FICHEROS * STOP RUN . * ****************************************************************** * 91000 - CERRAR FICHEROS * ****************************************************************** 91000-CERRAR-FICHEROS. * CLOSE FICHERO1 FICHERO2 SALIDA * IF NOT FS-FICHERO1-OK DISPLAY 'ERROR EN CLOSE DEL FICHERO FICHERO1:'FS-FICHERO1 PERFORM 90000-FINAL END-IF * IF NOT FS-FICHERO2-OK DISPLAY 'ERROR EN CLOSE DEL FICHERO FICHERO2:'FS-FICHERO2 PERFORM 90000-FINAL END-IF * IF NOT FS-SALIDA-OK DISPLAY 'ERROR EN CLOSE DEL FICHERO SALIDA:'FS-SALIDA PERFORM 90000-FINAL END-IF . * ****************************************************************** * | LEER-FICHERO1 * *-----------------------------><---------------------------------* * | GUARDAMOS EL REGISTRO LEIDO EN LA VARIABLE WX-REG-XML * ****************************************************************** LEER-FICHERO1. * READ FICHERO1 INTO WR-FICHERO1 EVALUATE TRUE WHEN FS-FICHERO1-OK MOVE WR-FICHERO1-CLAVE TO WX-CLAVE1 WHEN FS-FICHERO1-EOF SET FIN-FICHERO1 TO TRUE MOVE HIGH-VALUES TO WX-CLAVE1 WHEN OTHER DISPLAY 'ERROR EN READ DEL FICHERO FICHERO1:'FS-FICHERO1 PERFORM 90000-FINAL END-EVALUATE . * ****************************************************************** * | ESCRIBIR-FICHERO2 * ****************************************************************** LEER-FICHERO2. * READ FICHERO2 INTO WR-FICHERO2 * EVALUATE TRUE WHEN FS-FICHERO2-OK MOVE WR-FICHERO2-CLAVE TO WX-CLAVE2 WHEN FS-FICHERO1-EOF SET FIN-FICHERO2 TO TRUE MOVE HIGH-VALUES TO WX-CLAVE2 WHEN OTHER DISPLAY 'ERROR EN READ DEL FICHERO FICHERO2:'FS-FICHERO2 PERFORM 90000-FINAL END-EVALUATE . * ****************************************************************** * | ESCRIBIR-SALIDA * ****************************************************************** ESCRIBIR-SALIDA. * WRITE REG-SALIDA FROM WR-SALIDA * IF FS-SALIDA-OK INITIALIZE WR-SALIDA ELSE DISPLAY 'ERROR EN READ DEL FICHERO RVISTAS:'FS-SALIDA PERFORM 90000-FINAL END-IF . * *================ Fin del Programa CRUCENN ================*