Ejemplo 7: ficheros VB (longitud variable)

En este ejemplo vamos a crear un programa que lee de un fichero de entrada de longitud fija y escriba en un fichero de salida de longitud variable.

JCL:

//******************************************************
//******************** BORRADO *************************
//BORRADO EXEC PGM=IDCAMS
//SYSPRINT DD SYSOUT=*
//SYSIN DD *
DEL FICHERO.DE.SALIDA
SET MAXCC = 0
//******************************************************
//*********** EJECUCION DEL PROGRAMA PRUEBA3 ***********
//P001 EXEC PGM=PRUEBA7
//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)),
//           DCB=(RECFM=VB,LRECL=107,BLKSIZE=0)
/*

En este caso volvemos a utilizar el IDCAMS para borrar el fichero de salida que se genera en el segundo paso. Se trata de 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 compartido al indicar DISP=SHR.
En la SYSOUT veremos los mensajes de error en caso de que los haya.
El fichero de salida se definirá como variable al indicar RECFM=VB, la longitud del fichero será la máxima que pueda tener (pues cada registro medirá diferente) indicada en LRECL=107.
Si sumamos las posiciones de la variable que define el fichero de salida en el programa, REG-SALIDA, veremos que suman 103. La razón de que se indique 107 en el JOB es que para los ficheros de longitud variable, el sistema reserva las 4 primeras posiciones para guardar la longitud, de ahí los 107 (103+4). Veremos más propiedades de los ficheros de longitud variable en otro artículo.


Fichero de entrada:
----+----1-
0000155501
0000155502
0000155503
0000255504
0000255505
0000355506
0000455507

Campo1: código de cliente
Campo2: código de producto

PROGRAMA:

 IDENTIFICATION DIVISION.
 PROGRAM-ID. PRUEBA7.
*=======================================================*
*     PROGRAMA QUE LEE DE FICHERO FB Y
*     ESCRIBE EN FICHERO VB
*=======================================================*
*
 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 10 CHARACTERS.
 01 REG-ENTRADA PIC X(10).
*
* Fichero de salida de longitud variable (V).
 FD SALIDA RECORDING MODE IS V
           BLOCK CONTAINS 0 RECORDS.

* Utilizando el depending on hacemos que el último campo

* tome diferentes longitudes dependiendo de REG-LONG
 01 REG-SALIDA.
    05 REG-CLIENTE PIC 9(5).
    05 REG-LONG    PIC 9(4) COMP-3.
    05 REG-PRODUCTO.
       10 PRODUCTO PIC X OCCURS 1 TO 95 TIMES
                DEPENDING ON REG-LONG.
*
 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 WI-PRODUCTO              PIC 9(3) COMP-3.
 01 WX-CLIENTE-ANT           PIC 9(5).
*
 01 WX-REGISTRO-ENTRADA.
    05 WX-ENT-CLIENTE        PIC 9(5).
    05 WX-ENT-PRODUCTO       PIC X(5).
*
 01 WX-REGISTRO-SALIDA.
    05 WX-SAL-PRODUCTO       PIC X(5) OCCURS 19 TIMES.
*
************************************************************
 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

     MOVE WX-ENT-CLIENTE TO WX-CLIENTE-ANT
     MOVE ZEROES         TO WI-PRODUCTO 
     .
*
************************************************************
*               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 DE ENTRADA:'FS-ENTRADA
     END-IF

     IF NOT FS-SALIDA-OK
        DISPLAY 'ERROR EN OPEN 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.
*
     IF WX-ENT-CLIENTE EQUAL WX-CLIENTE-ANT
*Para un mismo cliente, guardamos sus codigos de producto
        PERFORM 21000-GUARDAR-PRODUCTO 
     ELSE
*Al cambiar de cliente, escribimos el registro con 
*los productos del cliente anterior 
        PERFORM 22000-INFORMAR-SALIDA

        PERFORM ESCRIBIR-SALIDA
*Inicializamos las variables de trabajo       
        MOVE ZEROES         TO WI-PRODUCTO
        MOVE SPACES         TO WX-REGISTRO-SALIDA 
*Guardamos el siguiente cliente que vamos a tratar
        MOVE WX-ENT-CLIENTE TO WX-CLIENTE-ANT 
*Guardamos el codigo de producto del siguiente cliente
        PERFORM 21000-GUARDAR-PRODUCTO 

     END-IF

     PERFORM LEER-ENTRADA
     .
*
************************************************************
*                21000-GUARDAR-PRODUCTO
*--|------------------+----------><----------+-------------*
* GUARDAMOS EL CODIGO DE PRODUCTO PARA UN MISMO CLIENTE
* EN LA TABLA WX-REG-SALIDA
************************************************************
 21000-GUARDAR-PRODUCTO.
*
     ADD 1 TO WI-PRODUCTO
 
     MOVE WX-ENT-PRODUCTO 
       TO WX-SAL-PRODUCTO(WI-PRODUCTO)
     .
*
************************************************************
*                22000-INFORMAR-SALIDA
*--|------------------+----------><----------+-------------*
* INFORMAMOS LOS CAMPOS DEL FICHERO DE SALIDA
* 1 * COMO HEMOS CAMBIADO DE CLIENTE, REG-CLIENTE SERA EL
*     ALMACENADO EN WX-CLIENTE-ANT
* 2 * CALCULAMOS LA LONGITUD DE REG-PRODUCTO MULTIPLICANDO
*     EL NÚMERO DE PRODUCTOS ALMACENADOS POR SU LONGITUD (5)
* 3 * MOVEMOS LOS CODIGOS GUARDADOS EN WX-REGISTRO-SAL
*     A REG-PRODUCTO
************************************************************
 22000-INFORMAR-SALIDA.
*
*1*
        MOVE WX-CLIENTE-ANT TO REG-CLIENTE
*2*
        COMPUTE REG-LONG = WI-PRODUCTO * 5 
*3*
        MOVE WX-REGISTRO-SALIDA(1:REG-LONG)
          TO REG-PRODUCTO
     .
*
************************************************************
*                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

     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.
*
*Escribimos la información del último cliente
     PERFORM 22000-INFORMAR-SALIDA
     PERFORM ESCRIBIR-SALIDA 
*Cerramos ficheros    
     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
     .


Fichero de salida:
----+----1----+----2----+
00001  ¬555015550255503
FFFFF005FFFFFFFFFFFFFFF
0000101F555015550255503
-------------------------
00002   5550455505
FFFFF000FFFFFFFFFF
0000201F5550455505
-------------------------
00003  ¬55506
FFFFF005FFFFF
0000300F55506
-------------------------
00004  ¬55507
FFFFF005FFFFF
0000400F55507