COBOL-CICS-Programm GPCAP764: Beratung Produktabfrage mit DB2

COBOL-CICS-Programm GPCAP764: Produktberatung mit DB2

*=============================================================*
IDENTIFICATION DIVISION.
*=============================================================*
PROGRAM-ID. GPCAP764.
AUTOR. FELIPE RICARDO NOGUEIRA.
SICHERHEIT. BERATUNG PROGRAM PRODUCTS.
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 $ZZ.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) COMP.
*-----------------------------------------------------------*
EXEC SQL
INCLUDE SQLCA
END-EXEC.
EXEC SQL
INCLUDE TB76PROD
END-EXEC.
*-----------------------------------------------------------*
DFHAID COPY.
*************************************************************
DFHBMSCA COPY.
*************************************************************
GPM7654 COPY.
*************************************************************
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.
*=============================================================*
PROCEDURE DIVISION.
*=============================================================*
P000-MAIN.
*-------------------*
PERFORM P100-START.
EVALUATE CA-FASE
WHEN '1 '
PERFORM P200-FASE-UM
WHEN '2 '
PERFORM P220-FASE-DOIS
WHEN '3 '
PERFORM P240-FASE-TRES
END-EVALUATE.
*-------------------*
P100-START.
*-------------------*
EXEC CICS
HANDLE ABEND LABEL(P999-97-IS-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 '<<<< Código do Produto Necessário >>>>' TO MENS.
MOVE CURSOR TO WK-CODPRODL.
MOVE 'J' TO CODPRODA.
MOVE '2 ' TO CA-FASE.
PERFORM P720-00-ENVIA-WEB-COM-ALARME.
PERFORM P999-98-SAIDA-COM-TRANS.
*-------------------*
P210-PROTEGE-CAMPOS.
*-------------------*
MOVE '/' TO DATAATUA
LOCAL
QTDESTA
QTDMINA
QTDMAXA
PRECOA
DTATUA
USUARIOA.
*-------------------*
P220-FASE-DOIS.
*-------------------*
PERFORM P700-00-RECEBE-WEB.
EVALUATE EIBAID
WHEN DFHENTER
PERFORM P310-VERIFICA-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-WEB.
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.
*------------------------*
P310-VERIFICA-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 DESCRI OF DCLTB76PROD TO DESCRIO
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 USUARIOA
MOVE '/' TO CODPRODA
MOVE '<F5 Chave para NOVA CONSULTA>' TO MENS
MOVE CURSOR TO WK-CODPRODL
MOVE '3' TO CA-FASE
PERFORM P720-00-ENVIA-WEB-COM-ALARME
PERFORM P999-98-SAIDA-COM-TRANS
WHEN 100
MOVE CODPRODI TO WK-CODPROD
MOVE LOW-VALUES TO GPM7654I
STRING 'Digite novamente, PRODUTO não encontrado '
'=> '
WK-CODPROD
' <<<<'
DELIMITED BY SIZE INTO MENS
MOVE CURSOR TO WK-CODPRODL
MOVE 'J' TO CODPRODA
PERFORM P720-00-ENVIA-WEB-COM-ALARME
PERFORM P999-98-SAIDA-COM-TRANS
WHEN OTHER
PERFORM P999-DB-TRATA-ABEND-DB2
END-EVALUATE.
*-------------------*
P312-TECLA-INVALIDA.
*-------------------*
MOVE '<<<< TECLA INVÁLIDA >>>>' TO MENS.
MOVE CURSOR TO WK-CODPRODL.
PERFORM P720-00-ENVIA-WEB-COM-ALARME.
PERFORM P999-98-SAIDA-COM-TRANS.
*-------------------*
P400-FIM-PROGRAMA.
*-------------------*
MOVE '*** FIM DA TRANSAÇÃO BERATUNG ***' TO WK-MENSAGEM.
PERFORM P730-00-ENVIA-TEXTO.
PERFORM P999-00-SAIDA-SEM-TRANS.
*-------------------*
P410-VOLTA-MENU.
*-------------------*
MOVE '*** RÜCKKEHR ZUM MENÜ ***' TO WK-MENSAGEM.
PERFORM P730-00-ENVIA-TEXTO.
PERFORM P999-99-TRANSFERE-CONTROLE.
*-------------------*
P700-00-RECEBE-WEB.
*-------------------*
EXEC CICS
RECEIVE MAP('GPM7654')
MAPSET('GPM7654')
INTO(GPM7654I)
END-EXEC.
*-------------------*
P720-00-ENVIA-WEB-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-ENVIA-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 WK-HORASISO.
*-------------------*
P999-97-IS-ABEND.
*-------------------*
EXEC CICS
HANDLE ABEND CANCEL
END-EXEC.
EXEC CICS
ASSIGN ABCODE(WK-ABEND)
END-EXEC.
MOVE 'NÃO APLICÁVEL - OCORREU UM ERRO CODE => '
TO WK-MENSAGEM.
MOVE WK-ABEND TO WK-MENSAGEM(42:4).
PERFORM P730-00-ENVIA-TEXTO.
PERFORM P999-98-SAIDA-COM-TRANS.
*-------------------*
P999-DB-TRATA-ABEND-DB2.
*-------------------*
EXEC CICS
HANDLE ABEND CANCEL
END-EXEC.
MOVE 'SELECT - OCORREU UM ERRO NO DB2 => '
TO WK-MENSAGEM.
MOVE SQLCODE TO WS-SQLCODE.
MOVE WS-SQLCODE TO WK-MENSAGEM(34:5).
PERFORM P730-00-ENVIA-TEXTO.
PERFORM P999-00-SAIDA-SEM-TRANS.
*-------------------*
P999-98-SAIDA-COM-TRANS.
*-------------------*
EXEC CICS
RETURN TRANSID('P764')
COMMAREA(CA-COMMAREA)
END-EXEC.
*-------------------*
P999-00-SAIDA-SEM-TRANS.
*-------------------*
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.