lunes, 28 de febrero de 2011

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 : )

32 comentarios:

AzraHell dijo...

Buen Blog me ha ayudado mucho estos dias, apensa llevo una semana en Cobol, aunque aun no logro diregirir bien el ejemplo.

Saludos

Tallian dijo...

Si necesitas que te aclaremos el uso de alguna sentencia en concreto pregunta sin problemas!

Ignacio dijo...

Muy buena informacion. Me estan capacitando en COBOL en una empresa a la que acabo de ingresar y esto me aclaro varias dudas que tenia, aunque todavia me queda muchisimo por aprender.
Gracias por lo que hacen!!!

Tallian dijo...

De nada Ignacio! Cualquier consulta que tengas, no dudes en preguntar : )

Rakel dijo...

Mil gracias. Me ha ayudado mucho.

Tallian dijo...

Nos alegramos de que te haya sido útil Rakel.
Gracias por leernos!

Anónimo dijo...

Excelente publicación. Estoy aprendiendo cobol en la universidad y diria que es un complemento necesario el leer estos articulos. Felicitaciones.

Anónimo dijo...

Hay alguna manera de leer un fichero desde un jcl sin usar un programa? Saludos

Tallian dijo...

Todo depende de lo que quieras hacer con el fichero. Se pueden manejar desde JCL sin usar un programa y sin necesidad de "leerlos".
También se pueden manejar con Easytrieve.

Si nos dices lo que quieres hacer concretamos : )

Anónimo dijo...

un preguntita para que sirve este código por fa si me puedes ayudar es que necesito hacer una presentación sobres este código

Tallian dijo...

Está todo explicado en el texto del artículo. Este programa lee información de un fichero de entrada y la formatea para escribirla en un fichero de salida.

Anónimo dijo...

Buenas,

No me queda claro de donde salen los valores de WK-POSITIVO y WK-NEGATIVO, ya que veo que estos se mueven a WX-SAL-SIGNO pero no estan declarados en ninguna otra parte.

Tampoco me cuadran los valores de saldo y signo de saldo del fichero de salida, ya que en el fichero de entrada aparecen con 100A, 100B, 100K y 100M, y en el de salida salen como 1001positivo, 1002positivo, 1002negativo y 1004negativo.

Un saludo y muchas gracias de antemano.

Tallian dijo...

Hola anónimo.
Efectivamente estaban sin definir las constantes WK-POSITIVO y WK-NEGATIVO. Ya lo he puesto.
Sobre los valores del saldo:
Si te fijas, en el fichero de salida el campo del saldo no lleva signo, por lo que vuelve a aparecer el número.
La A equivale al 1 positivo, la B al 2 positivo, la K al 2 negativo y la M al 4 negativo.

La equivalencia la puedes ver en http://www.consultoriocobol.com/2011/01/working-storage-definiendo-variables.html

Gracias!

GURKO dijo...

super practico el programa, justo lo que necesitaba para poder editar un archivo que trae datos COMP-3 y visualizarlos como alfanumerico, asi exportarlo y poder trabajarlo.

muchas gracias nuevamente

El Coronel Gabilondo dijo...

Buenas,
¿que repercusión tiene no cerrar una validación en un reposicionamiento al leer-fichero?
IF SI-ERROR OR FIN-ENTRADA
CONTINUE
ELSE
PERFORM A120-LEER-FICH-ENTRADA THRU
A120-LEER-FICH-ENTRADA-EXIT.

Anónimo dijo...

Me ayudan con algun ejercicio de altas con un archivo secuencial!?

Gracias Sofia!!

Loboc dijo...

Hola Anónimo ¿te refieres a un programa que lea un archivo secuencial y de registros de alta en la base de datos?

Fernando dijo...

Me está sirviendo de mucha ayuda este consultorio. Se agradece de todo corazón. Gracias!

mimicha68 dijo...

saludos, si uso en un programa cobol la sentencia READ, tengo que usar la sentencia WITH NO LOCK, ??? como se usa o cuales o en que casos puedo o debo usar la sentencia WITH NO LOCK. ????

Efren Tellez dijo...

Hola, espero que me puedan ayudar lo que necesito es identificar el ultimo registro en un archivo mediante un JCL por ejemplo tengo el archivo:

aaaaaa,
bbbbbb,
cccccc,
bbbbbb,

Esto para escribir este registro en otro archivo y formatearlo, espero que me puedan ayuda.

De antemano Muchas gracias.

Tu papa dijo...

Sale error:
181: WX-TABLA-EMPRESAS not indexed
64: WX-TABLA-EMPRESAS defined here

Tu papa dijo...

Ya encontré el errorcito.

Saludos

FRANXIZKO dijo...

Estimado veo que hay un pequeño error en la sentencia

SEARCH WX-TABLA-EMPRESAS

deberia ser :

SEARCH WX-ELEMENTOS ya que tiene que recorrer la tabla, elemento por elemento.
saludos

Tallian dijo...

Gracias Franxizko!

coco dijo...

Buenas estoy muy perdido en cobol, necesito leer una base de datos con extension .dat, y no se como he probado varias cosas pero no me ha funcionado nada, el archivo no es legible desde notepad ya que no se que codificación lleva. ¿Podría alguien decirme algo?. Muchas gracias.

Fernando dijo...

Buenas, queria consultar, existe una forma de tomar los registros de un fichero para utilizarlos en una consulta dentro del mismo jcl, sin necesidad de hacer un programa

Tallian dijo...

Hola Fernando. Para ese caso lo mejor es hacer un easytrieve.
Puedes ver un ejemplo de easytrieve con db2 en
http://www.mvsforums.com/helpboards/viewtopic.php?t=478&highlight=easytrieve+db2

Saludos!

David dijo...

hola, no me compila el programa dice q wx-saldo no esta definido

David dijo...

YA ENCONTRE EL ERROR, EN EL MOVE DEL BUSCAR-SIGNO TENDRIA Q SER
MOVE WX-ENT-SALDO

Tallian dijo...

Corregido! Gracias!

Unknown dijo...

Muy bueno, gracias!

Unknown dijo...

¿Para qué se usa sentencia assign y qué pasa si no la pongo?