API tools faq
paste
Guest User

Untitled

a guest
Sep 16th, 2018
169
0
Never
Add comment
Not a member of Pastebin yet? Sign Up, it unlocks many cool features!
COBOL 10.39 KB | None | 0 0
raw download clone embed print report
  1.       ***********************************************************************
  2.       *-----I D E N T I F I C A T I O N   D I V I S I O N-------------------*
  3.       ***********************************************************************
  4.        IDENTIFICATION DIVISION.
  5.        PROGRAM-ID. CBLHO4JN.
  6.        AUTHOR. Jan Noel Calayag.
  7.  
  8.       ***********************************************************************
  9.       *-----E N V I R O M E N T   D I V I S I O N---------------------------*
  10.       ***********************************************************************
  11.        ENVIRONMENT DIVISION.
  12.        INPUT-OUTPUT SECTION.
  13.        FILE-CONTROL.
  14.        
  15.              SELECT PRINT-WORK-FILE
  16.                ASSIGN TO WORK01
  17.                ORGANIZATION IS SEQUENTIAL.
  18.        
  19.              SELECT DIVSYS-WORK-FILE
  20.                ASSIGN TO WORK02
  21.                ORGANIZATION IS SEQUENTIAL.
  22.  
  23.              SELECT PRINT-SORTED-FILE
  24.                ASSIGN TO SORTED01
  25.                ORGANIZATION IS SEQUENTIAL
  26.                FILE STATUS IS FS-PRINT-FILE.
  27.  
  28.              SELECT DIVSYS-SORTED-FILE
  29.                ASSIGN TO SORTED02
  30.                ORGANIZATION IS SEQUENTIAL
  31.                FILE STATUS IS FS-DIVSYS-FILE.
  32.  
  33.              SELECT PRINT-FILE
  34.                ASSIGN TO PTCHO4I1
  35.                ORGANIZATION IS SEQUENTIAL
  36.                FILE STATUS IS FS-PRINT-FILE.
  37.  
  38.              SELECT DIVSYS-FILE
  39.                ASSIGN TO PTCHO4I2
  40.                ORGANIZATION IS SEQUENTIAL
  41.                FILE STATUS IS FS-DIVSYS-FILE.
  42.                
  43.              SELECT PROV-FUND-SLIP
  44.                ASSIGN TO PTCHO3O1
  45.                ORGANIZATION IS SEQUENTIAL.
  46.                
  47.       ***********************************************************************
  48.       *-----D A T A   D I V I S I O N---------------------------------------*
  49.       ***********************************************************************
  50.        DATA DIVISION.
  51.       * ********************************************************************
  52.       *  *                    F I L E   S E C T I O N                      *
  53.       * ********************************************************************
  54.        FILE SECTION.
  55.       *    *****************************************************************
  56.       *   *    SORT WORK FILES                                           *
  57.       *    *****************************************************************
  58.        SD    PRINT-WORK-FILE.                    
  59.        01 PRINT-WORK-REC.
  60.           05 WF-PRINT-TYPE             PIC X(01).
  61.           05 WF-PRINT-EMPNO            PIC X(06).  
  62.           05 WF-PRINT-DATE             PIC X(06).
  63.           05 FILLER                    PIC X(01).
  64.           05 WF-PRINT-EE-CONTR         PIC 9(08)V99.
  65.           05 WF-PRINT-ER-CONTR         PIC 9(08)V99.
  66.           05 WF-PRINT-EE-EARNG         PIC 9(08)V99.
  67.           05 WF-PRINT-ER-EARNG         PIC 9(08)V99.
  68.        
  69.        SD    DIVSYS-WORK-FILE.
  70.        01 DIVSYS-WORK-REC.
  71.           05 WF-DIVSYS-PREFIX          PIC X(03).
  72.           05 WF-DIVSYS-CODE            PIC X(03).
  73.          
  74.       *    *****************************************************************
  75.       *   *    SORTED FILES                                              *
  76.       *    *****************************************************************
  77.        FD    PRINT-SORTED-FILE
  78.              RECORD CONTAINS  54 CHARACTERS
  79.              LABEL RECORDS ARE STANDARD
  80.              DATA RECORD IS PRINT-SORTED-REC.      
  81.        01 PRINT-SORTED-REC.
  82.           05 SF-PRINT-TYPE             PIC X(01).
  83.           05 SF-PRINT-EMPNO            PIC X(06).  
  84.           05 SF-PRINT-DATE             PIC X(06).
  85.           05 FILLER                    PIC X(01).
  86.           05 SF-PRINT-EE-CONTR         PIC 9(08)V99.
  87.           05 SF-PRINT-ER-CONTR         PIC 9(08)V99.
  88.           05 SF-PRINT-EE-EARNG         PIC 9(08)V99.
  89.           05 SF-PRINT-ER-EARNG         PIC 9(08)V99.
  90.        
  91.        FD    DIVSYS-SORTED-FILE
  92.              RECORD CONTAINS   6 CHARACTERS
  93.              LABEL RECORDS ARE STANDARD
  94.              DATA RECORD IS DIVSYS-SORTED-REC.
  95.        01 DIVSYS-SORTED-REC.
  96.           05 SF-DIVSYS-PREFIX          PIC X(03).
  97.           05 SF-DIVSYS-CODE            PIC X(03).
  98.          
  99.       *    *****************************************************************
  100.       *   *    INPUT FILES                                               *
  101.       *    *****************************************************************
  102.        FD    PRINT-FILE.                    
  103.        01 PRINT-REC                    PIC X(54).
  104.        
  105.        FD    DIVSYS-FILE.
  106.        01 DIVSYS-REC.                  PIC X(06).
  107.        
  108.       *    *****************************************************************
  109.       *   *    OUTPUT FILES                                              *
  110.       *    *****************************************************************
  111.        FD    PROV-FUND-SLIP
  112.              RECORD CONTAINS 132 CHARACTERS
  113.              LABEL RECORDS ARE STANDARD
  114.              DATA RECORD IS PROV-FUND-REC.
  115.        01 PROV-FUND-REC                PIC X(132).
  116.        
  117.       * ********************************************************************
  118.       *  *         W O R K I N G   S T O R A G E   S E C T I O N           *
  119.       * ********************************************************************
  120.        WORKING-STORAGE SECTION.
  121.       *    *****************************************************************
  122.       *   *    DIVISION SYSTEM TABLE                                     *
  123.       *    *****************************************************************
  124.        01 WS-TBL-DIVSYS.
  125.           05 TBL-DIVSYS-REC OCCURS 999 TIMES
  126.                             INDEXED BY TBL-DIVSYS-INDEX.
  127.              10 TBL-DIVSYS-PREFIX      PIC X(03).
  128.              10 TBL-DIVSYS-CODE        PIC X(03).
  129.              
  130.       *    *****************************************************************
  131.       *   *    BUFFER TABLE                                              *
  132.       *    *****************************************************************
  133.        01 WS-TBL-BUFF.
  134.           05 TBL-BUFF-REC OCCURS 2 TIMES.
  135.              10 TBL-BUFF-B.
  136.                 15 TBL-BUFF-B-EE-EARNG PIC 9(08)V99 VALUE ZERO.
  137.                 15 TBL-BUFF-B-ER-EARNG PIC 9(08)V99 VALUE ZERO.
  138.                 15 TBL-BUFF-B-EE-CONTR PIC 9(08)V99 VALUE ZERO.
  139.                 15 TBL-BUFF-B-ER-CONTR PIC 9(08)V99 VALUE ZERO.
  140.              10 TBL-BUFF-D OCCURS 12 TIMES
  141.                            INDEXED BY TBL-BUFF-D-INDEX.
  142.                 15 TBL-BUFF-D-DATE.
  143.                    20 TBL-BUFF-D-CC    PIC X(02)    VALUE SPACES.
  144.                    20 TBL-BUFF-D-YY    PIC X(02)    VALUE SPACES.
  145.                    20 TBL-BUFF-D-DD    PIC X(02)    VALUE SPACES.
  146.                 15 TBL-BUFF-B-EE-EARNG PIC X(10)    VALUE SPACES.
  147.                 15 TBL-BUFF-B-EE-EARN9 REDEFINES TBL-BUFF-B-EE-EARNG
  148.                                        PIC 9(08)V99.
  149.                 15 TBL-BUFF-B-ER-EARNG PIC X(10)    VALUE SPACES.
  150.                 15 TBL-BUFF-B-ER-EARN9 REDEFINES TBL-BUFF-B-ER-EARNG
  151.                                        PIC 9(08)V99.
  152.                 15 TBL-BUFF-B-EE-CONTR PIC X(10)    VALUE SPACES.
  153.                 15 TBL-BUFF-B-EE-CONT9 REDEFINES TBL-BUFF-B-EE-CONTR
  154.                                        PIC 9(08)V99.
  155.                 15 TBL-BUFF-B-ER-CONTR PIC X(10)    VALUE SPACES.
  156.                 15 TBL-BUFF-B-ER-CONT9 REDEFINES TBL-BUFF-B-ER-CONTR
  157.                                        PIC 9(08)V99.
  158.              10 TBL-BUFF-E.
  159.                 15 TBL-BUFF-B-EE-EARNG PIC 9(08)V99 VALUE ZERO.
  160.                 15 TBL-BUFF-B-ER-EARNG PIC 9(08)V99 VALUE ZERO.
  161.                 15 TBL-BUFF-B-EE-CONTR PIC 9(08)V99 VALUE ZERO.
  162.                 15 TBL-BUFF-B-ER-CONTR PIC 9(08)V99 VALUE ZERO.
  163.        
  164.       *    *****************************************************************
  165.       *   *    PROVIDENT FUND SLIP                                       *
  166.       *    *****************************************************************
  167.        01 RP-PROV-FUND-SLIP            PIC X(132).
  168.        
  169.        01 RP-RECORD.
  170.           05 RP-HEADER01 OCCURS 2 TIMES.
  171.              10 FILLER                 PIC X(03)    VALUE 'DIV'.
  172.              10 FILLER                 PIC X(01)    VALUE SPACES.
  173.              10 FILLER                 PIC X(01)    VALUE ':'.
  174.              10 FILLER                 PIC X(01)    VALUE SPACES.
  175.              10 RP-DIV                 PIC X(03)    VALUE SPACES.
  176.              10 FILLER                 PIC X(56)
  177.           05  
  178.        
  179.       ***********************************************************************
  180.       *-----P R O C E D U R E   D I V I S I O N-----------------------------*
  181.       ***********************************************************************
  182.        PROCEDURE DIVISION.
  183.       * ********************************************************************
  184.       *  *       0XXX - MAIN PROGRAM                                       *
  185.       * ********************************************************************
  186.       *    *****************************************************************
  187.       *   *    0100 - MAIN                                               *
  188.       *    *****************************************************************
  189.        0000-MAIN.
  190.             PERFORM 0100-INITIALIZE  THRU 0100-EXIT.
  191.             PERFORM 0300-PROCESS     THRU 0300-EXIT.
  192.             PERFORM 0200-END-PROGRAM THRU 0200-EXIT.
  193.        0000-EXIT.
  194.             EXIT.          
  195.      
  196.       *    *****************************************************************
  197.       *   *    0100 - INITIALIZE                                         *
  198.       *    *****************************************************************
  199.        0100-INITIALIZE.
  200.        0100-EXIT.
  201.             EXIT.
  202.        
  203.       *    *****************************************************************
  204.       *   *    0200 - END-PROGRAM                                        *
  205.       *    *****************************************************************
  206.        0200-END-PROGRAM.
  207.        0200-EXIT.
  208.             STOP RUN.
  209.             EXIT.
  210.            
  211.       *    *****************************************************************
  212.       *   *    0300 - PROCESS                                            *
  213.       *    *****************************************************************
  214.        0300-PROCESS.
  215.        0300-EXIT.
  216.             EXIT.
Add Comment
Please, Sign In to add comment
Public Pastes
We use cookies for various purposes including analytics. By continuing to use Pastebin, you agree to our use of cookies as described in the Cookies Policy.  OK, I Understand
Not a member of Pastebin yet?
Sign Up, it unlocks many cool features!