lunes, 7 de marzo de 2011

Pantallas en Cobol AS400 - DSPF WINDOW SUBFILE (Parte II)

En mi corto paso por este tipo de desarrollo, he podido conocer 2 maneras de trabajar las pantallas en Cobol AS400:

La primera, usando la declaración externa de los registros del archivo de pantalla. Para esto declaramos en la DATA DIVISION su estructura externa. En la DSPF usamos la palabra clave INDARA para indicadores, etc. Particularmente no utilizo esta modalidad.

En el siguiente link puedes tener un ejemplo completo:
       FILE-CONTROL.
           SELECT   PANTALLA  ASSIGN  WORKSTATION-PANTALLA-SI
                              ORGANIZATION IS TRANSACTION
                              ACCESS       IS DYNAMIC
                              RELATIVE KEY IS SFL-KEY
                              CONTROL-AREA IS WS-TECLA.

       FILE SECTION.
       FD  PANTALLA            
              LABEL RECORD STANDARD.
       01  REG-PANTALLA.
           COPY DDS-ALL-FORMATS OF PANTALLA.

La segunda, usando una declaración interna de los registros del archivo de pantalla. Para esto declaramos estructuras internas y con la directiva COPY recuperamos la estructura de los registros de la pantalla. Esta es la manera con la que más he elaborado pantallas en Cobol y es la que a continuación mostraré como ejemplo.

Fuente de archivo:

A                                      UNIQUE       
A          R REGAULAS                               
A            CODAULA        5                       
A            CURSO         25                       
A            NUMALUMNOS     3  0                    
A            TURNOAULA      1                       
A          K CODAULA                                

Fuente de Archivo de pantalla:


A                                      DSPSIZ(24 80 *DS3           
A                                             27 132 *DS4)         
A          R REGDATA                   SFL                         
A  78                                  SFLNXTCHG                   
A            DCODAU         5A  O  5  2                            
A            DNOMCU        25   O  5 10                            
A          R REGCTL                    SFLCTL(REGDATA)             
A  *DS3                                SFLSIZ(0009)                
A  *DS4                                SFLSIZ(0009)                
A  *DS3                                SFLPAG(0009)                
A  *DS4                                SFLPAG(0009)                
A  *DS3                                WINDOW(4 20 17 45)           
A  *DS4                                WINDOW(4 20 17 45)          
A                                      CA03(03 'SALIR')            
A                                      PAGEDOWN(88 'PAGINA ARRIBA')
A                                      PAGEUP(66 'PAGINA ABAJO')   
A                                      VLDCMDKEY(99 'ENTER')       
A                                      OVERLAY                     
A                                      SFLCSRRRN(&RELNBR)          
A  74                                  SFLDSP                      
A  75                                  SFLDSPCTL                   
A  76                                  SFLCLR                      
A  77                                  SFLEND(*MORE)               
A                                      WDWTITLE((*TEXT ' TABLA AULA ')    -
A                                      *CENTER)                            
A                                  2  1'UBIQUE CURSOR LUEGO PULSE ENTER.'  
A                                      COLOR(BLU)                          
A            RELNBR         5S 0H                                          
A            NROREG         4S 0H      SFLRCDNBR                           
A            XCODAU         5A  I  4  2COLOR(YLW)                          
A                                  3  2'COD AULA'                          
A                                      DSPATR(HI)                          
A                                  3 13'DESCRIPCION CURSO'                 
A                                      DSPATR(HI)                          
A          R REGMSG                                                        
A  *DS3                                WINDOW(REGCTL)                       
A  *DS4                                WINDOW(REGCTL)                      
A                                      OVERLAY                             
A  79        MSGKEY1       10A  O 16  1COLOR(BLU)                          
A                                 15  1'__________________________________-
A                                      ___________'                        
A                                      COLOR(BLU)                          
A                                 16 17'WWW.ISERIES-PERU.BLOGSPOT.COM'     
A                                      COLOR(YLW)                          
A          R DUMMY                                                         
A                                      ASSUME                              
A                                      OVERLAY                             
A                                  1  3' '   

Fuentes del programa Cobol:

IDENTIFICATION DIVISION.
*************************
 AUTHOR.      ISERIES-PERU.
 PROGRAM-ID.  PROGRAMA.

*****************************
*  CONSULTA WINDOW SUBFILE  *
*****************************

 ENVIRONMENT DIVISION.
**********************
 CONFIGURATION SECTION.
*---------------------*
 INPUT-OUTPUT SECTION.
*--------------------*
 FILE-CONTROL.

     SELECT   PANTALLA
              ASSIGN       TO WORKSTATION-PANTALLA
              ORGANIZATION IS TRANSACTION
              ACCESS       IS DYNAMIC
              RELATIVE KEY IS RECNO
              FILE STATUS  IS FS-PANTA.
*
     SELECT   AULA
              ASSIGN TO    DATABASE-AULA
              ORGANIZATION IS INDEXED
              ACCESS       IS DYNAMIC
              RECORD KEY   IS EXTERNALLY-DESCRIBED-KEY
              FILE STATUS  IS FS-AULA.
*
 DATA DIVISION.
***************
 FILE SECTION.
*------------*
 FD  PANTALLA.
 01  PANTREG      PIC X(1000).
*
 FD  AULA
     LABEL RECORD STANDARD.
 01  REG-AULA.
     COPY DDS-ALL-FORMATS OF AULA.
*
 WORKING-STORAGE SECTION.
*-----------------------*
 01  WS-FILE-STATUS.
     02  FS-AULA               PIC XX.
     02  FS-PANTA              PIC XX.
 01  RECNO                     PIC 9(6) VALUE 0.
 01  WS-LAST-RECNO             PIC 9(6) VALUE 0.
 01  WS-LAST-CODAU             PIC X(5) VALUE SPACES.
 01  TOT-REG                   PIC 9(6) VALUE 0.
*
 01  SW-FIN-PROGRAMA           PIC 9(01) VALUE 0.
     88 FIN-PROGRAMA                     VALUE 1.
 01  SW-EOF-FILE               PIC 1.
     88 EOF-FILE                         VALUE B"1".
     88 NO-EOF-FILE                      VALUE B"0".
 01  SW-BOF-FILE               PIC 1.
     88 BOF-FILE                         VALUE B"1".
     88 NO-BOF-FILE                      VALUE B"0".
*
 01  WS-INDICATORS-SFL.
     05 IN74                   PIC 1.
        88 WRITE-SFL                     VALUE B"1".
        88 NO-WRITE-SFL                  VALUE B"0".
     05 IN75                   PIC 1.
        88 WRITE-CTL                     VALUE B"1".
        88 NO-WRITE-CTL                  VALUE B"0".
     05 IN76                   PIC 1.
        88 CLEAR-SFL                     VALUE B"1".
        88 NO-CLEAR-SFL                  VALUE B"0".
     05 IN77                   PIC 1.
        88 END-SFL                       VALUE B"1".
        88 NO-END-SFL                    VALUE B"0".
*
 01  WS-INDICATORS-MSG.
     05 IN79                   PIC 1.
        88 DSP-MSGKEY                    VALUE B"1".

*
 01  WS-INDICATORS-CTL.
     05 IN03                   PIC 1.
        88 KEY-F3                        VALUE B"1".
     05 IN66                   PIC 1.
        88 PAGE-UP                       VALUE B"1".
     05 IN88                   PIC 1.
        88 PAGE-DOWN                     VALUE B"1".
     05 IN99                   PIC 1.
        88 KEY-ENTER                     VALUE B"0".

* Pantalla Subfile Data
 01  REG-OUTPUT-SUBFILE-DATA.
     COPY DDS-REGDATA-O OF PANTALLA.
 01  REG-INPUT-SUBFILE-DATA.
     COPY DDS-REGDATA-I OF PANTALLA.
* Pantalla Subfile Control
 01  REG-OUTPUT-SUBFILE-CTRL.
     COPY DDS-REGCTL-O OF PANTALLA.
 01  REG-INPUT-SUBFILE-CTRL.
     COPY DDS-REGCTL-I OF PANTALLA.
* Pantalla Subfile Mensajes
 01  REG-OUTPUT-SUBFILE-MSG.
     COPY DDS-REGMSG-O OF PANTALLA.

 LINKAGE SECTION.
*---------------*
 01 PARM-CODAULA   PIC X(5).
*
 PROCEDURE DIVISION USING PARM-CODAULA.
********************
 PRINCIPAL.
*----------
     PERFORM INICIO.
     PERFORM PANTALLA-SFL UNTIL FIN-PROGRAMA.
     PERFORM FIN.

 INICIO.
*-------
     OPEN I-O      PANTALLA
          INPUT    AULA.

     PERFORM LLENA-SUBFILE.
*
 FIN.
*----
     CLOSE  AULA
            PANTALLA.
     STOP RUN.
*
 PANTALLA-SFL.
*------------
     PERFORM MUESTRA-SFL.
     MOVE CORR REGCTL-I-INDIC TO WS-INDICATORS-CTL.
*
     EVALUATE TRUE
     WHEN  KEY-F3
           MOVE 1 TO SW-FIN-PROGRAMA

     WHEN  PAGE-UP
           PERFORM RUTINA-PAGE-UP

     WHEN  PAGE-DOWN
           PERFORM RUTINA-PAGE-DOWN

     WHEN  KEY-ENTER
           PERFORM VALIDATE-ENTRY

     END-EVALUATE.
*
 INICIALIZA-PANTALLAS.
*---------------------
     INITIALIZE  REGCTL-I
                 REGCTL-O
     INITIALIZE  REGDATA-I
                 REGDATA-O
     INITIALIZE  REGMSG-O

     MOVE SPACES TO REG-OUTPUT-SUBFILE-CTRL
                    REG-OUTPUT-SUBFILE-DATA
                    REG-OUTPUT-SUBFILE-MSG

     MOVE ZEROES TO RECNO

     SET  NO-WRITE-SFL
          NO-END-SFL
          WRITE-CTL
          CLEAR-SFL    TO TRUE

     PERFORM GRABA-SUBFILE

     SET NO-CLEAR-SFL
         NO-BOF-FILE
         NO-EOF-FILE TO TRUE.

*
 MUESTRA-SFL.
*--------------
     PERFORM MUESTRA-TECLAS
     PERFORM GRABA-SUBFILE
     PERFORM LEE-CONTROL.
*
 GRABA-SUBFILE.
*-------------
     MOVE CORR WS-INDICATORS-SFL TO REGCTL-O-INDIC.
     WRITE  PANTREG FROM REG-OUTPUT-SUBFILE-CTRL
            FORMAT IS "REGCTL"
     END-WRITE.
*
 LEE-CONTROL.
*-------------
     READ   PANTALLA INTO  REG-INPUT-SUBFILE-CTRL
            FORMAT IS "REGCTL"
     END-READ.
     MOVE CORR REGCTL-I-INDIC TO WS-INDICATORS-SFL.
*
 MUESTRA-TECLAS.
*-------------
     MOVE "F3=Salir"     TO MSGKEY1 OF REGMSG-O
     SET  DSP-MSGKEY     TO TRUE
     MOVE CORR WS-INDICATORS-MSG TO REGMSG-O-INDIC
     WRITE  PANTREG FROM REG-OUTPUT-SUBFILE-MSG
            FORMAT IS "REGMSG"
     END-WRITE.
*
 LLENA-SUBFILE.
*------------
     PERFORM INICIALIZA-PANTALLAS.
     PERFORM LLENA-SUBFILE-LOOP UNTIL EOF-FILE OR
                                     RECNO EQUAL TO 09
     IF RECNO GREATER THAN ZEROES
        MOVE RECNO TO WS-LAST-RECNO
        MOVE 1     TO NROREG OF REGCTL-O
        SET  WRITE-SFL TO TRUE
     END-IF.

*
 LLENA-SUBFILE-LOOP.
*-----------------
     READ AULA NEXT RECORD
          AT END SET EOF-FILE END-SFL TO TRUE
     END-READ.
     IF NO-EOF-FILE
           MOVE CODAULA OF REG-AULA TO DCODAU  OF REGDATA-O
           MOVE CURSO   OF REG-AULA TO DNOMCU  OF REGDATA-O
           ADD  1 TO RECNO
           WRITE SUBFILE PANTREG
                 FROM REG-OUTPUT-SUBFILE-DATA
                 FORMAT IS "REGDATA"
           END-WRITE
     ELSE
        READ AULA LAST RECORD
             AT END   SET EOF-FILE TO TRUE
        END-READ
     END-IF.
*
 RUTINA-PAGE-DOWN.
*----------------
     IF NO-EOF-FILE
        PERFORM LLENA-SUBFILE
     END-IF.
*
 RUTINA-PAGE-UP.
*----------------
     IF WS-LAST-RECNO IS GREATER THAN ZERO
        COMPUTE TOT-REG = 9 + WS-LAST-RECNO
        MOVE    ZEROES TO RECNO
        PERFORM LEE-ANTERIOR UNTIL BOF-FILE OR
                                   RECNO EQUAL TO TOT-REG
        PERFORM LLENA-SUBFILE
     END-IF.
*
 LEE-ANTERIOR.
*-------------
     READ AULA PRIOR RECORD
          AT END
             SET BOF-FILE TO TRUE
             START AULA KEY GREATER OR EQUAL TO
                            EXTERNALLY-DESCRIBED-KEY
             END-START
          NOT END
             ADD 1 TO RECNO
     END-READ.
*
 VALIDATE-ENTRY.
*---------------
     IF XCODAU OF REGCTL-I NOT EQUAL TO SPACES
        MOVE  CODAULA OF REG-AULA   TO WS-LAST-CODAU
        MOVE  XCODAU  OF REGCTL-I   TO CODAULA OF REG-AULA
        START AULA KEY GREATER OR EQUAL TO
                       EXTERNALLY-DESCRIBED-KEY
              INVALID KEY
                 MOVE WS-LAST-CODAU TO CODAULA OF REG-AULA
                 START AULA KEY GREATER OR EQUAL TO
                       EXTERNALLY-DESCRIBED-KEY
                 END-START
              NOT INVALID KEY
                 PERFORM LLENA-SUBFILE
        END-START
     END-IF.
     PERFORM LEE-REGISTRO-SFL.
*
 LEE-REGISTRO-SFL.
*-------------------
     IF  RELNBR OF REGCTL-I IS GREATER THAN ZERO
         MOVE RELNBR OF REGCTL-I  TO RECNO
         READ SUBFILE PANTALLA RECORD
                      INTO REG-INPUT-SUBFILE-DATA
                      FORMAT IS "REGDATA"
              NOT INVALID KEY
                  MOVE DCODAU OF REGDATA-O TO PARM-CODAULA
                  PERFORM FIN
         END-READ
     END-IF.



Publicado por Iseries Peru a las 19:39

3 comentarios:

  1. Greglim21 de octubre de 2014, 10:00

    Buen blog . Sigue adelante

    ResponderEliminar
  2. Unknown7 de agosto de 2015, 11:54

    Estoy trabajando en COBOL en un iServer. Pido ciertos parámetros por pantalla y luego ejecuto un proceso bastante largo. Quisiera ir desplegando en pantalla mensajes con los avances del programa. Sin embargo, no lo puedo hacer. Como que no puedo hacer dos WRITE seguidos de una pantalla. Solo funciona si entre dos los WRITE pongo un READ de la pantalla, pero eso no me sirve. Tenés alguna solución. Desde ya muchas gracias.

    ResponderEliminar
  3. Raul-Angel García10 de diciembre de 2022, 4:12

    Muchíiiiiiiisimas gracias, Iseries Peru, por éstos códigos fuente, que tantíiiiiiisimo me simplifican los trabajos a la hora de programar en Cobol. Sobre todo, el último archivo fuente (el de Cobol precisamente....) que tanto me simplifica la vida a la hora de desarrollar mis Apps particulares con registros y pantallas en AS/400, al yo poder utilizar su archivo a modo de "plantilla de Cobol" para manejar dichos registros y dichas pantallas de mis propias Aplicaciones.......
    ....Debo de seguir aprendiendo Cobol para YO SABER hacer DE VERDAD, programas codificador TOTALMENTE POR MI, si!!, :|, sabiendo y teniendo bien claros los conceptos y naturalezas de todas las partes (y todas las "divisiones" y "secciones"...) de tan potente y basto lenguaje, pero para yo poder aprender, se agradece enooooormemente que, de vez en cuando, a uno le den "empujes" en forma de concreciones aplicables, para aprender a USAR las herramientas informáticas (en el caso que me ocupa, las herramientas de COBOL...) a través de ememplos prácticos.....
    Zénquiu veri mach!!, ;)

    ResponderEliminar

Suscribirse a: Enviar comentarios (Atom)