Alocar ficheros dinámicamente con BPXWDYN

Hoy os traigo un ejemplo de cómo generar dinámicamente ficheros de salida a través de un programa cobol.
El BPXWDYN es una rutina del sistema, capaz de alocar/liberar/concatenar ficheros en una ejecución batch.

En este ejemplo, el programa lee de un fichero de entrada con N registros, y genera N ficheros de salida.
Para la nomenclatura, hemos utilizado un contador en uno de los delimitadores.

La utilidad? Imagina que tienes un fichero de entrada con 1 millón de registros, y tienes que generar un fichero de salida por cada uno de ellos (osea, 1 millón de ficheros). Vas a picarte el nombre de los ficheros a mano en el JCL? Además de que puede que no sepas el número exacto de registros que va a tener ese fichero, pues varíe cada día.
En fin, por si algún día os veis en la situación, aquí lo tenéis :-)

JCL:
//PASO01 EXEC PGM=PRUEBDYN
//ENTRADA   DD DSN=FICHERO.DE.ENTRADA,DISP=SHR
//SYSOUT   DD SYSOUT=*
//SYSTSPRT DD SYSOUT=*
//SYSPRINT DD SYSOUT=*

donde EXEC PGM= indica el programa SIN DB2 que vamos a ejecutar
SYSOUT DD SYSOUT=* indica que la información "displayada" se quedará en la cola del SYSOUT (no lo vamos a guardar en un fichero)
Para definir el fichero de entrada "ENTRADA" indicaremos que es un fichero ya existente y compartida al indicar DISP=SHR.

Fichero de entrada:
----+----1----+
REGISTRO1
REGISTRO2
REGISTRO3
REGISTRO4



PROGRAMA:

 IDENTIFICATION DIVISION.
 PROGRAM-ID. PRUEBDYN.
*==========================================================*
*     PROGRAMA QUE LEE DE FICHERO Y GENERA DINAMICAMENTE
*     VARIOS FICHEROS DE SALIDA
*==========================================================*
 ENVIRONMENT DIVISION.
*
 CONFIGURATION SECTION.
*
 SPECIAL-NAMES.
     DECIMAL-POINT IS COMMA.
* 
 INPUT-OUTPUT SECTION.
*
 FILE-CONTROL. 
*ENTRADA
 SELECT ENTRADA
 ASSIGN TO ENTRADA
 FILE STATUS IS FS-ENTRADA.
*SALIDA
 SELECT OTFILE ASSIGN TO OTFILE
 FILE STATUS FS.
*
 DATA DIVISION.
*
 FILE SECTION. 
*ENTRADA
 FD ENTRADA
 LABEL RECORD STANDARD
 BLOCK CONTAINS 0 RECORDS
 RECORDING MODE IS F.
 01 REG-ENTRADA PIC X(80).
*SALIDA
 FD OTFILE.
 01 OT-REC PIC X(80).
*******************************************************

 WORKING-STORAGE SECTION.
 01 FS PIC X(02).
 01 FN PIC X(20).
 01 WS-ALLOC-STRING PIC X(100).
 01 PGM PIC X(08) VALUE 'BPXWDYN'.

 01 WS-VARIABLES.
    05 SW-FIN-ENTRADA PIC X(01) VALUE 'N'.
       88 FIN-ENTRADA VALUE 'S'.
       88 NO-FIN-ENTRADA VALUE 'N'.
    05 FS-ENTRADA PIC X(02).
    05 WS-ENTRADA PIC X(80).
    05 WS-NOMBRE-SALIDA.
       10 WS-PARTE-FIJA PIC X(13) VALUE
                                  'PARTE.COMUN.F'.
       10 WS-VARIABLE PIC 9(7).
    05 WS-LIBERAR PIC X(15) VALUE 'FREE FI(OTFILE)'.
******************************************************
 PROCEDURE DIVISION.
******************************************************

     PERFORM 100000-INICIO
     PERFORM 200000-PROCESO
       UNTIL FIN-ENTRADA
     PERFORM 300000-FIN
     .

*TRATO FICHERO DE ENTRADA
 100000-INICIO.
     OPEN INPUT ENTRADA

     IF FS-ENTRADA NOT EQUAL '00'
        DISPLAY 'ERROR AL LEER'
        PERFORM 300000-FIN
     END-IF

     PERFORM 110000-LEER
     .
*LEER FICHERO
 110000-LEER.
     READ ENTRADA INTO WS-ENTRADA

     EVALUATE FS-ENTRADA
         WHEN CTA-FS-CORRECTO
*Añadimos 1 a WS-VARIABLE para generar los diferentes
*nombres del fichero de salida
              ADD 1 TO WS-VARIABLE
          WHEN CTA-FS-FIN-FICHERO
              SET FIN-ENTRADA TO TRUE
          WHEN OTHER
              DISPLAY 'ERROR AL LEER'
              PERFORM 300000-FIN
    END-EVALUATE
    .

********************************************************
* PROCESO DEL PROGRAMA
* 1-MONTAMOS EL NOMBRE DEL FICHERO DE SALIDA
* 2-LLAMAMOS A BPXWDYN PARA ALOCAR
* 3-ESCRIBIMOS EN EL FICHERO DE SALIDA Y LO CERRAMOS
* 4-LLAMAMOS A BPXWDYN PARA LIBERAR EL FICHERO DE SALIDA
********************************************************
 200000-PROCESO.

    MOVE WS-NOMBRE-SALIDA TO FN

    STRING 'ALLOC DD(OTFILE) DSN(' FN ') NEW '
             'CATALOG ' 'LRECL(80) RECFM(FB)'
    DELIMITED BY SIZE
    INTO WS-ALLOC-STRING

*LLAMO AL PROGRAMA RARO
    CALL PGM USING WS-ALLOC-STRING

    DISPLAY 'SALIDA PGM:' RETURN-CODE
*ABRO FICHERO SALIDA
    OPEN OUTPUT OTFILE

    IF FS NOT EQUAL '00'
       DISPLAY 'ERROR AL ABRIR SALIDA:' FS
    END-IF

*ESCRIBO EN EL FICHERO
    MOVE WS-ENTRADA TO OT-REC

    WRITE OT-REC

    IF FS NOT EQUAL '00'
       DISPLAY 'ERROR AL ESCRIBIR SALIDA:' FS
    END-IF

*CIERRO EL FICHERO DE SALIDA
    CLOSE OTFILE

    IF FS NOT EQUAL '00'
       DISPLAY 'ERROR AL CERRAR SALIDA:' FS
    END-IF

    CALL PGM USING WS-LIBERAR

    PERFORM 110000-LEER
    .
*FIN
 300000-FIN.
    CLOSE ENTRADA

    IF FS-ENTRADA NOT EQUAL '00'
       DISPLAY 'ERROR AL CERRAR'
    END-IF

    STOP RUN
    .

La primera vez que llamamos al programa BPXWDYN, lo hacemos con la opción "alocar", ALLOC.
Le indicamos el nombre del fichero, lo que iría en la DSN, con una variable "FN" que contiene el nombre PARTE.COMUN.F0000001.
Además le indicamos las opciones que irían en el DISP: NEW, CATALOG. La longitud LRECL(80) y que es un fichero de longitud fija RECFM(FB).
Estas opciones podemos modificarlas en función de nuestras necesidades.

La segunda vez que llamamos al programa BPXWDYN es necesaria para que OTFILE coja el siguiente nombre que le asignemos. Si no lo hiciésemos, el primer nombre (PARTE.COMUN.F0000001) se quedaría alocado y no se generaría ningún otro.

El resultado son 4 ficheros de salida:
PARTE.COMUN.F0000001 --> contiene REGISTRO1
PARTE.COMUN.F0000002 --> contiene REGISTRO2
PARTE.COMUN.F0000003 --> contiene REGISTRO3
PARTE.COMUN.F0000004 --> contiene REGISTRO4

Utilidades REXX I: Querys dinámicas.

REXX (REstructured eXtended eXecutor) es un lenguaje de programación desarrollado en IBM y, en principio, está disponible en todos los entornos mainframe. No necesita compilación y puede ejecutarse tanto desde un JCL como con un TSO EXEC.

No vamos a entrar a ver las sentencias básicas del REXX ni como construír "mi primer programa", pero si alguien tiene alguna duda, puede consultárnoslo ^^.

Lo que vamos a ver es un ejemplo de para qué podemos usar este lenguaje. En nuestro caso será para construir una query dinámica, es decir, una sentencia SELECT en la que los campos del FROM y del WHERE serán variables que tomaremos de un fichero.

¿Para qué puedo necesitar esto? Veamos el caso práctico.

Imaginemos que queremos localizar el apellido "Ercilurrutigastañaza" porque hemos cambiado los campos que contienen apellidos de nuestra base de datos y ahora ya nos cabe el apellido entero "Ercilurrutigastañazagogeascoa". Y queremos actualizarlo para que el pobre hombre tenga bien puesto su apellido en los recibos del banco.
Vamos a buscar todas las tablas donde esté almacenado ese apellido.

El problema es que los campos donde se guarda el apellido no tienen un nombre intuitivo, asi que no podemos buscar por todas las tablas el campo "APEL", por ejemplo.

Lo que buscaremos será el contenido del campo, teniendo en cuenta que el campo mide 20 posiciones y que es un carácter, buscaremos en todas las tablas los campos que midan 20 o más y que sean caracteres.

Veamos la cadena con la sentencia que nos recuperará la lista de tablas+campos en un fichero:

//*-----------------------------------------------------------
//* DESCARGA | UNLOAD | DESCARGAMOS EN UN FICHERO LA INFORMACION
//*------------------------------------------------------------
//UNLOAD EXEC PGM=IKJEFT01,DYNAMNBR=20
//SYSTSPRT DD SYSOUT=*
//SYSTSIN DD *
 DSN SYSTEM(DSNT)
 RUN PROGRAM(DSNTIAUL) PLAN(DSNTIAUL) -
 LIB('LIBRERIA.DE.TU.INSTALACION')
//SYSPRINT DD SYSOUT=*
//SYSUDUMP DD SYSOUT=*
//SYSPUNCH DD SYSOUT=*
//SYSREC00 DD DSN=XXXX.FICHERO.CAMPOS.TABLAS,
// DISP=(,CATLG,),UNIT=SYSDA,
// SPACE=(CYL,(100,50),RLSE)
//SYSIN DD *
  SELECT CHAR(TBNAME, 20)
        ,CHAR(NAME, 20)
    FROM SYSIBM.SYSCOLUMNS
   WHERE TBNAME LIKE 'TB%'
     AND COLTYPE LIKE '%CHAR%'
     AND TBCREATOR = 'DBO'
     AND LENGTH >= 20
     ;
/*

Donde:
CHAR(TBNAME, 20):Lo que mida el nombre de las tablas como máximo
CHAR(NAME, 20) :Lo que mida el nombre de los campos como máximo
SYSIBM.SYSCOLUMNS:Contiene información de cada columna de cada tabla y vista de la BD
'TB%':Parte común a todas nuestras tablas
'%CHAR%':Es el tipo de dato
'DBO':Owner DB2 que corresponda
LENGTH:Longitud del campo que buscamos

La información del fichero tendría esta pinta:
TBPRU01 CAMPO1
TBPRU01 CAMPO2
TBPRU01 CAMPO3
TBPRU02 CAMPO4
TBPRU02 CAMPO5
TBPRU02 CAMPO6
TBPRU03 CAMPO7
TBPRU03 CAMPO8
TBPRU03 CAMPO9
TBPRU04 CAMPO1
(...)

Veamos el código del programa REXX:

/* REXX */
STAT = MSG('ON')
USER=SYSVAR(SYSUID)
RXSQL_DB2SUBSYS = DSNT
"EXECIO * DISKR DESCARGA (STEM LINE. FINIS"
DO I = 1 TO LINE.0
   TABLA= STRIP(SUBSTR(LINE.I,1,20))
   CAMPO= STRIP(SUBSTR(LINE.I,21,20))
   SENTENCIA = "SELECT COUNT(*)",
               "FROM "STRIP(TABLA),
               "WHERE "STRIP(CAMPO) "= 'Ercilurrutigastañaza'"
   CALL RXSQL SENTENCIA
   IF RXSQL_SQLCODE < 0 THEN
      DO
        SAY "ERROR EN TABLA:"STRIP(TABLA) "SQLCODE:"RXSQL_SQLCODE
        SAY SENTENCIA
      END
   IF STRIP(TEMP.1.1) > 0 THEN
      DO
        SAY SENTENCIA
        SAY STRIP(TEMP.1.1)
      END
END
CALL RXSQLEND
EXIT 0

Donde:
"EXECIO * DISKR DESCARGA (STEM LINE. FINIS":Lee el fichero DESCARGA hasta el final
TABLA= STRIP(SUBSTR(LINE.I,1,20)):Los nombres de tablas del fichero
CAMPO= STRIP(SUBSTR(LINE.I,21,20)):Los nombres de campos del fichero
SAY SENTENCIA:Nos displayará las sentencias en las que encontremos el apellido que buscamos

Lo ejecutaremos en una cadena:

//*=========================================================
//* EJECUCION DEL PROGRAMA REXX
//*=========================================================
//REXTBLS EXEC PGM=IKJEFT01
//*-------
//SYSPROC DD DISP=SHR,DSN=LIBRERIA.DONDE.ESTA.EL.PROGRAMA
//DESCARGA DD DISP=SHR,DSN=XXXX.FICHERO.CAMPOS.TABLAS
//SYSTSPRT DD DSN=XXXX.LISTA.CAMPOS.APELLIDO
//         DISP=(,CATLG),
//         SPACE=(CYL,(60,10),RLSE),UNIT=SYSDA
//SYSLIST DD SYSOUT=*
//SYSOUT DD SYSOUT=*
//SYSTSIN DD *
 REXTBLS
/*

Donde:
XXXX.LISTA.CAMPOS.APELLIDO:Fichero donde escribiremos los SAY
REXTBLS:Nombre del programa REXX

Podéis descargaros el JCL completo y el código del programa.