cobsample.txt

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

      **************************************                                    
      *                                                                         
       DECLARATIVES.                                                            
           COPY PBCDCL REPLACING == :FILENAME: == BY == CVQPBKY3 ==             
                                 ==':FILENAME:'== BY =='CVQPBKY3'==.            
           COPY PBCDCL REPLACING == :FILENAME: == BY == PBFDIFF ==              
                                 ==':FILENAME:'== BY =='PBFDIFF'==.             
       END DECLARATIVES.                                                        
      *                                                                         
       A000-MAIN-PROC.                                                          
      *                                                                         
           PERFORM     A000-INITIALIZE                                          
           PERFORM     B000-MAIN-PROCESS                                        
           PERFORM     C000-WRITE-STATISTICS                                    
           PERFORM     Z100-NORMAL-END                                          
      *                                                                         
           GOBACK.                                                              
      *                                                                         
      *****************************************************************         
      *    INITIAL PROCESS ROUTINE                                    *         
      *****************************************************************         
      *                                                                         
       A000-INITIALIZE.                                                         
      *                                                                         
           INITIALIZE                            WS-FILE-STS-AREA               
                                                 WS-MESSAGE-AREA                
                                                 WS-WORKING-VAR                 
           MOVE        K-PGM-ID               TO WS-PGM-ID                      
           SET         WS-PGM-START           TO TRUE                           
           DISPLAY     WS-PGM-HEAD               WS-PGM-MSG                     
      *                                                                         
           SET         STUS-ACTION-OPEN       TO TRUE                           
           OPEN        OUTPUT                    CVQPBKY3                       
                       INPUT                     PBFDIFF                        
           .                                                                    
           EXIT.                                                                
      *                                                                         
      *****************************************************************         
      *    MAIN PROCESS ROUTINE                                       *         
      *****************************************************************         
      *                                                                         
       B000-MAIN-PROCESS.                                                       
      *                                                                         
           MOVE        SPACE                  TO DIFF-KEY                       
           PERFORM     S000-STARTBR-PBFDIFF                                     
           PERFORM     UNTIL WS-EOF-DIFF                                        
              PERFORM  S000-READNEXT-PBFDIFF                                    
              ADD      1                      TO WS-TOTAL-CNT                   
              PERFORM  B050-WRITE-CVQPBKY3-PROC                                 
           END-PERFORM                                                          
           .                                                                    
           EXIT.                                                                
      *                                                                         
      *****************************************************************         
      *    WRITE ITEM CODE TO CVQPBKY3                                *         
      *****************************************************************         
      *                                                                         
       B050-WRITE-CVQPBKY3-PROC.                                                
      *                                                                         
           MOVE        SPACE                  TO CVRIFKEY                       
           MOVE        DIFF-AP                TO IFKEY-SPD-AP                   
           MOVE        DIFF-NO                TO IFKEY-SPD-NO                   
           MOVE        DIFF-CUR               TO IFKEY-SPD-CCY                  
           PERFORM     S000-WRITE-CVQPBKY3                                      
           ADD         1                      TO WS-SUCC-CNT                    
           .                                                                    
           EXIT.                                                                
      *                                                                         
       C000-WRITE-STATISTICS.                                                   
      *                                                                         
           DISPLAY                               ' '                            
           .                                                                    
           EXIT.                                                                
      *                                                                         
      *****************************************************************         
      *    WRITE FILE CVQPBKY3 ROUTINE                                 *        
      *****************************************************************         
      *                                                                         
       S000-WRITE-CVQPBKY3.                                                     
      *                                                                         
           SET         STUS-ACTION-WRITE      TO TRUE                           
           WRITE                                 CVRIFKEY                       
           .                                                                    
           EXIT.                                                                
      *                                                                         
      *****************************************************************         
      *    START BROWSE FILE OF PBFDIFF                               *         
      *****************************************************************         
      *                                                                         
       S000-STARTBR-PBFDIFF.                                                    
      *                                                                         
           SET         STUS-ACTION-START      TO TRUE                           
           START       PBFDIFF       KEY      >= DIFF-KEY                       
              INVALID  KEY                                                      
                 SET   WS-EOF-DIFF            TO TRUE                           
           END-START                                                            
           .                                                                    
           EXIT.                                                                
      *                                                                         
      *****************************************************************         
      *    READ NEXT RECORD OF PBFDIFF                                *         
      *****************************************************************         
      *                                                                         
       S000-READNEXT-PBFDIFF.                                                   
      *                                                                         
           SET         STUS-ACTION-READ       TO TRUE                           
           READ        PBFDIFF                   NEXT RECORD                    
              AT END                                                            
                 SET   WS-EOF-DIFF            TO TRUE                           
           END-READ                                                             
           .                                                                    
           EXIT.                                                                
      *                                                                         
       Y000-DISP-STATIS.                                                        
      *                                                                         
           MOVE        WS-TOTAL-CNT           TO WS-TOTAL-READ                  
           MOVE        WS-SUCC-CNT            TO WS-SUCC-WRITE                  
           MOVE        WS-FAIL-CNT            TO WS-FAIL-WRITE                  
      *                                                                         
           DISPLAY     WS-PGM-HEAD               WS-TOTAL-ST                    
           DISPLAY     WS-PGM-HEAD               WS-SUCCESS-ST                  
           DISPLAY     WS-PGM-HEAD               WS-FAIL-ST                     
           .                                                                    
           EXIT.                                                                
      *                                                                         
       Z000-CLOSE-FILE.                                                         
      *                                                                         
           SET         STUS-ACTION-CLOSE      TO TRUE                           
           CLOSE                                 CVQPBKY3                       
                                                 PBFDIFF                        
      *                                                                         
           PERFORM     Y000-DISP-STATIS                                         
           .                                                                    
           EXIT.                                                                
      *                                                                         
      *****************************************************************         
      *    PROGRAM EXIT                                               *         
      *****************************************************************         
      *                                                                         
       Z100-NORMAL-END.                                                         
      *                                                                         
           PERFORM     Z000-CLOSE-FILE                                          
           SET         WS-NORMAL-END          TO TRUE                           
           DISPLAY     WS-PGM-HEAD               WS-PGM-MSG                     
           MOVE        K-RETURN-NORMAL        TO RETURN-CODE                    
           GOBACK                                                               
           .                                                                    
           EXIT.                                                                
      *                                                                         
       Z200-ABNORMAL-END.                                                       
      *                                                                         
           PERFORM     Z000-CLOSE-FILE                                          
           SET         WS-ABNORMAL-END        TO TRUE                           
           DISPLAY     WS-PGM-HEAD               WS-PGM-MSG                     
           MOVE        K-RETURN-ABNORMAL      TO RETURN-CODE                    
           GOBACK                                                               
           .                                                                    
           EXIT.                                                                
      *                                                                         
      *****************************************************************         
      *  SYSTEM ERROR PROCESS (PUBLIC)                                *         
      *****************************************************************         
           COPY SCSPBERR.                                                       
      *                                                                         
      **********************                                                    
      *END PROGRAM CVBPBDIF.                                                    
      **********************