En este ejemplo veremos el uso de los ficheros VSAM.
Un fichero VSAM es un fichero de tipo indexado, que tiene definido un índice, y sobre el que se pueden realizar accesos por índice.
Vamos a crear un programa que dé de alta registros, borre registros y actualice registros de un fichero VSAM.
Para ello usaremos el siguiente ejemplo:
Tenemos como entrada 2 versiones del fichero oficina (será un GDG), por un lado la versión actual (0), y por otro la versión anterior (-1). En estos ficheros tendremos la información de las oficinas de un banco con formato:
COPY COFICINA:
01 CSAM-COFICINA.
05 CSAM-CLAVE.
10 CSAM-COD-CODENT PIC 9(4).
10 CSAM-COD-CODOFI PIC 9(4).
05 CSAM-DES-NOMBRE PIC X(20).
05 CSAM-COD-CODPOS PIC 9(5).
05 CSAM-COD-TELEF1 PIC 9(9).
05 CSAM-FEC-APERTU PIC X(10).
La versión (0) será la que tenga los datos más actuales (del día). La versión (-1) será la del día anterior.
Los datos de las oficinas se guardan en un fichero VSAM con clave código de entidad (CSAM-COD-CODENT) y código de oficina (CSAM-COD-CODOFI).
Vamos a comparar las dos versiones para:
1. Si una oficina existe en el fichero de hoy y en la versión del día anterior, actualizamos esa clave en el fichero VSAM.
2. Si una oficina existe en el fichero de hoy pero no en el de ayer, la damos de alta en el fichero VSAM.
3. Si una oficina existe en el fichero de ayer pero no en el de hoy, la damos de baja del fichero VSAM.
JCL:
//** *****************************************************
//** ** ACTUALIZAMOS FICHERO DE OFICINAS VSAM ** **
//** ***************************************************
//PGMVSAM EXEC PGM=PGMVSAM
//ENTRADA1 DD DSN=NOMBRE.FICHERO.OFICINA(0),DISP=SHR
//ENTRADA2 DD DSN=NOMBRE.FICHERO.OFICINA(-1),DISP=SHR
//SALIDA DD DSN=FICHERO.SALIDA.VSAM,DISP=SHR
//SYSOUT DD SYSOUT=*
//SYSPRINT DD SYSOUT=*
//SYSUDUMP DD SYSOUT=4,DEST=JESTC3
//SYSDBOUT DD SYSOUT=4,DEST=JESTC3
//CEEDUMP DD SYSOUT=4,DEST=JESTC3
/*
PROGRAMA:
IDENTIFICATION DIVISION.
PROGRAM-ID. PGMVSAM.
AUTHOR. CONSULTORIO COBOL.
*============================================*
* PROGRAMA DE MANTENIMIENTO DE FICHERO VSAM *
*============================================*
*
*
ENVIRONMENT DIVISION.
*
CONFIGURATION SECTION.
SPECIAL-NAMES.
DECIMAL-POINT IS COMMA.
*
INPUT-OUTPUT SECTION.
FILE-CONTROL.
SELECT ENTRADA0 ASSIGN TO ENTRADA0
FILE STATUS IS FS-ENTRADA0.
SELECT ENTRADA1 ASSIGN TO ENTRADA1
FILE STATUS IS FS-ENTRADA1.
SELECT SALIDA ASSIGN TO SALIDA
ORGANIZATION IS INDEXED
ACCESS MODE IS RANDOM
RECORD KEY IS CLAVE-OFICVSM
FILE STATUS IS FS-SALIDA.
*
DATA DIVISION.
*
FILE SECTION.
*
**** FICHEROS DE ENTRADA ****
*
**--> OFICINAS VERSION 0 (FICHERO SECUENCIAL)
FD ENTRADA0
LABEL RECORD STANDARD
RECORDING MODE IS F
BLOCK CONTAINS 0 RECORDS.
01 REG-ENTRADA0 PIC X(52).
*
*--> OFICINAS VERSION -1 (FICHERO SECUENCIAL)
FD ENTRADA1
LABEL RECORD STANDARD
RECORDING MODE IS F
BLOCK CONTAINS 0 RECORDS.
01 REG-ENTRADA1 PIC X(52).
**** FICHERO DE ENTRADA - SALIDA ****
*
*--> OFICINAS (FICHERO VSAM)
FD SALIDA.
01 REG-VSAM.
03 CLAVE-OFICVSM PIC X(08).
03 RESTO-OFICVSM PIC X(44).
*
*
**********************************************
*
WORKING-STORAGE SECTION.
*
*--------------------------------------------
*--- AREA DE COPYS ---*
*---------------------------------------------
*
*--------------- COPY FICHERO OFICINAS ------------
COPY COFICINA REPLACING CSAM-COFICINA BY ==ENT-V0==.
*
COPY COFICINA REPLACING CSAM-COFICINA BY ==ENT-V1==.
*
*--------------------------------------------------
* AREA DE SWITCHES
*-------------------------------------------------
*--> Final fichero OFICINAS VERSION 0
01 WB-FIN-ENTRADA0 PIC X(1) VALUE 'N'.
88 FIN-ENTRADA0 VALUE 'S'.
*--> Final fichero OFICINAS VERSION 1
01 WB-FIN-ENTRADA1 PIC X(1) VALUE 'N'.
88 FIN-ENTRADA1 VALUE 'S'.
*
*------------------------------------------------
* CODIGOS DE ESTADO DE FICHEROS
*-------------------------------------------------
* FILE STATUS
01 FS-STATUS.
05 FS-ENTRADA0 PIC X(2).
88 FS-ENTRADA0-OK VALUE '00'.
88 FS-ENTRADA0-EOF VALUE '10'.
05 FS-ENTRADA1 PIC X(2).
88 FS-ENTRADA1-OK VALUE '00'.
88 FS-ENTRADA1-EOF VALUE '10'.
05 FS-SALIDA PIC X(2).
88 FS-SALIDA-OK VALUE '00'.
*----------------------------------------------------
* REGISTROS LEIDOS - GRABADOS - BORRADOS - MODIFICADOS
*----------------------------------------------------
01 WC-PROCESADOS.
03 REG-LEIDOS-EN0 PIC 9(09) VALUE ZEROS.
03 REG-LEIDOS-EN1 PIC 9(09) VALUE ZEROS.
03 REG-GRABADOS-VSAM PIC 9(09) VALUE ZEROS.
03 REG-BORRADOS-VSAM PIC 9(09) VALUE ZEROS.
03 REG-MODIF-VSAM PIC 9(09) VALUE ZEROS.
*
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 1000-INICIO
PERFORM 2000-PROCESO
UNTIL FIN-ENTRADA0 AND FIN-ENTRADA1
PERFORM 3000-FINAL
.
*
*-----------
1000-INICIO.
*-----------
PERFORM 1100-ABRIR-FICHEROS
*
*--> LEEMOS PRIMERA OFICINA
PERFORM LEER-ENTRADA0
PERFORM LEER-ENTRADA1
.
*
*---------------
2000-PROCESO.
*---------------
*
EVALUATE TRUE
WHEN CSAM-CLAVE OF ENT-V0
EQUAL CSAM-CLAVE OF ENT-V1
IF ENT-V0 NOT EQUAL ENT-V1
*---------> ACTUALIZAR CLAVE EN FICHERO VSAM
MOVE ENT-V0 TO REG-VSAM
PERFORM 2100-MODIFICAR-VSAM
END-IF
PERFORM LEER-ENTRADA0
PERFORM LEER-ENTRADA1
WHEN CSAM-CLAVE OF ENT-V0 GREATER THAN
CSAM-CLAVE OF ENT-V1
*---------> DAR DE BAJA CLAVE DE V1 EN FICHERO VSAM
MOVE CSAM-CLAVE OF ENT-V1
TO CLAVE-OFICVSM
PERFORM 2200-BAJA-VSAM
PERFORM LEER-ENTRADA1
WHEN CSAM-CLAVE OF ENT-V0 LESS THAN
CSAM-CLAVE OF ENT-V1
*---------> DAR DE ALTA LA CLAVE DE V0 EN FICHERO VSAM
MOVE ENT-V0 TO REG-VSAM
PERFORM 2300-ALTA-VSAM
PERFORM LEER-ENTRADA0
END-EVALUATE
.
*
*-----------
3000-FINAL.
*-----------
PERFORM CERRAR-FICHEROS
*
PERFORM ESTADISTICAS
STOP RUN
.
*
*-----------------------
1100-ABRIR-FICHEROS.
*-----------------------
OPEN INPUT ENTRADA0
ENTRADA1
I-O SALIDA
IF NOT FS-ENTRADA0-OK
DISPLAY 'ERROR EN ABRIR-ENTRADA1'
DISPLAY 'FILE-STATUS = 'FS-ENTRADA0
END-IF
IF NOT FS-ENTRADA1-OK
DISPLAY 'ERROR EN ABRIR-ENTRADA2'
DISPLAY 'FILE-STATUS = 'FS-ENTRADA1
END-IF
IF NOT FS-SALIDA-OK
DISPLAY 'ERROR EN ABRIR-FVSAM'
DISPLAY 'FILE-STATUS = ' FS-SALIDA
END-IF
.
*
*----------------------
LEER-ENTRADA0.
*----------------------
READ ENTRADA0 INTO ENT-V0
EVALUATE TRUE
WHEN FS-ENTRADA0-OK
ADD 1 TO REG-LEIDOS-EN0
WHEN FS-ENTRADA0-EOF
SET FIN-ENTRADA0 TO TRUE
WHEN OTHER
DISPLAY 'ERROR EN LEER-ENTRADA0'
DISPLAY 'FILE-STATUS = ' FS-ENTRADA0
PERFORM ESTADISTICAS
END-EVALUATE
.
*
*------------------------
CERRAR-FICHEROS.
*------------------------
CLOSE ENTRADA0
ENTRADA1
SALIDA
IF NOT FS-ENTRADA0-OK
DISPLAY 'ERROR EN CERRAR-ENTRADA0'
DISPLAY 'FILE-STATUS = ' FS-ENTRADA0
PERFORM ESTADISTICAS
END-IF
IF NOT FS-ENTRADA1-OK
DISPLAY 'ERROR EN CERRAR-ENTRADA1'
DISPLAY 'FILE-STATUS = 'FS-ENTRADA1
PERFORM ESTADISTICAS
END-IF
IF NOT FS-SALIDA-OK
DISPLAY 'ERROR EN CERRAR-FVSAM'
DISPLAY 'FILE-STATUS = ' FS-SALIDA
PERFORM ESTADISTICAS
END-IF
.
*
*----------------------
LEER-ENTRADA1.
*----------------------
READ ENTRADA1 INTO REG-ENTRADA1
EVALUATE TRUE
WHEN FS-ENTRADA1-OK
ADD 1 TO REG-LEIDOS-EN1
WHEN FS-ENTRADA1-EOF
SET FIN-ENTRADA1 TO TRUE
WHEN OTHER
DISPLAY 'ERROR EN LEER-ENTRADA1'
DISPLAY 'FILE-STATUS = ' FS-ENTRADA1
PERFORM ESTADISTICAS
END-EVALUATE
.
*
*------------------
2100-MODIFICAR-VSAM.
*------------------
REWRITE REG-VSAM
INVALID KEY
DISPLAY 'ERROR EN MODIFICAR-VSAM'
DISPLAY 'FILE-STATUS = ' FS-SALIDA
PERFORM ESTADISTICAS
ADD 1 TO REG-MODIF-VSAM
.
*-------------
2200-BAJA-VSAM.
*-------------
DELETE REG-VSAM
INVALID KEY
DISPLAY 'ERROR EN BAJA-VSAM'
DISPLAY 'FILE-STATUS = ' FS-SALIDA
PERFORM ESTADISTICAS
ADD 1 TO REG-BORRADOS-VSAM
.
*-------------
2300-ALTA-VSAM.
*-------------
WRITE REG-VSAM
INVALID KEY
DISPLAY 'ERROR EN ALTA-VSAM'
DISPLAY 'FILE-STATUS = ' FS-SALIDA
PERFORM ESTADISTICAS
ADD 1 TO REG-GRABADOS-VSAM
.
*
*--------------------------------------------
* ESTADISTICAS
*-------------------------------------------
ESTADISTICAS.
*-------------
DISPLAY '******************************************'
DISPLAY '* E S T A D I S T I C A S *'
DISPLAY '******************************************'
DISPLAY ' PROGRAMA PGMVSAM'
DISPLAY '******************************************'
DISPLAY 'REG. LEIDOS OFI V0 ........ ' REG-LEIDOS-EN0
DISPLAY 'REG. LEIDOS OFI V-1 ....... ' REG-LEIDOS-EN1
DISPLAY 'REG. GRABADOS OFI VSAM .... ' REG-GRABADOS-VSAM
DISPLAY 'REG. BORRADOS OFI VSAM .... ' REG-BORRADOS-VSAM
DISPLAY 'REG. MODIFIC EN OFI VSAM .. ' REG-MODIF-VSAM
DISPLAY '******************************************'
.
*********************************************
Este ejemplo os lo dejo sin probar, así que puede haber algún error en el código.
Cualquier duda la vemos!
Mostrando entradas con la etiqueta ejemplo. Mostrar todas las entradas
Mostrando entradas con la etiqueta ejemplo. Mostrar todas las entradas
miércoles, 28 de enero de 2015
lunes, 12 de diciembre de 2011
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.
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
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
miércoles, 22 de junio de 2011
Ejemplo 1: Leer de SYSIN y escribir en SYSPRINT (pl/i).
En PL/I hay que diferenciar entre los programas que acceden a DB2 y los que no, pues se compilarán de maneras diferentes y se ejecutarán de forma diferente.
Enpezaremos por ver el programa sin DB2 más sencillo:
El programa más sencillo es aquel que recibe datos por SYSIN del JCL y los muestra por SYSPRINT.
JCL:
//PROG1 EXEC PGM=PRUEBA1
//SYSPRINT DD SYSOUT=*
//SYSIN DD *
JOSE LOPEZ VAZQUEZ HUGO CASILLAS DIAZ
JAVIER CARBONERO PACO GONZALEZ
JESUS IGLESIAS RICARDO MONTES
/*
donde EXEC PGM= indica el programa SIN DB2 que vamos a ejecutar
SYSPRINT DD SYSOUT=* indica que la información "displayada" se quedará en la cola del SYSPRINT (no lo vamos a guardar en un fichero)
en SYSIN DD * metemos la información que va a recibir el programa
Fijaos en las posiciones de los nombres de la SYSIN, para entender bien el programa:
----+----1----+----2----+----3----+----4----+----5----+----6----+----7----+----8
JOSE LOPEZ VAZQUEZ HUGO CASILLAS DIAZ
JAVIER CARBONERO PACO GONZALEZ
JESUS IGLESIAS RICARDO MONTES
Como veis, hemos dividido la información en 2 trozos de 20 posiciones, cada uno con un nombre. Además hemos escrito varias líneas de SYSIN, pues como vimos en el artículo de Ficheros en PL/I, podemos recuperar varias líneas (en COBOL esto no es posible).
PROGRAMA:
PLIPRU1: PROCEDURE OPTIONS (MAIN);
/* PROGRAMA QUE LEE DE SYSIN(GET EDIT)*/
/* Y ESCRIBE EN SYSPRINT (PUT EDIT) */
/*DEFINIMOS SYSIN*/
DCL SYSIN FILE STREAM INPUT;
/*DEFINIMOS SYSPRINT*/
DCL SYSPRINT FILE PRINT;
/*DECLARACION DE VARIABLES DEL PROGRAMA*/
DCL 1 TABLA_NOMBRES,
2 NOMBRE(6) CHAR(20);
DCL 1 LINEA_SYSIN,
2 NOMBRE_SYSIN1 CHAR(20),
2 NOMBRE_SYSIN2 CHAR(20);
DCL CONT_NOMBRE DEC FIXED (2);
DCL FIN CHAR(1) INIT ('0');
/*CONTROL FIN SYSIN*/
ON ENDFILE(SYSIN) BEGIN;
FIN = '1';
END;
/*PROCESO DEL PROGRAMA*/
GET FILE(SYSIN) EDIT(LINEA_SYSIN)(A(40));
CONT_NOMBRE = 1;
DO WHILE (FIN = '0');
CALL MOVER_A_TABLA;
GET FILE(SYSIN) EDIT(LINEA_SYSIN)(A(40));
END;
CALL PINTAR_NOMBRES;
/*PARRAFO QUE GUARDA LOS NOMBRES RECUPERADOS EN TABLA_NOMBRES*/
MOVER_A_TABLA: PROC;
NOMBRE(CONT_NOMBRE) = NOMBRE_SYSIN1;
CONT_NOMBRE = CONT_NOMBRE + 1;
NOMBRE(CONT_NOMBRE) = NOMBRE_SYSIN2;
CONT_NOMBRE = CONT_NOMBRE + 1;
END MOVER_A_TABLA;
/*PARRAFO QUE ESCRIBE EN EL SYSPRINT LOS NOMBRES DE LA SYSIN*/
PINTAR_NOMBRES: PROC;
CONT_NOMBRE = 1;
DO WHILE CONT_NOMBRE < 7
PUT EDIT('NOMBRE: ', NOMBRE(CONT_NOMBRE)) (SKIP,A,A);
CONT_NOMBRE = CONT_NOMBRE + 1;
END;
END PINTAR_NOMBRES;
END PLIPRU1;
En el programa podemos ver las siguientes sentencias:
ON ENDFILE(SYSIN): controla el final de la SYSIN (como el fin fichero pero para la SYSIN).
GET FILE: lee del fichero STREAM SYSIN.
DO WHILE: es un bucle. Las instrucciones de dentro del bucle se harán MIENTRAS se cumpla la condición indicada.
CALL: llamada a párrafo
PUT EDIT: escribe en el fichero STREAM SYSPRINT.
SKIP: indica salto de línea.
END PLIPRU1: indica fin del programa.
Descripción del programa:
Al inicio, declararemos los ficheros y las variables que utilizaremos a lo largo del programa.
En el proceso principal, leemos el primer registro de la SYSIN y ponemos a 1 el contador CONT_NOMBRE y montamos un bucle para recuperar todos los registros.
En el párrafo MOVER_A_TABLA guardamos los 2 nombres recuperados de la SYSIN en diferentes filas de la tabla TABLA_NOMBRES. Para ello indicamos entre paréntesis el número de la fila donde se va a guardar. El máximo de filas de la tabla es 6 (es el número indicado entre paréntesis al lado del campo NOMBRE).
En el párrafo PINTAR_NOMBRES escribiremos en el SYSPRINT todos los nombres guardados en nuestra TABLA_NOMBRES.
Informamos el campo CONT_NOMBRE con un 1, pues vamos a utilizar los campos de la tabla interna:
Para utilizar un campo que pertenezca a una tabla interna, debemos acompañar el campo de un "índice" entre paréntesis. De tal forma que indiquemos a que fila de la tabla nos estamos refiriendo. Por ejemplo, NOMBRE(1) sería el primer nombre guardado (JOSE LOPEZ VAZQUEZ).
Como queremos displayar todas las filas de la tabla, haremos que el índice sea una variable que va aumentando.
A continuación montamos un bucle (DO WHILE) con la condición CONT_NOMBRE menor de 7, pues el máximo es 6. La primera vez CONT_NOMBRE valdrá 1, y necesitamos que el bucle se repita 6 veces:
CONT_NOMBRE = 1: NOMBRE(1) = JOSE LOPEZ VAZQUEZ
CONT_NOMBRE = 2: NOMBRE(2) = HUGO CASILLAS DIAZ
CONT_NOMBRE = 3: NOMBRE(3) = JAVIER CARBONERO
CONT_NOMBRE = 4: NOMBRE(4) = PACO GONZALEZ
CONT_NOMBRE = 5: NOMBRE(5) = JESUS IGLESIAS
CONT_NOMBRE = 6: NOMBRE(6) = RICARDO MONTES
CONT_NOMBRE = 7: salimos del bucle porque ya no se cumple CONT_NOMBRE menor que 7
NOTA: el índice de una tabla interna NUNCA puede ser cero, pues no existe la fila cero. Si no informásemos CONT_NOMBRE con 1, el PUT de NOMBRE(0) nos daría un estupendo OFFSET.
RESULTADO:
NOMBRE: JOSE LOPEZ VAZQUEZ
NOMBRE: HUGO CASILLAS DIAZ
NOMBRE: JAVIER CARBONERO
NOMBRE: PACO GONZALEZ
NOMBRE: JESUS IGLESIAS
NOMBRE: RICARDO MONTES
He de decir que no me ha dado tiempo a ejecutar este ejemplo, en cuanto tenga un rato lo pruebo y corrijo si es necesario.
Enpezaremos por ver el programa sin DB2 más sencillo:
El programa más sencillo es aquel que recibe datos por SYSIN del JCL y los muestra por SYSPRINT.
JCL:
//PROG1 EXEC PGM=PRUEBA1
//SYSPRINT DD SYSOUT=*
//SYSIN DD *
JOSE LOPEZ VAZQUEZ HUGO CASILLAS DIAZ
JAVIER CARBONERO PACO GONZALEZ
JESUS IGLESIAS RICARDO MONTES
/*
donde EXEC PGM= indica el programa SIN DB2 que vamos a ejecutar
SYSPRINT DD SYSOUT=* indica que la información "displayada" se quedará en la cola del SYSPRINT (no lo vamos a guardar en un fichero)
en SYSIN DD * metemos la información que va a recibir el programa
Fijaos en las posiciones de los nombres de la SYSIN, para entender bien el programa:
----+----1----+----2----+----3----+----4----+----5----+----6----+----7----+----8
JOSE LOPEZ VAZQUEZ HUGO CASILLAS DIAZ
JAVIER CARBONERO PACO GONZALEZ
JESUS IGLESIAS RICARDO MONTES
Como veis, hemos dividido la información en 2 trozos de 20 posiciones, cada uno con un nombre. Además hemos escrito varias líneas de SYSIN, pues como vimos en el artículo de Ficheros en PL/I, podemos recuperar varias líneas (en COBOL esto no es posible).
PROGRAMA:
PLIPRU1: PROCEDURE OPTIONS (MAIN);
/* PROGRAMA QUE LEE DE SYSIN(GET EDIT)*/
/* Y ESCRIBE EN SYSPRINT (PUT EDIT) */
/*DEFINIMOS SYSIN*/
DCL SYSIN FILE STREAM INPUT;
/*DEFINIMOS SYSPRINT*/
DCL SYSPRINT FILE PRINT;
/*DECLARACION DE VARIABLES DEL PROGRAMA*/
DCL 1 TABLA_NOMBRES,
2 NOMBRE(6) CHAR(20);
DCL 1 LINEA_SYSIN,
2 NOMBRE_SYSIN1 CHAR(20),
2 NOMBRE_SYSIN2 CHAR(20);
DCL CONT_NOMBRE DEC FIXED (2);
DCL FIN CHAR(1) INIT ('0');
/*CONTROL FIN SYSIN*/
ON ENDFILE(SYSIN) BEGIN;
FIN = '1';
END;
/*PROCESO DEL PROGRAMA*/
GET FILE(SYSIN) EDIT(LINEA_SYSIN)(A(40));
CONT_NOMBRE = 1;
DO WHILE (FIN = '0');
CALL MOVER_A_TABLA;
GET FILE(SYSIN) EDIT(LINEA_SYSIN)(A(40));
END;
CALL PINTAR_NOMBRES;
/*PARRAFO QUE GUARDA LOS NOMBRES RECUPERADOS EN TABLA_NOMBRES*/
MOVER_A_TABLA: PROC;
NOMBRE(CONT_NOMBRE) = NOMBRE_SYSIN1;
CONT_NOMBRE = CONT_NOMBRE + 1;
NOMBRE(CONT_NOMBRE) = NOMBRE_SYSIN2;
CONT_NOMBRE = CONT_NOMBRE + 1;
END MOVER_A_TABLA;
/*PARRAFO QUE ESCRIBE EN EL SYSPRINT LOS NOMBRES DE LA SYSIN*/
PINTAR_NOMBRES: PROC;
CONT_NOMBRE = 1;
DO WHILE CONT_NOMBRE < 7
PUT EDIT('NOMBRE: ', NOMBRE(CONT_NOMBRE)) (SKIP,A,A);
CONT_NOMBRE = CONT_NOMBRE + 1;
END;
END PINTAR_NOMBRES;
END PLIPRU1;
En el programa podemos ver las siguientes sentencias:
ON ENDFILE(SYSIN): controla el final de la SYSIN (como el fin fichero pero para la SYSIN).
GET FILE: lee del fichero STREAM SYSIN.
DO WHILE: es un bucle. Las instrucciones de dentro del bucle se harán MIENTRAS se cumpla la condición indicada.
CALL: llamada a párrafo
PUT EDIT: escribe en el fichero STREAM SYSPRINT.
SKIP: indica salto de línea.
END PLIPRU1: indica fin del programa.
Descripción del programa:
Al inicio, declararemos los ficheros y las variables que utilizaremos a lo largo del programa.
En el proceso principal, leemos el primer registro de la SYSIN y ponemos a 1 el contador CONT_NOMBRE y montamos un bucle para recuperar todos los registros.
En el párrafo MOVER_A_TABLA guardamos los 2 nombres recuperados de la SYSIN en diferentes filas de la tabla TABLA_NOMBRES. Para ello indicamos entre paréntesis el número de la fila donde se va a guardar. El máximo de filas de la tabla es 6 (es el número indicado entre paréntesis al lado del campo NOMBRE).
En el párrafo PINTAR_NOMBRES escribiremos en el SYSPRINT todos los nombres guardados en nuestra TABLA_NOMBRES.
Informamos el campo CONT_NOMBRE con un 1, pues vamos a utilizar los campos de la tabla interna:
Para utilizar un campo que pertenezca a una tabla interna, debemos acompañar el campo de un "índice" entre paréntesis. De tal forma que indiquemos a que fila de la tabla nos estamos refiriendo. Por ejemplo, NOMBRE(1) sería el primer nombre guardado (JOSE LOPEZ VAZQUEZ).
Como queremos displayar todas las filas de la tabla, haremos que el índice sea una variable que va aumentando.
A continuación montamos un bucle (DO WHILE) con la condición CONT_NOMBRE menor de 7, pues el máximo es 6. La primera vez CONT_NOMBRE valdrá 1, y necesitamos que el bucle se repita 6 veces:
CONT_NOMBRE = 1: NOMBRE(1) = JOSE LOPEZ VAZQUEZ
CONT_NOMBRE = 2: NOMBRE(2) = HUGO CASILLAS DIAZ
CONT_NOMBRE = 3: NOMBRE(3) = JAVIER CARBONERO
CONT_NOMBRE = 4: NOMBRE(4) = PACO GONZALEZ
CONT_NOMBRE = 5: NOMBRE(5) = JESUS IGLESIAS
CONT_NOMBRE = 6: NOMBRE(6) = RICARDO MONTES
CONT_NOMBRE = 7: salimos del bucle porque ya no se cumple CONT_NOMBRE menor que 7
NOTA: el índice de una tabla interna NUNCA puede ser cero, pues no existe la fila cero. Si no informásemos CONT_NOMBRE con 1, el PUT de NOMBRE(0) nos daría un estupendo OFFSET.
RESULTADO:
NOMBRE: JOSE LOPEZ VAZQUEZ
NOMBRE: HUGO CASILLAS DIAZ
NOMBRE: JAVIER CARBONERO
NOMBRE: PACO GONZALEZ
NOMBRE: JESUS IGLESIAS
NOMBRE: RICARDO MONTES
He de decir que no me ha dado tiempo a ejecutar este ejemplo, en cuanto tenga un rato lo pruebo y corrijo si es necesario.
miércoles, 23 de marzo de 2011
Ejemplo 4: generando un listado.
Un programa típico que nos encontraremos en cualquier aplicación es aquel que genera un listado. ¿Que a qué nos referimos con listado? Mejor verlo para hacernos una idea:
----+----1----+----2----+----3----+----4----+
LISTADO DE EJEMPLO DEL CONSULTORIO COBOL
DIA: 23-03-11 PAGINA: 1
------------------------------------------
NOMBRE APELLIDO
--------- ---------------
ANA LOPEZ
ANA MARTINEZ
ANA PEREZ
ANA RODRIGUEZ
TOTAL ANA : 04
LISTADO DE EJEMPLO DEL CONSULTORIO COBOL
DIA: 23-03-11 PAGINA: 2
------------------------------------------
NOMBRE APELLIDO
--------- ---------------
BEATRIZ GARCIA
BEATRIZ MOREDA
BEATRIZ OTERO
TOTAL BEATRIZ : 03
TOTAL NOMBRES: 07
Aquí vemos un listado de 2 páginas. Ambas páginas tienen una parte común que se denomina cabecera y que, por lo general, será la misma en todas las páginas. Suele contener un título que describa al listado y la fecha en que ha sido generado. Lo único que cambia es el número de página en el que estamos^^
Después tenemos una "subcabecera" también común en cada página, en este caso la subcabecera incluye a "NOMBRE" y "APELLIDO".
En nuestro listado de ejemplo hemos querido que cada nombre salga en una página distinta. Al final de cada página de nombre escribimos un "subtotal" con el número de registros que hemos escrito para ese nombre.
Al final del listado escribiremos una linea de "totales" con el total de registros escritos.
El fichero de partida para este programa será el siguiente:
----+----1----+----2
ANA LOPEZ
ANA MARTINEZ
ANA PEREZ
ANA RODRIGUEZ
BEATRIZ GARCIA
BEATRIZ MOREDA
BEATRIZ OTERO
Los ficheros que se usan en listados siempre están ordenados por algún campo. En nuestro caso por "nombre" y "apellido". En el JCL incluiremos el paso de SORT para ordenarlo.
Vamos allá!
Fichero de entrada desordenado:
----+----1----+----2
ANA LOPEZ
BEATRIZ MOREDA
ANA PEREZ
BEATRIZ OTERO
ANA RODRIGUEZ
BEATRIZ GARCIA
ANA MARTINEZ
JCL:
//******************************************************
//******************** BORRADO *************************
//BORRADO EXEC PGM=IDCAMS
//SYSPRINT DD SYSOUT=*
//SYSIN DD *
DEL FICHERO.NOMBRES.APELLIDO.ORDENADO
DEL FICHERO.CON.LISTADO
SET MAXCC = 0
//******************************************************
//* ORDENAMOS EL FICHERO POR NOMBRE Y APELLIDO *********
//SORT01 EXEC PGM=SORT
//SORTIN DD DSN=FICHERO.NOMBRES.APELLIDO,DISP=SHR
//SORTOUT DD DSN=FICHERO.NOMBRES.APELLIDO.ORDENADO,
// DISP=(,CATLG),SPACE=(TRK,(50,10))
//SYSOUT DD SYSOUT=*
//SYSPRINT DD SYSOUT=*
//SYSIN DD *
SORT FIELDS=(1,9,CH,A,10,10,CH,A)
//******************************************************
//*********** EJECUCION DEL PROGRAMA PRUEBA3 ***********
//PROG4 EXEC PGM=PRUEBA4
//SYSOUT DD SYSOUT=*
//ENTRADA DD DSN=FICHERO.NOMBRES.APELLIDO.ORDENADO,DISP=SHR
//SALIDA DD DSN=FICHERO.CON.LISTADO,
// DISP=(NEW, CATLG, DELETE),SPACE=(TRK,(50,10)),
// DCB=(RECFM=FBA,LRECL=133)
/*
En este JCL tenemos 3 pasos:
Paso 1: Borrado de ficheros que se generan durante la ejecución, visto ya en otros ejemplos.
Paso 2: Ordenación del fichero de entrada usando el SORT. Toda la información sobre el SORT la tenéis en SORT vol.1: SORT, INCLUDE.
Paso 3: Ejecución del programa que genera el listado. Tenemos como fichero de entrada el fichero de salida del SORT, y como fichero de salida ojito: indicaremos RECFM=FBA siempre para listados. Esto significa que el fichero contiene caracteres ASA, que son los que le indican a la impresora los saltos de línea que tiene que hacer al imprimir. Lo iremos viendo con el programa de ejemplo. La longitud del fichero(LRECL) suele ser 133, debido a que se imprimen en hojas A4 en formato apaisado.
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 LISTADO ASSIGN TO LISTADO
STATUS IS FS-LISTADO.
*
DATA DIVISION.
*
FILE SECTION.
*
* FICHERO DE ENTRADA DE LONGITUD FIJA (F) IGUAL A 20.
FD ENTRADA RECORDING MODE IS F
BLOCK CONTAINS 0 RECORDS
RECORD CONTAINS 20 CHARACTERS.
01 REG-ENTRADA PIC X(20).
*
* FICHERO DE LISTADO DE LONGITUD FIJA (F) IGUAL A 132.
FD LISTADO RECORDING MODE IS F
BLOCK CONTAINS 0 RECORDS
RECORD CONTAINS 132 CHARACTERS.
01 REG-LISTADO PIC X(132).
*
WORKING-STORAGE SECTION.
*
* FILE STATUS
*
01 FS-STATUS.
05 FS-ENTRADA PIC X(2).
88 FS-ENTRADA-OK VALUE '00'.
88 FS-ENTRADA-EOF VALUE '10'.
05 FS-LISTADO PIC X(2).
88 FS-LISTADO-OK VALUE '00'.
*
* SWITCHES
*
01 WB-FIN-ENTRADA PIC X(1) VALUE 'N'.
88 FIN-ENTRADA VALUE 'S'.
*
* CONTADORES
*
01 WC-LINEAS PIC 9(2).
01 WC-NOMBRES PIC 9(2).
01 WC-TOTALES PIC 9(2).
*
* VARIABLES
*
01 WX-REGISTRO-ENTRADA.
05 WX-NOMBRE PIC X(9).
05 WX-APELLIDO PIC X(10).
01 WX-NOMBRE-ANT PIC X(9).
01 WX-FEC-DDMMAA.
05 WX-FEC-DD PIC 9(2).
05 FILLER PIC X VALUE '-'.
05 WX-FEC-MM PIC 9(2).
05 FILLER PIC X VALUE '-'.
05 WX-FEC-AA PIC 9(2).
01 WX-FECHA PIC 9(6).
*
* REGISTRO LISTADO
*
01 CABECERA1.
05 FILLER PIC X(40)
VALUE 'LISTADO DE EJEMPLO DEL CONSULTORIO
- 'COBOL'.
01 CABECERA2.
05 FILLER PIC X(5) VALUE 'DIA: '.
05 LT-FECHA PIC X(8).
05 FILLER PIC X(16) VALUE ALL SPACES.
05 FILLER PIC X(8) VALUE 'PAGINA: '.
05 LT-NUMPAG PIC 9.
*
01 CABECERA3.
05 FILLER PIC X(42) VALUE ALL '-'.
*
01 SUBCABECERA1.
05 FILLER PIC X(6) VALUE 'NOMBRE'.
05 FILLER PIC X(9) VALUE ALL SPACES.
05 FILLER PIC X(8) VALUE 'APELLIDO'.
*
01 SUBCABECERA2.
05 FILLER PIC X(9) VALUE ALL '-'.
05 FILLER PIC X(3) VALUE ALL SPACES.
05 FILLER PIC X(15) VALUE ALL '-'.
*
01 DETALLE.
05 LT-NOMBRE PIC X(9).
05 FILLER PIC X(3) VALUE ALL SPACES.
05 LT-APELLIDO PIC X(15).
*
01 SUBTOTAL.
05 FILLER PIC X(6) VALUE 'TOTAL '.
05 LT-NOMTOT PIC X(9).
05 FILLER PIC X(2) VALUE ': '.
05 LT-NUMNOM PIC 9(2).
01 TOTALES.
05 FILLER PIC X(15) VALUE 'TOTAL NOMBRES: '.
05 LT-TOTALES PIC 9(2).
*
************************************************************
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 DEL FICHERO DE ENTRADA
* 3| INFORMAMOS CABECERA Y ESCRIBIMOS CABECERA
************************************************************
10000-INICIO.
*
INITIALIZE DETALLE
WX-REGISTRO-ENTRADA
PERFORM 11000-ABRIR-FICHEROS
PERFORM LEER-ENTRADA
IF FIN-ENTRADA
DISPLAY 'FICHERO DE ENTRADA VACIO'
PERFORM 30000-FINAL
END-IF
MOVE WX-NOMBRE TO WX-NOMBRE-ANT
PERFORM INFORMAR-CABECERA
PERFORM ESCRIBIR-CABECERAS
.
*
************************************************************
* 11000 - ABRIR FICHEROS
*--|------------------+----------><----------+-------------*
* ABRIMOS LOS FICHEROS DEL PROGRAMA ************************************************************
11000-ABRIR-FICHEROS.
*
OPEN INPUT ENTRADA
OUTPUT LISTADO
*
IF NOT FS-ENTRADA-OK
DISPLAY 'ERROR EN OPEN DE ENTRADA:'FS-ENTRADA
END-IF
IF NOT FS-LISTADO-OK
DISPLAY 'ERROR EN OPEN DE LISTADO:'FS-LISTADO
END-IF
.
*
************************************************************
* 12000 - INFORMAR CABECERA
*--|------------------+----------><----------+-------------*
* INFORMAMOS EL CAMPO FECHA DE LA CABECERA ************************************************************
INFORMAR-CABECERA.
*
ACCEPT WX-FECHA FROM DATE
MOVE WX-FECHA(1:2) TO WX-FEC-AA
MOVE WX-FECHA(3:2) TO WX-FEC-MM
MOVE WX-FECHA(5:2) TO WX-FEC-DD
MOVE WX-FEC-DDMMAA TO LT-FECHA
* Inicializamos el contador de páginas
MOVE 1 TO LT-NUMPAG
.
*
************************************************************
* | 20000 - PROCESO
*--|------------------+----------><------------------------*
* | SE REALIZA EL TRATAMIENTO DE LOS DATOS:
* 1| ESCRIBIMOS LAS LINEAS DE DETALLE Y CONTROLAMOS LOS
* | SALTOS DE PAGINA
************************************************************
20000-PROCESO.
*
INITIALIZE DETALLE
IF WC-LINEAS GREATER 64
ADD 1 TO LT-NUMPAG
PERFORM ESCRIBIR-CABECERAS
END-IF
IF WX-NOMBRE NOT EQUAL WX-NOMBRE-ANT
PERFORM ESCRIBIR-SUBTOTAL
ADD 1 TO LT-NUMPAG
PERFORM ESCRIBIR-CABECERAS
MOVE ZEROES TO WC-NOMBRES
END-IF
PERFORM 21000-INFORMAR-DETALLE
PERFORM ESCRIBIR-DETALLE
MOVE WX-NOMBRE TO WX-NOMBRE-ANT
PERFORM LEER-ENTRADA
.
*
************************************************************
* ESCRIBIR CABECERAS
*--|------------------+----------><----------+-------------*
* ESCRIBE LA CABECERA Y SUBCABECERA DEL LISTADO ************************************************************
ESCRIBIR-CABECERAS.
*
WRITE REG-LISTADO FROM CABECERA1 AFTER ADVANCING PAGE
WRITE REG-LISTADO FROM CABECERA2
WRITE REG-LISTADO FROM CABECERA3
WRITE REG-LISTADO FROM SUBCABECERA1 AFTER ADVANCING 2 LINES
WRITE REG-LISTADO FROM SUBCABECERA2
MOVE 6 TO WC-LINEAS
.
*
************************************************************
* ESCRIBIR SUBTOTAL
*--|------------------+----------><----------+-------------*
* ESCRIBIMOS LINEA DE SUBTOTAL ************************************************************
ESCRIBIR-SUBTOTAL.
*
MOVE WX-NOMBRE-ANT TO LT-NOMTOT
MOVE WC-NOMBRES TO LT-NUMNOM
WRITE REG-LISTADO FROM SUBTOTAL AFTER ADVANCING 2 LINES
.
*
************************************************************
* 21000 INFORMAR DETALLE
*--|------------------+----------><----------+-------------*
* INFORMAMOS LOS CAMPOS DE LA LINEA DE DETALLE CON LA
* INFORMACION DEL FICHERO DE ENTRADA ************************************************************
21000-INFORMAR-DETALLE.
*
MOVE WX-NOMBRE TO LT-NOMBRE
MOVE WX-APELLIDO TO LT-APELLIDO
.
*
************************************************************
* ESCRIBIR DETALLE
*--|------------------+----------><----------+-------------*
* ESCRIBIMOS LA LINEA DE DETALLE ************************************************************
ESCRIBIR-DETALLE.
*
WRITE REG-LISTADO FROM DETALLE
IF NOT FS-LISTADO-OK
DISPLAY 'ERROR AL ESCRIBIR DETALLE:'FS-LISTADO
END-IF
ADD 1 TO WC-LINEAS
ADD 1 TO WC-NOMBRES
ADD 1 TO WC-TOTALES
.
*
************************************************************
* 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
.
*
************************************************************
* | 30000 - FINAL
*--|------------------+----------><----------+-------------*
* | FINALIZA LA EJECUCION DEL PROGRAMA ************************************************************
30000-FINAL.
*
IF WC-LINEAS GREATER 60
ADD 1 TO LT-NUMPAG
PERFORM ESCRIBIR-CABECERAS
PERFORM ESCRIBIR-SUBTOTAL
PERFORM ESCRIBIR-TOTALES
ELSE
PERFORM ESCRIBIR-SUBTOTAL
PERFORM ESCRIBIR-TOTALES
END-IF
PERFORM 31000-CERRAR-FICHEROS
STOP RUN
.
*
************************************************************
* | ESCRIBIR TOTALES
*--|------------------+----------><----------+-------------*
* | ESCRIBIMOS LA LINEA DE TOTALES DEL LISTADO ************************************************************
ESCRIBIR-TOTALES.
*
MOVE WC-TOTALES TO LT-TOTALES
WRITE REG-LISTADO FROM TOTALES
.
*
************************************************************
* | 31000 - CERRAR FICHEROS
*--|------------------+----------><----------+-------------*
* | CERRAMOS LOS FICHEROS DEL PROGRAMA
************************************************************
31000-CERRAR-FICHEROS.
*
CLOSE ENTRADA
LISTADO
IF NOT FS-ENTRADA-OK
DISPLAY 'ERROR EN CLOSE DE ENTRADA:'FS-ENTRADA
END-IF
IF NOT FS-LISTADO-OK
DISPLAY 'ERROR EN CLOSE DE LISTADO:'FS-LISTADO
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.
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.
EVALUATE TRUE: "Evalúa" si los niveles 88 por los que preguntamos en el "WHEN" están activados a "TRUE".
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 entrada, 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.
Leemos el primer registro del fichero de entrada y controlaremos el file-status.
Además comprobamos que el fichero de entrada no venga vacío (en caso de que así sea, finalizamos la ejecución). Si todo ha ido OK guardaremos el nombre leído del fichero de entrada en WX-NOMBRE-ANT para controlar posteriormente el momento en que cambiemos de nombre.
Informaremos la parte genérica de la cabecera e inicializamos el contador de páginas. Escribimos la cabecera por primera vez.
INFORMAR-CABECERA:
Recoge la fecha del sistema mediante un ACCEPT. La variable "DATE" es la fecha del sistema en formato 9(6) AAMMDD.
Para informar la fecha del listado formateamos la recibida del sistema a formato DD-MM-AA.
ESCRIBIR-CABECERAS:
Escribe las lineas de cabecera CABECERA1, CABECERA2, CABECERA3, SUBCABECERA1 y SUBCABECERA2.
En el WRITE de CABECERA1 vemos que utilizamos el "AFTER ADVANCING PAGE", esto significa que esta línea se escribirá en una página nueva. Lo podemos ver en el caracter ASA que aparece a la izquierda de esta linea en el fichero de salida que será un '1'.
En el WRITE de SUBCABECERA1 vemos que utilizamos "AFTER ADVANCING 2 LINES", esto significa que se escribirá una línea en blanco y después la línea de SUBCABECERA1. El caracter ASA que aparecerá será un '0'.
Informamos el contador de líneas a '6', pues la cabecera ocupa 6 líneas.
En el párrafo de proceso, que se repetirá hasta que se termine el fichero de entrada (FIN-ENTRADA), controlaremos:
Por un lado el número de líneas escritas, y en caso de superar un máximo (64 en nusetro caso) escribiremos otra vez las cabeceras en una página nueva (ver párrado ESCRIBIR-CABECERAS).
Por otro lado la variable WX-NOMBRE, pues queremos escribir cada nombre en una página distinta. Cuando cambie el nombre escribiremos la línea de subtotales y volveremos a escribir cabeceras (que nos hará el salto de página).
Informaremos la linea de detalle y escribiremos en el fichero del listado.
Guardamos el último nombre escrito en WX-NOMBRE-ANT para controlar el cambio de nombre.
Leemos el siguiente registro del fichero de entrada.
Llamadas a párrafos:
ESCRIBIR-SUBTOTAL:
Informará el campo LT-NOMTOT con el nombre que hemos estado escribiendo, y LT-NUMNOM con el contador de registros escritos para ese nombre.
Escribirá SUBTOTALES dejando antes una línea en blanco (AFTER ADVANCING 2 LINES).
21000-INFORMAR-DETALLE:
Informamos los campos de la línea de detalle LT-NOMBRE y LT-APELLIDO con los campos de lfichero de entrada WX-NOMBRE y WX-APELLIDO.
ESCRIBIR-DETALLE:
Escribe la linea de detalle en el fichero del listado. Controlamos file-status y añadimos uno a los contadores.
En el párrado de FINAL, finalizaremos el programa escribiendo la línea de subtotales que falta, y la línea de totales generales.
Controlaremos el número de líneas que llevamos escritas, pues para escribir la línea SUBTOTALES y TOTALES necesitamos 3 líneas.
En el párrafo de ESCRIBIR-TOTALES informaremos el campo LT-TOTALES con el contador de registros escritos en total.
Al inicio del artículo veiamos como quedaría el listado una vez "impreso", ya sea por pantalla o en papel. Vamos a ver como quedaría el fichero con los caracteres ASA que indican los saltos de linea.
Fichero de salida:
----+----1----+----2----+----3----+----4----+
1LISTADO DE EJEMPLO DEL CONSULTORIO COBOL
DIA: 22-03-11 PAGINA: 1
------------------------------------------
0NOMBRE APELLIDO
--------- ---------------
ANA LOPEZ
ANA MARTINEZ
ANA PEREZ
ANA RODRIGUEZ
0TOTAL ANA : 04
1LISTADO DE EJEMPLO DEL CONSULTORIO COBOL
DIA: 22-03-11 PAGINA: 2
------------------------------------------
0NOMBRE APELLIDO
--------- ---------------
BEATRIZ GARCIA
BEATRIZ MOREDA
BEATRIZ OTERO
0TOTAL BEATRIZ : 03
TOTAL NOMBRES: 07
Donde:
1 = salto de página.
0 = deja una línea en blanco justo antes.
- = deja dos líneas en blanco.
espacio = escribe sin dejar lineas en blanco.
Y listo! Si veis que no me he parado mucho en alguna cosa y queréis que explique más en detalle, dejad un comentario y lo vemos : )
----+----1----+----2----+----3----+----4----+
LISTADO DE EJEMPLO DEL CONSULTORIO COBOL
DIA: 23-03-11 PAGINA: 1
------------------------------------------
NOMBRE APELLIDO
--------- ---------------
ANA LOPEZ
ANA MARTINEZ
ANA PEREZ
ANA RODRIGUEZ
TOTAL ANA : 04
LISTADO DE EJEMPLO DEL CONSULTORIO COBOL
DIA: 23-03-11 PAGINA: 2
------------------------------------------
NOMBRE APELLIDO
--------- ---------------
BEATRIZ GARCIA
BEATRIZ MOREDA
BEATRIZ OTERO
TOTAL BEATRIZ : 03
TOTAL NOMBRES: 07
Aquí vemos un listado de 2 páginas. Ambas páginas tienen una parte común que se denomina cabecera y que, por lo general, será la misma en todas las páginas. Suele contener un título que describa al listado y la fecha en que ha sido generado. Lo único que cambia es el número de página en el que estamos^^
Después tenemos una "subcabecera" también común en cada página, en este caso la subcabecera incluye a "NOMBRE" y "APELLIDO".
En nuestro listado de ejemplo hemos querido que cada nombre salga en una página distinta. Al final de cada página de nombre escribimos un "subtotal" con el número de registros que hemos escrito para ese nombre.
Al final del listado escribiremos una linea de "totales" con el total de registros escritos.
El fichero de partida para este programa será el siguiente:
----+----1----+----2
ANA LOPEZ
ANA MARTINEZ
ANA PEREZ
ANA RODRIGUEZ
BEATRIZ GARCIA
BEATRIZ MOREDA
BEATRIZ OTERO
Los ficheros que se usan en listados siempre están ordenados por algún campo. En nuestro caso por "nombre" y "apellido". En el JCL incluiremos el paso de SORT para ordenarlo.
Vamos allá!
Fichero de entrada desordenado:
----+----1----+----2
ANA LOPEZ
BEATRIZ MOREDA
ANA PEREZ
BEATRIZ OTERO
ANA RODRIGUEZ
BEATRIZ GARCIA
ANA MARTINEZ
JCL:
//******************************************************
//******************** BORRADO *************************
//BORRADO EXEC PGM=IDCAMS
//SYSPRINT DD SYSOUT=*
//SYSIN DD *
DEL FICHERO.NOMBRES.APELLIDO.ORDENADO
DEL FICHERO.CON.LISTADO
SET MAXCC = 0
//******************************************************
//* ORDENAMOS EL FICHERO POR NOMBRE Y APELLIDO *********
//SORT01 EXEC PGM=SORT
//SORTIN DD DSN=FICHERO.NOMBRES.APELLIDO,DISP=SHR
//SORTOUT DD DSN=FICHERO.NOMBRES.APELLIDO.ORDENADO,
// DISP=(,CATLG),SPACE=(TRK,(50,10))
//SYSOUT DD SYSOUT=*
//SYSPRINT DD SYSOUT=*
//SYSIN DD *
SORT FIELDS=(1,9,CH,A,10,10,CH,A)
//******************************************************
//*********** EJECUCION DEL PROGRAMA PRUEBA3 ***********
//PROG4 EXEC PGM=PRUEBA4
//SYSOUT DD SYSOUT=*
//ENTRADA DD DSN=FICHERO.NOMBRES.APELLIDO.ORDENADO,DISP=SHR
//SALIDA DD DSN=FICHERO.CON.LISTADO,
// DISP=(NEW, CATLG, DELETE),SPACE=(TRK,(50,10)),
// DCB=(RECFM=FBA,LRECL=133)
/*
En este JCL tenemos 3 pasos:
Paso 1: Borrado de ficheros que se generan durante la ejecución, visto ya en otros ejemplos.
Paso 2: Ordenación del fichero de entrada usando el SORT. Toda la información sobre el SORT la tenéis en SORT vol.1: SORT, INCLUDE.
Paso 3: Ejecución del programa que genera el listado. Tenemos como fichero de entrada el fichero de salida del SORT, y como fichero de salida ojito: indicaremos RECFM=FBA siempre para listados. Esto significa que el fichero contiene caracteres ASA, que son los que le indican a la impresora los saltos de línea que tiene que hacer al imprimir. Lo iremos viendo con el programa de ejemplo. La longitud del fichero(LRECL) suele ser 133, debido a que se imprimen en hojas A4 en formato apaisado.
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 LISTADO ASSIGN TO LISTADO
STATUS IS FS-LISTADO.
*
DATA DIVISION.
*
FILE SECTION.
*
* FICHERO DE ENTRADA DE LONGITUD FIJA (F) IGUAL A 20.
FD ENTRADA RECORDING MODE IS F
BLOCK CONTAINS 0 RECORDS
RECORD CONTAINS 20 CHARACTERS.
01 REG-ENTRADA PIC X(20).
*
* FICHERO DE LISTADO DE LONGITUD FIJA (F) IGUAL A 132.
FD LISTADO RECORDING MODE IS F
BLOCK CONTAINS 0 RECORDS
RECORD CONTAINS 132 CHARACTERS.
01 REG-LISTADO PIC X(132).
*
WORKING-STORAGE SECTION.
*
* FILE STATUS
*
01 FS-STATUS.
05 FS-ENTRADA PIC X(2).
88 FS-ENTRADA-OK VALUE '00'.
88 FS-ENTRADA-EOF VALUE '10'.
05 FS-LISTADO PIC X(2).
88 FS-LISTADO-OK VALUE '00'.
*
* SWITCHES
*
01 WB-FIN-ENTRADA PIC X(1) VALUE 'N'.
88 FIN-ENTRADA VALUE 'S'.
*
* CONTADORES
*
01 WC-LINEAS PIC 9(2).
01 WC-NOMBRES PIC 9(2).
01 WC-TOTALES PIC 9(2).
*
* VARIABLES
*
01 WX-REGISTRO-ENTRADA.
05 WX-NOMBRE PIC X(9).
05 WX-APELLIDO PIC X(10).
01 WX-NOMBRE-ANT PIC X(9).
01 WX-FEC-DDMMAA.
05 WX-FEC-DD PIC 9(2).
05 FILLER PIC X VALUE '-'.
05 WX-FEC-MM PIC 9(2).
05 FILLER PIC X VALUE '-'.
05 WX-FEC-AA PIC 9(2).
01 WX-FECHA PIC 9(6).
*
* REGISTRO LISTADO
*
01 CABECERA1.
05 FILLER PIC X(40)
VALUE 'LISTADO DE EJEMPLO DEL CONSULTORIO
- 'COBOL'.
01 CABECERA2.
05 FILLER PIC X(5) VALUE 'DIA: '.
05 LT-FECHA PIC X(8).
05 FILLER PIC X(16) VALUE ALL SPACES.
05 FILLER PIC X(8) VALUE 'PAGINA: '.
05 LT-NUMPAG PIC 9.
*
01 CABECERA3.
05 FILLER PIC X(42) VALUE ALL '-'.
*
01 SUBCABECERA1.
05 FILLER PIC X(6) VALUE 'NOMBRE'.
05 FILLER PIC X(9) VALUE ALL SPACES.
05 FILLER PIC X(8) VALUE 'APELLIDO'.
*
01 SUBCABECERA2.
05 FILLER PIC X(9) VALUE ALL '-'.
05 FILLER PIC X(3) VALUE ALL SPACES.
05 FILLER PIC X(15) VALUE ALL '-'.
*
01 DETALLE.
05 LT-NOMBRE PIC X(9).
05 FILLER PIC X(3) VALUE ALL SPACES.
05 LT-APELLIDO PIC X(15).
*
01 SUBTOTAL.
05 FILLER PIC X(6) VALUE 'TOTAL '.
05 LT-NOMTOT PIC X(9).
05 FILLER PIC X(2) VALUE ': '.
05 LT-NUMNOM PIC 9(2).
01 TOTALES.
05 FILLER PIC X(15) VALUE 'TOTAL NOMBRES: '.
05 LT-TOTALES PIC 9(2).
*
************************************************************
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 DEL FICHERO DE ENTRADA
* 3| INFORMAMOS CABECERA Y ESCRIBIMOS CABECERA
************************************************************
10000-INICIO.
*
INITIALIZE DETALLE
WX-REGISTRO-ENTRADA
PERFORM 11000-ABRIR-FICHEROS
PERFORM LEER-ENTRADA
IF FIN-ENTRADA
DISPLAY 'FICHERO DE ENTRADA VACIO'
PERFORM 30000-FINAL
END-IF
MOVE WX-NOMBRE TO WX-NOMBRE-ANT
PERFORM INFORMAR-CABECERA
PERFORM ESCRIBIR-CABECERAS
.
*
************************************************************
* 11000 - ABRIR FICHEROS
*--|------------------+----------><----------+-------------*
* ABRIMOS LOS FICHEROS DEL PROGRAMA ************************************************************
11000-ABRIR-FICHEROS.
*
OPEN INPUT ENTRADA
OUTPUT LISTADO
*
IF NOT FS-ENTRADA-OK
DISPLAY 'ERROR EN OPEN DE ENTRADA:'FS-ENTRADA
END-IF
IF NOT FS-LISTADO-OK
DISPLAY 'ERROR EN OPEN DE LISTADO:'FS-LISTADO
END-IF
.
*
************************************************************
* 12000 - INFORMAR CABECERA
*--|------------------+----------><----------+-------------*
* INFORMAMOS EL CAMPO FECHA DE LA CABECERA ************************************************************
INFORMAR-CABECERA.
*
ACCEPT WX-FECHA FROM DATE
MOVE WX-FECHA(1:2) TO WX-FEC-AA
MOVE WX-FECHA(3:2) TO WX-FEC-MM
MOVE WX-FECHA(5:2) TO WX-FEC-DD
MOVE WX-FEC-DDMMAA TO LT-FECHA
* Inicializamos el contador de páginas
MOVE 1 TO LT-NUMPAG
.
*
************************************************************
* | 20000 - PROCESO
*--|------------------+----------><------------------------*
* | SE REALIZA EL TRATAMIENTO DE LOS DATOS:
* 1| ESCRIBIMOS LAS LINEAS DE DETALLE Y CONTROLAMOS LOS
* | SALTOS DE PAGINA
************************************************************
20000-PROCESO.
*
INITIALIZE DETALLE
IF WC-LINEAS GREATER 64
ADD 1 TO LT-NUMPAG
PERFORM ESCRIBIR-CABECERAS
END-IF
IF WX-NOMBRE NOT EQUAL WX-NOMBRE-ANT
PERFORM ESCRIBIR-SUBTOTAL
ADD 1 TO LT-NUMPAG
PERFORM ESCRIBIR-CABECERAS
MOVE ZEROES TO WC-NOMBRES
END-IF
PERFORM 21000-INFORMAR-DETALLE
PERFORM ESCRIBIR-DETALLE
MOVE WX-NOMBRE TO WX-NOMBRE-ANT
PERFORM LEER-ENTRADA
.
*
************************************************************
* ESCRIBIR CABECERAS
*--|------------------+----------><----------+-------------*
* ESCRIBE LA CABECERA Y SUBCABECERA DEL LISTADO ************************************************************
ESCRIBIR-CABECERAS.
*
WRITE REG-LISTADO FROM CABECERA1 AFTER ADVANCING PAGE
WRITE REG-LISTADO FROM CABECERA2
WRITE REG-LISTADO FROM CABECERA3
WRITE REG-LISTADO FROM SUBCABECERA1 AFTER ADVANCING 2 LINES
WRITE REG-LISTADO FROM SUBCABECERA2
MOVE 6 TO WC-LINEAS
.
*
************************************************************
* ESCRIBIR SUBTOTAL
*--|------------------+----------><----------+-------------*
* ESCRIBIMOS LINEA DE SUBTOTAL ************************************************************
ESCRIBIR-SUBTOTAL.
*
MOVE WX-NOMBRE-ANT TO LT-NOMTOT
MOVE WC-NOMBRES TO LT-NUMNOM
WRITE REG-LISTADO FROM SUBTOTAL AFTER ADVANCING 2 LINES
.
*
************************************************************
* 21000 INFORMAR DETALLE
*--|------------------+----------><----------+-------------*
* INFORMAMOS LOS CAMPOS DE LA LINEA DE DETALLE CON LA
* INFORMACION DEL FICHERO DE ENTRADA ************************************************************
21000-INFORMAR-DETALLE.
*
MOVE WX-NOMBRE TO LT-NOMBRE
MOVE WX-APELLIDO TO LT-APELLIDO
.
*
************************************************************
* ESCRIBIR DETALLE
*--|------------------+----------><----------+-------------*
* ESCRIBIMOS LA LINEA DE DETALLE ************************************************************
ESCRIBIR-DETALLE.
*
WRITE REG-LISTADO FROM DETALLE
IF NOT FS-LISTADO-OK
DISPLAY 'ERROR AL ESCRIBIR DETALLE:'FS-LISTADO
END-IF
ADD 1 TO WC-LINEAS
ADD 1 TO WC-NOMBRES
ADD 1 TO WC-TOTALES
.
*
************************************************************
* 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
.
*
************************************************************
* | 30000 - FINAL
*--|------------------+----------><----------+-------------*
* | FINALIZA LA EJECUCION DEL PROGRAMA ************************************************************
30000-FINAL.
*
IF WC-LINEAS GREATER 60
ADD 1 TO LT-NUMPAG
PERFORM ESCRIBIR-CABECERAS
PERFORM ESCRIBIR-SUBTOTAL
PERFORM ESCRIBIR-TOTALES
ELSE
PERFORM ESCRIBIR-SUBTOTAL
PERFORM ESCRIBIR-TOTALES
END-IF
PERFORM 31000-CERRAR-FICHEROS
STOP RUN
.
*
************************************************************
* | ESCRIBIR TOTALES
*--|------------------+----------><----------+-------------*
* | ESCRIBIMOS LA LINEA DE TOTALES DEL LISTADO ************************************************************
ESCRIBIR-TOTALES.
*
MOVE WC-TOTALES TO LT-TOTALES
WRITE REG-LISTADO FROM TOTALES
.
*
************************************************************
* | 31000 - CERRAR FICHEROS
*--|------------------+----------><----------+-------------*
* | CERRAMOS LOS FICHEROS DEL PROGRAMA
************************************************************
31000-CERRAR-FICHEROS.
*
CLOSE ENTRADA
LISTADO
IF NOT FS-ENTRADA-OK
DISPLAY 'ERROR EN CLOSE DE ENTRADA:'FS-ENTRADA
END-IF
IF NOT FS-LISTADO-OK
DISPLAY 'ERROR EN CLOSE DE LISTADO:'FS-LISTADO
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.
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.
EVALUATE TRUE: "Evalúa" si los niveles 88 por los que preguntamos en el "WHEN" están activados a "TRUE".
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 entrada, 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.
Leemos el primer registro del fichero de entrada y controlaremos el file-status.
Además comprobamos que el fichero de entrada no venga vacío (en caso de que así sea, finalizamos la ejecución). Si todo ha ido OK guardaremos el nombre leído del fichero de entrada en WX-NOMBRE-ANT para controlar posteriormente el momento en que cambiemos de nombre.
Informaremos la parte genérica de la cabecera e inicializamos el contador de páginas. Escribimos la cabecera por primera vez.
INFORMAR-CABECERA:
Recoge la fecha del sistema mediante un ACCEPT. La variable "DATE" es la fecha del sistema en formato 9(6) AAMMDD.
Para informar la fecha del listado formateamos la recibida del sistema a formato DD-MM-AA.
ESCRIBIR-CABECERAS:
Escribe las lineas de cabecera CABECERA1, CABECERA2, CABECERA3, SUBCABECERA1 y SUBCABECERA2.
En el WRITE de CABECERA1 vemos que utilizamos el "AFTER ADVANCING PAGE", esto significa que esta línea se escribirá en una página nueva. Lo podemos ver en el caracter ASA que aparece a la izquierda de esta linea en el fichero de salida que será un '1'.
En el WRITE de SUBCABECERA1 vemos que utilizamos "AFTER ADVANCING 2 LINES", esto significa que se escribirá una línea en blanco y después la línea de SUBCABECERA1. El caracter ASA que aparecerá será un '0'.
Informamos el contador de líneas a '6', pues la cabecera ocupa 6 líneas.
En el párrafo de proceso, que se repetirá hasta que se termine el fichero de entrada (FIN-ENTRADA), controlaremos:
Por un lado el número de líneas escritas, y en caso de superar un máximo (64 en nusetro caso) escribiremos otra vez las cabeceras en una página nueva (ver párrado ESCRIBIR-CABECERAS).
Por otro lado la variable WX-NOMBRE, pues queremos escribir cada nombre en una página distinta. Cuando cambie el nombre escribiremos la línea de subtotales y volveremos a escribir cabeceras (que nos hará el salto de página).
Informaremos la linea de detalle y escribiremos en el fichero del listado.
Guardamos el último nombre escrito en WX-NOMBRE-ANT para controlar el cambio de nombre.
Leemos el siguiente registro del fichero de entrada.
Llamadas a párrafos:
ESCRIBIR-SUBTOTAL:
Informará el campo LT-NOMTOT con el nombre que hemos estado escribiendo, y LT-NUMNOM con el contador de registros escritos para ese nombre.
Escribirá SUBTOTALES dejando antes una línea en blanco (AFTER ADVANCING 2 LINES).
21000-INFORMAR-DETALLE:
Informamos los campos de la línea de detalle LT-NOMBRE y LT-APELLIDO con los campos de lfichero de entrada WX-NOMBRE y WX-APELLIDO.
ESCRIBIR-DETALLE:
Escribe la linea de detalle en el fichero del listado. Controlamos file-status y añadimos uno a los contadores.
En el párrado de FINAL, finalizaremos el programa escribiendo la línea de subtotales que falta, y la línea de totales generales.
Controlaremos el número de líneas que llevamos escritas, pues para escribir la línea SUBTOTALES y TOTALES necesitamos 3 líneas.
En el párrafo de ESCRIBIR-TOTALES informaremos el campo LT-TOTALES con el contador de registros escritos en total.
Al inicio del artículo veiamos como quedaría el listado una vez "impreso", ya sea por pantalla o en papel. Vamos a ver como quedaría el fichero con los caracteres ASA que indican los saltos de linea.
Fichero de salida:
----+----1----+----2----+----3----+----4----+
1LISTADO DE EJEMPLO DEL CONSULTORIO COBOL
DIA: 22-03-11 PAGINA: 1
------------------------------------------
0NOMBRE APELLIDO
--------- ---------------
ANA LOPEZ
ANA MARTINEZ
ANA PEREZ
ANA RODRIGUEZ
0TOTAL ANA : 04
1LISTADO DE EJEMPLO DEL CONSULTORIO COBOL
DIA: 22-03-11 PAGINA: 2
------------------------------------------
0NOMBRE APELLIDO
--------- ---------------
BEATRIZ GARCIA
BEATRIZ MOREDA
BEATRIZ OTERO
0TOTAL BEATRIZ : 03
TOTAL NOMBRES: 07
Donde:
1 = salto de página.
0 = deja una línea en blanco justo antes.
- = deja dos líneas en blanco.
espacio = escribe sin dejar lineas en blanco.
Y listo! Si veis que no me he parado mucho en alguna cosa y queréis que explique más en detalle, dejad un comentario y lo vemos : )
Suscribirse a:
Entradas (Atom)
