miércoles, 16 de mayo de 2012

Creación de un Subfile - Cobol

Anteriormente hemos creado las DDS tanto de las tablas que almacenarán los datos como de la pantalla que mostrará el subfichero.

Ahora nos adentraremos en la parte del programa Cobol que controlará dicho subfichero.

A grandes rasgos, el programa realizará dos pasos principales:

  1. Cargar el subfichero.
  2. Mostrar el subfichero y gestionar las teclas de función.

Para la carga del subfichero nos leeremos de principio a fin el fichero lógico FAGENDA1 para que salgan ordenados por nombre y apellidos. Por cada registro leído, escribiremos uno en el subfichero.

Una vez hayamos terminado la lectura del fichero de datos, el subfichero quedará cargado, por lo que lo único que tendremos que hacer es mostrar por pantalla dicho subfichero y gestionar las teclas que se pulsan.

Así que manos a la obra. El fuente quedaría de la siguiente forma (después del fuente comentamos los diferentes accesos):

0001.00        PROCESS APOST.                                                 
0002.00       *************************                                       
0003.00        IDENTIFICATION DIVISION.                                        
0004.00       *************************                                       
0005.00        PROGRAM-ID. AGENDA.                                            
0006.00        AUTHOR.   TODO-AS400.BLOGSPOT.COM.ES                                     
0007.00        SECURITY. FECHA DE CREACION     : MAYO/2012                    
0008.00                  ULTIMA MODIFICACION   : 00/00/0000                   
0009.00                                                                       
0010.00       *****************************************************************
0011.00       *|     D E S C R I P C I Ó N    D E L    P R O G R A M A        |
0012.00       *****************************************************************
0013.00       *|    SUBFICHERO DE CARGA TOTAL SIMPLE V 1.0                    |
0014.00       *|    @@@@@   TODO-AS400.BLOGSPOT.COM.ES @@@@@                  |
0015.00       *****************************************************************
0016.00                                                                        
0017.00       **********************                                          
0018.00        ENVIRONMENT DIVISION.                                          
0019.00       **********************                                           
0020.00           CONFIGURATION SECTION.                                      
0021.00           SOURCE-COMPUTER. AS-400.                                
0022.00           OBJECT-COMPUTER. AS-400.                                 
0023.00           SPECIAL-NAMES.   DECIMAL-POINT IS COMMA                 
0024.00                            LOCAL-DATA    IS LDA                   
0025.00                            REQUESTOR     IS CONSOLA.              
0026.00       *                                                            
0027.00        INPUT-OUTPUT SECTION.                                      
0028.00       *------------------------------------------------------------
0029.00           FILE-CONTROL.                                            
0030.00       *------------------------------------------------------------
0031.00            SELECT TAGENDA   ASSIGN        WORKSTATION-TAGENDA-SI  
0032.00                             ORGANIZATION  TRANSACTION             
0033.00                             ACCESS        DYNAMIC                 
0034.00                             CONTROL-AREA  AREA-TECLAS             
0035.00                             RELATIVE KEY  NRR                     
0036.00                             FILE STATUS   FS-FILE.                
0037.00                                                                   
0038.00            SELECT FAGENDA1  ASSIGN        DATABASE-FAGENDA1       
0039.00                             ORGANIZATION  INDEXED                 
0040.00                             ACCESS        DYNAMIC                 
0041.00                             RECORD KEY    EXTERNALLY-DESCRIBED-KEY
0042.00                             FILE STATUS   FS-FILE.
0043.00                                                    
0044.00       ***************                             
0045.00        DATA DIVISION.                             
0046.00       ***************                             
0047.00       *--------------------------------------------
0048.00        FILE SECTION.                              
0049.00       *--------------------------------------------
0050.00       *--------------------------------------------
0051.00        FD  TAGENDA.                                
0052.00        01  R-TAGENDA PIC X(1024).                 
0053.00       *--------------------------------------------
0054.00        FD  FAGENDA1.                              
0055.00        01  R-FAGENDA1.                            
0056.00            COPY DDS-ALL-FORMAT OF FAGENDA1.       
0057.00       *--------------------------------------------
0058.00        WORKING-STORAGE SECTION.                   
0059.00       *--------------------------------------------
0060.00       *--------------------------------------------
0061.00        01  VARIABLES-GENERALES.                   
0062.00            05  FS-FILE             PIC X(02).     
0063.00            05  NUERR               PIC 9(03).
0064.00            05  NRR                 PIC 9(04).
0065.00            05  W-CICLO             PIC 9(02).
0066.00                                             
0067.00       *---- SWITCHES ------------------------
0068.00        01  SW-FAGENDA1   PIC X.             
0069.00            88 FIN-FAGENDA1    VALUE 'S'.    
0070.00            88 NO-FIN-FAGENDA1 VALUE 'N'.    
0071.00                                             
0072.00       *######################################
0073.00       *-----------  REGISTROS DE PANTALLA Y L
0074.00       *######################################
0075.00        01  W-SFL01-O.                       
0076.00            COPY DDS-SFL01-O     OF  TAGENDA.
0077.00                                             
0078.00        01  AREA-TECLAS.                     
0079.00            05  FILLER PIC XX.               
0080.00                88  INTRO    VALUE '00'.     
0081.00                88  F03      VALUE '03'.     
0082.00                                             
0083.00        01  INDICADORES.                      
0084.00            05 TAB-IN OCCURS 99                  PIC  1 INDICATOR 1.   
0085.00               88 INDON                          VALUE B'1'.           
0086.00               88 INDOFF                         VALUE B'0'.           
0087.00                                                                        
0088.00       *################################################################
0089.00       *------------------ ACCESO A OTROS PROGRAMAS --------------------
0090.00       *################################################################
0091.00                                                                       
0092.00       *################################################################
0093.00       *------------------ TABLAS AUXILIARES ---------------------------
0094.00       *################################################################
0095.00                                                                       
0096.00       *================================================================
0097.00        LINKAGE SECTION.                                               
0098.00       *================================================================
0099.00                                                                        
0100.00       ***********************************************************     
0101.00        PROCEDURE DIVISION.                                            
0102.00       ***********************************************************     
0103.00                                                                        
0104.00       *****************************************************************
0105.00       *              E S T R U C T U R A    - A G E N D A -    
0106.00       **********************************************************
0107.00       *-----------------------                                 
0108.00        0000-ESTRUCTURA-AGENDA.                                 
0109.00       *-----------------------                                  
0110.00            PERFORM 1000-INICIO-AGENDA                          
0111.00            PERFORM 2000-PROCESO-AGENDA UNTIL W-CICLO = 99      
0112.00            PERFORM 3000-FIN-AGENDA.                            
0113.00                                                                 
0114.00       **********************************************************
0115.00       ********************* PROCESOS PRINCIPALES ***************
0116.00       **********************************************************
0117.00       *------------------                                      
0118.00        1000-INICIO-AGENDA.                                     
0119.00       *------------------                                      
0120.00            INITIALIZE VARIABLES-GENERALES                      
0121.00            MOVE          001     TO   NUERR                    
0122.00                                                                
0123.00            OPEN I-O    TAGENDA                                 
0124.00                 INPUT  FAGENDA1                                
0125.00                                                                
0126.00            MOVE 1 TO W-CICLO              
0127.00            .                              
0128.00                                           
0129.00       *-------------------                
0130.00        2000-PROCESO-AGENDA.               
0131.00       *-------------------                
0132.00            EVALUATE W-CICLO               
0133.00               WHEN 1                      
0134.00                  PERFORM 2000-CARGAR-SFL01
0135.00               WHEN 2                      
0136.00                  PERFORM 2000-MOSTRAR-SFL01
0137.00               WHEN OTHER                   
0138.00                  MOVE 99 TO W-CICLO       
0139.00            END-EVALUATE                   
0140.00            .                              
0141.00                                           
0142.00       *---------------                     
0143.00        3000-FIN-AGENDA.                   
0144.00       *---------------                    
0145.00            MOVE    002      TO   NUERR    
0146.00            CLOSE  TAGENDA FAGENDA1        
0147.00            GOBACK.                                                     
0148.00                                                                       
0149.00       *****************************************************************
0150.00       ********************* PROCESOS DE CICLO 1 ***********************
0151.00       *****************************************************************
0152.00       *------------------                                             
0153.00        2000-CARGAR-SFL01.                                              
0154.00       *------------------                                             
0155.00            MOVE ZEROES TO NRR                                         
0156.00            PERFORM 2000-LIMPIAR-CTL01                                 
0157.00            PERFORM 9000-LEERN-FAGENDA1                                
0158.00            PERFORM UNTIL FIN-FAGENDA1                                 
0159.00               ADD 1 TO NRR                                            
0160.00                                                                        
0161.00               INITIALIZE W-SFL01-O                                    
0162.00               MOVE NOMBRE    OF FAGENDA1 TO SFL01NOM OF W-SFL01-O     
0163.00               MOVE APELLIDOS OF FAGENDA1 TO SFL01APE OF W-SFL01-O     
0164.00               MOVE TELEFONO  OF FAGENDA1 TO SFL01TEL OF W-SFL01-O     
0165.00                                                                       
0166.00               PERFORM 9000-ESCRIBIR-SFL01                              
0167.00               PERFORM 9000-LEERN-FAGENDA1                             
0168.00            END-PERFORM                                                
0169.00                                                                        
0170.00            IF NRR > 0                                                 
0171.00               SET INDON(90) TO TRUE                                   
0172.00            ELSE                                                       
0173.00               SET INDOFF(90) TO TRUE                                  
0174.00            END-IF                                                     
0175.00                                                                       
0176.00            MOVE 2 TO W-CICLO                                          
0177.00            .                                                          
0178.00                                                                       
0179.00       *-------------------                                             
0180.00        2000-LIMPIAR-CTL01.                                            
0181.00       *-------------------                                            
0182.00            SET INDOFF(90) TO TRUE                                      
0183.00            PERFORM 9000-ESCRIBIR-CTL01                                
0184.00            SET INDON(90)  TO TRUE                                     
0185.00            .                                                           
0186.00                                                                       
0187.00       *****************************************************************
0188.00       ********************* PROCESOS DE CICLO 2 ***********************
0189.00       ***********************************************************
0190.00       *------------------                                       
0191.00        2000-MOSTRAR-SFL01.                                      
0192.00       *------------------                                        
0193.00            PERFORM 9000-ESCRIBIR-PIE01                          
0194.00            PERFORM 9000-ESCRIBIR-CTL01                          
0195.00            PERFORM 9000-LEER-CTL01                              
0196.00            PERFORM 2000-EVALUAR-TECLAS-CTL01                    
0197.00            .                                                    
0198.00                                                                 
0199.00       *--------------------------                               
0200.00        2000-EVALUAR-TECLAS-CTL01.                               
0201.00       *--------------------------                               
0202.00            IF F03                                                
0203.00               MOVE 99 TO W-CICLO                                
0204.00            END-IF                                               
0205.00            .                                                    
0206.00                                                                  
0207.00       ***********************************************************
0208.00       *  Rutinas 9000 de Acceso a Ficheros                      
0209.00       ***********************************************************
0210.00       *--------------------                            
0211.00        9000-ESCRIBIR-PIE01.                            
0212.00       *--------------------                            
0213.00            MOVE  901 TO NUERR                           
0214.00            WRITE R-TAGENDA                             
0215.00                           FORMAT     'PIE01'           
0216.00                           INDICATORS INDICADORES       
0217.00            END-WRITE                                    
0218.00            .                                           
0219.00                                                        
0220.00       *-------------------                             
0221.00        9000-LEERN-FAGENDA1.                             
0222.00       *-------------------                             
0223.00            MOVE 902 TO NUERR                           
0224.00            READ FAGENDA1  NEXT                         
0225.00                 AT END      SET FIN-FAGENDA1     TO TRUE
0226.00                 NOT AT END  SET NO-FIN-FAGENDA1  TO TRUE
0227.00            END-READ                                    
0228.00            .                                           
0229.00                                                         
0230.00       *--------------------                            
0231.00        9000-ESCRIBIR-SFL01.                             
0232.00       *--------------------                             
0233.00            MOVE  903 TO NUERR                           
0234.00            WRITE SUBFILE R-TAGENDA  FROM W-SFL01-O      
0235.00                                    FORMAT 'SFL01'       
0236.00                                    INDICATORS INDICADORES
0237.00            END-WRITE                                    
0238.00            .                                            
0239.00                                                         
0240.00       *--------------------                             
0241.00        9000-ESCRIBIR-CTL01.                             
0242.00       *--------------------                             
0243.00            MOVE  904 TO NUERR                           
0244.00            WRITE R-TAGENDA                              
0245.00                            FORMAT     'CTL01'           
0246.00                            INDICATORS INDICADORES       
0247.00            END-WRITE                                    
0248.00            .                                            
0249.00                                                         
0250.00       *----------------                                 
0251.00        9000-LEER-CTL01.                                 
0252.00       *----------------                            
0253.00            MOVE  905 TO NUERR                     
0254.00            READ  TAGENDA                          
0255.00                           FORMAT     'CTL01'      
0256.00                           INDICATORS INDICADORES  
0257.00            END-READ                               
0258.00            .                                      

De las líneas 27 a 56 declaramos los ficheros a usar. La pantalla TAGENDA y el fichero FAGENDA1, así como sus FD (File Description).

Dentro de la Working declaramos las variables y switches que vamos a utilizar. Dentro de la definición de los campos de pantalla, declaramos los campos que tendrá el subfichero (realizamos un COPY DDS para no tener que meter los campos a mano). A su vez declaramos las teclas de función que se utilizarán y la tabla con los indicadores de pantalla.

En la línea 108 iniciamos el programa en sí. Declaramos la estructura del programa, que será un inicio, un cuerpo y un fin.
En el inicio abriremos los ficheros. El cuerpo estará embuclado hasta que la variable W-CICLO valga 99. Luego estará el fin, que será donde cerremos ficheros y finalicemos el programa.

Dentro de 2000-PROCESO-AGENDA lo que haremos sera evaluar el valor de la variable W-CICLO. Como podéis ver, aquí definimos los dos procesos de los que hablamos anteriormente. Por un lado la carga del subfichero y por otro mostrar dicho subfichero. Cada parte será un ciclo de ejecución.
En la carga del subfichero (párrafo 2000-CARGAR-SFL01) inicialmente borraremos el subfichero. Para ello desactivaremos el indicador 90, que es el que controla el SLFCLR. Una vez limpiado, nos recorremos el fichero FAGENDA1 de principio a fin, y por cada registro escribimos uno en el subfichero.

Tras finalizar la lectura, verificaremos el valor de NRR. Si vale 0 (no hay registros en el subfichero), desactivaremos el indicador 90 para que no se muestre el subfichero (es el indicador que controla el DSPSFL). En cambio, si NRR > 0, activaremos el indicador 90 para que posteriormente se muestre el subfichero.

Una vez realizado este primer ciclo, nos vamos al siguiente ciclo, que será el que muestre el subfichero. Escribiremos el formato del pie, el formato de control y leeremos el control para ver los datos. Tras leer la pantalla, controlaremos qué teclas se han pulsado (si se pulsa F3 finalizará el programa moviendo el valor 99 a W-CICLO).

Como podéis ver, un subfichero que sólo muestra información es algo muy simple. Teniendo clara la filosofía de su programación (carga del subfile y mostrado del mismo) la programación se hace tremendamente simple.

Para ver cómo funciona el subfichero, cargaremos con datos el fichero:

INSERT INTO FAGENDAP (NOMBRE, APELLIDOS, DIRECCION,      
TELEFONO, FILLER) VALUES                                        
('PEPITO', 'GOMEZ LOPEZ', 'CALLE SU CASITA 3', '666888777', ' '),
('DIEGO', 'SERRANO JAEN', 'AVENIDA GRANDE  8', '111222333', ' '),
('JUAN', 'PEREZ JIMENEZ', 'CALLE LORCA S/N', '236854795', ' ')  

Y ejecutaremos el programa: 

CALL AGENDA

La ejecución del mismo:




En post posteriores iremos complicando aún más este ejemplo, añadiendo una ventana para dar de alta registros, añadiendo más columnas, opción de búsqueda dentro del subfichero, etc…

Y recordad, no olvidéis visitar nuestra web cobol-400.com.

Un saludo.

2 comentarios:

  1. Muy buenas, he copiado tu ejemplo, paso a paso, para probarlo, ya que estoy aprendiendo a utilizar AS400 y sus distintas herramientas.

    Después de terminar todo y ejecutar el programa(tal cual), aparece una pantalla que deduzco que es de error, la cual me da la opción de ingresar 4 letras (C D F G). El caso es que si en el correspondiente ASSIGN, en vez de poner WORKSTATION-TAGENDA-SI, pongo WORKSTATION-TAGENDA, al ejecutar el programa me aparece la pantalla con la cabecera de control pero sin los datos de los registros del subfichero.

    ¿Podrías indicarme que puede estar mal en el programa? Se lo agradecería.

    Un saludo, muchas gracias

    ResponderEliminar
  2. Hola, buenas, si le pongo el SI, me da error de parametros Mch...Pointer not set for location referenced., si se lo quito, me presenta la pantalla sin datos de subfile, favor ayudar.

    ResponderEliminar