home *** CD-ROM | disk | FTP | other *** search
/ OS/2 Shareware BBS: 10 Tools / 10-Tools.zip / viscobv6.zip / vac22os2 / ibmcobol / samples / elookup1 / dbclss / servc.cbl < prev   
Text File  |  1998-01-10  |  5KB  |  106 lines
  1.  
  2.       *************************************************************
  3.       *                                                           *
  4.       *    Licensed Materials - Property of IBM                   *
  5.       *                                                           *
  6.       *    28H2177  (C) Copyright IBM Corp. 1995, 1998            *
  7.       *    All rights reserved                                    *
  8.       *                                                           *
  9.       *    US Government Users Restricted Rights - Use,           *
  10.       *    duplication, or disclosure restricted by GSA ADP       *
  11.       *    Schedule Contract with IBM Corp.                       *
  12.       *                                                           *
  13.       *************************************************************
  14.  
  15.       *************************************************************
  16.        IDENTIFICATION DIVISION.
  17.       *************************************************************
  18.        PROGRAM-ID.    SERVC.
  19.        AUTHOR.        Programmer.
  20.  
  21.       *************************************************************
  22.       *                                                           *
  23.       *NAME.........SERVC                                         *
  24.       *LANGUAGE.....COBOL                                         *
  25.       *FUNCTION.....Service Length calculation subroutine         *
  26.       *             This subroutine accepts a date (format:       *
  27.       *             yyyymmdd), calculates and returns the service *
  28.       *             length (number of years from today's date.)   *
  29.       *COPY MEMBER..Servsc                                        *
  30.       *PARAMETERS...Hire date      (value set by calling program) *
  31.       *             Service length (value set by this program)    *
  32.       *                                                           *
  33.       *************************************************************
  34.  
  35.       *************************************************************
  36.        ENVIRONMENT DIVISION.
  37.       *************************************************************
  38.        CONFIGURATION SECTION.
  39.       *************************************************************
  40.        DATA DIVISION.
  41.       *************************************************************
  42.        WORKING-STORAGE SECTION.
  43.        01  WORK-FIELDS.
  44.            05  WK-TODAYS-DATE.
  45.                10  WK-TODAYS-YEAR         PIC 9(04).
  46.                10  WK-TODAYS-MONTH        PIC 9(02).
  47.                10  WK-TODAYS-DAY          PIC 9(02).
  48.            05  WK-SERVICE-LENGTH          PIC 9(02).
  49.            05 WK-SC-HIRE-YEAR-FOUR        PIC 9(04).
  50.            05 WK-HUNDRED-YEAR-WINDOW-START PIC 9(04).
  51.  
  52.       *************************************************************
  53.       *  Linkage Section                                          *
  54.       *************************************************************
  55.        LINKAGE SECTION.
  56.        01  SC-COMMAREA.
  57.            Copy SERVSC.
  58.  
  59.       *************************************************************
  60.        PROCEDURE DIVISION USING SC-COMMAREA.
  61.       *************************************************************
  62.  
  63.       *************************************************************
  64.       *0000-MAIN.                                                 *
  65.       *  Initialize the service length fields.                    *
  66.       *  Retrieve today's date and then calculcate number of      *
  67.       *    years of service.                                      *
  68.       *  Move calculcated service length to return parameter.     *
  69.       *************************************************************
  70.  
  71.        0000-MAIN.
  72.  
  73.             INITIALIZE SC-SERVICE-LENGTH
  74.                        WK-SERVICE-LENGTH.
  75.  
  76.       *     Retrieve today's date
  77.             MOVE FUNCTION CURRENT-DATE(1:8) TO WK-TODAYS-DATE
  78.  
  79.       * Convert the hire year from two digit to four digit.
  80.       * Assume a floating 100 year window from 80 years prior to
  81.       * current year to 20 years from current year.  This algorithm
  82.       * assumes all years are of the form 19xx or 20xx.
  83.  
  84.       *     Calculate service length
  85.             SUBTRACT SC-HIRE-YEAR FROM WK-TODAYS-YEAR
  86.                 GIVING WK-SERVICE-LENGTH
  87.  
  88.             IF WK-TODAYS-MONTH < SC-HIRE-MONTH AND
  89.                WK-SERVICE-LENGTH > 0
  90.                 SUBTRACT 1 FROM WK-SERVICE-LENGTH
  91.                     GIVING WK-SERVICE-LENGTH
  92.             ELSE
  93.                 IF WK-TODAYS-MONTH = SC-HIRE-MONTH AND
  94.                    SC-HIRE-DAY > WK-TODAYS-DAY AND
  95.                    WK-SERVICE-LENGTH > 0
  96.                     SUBTRACT 1 FROM WK-SERVICE-LENGTH
  97.                         GIVING WK-SERVICE-LENGTH
  98.                 END-IF
  99.             END-IF.
  100.  
  101.             Move WK-SERVICE-LENGTH To SC-SERVICE-LENGTH.
  102.             Move  0  To sc-return-code.
  103.  
  104.        0000-MAIN-EXIT.
  105.             GOBACK.
  106.