Programa COBOL CICS para Consulta de Productos con DB2: Ejemplo Práctico
Inglés9,69 KB
Programa COBOL CICS de consulta de productos
A continuación se presenta el código fuente del programa GPCAP764, un programa de consulta de productos desarrollado en COBOL para entornos CICS con acceso a DB2 mediante SQL embebido.
Identificación y entorno
*==============================================================*
IDENTIFICATION DIVISION.
*==============================================================*
PROGRAM-ID. GPCAP764.
AUTHOR. FELIPE RICARDO NOGUEIRA.
SECURITY. PROGRAMA DE CONSULTA DE PRODUTOS.
DATE-WRITTEN. 28/11/2009.
*==============================================================*
ENVIRONMENT DIVISION.
*==============================================================*
CONFIGURATION SECTION.
SPECIAL-NAMES. DECIMAL-POINT IS COMMA.
*==============================================================*
DATA DIVISION.
*==============================================================*
WORKING-STORAGE SECTION.
*--------------------------------*
01 AREA-DE-TRABALHO.
03 WK-MENSAGEM PIC X(80) VALUE SPACES.
03 WK-PROGRAMA PIC X(08) VALUE SPACES.
03 WK-CODPROD PIC X(06) VALUE SPACES.
01 AREA-DE-DESCOMPACTACAO.
03 WS-QTDEST PIC 9(04) VALUE ZEROS.
03 WS-QTDMIN PIC 9(04) VALUE ZEROS.
03 WS-QTDMAX PIC 9(04) VALUE ZEROS.
03 WS-PRECO PIC 9(04)V99 VALUE ZEROS.
03 WS-PRECO-MASC PIC $Z.ZZ9,99.
03 WS-SQLCODE PIC ++++9.
01 WK-DATA.
03 WK-DIA-DATA PIC 9(02) VALUE ZEROS.
03 FILLER PIC X(01) VALUE '/'.
03 WK-MES-DATA PIC 9(02) VALUE ZEROS.
03 FILLER PIC X(01) VALUE '/'.
03 WK-ANO-DATA PIC 9(04) VALUE ZEROS.
01 WK-HORA PIC X(05) VALUE SPACES.
01 WK-TEMPO PIC S9(15) COMP-3 VALUE ZEROS.
01 WK-ABEND PIC X(04) VALUE SPACES.
01 WK-CURSOR PIC S9(04) VALUE -1.
*----------------------------------------------------------------*
EXEC SQL
INCLUDE SQLCA
END-EXEC.
EXEC SQL
INCLUDE TB76PROD
END-EXEC.
*----------------------------------------------------------------*
COPY DFHAID.
*********************************
COPY DFHBMSCA.
********************************************************
COPY GPM7654.
********************************************************
01 CA-COMMAREA.
03 CA-FASE PIC X(01) VALUE SPACES.
03 CA-TRANS-CHAMADOR PIC X(04) VALUE SPACES.
*==============================================================*
LINKAGE SECTION.
*==============================================================*
01 DFHCOMMAREA.
03 FILLER PIC X(01) OCCURS 4096
DEPENDING ON EIBCALEN.Lógica principal
*==============================================================*
PROCEDURE DIVISION.
*==============================================================*
P000-PRINCIPAL.
*-------------------*
PERFORM P100-INICIAR.
EVALUATE CA-FASE
WHEN '1'
PERFORM P200-FASE-UM
WHEN '2'
PERFORM P220-FASE-DOIS
WHEN '3'
PERFORM P240-FASE-TRES
END-EVALUATE.
*-------------------*
P100-INICIAR.
*-------------------*
EXEC CICS
HANDLE ABEND LABEL (P999-97-TRATA-ABEND)
END-EXEC.
*****************************************************************
IF EIBCALEN EQUAL ZEROS
INITIALIZE CA-COMMAREA
MOVE '1' TO CA-FASE
ELSE
MOVE DFHCOMMAREA TO CA-COMMAREA
IF EIBTRNID NOT EQUAL 'P764'
MOVE '1' TO CA-FASE
END-IF
END-IF.
*-------------------*
P200-FASE-UM.
*-------------------*
MOVE LOW-VALUES TO GPM7654I.
MOVE '<<<< INFORME O CODIGO DO PRODUTO>>>>' TO MENSO.
MOVE WK-CURSOR TO CODPRODL.
MOVE 'J' TO CODPRODA.
MOVE '2' TO CA-FASE.
PERFORM P720-00-EXIBE-TELA-COM-ALARME.
PERFORM P999-98-SAIDA-COM-TRANSID.
*-------------------*
P210-PROTEGE-CAMPOS.
*-------------------*
MOVE '/' TO DESCRIA
LOCALA
QTDESTA
QTDMINA
QTDMAXA
PRECOA
DTATUA
USUARIOA.
*-------------------*
P220-FASE-DOIS.
*-------------------*
PERFORM P700-00-RECEBE-TELA.
EVALUATE EIBAID
WHEN DFHENTER
PERFORM P310-CONSISTE-CODPROD
WHEN DFHPF3
PERFORM P400-FIM-PROGRAMA
WHEN DFHPF4
PERFORM P410-VOLTA-MENU
WHEN DFHCLEAR
PERFORM P400-FIM-PROGRAMA
WHEN OTHER
MOVE 'J' TO CODPRODA
PERFORM P312-TECLA-INVALIDA
END-EVALUATE.
*-------------------*
P240-FASE-TRES.
*-------------------*
PERFORM P700-00-RECEBE-TELA.
EVALUATE EIBAID
WHEN DFHPF3
PERFORM P400-FIM-PROGRAMA
WHEN DFHPF4
PERFORM P999-99-TRANSFERE-CONTROLE
WHEN DFHPF5
PERFORM P200-FASE-UM
WHEN DFHCLEAR
PERFORM P400-FIM-PROGRAMA
WHEN OTHER
MOVE '/' TO CODPRODA
PERFORM P312-TECLA-INVALIDA
END-EVALUATE.Consulta del producto en DB2
*------------------------*
P310-CONSISTE-CODPROD.
*------------------------*
EXEC CICS
BIF DEEDIT FIELD(CODPRODI)
END-EXEC.
MOVE CODPRODI TO CODPROD OF DCLTB76PROD.
EXEC SQL
SELECT *
INTO :DCLTB76PROD
FROM TB76PROD
WHERE CODPROD = :DCLTB76PROD.CODPROD
END-EXEC.
EVALUATE SQLCODE
WHEN ZEROS
MOVE DECRI OF DCLTB76PROD TO DESCRIO
MOVE LOCAL OF DCLTB76PROD TO LOCALO
MOVE QTDEST OF DCLTB76PROD TO WS-QTDEST
MOVE WS-QTDEST TO QTDESTO
MOVE QTDMIN OF DCLTB76PROD TO WS-QTDMIN
MOVE WS-QTDMIN TO QTDMINO
MOVE QTDMAX OF DCLTB76PROD TO WS-QTDMAX
MOVE WS-QTDMAX TO QTDMAXO
MOVE PRECO OF DCLTB76PROD TO WS-PRECO
MOVE WS-PRECO TO WS-PRECO-MASC
MOVE WS-PRECO-MASC TO PRECOO
INSPECT DTATU OF DCLTB76PROD REPLACING ALL '.' BY '/'
MOVE DTATU OF DCLTB76PROD TO DTATUO
MOVE USUARIO OF DCLTB76PROD TO USUARIOO
MOVE '/' TO CODPRODA
MOVE '< TECLE F5 PARA NOVA CONSULTA > ' TO MENSO
MOVE WK-CURSOR TO CODPRODL
MOVE '3' TO CA-FASE
PERFORM P720-00-EXIBE-TELA-COM-ALARME
PERFORM P999-98-SAIDA-COM-TRANSID
WHEN +100
MOVE CODPRODI TO WK-CODPROD
MOVE LOW-VALUES TO GPM7654I
STRING '<<<< DIGITE NOVAMENTE, PRODUTO NAO ENCONTRADO - '
WK-CODPROD
' >>>>'
DELIMITED BY SIZE INTO MENSO
MOVE WK-CURSOR TO CODPRODL
MOVE 'J' TO CODPRODA
PERFORM P720-00-EXIBE-TELA-COM-ALARME
PERFORM P999-98-SAIDA-COM-TRANSID
WHEN OTHER
PERFORM P999-DB-TRATAR-ABEND-DB2
END-EVALUATE.Tratamiento de teclas y finalización
*-------------------*
P312-TECLA-INVALIDA.
*-------------------*
MOVE '<<<< TECLA INVALIDA >>>>' TO MENSO.
MOVE WK-CURSOR TO CODPRODL.
PERFORM P720-00-EXIBE-TELA-COM-ALARME.
PERFORM P999-98-SAIDA-COM-TRANSID.
*-------------------*
P400-FIM-PROGRAMA.
*-------------------*
MOVE '*** FIM DA TRANSACAO DE CONSULTA ***' TO WK-MENSAGEM.
PERFORM P730-00-EXIBE-TEXTO.
PERFORM P999-00-SAIDA-SEM-TRANSID.
*-------------------*
P410-VOLTA-MENU.
*-------------------*
MOVE '*** RETORNANDO AO MENU ***' TO WK-MENSAGEM.
PERFORM P730-00-EXIBE-TEXTO.
PERFORM P999-99-TRANSFERE-CONTROLE.Operaciones de pantalla y utilidades
*-------------------*
P700-00-RECEBE-TELA.
*-------------------*
EXEC CICS
RECEIVE MAP ('GPM7654')
MAPSET ('GPM7654')
INTO (GPM7654I)
END-EXEC.
*-------------------*
P720-00-EXIBE-TELA-COM-ALARME.
*-------------------*
PERFORM P740-00-PESQUISA-DATA-HORA.
EXEC CICS
SEND MAP ('GPM7654')
MAPSET ('GPM7654')
FROM (GPM7654I)
FREEKB
FRSET
ERASE
ALARM
CURSOR
NOHANDLE
END-EXEC.
*-------------------*
P730-00-EXIBE-TEXTO.
*-------------------*
EXEC CICS
SEND TEXT FROM (WK-MENSAGEM)
FREEKB
ERASE
ALARM
NOHANDLE
END-EXEC.
*-------------------*
P740-00-PESQUISA-DATA-HORA.
*-------------------*
EXEC CICS
ASKTIME ABSTIME (WK-TEMPO)
END-EXEC.
EXEC CICS
FORMATTIME ABSTIME (WK-TEMPO)
DDMMYYYY (WK-DATA)
DATESEP ('/')
TIME (WK-HORA)
TIMESEP (':')
END-EXEC.
MOVE WK-DATA TO DATASISO.
MOVE WK-HORA TO HORASISO.Tratamiento de errores (ABEND)
*-------------------*
P999-97-TRATA-ABEND.
*-------------------*
EXEC CICS
HANDLE ABEND CANCEL
END-EXEC.
EXEC CICS
ASSIGN ABCODE (WK-ABEND)
END-EXEC.
MOVE 'OCORREU UM ERRO NO APLICATIVO = CODIGO => '
TO WK-MENSAGEM.
MOVE WK-ABEND TO WK-MENSAGEM(42:4).
PERFORM P730-00-EXIBE-TEXTO.
PERFORM P999-98-SAIDA-COM-TRANSID.
*-------------------*
P999-DB-TRATAR-ABEND-DB2.
*-------------------*
EXEC CICS
HANDLE ABEND CANCEL
END-EXEC.
MOVE 'OCORREU UM ERRO NO SELECT DO DB2 => '
TO WK-MENSAGEM.
MOVE SQLCODE TO WS-SQLCODE.
MOVE WS-SQLCODE TO WK-MENSAGEM(34:5).
PERFORM P730-00-EXIBE-TEXTO.
PERFORM P999-00-SAIDA-SEM-TRANSID.Salidas y transferencia de control
*-------------------*
P999-98-SAIDA-COM-TRANSID.
*-------------------*
EXEC CICS
RETURN TRANSID ('P764')
COMMAREA (CA-COMMAREA)
END-EXEC.
*-------------------*
P999-00-SAIDA-SEM-TRANSID.
*-------------------*
EXEC CICS
RETURN
END-EXEC.
*-------------------*
P999-99-TRANSFERE-CONTROLE.
*-------------------*
MOVE '1' TO CA-FASE.
MOVE 'P768' TO CA-TRANS-CHAMADOR.
MOVE 'GPCAP768' TO WK-PROGRAMA.
EXEC CICS
XCTL PROGRAM (WK-PROGRAMA)
COMMAREA (CA-COMMAREA)
NOHANDLE
END-EXEC.