Ficheros Generacionales GDG

Ficheros generacionales GDG (Generation Data Group)

El mejor modo de entender el comportamiento de estos ficheros es mediante un ejemplo:
Para hacer referencia a cada versión de fichero se sigue lo siguiente:

XXXXXXXX.YYYYYYYY.ZZZZZZZZ(0) --> Última versión / versión actual
XXXXXXXX.YYYYYYYY.ZZZZZZZZ(+1) --> Versión nueva
XXXXXXXX.YYYYYYYY.ZZZZZZZZ(-1) --> Versión anterior a la actual


Supongamos que tenemos un fichero de 7 versiones con los datos de los últimos 7 días de la semana.

Nuestro fichero tendría este aspecto:

XXXXXXXX.YYYYYYYY.ZZZZZZZZ --> Base (no contiene información)
XXXXXXXX.YYYYYYYY.ZZZZZZZZ.G0001V00 --> Datos Martes 12
XXXXXXXX.YYYYYYYY.ZZZZZZZZ.G0002V00 --> Datos Miércoles 13
XXXXXXXX.YYYYYYYY.ZZZZZZZZ.G0003V00 --> Datos Jueves 14
XXXXXXXX.YYYYYYYY.ZZZZZZZZ.G0004V00 --> Datos Viernes 15
XXXXXXXX.YYYYYYYY.ZZZZZZZZ.G0005V00 --> Datos Sábado 16
XXXXXXXX.YYYYYYYY.ZZZZZZZZ.G0006V00 --> Datos Domingo 17
XXXXXXXX.YYYYYYYY.ZZZZZZZZ.G0007V00 --> Datos Lunes 18

Para hacer referencia a la versión que queramos lo indicaremos de este modo:

XXXXXXXX.YYYYYYYY.ZZZZZZZZ(-6) --> Datos Martes 12
XXXXXXXX.YYYYYYYY.ZZZZZZZZ(-5) --> Datos Miércoles 13
XXXXXXXX.YYYYYYYY.ZZZZZZZZ(-4) --> Datos Jueves 14
XXXXXXXX.YYYYYYYY.ZZZZZZZZ(-3) --> Datos Viernes 15
XXXXXXXX.YYYYYYYY.ZZZZZZZZ(-2) --> Datos Sábado 16
XXXXXXXX.YYYYYYYY.ZZZZZZZZ(-1) --> Datos Domingo 17
XXXXXXXX.YYYYYYYY.ZZZZZZZZ(0) --> Datos Lunes 18

Imaginemos que queremos guardar los datos del Martes 19. En nuestro jcl, para crear la nueva versión de datos le indicaremos:
XXXXXXXX.YYYYYYYY.ZZZZZZZZ(+1)

Una vez creada una nueva versión nuestro fichero, la versión (+1) que hemos usado pasará a ser la (0), y la que era (0) pasará a ser (-1), es decir, quedará del siguiente modo:

XXXXXXXX.YYYYYYYY.ZZZZZZZZ(-6) --> Datos Martes 12. (La versión más antigua se pierde)
XXXXXXXX.YYYYYYYY.ZZZZZZZZ(-6) --> Datos Miércoles 13
XXXXXXXX.YYYYYYYY.ZZZZZZZZ(-5) --> Datos Jueves 14
XXXXXXXX.YYYYYYYY.ZZZZZZZZ(-4) --> Datos Viernes 15
XXXXXXXX.YYYYYYYY.ZZZZZZZZ(-3) --> Datos Sábado 16
XXXXXXXX.YYYYYYYY.ZZZZZZZZ(-2) --> Datos Domingo 17
XXXXXXXX.YYYYYYYY.ZZZZZZZZ(-1) --> Datos Lunes 18
XXXXXXXX.YYYYYYYY.ZZZZZZZZ(0) --> Datos Martes 19

Si quisiéramos utilizar la versión del Martes 19 en otro jcl, ya no haríamos referencia a la versión (+1), sino a la (0).

Sin embargo, si dentro del mismo jcl, creamos una versión nueva y a continuación, en otro paso, la utilizamos(en un programa que lea el fichero por ejemplo), hay que referirse al fichero como (+1).
Esto es porque hasta que no acaba la ejecución del jcl, no se actualiza la información de las versiones, por lo tanto si utilizáramos la versión (0) en el programa, no estaríamos cogiendo la versión creada en el paso anterior, sino la versión anterior a esa.

Paso de Creación de la base de un fichero generacional:

//PASO1 EXEC PGM=IDCAMS
//SYSPRINT DD SYSOUT=*
//SYSIN DD *
DEFINE GDG(NAME(XXXXXXXX.YYYYYYYY.ZZZZZZZZ) LIMIT(XX) EMPTY/NOEMPTY SCRATCH/NOSCRATCH)

Detalle:
- NAME --> Nombre del fichero. Una buena manera de nombrar los fichero es la siguiente:
XXXXXXXX --> Indentificador de la aplicación
YYYYYYYY --> Nombre del JCL donde se crea
ZZZZZZZZZ --> Nombre del JCL donde se actualiza
- LIMIT --> Indicar el número de versiones que va a tener como máximo.
- EMPTY : Opcional. Especifica que se descataloguen todos los nombres de fichero
cuya versión supere la especificada en LIMIT.
- NOEMPTY : Sirve para especificar que según se vayan generando versiones
nuevas, se vayan borrando las mas antiguas, de forma que solo estén activas
las ultimas LIMIT.
- SCRATCH : Opcional. Especifica que se borre físicamente el fichero cuando
se descatalogue.

Este paso crea únicamente la base del fichero, pero en ésta no se pueden almacenar datos. Se han de crear versiones +1 donde guardaremos los datos.

Los ficheros generacionales son independientes de la longitud. Es decir, cada versión del fichero puede tener una longitud distinta a la anterior.

Paso para modificar el número de versiones de un fichero generacional:

En caso de querer aumentar o disminuir el número de versiones de un fichero GDG, el paso a seguir es el siguiente:

//PASO2 EXEC PGM=IDCAMS
//SYSPRINT DD SYSOUT=*
//SYSIN DD *
ALTER XXXXXXXX.YYYYYYYY.ZZZZZZZZ -
LIMIT(XX)

Si reducimos el número de versiones que tiene un fichero, la máquina por defecto, elimina de la versión más antigua a la más reciente.

Paso para crear una versión vacía de un fichero generacional

En caso de querer crear una versión en vacío de un fichero GDG, el paso a seguir es el siguiente:

//PASO3 EXEC PGM=ICEGENER
//SYSPRINT DD SYSOUT=*
//SYSIN DD DUMMY
//SYSUT1 DD DSN=NULLFILE,
// DCB=(LRECL=XXX,RECFM=FB)
//SYSUT2 DD UNIT=SYSDA,DISP=(NEW,CATLG,DELETE),
// DSN=XXXXXXXX.XXXXXXXX.XXXXXXXX(+1),
// SPACE=(TRK,(1,1),RLSE)
// DCB=(LRECL=XXX,RECFM=FB)

Recordar que cada versión del fichero puede tener una longitud distinta a la anterior.
Si no se sabe o no se quiere indicar la longitud, se puede omitir el:

// DCB=(LRECL=XXX,RECFM=FB)

Ojo. Si se borra esta línea se ha de eliminar la coma de la línea anterior.

Paso de borrado de un fichero generacional

Para borrar un fichero generacional se ha de seguir el siguiente proceso:
- Primero se han de borrar cada una de las versiones del fichero, dejando únicamente su base. Para borrar una versión se puede hacer “a mano” o con un paso de borrado normal. Es importante indicar el número de versión del fichero a borrar (XXXXXXXX.YYYYYYYY.ZZZZZZZZ.G0003V00).
- Una vez eliminadas todas las versiones se ha de lanzar por jcl el siguiente paso:

//PASO4 EXEC PGM=IDCAMS
//SYSPRINT DD SYSOUT=*
//SYSIN DD *
DELETE (XXXXXXXX.YYYYYYYY.ZZZZZZZZ) GDG PURGE

El reto de cubrir objetivos

Recientemente el presidente de la Unidad de Negocio de Gestión de Servicios de Mainframe, de BMC Software, Bill Miller, expuso sus teorías sobre la situación actual que se vive en los departamentos de TI debido a los presupuestos restrictivos.

El reto de cubrir objetivos

Nos encontramos ante una situación compleja, ya que mientras la crisis azota los presupuestos, muchos otros factores, como el incremento del uso de internet exige responder a niveles de servicio crecientes.

Bill Miller plantea un uso de software inteligente enfocado a gestionar las actuales infraestructuras de mainframe. Según asegura, esta solución podría resolver los sobrecostes en los que incurren la mayor parte de las organizaciones. Tareas tales como la mejora del rendimiento de las aplicaciones, estudios de la gestión de datos, etc, conseguirían un ahorro de costes considerable.

La disminución de estos costes se justificaría, en gran parte, con la reducción de personal y gastos inherentes de los mismos (formación).

Surgen varias preguntas que plantearse:

¿Están justificadas, dados los presupuestos menguantes actuales, las inversiones millonarias en sistemas software inteligentes y mantenimiento de los mismos?

y

¿Se debe optar por sistemas de software inteligentes u obligar al cumplimiento en las organizaciones de procesos empresariales estandarizados?

XML PARSE: de XML a fichero plano con COBOL.

El XML parse es una utilidad del COBOL que podéis encontrar en el propio manual de IBM.
Pero, ¿alguna vez has tenido que usarlo? Y digo más, ¿alguna vez has tenido que usarlo para transformar un XML que subido a host se convirtiese en un fichero de más de 500.000 registros?

Se puede decir que para pequeños textos no tiene mucha dificultad, pero como a nosotros nos gusta el riesgo, vamos a explicar como transformar un fichero bien "gordo" con el XML PARSE.
Al final de este artículo podréis descargaros el código completo del programa de ejemplo.

Lo primero que tenemos que hacer es "subir" el fichero xml que tengamos en local a nuestro servidor. En nuestro ejemplo vamos a suponer que tendremos un fichero plano de longitud fija 129, y unos 500.000 registros.

Si el fichero XML tenía una estructura de este tipo:


<elemento1>
<elemento2 atributo1=atr1-uno/>
<elemento2 atributo1=atr1-uno/>
</elemento1>
<elemento3>
<elemento4>elem4-uno</elemento4>
<elemento5 atributo2=atr2-uno/>
<elemento5 atributo2=atr2-dos/>
<elemento6>elem6-uno</elemento6>
<elemento6>elem6-dos</elemento6>
</elemento3>


En nuestro fichero plano tendrá una estructura de este tipo:

Aquí vemos aparecer los primeros problemas:

1. Para el proceso de parseo necesitaremos conocer tanto el inicio como el final de un elemento/atributo, pero, cuando leamos el fichero, la información puede venir separada en diferentes registros.

2. Además, COBOL tiene un máximo de caracteres que puede procesar a la vez, es decir, no podemos declarar una variable que mida "longitud de registro * nº de registros" para guardar toda la información del fichero en ella.
La máxima longitud soportada es 134217727.
La solución: procesar el fichero por "trocitos".

Definiremos una variable WX-REG-XML con PIC X(250000), que será lo que mida cada uno de nuestros "trocitos" (podéis definirla con la longitud que consideréis conveniente).
Luego leeremos del fichero de entrada hasta rellenar esa variable.

Proceso:
PERFORM UNTIL WI-POS GREATER 249400(para dejar un margen de espacios en blanco al final de la variable WX-REG-XML) OR FIN-FICHERO

PERFORM LEER-FICHERO

END-PERFORM

MOVE WI-POS TO WI-POS-AUX(nos guardamos la posición donde tenemos que mover el siguiente registro que leamos)

IF FIN-TABLA
PERFORM BUSCA-INICIO-ELEMENTO(buscamos las etiquetas de inicio de los elementos)
END-IF

PERFORM BUSCA-FIN-ELEMENTO(buscamos las etiquetas de final de los elementos)

PERFORM PROCESO-XML(hacemos el XML PARSE)

MOVE WX-REG-XML-AUX TO WX-REG-XML

Leer-fichero:
READ FICHERO INTO WR-FICHERO

SI FS-FICHERO = '00'
MOVE WR-FICHERO TO WX-REG-XML(WI-POS:129)

ADD 129 TO WI-POS
END-IF

De esta forma tendremos guardado en nuestra variable WX-REG-XML el texto del ejemplo 2 en una sola línea.

Gracias a nuestro fichero xsd sabremos los nombres de todos los elementos/atributos de nuestro xml. Esto nos ayudará en la siguiente parte del proceso: detectar el inicio y el fin de cada elemento raíz. En nuestro caso, los elementos raíz serán "elemento1" y "elemento3", y escribiremos la información de cada uno de ellos en un fichero de salida diferente.

Buscar el inicio de un elemento raíz:
PERFORM VARYING WI-INI FROM 1 BY 1 UNTIL FIN-BUSCA-INI OR WI-INI GREATER 249800

IF WX-REG-XML(WI-INI:9) EQUAL 'elemento1'
SET SI-ELEMENTO1 TO TRUE
SET FIN-BUSCA-INI
END-IF

IF WX-REG-XML(WI-INI:9) EQUAL 'elemento3'
SET SI-ELEMENTO3 TO TRUE
SET FIN-BUSCA-INI TO TRUE
END-IF

END-PERFORM

Una vez que sabemos el elemento raíz que vamos a procesar, buscaremos el final de ese elemento.
Aquí nos podemos encontrar con otro problema, pues puede darse el caso de que un elemento raíz contenga tanta información que no quepa en nuestra variable WX-REG-XML y en este caso no encontraríamos la etiqueta de final de elemento "</elemento1>".
La solución en este caso pasa por controlar en todo momento el final de algún elemento hijo.

Vamos a ver todo esto con un ejemplo:
"elemento1"
PERFORM VARYING WI-FIN FROM 1 BY 1 UNTIL FIN-BUSCA-FIN

a) Controlamos la posición del final del atributo:

IF WX-REG-XML(WI-FIN:2) EQUAL '/>'
COMPUTE WX-FIN-ATR = WI-FIN + 2
END-IF

b) Buscamos el final del elemento raíz

IF WX-REG-XML(WI-FIN:12) EQUAL '</elemento1>'
COMPUTE WX-POS-INI = WI-FIN + 12

c) Guardamos la información que ya no pertenece a "elemento1" en una variable auxiliar

MOVE WX-REG-XML(WX-POS-INI:) TO WX-REG-XML-AUX
MOVE SPACES TO WX-REG-XML(WX-POS-INI:)

d)Calculamos la posición donde moveremos el siguiente registro que leamos

COMPUTE WI-POS = WI-POS-AUX - WX-POS-INI + 1

SET FIN-BUSCA-FIN TO TRUE
SET FIN-TABLA TO TRUE

e)Al mismo tiempo que buscamos el final del "elemento1", controlamos el final de la variable WX-REG-XML.

ELSE

f)Si hemos llegado al final del registro sin encontrar el final del "elemento1", crearemos un nombre de elemento raíz auxiliar e incrementable de este tipo:

05 WX-TABLA-AUX.
10 FILLER PIC X(7) VALUE '<TBLAUX'.
10 WX-NUMTBL PIC 9(8).
10 FILLER PIC X VALUE '>'.


para tratar, en una siguiente pasada, el resto de la información de "elemento1" hasta que encontremos el final "</elemento1>".

IF WX-REG-XML(WI-FIN:200) EQUAL SPACES

ADD 1 TO WA-NUMTBL

MOVE WA-NUMTBL TO WX-NUMTBL
MOVE WX-TABLA-AUX TO WX-REG-XML-AUX(1:16) <--Ponemos la etiqueta <TBLAUX00000001>

MOVE WX-REG-XML(WX-FIN-ATR:) TO WX-REG-XML-AUX(17:)
MOVE SPACES TO WX-REG-XML(WX-FIN-ATR:)

COMPUTE WI-POS = WI-POS-AUX - WX-FIN-ATR + 17

SET FIN-BUSCA-FIN TO TRUE
SET NO-FIN-TABLA TO TRUE
END-IF
ENF-IF
END-PERFORM

De esta forma, la siguiente parte de información que procesaríamos sería algo así:


El hecho de que busquemos 200 espacios se debe a que el texto de un elmento/atributo puede incluir un gran número de espacios en un texto grande. Como nuestros registros miden 129, incluso aunque haya un salto de línea dentro del texto, 200 espacios es un margen suficiente:


En este caso tendríamos 129 espacios, menor que 200. Obviamente este número puede ser el que más os convenga.

Una vez que tenemos guardada la información a procesar en nuestra variable WX-REG-XML, viene la parte fácil, el "parseo" propiamente dicho.

Proceso XML:

XML PARSE WX-REG-XML
PROCESSING PROCEDURE PARSEO-XML
ON EXCEPTION
DISPLAY 'ERROR EN PARSEO XML:'XML-CODE
NOT ON EXCEPTION
CONTINUE
END-XML

El procesado se haría en el párrafo PARSEO-XML. En nuestro caso, como queremos diferenciar entre "elemento1" y "elemento2" crearemos dos párrafos diferenciados dentro de PARSEO-XML:

Parseo-XML:

EVALUATE TRUE
WHEN SI-ELEMENTO1
PERFORM PROCESO-XML-ELEMENTO1
WHEN SI-ELEMENTO2
PERFORM PROCESO-XML-ELEMENTO2
END-EVALUATE

Proceso-XML-elemento1:

EVALUATE XML-EVENT
WHEN 'START-OF-ELEMENT'
DISPLAY 'ELEMENTO:'XML-TEXT

WHEN 'CONTENT-CHARACTERS'
DISPLAY 'TEXTO DEL ELEMENTO:'XML-TEXT

WHEN 'END-OF-ELEMENT'
DISPLAY 'FIN DE ELEMENTO:'XML-TEXT
IF XML-TEXT EQUAL 'elemento2'
PERFORM ESCRIBIR-FICHERO1
END-IF

WHEN 'ATTRIBUTE-NAME'
DISPLAY 'ATRIBUTO:'XML-TEXT

IF XML-TEXT EQUAL 'atributo1'
SET SI-ATR1 TO TRUE
END-IF

WHEN 'ATTRIBUTE-CHARACTERS'
DISPLAY 'TEXTO DEL ATRIBUTO:'XML-TEXT

IF SI-ATR1
Informamos el fichero de salida desde XML-TEXT
END-IF

WHEN 'COMMENT'
DISPLAY 'COMENTARIOS:'XML-TEXT

WHEN 'EXCEPTION'
DISPLAY 'EXCEPCION:'XML-CODE

WHEN OTHER
DISPLAY 'ERROR NO CONTROLADO:'XML-EVENT
END-EVALUATE

Proceso-XML-elemento3:

EVALUATE XML-EVENT
WHEN 'START-OF-ELEMENT'
DISPLAY 'ELEMENTO:'XML-TEXT

EVALUATE XML-TEXT
WHEN 'elemento4'
SET SI-ELEM4 TO TRUE
WHEN 'elemento6'
SET SI-ELEM6 TO TRUE
END-EVALUATE

WHEN 'CONTENT-CHARACTERS'
DISPLAY 'TEXTO DEL ELEMENTO:'XML-TEXT

EVALUATE TRUE
WHEN SI-ELEM4
Informamos el fichero de salida desde XML-TEXT
WHEN SI-ELEM6
Informamos el fichero de salida desde XML-TEXT
END-EVALUATE

WHEN 'END-OF-ELEMENT'
DISPLAY 'FIN DE ELEMENTO:'XML-TEXT
IF XML-TEXT EQUAL 'elemento3'
PERFORM ESCRIBIR-FICHERO2
END-IF

WHEN 'ATTRIBUTE-NAME'
DISPLAY 'ATRIBUTO:'XML-TEXT

IF XML-TEXT EQUAL 'atributo2'
SET SI-ATR2 TO TRUE
END-IF

WHEN 'ATTRIBUTE-CHARACTERS'
DISPLAY 'TEXTO DEL ATRIBUTO:'XML-TEXT

IF SI-ATR2
Informamos el fichero de salida desde XML-TEXT
END-IF

WHEN 'COMMENT'
DISPLAY 'COMENTARIOS:'XML-TEXT

WHEN 'EXCEPTION'
DISPLAY 'EXCEPCION:'XML-CODE

WHEN OTHER
DISPLAY 'ERROR NO CONTROLADO:'XML-EVENT
END-EVALUATE

Podéis encontrar un ejemplo muy bueno con todos los posibles eventos en la página de ibm: ejemplo parseo XML.

En este artículo hemos querido centrarnos más en la parte del procesado de los datos de entrada que en el parseo propiamente dicho, pues nos ha parecido la parte más compleja. Pero si alguien quiere que entremos más en detalle del XML PARSE, XML EVENT etc. no tiene más que pedirlo : )

Archivos:
Código del programa de prueba.
Fichero XML original.
Códigos de aviso XML.
Códigos de error XML.

Cruce n-n: la cosa se complica.

En un programa de cruce n-n, las claves de ambos ficheros pueden venir repetidas n veces.
Puede ocurrir que, a pesar de que la clave esté repetida, sólo nos interese comprobar que coinciden 1 vez, que sería el caso más sencillo.
Si por el contrario necesitamos recuperar todos los registros con la misma clave de los 2 ficheros, la cosa se complicaría un poco más.

Vamos a empezar por el caso fácil: Cruce n-n simple.



En el INICIO del programa, leeremos el primer registro de cada fichero e informaremos los campos CLAVE1 y CLAVE2:
CLAVE1 = 1; CLAVE2 = 1.
Repetiremos el proceso hasta llegar al final de alguno de los 2 ficheros.

a) CLAVE1 = CLAVE2:
Hacemos el tratamiento de datos
Leemos del fichero 1 hasta que cambie CLAVE1:

PERFORM UNTIL CLAVE1 <> CLAVE1-ANTERIOR(que valía 1)
Leemos el siguiente registro del fichero 1 e informamos CLAVE1 con el siguiente valor.
Cuando lleguemos a CLAVE1 = 2 saldremos del bucle
END-PERFORM

CLAVE1 = 2

Leemos del fichero 2 hasta que cambie CLAVE2:

PERFORM UNTIL CLAVE2 <> CLAVE2-ANTERIOR(que valía 1)
Leemos el siguiente registro del fichero 1 e informamos CLAVE1 con el siguiente valor.
Cuando lleguemos a CLAVE2 = 3 saldremos del bucle
END-PERFORM

CLAVE2 = 3

b) CLAVE1 < CLAVE2:
Esto significa que la CLAVE1 no existe en el fichero 2. Leemos el siguiente registro del fichero 1.

c) CLAVE1 > CLAVE2:
Esto significa que la CLAVE2 no existe en el fichero 1.
Leemos el siguiente registro del fichero 2.

En este caso lo único que hacemos es saltarnos los registros repetidos pues sólo vamos a tratar 1 vez cada CLAVE.

Vamos con el caso difícil: Cruce n-n complejo.



En el INICIO del programa:
Leeremos el primer registro del fichero 1 y del fichero 2.
Guardo todos los registros del fichero 2 que tengan la misma clave en una tabla interna.
CLAVE1 = 1; CLAVE2-tabla interna = 1.

Repetiremos el proceso hasta llegar al final de alguno de los 2 ficheros:

a) CLAVE1 = CLAVE2-tabla interna(1):
Comparamos cada registro del fichero 1, con todos los registros del fichero 2 guardados en la tabla interna:



PERFORM UNTIL CLAVE1 <> CLAVE1-ANTERIOR(que valía 1)
PERFORM UNTIL clave de la tabla interna vacía o superamos el máximo de ocurrencias
Hacemos el tratamiento de los datos
Añadimos 1 al índice
END-PERFORM

Inicializamos el índice de la tabla a 1
Leemos siguiente registro del fichero 1:cuando lleguemos a CLAVE1 = 2 saldremos del bucle
END-PERFORM

CLAVE1 = 2
Guardo los siguientes registros del fichero 2 que tengan la misma clave en la tabla interna:
CLAVE2-tabla interna = 3

b) CLAVE1 < CLAVE2-tabla interna:
Esto significa que la CLAVE1 no existe en el fichero 2. Leemos el siguiente registro del fichero 1: CLAVE1 = 5. CLAVE2-tabla interna sigue valiendo 3.

c) CLAVE1 > CLAVE2-tabla interna:
Esto significa que la CLAVE2 no existe en el fichero 1.
Guardo los siguientes registros del fichero 2 que tengan la misma clave en la tabla interna:
CLAVE2-tabla interna = 3

Una forma de guardar los registros en la tabla interna sería:
PERFORM UNTIL CLAVE2 <> CLAVE2-ANTERIOR
Muevo los campos a la tabla interna
Leo el siguiente registro del fichero 2
END-PERFORM

Y queda listo nuestro programa de cruce n-n. Toma ya!

A petición popular, os dejo un ejemplo completo, con su JCL, y con la información de los ficheros de entrada y de salida:
Programa de cruce n-n.
JCL de ejecución.
Ficheros de entrada y salida.

Cruce 1-n: subiendo el nivel.

El programa de cruce 1-n se basa en el mismo proceso que el cruce 1-1. La diferencia está en que la clave del fichero 2 puede venir repetida n veces. Y como para muestra un botón, ahí va otro ejemplo:



En el INICIO del programa, leeremos el primer registro de cada fichero e informaremos los campos CLAVE1 y CLAVE2: CLAVE1 = 1; CLAVE2 = 1.

Repetiremos el proceso hasta llegar al final de alguno de los 2 ficheros.

a) CLAVE1 = CLAVE2:
Dentro de un bucle, hacemos el tratamiento que corresponda y leemos del fichero 2 hasta que cambie el valor del campo CLAVE2.

PERFORM UNTIL CLAVE2 <> CLAVE2-ANTERIOR(que valía 1)
Tratamiento de datos.
Leemos el siguiente registro del fichero 2 e informamos CLAVE2 con el siguiente valor.
Cuando lleguemos a CLAVE2 = 3 saldremos del bucle
END-PERFORM

b) Fuera del bucle(CLAVE2 ha cambiado, vale 3), leemos el siguiente registro del fichero 1:
CLAVE1 = 2.

c) CLAVE1 < CLAVE2:
Esto significa que la CLAVE1 no existe en el fichero 2. Leemos el siguiente registro del fichero 1.
CLAVE1 = 5. CLAVE2 sigue valiendo 3.

d) CLAVE1 > CLAVE2:
Esto significa que la CLAVE2 no existe en el fichero 1. Leemos el siguiente registro del fichero 2.
CLAVE1 = 5. CLAVE2 = 5.

La diferencia principal con el cruce 1-1 está en el caso a), pues ahora tendremos que tratar todos los registros del fichero 2 que tengan la misma clave antes de tratar el siguiente registro del fichero 1.

Mi primer programa de cruce. Cruce 1-1.

El programa de cruce de ficheros más sencillo es el denominado 1-1. Esto significa que el valor de los campos que vamos a comparar sólo estará una vez en cada fichero.

El campo de comparación se suele llamar "campo clave" o simplemente "clave". Este campo clave existirá en ambos ficheros y tendrá el mismo formato (PIC) en ambos. De no ser así tendríamos que formatear uno de ellos para que coincidan los formatos.

OJO! los ficheros de un programa de cruce siempre vendrán ordenados por el campo clave.

JCL:

//******************************************************
//******************** BORRADO *************************
//BORRADO EXEC PGM=IDCAMS
//SYSPRINT DD SYSOUT=*
//SYSIN DD *
DEL FICHERO.ENTRADA1.ORDENADO
DEL FICHERO.ENTRADA2.ORDENADO
DEL FICHERO.SALIDA.CRUCE
SET MAXCC = 0
//******************************************************
//* ORDENAMOS EL FICHERO ENTRADA1 POR CLAVE *********
//SORT01 EXEC PGM=SORT
//SORTIN   DD DSN=FICHERO.ENTRADA1,DISP=SHR
//SORTOUT  DD DSN=FICHERO.ENTRADA1.ORDENADO,
//            DISP=(,CATLG),SPACE=(TRK,(50,10))
//SYSOUT   DD SYSOUT=*
//SYSPRINT DD SYSOUT=*
//SYSIN DD *
  SORT FIELDS=(1,1,CH,A)
//******************************************************
//* ORDENAMOS EL FICHERO ENTRADA2 POR CLAVE *********
//SORT01 EXEC PGM=SORT
//SORTIN   DD DSN=FICHERO.ENTRADA2,DISP=SHR
//SORTOUT  DD DSN=FICHERO.ENTRADA2.ORDENADO,
//            DISP=(,CATLG),SPACE=(TRK,(50,10))
//SYSOUT   DD SYSOUT=*
//SYSPRINT DD SYSOUT=*
//SYSIN DD *
  SORT FIELDS=(1,1,CH,A)
//******************************************************
//*********** EJECUCION DEL PROGRAMA PRUEBA7 ***********
//PROG4 EXEC PGM=PRUEBA7
//SYSOUT  DD SYSOUT=*
//FICHERO1 DD DSN=FICHERO.ENTRADA1.ORDENADO,DISP=SHR
//FICHERO2 DD DSN=FICHERO.ENTRADA2.ORDENADO,DISP=SHR
//SALIDA   DD DSN=FICHERO.SALIDA.CRUCE,
//            DISP=(NEW, CATLG, DELETE),SPACE=(TRK,(50,10)),
//            DCB=(RECFM=FB,LRECL=1)
/*

Programa:
La base del proceso de un programa de cruce es la comparación de las claves:

3000-PROCESO.

EVALUATE TRUE
   WHEN CLAVE1 = CLAVE2
        (...)
   WHEN CLAVE1 < CLAVE2
        (...)
   WHEN CLAVE1 > CLAVE2
        (...)
END-EVALUATE
.

En cada WHEN pondremos el código de lo que queremos hacer. Por ejemplo, cuando las claves coincidan, escribiremos un registro en un fichero de salida.

EVALUATE TRUE
   WHEN CLAVE1 = CLAVE2
        PERFORM ESCRIBE-SALIDA-CRUCE
        PERFORM LEER-FICHERO1
        PERFORM LEER-FICHERO2
   WHEN CLAVE1 < CLAVE2
        DISPLAY 'CLAVE1 NO EXISTE EN FICHERO2'
        PERFORM LEER-FICHERO1
   WHEN CLAVE1 > CLAVE2
        DISPLAY 'CLAVE2 NO EXISTE EN FICHERO1'
        PERFORM LEER-FICHERO2
END-EVALUATE
.

Este proceso se repetirá X veces dependiendo del tratamiento que queramos hacer:
1.Proceso hasta final del fichero 1: cuando queremos tratar todos los registros del fichero 1, existan o no en el fichero 2.
2.Proceso hasta final del fichero 1 y final del fichero 2: cuando queremos tratar todos los registros de los 2 ficheros. Esto incluye los registros comunes a ambos ficheros, los registros del fichero 1 que no están en el fichero 2 y los registros del fichero 2 que no están el fichero 1.
3.Proceso hasta final del fichero 1 o final del fichero2: cuando sólo queremos tratar los registros coincidentes. En el momento en que uno de los ficheros se termine, no volveremos a tener claves coincidentes por lo que no tiene sentido continuar la ejecución.

Para verlo más claro pongamos un ejemplo:

En el INICIO del programa, leeremos el primer registro de cada fichero e informaremos los campos CLAVE1 y CLAVE2:

1000-INICIO.

    PERFORM LEER-FICHERO1
    PERFORM LEER-FICHERO2
    .

Donde:
LEER-FICHERO1.
    
    READ FICHERO1 INTO WX-ENTRADA1

    EVALUATE FS-FICHERO1
       WHEN ZEROES
            MOVE WX-ENTRADA1 TO CLAVE1
       WHEN 10
            SET FIN-FICHERO1 TO TRUE
       WHEN OTHER
            PERFORM 3000-FINAL
    END-EVALUATE
    .

LEER-FICHERO2.
Lo mismo que para Fichero1.


Después de la primera lectura:
CLAVE1 = 1; CLAVE2 = 1.

Repetiremos el proceso hasta llegar al final de alguno de los 2 ficheros.
PERFORM 3000-PROCESO
  UNTIL FIN-FICHERO1
     OR FIN-FICHERO2

a) CLAVE1 = CLAVE2:
Escribimos en el fichero de salida:
ESCRIBIR-SALIDA-CRUCE.
    MOVE CLAVE1 TO WX-SALIDA

    WRITE REG-SALIDA FROM WX-SALIDA

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

Leemos el siguiente registro del fichero 1: PERFORM LEER-FICHERO1
CLAVE1 = 2.
Leemos el siguiente registro del fichero 2: PERFORM LEER-FICHERO2
CLAVE2 = 3.

b) CLAVE1 < CLAVE2:
Esto significa que la CLAVE1 no existe en el fichero 2.
Leemos el siguiente registro del fichero 1: PERFORM LEER-FICHERO1
CLAVE1 = 5.

c) CLAVE1 > CLAVE2:
Esto significa que la CLAVE2 no existe en el fichero 1.
Leemos el siguiente registro del fichero 2: PERFORM LEER-FICHERO2
CLAVE2 = 5.

El tratamiento que hagamos en cada uno de los casos es indiferente para el proceso de cruce. Lo importante es el orden en el que leemos los ficheros.

Para terminar vamos a ver como serían las lecturas en caso de que el proceso se repita hasta final de los dos ficheros:
LEER-FICHERO1.
    READ FICHERO1 INTO WX-ENTRADA1

    EVALUATE FS-FICHERO1
       WHEN ZEROES
            MOVE WX-ENTRADA1 TO CLAVE1
       WHEN 10
            SET FIN-FICHERO1 TO TRUE
            
            MOVE HIGH-VALUES TO CLAVE1
       WHEN OTHER
            PERFORM 3000-FINAL
    END-EVALUATE
    .

LEER-FICHERO2.
Lo mismo que para Fichero1.

Como podéis ver hemos informado la clave con HIGH-VALUES. Esto significa que cuando finalize el fichero1, la CLAVE1 va a ser siempre mayor que la clave 2, y en el EVALUATE donde comparamos las claves, siempre entrará por el tercer WHEN.
Una vez leido todo el fichero1, el programa seguirá ejecutándose leyendo del fichero2, hasta que éste también finalice.

Y ya está, nuestro primer programa de cruce está listo : )