bcb8564.pco

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

       IDENTIFICATION  DIVISION.
       PROGRAM-ID.     BCB8564.
       AUTHOR.         WHQ.
       DATE-WRITTEN.   2001/11/09.
       DATE-COMPILED.  2001/11/09.
      ******************************************************************
      *   REMARKS:          : STAMENT PROC IN SEPCIAL DATE(END OF YEAR,*
      *                     : MONTH, TENDAY, WEEK ETC)                 *
      *   PROGRAM  NAME:    : BCB8564                                  *
      *   COMMON  DATA AREA :                                          *
      *   PROGRAM PURPOSE :                                            *
      *   PROCESS DESCRIPTION:                                         *
      *           1000-PRM-INIT-RTN                                    *
      *           3000-FILE-RETRIEVE-RTN                               *
      *           5000-NORMAL-PROCESS-RTN                              *
      *           ...                                                  *
      *           8000-PGM-END-RTN                                     *
      ******************************************************************
      ***  MODIFIED BY: zhaoxz                                       ***
      ***  DATE MODIFY: 2002-06-28                                   ***
      ***  MODIFY REASON: 半年、年底没有采用决算牌价                 ***
      ***  MODIFY DESCRIPTION  : 020628                              ***
      ******************************************************************
      ***  MODIFIED BY: LiuXiaoShi                                   ***
      ***  DATE MODIFY: 2003-05-28                                   ***
      ***  MODIFY REASON: 解决程序运行太慢                           ***
      ***  MODIFY DESCRIPTION  : 030528                              ***
      ******************************************************************


       ENVIRONMENT DIVISION.
       INPUT-OUTPUT SECTION.
       DATA DIVISION.
      **********************************************************
      *** FOLLOWING SECTION IS ONLY FOR BATCH OUTPUT FILE    ***
      **********************************************************
       WORKING-STORAGE SECTION.
       01  WK-END-FLAG           PIC X(1)  VALUE '0'.
       01  WK-END-FLAG1          PIC X(1)  VALUE '0'.
       01  WK-X-PARA             PIC X(40) VALUE SPACES.

      *--------------------------------------------------------------*
      * SQL/DS HOST VARIABLE DECLARATION                             *
      *--------------------------------------------------------------*
           EXEC   SQL   BEGIN    DECLARE  SECTION END-EXEC.
           EXEC   SQL   INCLUDE  SQLCOM           END-EXEC.
           EXEC   SQL   INCLUDE  ACKSQST          END-EXEC.
           01  TMP-RECTYP        PIC X(1)  VALUE SPACES.
020628     01 TMP1-XRTCDE        PIC X(1) VALUE SPACES.
020628     01 TMP2-XRTCDE        PIC X(1) VALUE SPACES.
           01  WK-CNT-APC        PIC S9(7) COMP-3 VALUE 0.
           01 WK-M-VAL-SQL.
           EXEC   SQL   INCLUDE  ACKSCT           END-EXEC.
           EXEC   SQL   INCLUDE  ACKCAP           END-EXEC.
           EXEC   SQL   INCLUDE  ACKAPC           END-EXEC.
           EXEC   SQL   INCLUDE  ACKCXR           END-EXEC.
           EXEC   SQL   END      DECLARE SECTION   END-EXEC.
      *--------------------------------------------------------------*
      * SQL INCLUDE FOR SQLCA                                        *
      *--------------------------------------------------------------*
           EXEC   SQL   INCLUDE SQLCA  END-EXEC.

       PROCEDURE DIVISION.
      *--------------------------------------------------------------*
       0000-MAIN-PROCESS-RTN.
      *--------------------------------------------------------------*
           DISPLAY     'BCB8564  BEGIN'.

           PERFORM     1000-TXN-INIT-RTN           THRU  1000-EXIT.
           PERFORM     3000-FILE-RETRIEVE-RTN      THRU  3000-EXIT.
      *    PERFORM     5000-NORMAL-PROCESS-RTN     THRU  5000-EXIT.
           PERFORM     8000-TXN-END-RTN            THRU  8000-EXIT.

           DISPLAY     'BCB8564  END'.
       0000-EXIT.
           STOP RUN.


      *--------------------------------------------------------------*
       1000-TXN-INIT-RTN.
      *--------------------------------------------------------------*
           MOVE       '1000-TXN-INIT-RTN'      TO        WK-X-PARA.
           DISPLAY    WK-X-PARA.

           EXEC  SQL  INCLUDE APS999  END-EXEC.
      *    EXEC  SQL  WHENEVER SQLERROR   GOTO :ERRCHK       END-EXEC.
      *    EXEC  SQL  WHENEVER SQLWARNING GOTO :ERRCHK       END-EXEC.
       1000-EXIT.
           EXIT.


      *--------------------------------------------------------------*
       3000-FILE-RETRIEVE-RTN.
      *--------------------------------------------------------------*
           MOVE       '3000-FILE-RETRIEVE-RTN'   TO        WK-X-PARA.
           DISPLAY    WK-X-PARA.

      * 清TMPCAP中的外币折美圆、折人民币数据

020628*    EXEC SQL DELETE FROM TMPCAP
   .  *             WHERE RECSTS = :CNST-M-RECSTS-VALID
   .  *               AND (RECTYP = :CNST-M-RECTYP-F
   .  *                 OR RECTYP = :CNST-M-RECTYP-G
   .  *                 OR RECTYP = :CNST-M-RECTYP-I
   .  *                 OR RECTYP = :CNST-M-RECTYP-K
   .  *                 OR RECTYP = :CNST-M-RECTYP-D
   .  *                 OR RECTYP = :CNST-M-RECTYP-M
   .  *                 OR RECTYP = :CNST-M-RECTYP-S
   .  *                 OR RECTYP = :CNST-M-RECTYP-Y )
020628*    END-EXEC.
020628     EXEC SQL TRUNCATE TABLE TMPCAP   END-EXEC.

           EXEC SQL  SELECT  MONMAK,      QTRMAK,      HYRMAK,
                             YERMAK,      CRNDAT,      PREMAK
                       INTO  :SCT-MONMAK, :SCT-QTRMAK, :SCT-HYRMAK,
                             :SCT-YERMAK, :SCT-CRNDAT, :SCT-PREMAK
                       FROM  ACTSCT
                      WHERE  SCTNUM = :CNST-M-SCTNUM-NORMAL
           END-EXEC.

      *--------------------------------------------------------------*
      *    SKIP PROC IF NOT SPECIAL DATE                             *
      *--------------------------------------------------------------*

           MOVE    SCT-CRNDAT    TO    CAP-CREDAT.
           MOVE    SCT-CRNDAT    TO    CAP-GLDATE.

020628*    PERFORM  5010-SELECT-001    THRU    5010-EXIT.
   .  *    PERFORM  5100-PROCES-RTN    THRU    5100-EXIT.
   .  *    IF SCT-MONMAK = 'Y'
   .  *     OR SCT-QTRMAK = 'Y'
   .  *     OR SCT-HYRMAK = 'Y'
   .  *     OR SCT-YERMAK = 'Y'
   .  *     OR SCT-PREMAK = 'Y'
   .  *    THEN
   .  *      PERFORM  5500-PROCES-MON    THRU    5500-EXIT
   .  *      PERFORM  5600-PROCES-QTR    THRU    5600-EXIT
   .  *      PERFORM  5700-PROCES-HYR    THRU    5700-EXIT
   .  *      PERFORM  5800-PROCES-YER    THRU    5800-EXIT
020628*    END-IF.

           EXEC SQL DECLARE CUR_CAP001 CURSOR FOR
                SELECT ORGIDT, APCODE, CURCDE,
                       RECTYP, GLDATE, DRAMNT,
                       CRAMNT, DRCUNT, CRCUNT,
                       DRBALA, CRBALA, DAVBAL,
                       CAVBAL, DLSBAL, CLSBAL,
                       RECSTS
                  FROM ACTCAP
                 WHERE RECSTS = :CNST-M-RECSTS-VALID
                   AND CURCDE = :CNST-M-CURCDE-001
020628*       ORDER BY ORGIDT, APCODE, RECTYP
           END-EXEC.

           EXEC SQL DECLARE CUR_TMPCAP CURSOR FOR
                SELECT ACTCAP.ORGIDT, ACTCAP.APCODE,
                       SUM(ACTCAP.DRAMNT * ACTCXR.CURRAT),
                       SUM(ACTCAP.CRAMNT * ACTCXR.CURRAT),
                       SUM(ACTCAP.DRCUNT),
                       SUM(ACTCAP.CRCUNT),
                       SUM(ACTCAP.DRBALA * ACTCXR.CURRAT),
                       SUM(ACTCAP.CRBALA * ACTCXR.CURRAT),
                       SUM(ACTCAP.DAVBAL * ACTCXR.CURRAT),
                       SUM(ACTCAP.CAVBAL * ACTCXR.CURRAT),
                       SUM(ACTCAP.DLSBAL * ACTCXR.CURRAT),
                       SUM(ACTCAP.CLSBAL * ACTCXR.CURRAT)
                  FROM ACTCAP, ACTAPC, ACTCXR
                 WHERE ACTCAP.APCODE = ACTAPC.APCODE
                 AND ACTCAP.RECTYP = :TMP-RECTYP
                 AND ACTCAP.CURCDE = ACTCXR.CURCDE
                 AND ACTCXR.SECCCY = :CNST-M-CURCDE-001
020628*          AND ((ACTCXR.XRTCDE = :CNST-M-XRTCDE-4
020628           AND ((ACTCXR.XRTCDE = :TMP1-XRTCDE
                   AND ACTCXR.CURCDE NOT IN ('013','014','027','038'))
020628*           OR (ACTCXR.XRTCDE = :CNST-M-XRTCDE-8
020628            OR (ACTCXR.XRTCDE = :TMP2-XRTCDE
                   AND ACTCXR.CURCDE IN ('013','014','027','038')))
                 AND ACTCAP.RECSTS = :CNST-M-RECSTS-VALID
                 AND ACTAPC.RECSTS = :CNST-M-RECSTS-VALID
              GROUP BY ACTCAP.ORGIDT, ACTCAP.APCODE
020628*       ORDER BY ACTCAP.ORGIDT, ACTCAP.APCODE
           END-EXEC.

020628     IF SCT-HYRMAK = 'Y' OR SCT-YERMAK = 'Y'
   .       THEN
   .         MOVE  CNST-M-XRTCDE-6     TO    TMP1-XRTCDE
   .         MOVE  CNST-M-XRTCDE-6     TO    TMP2-XRTCDE
   .       ELSE
   .         MOVE  CNST-M-XRTCDE-4     TO    TMP1-XRTCDE
   .         MOVE  CNST-M-XRTCDE-8     TO    TMP2-XRTCDE
   .       END-IF.

020628     PERFORM  5010-SELECT-001    THRU    5010-EXIT.
   .       PERFORM  5100-PROCES-RTN    THRU    5100-EXIT.
   .       IF SCT-MONMAK = 'Y'
   .        OR SCT-QTRMAK = 'Y'
   .        OR SCT-HYRMAK = 'Y'
   .        OR SCT-YERMAK = 'Y'
   .        OR SCT-PREMAK = 'Y'
   .       THEN
   .         PERFORM  5500-PROCES-MON    THRU    5500-EXIT
   .         PERFORM  5800-PROCES-YER    THRU    5800-EXIT
020628     END-IF.

       3000-EXIT.
           EXIT.

      *--------------------------------------------------------------*
       5000-NORMAL-PROCESS-RTN.
      *--------------------------------------------------------------*
           MOVE       '5000-RTN'               TO        WK-X-PARA.
           DISPLAY    WK-X-PARA.

       5000-EXIT.
           EXIT.


       5010-SELECT-001.
           MOVE       '5010-SELECT-001'    TO        WK-X-PARA.
           DISPLAY    WK-X-PARA.

030528     EXEC SQL  DROP TABLE TMP_COUNTCUT    END-EXEC.
030528     EXEC SQL  CREATE TABLE TMP_COUNTCUT
030528          AS   SELECT  ORGIDT,'001' CURCDE,
030528                       APCODE,COUNT(*) COUNT
030528                 FROM  ACTCUT
030528                 WHERE RECSTS = '1'
030528                  AND  CURCDE = '001'
030528                 GROUP BY ORGIDT,APCODE
030528     END-EXEC.
030528     EXEC SQL  CREATE UNIQUE INDEX TMP_COUNTCUT_PK
030528                  ON  TMP_COUNTCUT(ORGIDT,CURCDE,APCODE)
030528     END-EXEC.

           MOVE    '0'      TO    WK-END-FLAG.

           EXEC SQL OPEN CUR_CAP001 END-EXEC.

           PERFORM  5050-FETCH-CAP001    THRU    5050-EXIT
                    UNTIL WK-END-FLAG = '1'.

           EXEC SQL CLOSE CUR_CAP001 END-EXEC.

       5010-EXIT.
           EXIT.

       5050-FETCH-CAP001.
           MOVE       '5050-FETCH-CAP001'    TO     WK-X-PARA.
           DISPLAY    WK-X-PARA.

           EXEC SQL FETCH CUR_CAP001
                     INTO :CAP-ORGIDT, :CAP-APCODE, :CAP-CURCDE,
                          :CAP-RECTYP, :CAP-GLDATE, :CAP-DRAMNT,
                          :CAP-CRAMNT, :CAP-DRCUNT, :CAP-CRCUNT,
                          :CAP-DRBALA, :CAP-CRBALA, :CAP-DAVBAL,
                          :CAP-CAVBAL, :CAP-DLSBAL, :CAP-CLSBAL,
                          :CAP-RECSTS
           END-EXEC.

           MOVE    SQLCODE    TO    SQL-ERR-CODE.

           IF NOT SQL-C-NORMAL
           THEN
             IF SQL-C-RECORD-NOT-FOUND
             THEN
               MOVE    '1'      TO    WK-END-FLAG
               GO TO 5050-EXIT
             ELSE
               DISPLAY 'FETCH CAP001 ERR:'SQLCODE
               GO TO ERRCHK
             END-IF
           END-IF.

           PERFORM  5960-COUNT-APC    THRU    5960-EXIT.

           PERFORM  6000-INSERT-CAP    THRU    6000-EXIT.

       5050-EXIT.
           EXIT.

       5100-PROCES-RTN.
           MOVE       '5100-PROCES-RTN'    TO        WK-X-PARA.
           DISPLAY    WK-X-PARA.

030528     EXEC SQL  DROP TABLE TMP_COUNTCUT    END-EXEC.
030528     EXEC SQL  CREATE TABLE TMP_COUNTCUT
030528          AS   SELECT  ORGIDT,'000' CURCDE,
030528                       APCODE,COUNT(*) COUNT
030528                 FROM  ACTCUT
030528                 WHERE RECSTS = '1'
030528                 GROUP BY ORGIDT,APCODE
030528     END-EXEC.
030528     EXEC SQL  CREATE UNIQUE INDEX TMP_COUNTCUT_PK
030528                  ON  TMP_COUNTCUT(ORGIDT,CURCDE,APCODE)
030528     END-EXEC.

           MOVE    '0'           TO    WK-END-FLAG1.

           MOVE    'D'           TO    TMP-RECTYP.

           MOVE    'F'           TO    CAP-RECTYP.
           MOVE    CNST-M-RECSTS-VALID    TO    CAP-RECSTS.

*****************************************************
********各货币折人民币                              *
*****************************************************

           MOVE    CNST-M-CURCDE-001      TO    CAP-CURCDE.

           EXEC SQL OPEN CUR_TMPCAP END-EXEC.

           PERFORM  5120-FETCH-CURSOR    THRU    5120-EXIT
                    UNTIL WK-END-FLAG1 = '1'.

           EXEC SQL CLOSE CUR_TMPCAP END-EXEC.

       5100-EXIT.
           EXIT.

       5120-FETCH-CURSOR.
           MOVE       '5120-FETCH-CURSOR'  TO        WK-X-PARA.
           DISPLAY    WK-X-PARA.

           PERFORM  5910-FETCH-CAP   THRU    5910-EXIT.

           MOVE    SQLCODE    TO    SQL-ERR-CODE.

           IF NOT SQL-C-NORMAL
           THEN
             IF SQL-C-RECORD-NOT-FOUND
             THEN
               MOVE    '1'      TO    WK-END-FLAG1
               GO TO 5120-EXIT
             ELSE
               DISPLAY '5120SQLCODE:',SQLCODE
               GO TO ERRCHK
             END-IF
           END-IF.

           PERFORM  5950-COUNT-APC     THRU    5950-EXIT.

           PERFORM  6000-INSERT-CAP    THRU    6000-EXIT.

       5120-EXIT.
           EXIT.

       5500-PROCES-MON.
           MOVE       '5500-PROCES-MON'    TO        WK-X-PARA.
           DISPLAY    WK-X-PARA.

           MOVE    '0'           TO    WK-END-FLAG1.

           MOVE    'M'           TO    TMP-RECTYP.

           MOVE    'G'           TO    CAP-RECTYP.
           MOVE    CNST-M-RECSTS-VALID    TO    CAP-RECSTS.

*****************************************************
********汇总折人民币                                *
*****************************************************

           MOVE    CNST-M-CURCDE-001      TO    CAP-CURCDE.

           EXEC SQL OPEN CUR_TMPCAP END-EXEC.

           PERFORM  5520-FETCH-CURSOR    THRU    5520-EXIT
                    UNTIL WK-END-FLAG1 = '1'.

           EXEC SQL CLOSE CUR_TMPCAP END-EXEC.