Manual Cobol

Manual Cobol

Esquema de un programa cobol Los programas cobol se dividen en partes llamadas "DIVISION" que a su vez se separan en secciones llamadas "SECTION". Vamos a ver el esquema básico que todo programa cobol debe tener: IDENTIFICATION DIVISION . PROGRAM-ID. PROGRAM-ID . PRUEBA1.

Nombre del programa. Debe coincidir con el nombre externo del programa. ENVIRONMENT DIVISION . CONFIGURATION SECTION . SPECIAL-NAMES. SPECIAL-NAMES . DECIMAL-POINT IS COMMA .

Nosotros usamos los puntos como separadores de miles y la coma como el separador de decimales. INPUT-OUTPUT SECTION . FILE-CONTROL. FILE-CONTROL .

En esta parte se definen los ficheros en caso de que los haya. SELECT FICHERO1

Nombre de fichero. ACCES MODE IS SEQUENTIAL

Tipo de acceso: SEQUENTIAL para los planos, INDEXED para los indexados. FILE STATUS IS FS-FICHERO1

Variable donde guardará el file-status file -status (código de control de errores de acceso a ficheros). DATA DIVISION. DIVISION . FILE SECTION. SECTION . FD FICHERO1 RECORDING MODE IS F

Fichero con longitud fija. Si fuese de longitud variable pondríamos V. BLOCK CONTAINS 0 RECORDS RECORD CONTAINS 129 CHARACTERS CHARACTERS. .

Longitud del fichero. 01 REG-FICHERO1 PIC X(129).

Donde guardaremos la información. WORKING-STORAGE SECTION .

En ella definimos las variables que usaremos en el programa. 01 WX-VARIABLE PIC X.

Definición de variables lo veremos más adelante. LINKAGE SECTION. SECTION .

 Área de comunicación con otros otros programas 01 AREA-LINKAGE PIC X.

PROCEDURE DIVISION . / PROCEDURE DIVISION USING AREA-LINKAGE.

Si hay un área definida en la linkage debemos incluir el USING en la procedure.  Aquí es donde va el programa en sí. La estructura estructura general será: 0000-PRINCIPAL. PERFORM 1000-INICIO PERFORM 2000-PROCESO UNTIL CUMPLE-CONDICION PERFORM 3000-FINAL .

La numeración de párrafos suele ser esa, pero cada empresa puede tener su propia nomenclatura estándar. El proceso en un programa se suele repetir n veces, hasta que se cumple la condición indicada en el UNTIL. En el párrafo de final se incluye la instrucción de finalización de ejecución: STOP RUN para programas principales. GOBACK para rutinas. Se pueden definir tantos párrafos como queramos, pero la estructura de todos ell os será la siguiente: 1000-INICIO. código con instrucciones a realizar .

Es decir, todos los párrafos terminan con un p unto "." que indica el final de párrafo.  A tener en cuenta: En cobol no podemos empezar a escribir donde queramos, pues cada cosa tiene su sitio^^ Un programa cobol mide de ancho 80 posiciones, aunque sólo escribiremos hasta la 72. ----+----1----+----2----+----3----+----4------+----1----+----2----+---3----+----4----+----5----+----+----5----+----6----+----7-6----+----7-01 WX-CAMPOS. WX-CAMPOS . 05 WX-CAMPO1 PIC X. 05 WX-LITERAL PIC X(40) VALUE 'LITERAL TAN GRANDE QUE NO CABE ' 'EN UNA LINEA Y LO TENEMOS QUE PARTIR'. * PROCEDURE DIVISION. DIVISION . *************************** ************* **************************** **************************** ************************* *********** 00000-PRINCIPAL. 00000-PRINCIPAL . * PERFORM 10000-INICIO 10000-INICIO. .

* De la posición 1 a la 6: no se codifica nada. * Posición 7: se escribirá un * si queremos comentar la línea. En caso de que un texto no nos quepa en una línea, se escribirá en esta posición un guión "-" para continuarlo. * De la posición 8 a la 11: se denomina área A. Aquí escribiremos las "divisiones" y "secciones", los niveles 01 y los descriptores de ficheros "FD". * De la 12 a la 72: se denomina área B. Aquí se escribirán el resto de instrucciones del programa, y los niveles 05 en adelante. * De la 73 a la 80: no se codifica nada.

Esto que acabamos de ver es algo muuuuy general, pero iremos viéndolo mejor con ejemplos. Y hasta aquí la primera lección. En el siguiente artículo veremos la WORKING-STORAGE, donde se definen las varibles que vamos a usar a lo largo del programa. Veremos los diferentes tipos de variables, el cálculo de longitudes y como se visualizan en un fichero.

WORKING-STORAGE: WORKINGSTORAGE: definiendo variables. Las variables que se usan en un programa cobol deben haber sido previamente definidas en la WORKING-STORAGE SECTION. Existen diferentes tipos de variables en cobol. Cada variable que definamos debe terminar con un punto ".". VALUE.. Si la variable va a tener un valor inicial lo indicaremos con la cláusula VALUE  Alfanuméricas: se indican con un PIC X(número de caracteres). caracteres). Podrán tener como valores números y letras. 01 WX-VARIABLE-ALFNUM PIC X(10) VALUE 'LOQUESEA10'.

Numéricas normales: se indican con un PIC 9(número de dígitos). Sólo tendrán valor numérico. La V indica la coma decimal. 01 WX-VARIABLE-NUM PIC 9(5)V9(2) VALUE 12345,67. (value sin las comillas)

Numéricos comprimidos: se indican con un PIC 9(número de dígitos) COMP-3. Sólo valores numéricos. Estas variables ocuparán, en espacio, menos que un numérico normal. El cálculo de longitudes lo veremos más adelante. La S indica que lleva signo decim al que puede ser positivo o negativo. 01 WX-VARIABLE-COMP3 PIC S9(5)V9(2) COMP-3 VALUE 12345,67.

Numéricos hexadecimales: se indican con un PIC 9(número de dígitos) COMP. Sólo valor  numérico. OJO! Aceptan letras porque el número va en formato hexadecimal, pero eso no significa que podamos informarlas con caracteres alfabéticos. 01 WX-VARIABLE-COMP PIC 9(5)V9(2) COMP VALUE 12345,67.

Editados: se indican con la cláusula PIC seguida por tantas "zetas" Z como necesitemos. Se utilizan para dar formato a campos numéricos. 01 WX-VARIABLE-EDI PIC -Z.ZZZ.ZZ9,99.

Esto equivaldría a un campo numérico PIC S9(7)V9(2). El último dígito antes de la coma decimal se indica con un 9 para que aparezca el valor numérico del 0 al 9. Las Zs sustituirán los "ceros" 0 a la izquierda por espacios. 01 WX-VARIABLE-NUM PIC S9(7)V9(2) VALUE -0001234,56. 01 WX-VARIABLE-EDI PIC -Z.ZZZ.ZZ9,99 DISPLAY 'WX-VARIABLE-NUM:'WX-VARIABLE-NUM MOVE WX-VARIABLE-NUM TO WX-VARIABLE-EDI DISPLAY 'WX-VARIABLE-EDI:'WX-VARIABLE-EDI

El resultado sería: WX-VARIABLE-NUM:00012345O WX-VARIABLE-EDI:1.234,56

 Ahora que sabemos definir variables, variables, vamos a ver que las variables pueden estar definidas en diferentes "niveles". Estos niveles vienen indicados por un número a la izquierda: 01 WX-INFORMACION-PERSONA. 05 WX-NOMBRE PIC X(10). 05 WX-APELLIDO1 PIC X(10). 05 WX-APELLIDO2 PIC X(10). 05 WX-DIRECCION. 10 WX-CALLE PIC X(10). 10 WX-NUMERO PIC 9(3). 10 WX-PISO PIC 9(2).

Y así sucesivamente. Si tenemos algún subnivel que sea una constante, en lugar de ponerle nombre al campo podemos FILLER:: utilizar la cláusala FILLER 01 WX-FECHA. 05 WX-DIA 05 FILLER 05 WX-MES 05 FILLER 05 WX-ANO

PIC PIC PIC PIC PIC

9(2). X VALUE '-'. 9(2). X VALUE '-'. 9(4).

La diferencia del FILLER con un campo "con nombre", es que el FILLER no se puede utilizar para "mover" la información que contenga. Es un c ampo fijo (la traducción sería "RELLENO") que no se puede informar (a no ser que informásemos el nivel superior y nos cargásemos todo, claro... xd). El resultado del campo informado sería por ejemplo: Fecha = 01-01-2011 Existe una forma de definir variables con dos o más tipos de formato (PIC) distintos. Se trata de la REDEFINES.. cláusula REDEFINES Se suele utilizar para evitar mover m over campos alfanuméricos a numéricos, o bien para agrupar un campo que tenga subniveles: 01 WX-CAMPO1 PIC X(3). 01 WX-CAMPO2 REDEFINES WX-CAMPO1 PIC 9(3). 01 WX-CAMPO1. 05 WX-SUBCAMPO1 PIC X(3). 05 WX-SUBCAMPO2 PIC 9(5). 01 WX-CAMPO2 REDEFINES WX-CAMPO1 PIC X(8).

IMPORTANTE: sólo se pueden "redefinir" campos que estén al mismo nivel, es decir, para re definir  un campo de un nivel 01, tendremos que hacerlo en otro campo de nivel 01.

También podemos definir tablas o arrays: 01 WX-TABLA-INTERNA OCCURS 5 TIMES TIMES. . 05 WX-CAMPO1 PIC X VALUE 'A'. 05 WX-CAMPO2 PIC X VALUE 'B'.

De tal manera que el conjunto de los campos 1 y 2 se repiten 5 veces:  ABABABABAB Existen otro tipo de niveles que son los niveles "88": 01 WX-RESPUESTA PIC X. 88 RESPUESTA-SI VALUE 'S'. 88 RESPUESTA-NO VALUE 'N'.

De tal forma que la variable WX-RESPUESTA podrá tomar los valores S ó N según queramos. Para hacer que la variable tome un valor: SET RESPUESTA-SI TO TRUE SET RESPUSETA-NO TO TRUE

tomará el valor S. tomará el valor N.

Imaginemos que tenemos una serie de campos que definen la estructura de un fichero. Si tenemos varios programas que usan ese fichero, tendremos que escribir esos campos tantas veces como programas tengamos. Para ahorrarnos trabajo tenemos la cláusula COPY. Una "COPY" es un trozo de código cobol que puede contener la definición de variables (COPY de WORKING) o una parte del código del programa (COPY de PROCEDURE): COPY WORKING Se incluirán dentro de la WORKING-STORAGE. W ORKING-STORAGE. COPY WSCOPY. WSCOPY .

Donde WSCOPY contendrá algo de este estilo: 01 WX-WSCOPY. 05 WX-CAMPO1 05 WX-CAMPO2 05 WX-CAMPO3 05 WX-CAMPO4

PIC PIC PIC PIC

X(5). X(5). X(5). X(5).

COPY PROCEDURE Se incluirán dentro de la PROCEDURE DIVISION. DIVISION. COPY PDCOPY. PDCOPY .

Donde PDCOPY contendrá algo de este estilo: MOVE MOVE MOVE MOVE MOVE

WX-CAMPO1 WX-CAMPO2 WX-CAMPO3 WX-CAMPO4 WX-CAMPO5

TO TO TO TO TO

WX-REGISTRO1 WX-REGISTRO2 WX-REGISTRO3 WX-REGISTRO4 WX-REGISTRO5

CÁLCULO DE LONGITUDES Numéricos y alfanuméricos: lo que venga i ndicado en el PIC X(n) ó PIC 9(n) respectivamente. 01 WX-VARIABLE-ALFNUM PIC X(5). 01 WX-VARIABLE-NUM PIC 9(5).

longitud = 5

Numéricos COMP-3: si tenemos un PIC 9(n) COMP-3, la longitud será (n+1)/2. Si el resultado tiene decimales redondeamos hacia arriba. Hay que tener en cuenta que la coma decimal no ocupa espacio, y que el signo ocupa sólo media posición. 01 WX-VARIABLE-COMP3 PIC S9(5) COMP-3.

longitud = (5 + 1)/2 = 3 Numéricos COMP: Un campo con PICTURE numérica y COMP se almacena en formato binario puro (base 2); el signo lo representa el bit de la derecha. El número de bytes que se reservan en memoria para cada campo es: 2 posiciones para números de 1 a 4 dígitos. 4 posiciones para números de 5 a 9 dígitos. 8 posiciones para números de 10 a 18 dígitos. 01 WX-VARIABLE-COMP PIC 9(5) COMP.

longitud = 4 VISUALIZANDO CAMPOS Como ya hemos comentado, existen campos en cobol q no se ven "tal cual", como son los comprimidos o los hexadecimales. Vamos a ver como se verían en un fichero estos campos: ----+----1----+----2----+----3----+----4 999999999 q Íì% 00000 S FFFFFFFFF444444444493716000000FFFFF00E2 99999999900000000008265C000000000000122 ----------------------------------------

* El campo que va de la posición 1 a la 9 sería un campo numérico normal con valor 999999999. * El campo que va de la posición 10 a la 19 sería un campo alfanumérico con valor ' ' (9 espacios). * El campo que va de la posición 20 a la 24 sería un campo numérico COMP-3 con valor  983276156 positivo (letra C, letra D para negativos*). * El campo que va de la posición 25 a la 30 sería un campo informado con low-values. * El campo que va de la posición 31 a la posición 35 sería un campo informado con 5 ceros 00000. * El campo que va de la posición 36 a la 39 sería un campo numérico COMP con valor 1E222 (en hexadecimal) / 123426(en decimal). *Para campos numéricos con signo del tipo S9(3)V99, podemos distinguir el signo fijándonos en la última posición: A B C D E F G H I J K

= = = = = = = = = = =

+1 +2 +3 +4 +5 +6 +7 +8 +9 -1 -2

L M N O P Q R { }

= = = = = = = = =

-3 -4 -5 -6 -7 -8 -9 +0 -0

En el próximo artículo veremos la PROCEDURE DIVISION, donde se codifica la "miga" del programa. Veremos como informar campos, como inicializarlos y como codificar bucles y condiciones.

PROCEDURE DIVISION: proceso del programa. La PROCEDURE DIVISION es la parte del programa donde se codifica el proceso en sí. Es decir, aquí escribiremos las sentencias cobol para llevar a cabo la función del programa. INFORMANDO VARIABLES En cobol lo que se hace es "mover" la información de una variable a otra utilizando la sentencia MOVE.  A la hora de mover información tendremos que tener en cuenta 2 cosas: Formato(PIC) de ambas variables Longitud de ambas variables  

Ejemplo 1. 01 WX-TELEFONO PIC X(9) VALUE '666111333'. 01 WX-TELEFONO-2 PIC X(9).

Tienen mismo formato y misma longitud, por lo que no habrá problemas. La sentencia sería: MOVE WX-TELEFONO TO WX-TELEFONO-2

 Ahora WX-TELEFONO-2 tendrá el valor '666111333'. Ejemplo 2. 01 WX-TELEFONO PIC X(9) VALUE '666111333'. 01 WX-TELEFONO-NUM PIC 9(9).

 Ahora tenemos misma longitud pero distinto formato. En este caso la variable alfanumérica sólo tiene números, por lo que no habrá problema. MOVE WX-TELEFONO TO WX-TELEFONO-NUM

 Ahora WX-TELEFONO-NUM tendrá el valor 666111333. Ejemplo 3. 01 WX-TELEFONO PIC X(9) VALUE 'AAA111333'. 01 WX-TELEFONO-NUM PIC 9(9).

 Ahora tenemos caracteres alfabéticos en la variable alfanumérica, esto no dará error, aunque no tiene mucho sentido hacerlo. Dependiendo de la instalación, este tipo de movimientos donde pasamos caracteres alfabéticos a campos numéricos darán, o no, un error en ej ecución: el MOVE dará un estupendo "casque" al ejecutar con código error S0C7. Lo mismo ocurre si lo movemos a un campo COMP-3 o COMP. En cualquier caso, NO debemos mover caracteres alfabéticos a un campo numérico, COMP o COMP-3.

Ejemplo 4. 01 WX-TELEFONO PIC X(9) VALUE '666111333'. 01 WX-TELEFONO-NUM PIC 9(6).

En este caso no coinciden ni las longitudes ni los formatos. Como el campo alfanumérico sólo lleva números no habrá problema, pero al no c oincidir las longitudes el campo se "truncará". MOVE WX-TELEFONO TO WX-TELEFONO-NUM

 Ahora el campo WX-TELEFONO-NUM tendrá valor 111333. Hemos perdido los 3 primeros dígitos. Si fuese al revés: 01 WX-TELEFONO-NUM PIC 9(9) VALUE 666111333. 01 WX-TELEFONO PIC X(6). MOVE WX-TELEFONO-NUM TO WX-TELEFONO

El valor del campo WX-TELEFONO sería 666111. Cuando se mueve a un campo alfanumérico, el movimiento se hace de la posición 1 del campo inicial a la posición 1 del campo alfanumérico. Cuando se mueve a un campo numérico, el movimiento se hace de la última posición del campo inicial a la última posición del campo numérico. Ejemplo 5. 01 WX-NUMERO-ALF PIC X(4) VALUE '12 '. 01 WX-NUMERO PIC 9(4).

Puede darse el caso de que valores numéricos nos vengan con espacios en lugar de ceros a la izquierda. Una manera de solventar esto es utilizando el COMPUTE FUNCTION NUMVAL: COMPUTE WX-NUMERO = FUNCTION NUMVAL(WX-NUMERO-ALF)

 Ahora la variable WX-NUMERO tendrá el valor 0012. Es una manera de asegurarnos de que no casque el programa porque algún vago no haya escrito los ceros^^ El movimiento en sí no daría error, pero no debe hacerse. Un ejemplo más claro: 01 WX-NUMERO-ALF PIC X(4) VALUE '12,00 01 WX-NUMERO PIC 9(4)V9(2).

'.

Con el COMPUTE FUNCTION NUMVAL conseguiríamos que WX-NUMERO tuviese el valor 00120{ (aplantillado con la coma decimal). Campos COMP-3 y COMP. Ejemplo 6. 01 WX-SUELDO-COMP3 PIC S9(6) COMP-3 VALUE 100000. 01 WX-SUELDO-NUM PIC 9(6). MOVE WX-SUELDO-COMP3 TO WX-SUELDO-NUM

Sin problema. WX-SUELDO-NUM valdrá 100000. Ejemplo 7. 01 WX-SUELDO-COMP3 PIC S9(6) COMP-3 VALUE 100000. 01 WX-SUELDO-ALF PIC X(6).

MOVE WX-SUELDO-COMP3 TO WX-SUELDO-ALF

Sin problema. WX-SUELDO-ALF valdrá 100000. Ejemplo 8. 01 WX-SUELDO-COMP PIC S9(6) COMP VALUE 100000. 01 WX-SUELDO-NUM PIC 9(6). MOVE WX-SUELDO-COMP TO WX-SUELDO-NUM

Sin problema. WX-SUELDO-ALF valdrá 100000. Ejemplo 9. 01 WX-SUELDO-COMP PIC S9(6) COMP VALUE 100000. 01 WX-SUELDO-ALF PIC X(6). MOVE WX-SUELDO-COMP TO WX-SUELDO-ALF

Sin problema. WX-SUELDO-ALF valdrá 100000. Ejemplo 10. 01 WX-SUELDO-COMP3 PIC S9(6) COMP-3 VALUE 100000. 01 WX-SUELDO-COMP PIC 9(6) COMP. MOVE WX-SUELDO-COMP3 TO WX-SUELDO-COMP

Sin problema, WX-SUELDO-COMP valdrá 100000 pero en formato hexadecimal: 186A0 Ejemplo 11. 01 WX-SUELDO-COMP PIC 9(6) COMP VALUE 100000. 01 WX-SUELDO-COMP3 PIC S9(6) COMP-3. MOVE WX-SUELDO-COMP TO WX-SUELDO-COMP3

Sin problema, WX-SUELDO-COMP valdrá 100000. Para campos numéricos existe también la sentencia C OMPUTE para pasar información de uno a otro: Ejemplo 12. 01 WX-NUMERO-1 PIC 9(5) VALUE 12345. 01 WX-NUMERO-2 PIC 9(5). COMPUTE WX-NUMERO-2 = WX-NUMERO-1

 Ahora WX-NUMERO-2 valdrá 12345.  Aunque la sentencia COMPUTE se usa en general para operaciones aritméticas: suma, resta, multiplicación, división, potencia... COMPUTE WX-NUMERO1 = ((WX-NUMERO2 + WX-NUMERO3) - (WX-NUMERO4 * WX-NUMERO5) / WX-NUMERO6) ** 2

Y se aplican las mismas reglas de prioridades que en matemáticas.(el doble asterisco es la potencia) Es en estos casos cuando un campo numérico que lleve caracteres o espacios p ierde su sentido, pues adivinad que sucede si intentamos dividir 'ABC?%&' entre 1000 al ejecutar el programa... Premio! Un S0C7!!

Nunca va a tener sentido dividor letras entre números, imagino que en esto estamos todos de acuerdo : P Para operaciones aritméticas existen también: ADD: operador suma. "ADD 1 TO WX-CAMPO" SUBTRACT: operador resta. "SUBTRACT 1 FROM WX-CAMPO" MULTIPLY: operador multiplicación. "MULTIPLY WX-CAMPO BY 1" DIVIDE: operador división. "DIVIDE WX-CAMPO BY 1" REMAINDER: es el resto de una división. "DIVIDE WX-CAMPO BY 1 REMINDER WX-RESTO"

Ejemplo 13. 01 WX-TELEFONO-NUM PIC 9(9) VALUE 666111333. 01 WX-TELEFONO-ALF PIC X(9) VALUE '666111333'. 01 WX-TELEFONO PIC X(6).

Para campos alfanuméricos y numéricos sin comprimir existe la pos ibilidad de mover sólo determinadas posiciones del campo. MOVE WX-TELEFONO-NUM(1:6) TO WX-TELEFONO

En este caso estamos cogiendo 6 posiciones, empezando desde la posición 1. Ahora WXTELEFONO valdrá '666111'. MOVE WX-TELEFONO-ALF(4:) TO WX-TELEFONO

En este caso estamos cogiendo todas las posiciones hasta final de campo desde la posición 4.  Ahora WX-TELEFONO valdrá '111333'. CONCATENANDO CAMPOS En COBOL también existe la opción de concatenar campos usando la sentencia STRING. Lo que haremos será indicar las variables a concatenar, el modo en que se unirán y el campo donde se guardará el resultado. 01 WX-CAMPO1 PIC X(17) VALUE 'CONSULTORIO COBOL'. 01 WX-CAMPO2 PIC X(10) VALUE ' SON GUAYS'. 01 WX-RESULTADO PIC X(41). STRING 'LOS TIPOS DEL ' WX-CAMPO1 WX-CAMPO2 DELIMITED BY SIZE INTO WX-RESULTADO

Donde DELIMITED BY SIZE indica que los campos se unirán según el tamaño que ocupen, y el INTO indicará el campo donde guardar la información concatenada. Si por ejemplo tuviésemos campos con espacios al final podríamos indicarle un DELIMITED BY SPACES, para que cortase la información al encontrarse el primer espacio. Vamos a ver el ejemplo: 01 WX-DIA PIC 9(2) VALUE 31. 01 WX-MES PIC X(10). 01 WX-FECHA PIC X(19). MOVE 'MAYO' TO WX-MES Ahora WX-MES valdrá 'MAYO

'.

STRING 'HOY ES ' WX-DIA ' DE ' DELIMITED BY SIZE WX-MES DELIMITED BY SPACE '.' DELIMITED BY SIZE INTO WX-FECHA

El resultado: HOY ES 31 DE MAYO.

Si no hubiésemos indicado el DELIMITED BY SPACE, el resultado sería: HOY ES 31 DE MAYO

.

Recordad: el DELIMITED BY se aplica a todos los campos que lo preceden. Usad el DELIMITED BY correcto en cada caso INICIALIZANDO CAMPOS Para "vaciar" un campo podríamos moverle ceros o espacios (según su formato). Pero en cobol existe una instrucción más sencilla que es el INITIALIZE. 01 WX-NUMERO PIC 9(5) VALUE 12345. (...) INITIALIZE WX-NUMERO

 Ahora WX-NUMERO valdrá 00000. Si fuese alfanumérico valdría '

' (cinco espacios).

Las variables "vacías" en cobol pueden tener 3 tipos de información: ceros: 00000 espacios: ' ' low-values: '.....' Por eso a la hora de preguntar si un campo está vacío en cobol preguntaremos: IF WX-CAMPO EQUAL ZEROES OR SPACES OR LOW-VALUES (...)

Nota: Tanto LOW-VALUES como HIGH-VALUES son palabras reservadas en cobol, y se pueden definir como "el valor más bajo posible" y "el valor más alto posible" respectivamente. Veremos su uso en otros artículos. BUCLES Y CONDICIONES Las condiciones en cobol se escriben de la siguiente manera: IF WX-CAMPO = 1 MOVE 1 TO WX-CAMPO2 ELSE MOVE WX-CAMPO TO WX-CAMPO2 END-IF

Podemos escribir IFs dentro de IFs (IFs anidados) y La sentencia ELSE no es obligatoria: IF WX-CAMPO1 = 1 IF WX-CAMPO2 = 2 MOVE WX-CAMPO1 TO WX-CAMPO3 END-IF

ELSE MOVE 1 TO WX-CAMPO3 END-IF

No tienen más ciencia que cualquier IF de cualquier otro lenguaje. Los operadores lógicos serán OR, AND, EQUAL, NOT EQUAL. Los operadores de mayor, menor, serán GREATER y LESS. También se pueden utilizar combinaciones como GREATER OR EQUAL (mayor o igual), y también con símbolos: >= (mayor o igual), <= (menor o igual). Los bucles son diferentes debido a que en cobol no existe la sentencia "while" de otros lenguajes.  Aquí los bucles son siempre "UNTIL", es decir, hasta que se cumpla la condición especificada. MOVE 0 TO WX-CAMPO PERFORM UNTIL WX-CAMPO = 5 -> aquí es donde pregunta por la condición proceso a realizar ADD 1 TO WX-CAMPO END-PERFORM

El proceso se realizará para: WX-CAMPO = 0 WX-CAMPO = 1 WX-CAMPO = 2 WX-CAMPO = 3 WX-CAMPO = 4 MOVE 5 TO WX-CAMPO PERFORM UNTIL WX-CAMPO = 5 -> aquí es donde pregunta por la condición proceso a realizar END-PERFORM

El proceso no se llega a realizar. Si quisiésemos preguntar por la condición al final del bucle, tendríamos que codificar el bucle con un "WITH TEST AFTER": MOVE 0 TO WX-CAMPO PERFORM WITH TEST AFTER UNTIL WX-CAMPO = 5 proceso a realizar ADD 1 TO WX-CAMPO END-PERFORM -> aquí es donde pregunta por la condición

El proceso se realizará para: WX-CAMPO = 0 WX-CAMPO = 1 WX-CAMPO = 2 WX-CAMPO = 3 WX-CAMPO = 4 MOVE 5 TO WX-CAMPO

PERFORM WITH TEST AFTER UNTIL WX-CAMPO = 5 proceso a realizar ADD 1 TO WX-CAMPO END-PERFORM -> aquí es donde pregunta por la condición

El proceso se realiza una vez, antes de comprobar si se cumple la codición. Como veíamos en la estructura general de un programa cobol, un párrafo entero también se puede repetir hasta que se cumpla una condición: PERFORM 2000-PROCESO UNTIL CUMPLA-CONDICION

Otro tipo de bucles son los "PERFORM VARYING". En este caso tendremos un contador que se irá incrementando automáticamente según le indiquemos: PERFORM VARYING WI-INDICE FROM 1 BY 1 UNTIL WI-INDICE = 10 código a ejecutar END-PERFORM

El "FROM" le indica desde que valor empezar. El "BY" le indica cuanto le ha de sumar cada vez. Como en el otro caso, el "UNTIL" le indicará la condición de final de bucle. Con todo esto, ya podemos empezar a ver un ejemplo de un programa sencillo

Ejemplo 1: Leer de SYSIN y escribir en SYSOUT. En cobol 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. Empezaremos 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  SYSOUT. JCL: //PROG1 EXEC PGM=PRUEBA1 //SYSOUT DD SYSOUT=* //SYSIN DD * JOSE LOPEZ VAZQUEZ HUGO CASILLAS DIAZ JAVIER CARBONERO PACO GONZALEZ /*

donde EXEC PGM= indica el programa SIN DB2 que vamos a ejecutar  SYSOUT DD SYSOUT=* indica que la información "displayada" se quedará en la cola del SYSOUT (no lo vamos a guardar en un fichero) 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

Como veis, la longitud máxima que se puede pasar a un programa a través de la SYSIN es de 80. En nuestro caso la hemos dividido en 4 trozos de 20 posiciones, cada uno con un nombre. PROGRAMA: IDENTIFICATION DIVISION .

PROGRAM-ID. PRUEBA1. *==========================================================* * PROGRAMA QUE LEE DE SYSIN Y ESCRIBE EN SYSOUT *==========================================================* * ENVIRONMENT DIVISION . * CONFIGURATION SECTION . * SPECIAL-NAMES . DECIMAL-POINT IS COMMA . * DATA DIVISION. * WORKING-STORAGE SECTION . * 01 WI-INDICE PIC 9(4) COMP. 01 WX-SYSIN PIC X(80). 01 WX-TABLA-NOMBRES. 05 WX-NOMBRE PIC X(20) OCCURS 4 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 * 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-SYSIN ACCEPT WX-SYSIN FROM SYSIN . ************************************************************ * | 20000 - PROCESO *--|------------------+----------><------------------------* * | SE REALIZA EL TRATAMIENTO DE LOS DATOS: * 1| Realiza el tratamiento de cada registro leido

************************************************************ 20000-PROCESO. * MOVE WX-SYSIN TO WX-TABLA-NOMBRES MOVE 1 TO WI-INDICE PERFORM UNTIL WI-INDICE GREATER 4 DISPLAY 'WX-NOMBRE:'WX-NOMBRE(WI-INDICE) ADD 1 TO WI-INDICE END-PERFORM . ************************************************************ * | 30000 - FINAL *--|------------------+----------><----------+-------------* * | FINALIZA LA EJECUCION DEL PROGRAMA ************************************************************ 30000-FINAL. * STOP RUN .

En el programa podemos ver las siguientes divisiones/secciones: IDENTIFICATION DIVISION: existirá siempre. ENVIRONMENT DIVISION: existirá siempre. CONFIGURATION SECTION: existirá siempre. En este caso no existirá la INPUT-OUTPUT SECTION, pues nuestro programa no utiliza ficheros. DATA DIVISION: existirá siempre. En este caso no existirá la FILE SECTION, pues nuestro programa no utili za ficheros. WORKING-STORAGE SECTION: existirá siempre. En este caso no existirá la LINKAGE SECTION pues el programa no se comunica con otros programas. PROCEDURE DIVISION: existirá siempre. En el programa podemos ver las siguientes sentencias: PERFORM: llamada a párrafo INITIALIZE: para inicializar variable ACCEPT: esta sentencia recoge la información del campo indicado en el "FROM". En este caso recoge la información almacenada en "SYSIN"; la que nosotros hemos introducido en el JCL. MOVE/TO: movemos la información de un campo a otro PERFORM UNTIL: bucle DISPLAY: escribe el contenido del campo indicado en la SYSOUT del JCL. ADD: Operador de adición (suma) STOP RUN: sentencia de finalización de ejecución. Descripción del programa: En el párrafo de inicio, inicializamos WX-SYSIN para guardar posteriormente mediante un ACC EPT la información que hemos escrito en la SYSIN del JCL. En el párrafo de proceso, informamos la tabla i nterna WX-TABLA-NOMBRES, donde el campo WX-NOMBRES se repetirá 4 veces (occurs 4 times).

Informamos el campo WI-INDICE con un 1, pues vamos a utilizar los campos de la tabla interna: Para utilizar un campo que pertenezca a una tabla interna (tiene occurs), debemos acompañar el campo de un "índice" entre paréntesis. De tal forma que indiquemos a que "ocurrencia" de la tabla nos estamos refiriendo. Por ejemplo, WX-NOMBRE (1) sería el primer nombre guardado (JOSE LOPEZ VAZQUEZ). Como queremos desplazar todas las ocurrencias de la tabla, haremos que el índice sea una variable que va aumentando.  A continuación montamos un bucle (perform until) con la condición WI-INDICE mayor (greater) de 4, pues la primera vez WI-INDICE valdrá 1, y necesitamos que el bucle se repita 4 veces: WI-INDICE WI-INDICE WI-INDICE WI-INDICE WI-INDICE

= = = = =

1: 2: 3: 4: 5:

WX-NOMBRE(1) = JOSE LOPEZ VAZQUEZ WX-NOMBRE(2) = HUGO CASILLAS DIAZ WX-NOMBRE(3) = JAVIER CARBONERO WX-NOMBRE(4) = PACO GONZALEZ salimos del bucle porque se cumple WI-INDICE GREATER 4

NOTA: el índice de una tabla interna NUNCA puede ser cero, pues no existe la ocurrencia cero. Si no informásemos WI-INDICE con 1, el DISPLAY de W X-NOMBRE(0) nos daría un estupendo casque, de este estilo: IGZ0006S The reference to table WX-NOMBRE by verb number 01 on line 001099 addressed an area outside the region of the table. From compile unit R2BCTAN1 at entry point R2BCTAN1 at compile unit offset +00001122 at entry offset +00001122 at address 1965BBAA.

 Aunque ahora ya sabemos cómo encontrar la línea que nos da el OFFSET :D RESULTADO: WX-NOMBRE: WX-NOMBRE: WX-NOMBRE: WX-NOMBRE:

JOSE LOPEZ VAZQUEZ HUGO CASILLAS DIAZ JAVIER CARBONERO PACO GONZALEZ

Ejemplo 2: leer de SYSIN y escribir en fichero. En este ejemplo vamos a ejecutar un programa SIN DB2, que recoge información de la SYSIN del JCL del mismo modo que vimos en el ejemplo 1. La diferencia estará en que en esta ocasión vamos a escribir la información en un fichero en lugar de en la SYSOUT. JCL: //****************************************************** //**************************** BORRADO ***************** //BORRADO EXEC PGM=IDCAMS //SYSPRINT DD SYSOUT=* //SYSIN DD * DEL FICHERO.CON.NOMBRES SET MAXCC = 0 //****************************************************** //*********** EJECUCION DEL PROGRAMA PRUEBA2 *********** //PROG1 EXEC PGM=PRUEBA2

//SYSOUT DD SYSOUT=* //FICHERO DD DSN=FICHERO.CON.NOMBRES, // DISP=(NEW, CATLG, DELETE),SPACE=(TRK,(50,10)) //SYSIN DD * JOSE LOPEZ VAZQUEZ HUGO CASILLAS DIAZ JAVIER CARBONERO PACO GONZALEZ /*

En este ejemplo añadimos un nuevo paso, el IDCAMS. Este programa sirve para borrar  ficheros que se crean a lo largo del JCL. En nuestro caso borrará el fichero que se va a crear en el programa. Así podremos ejecutarlo tantas veces como queramos sin generar el mismo fichero una y otra vez. El paso de ejecución del programa PRUEBA2 es similar al del ejemplo 1, sólo le hemos añadido la definición del fichero de salida "FICHERO". PROGRAMA: IDENTIFICATION DIVISION . PROGRAM-ID. PRUEBA2. *==========================================================* * PROGRAMA QUE LEE DE SYSIN Y ESCRIBE EN FICHERO *==========================================================* * ENVIRONMENT DIVISION . * CONFIGURATION SECTION . * SPECIAL-NAMES . DECIMAL-POINT IS COMMA . * INPUT-OUTPUT SECTION . * FILE-CONTROL. * SELECT FICHERO ASSIGN TO FICHERO STATUS IS FS-FICHERO. * DATA DIVISION. * FILE SECTION. * * Fichero de salida de longitud fija (F) igual a 20. FD FICHERO RECORDING MODE IS F BLOCK CONTAINS 0 RECORDS RECORD CONTAINS 20 CHARACTERS. 01 REG-FICHERO PIC X(20). * WORKING-STORAGE SECTION . * FILE STATUS 01 FS-STATUS. 05 FS-FICHERO PIC X(2). 88 FS-FICHERO-OK VALUE '00'. * * VARIABLES 01 WI-INDICE PIC 9(4) COMP. 01 WX-SYSIN PIC X(80). 01 WX-TABLA-NOMBRES. 05 WX-NOMBRE PIC X(20) OCCURS 4 TIMES. 01 WX-REGISTRO-SALIDA PIC X(20).

* ************************************************************ 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 * 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-SYSIN WX-REGISTRO-SALIDA WX-TABLA-NOMBRES ACCEPT WX-SYSIN FROM SYSIN PERFORM 11000-ABRIR-FICHERO . * ************************************************************ * 11000 - ABRIR FICHEROS *--|------------------+----------><----------+-------------* * Abrimos el fichero de salida ************************************************************ 11000-ABRIR-FICHERO. * OPEN OUTPUT FICHERO * IF NOT FS-FICHERO-OK DISPLAY 'ERROR EN OPEN DEL FICHERO:'FS-FICHERO END-IF . * ************************************************************ * | 20000 - PROCESO *--|------------------+----------><------------------------* * | SE REALIZA EL TRATAMIENTO DE LOS DATOS: * 1| Realiza el tratamiento de cada registro recuperado de * la SYSIN ************************************************************

20000-PROCESO. * MOVE WX-SYSIN TO WX-TABLA-NOMBRES MOVE 1 TO WI-INDICE PERFORM UNTIL WI-INDICE GREATER 4 PERFORM 21000-INFORMAR-REGISTRO PERFORM 22000-ESCRIBIR-FICHERO ADD 1 TO WI-INDICE END-PERFORM . * ************************************************************ * 21000 - INFORMAR REGISTRO *--|------------------+----------><----------+-------------* * MOVEMOS LA INFORMACION DESDE NUESTRA TABLA INTERNA A LA * VARIABLE WX-REGISTRO-SALIDA ************************************************************ 21000-INFORMAR-REGISTRO. * MOVE WX-NOMBRE(WI-INDICE) TO WX-REGISTRO-SALIDA . * ************************************************************ * 22000 - ESCRIBIR FICHERO *--|------------------+----------><----------+-------------* * ESCRIBIMOS EN EL FICHERO DE SALIDA LA INFORMACION GUARDADA * WX-REGISTRO-SALIDA ************************************************************ 22000-ESCRIBIR-FICHERO. * WRITE REG-FICHERO FROM WX-REGISTRO-SALIDA IF NOT FS-FICHERO-OK DISPLAY 'ERROR EN WRITE DEL FICHERO:'FS-FICHERO END-IF . * ************************************************************ * | 30000 - FINAL *--|------------------+----------><----------+-------------* * | FINALIZA LA EJECUCION DEL PROGRAMA ************************************************************ 30000-FINAL. * PERFORM 31000-CERRAR-FICHERO STOP RUN . * ************************************************************ * | 31000 - CERRAR FICHERO *--|------------------+----------><----------+-------------*

* | CERRAMOS EL FICHERO DE SALIDA ************************************************************ 31000-CERRAR-FICHERO. * CLOSE FICHERO IF NOT FS-FICHERO-OK DISPLAY 'ERROR EN CLOSE DEL FICHERO:'FS-FICHERO 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 salida. DATA DIVISION: existirá siempre. FILE SECTION: en este ejemplo existirá pues utilizamos un fichero 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 ACCEPT: esta sentencia recoge la información del campo indicado en el "FROM". En este caso recoge la información almacenada en "SYSIN"; la que nosotros hemos introducido en el JCL. 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 ADD: Operador de adición (suma) 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 las variables que utilizaremos a lo largo del programa: WX-SYSIN: donde guardaremos posteriormente mediante un ACCEPT la información que hemos escrito en la SYSIN del JCL. WX-TABLA-NOMBRES: donde moveremos la información de la SYSIN para dividirla en los diferentes nombres. WX-REGISTRO-SALIDA: donde guardaremos la información que vamos a escribir en el fichero de salida.  Abriremos el fichero de salida (OPEN OUTPUT) 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. En el párrafo de proceso, informamos la tabla interna WX-TABLA-NOMBRES, donde el campo WX-NOMBRES se repetirá 4 veces (occurs 4 times). Recordad que el tratamiento de las tablas internas está explicado en detalle en el ejemplo 1. Montaremos un bucle para escribir cada uno d e los nombres guardados en la tabla interna en el fichero de salida. Informaremos la variable WX-REGISTRO-SALIDA con cada uno de los nombres de la tabla.

Escribiremos el fichero de salida. Para ellos indicaremos a continuación del WRITE la variable definida en la FILE-SECTION, y a continuación del FROM la variable donde tenemos guardada la información que queremos escribir. Controlaremos el file-status. Nota: es importante controlar el FILE-STATUS en los accesos a ficheros (OPEN, READ, WRITE, CLOSE...) para, en caso de fallo en la ejecución, tener información sobre la causa del error.

Ejemplo 3: leer de fichero y escribir en fichero. Para este ejemplo crearemos un programa que lea un fichero de entrada, formatee la información y escriba en un fichero de salida. JCL: //****************************************************** //******************** BORRADO ************************* //BORRADO EXEC PGM=IDCAMS //SYSPRINT DD SYSOUT=* //SYSIN DD * DEL FICHERO.DE.SALIDA SET MAXCC = 0 //****************************************************** //*********** EJECUCION DEL PROGRAMA PRUEBA3 *********** //PROG3 EXEC PGM=PRUEBA3 //SYSOUT DD SYSOUT=* //ENTRADA DD DSN=FICHERO.DE.ENTRADA,DISP=SHR //SALIDA DD DSN=FICHERO.DE.SALIDA, // DISP=(NEW, CATLG, DELETE),SPACE=(TRK,(50,10)) /*

En este caso volvemos a utilizar el IDCAMS para borrar el fichero de salida que se genera en el segundo paso. Sigue siendo un programa sin DB2, así que utilizamos el EXEC PGM. Para definir el fichero de entrada "ENTRADA" indicaremos que es un fichero ya existente y compartida al indicar DISP=SHR. En la SYSOUT veremos los mensajes de error en caso de que los haya. Fichero de entrada: ----+----1----+ 11111AA100A 22222BB100B 33333CC100K 44444DD100M

campo1: número de cliente campo2: código de empresa campo3: saldo PROGRAMA: IDENTIFICATION DIVISION . PROGRAM-ID. PRUEBA3. *==========================================================* * PROGRAMA QUE LEE DE FICHERO Y ESCRIBE EN FICHERO *==========================================================* * ENVIRONMENT DIVISION . *

CONFIGURATION SECTION . * SPECIAL-NAMES . DECIMAL-POINT IS COMMA . * INPUT-OUTPUT SECTION . * FILE-CONTROL. * SELECT ENTRADA ASSIGN TO ENTRADA STATUS IS FS-ENTRADA. SELECT SALIDA ASSIGN TO SALIDA STATUS IS FS-SALIDA. * DATA DIVISION. * FILE SECTION. * * Fichero de entrada de longitud fija (F) igual a 11. FD ENTRADA RECORDING MODE IS F BLOCK CONTAINS 0 RECORDS RECORD CONTAINS 11 CHARACTERS. 01 REG-ENTRADA PIC X(11). * * Fichero de salida de longitud fija (F) igual a 28. FD SALIDA RECORDING MODE IS F BLOCK CONTAINS 0 RECORDS RECORD CONTAINS 28 CHARACTERS. 01 REG-SALIDA PIC X(28). * WORKING-STORAGE SECTION . * FILE STATUS 01 FS-STATUS. 05 FS-ENTRADA PIC X(2). 88 FS-ENTRADA-OK VALUE '00'. 88 FS-FICHERO1-EOF VALUE '10'. 05 FS-SALIDA PIC X(2). 88 FS-SALIDA-OK VALUE '00'. * * VARIABLES 01 WB-FIN-ENTRADA PIC X(1) VALUE 'N'. 88 FIN-ENTRADA VALUE 'S'. * 01 WB-SIGNOS PIC X. 88 SIGNO-MAS VALUE 'A', 'B', 'C', 'D', 'E', 'F', 'G', 'H', 'I', '{'. 88 SIGNO-MENOS VALUE 'J', 'K', 'L', 'M', 'N', 'O', 'P', 'Q', 'R', '}'. 01 WX-TABLA-EMPRESAS. 05

PIC X(11) VALUE 'AAEMPRESA 1'.

05 PIC X(11) VALUE 'BBEMPRESA 2'. 05 PIC X(11) VALUE 'CCEMPRESA 3'. 05 PIC X(11) VALUE 'DDEMPRESA 4'. 01 REDEFINES WX-TABLA-EMPRESAS. 05 WX-ELEMENTOS OCCURS 4 TIMES INDEXED BY WI-ELEM. 10 WX-CODIGO-EMPRESA PIC X(2). 10 WX-NOMBRE-EMPRESA PIC X(9). * 01 WX-REGISTRO-ENTRADA. 05 WX-ENT-CLIENTE PIC 9(5). 05 WX-ENT-COD-EMPRESA PIC X(2). 05 WX-ENT-SALDO PIC S9(4). * 01 WX-REGISTRO-SALIDA. 05 WX-SAL-CLIENTE PIC 9(5). 05 WX-SAL-COD-EMPRESA PIC X(2). 05 WX-SAL-NOMBRE-EMPRESA PIC X(9). 05 WX-SAL-SALDO PIC 9(4). 05 WX-SAL-SIGNO PIC X(8). * CONSTANTES 01 WK-POSITIVO PIC X(8) VALUE 'positivo'. 01 WK-NEGATIVO PIC X(8) VALUE 'negativo'. * ************************************************************ PROCEDURE DIVISION. ************************************************************ * | 0000 - PRINCIPAL *--|------------------+----------><----------+-------------* * 1| EJECUTA EL INICIO DEL PROGRAMA * 2| EJECUTA EL PROCESO DEL PROGRAMA * 3| EJECUTA EL FINAL DEL PROGRAMA ************************************************************ 00000-PRINCIPAL. * PERFORM 10000-INICIO * PERFORM 20000-PROCESO UNTIL FIN-ENTRADA * PERFORM 30000-FINAL . ************************************************************ * | 10000 - INICIO *--|------------+----------><----------+-------------------* * | SE REALIZA EL TRATAMIENTO DE INICIO: * 1| Inicialización de Áreas de Trabajo * 2| Primera lectura de SYSIN ************************************************************ 10000-INICIO. * INITIALIZE WX-REGISTRO-SALIDA PERFORM 11000-ABRIR-FICHERO PERFORM LEER-ENTRADA

IF FIN-ENTRADA DISPLAY 'FICHERO DE ENTRADA VACIO' PERFORM 30000-FINAL END-IF . * ************************************************************ * 11000 - ABRIR FICHEROS *--|------------------+----------><----------+-------------* * Abrimos los ficheros del programa ************************************************************ 11000-ABRIR-FICHEROS. * OPEN INPUT ENTRADA OUTPUT SALIDA * IF NOT FS-ENTRADA-OK DISPLAY 'ERROR EN OPEN DEL FICHERO DE ENTRADA:'FS-ENTRADA END-IF IF NOT FS-SALIDA-OK DISPLAY 'ERROR EN OPEN DEL FICHERO DE SALIDA:'FS-SALIDA END-IF . * ************************************************************ * | 20000 - PROCESO *--|------------------+----------><------------------------* * | SE REALIZA EL TRATAMIENTO DE LOS DATOS: * 1| Realiza el tratamiento de cada registro recuperado de * | la ENTRADA ************************************************************ 20000-PROCESO. * PERFORM 21000-BUSCAR-NOMBRE-EMPRESA PERFORM 22000-BUSCAR-SIGNO-SALDO PERFORM 23000-INFORMAR-SALIDA PERFORM ESCRIBIR-SALIDA PERFORM LEER-ENTRADA . * ************************************************************ * 21000 - BUSCAR NOMBRE EMPRESA *--|------------------+----------><----------+-------------* * BUSCAMOS EL CODIGO DE EMPRESA DEL FICHERO DE ENTRADA EN * NUESTRA TABLA INTERNA PARA RECUPERAR EL NOMBRE ************************************************************ 21000-BUSCAR-NOMBRE-EMPRESA. * *Ponemos el índice WI-ELEM a 1 y se irá incrementando de 1 en 1 SET WI-ELEM TO 1 *Buscamos en WX-TABLA-EMPRESAS el nombre de empresa que tenga

*el mismo código que el del fichero de entrada. *Si no lo encuentra, movemos espacios al nombre de la empresa SEARCH WX-TABLA-EMPRESAS AT END MOVE SPACES TO WX-SAL-NOMBRE-EMPRESA WHEN WX-CODIGO-EMPRESA(WI-ELEM) EQUAL WX-ENT-COD-EMPRESA MOVE WX-NOMBRE-EMPRESA(WI-ELEM) TO WX-SAL-NOMBRE-EMPRESA END-SEARCH . * ************************************************************ * 22000-BUSCAR-SIGNO-SALDO *--|------------------+----------><----------+-------------* * COMPROBAMOS EL SIGNO DEL SALDO E INFORMAMOS EL CAMPO: * WX-SAL-SIGNO ************************************************************ 22000-BUSCAR-SIGNO-SALDO. * *El signo viene dado por la última posición. La movemos al *switch WB-SIGNOS. Según su valor informará positivo o negativo MOVE WX-SALDO(4:1) TO WB-SIGNOS EVALUATE TRUE WHEN SIGNO-MAS MOVE WK-POSITIVO TO WX-SAL-SIGNO WHEN SIGNO-MENOS MOVE WK-NEGATIVO TO WX-SAL-SIGNO WHEN OTHER MOVE SPACES END-EVALUATE .

TO WX-SAL-SIGNO

* ************************************************************ * 23000-INFORMAR-SALIDA *--|------------------+----------><----------+-------------* * INFORMAMOS EL RESTO DE CAMPOS DEL FICHERO DE SALIDA ************************************************************ 23000-INFORMAR-SALIDA. * MOVE WX-ENT-CLIENTE TO WX-SAL-CLIENTE MOVE WX-ENT-COD-EMPRESA TO WX-SAL-COD-EMPRESA MOVE WX-ENT-SALDO TO WX-SAL-SALDO . * ************************************************************ * LEER ENTRADA *--|------------------+----------><----------+-------------* * Leemos del fichero de entrada ************************************************************ LEER-ENTRADA. *

READ ENTRADA INTO WX-REGISTRO-ENTRADA EVALUATE TRUE WHEN FS-ENTRADA-OK CONTINUE WHEN FS-ENTRADA-EOF SET FIN-ENTRADA TO TRUE WHEN OTHER DISPLAY 'ERROR EN READ DE ENTRADA:'FS-ENTRADA END-EVALUATE . * ************************************************************ * - ESCRIBIR SALIDA *--|------------------+----------><----------+-------------* * ESCRIBIMOS EN EL FICHERO DE SALIDA LA INFORMACION GUARDADA * WX-REGISTRO-SALIDA ************************************************************ ESCRIBIR-SALIDA. * WRITE REG-SALIDA FROM WX-REGISTRO-SALIDA IF FS-SALIDA-OK INITIALIZE WX-REGISTRO-SALIDA ELSE DISPLAY 'ERROR EN WRITE DEL FICHERO:'FS-SALIDA END-IF . * ************************************************************ * | 30000 - FINAL *--|------------------+----------><----------+-------------* * | FINALIZA LA EJECUCION DEL PROGRAMA ************************************************************ 30000-FINAL. * PERFORM 31000-CERRAR-FICHEROS STOP RUN . * ************************************************************ * | 31000 - CERRAR FICHEROS *--|------------------+----------><----------+-------------* * | CERRAMOS LOS FICHEROS DEL PROGRAMA ************************************************************ 31000-CERRAR-FICHEROS. * CLOSE ENTRADA SALIDA IF NOT FS-ENTRADA-OK DISPLAY 'ERROR EN CLOSE DE ENTRADA:'FS-ENTRADA END-IF

IF NOT FS-SALIDA-OK DISPLAY 'ERROR EN CLOSE DE SALIDA:'FS-SALIDA END-IF .

En el programa podemos ver las siguientes divisiones/secciones: IDENTIFICATION DIVISION: existirá siempre. ENVIRONMENT DIVISION: existirá siempre. CONFIGURATION SECTION: existirá siempre. INPUT-OUTPUT SECTION: en este ejemplo existirá porque utilizamos un fichero de entrada y uno de salida. DATA DIVISION: existirá siempre. FILE SECTION: en este ejemplo existirá pues utilizamos un fichero de entrada y uno de salida. WORKING-STORAGE SECTION: exisitirá siempre. En este caso no exisistirá la LINKAGE SECTION pues el programa no se comunica con otros programas. PROCEDURE DIVISION: exisitirá siempre. En el programa podemos ver las siguientes sentencias: PERFORM: llamada a párrafo INITIALIZE: para inicializar variable OPEN: "Abre" los ficheros del programa. Lo acompañaremos de "INPUT" para los ficheros de entrada y "OUTPUT" para los ficheros de salida. DISPLAY: escribe el contenido del campo indicado en la SYSOUT del JCL. MOVE/TO: movemos la información de un campo a otro. SEARCH: esta sentencia se utiliza para buscar un dato dentro de una tabla interna, recorriéndola usando un índice y comparando alguno de sus campos con el campo que buscamos. PERFORM UNTIL: bucle SET: Activa los niveles 88 de un campo tipo "switch". READ: Lee cada registro del fichero de entrada. En el "INTO" le indicamos donde debe guardar la información. WRITE: Escribe la información indicada en el "FROM" en el fichero indicado. STOP RUN: sentencia de finalización de ejecución. CLOSE: "Cierra" los ficheros del programa. Descripción del programa: En el párrafo de inicio, inicializamos el registro de salida: WX-REGISTRO-SALIDA  Abriremos los ficheros del programa (OPEN INPUT para la enrtada, y OUTPUT para la salida) y controlaremos el file-status. Si todo va bien el código del file-status valdrá '00'. Podéis ver lalista de los file-status más comunes.  Además comprobamos que el fichero de entrada no venga vacío (en caso de que así sea, finalizamos la ejecución). En el párrafo de proceso, que se repetirá hasta que se termine el fichero de entrada (FINENTRADA), tenemos varias llamadas a párrafos: 21000-BUSCAR-NOMBRE-EMPRESA:

Busca en la taba interna WX-TABLA-EMPRESAS utilizando la sentencia SEARCH. 22000-BUSCAR-SIGNO-SALDO:

La última posición del campo saldo (S9(4)) nos indica el signo. Podéis ver la referencia a lossignos

en campos numéricos. Guardaremos esa última posición en el nivel superior de un campo tipo switch (WB-SIGNOS). Si el valor se corresponde con alguno de los indicados en los niveles 88, ese nivel se activará a "TRUE". En el "EVALUATE TRUE", el programa entrará por la sentencia "WHEN" que esté activa (que sea "TRUE"). 23000-INFORMAR-SALIDA:

Informamos el resto de campos. ESCRIBIR-SALIDA:

Escribimos nuestro registro ya informado en el fichero de salida. LEER-ENTRADA:

Leemos el siguiente registro del fichero de entrada. Fichero de salida: ----+----1----+----2----+----3 11111AAEMPRESA 11001positivo 22222BBEMPRESA 21002positivo 33333CCEMPRESA 31002negativo 44444DDEMPRESA 41004negativo

campo1: número de cliente campo2: código de empresa campo3: nombre de empresa campo4: saldo campo5: signo del saldo En este programa además de ver como crear un PROCESO que trate todos los registros de un fichero de entrada, hemos visto varias sentencias como el E VALUATE y el SEARCH. Así aprovechamos para ir introduciendo más sentencias útiles del COBOL en forma de ejemplos. Y si os queda cualquier duda, estamos aquí para resolverlas

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 --------ANA ANA ANA ANA TOTAL ANA

APELLIDO --------------LOPEZ MARTINEZ PEREZ RODRIGUEZ : 04

LISTADO DE EJEMPLO DEL CONSULTORIO COBOL DIA: 23-03-11 PAGINA: 2 ------------------------------------------

NOMBRE --------BEATRIZ BEATRIZ BEATRIZ

APELLIDO --------------GARCIA MOREDA 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 05 FILLER 05 WX-FEC-MM 05 FILLER 05 WX-FEC-AA

PIC PIC PIC PIC PIC

9(2). X VALUE '-'. 9(2). X VALUE '-'. 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 05 05 05 05

FILLER LT-FECHA FILLER FILLER LT-NUMPAG

PIC PIC PIC PIC PIC

X(5) VALUE 'DIA: '. X(8). X(16) VALUE ALL SPACES . X(8) VALUE 'PAGINA: '. 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 ADD 1 ADD 1 .

TO WC-LINEAS TO WC-NOMBRES 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 PERFORM PERFORM ELSE PERFORM PERFORM END-IF

ESCRIBIR-CABECERAS ESCRIBIR-SUBTOTAL ESCRIBIR-TOTALES ESCRIBIR-SUBTOTAL ESCRIBIR-TOTALES

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 lalista 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 inici alizamos 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 (FINENTRADA), 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 ll evamos 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

Ejemplo 5: programa con DB2 En este ejemplo vamos a ver un programa que accede a base de datos para recuperar  información. Veremos un ejemplo sencillo en el que el programa recuperará de SYSIN l a clave por  la que accederá a la base de datos, y displayará la información recuperada por SYSOUT. JCL: //PASO01 EXEC PGM=IKJEFT01,DYNAMNBR=20 //SYSTSIN DD * DSN SYSTEM(DSN1) RUN PROGRAM(PRUEBA5) PLAN(PRUEBA5) LIB('LIBRERIA.DE.TU.INSTALACION') //SYSOUT DD SYSOUT=* //SYSIN DD * PEREZ /*

Donde EXEC PGM=IKJEFT01 ejecutará el programa que le indiquemos en el SYSTSIN. El DSN SYSTEM dependerá de cada instalación y puede variar según el entorno (desarrollo, preproduccion, explotación...). En PROGRAM indicaremos el programa con DB2 a ejecutar, y en PLAN el plan DB2 asociado. La librería indicada en LIB es opcional. En la SYSIN le pasaremos la clave por la que accederemos a la tabla. En este caso será el campo  APELLIDO. TABLA: Nombre CARMEN JAVIER SARA

Apellido PEREZ LOPEZ GARCIA

Telefono 666555444 666999888 666222111

Donde: El campo Nombre es un CHAR(10). El campo Apellido es un CHAR(10). El campo Telefono es un DECIMAL(9). PROGRAMA:

IDENTIFICATION DIVISION . PROGRAM-ID. PRUEBA5. *==========================================================* * PROGRAMA QUE ACCEDE A BASE DE DATOS CON UNA SELECT *==========================================================* * ENVIRONMENT DIVISION . * CONFIGURATION SECTION . * SPECIAL-NAMES . DECIMAL-POINT IS COMMA . * DATA DIVISION. * WORKING-STORAGE SECTION . * EXEC SQL INCLUDE SQLCA END-EXEC. EXEC SQL INCLUDE TABLA END-EXEC. 01 WX-SYSIN. 05 WX-CLAVE PIC X(10). 05 FILLER PIC X(70). 01 WX-TABLA. 05 WX-NOMBRE PIC X(10). 05 WX-APELLIDO PIC X(10). 05 WX-TELEFONO PIC S9(9) COMP-3. 01 WX-VARIABLES. 05 WX-TELEFONO-NUM PIC 9(9). * ************************************************************ PROCEDURE DIVISION. ************************************************************ * | 00000 - 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 * PERFORM 30000-FINAL . ************************************************************ * | 10000 - INICIO *--|------------+----------><----------+-------------------* * | SE REALIZA EL TRATAMIENTO DE INICIO:

* 1| Inicialización de Áreas de Trabajo * 2| Lectura de SYSIN ************************************************************ 10000-INICIO. * INITIALIZE WX-SYSIN WX-TABLA WX-VARIABLES ACCEPT WX-SYSIN FROM SYSIN . ************************************************************ * | 20000 - PROCESO *--|------------------+----------><------------------------* * | SE REALIZA EL TRATAMIENTO DE LOS DATOS: * 1| Realiza el acceso a base de datos ************************************************************ 20000-PROCESO. * EXEC SQL SELECT NOMBRE ,TELEFONO INTO :WX-NOMBRE ,:WX-TELEFONO FROM TABLA WHERE APELLIDO = :WX-CLAVE ORDER BY APELLIDO END-EXEC EVALUATE TRUE WHEN SQLCODE EQUAL ZEROES DISPLAY 'TODO VA BIEN' PERFORM 21000-GRABAR-SALIDA WHEN SQLCODE EQUAL +100 DISPLAY 'NO ENCONTRE NADA' WHEN OTHER DISPLAY 'ALGO HA IDO MAL. EL SQLCODE ES: ' SQLCODE PERFORM 30000-FINAL END-EVALUATE . ************************************************************* * | 21000 - GRABAR - SALIDA *--|------------------+----------><----------+--------------* * | ESCRIBE EN SYSOUT LA INFORMACIÓN RECUPERADA DE LA TABLA ************************************************************* 21000-GRABAR-SALIDA. * MOVE WX-TELEFONO TO WX-TELEFONO-NUM MOVE WX-CLAVE TO WX-APELLIDO DISPLAY 'NOMBRE :'WX-NOMBRE DISPLAY 'APELLIDO:'WX-APELLIDO DISPLAY 'TELEFONO:'WX-TELEFONO-NUM

. ************************************************************ * | 30000 - FINAL *--|------------------+----------><----------+-------------* * | FINALIZA LA EJECUCION DEL PROGRAMA ************************************************************ 30000-FINAL. * STOP RUN .

En el programa podemos ver las siguientes divisiones/secciones: IDENTIFICATION DIVISION: existirá siempre. ENVIRONMENT DIVISION: existirá siempre. CONFIGURATION SECTION: existirá siempre. En este caso no existirá la INPUT-OUTPUT SECTION, pues nuestro programa no utili za ficheros. DATA DIVISION: existirá siempre. En este caso no existirá la FILE SECTION, pues nuestro programa no utiliza ficheros. 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  ACCEPT: esta sentencia recoge la información del campo indicado en el "FROM". En este caso recoge la información almacenada en "SYSIN"; la que nosotros hemos introducido en el JCL. EXEC SQL/END-EXEC: son las etiquetas para incluir código SQL. Todas las sentencias DB2 se deben incluir entre estas etiquetas. EVALUATE TRUE: Valida que se cumplan las condiciones indicadas en cada uno de los "WHEN". MOVE/TO: movemos la información de un campo a otro DISPLAY: escribe el contenido del campo indicado en la SYSOUT del JCL. STOP RUN: sentencia de finalización de ejecución. Descripción del programa: En la WORKING-STORAGE hemos incluido la copy SQLCA (SQL communications area ó área de comunicación SQL), que es la que utiliza el gestor de base de datos para devolver la información de errores. La estructura es la siguiente: 01 SQLCA SYNC. 05 SQLCAID PIC X(8) VALUE "SQLCA ". 05 SQLCABC PIC S9(9) COMP-5 VALUE 136. 05 SQLCODE PIC S9(9) COMP-5. 05 SQLERRM. 05 SQLERRP PIC X(8). 05 SQLERRD OCCURS 6 TIMES PIC S9(9) COMP-5. 05 SQLWARN. 10 SQLWARN0 PIC X. 10 SQLWARN1 PIC X. 10 SQLWARN2 PIC X. 10 SQLWARN3 PIC X. 10 SQLWARN4 PIC X. 10 SQLWARN5 PIC X. 10 SQLWARN6 PIC X.

10 SQLWARN7 PIC X. 10 SQLWARN8 PIC X. 10 SQLWARN9 PIC X. 10 SQLWARNA PIC X. 05 SQLSTATE PIC X(5). *

Como veis incluye la variable SQLCODE, donde guardará el código de retorno que nos indicará si la consulta ha ido bien o no. Hemos incluido también la DCLGEN de la tabla "TABLA" que contendrá los campos DB2 de la tabla (los que codificamos en la parte de la SELECT) y sus campos working y que tendrá algo de este estilo: EXEC SQL DECLARE TABLA TABLE (NOMBRE CHAR(10) APELLIDO CHAR(10) RELEFONO DECIMAL(9) END-EXEC. 01

DCLTABLA. 10 TAB-NOMBRE 10 TAB-APELLIDO 10 TAB-TELEFONO

NOT NULL, NOT NULL, NOT NULL)

PIC X(10). PIC X(10). PIC S9(9) COMP-3.

En el párrafo de inicio, inicializamos todas las variables de trabajo definidas en la WORKINGSTORAGE, y realizamos un ACCEPT para recoger la información que hemos puesto en la SYSIN. En nuestro caso se trata del campo clave por el que accederemos a nuestra tabla. En el párrafo de proceso, hacemos una SELECT a la tabla con la condición APELLIDO = :WXCLAVE. Donde WX-CLAVE contiene el apellido recogido por SYSIN. Comprobamos el SQLCODE que nos devuelve esta consulta: Si el SQLCODE es cero, la consulta ha ido bien y se ha encontrado el apellido contenido en WXCLAVE en nuestra tabla. En nuestro caso dará este SQLCODE, pues "PEREZ" está en la tabla. Si el SQLCODE es 100, la consulta ha ido bien pero no ha encontrado el apellido "PEREZ" en nuestra tabla. Si el SQLCODE es cualquier otro, la consulta ha ido mal y habrá que comprobar en la tabla de errores DB2 cuál ha sido el problema. NOTA: el tema de la puntuación en sentencias SQL (es decir, poner o no poner un punto '.' al final de una sentencia DB2 dentro de la PROCEDURE DIVISION) dependerá de la versión del compilador. En el párrafo de GRABAR-SALIDA, movemos el campo WX-TELEFONO a una variable numérica sin comprimir (WX-TELEFONO-NUM), para que al hacer el DISPLAY se vea correctamente. Luego displayamos los campos recuperados de la consulta. RESULTADO: NOMBRE : CARMEN APELLIDO: PEREZ TELEFONO: 666555444

Si queréis probar este ejemplo, tendréis que hacer una sentencia SELECT a una tabla que exista en vuestra base de datos

Ejemplo 6: programa que llama a otro programa

En este ejemplo vamos a ver un programa que llama a otro programa, denominado rutina, para recuperar información. Se trata de un programa sin DB2 que recibirá un número de DNI por SYSIN y llamará a una rutina para calcular la letra de dicho NIF. La información recuperada la mostrará por SYSOUT. JCL: //PROG6 EXEC PGM=PRUEBA6 //SYSOUT DD SYSOUT=* //SYSIN DD * 32684930 /*

donde EXEC PGM= indica el programa SIN DB2 que vamos a ejecutar  SYSOUT DD SYSOUT=* indica que la información "displayada" se quedará en la cola del SYSOUT (no lo vamos a guardar en un fichero) en SYSIN DD * metemos la información que va a recibir el programa PROGRAMA: IDENTIFICATION DIVISION . PROGRAM-ID. PRUEBA6. *==========================================================* * PROGRAMA QUE LLAMA A OTRO PROGRAMA (RUTINA) *==========================================================* * ENVIRONMENT DIVISION . * CONFIGURATION SECTION . * SPECIAL-NAMES . DECIMAL-POINT IS COMMA . * DATA DIVISION. * WORKING-STORAGE SECTION . * 01 WX-SYSIN. 05 WX-NUMERO-NIF PIC X(8). 05 FILLER PIC X(72). 01 WX-RUTINA. 05 WX-NIF-COMPLETO. 10 WX-NUMERO-NIF PIC 9(8). 10 WX-LETRA-NIF PIC X. 05 WX-RETORNO PIC X(2). 01 RUTINA1 PIC X(7) VALUE 'RUTINA1'. * ************************************************************ PROCEDURE DIVISION. ************************************************************ * | 00000 - 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 * PERFORM 30000-FINAL . * ************************************************************ * | 10000 - INICIO *--|------------+----------><----------+-------------------* * | SE REALIZA EL TRATAMIENTO DE INICIO: * 1| Inicialización de Áreas de Trabajo * 2| Lectura de SYSIN ************************************************************ 10000-INICIO. * INITIALIZE WX-SYSIN WX-RUTINA ACCEPT WX-SYSIN FROM SYSIN . ************************************************************ * | 20000 - PROCESO *--|------------------+----------><------------------------* * | SE REALIZA EL TRATAMIENTO DE LOS DATOS: * 1| Realiza el acceso a base de datos ************************************************************ 20000-PROCESO. * MOVE WX-NUMERO-NIF OF WX-SYSIN TO WX-NUMERO-NIF OF WX-RUTINA CALL RUTINA1 USING WX-RUTINA IF WX-RETORNO EQUAL 'OK' DISPLAY 'LA LLAMADA HA IDO BIEN' PERFORM 21000-GRABAR-SALIDA ELSE DISPLAY 'LA LLAMADA HA IDO MAL' PERFORM 30000-FINAL END-IF . ************************************************************* * | 21000 - GRABAR - SALIDA *--|------------------+----------><----------+--------------* * | ESCRIBE EN SYSOUT LA INFORMACIÓN RECUPERADA DE LA TABLA ************************************************************* 21000-GRABAR-SALIDA. * DISPLAY 'NIF COMPLETO:'WX-NIF-COMPLETO . * ************************************************************

* | 30000 - FINAL *--|------------------+----------><----------+-------------* * | FINALIZA LA EJECUCION DEL PROGRAMA ************************************************************ 30000-FINAL. * STOP RUN .

En el programa podemos ver las siguientes divisiones/secciones: IDENTIFICATION DIVISION: existirá siempre. ENVIRONMENT DIVISION: existirá siempre. CONFIGURATION SECTION: existirá siempre. En este caso no existirá la INPUT-OUTPUT SECTION, pues nuestro programa no utiliza ficheros. DATA DIVISION: existirá siempre. En este caso no existirá la FILE SECTION, pues nuestro programa no utiliza ficheros. WORKING-STORAGE SECTION: exisitirá siempre. En este caso no exisistirá la LINKAGE SECTION pues el programa no es llamado desde otros programas. PROCEDURE DIVISION: exisitirá siempre. En el programa podemos ver las siguientes sentencias: PERFORM: llamada a párrafo INITIALIZE: para inicializar variable ACCEPT: esta sentencia recoge la información del campo indicado en el "FROM". En este caso recoge la información almacenada en "SYSIN"; la que nosotros hemos introducido en el JCL. MOVE/TO: movemos la información de un campo a otro CALL/USING: es la sentencia que usamos para llamar a una rutina. Después del CALL indicamos el nombre de la rutina que vamos a invocar, y después del USING indicamos las variables de comunicación entre ambos programas. DISPLAY: escribe el contenido del campo indicado en la SYSOUT del JCL. IF/ELSE: comprueba si se cumple una condición. STOP RUN: sentencia de finalización de ejecución. Descripción del programa: En el párrafo de inicio, inicializamos las variables que vamos a utilizar a lo largo del programa. Luego mediante un ACCEPT recogemos la información que hemos escrito en la SYSIN de nuestro JOB. En el párrafo de proceso, informamos el campo WX -NUMERO-NIF del área WX-RUTINA con la información recogida de SYSIN. Como veis existen dos variables con el mismo nombre. Esto no dará problemas al compilar, mientras las variables pertenezcan a niveles superiores diferentes. En nuestro caso tenemos un WX-NUMERO-NIF que pertenece a WX-SYSIN, y otro que pertenece a WX-RUTINA. Para utilizar estas variables a lo largo del programa tendremos que indicar a cuál de ellas nos referimos, por eso les hemos añadido el "OF WX-XXXXX". Una vez informada el área de comunicación entre dos programas, procedemos a hacer la llamada en sí con la sentencia CALL/USING. Se trata de una llamada dinámica, pues el nombre de la rutina está contenido dentro de una variable, así que después de la llamada la rutina será descargada de la memoria. En las llamadas estáticas el nombre de la rutina se indica entre comillas simpes 'RUTINA1'. En este caso, después de la llamada el módulo queda residente en memoria, porque se integra en el

programa objeto. Para que no haya errores comprobamos que la llamada ha ido bien validando el retorno (informado dentro de la rutina). Si todo ha ido bien grabamos la información recuperada (NIF con letra) en la SYSOUT mediante un DISPLAY. RUTINA IDENTIFICATION DIVISION . PROGRAM-ID. RUTINA1. *==========================================================* * RUTINA QUE CALCULA LA LETRA DE UN NIF *==========================================================* * ENVIRONMENT DIVISION . * CONFIGURATION SECTION . * SPECIAL-NAMES . DECIMAL-POINT IS COMMA . * DATA DIVISION. * WORKING-STORAGE SECTION . * 01 WI-INDICES. 05 WI-IND PIC 9(2). * 01 WX-VARIABLES. 05 WX-NIF-DIVID PIC 9(8). 05 WX-NIF-MULTI PIC 9(8). * 01 WT-TABLAS. 05 WT-NIF-TABLA PIC X(24) VALUE "TRWAGMYFPDXBNJZSQVHLCKET". 05 WT-NIF-TABLA-R REDEFINES WT-NIF-TABLA. 10 WT-LETRA-TABLA OCCURS 24 PIC X. * LINKAGE SECTION. * 01 WX-RUTINA. 05 WX-NIF-COMPLETO. 10 WX-NUMERO-NIF PIC 9(8). 10 WX-LETRA-NIF PIC X. 05 WX-RETORNO PIC X(2).

* ************************************************************ PROCEDURE DIVISION USING WX-RUTINA. ************************************************************ * | 00000 - 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 * PERFORM 30000-FINAL . ************************************************************ * | 10000 - INICIO *--|------------+----------><----------+-------------------* * | SE REALIZA EL TRATAMIENTO DE INICIO: * 1| Inicialización de Áreas de Trabajo ************************************************************ 10000-INICIO. * INITIALIZE WX-VARIABLES WI-INDICES . * ************************************************************ * | 20000 - PROCESO *--|------------------+----------><------------------------* * | SE REALIZA EL TRATAMIENTO DE LOS DATOS: * 1| Realiza el cálculo de la letra del NIF ************************************************************ 20000-PROCESO. * COMPUTE WX-NIF-DIVID = WX-NUMERO-NIF / 23 COMPUTE WX-NIF-MULTI = WX-NIF-DIVID * 23 COMPUTE WI-IND = WX-NUMERO-NIF - WX-NIF-MULTI ADD 1

TO WI-IND

MOVE WT-LETRA-TABLA(WI-IND) TO WX-LETRA-NIF MOVE 'OK' .

TO WX-RETORNO

* ************************************************************ * | 30000 - FINAL *--|------------------+----------><----------+-------------* * | FINALIZA LA EJECUCION DEL PROGRAMA ************************************************************ 30000-FINAL. * GOBACK .

En el programa podemos ver las siguientes divisiones/secciones: IDENTIFICATION DIVISION: existirá siempre. ENVIRONMENT DIVISION: existirá siempre. CONFIGURATION SECTION: existirá siempre. En este caso no existirá la INPUT-OUTPUT SECTION, pues nuestro programa no utili za ficheros. DATA DIVISION: existirá siempre.

En este caso no existirá la FILE SECTION, pues nuestro programa no utiliza ficheros. WORKING-STORAGE SECTION: exisitirá siempre. LINKAGE SECTION: en este caso sí existirá puesto q ue se trata de una rutina que es llamada por  un programa principal. PROCEDURE DIVISION: exisitirá siempre. En el programa podemos ver las siguientes sentencias: PERFORM: llamada a párrafo INITIALIZE: para inicializar variable COMPUTE: realiza cálculos numéricos  ADD: operador de adición (suma) MOVE/TO: movemos la información de un campo a otro GOBACK: sentencia de finalización de ejecución para rutinas. Devuelve el control al programa llamante. Descripción del programa: En la LINKAGE SECTION definimos el área de comunicación con el programa llamante (PRUEBA6), en este caso WX-RUTINA. En el párrafo de inicio inicializamos las variables que vamos a utilizar a lo largo del programa. En el párrafo de proceso hacemos los cálculos necesarios para saber qué letra s e corresponde al número de NIF que hemos introducido e informamos con un 'OK' el código de retorno. En caso de que se produzca un error antes de terminar el proceso, el código de retorno irá vacío, y podremos controlar esta diferencia en el programa llam ante. Una vez calculada la letra del NIF devolvemos el control al programa PRUEBA6 haciendo GOBACK. RESULTADO: NIF-COMPLETO: 32684930K

Diferencias entre ambos programas: LINKAGE SECTION: sólo la rutina (programa que es llamado por otro) tiene variables definidas en esta sección. PROCEDURE DIVISION: sólo la rutina lleva asociada el área de comunicación entre programas en la procedure, añadiéndole la sentencia USING. 30000-FINAL: el programa principal lleva un STOP RUN de finalización de ejecución, mientras que la rutina lleva un GOBACK para devolver el control al programa llamante (programa que ha hecho el CALL).

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, REGSALIDA, 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: ----+----10000155501 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 01 WX-CLIENTE-ANT * 01 WX-REGISTRO-ENTRADA. 05 WX-ENT-CLIENTE 05 WX-ENT-PRODUCTO * 01 WX-REGISTRO-SALIDA. 05 WX-SAL-PRODUCTO *

PIC 9(3) COMP-3. PIC 9(5). PIC 9(5). PIC X(5). 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