atb8999.pco

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

       IDENTIFICATION DIVISION.
       PROGRAM-ID.   ATB8999.
       AUTHOR.       YuLei.
      ****************************************************************
      *** REMARKS:                                                 ***
      *** PROGRAM NAME          : ATB8999.                         ***
      *** CALLING PROGRAM       : NOME.                            ***
      *** CALLED PROGRAM        : NONE.                            ***
      *** REPORTID              : NONE                             ***
      *** PROGRAM PURPOSE       : 利息税划转人民币                 ***
      ***  PROCESS DESCRIPTION:                                    ***
      ***    1000-PGM-INIT-RTN                                     ***
      ***    3000-FILE-RETRIEVE-RTN                                ***
      ***    5000-NORMAL-PROCESS-RTN                               ***
      ***    8000-PGM-END-RTN                                      ***
      ****************************************************************
      ***  MODIFIED BY         :Kang                               ***
      ***  DATE MODIFY         :2002/11/27                         ***
      ***  MODIFY REASON       :采用现钞买入价                     ***
      ***  MODIFY DESCRIPTION  :021127                             ***
      ****************************************************************
       ENVIRONMENT DIVISION.

       DATA DIVISION.

       WORKING-STORAGE SECTION.

       01  WK-AREA.
         05  WK-PARA                       PIC X(10) VALUE '//WK-PARA/'.
         05  WK-SQLTNAME                   PIC X(10) VALUE SPACES.
         05  WK-SQLECODE                   PIC --------9 VALUE ZERO.
       01  WK-END-FLAG                     PIC X(01) VALUE 'N'.
       01  WK-COUNT                        PIC 9(08) VALUE ZERO.
       01  TMP-N-NUMBER                    PIC S9(15) VALUE ZERO.
      **********************************************************
      ***   DEFINE  FOR  IFA                                 ***
      **********************************************************
                                           COPY  REKEXCG.
       01  RERY.                           COPY  REKRERY.
       01  APA.                            COPY  APKAPA.
       01  CNST.                           COPY  ACKCNST.
      ****************************************************************
      * 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 WK-SQL-VAL.
           EXEC SQL INCLUDE ACKCUT END-EXEC.
           EXEC SQL INCLUDE ACKACT END-EXEC.
           EXEC SQL INCLUDE ACKCXR END-EXEC.
           EXEC SQL INCLUDE ACKATR END-EXEC.
           EXEC SQL INCLUDE ACKTRF END-EXEC.
           EXEC SQL INCLUDE ACKCYT END-EXEC.
           EXEC SQL INCLUDE ACKCCY END-EXEC.
           EXEC SQL INCLUDE ACKAPC END-EXEC.
           EXEC SQL INCLUDE ACKGLC END-EXEC.
           EXEC SQL INCLUDE ACKORG END-EXEC.
           EXEC SQL INCLUDE ACKSCT END-EXEC.
           EXEC SQL INCLUDE SCKTLR END-EXEC.
           EXEC SQL INCLUDE ACKLOG END-EXEC.
         05  WK-L-ORGIDT             PIC X(4) VALUE SPACES.
         05  WK-XRTCDE               PIC X(1) VALUE SPACES.
         05  WK-XRTCDE-1             PIC X(1) VALUE SPACES.
      ****************************************************************
           EXEC SQL END DECLARE SECTION END-EXEC.
      ****************************************************************
      * SQL INCLUDE FOR SQLCA                                        *
      ****************************************************************
           EXEC SQL INCLUDE SQLCA  END-EXEC.

       PROCEDURE DIVISION.

       0000-MAIN-PROCESS-RTN.
           DISPLAY    '*** ATB8999 BEGIN ***'.
           PERFORM    1000-PGM-INIT-RTN         THRU    1000-EXIT.
           PERFORM    3000-FILE-RETRIEVE-RTN    THRU    3000-EXIT.
           PERFORM    5000-NORMAL-PROCESS-RTN   THRU    5000-EXIT.
           PERFORM    8000-PGM-END-RTN          THRU    8000-EXIT.
       0000-EXIT.
            EXIT.

       1000-PGM-INIT-RTN.
      ****************************************************************
      * CONNECT TO THE SQLDB.                                        *
      ****************************************************************
           PERFORM 9999-CONNECT.
           EXEC SQL WHENEVER SQLERROR GOTO :STOP-RUN END-EXEC.
           INITIALIZE  WK-SQL-VAL.
           MOVE       'ATB8999'                 TO      LOG-JOBNAM.
       1000-EXIT.
            EXIT.

       3000-FILE-RETRIEVE-RTN.
           MOVE  '/ 3000- /'  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 = :LOG-JOBNAM )
           END-EXEC.
           EXEC SQL SELECT  PRDCDE, EVTCDE, CTPCDE,
                            CATCDE, CURRAG, PROFLG,
                            BASRAT, APCODE, ATRNAM
                      INTO :ATR-PRDCDE, :ATR-EVTCDE, :ATR-CTPCDE,
                           :ATR-CATCDE, :ATR-CURRAG, :ATR-PROFLG,
                           :ATR-BASRAT, :ATR-APCODE, :ATR-ATRNAM
                      FROM  ACTATR
                     WHERE  ATRCDE = :CNST-M-ATRCDE-A99
                      AND   RECSTS = :CNST-M-RECSTS-VALID
           END-EXEC.
           MOVE     SQLCODE     TO      SQL-ERR-CODE.
           IF       NOT         SQL-C-NORMAL
           THEN
             MOVE   'ACTATR'    TO    WK-SQLTNAME
             GO TO STOP-RUN
           END-IF.
           EXEC SQL DECLARE CUR_AIF CURSOR FOR
                     SELECT ACTCUT.ORGIDT, ACTCUT.CUSIDT,
                            ACTCUT.APCODE, ACTCUT.CURCDE,
                            ACTCUT.ACTDEP, ACTCUT.LSTBAL
                      FROM  ACTCUT,ACTTRF,ACTCYT,TMP_ACTLOG  
                     WHERE  ACTCUT.ORGIDT = TMP_ACTLOG.ORGIDT
                       AND  ACTTRF.ATRCDE = :CNST-M-ATRCDE-A99
                       AND (ACTTRF.TRFKID = '1' AND
                            ACTCUT.ACTGLC=SUBSTR(TRFNUM,1,4)
                        OR  ACTTRF.TRFKID = '2' AND 
                            ACTCUT.ACTPLC = SUBSTR(TRFNUM,1,4)
                        OR  ACTTRF.TRFKID = '3' AND
                            ACTCUT.APCODE = SUBSTR(TRFNUM,1,4)
                        OR  ACTTRF.TRFKID = '4' AND
                            ACTCUT.CUSIDT = SUBSTR(TRFNUM,1,7)  AND
                            ACTCUT.APCODE = SUBSTR(TRFNUM,8,4)  AND
                            ACTCUT.CURCDE = SUBSTR(TRFNUM,12,3)
                        OR  ACTTRF.TRFKID = '5' AND
                            ACTCUT.APCODE = SUBSTR(TRFNUM,1,4) AND
                            ACTCYT.CYTCDE = SUBSTR(TRFNUM,5,3) AND
                            ACTCUT.CURCDE = ACTCYT.CURCDE )
                       AND  ACTCUT.CURCDE = ACTCYT.CURCDE AND
                            ACTCYT.CYTCDE = :ATR-CURRAG
                       AND  ACTCUT.LSTBAL != 0 
                       AND  ACTCUT.RECSTS = :CNST-M-RECSTS-VALID
                       AND  ACTTRF.RECSTS = :CNST-M-RECSTS-VALID
                       AND  ACTCYT.RECSTS = :CNST-M-RECSTS-VALID
                       AND  ACTCUT.ORGIDT > '0000'
                       AND  ACTCUT.CUSIDT > '0000000'
                       AND  ACTCUT.APCODE > '0000'
                       AND  ACTCUT.CURCDE > '000'
                     ORDER BY ACTCUT.ORGIDT, ACTCUT.CURCDE,
                              ACTCUT.APCODE, ACTCUT.CUSIDT
           END-EXEC.
       3000-EXIT.
            EXIT.

       5000-NORMAL-PROCESS-RTN.
           MOVE     '/ 5000- /'      TO        WK-PARA.
           EXEC  SQL  OPEN  CUR_AIF  END-EXEC.
           PERFORM  5100-PROCESS-EVERY-ORGIDT  THRU  5100-EXIT
                                 UNTIL WK-END-FLAG = 'Y'.
           IF WK-COUNT > 0
           THEN
             PERFORM  5105-PRO-END-ORG-RTN     THRU  5105-EXIT
           END-IF.
           EXEC  SQL  CLOSE  CUR_AIF  END-EXEC.
       5000-EXIT.
           EXIT.

       5100-PROCESS-EVERY-ORGIDT.
           MOVE        '/ 5100- /'          TO      WK-PARA.
           PERFORM     5101-FETCH-ACT-RTN   THRU    5101-EXIT.
           MOVE        SQLCODE              TO      SQL-ERR-CODE.
           IF  NOT SQL-C-NORMAL
           THEN
              IF SQL-C-RECORD-NOT-FOUND
              THEN
                 MOVE   'Y'   TO       WK-END-FLAG
                 GO  TO  5100-EXIT
              ELSE
                 DISPLAY 'FETCH CUROR ERROR'
                 GO  TO  STOP-RUN
              END-IF 
           ELSE
             ADD    1     TO       WK-COUNT
           END-IF.

           IF CUT-ORGIDT NOT = WK-L-ORGIDT
           THEN
             IF WK-L-ORGIDT NOT = SPACE
             THEN
               PERFORM  5105-PRO-END-ORG-RTN  THRU  5105-EXIT
             END-IF
             PERFORM    5110-SEL-SCTORG-RTN   THRU  5110-EXIT
             MOVE       CUT-ORGIDT            TO    TLR-ORGIDT
             PERFORM    5111-SEL-SCTTLR-RTN   THRU  5111-EXIT
             MOVE       CUT-ORGIDT            TO    WK-L-ORGIDT
           END-IF.
           

xiaojf     EXEC SQL SELECT  DECPOS
xiaojf                INTO  CCY-DECPOS
xiaojf                FROM  ACTCCY
xiaojf               WHERE  CURCDE = :CUT-CURCDE
xiaojf                 AND  RECSTS = :CNST-M-RECSTS-VALID
xiaojf     END-EXEC.
xiaojf     MOVE       SQLCODE                 TO    SQL-ERR-CODE.
xiaojf     IF NOT SQL-C-NORMAL
xiaojf     THEN
xiaojf        DISPLAY 'READ ACTCCY ERROR' CUT-CURCDE
xiaojf        GO  TO  STOP-RUN
xiaojf     END-IF. 
           
           
xiaojf     IF CCY-DECPOS = 0
xiaojf     THEN
xiaojf        COMPUTE    TMP-N-NUMBER ROUNDED = CUT-LSTBAL *  1
xiaojf        MOVE       TMP-N-NUMBER      TO      CUT-LSTBAL
xiaojf     END-IF.
           
xiaojf     IF CUT-LSTBAL NOT = 0
           PERFORM      5200-PRO-IFA-RTN      THRU  5200-EXIT.

       5100-EXIT.