Ejemplo 3: leer de fichero y escribir en fichero.

Para este ejemplo crearemos un programa que lea un fichero de entrada, formatee la información y escriba en un fichero de salida.

JCL:

//******************************************************
//******************** BORRADO *************************
//BORRADO EXEC PGM=IDCAMS
//SYSPRINT DD SYSOUT=*
//SYSIN DD *
DEL FICHERO.DE.SALIDA
SET MAXCC = 0
//******************************************************
//*********** EJECUCION DEL PROGRAMA PRUEBA3 ***********
//PROG3 EXEC PGM=PRUEBA3
//SYSOUT DD SYSOUT=*
//ENTRADA DD DSN=FICHERO.DE.ENTRADA,DISP=SHR
//SALIDA DD DSN=FICHERO.DE.SALIDA,
// DISP=(NEW, CATLG, DELETE),SPACE=(TRK,(50,10))
/*

En este caso volvemos a utilizar el IDCAMS para borrar el fichero de salida que se genera en el segundo paso. Sigue siendo un programa sin DB2, así que utilizamos el EXEC PGM.
Para definir el fichero de entrada "ENTRADA" indicaremos que es un fichero ya existente y compartida al indicar DISP=SHR.
En la SYSOUT veremos los mensajes de error en caso de que los haya.

Fichero de entrada:
----+----1----+
11111AA100A
22222BB100B
33333CC100K
44444DD100M

campo1: número de cliente
campo2: código de empresa
campo3: saldo


PROGRAMA:

 IDENTIFICATION DIVISION.
 PROGRAM-ID. PRUEBA3.
*==========================================================*
*     PROGRAMA QUE LEE DE FICHERO Y ESCRIBE EN FICHERO
*==========================================================*
*
 ENVIRONMENT DIVISION.
*
 CONFIGURATION SECTION.
*
 SPECIAL-NAMES.
     DECIMAL-POINT IS COMMA.
*
 INPUT-OUTPUT SECTION.
*
 FILE-CONTROL.
*
 SELECT ENTRADA ASSIGN TO ENTRADA
                STATUS IS FS-ENTRADA.
 SELECT SALIDA ASSIGN TO SALIDA
                STATUS IS FS-SALIDA.
*
 DATA DIVISION.
*
 FILE SECTION.
*
* Fichero de entrada de longitud fija (F) igual a 11.
 FD ENTRADA RECORDING MODE IS F
            BLOCK CONTAINS 0 RECORDS
            RECORD CONTAINS 11 CHARACTERS.
 01 REG-ENTRADA PIC X(11).
*
* Fichero de salida de longitud fija (F) igual a 28.
 FD SALIDA RECORDING MODE IS F
           BLOCK CONTAINS 0 RECORDS
           RECORD CONTAINS 28 CHARACTERS.
 01 REG-SALIDA PIC X(28).
*
 WORKING-STORAGE SECTION.
* FILE STATUS
 01 FS-STATUS.
    05 FS-ENTRADA        PIC X(2).
       88 FS-ENTRADA-OK          VALUE '00'.
       88 FS-FICHERO1-EOF          VALUE '10'.
    05 FS-SALIDA         PIC X(2).
       88 FS-SALIDA-OK           VALUE '00'.
*
* VARIABLES
 01 WB-FIN-ENTRADA           PIC X(1) VALUE 'N'.
    88 FIN-ENTRADA                    VALUE 'S'.
*
 01 WB-SIGNOS               PIC X.
    88 SIGNO-MAS                      VALUE 'A', 'B',
                                            'C', 'D',
                                            'E', 'F',
                                            'G', 'H',
                                            'I', '{'.
    88 SIGNO-MENOS                    VALUE 'J', 'K',
                                            'L', 'M',
                                            'N', 'O',
                                            'P', 'Q',
                                            'R', '}'.

 01 WX-TABLA-EMPRESAS.
    05                       PIC X(11) VALUE 'AAEMPRESA 1'.
    05                       PIC X(11) VALUE 'BBEMPRESA 2'.
    05                       PIC X(11) VALUE 'CCEMPRESA 3'.
    05                       PIC X(11) VALUE 'DDEMPRESA 4'.
 01 REDEFINES WX-TABLA-EMPRESAS.
    05 WX-ELEMENTOS OCCURS 4 TIMES
                    INDEXED BY WI-ELEM.
       10 WX-CODIGO-EMPRESA  PIC X(2).
       10 WX-NOMBRE-EMPRESA  PIC X(9).
*
 01 WX-REGISTRO-ENTRADA.
    05 WX-ENT-CLIENTE        PIC 9(5).
    05 WX-ENT-COD-EMPRESA    PIC X(2).
    05 WX-ENT-SALDO          PIC S9(4).
*
 01 WX-REGISTRO-SALIDA.
    05 WX-SAL-CLIENTE        PIC 9(5).
    05 WX-SAL-COD-EMPRESA    PIC X(2).
    05 WX-SAL-NOMBRE-EMPRESA PIC X(9).
    05 WX-SAL-SALDO          PIC 9(4).
    05 WX-SAL-SIGNO          PIC X(8).
* CONSTANTES
 01 WK-POSITIVO              PIC X(8)  VALUE 'positivo'.
 01 WK-NEGATIVO              PIC X(8)  VALUE 'negativo'.
*
************************************************************
 PROCEDURE DIVISION.
************************************************************
*  |     0000 - PRINCIPAL
*--|------------------+----------><----------+-------------*
* 1| EJECUTA EL INICIO DEL PROGRAMA
* 2| EJECUTA EL PROCESO DEL PROGRAMA
* 3| EJECUTA EL FINAL DEL PROGRAMA
************************************************************
 00000-PRINCIPAL.
*
     PERFORM 10000-INICIO
*
     PERFORM 20000-PROCESO
        UNTIL FIN-ENTRADA
*
     PERFORM 30000-FINAL
     .
************************************************************
*  |     10000 - INICIO
*--|------------+----------><----------+-------------------*
*  | SE REALIZA EL TRATAMIENTO DE INICIO:
* 1| Inicialización de Áreas de Trabajo
* 2| Primera lectura de SYSIN
************************************************************
 10000-INICIO.
*
     INITIALIZE WX-REGISTRO-SALIDA

     PERFORM 11000-ABRIR-FICHERO

     PERFORM LEER-ENTRADA

     IF FIN-ENTRADA
        DISPLAY 'FICHERO DE ENTRADA VACIO'

        PERFORM 30000-FINAL
     END-IF
     .
*
************************************************************
*               11000 - ABRIR FICHEROS
*--|------------------+----------><----------+-------------*
* Abrimos los ficheros del programa
************************************************************
 11000-ABRIR-FICHEROS.
*
     OPEN INPUT ENTRADA
         OUTPUT SALIDA
*
     IF NOT FS-ENTRADA-OK
        DISPLAY 'ERROR EN OPEN DEL FICHERO DE ENTRADA:'FS-ENTRADA
     END-IF

     IF NOT FS-SALIDA-OK
        DISPLAY 'ERROR EN OPEN DEL FICHERO DE SALIDA:'FS-SALIDA
     END-IF
     .
*
************************************************************
*  |     20000 - PROCESO
*--|------------------+----------><------------------------*
*  | SE REALIZA EL TRATAMIENTO DE LOS DATOS:
* 1| Realiza el tratamiento de cada registro recuperado de
*  | la ENTRADA
************************************************************
 20000-PROCESO.
*
     PERFORM 21000-BUSCAR-NOMBRE-EMPRESA

     PERFORM 22000-BUSCAR-SIGNO-SALDO

     PERFORM 23000-INFORMAR-SALIDA

     PERFORM ESCRIBIR-SALIDA

     PERFORM LEER-ENTRADA
     .
*
************************************************************
*               21000 - BUSCAR NOMBRE EMPRESA
*--|------------------+----------><----------+-------------*
* BUSCAMOS EL CODIGO DE EMPRESA DEL FICHERO DE ENTRADA EN
* NUESTRA TABLA INTERNA PARA RECUPERAR EL NOMBRE
************************************************************
 21000-BUSCAR-NOMBRE-EMPRESA.
*
*Ponemos el índice WI-ELEM a 1 y se irá incrementando de 1 en 1
     SET WI-ELEM TO 1
*Buscamos en WX-TABLA-EMPRESAS el nombre de empresa que tenga
*el mismo código que el del fichero de entrada.
*Si no lo encuentra, movemos espacios al nombre de la empresa
     SEARCH WX-ELEMENTOS
        AT END
           MOVE SPACES TO WX-SAL-NOMBRE-EMPRESA

        WHEN WX-CODIGO-EMPRESA(WI-ELEM) EQUAL WX-ENT-COD-EMPRESA
          MOVE WX-NOMBRE-EMPRESA(WI-ELEM)  
            TO WX-SAL-NOMBRE-EMPRESA

     END-SEARCH

     .
*
************************************************************
*                22000-BUSCAR-SIGNO-SALDO
*--|------------------+----------><----------+-------------*
* COMPROBAMOS EL SIGNO DEL SALDO E INFORMAMOS EL CAMPO:
* WX-SAL-SIGNO
************************************************************
 22000-BUSCAR-SIGNO-SALDO.
*
*El signo viene dado por la última posición. La movemos al
*switch WB-SIGNOS. Según su valor informará positivo o negativo
     MOVE WX-ENT-SALDO(4:1)       TO WB-SIGNOS

     EVALUATE TRUE
        WHEN SIGNO-MAS
             MOVE WK-POSITIVO TO WX-SAL-SIGNO

        WHEN SIGNO-MENOS
             MOVE WK-NEGATIVO TO WX-SAL-SIGNO

        WHEN OTHER
             MOVE SPACES      TO WX-SAL-SIGNO
     END-EVALUATE
     .
*
************************************************************
*                23000-INFORMAR-SALIDA
*--|------------------+----------><----------+-------------*
* INFORMAMOS EL RESTO DE CAMPOS DEL FICHERO DE SALIDA
************************************************************
 23000-INFORMAR-SALIDA.
*
     MOVE WX-ENT-CLIENTE     TO WX-SAL-CLIENTE
     MOVE WX-ENT-COD-EMPRESA TO WX-SAL-COD-EMPRESA
     MOVE WX-ENT-SALDO       TO WX-SAL-SALDO
     .
*
************************************************************
*                LEER ENTRADA
*--|------------------+----------><----------+-------------*
* Leemos del fichero de entrada
************************************************************
 LEER-ENTRADA.
*
     READ ENTRADA INTO WX-REGISTRO-ENTRADA

     EVALUATE TRUE
        WHEN FS-ENTRADA-OK
             CONTINUE

        WHEN FS-ENTRADA-EOF
             SET FIN-ENTRADA TO TRUE

        WHEN OTHER
             DISPLAY 'ERROR EN READ DE ENTRADA:'FS-ENTRADA
     END-EVALUATE
     .
*
************************************************************
*                - ESCRIBIR SALIDA
*--|------------------+----------><----------+-------------*
* ESCRIBIMOS EN EL FICHERO DE SALIDA LA INFORMACION GUARDADA
* WX-REGISTRO-SALIDA
************************************************************
  ESCRIBIR-SALIDA.
*
     WRITE REG-SALIDA FROM WX-REGISTRO-SALIDA

     IF FS-SALIDA-OK
        INITIALIZE WX-REGISTRO-SALIDA
     ELSE
        DISPLAY 'ERROR EN WRITE DEL FICHERO:'FS-SALIDA
     END-IF

     .
*
************************************************************
*  |     30000 - FINAL
*--|------------------+----------><----------+-------------*
*  | FINALIZA LA EJECUCION DEL PROGRAMA
************************************************************
 30000-FINAL.
*
     PERFORM 31000-CERRAR-FICHEROS

     STOP RUN
     .
*
************************************************************
*  |     31000 - CERRAR FICHEROS
*--|------------------+----------><----------+-------------*
*  | CERRAMOS LOS FICHEROS DEL PROGRAMA
************************************************************
 31000-CERRAR-FICHEROS.
*
     CLOSE ENTRADA
           SALIDA

     IF NOT FS-ENTRADA-OK
        DISPLAY 'ERROR EN CLOSE DE ENTRADA:'FS-ENTRADA
     END-IF


     IF NOT FS-SALIDA-OK
        DISPLAY 'ERROR EN CLOSE DE SALIDA:'FS-SALIDA
     END-IF
     .


En el programa podemos ver las siguientes divisiones/secciones:
IDENTIFICATION DIVISION: existirá siempre.
ENVIRONMENT DIVISION: existirá siempre.
  CONFIGURATION SECTION: existirá siempre.
  INPUT-OUTPUT SECTION: en este ejemplo existirá porque utilizamos un fichero de entrada y uno de salida.
DATA DIVISION: existirá siempre.
  FILE SECTION: en este ejemplo existirá pues utilizamos un fichero de entrada y uno de salida.
  WORKING-STORAGE SECTION: exisitirá siempre.
  En este caso no exisistirá la LINKAGE SECTION pues el programa no se comunica con otros programas.
PROCEDURE DIVISION: exisitirá siempre.


En el programa podemos ver las siguientes sentencias:
PERFORM: llamada a párrafo
INITIALIZE: para inicializar variable
OPEN: "Abre" los ficheros del programa. Lo acompañaremos de "INPUT" para los ficheros de entrada y "OUTPUT" para los ficheros de salida.
DISPLAY: escribe el contenido del campo indicado en la SYSOUT del JCL.
MOVE/TO: movemos la información de un campo a otro.
SEARCH: esta sententencia se utiliza para buscar un dato dentro de una tabla interna, recorriéndola usándo un índice y comparando alguno de sus campos con el campo que buscamos.
PERFORM UNTIL: bucle
SET:Activa los niveles 88 de un campo tipo "switch".
READ: Lee cada registro del fichero de entrada. En el "INTO" le indicamos donde debe guardar la información.
WRITE: Escribe la información indicada en el "FROM" en el fichero indicado.
STOP RUN: sentencia de finalización de ejecución.
CLOSE: "Cierra" los ficheros del programa.

Descripción del programa:
En el párrafo de inicio, inicializamos el registro de salida: WX-REGISTRO-SALIDA
Abriremos los ficheros del programa (OPEN INPUT para la enrtada, y OUTPUT para la salida) y controlaremos el file-status. Si todo va bien el código del file-status valdrá '00'. Podéis ver la lista de los file-status más comunes.
Además comprobamos que el fichero de entrada no venga vacío (en caso de que así sea, finalizamos la ejecución).

En el párrafo de proceso, que se repetirá hasta que se termine el fichero de entrada (FIN-ENTRADA), tenemos varias llamadas a párrafos:

21000-BUSCAR-NOMBRE-EMPRESA:
Busca en la taba interna WX-TABLA-EMPRESAS utilizando la sentencia SEARCH.

22000-BUSCAR-SIGNO-SALDO:
La última posición del campo saldo (S9(4)) nos indica el signo. Podéis ver la referencia a los signos en campos numéricos.
Guardaremos esa última posición en el nivel superior de un campo tipo switch (WB-SIGNOS). Si el valor se corresponde con alguno de los indicados en los niveles 88, ese nivel se activará a "TRUE".
En el "EVALUATE TRUE", el programa entrará por la sentencia "WHEN" que esté activa (que sea "TRUE").

23000-INFORMAR-SALIDA:
Informamos el resto de campos.

ESCRIBIR-SALIDA:
Escribimos nuestro registro ya informado en el fichero de salida.

LEER-ENTRADA:
Leemos el siguiente registro del fichero de entrada.

Fichero de salida:
----+----1----+----2----+----3
11111AAEMPRESA 11001positivo
22222BBEMPRESA 21002positivo
33333CCEMPRESA 31002negativo
44444DDEMPRESA 41004negativo

campo1: número de cliente
campo2: código de empresa
campo3: nombre de empresa
campo4: saldo
campo5: signo del saldo

En este programa además de ver como crear un PROCESO que trate todos los registros de un fichero de entrada, hemos visto varias sentencias como el EVALUATE y el SEARCH. Así aprovechamos para ir introduciendo más sentencias útiles del COBOL en forma de ejemplos.
Y si os queda cualquier duda, estamos aquí para resolverlas : )