pbsbckcd

用COBOL基于IBM大型机操作DB2及CICS的样例。

      *****************************************************************         
      *   PROGRAM SPECIFICATION                                       *         
      *---------------------------------------------------------------*         
      *   SYSTEM NAME   : PB                                          *         
      *   PROGRAM TYPE  : SUB PROGRAM (BATCH)                         *         
      *   PROGRAM NAME  : PBSBCKCD                                    *         
      *   AUTHOR  ....  : DEVLXU                                      *         
      *   CREATED DATE  : 2003/08/05                                  *         
      *   LAST UPD. DATE:                                             *         
      *   VERSION NO..  : 4.0.0                                       *         
      *---------------------------------------------------------------*         
      *   FUNCTIONS...  :COMMON ROUTINE FOR GET PUBLIC CODE           *         
      *---------------------------------------------------------------*         
      *   MODIFICATION HISTORY                                        *         
      *---------------------------------------------------------------*         
      *    SEQ   DESCRIPTION                         BY       DATE    *         
      *    001                                                        *         
      *    002                                                        *         
      *****************************************************************         
      *                                                                         
      *****************************************************************         
       IDENTIFICATION DIVISION.                                                 
      *****************************************************************         
      *                                                                         
       PROGRAM-ID.   PBSBCKCD.                                                  
       AUTHOR.       DEVLXU.                                                    
       DATE-WRITTEN. 2003/08/05.                                                
      *                                                                         
      *****************************************************************         
       ENVIRONMENT DIVISION.                                                    
      *****************************************************************         
      *************************                                                 
       CONFIGURATION SECTION.                                                   
      *************************                                                 
      *                                                                         
       INPUT-OUTPUT   SECTION.                                                  
      *                                                                         
       FILE-CONTROL.                                                            
           SELECT PBFCODE         ASSIGN         TO PBFCODE                     
                                  RECORD KEY     IS CODE-KEY                    
                                  ORGANIZATION   IS INDEXED                     
                                  ACCESS MODE    IS RANDOM                      
                                  FILE STATUS    IS WS-CODE-STS.                
      *                                                                         
      *****************************************************************         
       DATA DIVISION.                                                           
      *****************************************************************         
      *                                                                         
       FILE SECTION.                                                            
       FD  PBFCODE.
       01  pbrcode.
         03 code-key              pic x(20).
         03 code-content          pic x(100).
                                                      
      *                                                                         
      *                                                                         
       WORKING-STORAGE SECTION.                                                 
      *                                                                         
      *****************************************************************         
      *    CONSTANT DECLARATION                                       *         
      *****************************************************************         
      *****************************************************************         
      *    PGM-PBSBCKCD         : SUBPROGRAM FOR THIS PRG.            *         
      *    PGM-SCSBWLOG         : SUBPROGRAM FOR GET SCFJPRM INFO.    *         
      *    FILE-PBFCODE         : FILE NAME OF PBFCODE                *         
      *    K-6069               : CODE CONSTANT OF 6069               *         
      *    K-6070               : CODE CONSTANT OF 6070               *         
      *    K-MMO                : PB APPLICATION CONSTANT             *         
      *                                                                         
      *****************************************************************         
       77  PGM-PBSBCKCD           PIC X(08)      VALUE 'PBSBCKCD'.              
       77  PGM-SCSBWLOG           PIC X(08)      VALUE 'SCSBWLOG'.              
       77  FILE-PBFCODE           PIC X(08)      VALUE 'PBFCODE '.              
       77  K-6069                 PIC X(04)      VALUE '6069'.          00100014
       77  K-6070                 PIC X(04)      VALUE '6070'.          00100014
       77  K-MMO                  PIC X(02)      VALUE 'PB'.            00100014
      *                                                                         
      *****************************************************************         
      *    PROGRAM VARIABLES                                          *         
      *****************************************************************         
      *                                                                         
       01  WS-VARIABLIES.                                                       
           03 WS-FILE-STS.                                                      
              05 WS-CODE-STS      PIC 9(02)      VALUE 00.              00090014
           03 WS-TEMP-VARIABLE.                                                 
              05 WS-FLAG          PIC X          VALUE SPACE.           00090014
      *                                                                         
      *****************************************************************         
      *    CONDITION FLAG                                             *         
      *****************************************************************         
      *                                                                         
      *    NULL.                                                                
      *                                                                         
      *****************************                                             
      *    RECORD LAYOUT          *                                             
      *****************************                                             
      *                                                                         
      *                                                                         
      *****************************                                             
      *    ERROR MESSAGE          *                                             
      *****************************                                             
      *                                                                         
      *                                                                         
      *****************************************************************         
      *    COMMUNICATION AREA                                         *         
      *****************************************************************         
      *                                                                         
           COPY SCCBERR.                                                        
           COPY SCCFSTS.                                                        
           COPY SCCBLOG.                                                        
      *    COPY PBCOCKCD.                                                       
      *                                                                         
      ***********************************                                       
      *    DB2 VARIABLES                *                                       
      ***********************************                                       
      *                                                                         
      *    NULL                                                                 
      *                                                                         
      ***********************************                                       
      *    DB2 RESPONSE CODE            *                                       
      ***********************************                                       
      *                                                                         
      *    NULL                                                                 
      *