COBOL Program GPCAP764: Product Consultation
IDENTIFICATION DIVISION
PROGRAM-ID: GPCAP764
AUTHOR: FELIPE RICARDO NOGUEIRA
SECURITY: CONSULTATION PROGRAM PRODUCTS
DATE-WRITTEN: 28/11/2009
ENVIRONMENT DIVISION
CONFIGURATION SECTION
SPECIAL-NAMES: COMMA DECIMAL-POINT IS
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
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
CA-EVALUATE PHASE
- WHEN ‘1 ‘ PERFORM P200-PHASE-UM
- WHEN ‘2 ‘ PERFORM P220-PHASE-DOIS
- WHEN ‘3 ‘ PERFORM P240-THREE-PHASE
END-EVALUATE
P100-START
EXEC CICS HANDLE ABEND LABEL (P999-97-IS-ABEND) END-EXEC
IF EQUAL ZEROS EIBCALEN
INITIALIZE CA-COMMAREA
MOVE ‘1 ‘ TO CA-PHASE
ELSE
CA-DFHCOMMAREA MOVE TO COMMAREA
EIBTRNID IF NOT EQUAL ‘P764’
MOVE ‘1 ‘ TO CA-PHASE
END-IF
END-IF
P200-PHASE-UM
MOVE LOW-VALUES TO GPM7654I
MOVE ‘REPORT CODE MOVE OR DO PRODUTO’ TO MENS
CURSOR TO MOVE WK-CODPRODL
MOVE ‘J’ TO CODPRODA
MOVE ‘2 ‘ TO CA-PHASE
PERFORM P720-00-Exibir-WEB-COM-ALARMED
PERFORM P999-98-SAIDA-COM-TRANS
P210-PROTEGE-FIELDS
MOVE ‘/’ to describe
LOCAL
QTDESTA
QTDMINA
QTDMAXA
PRECOA
DTATUA
UserA
P220-PHASE-DOIS
PERFORM P700-00-RECEBO-WEB
EVALUATE EIBAID
- WHEN DFHENTER PERFORM P310-IS-CODPROD
- WHEN DFHPF3 PERFORM P400-FIM-PROGRAM
- WHEN DFHPF4 PERFORM P410-VOLTA-MENU
- WHEN DFHCLEAR PERFORM P400-FIM-PROGRAM
- WHEN OTHER MOVE ‘J’ TO CODPRODA PERFORM P312-INVALID-KEY
END-EVALUATE
THREE-PHASE-P240
PERFORM P700-00-RECEBO-WEB
EVALUATE EIBAID
- WHEN DFHPF3 PERFORM P400-FIM-PROGRAM
- WHEN DFHPF4 PERFORM P999-99-TRANSFER-CONTROL
- WHEN DFHPF5 PERFORM P200-PHASE-UM
- WHEN DFHCLEAR PERFORM P400-FIM-PROGRAM
- WHEN OTHER MOVE ‘/’ TO CODPRODA PERFORM P312-INVALID-KEY
END-EVALUATE
P310-IS-CODPROD
EXEC CICS BIF DEEDIT FIELD (CODPRODI) END-EXEC
CODPRODI MOVE TO CODPROD OF DCLTB76PROD
EXEC SQL SELECT * INTO: DCLTB76PROD FROM TB76PROD WHERE CODPROD =: DCLTB76PROD.CODPROD END-EXEC
EVALUATE SQLCODE
- WHEN ZEROS
MOVE TO DECRI OF DCLTB76PROD described
DCLTB76PROD MOVE OF LOCAL TO LOCAL
QTDEST OF DCLTB76PROD TO MOVE WS-QTDEST
QTDEST TO MOVE WS-QTDESTO
QTDMIN OF DCLTB76PROD TO MOVE WS-QTDMIN
QTDMIN TO MOVE WS-QTDMINO
QTDMAX OF DCLTB76PROD TO MOVE WS-QTDMAX
QTDMAX TO MOVE WS-QTDMAXO
PRECO DCLTB76PROD OF MOVE TO WS-PRECO
PRECO TO MOVE WS-WAS-PRECO-MASC
MOVE WS-PRECO-ADR TO PRECOO
DTATU INSPECT ALL OF REPLACING DCLTB76PROD ‘. ” BY ‘/’
DCLTB76PROD MOVE TO DTATU OF DTATUO
MOVE TO USER OF DCLTB76PROD UserA
MOVE ‘/’ TO CODPRODA
MOVE ” TO MENS
CURSOR TO MOVE WK-CODPRODL
MOVE ‘3 ‘ TO CA-PHASE
PERFORM P720-00-Exibir-WEB-COM-ALARM
PERFORM P999-98-SAIDA-COM-TRANS
- WHEN +100
CODPRODI TO MOVE WK-CODPROD
MOVE LOW-VALUES TO GPM7654I
STRING DIGITE'<<<< novamente, não encontrada PRODUTO – ‘=>’ WK-CODPROD ‘>>>>’ MENS BY SIZE INTO DELIMITED
CURSOR TO MOVE WK-CODPRODL
MOVE ‘J’ TO CODPRODA
PERFORM P720-00-Exibir-WEB-COM-ALARM
PERFORM P999-98-SAIDA-COM-TRANS
- WHEN OTHER
PERFORM P999-DB-TREAT-ABEND-DB2
END-EVALUATE
INVALID-KEY-P312
MOVE ‘INVALID KEY MOVE TO MENS’
CURSOR TO MOVE WK-CODPRODL
PERFORM P720-00-Exibir-WEB-COM-ALARMED
PERFORM P999-98-SAIDA-COM-TRANS
P400-FIM-PROGRAM
MOVE ‘*** FIM DA TRANSACAO CONSULTATION ***’ TO WK-MENSAGEM
PERFORM P730-00-Exibir-TEXT
PERFORM P999-00-SAIDA-SEM-TRANS
P410-VOLTA-MENU
MOVE ‘*** *** RETURNED AO MENU’ TO WK-MENSAGEM
PERFORM P730-00-Exibir-TEXT
PERFORM P999-99-TRANSFER-CONTROL
P700-00-RECEBO-WEB
EXEC CICS RECEIVE MAP ( ‘GPM7654’) Mapset ( ‘GPM7654’) INTO (GPM7654I) END-EXEC
P720-00-Exibir-WEB-COM-ALARMED
PERFORM P740-00-RESEARCH-DATA-TIME
EXEC CICS SEND MAP ( ‘GPM7654’) Mapset ( ‘GPM7654’) FROM (GPM7654I) FREEKB FRSET ERASE ALARM CURSOR NOHANDLE END-EXEC
P730-00-Exibir-TEXT
EXEC CICS SEND TEXT FROM (WK-MENSAGEM) FREEKB ERASE ALARM NOHANDLE END-EXEC
P740-00-RESEARCH-DATA-TIME
EXEC CICS ASKTIME abstime (WK-TEMPO) END-EXEC
EXEC CICS FORMATTIME abstime (WK-TEMPO) DDMMYYYY (WK-DATA) DATESEP (‘/’) TIME (WK-TIME) TIMESEP (‘:’) END-EXEC
MOVE TO WK-DATA DATASISO
TIME TO MOVE WK-HORASISO
P999-97-IS-ABEND
EXEC CICS HANDLE ABEND CANCEL END-EXEC
EXEC CICS ASSIGN ABCODE (WK-ABEND) END-EXEC
MOVE ‘NOT APPLICABLE OCORREU = UM ERRO CODE =>’ TO WK-MENSAGEM
ABEND TO MOVE WK-WK-MENSAGEM (42:4)
PERFORM P730-00-Exibir-TEXT
PERFORM P999-98-SAIDA-COM-TRANS
P999-DB-TREAT-ABEND-DB2
EXEC CICS HANDLE ABEND CANCEL END-EXEC
MOVE ‘SELECT OCORREU UM ERRO NO D0 DB2 =>’ TO WK-MENSAGEM
MOVE SQLCODE TO WS-SQLCODE
MOVE SQLCODE TO WS-WK-MENSAGEM (34:5)
PERFORM P730-00-Exibir-TEXT
PERFORM P999-00-SAIDA-SEM-TRANS
P999-98-SAIDA-COM-TRANS
EXEC CICS RETURN TRANS ( ‘P764’) COMMAREA (CA-COMMAREA) END-EXEC
P999-00-SAIDA-SEM-TRANS
EXEC CICS RETURN END-EXEC
P999-99-TRANSFER-CONTROL
MOVE ‘1 ‘ TO CA-PHASE
MOVE ‘P768’ TO CA-TRANS-CHAMADOR
MOVE ‘GPCAP768’ TO WK-PROGRAM
EXEC CICS XCTL PROGRAM (WK-PROGRAM) COMMAREA (CA-COMMAREA) NOHANDLE END-EXEC