📄 afcpo5.txt
字号:
./ ADD NAME=SCRNDEF
***********************************************************************
* AFCPO5.BD EXPORTED ON: 12/29/05 02:49:15 BY: C760040 *
***********************************************************************
***********************************************************************
* LAST UPDATE: 12/29/05 02:44 BY: C760040 *
***********************************************************************
TELON LANGLVL=4.1, C
LANG=COBOL, C
HEADER=AF, C
ID=CPO5
***********************************************************************
* BATCH DESCRIPTION ~~ SEND PRE IMAGE TO CBR *
***********************************************************************
BATCH CPO5,HEADER=AF, C
SIZE=(060,133), C
DESC='SEND PRE IMAGE TO CBR', C
CRTDATE=030618, C
UPDDATE=051229, C
UPDTIME=0244, C
UPDUSER=C760040, C
SECTION=ZSECTION, C
WKAREA=(ZZWKAREA,WFMC500C,WFMC500B,AFCPO1C,AFCPO5C), C
LANG=COBOL, C
REMARKS=REMARKS, C
INIT1=QINIT1, C
PRCTRAN=APRCTRAN, C
PARMS=03
***********************************************************************
* D A T A A C C E S S *
***********************************************************************
DATASET NAME=AFC00CGB, C
ACCESS=SEQUENTIAL, C
OPEN=INPUT, C
LRECL=00429
AFC00CGB RECORD @DEFINE,COPY=NONE
AUTOEXEC TRANSACT AFC00CGB,IOAREA=DCLCAF00CGB
*
CAF00RBR DB2 TBLQUAL=AF, C
TBLNAME=CAF00RBR
CAF00RBR ROW @DEFINE,TBLQUAL=AF, C
TBLNAME=CAF00RBR
READ CAF00RBR,IGNORE=(NFD,DUP,-305), C
CPYINIT=UCPYINTA, C
CPYCALL=UCPYCALA, C
CPYTERM=UCPYTRMA
*
CAF00RJR DB2 TBLQUAL=AF, C
TBLNAME=CAF00RJR
CAF00RJR ROW @DEFINE,TBLQUAL=AF, C
TBLNAME=CAF00RJR
READ CAF00RJR,IGNORE=(NFD,DUP,-305), C
CPYCALL=UCPYCALB
*
CAF00R39 DB2 TBLQUAL=AF, C
TBLNAME=CAF00R39
CAF00R39 ROW @DEFINE,TBLQUAL=AF, C
TBLNAME=CAF00R39
READ CAF00R39,IGNORE=(NFD,DUP,-305), C
SENCOLS=R39_CUST_633, C
CPYINIT=UCPYINTH, C
CPYCALL=UCPYCALH, C
CPYTERM=UCPYTRMH
*
CAF00RJ9 DB2 TBLQUAL=AF, C
TBLNAME=CAF00RJ9
CAF00RJ9 ROW @DEFINE,TBLQUAL=AF, C
TBLNAME=CAF00RJ9
READ CAF00RJ9,IGNORE=(NFD,DUP,-305), C
SENCOLS=RJ9_CUST_633, C
CPYCALL=UCPYCALI
*
CAF00CGB DB2 TBLQUAL=AF, C
TBLNAME=CAF00CGB
CAF00CGB ROW @DEFINE,TBLQUAL=AF, C
TBLNAME=CAF00CGB
UPDATE CAF00CGB,IGNORE=NFD, C
SENCOLS=(CGB_LST_UPD_TMSTP,CGB_CBR_RT_STAT_CD, C
CGB_LOG_USER), C
CPYCALL=UCPYCALC
*
CAF00CEH DB2 TBLQUAL=AF, C
TBLNAME=CAF00CEH
CAF00CEH ROW @DEFINE,TBLQUAL=AF, C
TBLNAME=CAF00CEH
READ CAF00CEH,IOAREA=':CEH-APPL-CD-DESC,:CURRENT-DATE,:CURRENTC
-TIME,:CURRENT-SERVER', C
SENCOLS='CEH_APPL_CD_DESC,CURRENT DATE, CURRENT TIME, CUC
RRENT SERVER', C
CPYCALL=UCPUCALJ
*
DATASET NAME=JCLFILE, C
ACCESS=SEQUENTIAL, C
OPEN=OUTPUT, C
LRECL=00080
JCLFILE RECORD @DEFINE,COPY=NONE
CREATE JCLFILE
BATCHPGM
END
DATA DIVISION.
WORKING-STORAGE SECTION.
01 WS-PGM-VAR.
05 WFMS500B PIC X(08) VALUE 'WFMS500B'.
05 AFCPO1 PIC X(08) VALUE 'AFCPO1'.
05 WS-STRPTR PIC S9(4) COMP-3 VALUE ZEROS.
05 WS-MQ-CNT PIC S9(4) COMP-3 VALUE ZEROS.
05 CURRENT-DATE PIC X(10) VALUE SPACES.
05 CURRENT-TIME PIC X(08) VALUE SPACES.
05 CURRENT-SERVER PIC X(10) VALUE SPACES.
05 TMP-PRC-PKG-N PIC -(11).
05 TMP-REN-PA-N PIC -(11).
05 IDX PIC S9(4) COMP-3 VALUE ZEROS.
05 IDX1 PIC S9(4) COMP-3 VALUE ZEROS.
05 IDX2 PIC S9(4) COMP-3 VALUE ZEROS.
05 SUB PIC S9(4) COMP-3 VALUE ZEROS.
05 WS-UPDT-CBR-ST-FL PIC X(01) VALUE SPACES.
88 UPDATE-CBR-ST VALUE 'Y'.
88 UPDATE-CBR-ST-NO VALUE 'N'.
01 WS-MESSAGE PIC X(250).
01 MQ-INPUT.
05 MQ-APPL-CD PIC X(03).
05 MQ-OVR-PMT-CD PIC X(01).
05 MQ-EQP-INIT PIC X(04).
05 MQ-EQP-NUMB PIC X(10).
05 MQ-BGN-RPC-DT PIC X(10).
05 MQ-BGN-RPC-TM PIC X(10).
05 MQ-EFF-DT PIC X(10).
05 MQ-EXP-DT PIC X(10).
05 MQ-SHPR-633 PIC X(12).
05 MQ-CNSG-633 PIC X(12).
05 MQ-TP-633 PIC X(12).
05 MQ-RULE-11-633 PIC X(12).
05 MQ-ORIG-CITY PIC X(09).
05 MQ-ORIG-ST PIC X(02).
05 MQ-DEST-CITY PIC X(09).
05 MQ-DEST-ST PIC X(02).
05 MQ-STCC-NUMB PIC X(07).
05 MQ-PRC-AUTH PIC X(14).
05 MQ-ISS-CARR PIC X(10).
05 MQ-PA-ID PIC X(10).
05 MQ-ITEM-N PIC X(10).
05 MQ-PA-N PIC X(10).
05 MQ-PRC-PKG-N PIC X(11).
05 MQ-REN-PA-N PIC X(11).
05 MQ-FGN-SYS-CD PIC X(01).
PROCRDURE DIVISION.
ADD +1 TO WS-MQ-CNT
PERFORM Z-100-GET-PRE-IMAGE
THRU Z-100-EXIT
PERFORM Z-300-BUILD-MSG
THRU Z-300-EXIT
PERFORM Z-200-WRITE-MSG
THRU Z-200-EXIT
PERFORM Z-400-UPDATE-LOG
THRU Z-400-EXIT
IF UPDATE-CBR-ST
PERFORM U-100-UPDATE-CAF00CGB
END-IF
IF WS-MQ-CNT >= 300
PERFORM Z-600-MQ-COMMIT
PERFORM U-100-COMMIT
MOVE ZEROES TO WS-MQ-CNT
END-IF
IF CGB-ISU-CARR-PA-ID <= SPACES AND
CGB-PA-ID <= SPACES AND
CGB-ITEM-N <= SPACES
PERFORM Z-500-SEND-MAIL
THRU Z-500-EXIT
END-IF
.
0000-INITIALIZE-CBR-ST-PARA.
INITIALIZE WS-MQ-CNT
IF PRM-FIELD-1 = 'JOB'
SET UPDATE-CBR-ST TO TRUE
ELSE
IF PRM-FIELD-1 = 'WEB'
SET UPDATE-CBR-ST-NO TO TRUE
END-IF
END-IF
.
U-100-READ-CAF00CEH
EXEC SQL
SELECT CEH_APPL_CD_DESC,CURRENT DATE, CURRENT TIME,
CURRENT SERVER
INTO :CEH-APPL-CD-DESC,:CURRENT-DATE,:CURRENT-TIME,
:CURRENT-SERVER
FROM AF.CAF00CEH
WHERE (CEH_APPL_ELE = 'EPS-NOTIF-MAIL-ID'
AND CEH_APPL_CD_VAL = 'MAIL')
END-EXEC.
U-100-READ-CAF00RBR
EXEC SQL
SELECT RBR_ACCTG_WB_ID
,RBR_WB_NUMB_SFX
INTO :RBR-ACCTG-WB-ID
,:RBR-WB-NUMB-SFX
FROM AF.CAF00RBR
WHERE RBR_WB_NUMB = :RBR-WB-NUMB
AND RBR_WB_DT = :RBR-WB-DT
AND RBR_EQP_INIT = :RBR-EQP-INIT
AND RBR_EQP_NUMB = :RBR-EQP-NUMB
AND RBR_WB_VRSN =
(SELECT MAX(RBR_WB_VRSN)
FROM AF.CAF00RBR
WHERE RBR_EQP_INIT = :RBR-EQP-INIT
AND RBR_EQP_NUMB = :RBR-EQP-NUMB
AND RBR_WB_NUMB = :RBR-WB-NUMB
AND RBR_WB_DT = :RBR-WB-DT)
END-EXEC.
U-100-READ-CAF00RJR
EXEC SQL
SELECT RJR_ACCTG_WB_ID
,RJR_WB_NUMB_SFX
INTO :RBR-ACCTG-WB-ID
,:RBR-WB-NUMB-SFX
FROM AF.CAF00RJR
WHERE RJR_WB_NUMB = :RBR-WB-NUMB
AND RJR_WB_DT = :RBR-WB-DT
AND RJR_EQP_INIT = :RBR-EQP-INIT
AND RJR_EQP_NUMB = :RBR-EQP-NUMB
AND RJR_WB_VRSN =
(SELECT MAX(RJR_WB_VRSN)
FROM AF.CAF00RJR
WHERE RJR_EQP_INIT = :RBR-EQP-INIT
AND RJR_EQP_NUMB = :RBR-EQP-NUMB
AND RJR_WB_NUMB = :RBR-WB-NUMB
AND RJR_WB_DT = :RBR-WB-DT)
END-EXEC.
U-100-UPDATE-CAF00CGB
EXEC SQL
UPDATE AF.CAF00CGB
SET
CGB_LST_UPD_TMSTP=CURRENT_TIMESTAMP
,CGB_CBR_RT_STAT_CD= 'S'
,CGB_LOG_USER='AFCPO5'
WHERE (CGB_EQP_INIT = :DCLCAF00CGB.CGB-EQP-INIT
AND CGB_EQP_NUMB = :DCLCAF00CGB.CGB-EQP-NUMB
AND CGB_CAS_OWNER = :DCLCAF00CGB.CGB-CAS-OWNER
AND CGB_BGN_RPC_DT = :DCLCAF00CGB.CGB-BGN-RPC-DT
AND CGB_BGN_RPC_TM = :DCLCAF00CGB.CGB-BGN-RPC-TM)
END-EXEC.
U-100-READ-CAF00R39
EXEC SQL
SELECT R39_CUST_633
INTO :R39-CUST-633
FROM AF.CAF00R39
WHERE R39_ACCTG_WB_ID = :R39-ACCTG-WB-ID
AND R39_WB_NUMB_SFX = :R39-WB-NUMB-SFX
AND R39_CUST_TYP_CD = :R39-CUST-TYP-CD
END-EXEC.
U-100-READ-CAF00RJ9
EXEC SQL
SELECT RJ9_CUST_633
INTO :R39-CUST-633
FROM AF.CAF00RJ9
WHERE RJ9_ACCTG_WB_ID = :R39-ACCTG-WB-ID
AND RJ9_WB_NUMB_SFX = :R39-WB-NUMB-SFX
AND RJ9_CUST_TYP_CD = :R39-CUST-TYP-CD
AND RJ9_ACCTG_WB_VRSN =
( SELECT MAX(RJ9_ACCTG_WB_VRSN)
FROM AF.CAF00RJ9
WHERE RJ9_ACCTG_WB_ID = :R39-ACCTG-WB-ID
AND RJ9_WB_NUMB_SFX = :R39-WB-NUMB-SFX
AND RJ9_CUST_TYP_CD = :R39-CUST-TYP-CD)
END-EXEC.
* INITIALIZE RBR-ACCTG-WB-ID
* RBR-WB-NUMB-SFX
MOVE CGB-EQP-INIT TO RBR-EQP-INIT
MOVE CGB-EQP-NUMB TO RBR-EQP-NUMB
MOVE CGB-WB-DT TO RBR-WB-DT
MOVE CGB-WB-NUMB TO RBR-WB-NUMB
.
* INITIALIZE R39-CUST-633
MOVE RBR-ACCTG-WB-ID TO R39-ACCTG-WB-ID
MOVE RBR-WB-NUMB-SFX TO R39-WB-NUMB-SFX
.
IF DA-OK
CONTINUE
ELSE
IF DA-NOTFOUND
PERFORM U-100-READ-CAF00RJR
END-IF
END-IF
.
./ ADD NAME=UCPYTRMH
IF DA-OK
CONTINUE
ELSE
IF DA-NOTFOUND
PERFORM U-100-READ-CAF00RJ9
END-IF
END-IF
.
./ ADD NAME=ZSECTION
Z-100-GET-PRE-IMAGE.
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -