Programa ejemplo Entrada formateo y Salida

Codigo Cobol. Ejemplo de OBTENER DATOS DE FICHERO Y GENERAR FICHERO DE 

 SALIDA.

Nota: si lo van a utilizar deben correrlo 5 espacios a la derecha al código. Ya que debe de estar en la columna 7.

* IDENTIFICATION DIVISION. ************************* PROGRAM-ID. ADCDFP2. * ****************************************************************** * * * HISTORIAL DE MODIFICACIONES * * --------------------------- * * * *----------------------------------------------------------------* * * * AUTOR : PERRO COBOLERO * * FECHA : 14/01/15 * * COMENTARIOS DE LA MODIFICACION : FICHERO DE SALIDA * * * ****************************************************************** ****************************************************************** ENVIRONMENT DIVISION. ****************************************************************** CONFIGURATION SECTION. *---------------------- SPECIAL-NAMES. DECIMAL-POINT IS COMMA. * INPUT-OUTPUT SECTION. *--------------------- FILE-CONTROL. SELECT FICHEROE ASSIGN TO FICHEROE FILE STATUS IS FS-ENTRADA. * SELECT FICHEROS ASSIGN TO FICHEROS FILE STATUS IS FS-SALIDA. *

****************************************************************** DATA DIVISION. ****************************************************************** FILE SECTION. *------------- FD FICHEROE RECORDING MODE IS F BLOCK 0 CHARACTERS LABEL RECORD STANDARD. 01 REG-FE. 02 NOMBRE PIC X(20). 02 APELLIDO PIC X(20). 02 EDAD PIC 9(2). FD FICHEROS RECORDING MODE IS F BLOCK 0 CHARACTERS LABEL RECORD STANDARD. 01 REG-FS PIC X(42). *

****************************************************************** WORKING-STORAGE SECTION. ****************************************************************** ****************************************************************** * CAMPOS WORKING * ****************************************************************** * * * ****************************************************************** ** L I T E R A L E S ** ****************************************************************** * 01 LINEA PIC X(42) VALUE ALL '-'. * 01 ENCABEZADO. 02 NOME PIC X(12) VALUE 'NOMBRE'. 02 FILLER PIC X(02) VALUE SPACE. 02 APEE PIC X(12) VALUE 'APELLIDO'. 02 FILLER PIC X(02) VALUE SPACE. 02 EDADE PIC X(05) VALUE 'EDAD'. * 01 PIE-PAG. 02 MSG PIC X(28) VALUE 'CANTIDAD DE REGISTRO LEIDOS:'.. 02 CONTADOR PIC 9(2). * 01 DETALLE. 02 NOMD PIC X(12). 02 FILLER PIC X(02) VALUE SPACES. 02 APED PIC X(12). 02 FILLER PIC X(02) VALUE SPACES. 02 EDAD1 PIC 9(02). * 01 IMPRIMIR PIC X(42). ****************************************************************** * SWITCHES * ****************************************************************** * 01 SW-FIN-FICHEROE PIC X(01) VALUE 'N'. 88 SI-FIN-E1 VALUE 'S'. 88 NO-FIN-E1 VALUE 'N'. * 01 FS-FILE-STATUS. 05 FS-ENTRADA PIC X(02) VALUE '00'. 88 FS-ENTRADA-OK VALUE '00'. 88 FS-ENTRADA-END VALUE '10'. 05 FS-SALIDA PIC X(02) VALUE '00'. 88 FS-SALIDAs-OK VALUE '00'. * 01 SW-ERROR-FICHERO PIC X(01) VALUE 'N'. 88 SW-SI-ERROR VALUE 'S'. 88 SW-NO-ERROR VALUE 'N'. * ****************************************************************** PROCEDURE DIVISION. ****************************************************************** * PERFORM 1000-INICIO THRU 1000-INICIO-EXIT * PERFORM 2000-PROCESO THRU 2000-PROCESO-EXIT UNTIL SI-FIN-E1 * PERFORM 3000-FIN THRU 3000-FIN-EXIT. * ****************************************************************** * 1000-INICIO * * - INICIALIZA VARIABLES DE WORKING * * - ABRE LOS FICHEROS * * - LEE LAS ENTRADAS, EN CASO DE FICHERO VACIO ERROR. * ****************************************************************** 1000-INICIO. * SET SW-NO-ERROR TO TRUE SET NO-FIN-E1 TO TRUE * PERFORM 1200-ABRIR-FICHEROS THRU 1200-ABRIR-FICHEROS-EXIT * PERFORM 9000-LEER-ENTRADA1 THRU 9000-LEER-ENTRADA1-EXIT * IF SI-FIN-E1 DISPLAY ' ' DISPLAY '=============================' DISPLAY ' ERROR FICHERO FQY721E1 VACIO' DISPLAY '=============================' END-IF MOVE 1 TO CONTADOR PERFORM ENCABEZAR. * 1000-INICIO-EXIT. EXIT. * ****************************************************************** * 1200-ABRIR-FICHEROS * * - ABRE LOS FICHEROS DE ENTRADA Y SALIDA * * - REALIZA EL CONTROL DE FILE STATUS DE AMBOS FICHEROS EN EL * * PROCESO DE APERTURA. * ****************************************************************** 1200-ABRIR-FICHEROS. * OPEN INPUT FICHEROE. OPEN OUTPUT FICHEROS. * IF FS-ENTRADA NOT EQUAL '00' DISPLAY '****************************' DISPLAY 'ERROR AL ABRIR FICHERO ENTRADA' DISPLAY 'FILE STATUS: ' FS-ENTRADA DISPLAY '****************************' SET SW-SI-ERROR TO TRUE PERFORM 3000-FIN THRU 3000-FIN-EXIT END-IF * IF FS-SALIDA NOT = '00' DISPLAY '****************************' DISPLAY 'ERROR AL ABRIR FICHERO SALIDA' DISPLAY 'FILE STATUS: ' FS-SALIDA DISPLAY '****************************' SET SW-SI-ERROR TO TRUE PERFORM 3000-FIN THRU 3000-FIN-EXIT END-IF. * 1200-ABRIR-FICHEROS-EXIT. EXIT. * ****************************************************************** * 2000-PROCESO * * SE PROCESA LOS PLANES DE PENSIONES, FONDOS DE INVERSION Y * * VALORES EXISTENTES EN EL FICHERO DE ENTRADA. * ****************************************************************** 2000-PROCESO. * PERFORM 2200-INFORMAR-SALIDA1 THRU 2200-INFORMAR-SALIDA1-EXIT PERFORM 9100-ESCRIBIR-SALIDA THRU 9100-ESCRIBIR-SALIDA-EXIT PERFORM 9000-LEER-ENTRADA1 THRU 9000-LEER-ENTRADA1-EXIT. * 2000-PROCESO-EXIT. EXIT. * ****************************************************************** * 2200-INFORMAR-SALIDA1 * * - SE INFORMAN LOS CAMPOS DE SALIDA CON LOS DATOS DE ENTRADA * ****************************************************************** * ENCABEZAR. MOVE LINEA TO IMPRIMIR PERFORM 9100-ESCRIBIR-SALIDA MOVE ENCABEZADO TO IMPRIMIR PERFORM 9100-ESCRIBIR-SALIDA MOVE LINEA TO IMPRIMIR PERFORM 9100-ESCRIBIR-SALIDA. * PIE-DE-PAGINA. MOVE LINEA TO IMPRIMIR PERFORM 9100-ESCRIBIR-SALIDA MOVE PIE-PAG TO IMPRIMIR PERFORM 9100-ESCRIBIR-SALIDA MOVE LINEA TO IMPRIMIR PERFORM 9100-ESCRIBIR-SALIDA. 2200-INFORMAR-SALIDA1. PERFORM MOVER-REGISTRO. * 2200-INFORMAR-SALIDA1-EXIT. EXIT. ****************************************************************** * 3000-FIN * * - MUESTRA ESTADISTICAS * * - CIERRA FICHEROS * * - FINALIZA LA EJECUCION DEL PROCESO. * ****************************************************************** 3000-FIN. * PERFORM 3100-ESTADISTICAS THRU 3100-ESTADISTICAS-EXIT * PERFORM PIE-DE-PAGINA * IF SW-NO-ERROR PERFORM 3200-CERRAR-FICHEROS THRU 3200-CERRAR-FICHEROS-EXIT END-IF * STOP RUN. * 3000-FIN-EXIT. EXIT. * ****************************************************************** * 3100-ESTADISTICAS * * SE GENERAN LAS ESTADISTICAS DEL PROCESO, INDICANDO EN NUMERO * * DE REGISTROS LEIDOS Y ESCRITOS. * ****************************************************************** 3100-ESTADISTICAS. DISPLAY 'REGISTROS LEIDOS: ' CONTADOR. * 3100-ESTADISTICAS-EXIT. EXIT. * ****************************************************************** * 3200-CERRAR-FICHEROS * * - CIERRA LOS FICHEROS DE ENTRADA Y SALIDA * * - REALIZA EL CONTROL DE FILE STATUS DE AMBOS FICHEROS EN EL * * PROCESO DE CIERRE. * ****************************************************************** 3200-CERRAR-FICHEROS. * CLOSE FICHEROE. CLOSE FICHEROS. * IF FS-ENTRADA NOT EQUAL '00' DISPLAY '*******************************' DISPLAY 'ERROR AL CERRAR FICHERO ENTRADA' DISPLAY 'FILE STATUS: ' FS-ENTRADA DISPLAY '*******************************' END-IF. IF FS-SALIDA NOT EQUAL '00' DISPLAY '******************************' DISPLAY 'ERROR AL CERRAR FICHERO SALIDA' DISPLAY 'FILE STATUS: ' FS-SALIDA DISPLAY '******************************' END-IF. * 3200-CERRAR-FICHEROS-EXIT. EXIT. * ****************************************************************** * 9000-LEER-ENTRADA1 * * - LEE EL FICHERO DE ENTRADA * * - SI ES FIN DE FICHERO ACTIVA SWITCH DE FIN DE FICHERO * * - SINO ES FIN DE FICHERO INCREMENTA CONTADOR DE REG. LEIDOS * * - EN CASO DE ERROR SE INFORMAN LAS VARIABLES DEL ERROR Y * * FINALIZA EL PROCESO. * ****************************************************************** 9000-LEER-ENTRADA1. * READ FICHEROE AT END SET SI-FIN-E1 TO TRUE END-READ * EVALUATE TRUE WHEN FS-ENTRADA-END CONTINUE WHEN FS-ENTRADA-OK ADD 1 TO CONTADOR WHEN OTHER DISPLAY '*****************************' DISPLAY 'ERROR AL LEER FICHERO ENTRADA' DISPLAY 'FILE STATUS: ' FS-ENTRADA DISPLAY '*****************************' PERFORM 3000-FIN THRU 3000-FIN-EXIT END-EVALUATE. * 9000-LEER-ENTRADA1-EXIT. EXIT. * ****************************************************************** * 9100-ESCRIBIR-SALIDA * * - ESCRIBE EN EL FICHERO DE SALIDA EL CONTENIDO DE LA COPY * * - INCREMENTA EL CONTADOR DE REGISTROS ESCRITOS * * - EN CASO DE ERROR SE INFORMAN LAS VARIABLES DEL ERROR Y * * FINALIZA EL PROCESO. ****************************************************************** MOVER-REGISTRO. MOVE NOMBRE TO NOMD MOVE APELLIDO TO APED MOVE EDAD TO EDAD1 MOVE DETALLE TO IMPRIMIR. * 9100-ESCRIBIR-SALIDA. * WRITE REG-FS FROM IMPRIMIR. * IF FS-SALIDA NOT EQUAL '00' DISPLAY '********************************' DISPLAY 'ERROR AL ESCRIBIR FICHERO SALIDA' DISPLAY 'FILE STATUS: ' FS-SALIDA DISPLAY '********************************' PERFORM 3000-FIN THRU 3000-FIN-EXIT END-IF. * 9100-ESCRIBIR-SALIDA-EXIT. EXIT.