SHARE
TWEET

Untitled

a guest Sep 17th, 2018 91 Never
Not a member of Pastebin yet? Sign Up, it unlocks many cool features!
  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. CBLHO5JN.
  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.       ***********************************************************************
  16.       *-----D A T A   D I V I S I O N---------------------------------------*
  17.       ***********************************************************************
  18.        DATA DIVISION.
  19.        
  20.       * ********************************************************************
  21.       *  *                    F I L E   S E C T I O N                      *
  22.       * ********************************************************************
  23.        FILE SECTION.
  24.    
  25.       * ********************************************************************
  26.       *  *         W O R K I N G   S T O R A G E   S E C T I O N           *
  27.       * ********************************************************************
  28.        WORKING-STORAGE SECTION.
  29.       *    *****************************************************************
  30.       *   *    PARAMETER CARD                                            *
  31.       *    *****************************************************************
  32.        01 WS-PRM-CRD                   PIC X(09).
  33.        
  34.        01 WS-PRM-DATE                  REDEFINES WS-PRM-CRD.
  35.           05 PRM-DATE-CCYY.
  36.              10 PRM-DATE-CC            PIC 9(02).
  37.              10 PRM-DATE-YY            PIC 9(02).
  38.           05 PRM-DATE-MM               PIC 9(02).
  39.           05 PRM-DATE-DD               PIC 9(03).
  40.      
  41.       *    *****************************************************************
  42.       *   *    SYSTEM DATE                                               *
  43.       *    *****************************************************************
  44.        01 WS-SYS-DATE.
  45.           05 SYS-DATE-CC               PIC 9(02)      VALUE 20.
  46.           05 SYS-DATE-YYMMDD.
  47.              10 SYS-DATE-YY            PIC 9(02)      VALUE ZERO.
  48.              10 SYS-DATE-MM            PIC 9(02)      VALUE ZERO.
  49.              10 SYS-DATE-DD            PIC 9(02)      VALUE ZERO.
  50.              
  51.       *    *****************************************************************
  52.       *   *    DISPLAY MESSAGES                                          *
  53.       *    *****************************************************************
  54.        01 WS-DISP-MSG                  PIC X(80)      VALUE SPACES.
  55.        
  56.       *    *****************************************************************
  57.       *   *    TEMPORARY STORAGE                                         *
  58.       *    *****************************************************************
  59.        01 WS-TMP-PRM-DATE.
  60.           05 PRM-DATE-CCYY-Q4          PIC 9(03)      VALUE ZERO.
  61.           05 PRM-DATE-CCYY-R4          PIC 9(03)      VALUE ZERO.
  62.              88 CCYY-DIVISIBLE-4       VALUE ZERO.
  63.           05 PRM-DATE-CCYY-Q100        PIC 9(03)      VALUE ZERO.
  64.           05 PRM-DATE-CCYY-R100        PIC 9(03)      VALUE ZERO.
  65.              88 CCYY-DIVISIBLE-100     VALUE ZERO.
  66.           05 PRM-DATE-CCYY-Q400        PIC 9(03)      VALUE ZERO.
  67.           05 PRM-DATE-CCYY-R400        PIC 9(03)      VALUE ZERO.
  68.              88 CCYY-DIVISIBLE-400     VALUE ZERO.
  69.      
  70.       *    *****************************************************************
  71.       *   *    FLAGS                                                     *
  72.       *    *****************************************************************
  73.        01 WS-VALIDITY-PRM-DATE         PIC X(01)      VALUE 'Y'.
  74.           88 VAL-PARAM-DATE            VALUE 'Y'.
  75.           88 INV-PARAM-DATE            VALUE 'N'.
  76.      
  77.       *    *****************************************************************
  78.       *   *    CONSTANTS                                                     *
  79.       *    *****************************************************************
  80.        01 TBL-MONTH.
  81.           05 MONTH-ARRAY.
  82.              10 FILLER                 PIC X(54)    VALUE
  83.             '  JANUARY FEBRUARY    MARCH    APRIL      MAY     JUNE'.
  84.              10 FILLER                 PIC X(54)    VALUE
  85.             '     JULY   AUGUSTSEPTEMBER  OCTOBER NOVEMBER DECEMBER'.
  86.           05 MONTH-TABLE               REDEFINES MONTH-ARRAY
  87.                                        OCCURS 12 TIMES.
  88.              10 MONTH                  PIC X(09).
  89.        
  90.        01 WS-DISP-MSG-LIT.
  91.           05 VAL-PARAM-CARD            PIC X(17)    VALUE
  92.             'PARAMETER CARD - '.
  93.           05 INV-PARAM-CARD            PIC X(25)    VALUE
  94.             'INVALID PARAMETER CARD - '.
  95.       ***********************************************************************
  96.       *-----P R O C E D U R E   D I V I S I O N-----------------------------*
  97.       ***********************************************************************
  98.        PROCEDURE DIVISION.
  99.       * ********************************************************************
  100.       *  *       0XXX - MAIN PROGRAM                                       *
  101.       * ********************************************************************
  102.       *    *****************************************************************
  103.       *   *    0000 - PROGRAM-DRIVER                                     *
  104.       *    *****************************************************************
  105.        0000-PROGRAM-DRIVER.
  106.             PERFORM 1000-INITIALIZE  THRU 1000-EXIT.
  107.             PERFORM 3000-PROCESS     THRU 3000-EXIT.
  108.             PERFORM 2000-END-PROGRAM THRU 2000-EXIT.
  109.        0000-EXIT.
  110.             EXIT.          
  111.      
  112.       * ********************************************************************
  113.       *  *       1XXX - INITIALIZE                                         *
  114.       * ********************************************************************
  115.       *    *****************************************************************
  116.       *   *    1000 - INITIALIZE                                         *
  117.       *    *****************************************************************
  118.        1000-INITIALIZE.
  119.             PERFORM 1100-PARAM-CARD-VALIDATION THRU 1100-EXIT.
  120.             PERFORM 1200-SORT-TRANS-FILE       THRU 1200-EXIT.
  121.             PERFORM 1300-OPEN-FILES            THRU 1300-EXIT.
  122.             PERFORM 1400-RESET-VALUES          THRU 1400-EXIT.
  123.        1000-EXIT.
  124.             EXIT.
  125.        
  126.        1100-PARAM-CARD-VALIDATION.
  127.             ACCEPT WS-PRM-DATE     FROM SYSIN.
  128.             ACCEPT SYS-DATE-YYMMDD FROM DATE.
  129.            
  130.             DISPLAY WS-PRM-CRD.
  131.             DISPLAY PRM-DATE-CCYY.
  132.             DISPLAY PRM-DATE-MM.
  133.             DISPLAY PRM-DATE-DD.
  134.            
  135.             PERFORM 4000-VALIDATE-PARAM-DATE THRU 4000-EXIT.
  136.            
  137.             IF INV-PARAM-DATE THEN
  138.                INITIALIZE WS-DISP-MSG
  139.                STRING INV-PARAM-CARD DELIMITED BY SIZE
  140.                       WS-PRM-DATE    DELIMITED BY SIZE
  141.                  INTO WS-DISP-MSG
  142.                END-STRING
  143.                DISPLAY WS-DISP-MSG
  144.                PERFORM 2000-END-PROGRAM THRU 2000-EXIT
  145.             ELSE
  146.                INITIALIZE WS-DISP-MSG
  147.                STRING VAL-PARAM-CARD      DELIMITED BY SIZE
  148.                       PRM-DATE-CC         DELIMITED BY SIZE
  149.                       ' '                 DELIMITED BY SIZE
  150.                       MONTH (PRM-DATE-MM) DELIMITED BY SIZE
  151.                       ' '                 DELIMITED BY SIZE
  152.                       PRM-DATE-CC         DELIMITED BY SIZE
  153.                       PRM-DATE-YY         DELIMITED BY SIZE
  154.                  INTO WS-DISP-MSG
  155.                END-STRING
  156.                DISPLAY WS-DISP-MSG
  157.             END-IF.
  158.        1100-EXIT.
  159.             EXIT.
  160.            
  161.        1200-SORT-TRANS-FILE.
  162.        
  163.        
  164.        1200-EXIT.
  165.             EXIT.
  166.            
  167.        1300-OPEN-FILES.
  168.        
  169.        
  170.        1300-EXIT.
  171.             EXIT.
  172.        
  173.        1400-RESET-VALUES.
  174.        
  175.        
  176.        1400-EXIT.
  177.             EXIT.
  178.            
  179.       * ********************************************************************
  180.       *  *       2XXX - END PROGRAM                                        *
  181.       * ********************************************************************
  182.       *    *****************************************************************
  183.       *   *    2000 - END-PROGRAM                                        *
  184.       *    *****************************************************************
  185.        2000-END-PROGRAM.
  186.             STOP RUN.
  187.        2000-EXIT.
  188.             EXIT.
  189.            
  190.       * ********************************************************************
  191.       *  *       3XXX - PROCESS                                            *
  192.       * ********************************************************************
  193.       *    *****************************************************************
  194.       *   *    3000 - PROCESS                                            *
  195.       *    *****************************************************************
  196.        3000-PROCESS.
  197.        3000-EXIT.
  198.             EXIT.
  199.            
  200.       * ********************************************************************
  201.       *  *       4XXX - VALIDATION                                         *
  202.       * ********************************************************************
  203.        4000-VALIDATE-PARAM-DATE.
  204.             IF WS-PRM-DATE IS NUMERIC AND
  205.                PRM-DATE-DD  < 1      THEN
  206.                   EVALUATE TRUE
  207.                      WHEN PRM-DATE-MM =  1 OR
  208.                           PRM-DATE-MM =  3 OR
  209.                           PRM-DATE-MM =  5 OR
  210.                           PRM-DATE-MM =  7 OR
  211.                           PRM-DATE-MM =  8 OR
  212.                           PRM-DATE-MM = 10 OR
  213.                           PRM-DATE-MM = 12
  214.                            IF PRM-DATE-DD > 31 THEN
  215.                               SET INV-PARAM-DATE TO TRUE
  216.                            END-IF
  217.                      WHEN PRM-DATE-MM =  4 OR
  218.                           PRM-DATE-MM =  6 OR
  219.                           PRM-DATE-MM =  9 OR
  220.                           PRM-DATE-MM = 11
  221.                            IF PRM-DATE-DD > 30 THEN
  222.                               SET INV-PARAM-DATE TO TRUE
  223.                            END-IF
  224.                      WHEN PRM-DATE-MM = 2
  225.                         DIVIDE    4
  226.                              INTO PRM-DATE-CCYY
  227.                            GIVING PRM-DATE-CCYY-Q4
  228.                         REMAINDER PRM-DATE-CCYY-R4
  229.                         DIVIDE    100
  230.                              INTO PRM-DATE-CCYY
  231.                            GIVING PRM-DATE-CCYY-Q100
  232.                         REMAINDER PRM-DATE-CCYY-R100
  233.                         DIVIDE    400
  234.                              INTO PRM-DATE-CCYY
  235.                            GIVING PRM-DATE-CCYY-Q400
  236.                         REMAINDER PRM-DATE-CCYY-R400
  237.                         IF CCYY-DIVISIBLE-4 THEN
  238.                            IF (NOT CCYY-DIVISIBLE-400) AND
  239.                                    CCYY-DIVISIBLE-100 THEN
  240.                               IF PRM-DATE-DD > 28 THEN
  241.                                  SET INV-PARAM-DATE TO TRUE
  242.                               END-IF
  243.                            ELSE
  244.                               IF PRM-DATE-DD > 29 THEN
  245.                                  SET INV-PARAM-DATE TO TRUE
  246.                               END-IF
  247.                            END-IF
  248.                         ELSE
  249.                            IF PRM-DATE-DD > 28 THEN
  250.                               SET INV-PARAM-DATE TO TRUE
  251.                            END-IF
  252.                         END-IF
  253.                      WHEN OTHER
  254.                         SET INV-PARAM-DATE TO TRUE
  255.                   END-EVALUATE
  256.             ELSE
  257.                SET INV-PARAM-DATE TO TRUE
  258.             END-IF.
  259.  
  260.             IF WS-PRM-DATE < WS-SYS-DATE THEN
  261.                SET INV-PARAM-DATE TO TRUE
  262.             END-IF.
  263.        4000-EXIT.
  264.             EXIT.
RAW Paste Data
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
 
Top