COBOL/CICS vol.3: Colas TS

Colas TS: TS QUEUES (Temporary storage queues).

En este artículo vamos a ver lo que son las colas TS y como escribir/leer en ellas con un programa de ejemplo.
Según la web de IBM, podemos definir las colas como "Instalaciones de almacenamiento secuencial que son recursos globales tanto dentro de una única región de CICS como de un sistema de regiones de CICS interconectadas". Lo que viene a significar que una cola es una región de almacenamiento de datos.
Existen dos tipos de colas, las TS y las TD (transient data queues). En este artículo solo trataremos las colas TS.

Las colas TS se crean dinámicamente, es decir, si al ejecutar un programa queremos escribir en una cola TS que no existe, se crea.
La información se almacena en forma de registros y se puede acceder a ellos de forma secuencial o directa. Para la forma directa tendremos que indicar a la hora de leer la cola TS el número del registro al que queremos acceder (ITEM). Si no lo indicamos, iremos leyendo los registros de la cola TS secuencialmente.
Al poder acceder de forma directa, permiten también actualizar la información almacenada.
El nombre de una cola TS se lo asignaremos nosotros.
Para ver la información de una cola TS accederemos a la transacción CEBR (Temporary Storage Browse) tecleando CEBR nombrecola:

CEBR CONSULCC

Mostraría:

CEBR TSQ CONSULCC SYSID CICS REC 1 OF 3 COL 1 OF 10
ENTER COMMAND ===>
************************** TOP OF QUEUE *******************************
00001 ALVARO
00002 TALLI
00003 PEPE
************************* BOTTOM OF QUEUE *****************************

Para borrar la información de una cola TS desde CICS usaremos la transacción CEMT.
CEMT SET TS(nombrecola)

En la opción Action escribiremos "delete" y daremos intro.

Para información sobre como crear transacciones podéis ver el artículo COBOL/CICS vol.1: primer contacto.

Hemos tomado como base el ejemplo del artículo COBOL/CICS vol.1 por lo que se trata de un programa conveersacional que recogerá un texto de la pantalla. En esta ocasión lo que haremos será escribir el texto recogido en una cola TS, a continuación leer de esa cola TS para recuperarlo y mostrar un saludo por pantalla. Para terminar borraremos la cola TS.
Vamos a ver el programa.

PROGRAMA:
Por tratarse de un programa COBOL/CICS, tendrá la misma estructura que un programa cobol normal, simplemente incluiremos algunas sentencias CICS en el código.

 IDENTIFICATION DIVISION.
 PROGRAM-ID. PGMCICS2.
 AUTHOR. CONSULTORIO COBOL.
*
*==========================================================*
* MI PRIMER PROGRAMA EN CICS *
* ENVIA UN SALUDO PERSONALIZADO *
*==========================================================*
*
 ENVIRONMENT DIVISION.
*
 CONFIGURATION SECTION.
*
 SPECIAL-NAMES.
    DECIMAL-POINT IS COMMA.
*
 DATA DIVISION.
*
 WORKING-STORAGE SECTION.
*
 01 WX-PREGUNTA-NOMBRE.
    05 WX-PN.
       10 FILLER    PIC X(20) VALUE 'INTRODUCE TU NOMBRE:'.
       10 FILLER    PIC X(10) VALUE '__________'.

 01 WX-RESPUESTA.
    05 WX-RES1.
       10 FILLER    PIC X(3).
       10 FILLER    PIC X(20).
       10 WX-NOMBRE PIC X(10).

 01 WX-SALUDO       PIC X(30).
 01 WX-HOLA         PIC X(5)  VALUE 'HOLA '.
 01 WX-RESTO-SALUDO PIC X(17) VALUE '! YO SOY EL CICS.'. 
 01 WRESP           PIC 9(4) COMP VALUE 0. 
 01 WX-TEXTO-ERR    PIC X(30). 
 01 WX-LONG-NOMBRE  PIC 99.
 01 WX-NUM-ELEMENT  PIC S9(4) COMP VALUE 1. 

* DAMOS NOMBRE A NUESTRA COLA                
                                             
 01 NOMBRECOLA.                              
    05 WX-COLA     PIC X(8) VALUE 'CONSULCC'.
                                             
* DESCRIPCION DEL REGISTRO DE LA COLA        
                                             
 01 WX-DATOSTS.                              
    02 TS-NOMBRE  PIC X(10) VALUE SPACES.    
*
***********************************************************
 PROCEDURE DIVISION.
***********************************************************
*  | 0000 - PRINCIPAL
*--|------------------+----------><----------+-------------* 
* 1| EJECUTA EL INICIO DEL PROGRAMA 
* 2| EJECUTA EL PROCESO DEL PROGRAMA 
* 3| EJECUTA EL FINAL DEL PROGRAMA ************************************************************
 0000-PRINCIPAL. 
* 
     PERFORM 1000-INICIO 
     PERFORM 2000-PROCESO 
     PERFORM 3000-FINAL 
     . 
* 
************************************************************ 
*  | 10000 - INICIO 
*--|------------+----------><----------+-------------------* 
*  | SE REALIZA EL TRATAMIENTO DE INICIO: 
* 1| INICIALIZACIóN DE ÁREAS DE TRABAJO 
* 2| PRIMERA LECTURA DE SYSIN ************************************************************ 
 1000-INICIO.
*
     INITIALIZE WX-RESPUESTA 
                WX-SALUDO
                WX-LONG-NOMBRE
     . 
* 
************************************************************ 
*  | 20000 - PROCESO 
*--|------------------+----------><------------------------* 
*  | SE REALIZA EL TRATAMIENTO DE LOS DATOS: 
* 1| REALIZA EL TRATAMIENTO DE CADA REGISTRO RECUPERADO DE 
*  | LA ENTRADA ************************************************************ 
 2000-PROCESO. 
*
     PERFORM 2100-PEDIR-DATOS
     PERFORM 2200-RECUPERAR-NOMBRE
     PERFORM 2300-GRABAR-COLA    
     PERFORM 2400-LEER-COLA       
     PERFORM 2500-ENVIA-SALUDO 
     PERFORM 2600-BORRAR-COLA
     . 
* 
************************************************************ 
* 2100 PEDIR DATOS 
*--|------------------+----------><----------+-------------* 
* ENVIA UN MENSAJE A LA PANTALLA ************************************************************
 2100-PEDIR-DATOS. 
* POSICIONAMOS EL CURSOR EN LA POSICION 21 
     MOVE 21   TO EIBCPOSN 
*
* ENVIAMOS UN TEXTO A LA VENTANA 
     EXEC CICS SEND TEXT 

               FROM (WX-PREGUNTA-NOMBRE) 

               ERASE 
               CURSOR (EIBCPOSN) 

               LENGTH (LENGTH OF WX-PREGUNTA-NOMBRE) 

     END-EXEC 

* 
* RECOGEMOS LA RESPUESTA EN WX-RESPUESTA 
* 
     EXEC CICS RECEIVE 

               INTO (WX-RESPUESTA) 

               LENGTH (LENGTH OF WX-RESPUESTA) 

     END-EXEC 

     .
* 
************************************************************ 
* 2200 RECUPERAR NOMBRE
*--|------------------+----------><----------+-------------* 
* FORMAREA LA INFORMACION RECOGIDA EN WX-RESPUESTA
* CALCULA LA LONGITUD DEL NOMBRE INTRODUCIDO POR VENTANA
************************************************************
 2200-RECUPERAR-NOMBRE.
*
     INSPECT WX-NOMBRE TALLYING WX-LONG-NOMBRE    
     FOR CHARACTERS BEFORE INITIAL '_'            
                                             
     MOVE WX-NOMBRE(1:WX-LONG-NOMBRE) TO TS-NOMBRE
     .   
* 
************************************************************ 
* 2300 GRABAR COLA

*--|------------------+----------><----------+-------------* 
* GRABAMOS LA INFORMACION DE W-DATOSTS EN NUESTRA COLA TS
************************************************************
 2300-GRABAR-COLA.
*      

     EXEC CICS WRITEQ  TS                               
          QUEUE  (NOMBRECOLA)                           
          FROM   (WX-DATOSTS) 

          ITEM   (WX-NUM-ELEMENT)                          
          RESP   (WRESP)                                
     END-EXEC                                          
                                                   
     IF WRESP NOT EQUAL ZEROES                                   
        MOVE 'ERROR AL ESCRIBIR COLA TS' TO WX-TEXTO-ERR
        PERFORM CANCELAR                                
     END-IF
     .
* 
************************************************************ 
* 2400 LEER COLA

*--|------------------+----------><----------+-------------* 
* LEEMOS NUESTRA COLA TS PARA RECUPERAR LA INFORMACION

************************************************************
 2400-LEER-COLA.
*     
     EXEC CICS READQ TS                                   
          QUEUE  (NOMBRECOLA)                             
          LENGTH (LENGTH OF WX-DATOSTS)                   
          INTO   (WX-DATOSTS)                             
          RESP   (WRESP)                                  
     END-EXEC                                            
                                                     
     EVALUATE WRESP                                       
        WHEN ZEROES                                           
        WHEN DFHRESP (QIDERR)                            
             CONTINUE                                    
        WHEN OTHER                                       
             MOVE 'ERROR AL LEER COLA TS' TO WX-TEXTO-ERR
             PERFORM CANCELAR                            
     END-EVALUATE
     .
* 
************************************************************ 
* 2500 BORRAR COLA

*--|------------------+----------><----------+-------------* 
* BORRAMOS LA COLA TS

************************************************************
 2500-BORRAR-COLA.
*
     EXEC CICS DELETEQ TS                             
          QUEUE  (NOMBRECOLA)                         
          RESP   (WRESP)                              
     END-EXEC                                        
                                                 
     IF WRESP NOT EQUAL ZEROES AND                             
        WRESP NOT EQUAL DFHRESP(QIDERR)                   
        MOVE 'ERROR AL BORRAR COLA TS' TO WX-TEXTO-ERR
        PERFORM CANCELAR                              
     END-IF
     .                                           
*
************************************************************ 
* 2600 ENVIAMOS SALUDO 
*--|------------------+----------><----------+-------------* 

* ENVIA EL SALUDO PERSONALIZADO A LA PANTALLA 
************************************************************ 
 2600-ENVIA-SALUDO. 
* 

     STRING WX-HOLA DELIMITED BY SIZE 
            WX-NOMBRE DELIMITED BY SPACES 
            WX-RESTO-SALUDO DELIMITED BY SIZE 
       INTO WX-SALUDO 

     EXEC CICS SEND TEXT 

               FROM (WX-SALUDO) 

               ERASE LENGTH (LENGTH OF WX-SALUDO) 

     END-EXEC 
     . 
* 
************************************************************ 
*  | 30000 - FINAL 
*--|------------------+----------><----------+-------------* 
*  | FINALIZA LA EJECUCION DEL PROGRAMA Y DEVUELVE EL 
*  | CONTROL AL CICS 
************************************************************ 
 3000-FINAL. 
* 
     EXEC CICS RETURN 

     END-EXEC

     . 
* 
************************************************************ 
*  | CANCELAR
*--|------------------+----------><----------+-------------* 
*  | ENVIAMOS UN MENSAJE DE ERROR POR LA CANCELACION
************************************************************ 
 CANCELAR. 
* 

     EXEC CICS SEND TEXT                     
               FROM (WX-TEXTO-ERR)           
               ERASE                         
               LENGTH (LENGTH OF WX-TEXTO-ERR)
     END-EXEC

     PERFORM 3000-FINAL                                    
     . 
*


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 no exisitrá porque no vamos a usar ficheros.
DATA DIVISION: existirá siempre.
  FILE SECTION: en este ejemplo no exisitrá porque no vamos a usar ficheros.
  WORKING-STORAGE SECTION: exisitirá siempre.
  En este caso NO exisistirá la LINKAGE SECTION pues se trata de un programa conversacional en el que el CICS inmobiliza áreas de memoria para guardar los datos intercambiados.
PROCEDURE DIVISION: exisitirá siempre.


En el programa podemos ver las siguientes sentencias:
PERFORM: llamada a párrafo
INITIALIZE: para inicializar variable
MOVE/TO: movemos la información de un campo a otro.
EXEC CICS/END-EXEC: Etiquetas entre las que se codifica una sentencia CICS
SEND TEXT: envía un mensaje de texto al CICS.
RECEIVE: recibe un mensaje de texto desde el CICS.
INSPECT/TALLYING: recorre todos los caracteres de una cadena y cuenta el número de caracteres encontrados antes del primer guión bajo (FOR CHARACTERS BEFORE INITIAL '_' ). El número de caracteres encontrados los guarda en WX-LONG-NOMBRE.
STRING/INTO: concatena los campos indicados en STRING y los guarda en la variable indicada en INTO. La explicación completa en PROCEDURE DIVISION: proceso del programa.
RETURN: Sentencia de finalización de ejecución. Devuelve el control al CICS.
WRITEQ TS: escribe la información indicada en FROM en la cola indicada en QUEUE.
READQ TS: lee la información de la cola indicada en QUEUE y la guarda en la variable indicada en INTO.
DELETEQ TS: borra la información de la cola indicada en QUEUE.


Descripción del programa:
En el inicio del programa, inicializamos las variables de trabajo WX-RESPUESTA, WX-SALUDO y WX-LONG-NOMBRE.

En el proceso tenemos los siguientes párrafos:
2100-PEDIR-DATOS.
Ver COBOL/CICS vol.1.

2200-RECUPERAR-NOMBRE.
En este párrafo formateamos el mensaje recibido:
INTRODUCE TU NOMBRE:TALLIAN____
En WX-NOMBRE tendremos el texto "TALLIAN____".
La sentencia INSPECT WX-NOMBRE recorrerá todos los caracteres almacenados en WX-NOMBRE.
La sentencia TALLYING contará el número de caracteres encontrados hasta llegar al primer guion bajo '_'. Esto se lo estamos indicando con la sentencia FOR CHARACTERS BEFORE INITIAL '_' (caracteres antes del primer guion bajo).
La información se guardará en la variable indicada junto a TALLYING, en nuestro caso WX-LONG-NOMBRE (el número guardado se corresponderá con la longitud del nombre).

Ahora lo que haremos será mover a la variable TS-NOMBRE sólo la información del nombre (sin los guiones bajos). Para ello utilizaremos un movimiento por posiciones desde la posición 1 y ocupando tantos caracteres como indice la variable WX-LONG-NOMBRE.

MOVE WX-NOMBRE(1:WX-LONG-NOMBRE) TO TS-NOMBRE

2300-GRABAR-COLA:
En este párrafo grabaremos la información guardada en TS-NOMBRE en nuestra cola TS. El nombre de nuestra cola lo hemos guardado en la variable NOMBRECOLA con valor "CONSULCC".
De esta forma la cola se creerá con ese nombre, y cuando vayamos a consultarla desde CEBR será el nombre que tengamos que indicarle.
En la variable WRESP se guardará el código de respuesta RESP que devuelva la acción del WRITEQ TS. Si es distinta de cero indicará que algo ha ido mal.

En este punto la cola TS CONSULCC tendrá la siguiente información:

2400-LEER-COLA:
En este párrafo leeremos la información guardada en nuestra cola CONSULCC. La información la guardaremos en WX-DATOS-TS. En ITEM le estamos indicando que recupere el registro grabado en la línea 1 (valor de la variable WX-NUM-ELEMENT). La variable que indiquemos en ITEM debe ser siempre un S9(4) COMP.
En esta caso estamos controlando el código de respuesta QIDERR, que significa que no ha encontrado la cola indicada, por lo que la variable WX-DATOS-TS vendrá vacía (pues hemos inicializado la variable antes de hacer el READQ).

2500-ENVIA-SALUDO.
Con la sentencia STRING concatenaremos el texto "HOLA ", WX-NOMBRE, y "! YO SOY EL CICS." dentro de la variable WX-SALUDO. Con DELIMITED BY SPACES eliminamos los espacios sobrantes en WX-NOMBRE.

Ahora con un nuevo SEND TEXT enviamos WX-SALUDO a la pantalla.

2600-BORRAR-COLA.
En este párrafo borramos la información guardada en la cola TS CONSULCC.


En el párrafo de final codificamos la sentencia CICS RETURN que finaliza la ejecución y devuelve el control al CICS.

Nota para usuarios de Hércules: para que CICS coja la última compilación de nuestro programa (si hemos compilado más de una vez) debemos "refrescarla" desde CEMT:
CEMT SET PROG(PGMCICS1) NEW

Como veis es un programa muy sencillo que graba un único registro en la cola TS, lo lee y lo borra, de tal modo que cada vez que ejecutemos la transacción estaremos leyendo siempre el primer elemento (el único que habrá).
Si no borrásemos la cola TS al final de la ejecución, en lugar de hacer un READQ por ITEM, lo haríamos de forma secuancial, es decir, sin indicar la opción ITEM. Así cada vez que ejecutásemos nuestra transacción leería el siguiente registro grabado.

Si lo hiciésemos por ITEM(1) el saludo siempre mostraría el primer nombre grabado en la cola TS, independientemente de lo que le pasásemos por pantalla.

Otra opción sería actualizar el registro 1 cada vez que escribiésemos en la cola TS. Para ello indicaríamos:

EXEC CICS WRITEQ TS
     QUEUE (NOMBRECOLA)
     FROM  (WX-DATOSTS)
     ITEM  (WX-NUM-ELEMENT)
     REWRITE
     RESP  (WRESP)
END-EXEC

Cualquier duda/consulta, dejad un comentario! : )