cobsample.txt

用COBOL语言基于IBM大型机实现的一系列样例程序。

      *****************************************************************         
      *   PROGRAM SPECIFICATION                                       *         
      *---------------------------------------------------------------*         
      *   SYSTEM NAME   : CV                                          *         
      *   PROGRAM TYPE  : BATCH MAIN PROCESS.                         *         
      *   PROGRAM NAME  : CVBPBDIF                                    *         
      *   AUTHOR        : DEVBYJ                                      *         
      *   CREATED DATE  : 2004/02/11                                  *         
      *   LAST UPD. DATE:                                             *         
      *   VERSION NO    : 1.0.0                                       *         
      *---------------------------------------------------------------*         
      *   FUNCTIONS.... :                                             *         
      *                   GENERATE INTERFACE-CHECKING FILE:CVQPBKY3   *         
      *---------------------------------------------------------------*         
      *   MODIFICATION HISTORY                                        *         
      *---------------------------------------------------------------*         
      *    SEQ   DESCRIPTION                         BY       DATE    *         
      *    001                                                        *         
      *    002                                                        *         
      *****************************************************************         
      *                                                                         
      **************************************                                    
       IDENTIFICATION DIVISION.                                                 
      **************************************                                    
      *                                                                         
       PROGRAM-ID.    CVBPBDIF.                                                 
       AUTHOR.        DEVBYJ.                                                   
       DATE-WRITTEN.  2004/02/11.                                               
      *                                                                         
      **************************************                                    
       ENVIRONMENT    DIVISION.                                                 
      **************************************                                    
      *                                                                         
       INPUT-OUTPUT   SECTION.                                                  
      *                                                                         
       FILE-CONTROL.                                                            
      *                                                                         
           SELECT PBFDIFF         ASSIGN       TO PBFDIFF                       
                                  RECORD KEY   IS DIFF-KEY                      
                                  ORGANIZATION IS INDEXED                       
                                  ACCESS MODE  IS DYNAMIC                       
                                  FILE STATUS  IS WS-PBFDIFF-STATUS.            
      *                                                                         
           SELECT CVQPBKY3        ASSIGN       TO CVQPBKY3                      
                                  FILE STATUS  IS WS-CVQPBKY3-STATUS.           
      *                                                                         
      **************************************                                    
       DATA DIVISION.                                                           
      **************************************                                    
      *                                                                         
       FILE SECTION.                                                            
      *                                                                         
       FD PBFDIFF.                                                              
          COPY     PBRDIFF.                                                     
      *                                                                         
       FD CVQPBKY3 RECORDING MODE IS F.                                         
          COPY     CVRIFKEY.                                                    
      *                                                                         
      ********************************                                          
       WORKING-STORAGE SECTION.                                                 
      ********************************                                          
      *****************************************************************         
      *    CONSTANT DECLARATION                                       *         
      *****************************************************************         
      *                                                                         
      *****************************************************************         
      * PGM-CVBPBDIF   : PROGRAM NAME OF THIS PROGRAM                 *         
      * FILE-XXXXXXXX  : FILE NAME OF XXXXXXXX                        *         
      *****************************************************************         
      *                                                                         
       77  K-START-MESSAGE        PIC  X(15)     VALUE 'CVBPBDIF START'.        
       77  K-PGM-ID               PIC  X(08)     VALUE 'CVBPBDIF'.              
       77  PGM-SCSBWLOG           PIC  X(08)     VALUE 'SCSBWLOG'.              
       77  K-END-MESSAGE          PIC  X(14)     VALUE 'CVBPBDIF END  '.        
       77  K-APP                  PIC  X(02)     VALUE 'PB'.                    
       77  K-RETURN-NORMAL        PIC  X(02)     VALUE '00'.                    
       77  K-RETURN-ABNORMAL      PIC  X(02)     VALUE '08'.                    
      *                                                                         
      *************************                                                 
      *  FILE STATUS          *                                                 
      *************************                                                 
      *                                                                         
       01 WS-FILE-STS-AREA.                                                     
          03 WS-CVQPBKY3-STATUS   PIC  9(02)     VALUE 00.                      
             88 WS-CVQPBKY3-SUCCESSFUL           VALUE 00.                      
             88 WS-CVQPBKY3-ACCEPTABLE           VALUE 00.                      
          03 WS-PBFDIFF-STATUS    PIC  9(02)     VALUE 00.                      
             88 WS-PBFDIFF-SUCCESSFUL            VALUE 00.                      
             88 WS-PBFDIFF-EOF                   VALUE 10.                      
             88 WS-PBFDIFF-ACCEPTABLE            VALUE 00 10.                   
      *                                                                         
      *****************************************************************         
      *    WORKING VARIABLIES                                         *         
      *****************************************************************         
      *                                                                         
      *****************************************************************         
      * WS-VARIABLIES  : WORKING VARIABLIES FOR THIS BATCH PROGRAM    *         
      * WS-FILE-END    : FILES END FLAG                               *         
      * WS-FILE-STS    : OPERATE ON FILES STATUS                      *         
      * WS-SQLCODE     : RETURN CODE OF DB2 VARIABLE                  *         
      * WS-TOT         : TOTLE OF AMOUNT VARIABLE                     *         
      * WS-AMT         : AMOUNT VARIABLE                              *         
      *****************************************************************         
      *                                                                         
       01  WS-WORKING-VAR.                                                      
           03 WS-RC               PIC -Z(10).                                   
           03 WS-TOTAL-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-CON-FLG          PIC  X(01)     VALUE SPACE.                   
              88 WS-EOF-DIFF                     VALUE 'Y'.                     
      *                                                                         
      ***************************                                               
      *  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 PBFDIFF  READ   :'.             
                 07 WS-TOTAL-READ PIC  ZZZZZZ9.                                 
              05 WS-SUCCESS-ST.                                                 
                 07 FILLER        PIC  X(25)                                    
                                  VALUE 'NO. OF CVQPBKY3 WRITE  :'.             
                 07 WS-SUCC-WRITE PIC  ZZZZZZ9.                                 
              05 WS-FAIL-ST.                                                    
                 07 FILLER        PIC  X(25)                                    
                                  VALUE 'NO. OF CVQPBKY3 FAIL   :'.             
                 07 WS-FAIL-WRITE PIC  ZZZZZZ9.                                 
      *                                                                         
      *****************************************************************         
      *    COMMUNICATION AREA                                         *         
      *****************************************************************         
      *                                                                         
      *****************************************************************         
      * SCCBERR      : COMM AREA FOR PUBLIC ERROR PROCESS(SCSAIERR)   *         
      * SCCFSTS      : FILE STATUS VALUE DESCRIPTION                  *         
      * SCCBLOG      : FILE OF SYSTEM BATCH LOG                       *         
      *****************************************************************         
      *                                                                         
           COPY PBCSTUS.                                                        
           COPY SCCBERR.                                                        
           COPY SCCFSTS.                                                        
           COPY SCCBLOG.                                                        
      *                                                                         
      ***********************************                                       
      *    DB2 VARIABLES                *                                       
      ***********************************                                       
      *                                                                         
      **************************************                                    
       PROCEDURE DIVISION.