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:
- Cargar el subfichero.
- 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.
Muy buenas, he copiado tu ejemplo, paso a paso, para probarlo, ya que estoy aprendiendo a utilizar AS400 y sus distintas herramientas.
ResponderEliminarDespué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
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