📄 rpind705
字号:
******************************************************************
* (C) COPYRIGHT *
* NO PART OF THIS PROGRAM MAY *
* BE PHOTOCOPIED, REPRODUCED, TRANSLATED TO ANOTHER *
* PROGRAM LANGUAGE OR USED IN ANY WAY WITHOUT THE *
* PRIOR WRITTEN CONSENT OF FINANCIAL NETWORK SERVICES *
* OR THE AUTHORISED SELLING AGENT. *
*----------------------------------------------------------------*
*ADDRESS: *
* *
* *
* *
******************************************************************
******************************************************************
******************************************************************
*** ***
*** SYSTEM:- BROKERAGE SYSTEM ***
*** ***
*** MODULE : EXTRACTION ***
*** ***
*** PROGRAM : RPIND705 ***
*** ***
*** PURPOSE : GENERATE REPORT VIA EXTRACTING FIELDS FROM ***
*** BANCS TABLES ***
*** ***
*** FUNCTION: TO EXTRACT FIELDS FROM TABLES OR FILES FOR ***
*** BACKOFFICE AND PERIPHERY SYSTEMS TO USE THEM. ***
*** ***
******************************************************************
******************************************************************
* P R O G R A M H I S T O R Y *
* ------------------------------ *
* *
* PROGRAMMERS INITIALS TOGETHER WITH THE "SPR" NUMBER MUST BE *
* REFLECTED IN COLUMNS 73-80 OF EVERY LINE/S CHANGED OR ADDED. *
* *
* PROGRAMMER : DATE :SPR NO :COMMENTS *
*----------------------------------------------------------------*
* : : :NEW PROGRAM *
*----------------------------------------------------------------*
******************************************************************
**************************************
IDENTIFICATION DIVISION.
**************************************
*
PROGRAM-ID. RPIND705.
INSTALLATION. FINANCIAL NETWORK SERVICES PTY LTD.
DATE-WRITTEN. 12TH FEB 2007.
DATE-COMPILED.
*
**************************************
ENVIRONMENT DIVISION.
**************************************
*
**********************************
CONFIGURATION SECTION.
**********************************
SOURCE-COMPUTER. IBM-390.
OBJECT-COMPUTER. IBM-390.
**********************************
INPUT-OUTPUT SECTION.
**********************************
*
FILE-CONTROL.
*
SELECT RPIN705 ASSIGN TO RPMDD705
ORGANIZATION IS SEQUENTIAL
ACCESS MODE IS SEQUENTIAL
FILE STATUS IS WS-RPIN705-STATUS.
**************************************
DATA DIVISION.
**************************************
*
FILE SECTION.
*
FD RPIN705 RECORDING MODE IS F.
COPY INCD705 REPLACING ==:XXXX:== BY ==INCD705==.
********************************
WORKING-STORAGE SECTION.
********************************
*
*
*
*****************************************************************
* CONSTANT DECLARATION *
*****************************************************************
*
*****************************************************************
* FILE-RPBDD601 : FILE NAME OF RPBDD601 *
* PGM-UTDB2ER : PROGRAM NAME OF UTDB2ER *
*****************************************************************
*
77 PGM-RPBDD601 PIC X(08) VALUE 'RPIND705'.
77 PGM-UTDB2ER PIC X(08) VALUE "UTDB2ER".
77 TBL-DB-TBL1 PIC X(08) VALUE 'INVM'.
*77 TBL-DB-TBL2 PIC X(08) VALUE 'DB-TBL2'.
77 K-START-MESSAGE PIC X(15) VALUE 'RPIND705 START'.
77 K-PGM-ID PIC X(08) VALUE 'RPIND705'.
77 K-END-MESSAGE PIC X(14) VALUE 'RPIND705 END '.
77 K-RETURN-NORMAL PIC X(02) VALUE '00'.
77 K-RETURN-WARNING PIC X(02) VALUE '04'.
77 K-RETURN-ABNORMAL PIC X(02) VALUE '08'.
*
01 WS-VAR.
03 WS-VAR-AREA PIC X(120).
03 WS-ACCOUNT-NO PIC X(16).
03 INCT-ACCT-NO PIC X(16).
03 INVE-VOUCHER-NO PIC X(8).
03 INVT-SEQUENCE-NO PIC X(3).
03 INVT-VOLUME-NO PIC X(2).
*
**************************
* FILE & PROCESS STATUS *
**************************
*
01 DB2-RTCD PIC ----9.
01 DB2-NORMAL PIC 9(01) VALUE ZERO.
01 DB2-NOTFOUND PIC 9(03) VALUE 100.
*
01 WS-FILE-STS-AREA.
03 WS-RPIN705-STATUS PIC 9(02) VALUE 00.
88 WS-RPIN705-SUCCESSFUL VALUE 00.
88 WS-RPIN705-EOF VALUE 10.
88 WS-RPIN705-ACCEPTABLE VALUE 00 10.
*
01 WS-PROCESS-STS-AREA.
03 WS-FILE-ERROR-FLAG PIC X(01) VALUE SPACE .
88 WS-FILE-NORMAL VALUE ' '.
88 WS-FILE-ERROR VALUE 'E'.
03 WS-DB2-ERROR-FLAG PIC X(01) VALUE SPACE .
88 WS-DB2-NORMAL VALUE ' '.
88 WS-DB2-ERROR VALUE 'E'.
03 WS-DB2-EOF-FLAG.
05 WS-INVM-EOF-FLAG PIC X(01) VALUE SPACE .
88 WS-INVM-EOF VALUE 'Y'.
88 WS-INVM-NOTEOF VALUE 'N'.
*
*-----------------------------------------------------------------
* WORKING VARIABLIES *
*-----------------------------------------------------------------
* WS-VARIABLIES : WORKING VARIABLIES FOR THIS BATCH PROGRAM *
* WK-CONSTANTS : WORKING CONSTANTS FOR THIS BATCH PROGRAM *
*-----------------------------------------------------------------
*
01 WS-WORKING-VAR.
03 WS-READ-CNT PIC 9(07) VALUE ZERO.
03 WS-SUCC-CNT PIC 9(07) VALUE ZERO.
03 WS-FAIL-CNT PIC 9(07) VALUE ZERO.
03 WS-TOTAL-RECS PIC 9(07) VALUE ZERO.
03 WS-REC-CNT PIC 9(07) VALUE ZERO.
*
01 WK-CONSTANTS-VAR.
03 WK-RETURN-WARNING PIC X(02) VALUE '04'.
03 WK-RETURN-ERROR PIC X(02) VALUE '08'.
03 WK-RETURN-NORMAL PIC X(02) VALUE '00'.
*
01 WK-RTN PIC X(1) VALUE SPACE.
88 WS-NO-REC-FOUND VALUE 'R'.
88 WS-NO-ERR VALUE 'E'.
*
01 MISERR01-STATUS PIC X(10) VALUE SPACE.
88 MISERR01-WARNING-FOUND VALUE 'N'.
88 MISERR01-FATAL-ERROR-FOUND VALUE 'N'.
88 MISERR01-SEVERE-WARNING-FOUND VALUE 'N'.
88 MISERR01-ERROR-FOUND VALUE 'N'.
*
***************************
* DISPLAY MESSAGES *
***************************
*
01 WS-MESSAGE-AREA.
03 WS-PGM-HEAD.
05 FILLER PIC X(03) VALUE '** '.
05 WS-PGM-ID PIC X(08).
05 FILLER PIC X(03) VALUE ' - '.
03 WS-SUB-PGM-MSG.
05 WS-PGM-ACTION PIC X(05).
88 WS-PGM-CALL VALUE 'CALL '.
05 WS-SUB-PGM-NAME PIC X(09).
05 FILLER PIC X(12) VALUE 'ERR, CODE = '.
05 WS-PGM-RTN-CODE PIC X(04).
05 FILLER PIC X(09) VALUE ', COMM = '.
05 WS-PGM-COMMAREA PIC X(150).
03 WS-PGM-MSG.
05 FILLER PIC X(80).
88 WS-PGM-START VALUE 'START'.
88 WS-NORMAL-END VALUE 'NORMAL END'.
88 WS-ABNORMAL-END VALUE 'ABNORMAL END'.
03 WS-STATISTICS.
05 WS-TOTAL-ST.
07 FILLER PIC X(25)
VALUE 'NO. OF RPIN705 READ :'.
07 WS-TOTAL-READ PIC ZZZZZZ9.
05 WS-SUCCESS-ST.
07 FILLER PIC X(25)
VALUE 'NO. OF DB-INVM WRITE :'.
07 WS-SUCC-WRITE PIC ZZZZZZ9.
05 WS-FAIL-ST.
07 FILLER PIC X(25)
VALUE 'NO. OF DB-INVM FAIL :'.
07 WS-FAIL-WRITE PIC ZZZZZZ9.
*
*****************************************************************
* COMMUNICATION AREA *
*****************************************************************
*
*****************************************************************
* UTCBERR : COMM AREA FOR PUBLIC ERROR PROCESS(UTSPBERR) *
* UTCFSTS : FILE STATUS VALUE DESCRIPTION *
* UTCSTUS : COMMAREA FOR SUB PGM UTSBSTUS *
*****************************************************************
COPY UTCSTUS.
* COPY UTCBERR.
COPY UTCFSTS.
COPY UTDB2ER IN LIBRYMVS.
* COPY DBDB2TST IN LIBRYMVS.
*
* COPY PBCSTUS.
* COPY SCCBERR.
* COPY SCCFSTS.
* COPY SCCBLOG.
* COPY SCRJPRM.
* COPY CVRPBVAR.
*
*-----------------------------------------------------------------
* DB2 HOST VARIABLES *
*-----------------------------------------------------------------
* copybook0 : SQLCA MESSAGE DDMMUNICATION AREA OF SQL DDMMAND *
* copybook1 : DCLGEN FOR TABLE 1 *
* copybook2 : DCLGEN FOR TABLE 2 *
*-----------------------------------------------------------------
EXEC SQL
INCLUDE SQLCA
END-EXEC.
EXEC SQL
INCLUDE INVM
END-EXEC.
EXEC SQL
INCLUDE INVE
END-EXEC.
EXEC SQL
INCLUDE INCT
END-EXEC.
EXEC SQL
INCLUDE CUSVAA
END-EXEC.
* EXEC SQL
* INCLUDE INVT
* END-EXEC.
*
***********************************
* DB2 RESPONSE CODE *
***********************************
*
* COPY DB2RTCD.
* COPY MISERR01.
*
***********************************
* DB2 CURSOR DECLARE *
***********************************
*
EXEC SQL
DECLARE CSR-INVM CURSOR FOR
SELECT
INVM.BRANCH_NO,
INVM.CURRENCY,
INVM.CURR_BAL,
INCT.ACCT_NO,
* INVE.VOUCHER_NO,
'010',
CUSVAA.NAME1
FROM INVM,INCT,INVE,CUSVAA
WHERE
INCT.TRAN_TYPE='40' AND
SUBSTR(INVM.KEY_1,4,16)=INCT.ACCT_NO AND
SUBSTR(INVE.KEY_1,4,16)=INCT.ACCT_NO AND
CUSVAA.CUST_NO=INVM.CUSTOMER_NO
END-EXEC.
*
*
LINKAGE SECTION.
01 LINK-PARM.
03 LINK-PARM-LEN PIC 9(04) COMP.
03 LINK-PARM-MSG PIC X(60).
**************************************
PROCEDURE DIVISION USING LINK-PARM.
**************************************
*
* DECLARATIVES.
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -