bcb8311.pco

行业应用源码 行业应用源码 行业应用源码 行业应用源码 行业应用源码 行业应用源码

       IDENTIFICATION  DIVISION.
       PROGRAM-ID.     BCB8311.
       AUTHOR.         John.
       DATE-WRITTEN.   2001/12/06/.
       DATE-COMPILED.  2001/12/06/.
      ******************************************************************
      *** REMARKS:                                                   ***
      *** PROGRAM NAME: BCB8311                                      ***
      *** PROGRAM PURPOSE     :计息帐户计算利息(包括协定帐户)        ***
      *** PROCESS DESCRIPTION :(支持一个协定帐户有多条协定记录)      ***
      ***    1000-TXN-INIT-RTN                                       ***
      ***    5000-NORMAL-PROCESS-RTN                                 ***
      ***    8000-TXN-END-RTN                                        ***
      ******************************************************************
      ****************************************************************
      ***  MODIFIED BY         : zhaoxz                            ***
      ***  DATE MODIFY         : 分ORGIDT COMMIT程序中的BUG        ***
      ***  MODIFY REASON       :                                   ***
      ***  MODIFY DESCRIPTION  :                                   ***
      ****************************************************************
      ***  MODIFIED BY         : Liu XiaoShi                       ***
      ***  DATE MODIFY         : 2003-08-18                        ***
      ***  MODIFY REASON       : 打开游标时速度很慢                ***
      ***  MODIFY DESCRIPTION  : 030818                            ***
      ****************************************************************
      ***  MODIFIED BY         : Liu XiaoShi                       ***
      ***  DATE MODIFY         : 2003-11-27                        ***
      ***  MODIFY REASON       : 打开游标时速度很慢                ***
      ***  MODIFY DESCRIPTION  : 031127                            ***
      ****************************************************************


       ENVIRONMENT DIVISION.
       INPUT-OUTPUT SECTION.
      ******************************************************************
      ***  DATA DIVISION                                             ***
      ******************************************************************

       DATA DIVISION.
       WORKING-STORAGE SECTION.
      ******************************************************************
      ***  VARIABLE  CAN'T BE INITIALIZED                            ***
      ******************************************************************

        01  WK-AREA.
          05  WK-PARA            PIC X(50)  VALUE '//WK-PARA/'.
          05  WK-END-FLAG        PIC X(1)   VALUE '0'.
          05  WK-ERR-FLAG        PIC X(1)   VALUE '0'.
          05  WK-ERR-ALL-FLAG    PIC X(1)   VALUE '0'.
        01 WK-IRTVAL             PIC S9(3)V9(15) VALUE ZERO.
        01 WK-DRATSF             PIC S9(3)V9(15) VALUE ZERO.
        01 WK-CRATSF             PIC S9(3)V9(15) VALUE ZERO.
        01 WK-NXTVAL1            PIC S9(3)V9(15) VALUE ZERO.
        01 WK-NXTVAL2            PIC S9(3)V9(15) VALUE ZERO.
        01 WK-NXTVAL3            PIC S9(3)V9(15) VALUE ZERO.
        01 OLD-NXTVAL1           PIC S9(3)V9(15) VALUE ZERO.
        01 OLD-NXTVAL2           PIC S9(3)V9(15) VALUE ZERO.
        01 OLD-NXTVAL3           PIC S9(3)V9(15) VALUE ZERO.
        01 OLD-ACC-FLAG          PIC X(1) VALUE '0'.
        01 OLD-ERYDAT            PIC X(10) VALUE SPACES.
        01 OLD-BALLIM            PIC S9(15)V9(2) COMP-3 VALUE ZEROS.
        01 WK-DITCST             PIC 9(3) VALUE ZERO.
        01 WK-DAYS               PIC S9(8) COMP-3   VALUE ZERO.
        01 WK-ACC-FLAG           PIC X(1) VALUE '0'.
        01 WK-DR-ALL-INT   PIC S9(14)V9(4) COMP-3 VALUE ZEROS.
        01 WK-CR-ALL-INT   PIC S9(14)V9(4) COMP-3 VALUE ZEROS.
        01 WK-DR-INT       PIC S9(14)V9(4) COMP-3 VALUE ZEROS.
        01 WK-CR-INT       PIC S9(14)V9(4) COMP-3 VALUE ZEROS.
        01 WK-CR-INT1      PIC S9(14)V9(4) COMP-3 VALUE ZEROS.
        01 WK-CR-INT2      PIC S9(14)V9(4) COMP-3 VALUE ZEROS.
        01 WK-XIE-BAL      PIC S9(15)V9(2) COMP-3 VALUE ZEROS.
        01 WK-DR-ACCM      PIC S9(15)V9(2) COMP-3 VALUE ZEROS.
        01 WK-CR-ACCM      PIC S9(15)V9(2) COMP-3 VALUE ZEROS.
        01 WK-CR-ACCM1     PIC S9(15)V9(2) COMP-3 VALUE ZEROS.
        01 WK-CR-ACCM2     PIC S9(15)V9(2) COMP-3 VALUE ZEROS.
      *****************************************************************
      * SQL/DS HOST VARIABLE DECLARATION                            ***
      *****************************************************************

           EXEC  SQL BEGIN   DECLARE  SECTION  END-EXEC.
           EXEC  SQL INCLUDE ACKSQST  END-EXEC.
           EXEC  SQL INCLUDE SQLCOM   END-EXEC.
       01 OLD-ORGIDT      PIC X(4)  VALUE SPACES.
       01 OLD-CUSIDT      PIC X(7)  VALUE SPACES.
       01 OLD-APCODE      PIC X(4)  VALUE SPACES.
       01 OLD-CURCDE      PIC X(3)  VALUE SPACES.
       01 OLD-INTDAT      PIC X(10) VALUE SPACES.
       01 WK-CBH-ERYDAT   PIC X(10) VALUE SPACES.
       01 WK-BASE-DATE    PIC X(10) VALUE '0001-01-01'.
       01 WK-INTDAT-DAYS  PIC S9(8) COMP-3   VALUE 1.
       01 WK-CRNDAT-DAYS  PIC S9(8) COMP-3   VALUE 1.
       01 WK-OLD-DAYS     PIC S9(8) COMP-3   VALUE 1.
       01 WK-DACINT       PIC S9(14)V9(4) COMP-3 VALUE ZEROS. 
       01 WK-CACINT       PIC S9(14)V9(4) COMP-3 VALUE ZEROS. 
       01 OLD-INTBAL      PIC S9(15)V9(2) COMP-3 VALUE ZEROS.
       01 WK-IRTAMT       PIC S9(15)V9(2) COMP-3 VALUE ZEROS.
       01 WK-EFFDAT       PIC X(10)        VALUE SPACES.
       01 WK-SQL-VAL.
           EXEC  SQL INCLUDE ACKSCT   END-EXEC.
           EXEC  SQL INCLUDE ACKCUT   END-EXEC.
           EXEC  SQL INCLUDE ACKCBH   END-EXEC.
           EXEC  SQL INCLUDE ACKIRT   END-EXEC.
           EXEC  SQL INCLUDE ACKCCY   END-EXEC.
           EXEC  SQL INCLUDE ACKBAL   END-EXEC.
           EXEC  SQL END     DECLARE  SECTION END-EXEC.
           EXEC  SQL INCLUDE SQLCA   END-EXEC.
       PROCEDURE DIVISION.
       0000-MAIN-PROCESS-RTN.
           DISPLAY   '*****  BCB8311  START *****' UPON CONSOLE.
           PERFORM     1000-TXN-INIT-RTN           THRU 1000-EXIT.
           PERFORM     5000-NORMAL-PROCESS-RTN     THRU 5000-EXIT.
           PERFORM     8000-TXN-END-RTN            THRU 8000-EXIT.
           DISPLAY   '*****  BCB8311  END   *****' UPON CONSOLE.
           STOP RUN.
       0000-EXIT.
           STOP  RUN.
       1000-TXN-INIT-RTN.
      ****************************************************************
      * CONNECT TO THE DATABASE                                      *
      ****************************************************************
           INITIALIZE  WK-SQL-VAL.
           MOVE        '/1000-TXN-INIT-RTN/'    TO      WK-PARA.
           EXEC SQL INCLUDE APS999  END-EXEC.
           EXEC SQL LOCK TABLE  ACTBAL  IN EXCLUSIVE MODE END-EXEC.
           EXEC SQL LOCK TABLE  ACTCUT  IN EXCLUSIVE MODE END-EXEC.
********   EXEC SQL WHENEVER SQLERROR   GOTO  :ERRCHK END-EXEC.
       1000-EXIT.
           EXIT.

       5000-NORMAL-PROCESS-RTN.
           MOVE   '/5000-NORMAL-PROCESS-RTN/'   TO   WK-PARA.

           EXEC SQL DELETE FROM TMP_ACTLOG END-EXEC.
           EXEC SQL INSERT INTO TMP_ACTLOG (
                    SELECT ORGIDT FROM ACTORG
                     WHERE RECSTS = :CNST-M-RECSTS-VALID
                     MINUS
                    SELECT ORGIDT FROM ACTLOG
                     WHERE JOBNAM = 'BCB8311' )
           END-EXEC.
zhaoxz     EXEC SQL COMMIT END-EXEC.
           EXEC SQL SELECT CRNDAT
                    INTO   :SCT-CRNDAT
                    FROM   ACTSCT
                   WHERE  SCTNUM = :CNST-M-SCTNUM-NORMAL
                     AND  RECSTS = :CNST-M-RECSTS-VALID
           END-EXEC.
           MOVE    SQLCODE    TO     SQL-ERR-CODE
           IF NOT SQL-C-NORMAL
           THEN
             DISPLAY 'READ ACTSCT ERR!'
             GO  TO  ERRCHK
           END-IF.

           EXEC SQL DECLARE CUR_ACTBAL CURSOR FOR
030818*            SELECT 
030818             SELECT /*+ first_rows */
031127*                   ORGIDT, CUSIDT, APCODE,
                          ACTBAL.ORGIDT, CUSIDT, APCODE,
                          CURCDE, INTDAT, INTBAL,
                          DINRAT, CINRAT, DRATSF,
                          CRATSF
031127*              FROM ACTBAL
031127               FROM ACTBAL, TMP_ACTLOG
                    WHERE TRANFG = :CNST-M-TRANFG-FALSE
                      AND INTTYP = :CNST-M-INTFLG-AIF  
                      AND RECSTS = :CNST-M-RECSTS-VALID  
031127                AND ACTBAL.ORGIDT = TMP_ACTLOG.ORGIDT
031127*               AND ORGIDT IN
031127*               ( SELECT  ORGIDT
031127*                  FROM  TMP_ACTLOG )
                 ORDER BY ORGIDT, CUSIDT, APCODE, CURCDE, INTDAT

           END-EXEC.

           EXEC  SQL  OPEN   CUR_ACTBAL  END-EXEC.
           MOVE    SQLCODE    TO     SQL-ERR-CODE
           IF NOT SQL-C-NORMAL
           THEN
              DISPLAY 'OPEN CUR_ACTBAL ERR'
              GO   TO   ERRCHK
           END-IF.
           PERFORM     5100-SCAN-ACTBAL-RTN        THRU 5100-EXIT
                   UNTIL  WK-END-FLAG = '1'.
           EXEC  SQL  CLOSE  CUR_ACTBAL  END-EXEC.
           MOVE    SQLCODE    TO     SQL-ERR-CODE
           IF NOT SQL-C-NORMAL
           THEN
              DISPLAY 'CLOSE CUR_ACTBAL ERR'
              GO   TO   ERRCHK
           END-IF.
       5000-EXIT.
           EXIT.

     ********************************************************************
     *** 5100-SCAN-ACTBAL-RTN 按机构循环计算帐户截止到当前工作日的利息***
     *** 并将其放在ACTCUT中的该帐户的应收应付息中。同时以上处理按机构 ***
     *** 提交直到无新的机构。                                         ***
     ********************************************************************
       5100-SCAN-ACTBAL-RTN.
           MOVE   '/5100-SCAN-ACTBAL-RTN/'   TO   WK-PARA.
           EXEC  SQL  FETCH  CUR_ACTBAL
                      INTO   :BAL-ORGIDT, :BAL-CUSIDT, :BAL-APCODE,
                             :BAL-CURCDE, :BAL-INTDAT, :BAL-INTBAL,
                             :BAL-DINRAT, :BAL-CINRAT, :BAL-DRATSF,
                             :BAL-CRATSF
           END-EXEC.
021112*    display 'bal1-orgidt='bal-orgidt.
021112*    display 'bal1-cusidt='bal-cusidt.
021112*    display 'bal1-apcode='bal-apcode.
021112*    display 'bal1-curcde='bal-curcde.
021112*    display 'bal1-dinrat='bal-dinrat.
021112*    display 'bal1-cinrat='bal-cinrat.
           MOVE      SQLCODE    TO     SQL-ERR-CODE
           IF NOT SQL-C-NORMAL
           THEN
             IF  SQL-C-RECORD-NOT-FOUND
             THEN
               IF OLD-ORGIDT NOT = SPACES
               THEN 
                 PERFORM 5102-COMPUTE-IRTVAL THRU 5102-EXIT 
                 PERFORM 5105-UPDATE-ACTCUT  THRU 5105-EXIT
                 PERFORM 5200-COMM-PROC      THRU 5200-EXIT
               END-IF
               MOVE     '1'                 TO      WK-END-FLAG
               GO  TO  5100-EXIT
             ELSE
               GO   TO    ERRCHK
             END-IF
           END-IF.
           PERFORM 5107-SEL-ACTCBH   THRU  5107-EXIT. 

           IF BAL-ORGIDT NOT = OLD-ORGIDT
           THEN
              IF OLD-ORGIDT NOT = SPACES
              THEN
                 PERFORM 5102-COMPUTE-IRTVAL THRU 5102-EXIT 
                 PERFORM 5105-UPDATE-ACTCUT  THRU 5105-EXIT
                 PERFORM 5200-COMM-PROC      THRU 5200-EXIT
                 MOVE  SPACES              TO      OLD-INTDAT
                 MOVE  0                   TO      OLD-INTBAL
              END-IF
              EXEC SQL SELECT UPDINT, DACINT, CACINT
                         INTO :CUT-UPDINT, :CUT-DACINT, :CUT-CACINT
                         FROM ACTCUT
                       WHERE ORGIDT = :BAL-ORGIDT
                         AND CUSIDT = :BAL-CUSIDT
                         AND APCODE = :BAL-APCODE
                         AND CURCDE = :BAL-CURCDE
                         AND RECSTS = :CNST-M-RECSTS-VALID
              END-EXEC
              MOVE      SQLCODE    TO     SQL-ERR-CODE
              IF NOT SQL-C-NORMAL
              THEN
                IF  SQL-C-RECORD-NOT-FOUND
                THEN
                  DISPLAY 'SELECT ACTCUT ERR!'
                  MOVE  '1'                 TO      WK-ERR-FLAG
                  GO    TO     5100-EXIT
                ELSE
                  GO    TO   ERRCHK
                END-IF
              END-IF
           ELSE
             IF BAL-CUSIDT NOT = OLD-CUSIDT  OR
                BAL-APCODE NOT = OLD-APCODE  OR
                BAL-CURCDE NOT = OLD-CURCDE
             THEN 
                PERFORM  5102-COMPUTE-IRTVAL THRU 5102-EXIT 
                PERFORM  5105-UPDATE-ACTCUT  THRU 5105-EXIT
                MOVE   SPACES              TO      OLD-INTDAT
                MOVE   0                   TO      OLD-INTBAL
                EXEC SQL SELECT UPDINT, DACINT, CACINT
                         INTO :CUT-UPDINT, :CUT-DACINT, :CUT-CACINT
                         FROM ACTCUT
                       WHERE ORGIDT = :BAL-ORGIDT
                         AND CUSIDT = :BAL-CUSIDT
                         AND APCODE = :BAL-APCODE