{\rtf1\ansi\ansicpg1252\deff0{\fonttbl{\f0\fnil\fcharset0 Fixedsys;}{\f1\fmodern\fprq1\fcharset0 Fixedsys;}
{\colortbl;\red255\green0\blue0;\red0\green0\blue255;\red0\green0\blue128;\red0\green0\blue0;\red128\green0\blue0;\red0\green128\blue0;\red128\green128\blue128;\red0\green128\blue128;\red255\green0\blue255;}
{\*\generator Msftedit 5.41.15.1507;}
\viewkind4\uc1\pard\lang1031\f0\fs16}
\cf1 \f1 IDENTIFICATION\cf0\f0 \cf1 \f1 DIVISION\cf0\f0 \cf2 \f1 .\cf0\f0
\par
\cf6 \f1 *\cf0\f0
\par
\cf1 \f1 PROGRAM-ID\cf0\f0 \cf2 \f1 .\cf0\f0 \cf4 \f1 DATET\cf0\f0 \cf2 \f1 .\cf0\f0
\par
\cf6 \f1 *\cf0\f0
\par
\cf1 \f1 DATE-WRITTEN\cf0\f0 . 04/10/89.
\par
\cf6 \f1 *\cf0\f0
\par
\cf6 \f1 * MODIFIED 12/26/95.\cf0\f0
\par
\cf6 \f1 * 07/31/97.\cf0\f0
\par
\cf6 \f1 * 10/18/97.\cf0\f0
\par
\cf6 \f1 *\cf0\f0
\par
\cf6 \f1 * *******************************\cf0\f0
\par
\cf6 \f1 * * *\cf0\f0
\par
\cf6 \f1 * * Judson D. McClendon *\cf0\f0
\par
\cf6 \f1 * * Sun Valley Systems *\cf0\f0
\par
\cf6 \f1 * * 329 37th Court N.E. *\cf0\f0
\par
\cf6 \f1 * * Birmingham, AL 35215 *\cf0\f0
\par
\cf6 \f1 * * 205-853-8440 *\cf0\f0
\par
\cf6 \f1 * * *\cf0\f0
\par
\cf6 \f1 * *******************************\cf0\f0
\par
\cf6 \f1 *\cf0\f0
\par
\cf1 \f1 ENVIRONMENT\cf0\f0 \cf1 \f1 DIVISION\cf0\f0 \cf2 \f1 .\cf0\f0
\par
\cf6 \f1 *\cf0\f0
\par
\cf1 \f1 CONFIGURATION\cf0\f0 \cf1 \f1 SECTION\cf0\f0 \cf2 \f1 .\cf0\f0
\par
\cf6 \f1 *\cf0\f0
\par
\cf1 \f1 INPUT-OUTPUT\cf0\f0 \cf1 \f1 SECTION\cf0\f0 \cf2 \f1 .\cf0\f0
\par
\cf6 \f1 *\cf0\f0
\par
\cf1 \f1 FILE-CONTROL\cf0\f0 \cf2 \f1 .\cf0\f0
\par
\cf6 \f1 *\cf0\f0
\par
\cf1 \f1 I-O-CONTROL\cf0\f0 \cf2 \f1 .\cf0\f0
\par
\cf6 \f1 *\cf0\f0
\par
\cf1 \f1 DATA\cf0\f0 \cf1 \f1 DIVISION\cf0\f0 \cf2 \f1 .\cf0\f0
\par
\cf6 \f1 *\cf0\f0
\par
\cf1 \f1 FILE\cf0\f0 \cf1 \f1 SECTION\cf0\f0 \cf2 \f1 .\cf0\f0
\par
\cf6 \f1 *\cf0\f0
\par
\cf1 \f1 WORKING-STORAGE\cf0\f0 \cf1 \f1 SECTION\cf0\f0 \cf2 \f1 .\cf0\f0
\par
\cf6 \f1 *\cf0\f0
\par
\cf6 \f1 ******************************************************************\cf0\f0
\par
\cf6 \f1 * *\cf0\f0
\par
\cf6 \f1 * 7 7 ' S *\cf0\f0
\par
\cf6 \f1 * *\cf0\f0
\par
\cf6 \f1 ******************************************************************\cf0\f0
\par
\cf6 \f1 *\cf0\f0
\par
\cf3 \f1 77\cf0\f0 \cf4 \f1 WS-ANSWER\cf0\f0 \cf2 \f1 PIC\cf0\f0 X(01) \cf1 \f1 V\cf0\f0 A\cf1 \f1 LUE S\cf0\f0 \cf2 \f1 P\cf0\f0 ACE.
\par
\cf3 \f1 77\cf0\f0 \cf4 \f1 WS-ESCAPE-FLAG\cf0\f0 \cf2 \f1 PIC\cf0\f0 9(01) \cf1 \f1 V\cf0\f0 A\cf3 \f1 L\cf0\f0 \cf2 \f1 U\cf0\f0 E 0.
\par
\cf6 \f1 *\cf0\f0
\par
\cf6 \f1 ******************************************************************\cf0\f0
\par
\cf6 \f1 * *\cf0\f0
\par
\cf6 \f1 * S C R E E N H O L D A R E A *\cf0\f0
\par
\cf6 \f1 * *\cf0\f0
\par
\cf6 \f1 ******************************************************************\cf0\f0
\par
\cf6 \f1 *\cf0\f0
\par
\cf3 \f1 01\cf0\f0 \cf4 \f1 SCREEN-HOLD-AREA\cf0\f0 \cf2 \f1 .\cf0\f0
\par
\cf3 \f1 03\cf0\f0 \cf4 \f1 SH-EDIT-DATE\cf0\f0 \cf2 \f1 PIC\cf0\f0 X(0\cf1 \f1 8) V\cf0\f0 A\cf1 \f1 LUE SP\cf0\f0 \cf2 \f1 A\cf0\f0 CES.
\par
\cf6 \f1 *\cf0\f0
\par
\cf3 \f1 03\cf0\f0 \cf4 \f1 SH-WORK-MMDDYYYY\cf0\f0 \cf2 \f1 PIC\cf0\f0 9(0\cf1 \f1 8) V\cf0\f0 A\cf3 \f1 L\cf0\f0 \cf2 \f1 U\cf0\f0 E 0.
\par
\cf3 \f1 03\cf0\f0 \cf4 \f1 SH-WORK-MMDDYYYY-ALPHA\cf0\f0 \cf1 \f1 REDEFINES\cf0\f0 \cf4 \f1 SH-WORK-MMDDYYYY\cf0\f0 \cf2 \f1 .\cf0\f0
\par
\cf3 \f1 05\cf0\f0 \cf4 \f1 SH-WORK-MONTH\cf0\f0 \cf2 \f1 PIC\cf0\f0 9(\cf2 \f1 0\cf0\f0 2).
\par
\cf3 \f1 05\cf0\f0 \cf4 \f1 SH-WORK-DAY\cf0\f0 \cf2 \f1 PIC\cf0\f0 9(\cf2 \f1 0\cf0\f0 2).
\par
\cf3 \f1 05\cf0\f0 \cf4 \f1 SH-WORK-YEAR\cf0\f0 \cf2 \f1 PIC\cf0\f0 9(\cf2 \f1 0\cf0\f0 4).
\par
\cf6 \f1 *\cf0\f0
\par
\cf3 \f1 03\cf0\f0 \cf4 \f1 SH-WORK-YYYYMMDD\cf0\f0 \cf2 \f1 PIC\cf0\f0 9(0\cf1 \f1 8) V\cf0\f0 A\cf3 \f1 L\cf0\f0 \cf2 \f1 U\cf0\f0 E 0.
\par
\cf3 \f1 03\cf0\f0 \cf4 \f1 SH-WORK-YYYYMMDD-ALPHA\cf0\f0 \cf1 \f1 REDEFINES\cf0\f0 \cf4 \f1 SH-WORK-YYYYMMDD\cf0\f0 \cf2 \f1 .\cf0\f0
\par
\cf3 \f1 05\cf0\f0 \cf4 \f1 SH-WORK-YYYY\cf0\f0 \cf2 \f1 PIC\cf0\f0 9(\cf2 \f1 0\cf0\f0 4).
\par
\cf3 \f1 05\cf0\f0 \cf4 \f1 SH-WORK-MM\cf0\f0 \cf2 \f1 PIC\cf0\f0 9(\cf2 \f1 0\cf0\f0 2).
\par
\cf3 \f1 05\cf0\f0 \cf4 \f1 SH-WORK-DD\cf0\f0 \cf2 \f1 PIC\cf0\f0 9(\cf2 \f1 0\cf0\f0 2).
\par
\cf6 \f1 *\cf0\f0
\par
\cf3 \f1 03\cf0\f0 \cf4 \f1 SH-JUL-DATE\cf0\f0 \cf2 \f1 PIC\cf0\f0 9(0\cf1 \f1 7) V\cf0\f0 A\cf3 \f1 L\cf0\f0 \cf2 \f1 U\cf0\f0 E 0.
\par
\cf3 \f1 03\cf0\f0 \cf4 \f1 SH-JUL-DATE-ALPHA\cf0\f0 \cf1 \f1 REDEFINES\cf0\f0 \cf4 \f1 SH-JUL-DATE\cf0\f0 \cf2 \f1 .\cf0\f0
\par
\cf3 \f1 05\cf0\f0 \cf4 \f1 SH-JUL-YYYY\cf0\f0 \cf2 \f1 PIC\cf0\f0 9(\cf2 \f1 0\cf0\f0 4).
\par
\cf3 \f1 05\cf0\f0 \cf4 \f1 SH-JUL-DDD\cf0\f0 \cf2 \f1 PIC\cf0\f0 9(\cf2 \f1 0\cf0\f0 3).
\par
\cf6 \f1 *\cf0\f0
\par
\cf3 \f1 03\cf0\f0 \cf4 \f1 SH-BEG-YYYYMMDD\cf0\f0 \cf2 \f1 PIC\cf0\f0 9(0\cf1 \f1 8) V\cf0\f0 A\cf3 \f1 L\cf0\f0 \cf2 \f1 U\cf0\f0 E 0.
\par
\cf3 \f1 03\cf0\f0 \cf4 \f1 SH-BEG-YYYYMMDD-ALPHA\cf0\f0 \cf1 \f1 REDEFINES\cf0\f0 \cf4 \f1 SH-BEG-YYYYMMDD\cf0\f0 \cf2 \f1 .\cf0\f0
\par
\cf3 \f1 05\cf0\f0 \cf4 \f1 SH-BEG-YYYY\cf0\f0 \cf2 \f1 PIC\cf0\f0 9(\cf2 \f1 0\cf0\f0 4).
\par
\cf3 \f1 05\cf0\f0 \cf4 \f1 SH-BEG-MM\cf0\f0 \cf2 \f1 PIC\cf0\f0 9(\cf2 \f1 0\cf0\f0 2).
\par
\cf3 \f1 05\cf0\f0 \cf4 \f1 SH-BEG-DD\cf0\f0 \cf2 \f1 PIC\cf0\f0 9(\cf2 \f1 0\cf0\f0 2).
\par
\cf6 \f1 *\cf0\f0
\par
\cf3 \f1 03\cf0\f0 \cf4 \f1 SH-END-YYYYMMDD\cf0\f0 \cf2 \f1 PIC\cf0\f0 9(0\cf1 \f1 8) V\cf0\f0 A\cf3 \f1 L\cf0\f0 \cf2 \f1 U\cf0\f0 E 0.
\par
\cf3 \f1 03\cf0\f0 \cf4 \f1 SH-END-YYYYMMDD-ALPHA\cf0\f0 \cf1 \f1 REDEFINES\cf0\f0 \cf4 \f1 SH-END-YYYYMMDD\cf0\f0 \cf2 \f1 .\cf0\f0
\par
\cf3 \f1 05\cf0\f0 \cf4 \f1 SH-END-YYYY\cf0\f0 \cf2 \f1 PIC\cf0\f0 9(\cf2 \f1 0\cf0\f0 4).
\par
\cf3 \f1 05\cf0\f0 \cf4 \f1 SH-END-MM\cf0\f0 \cf2 \f1 PIC\cf0\f0 9(\cf2 \f1 0\cf0\f0 2).
\par
\cf3 \f1 05\cf0\f0 \cf4 \f1 SH-END-DD\cf0\f0 \cf2 \f1 PIC\cf0\f0 9(\cf2 \f1 0\cf0\f0 2).
\par
\cf6 \f1 *\cf0\f0
\par
\cf3 \f1 03\cf0\f0 \cf4 \f1 SH-OFFSET\cf0\f0 \cf2 \f1 PIC\cf0\f0 S9(\cf1 \f1 08) \cf0\f0 V\cf3 \f1 A\cf0\f0 \cf2 \f1 L\cf0\f0 UE 0.
\par
\cf3 \f1 03\cf0\f0 \cf4 \f1 SH-AGE-YEARS\cf0\f0 \cf2 \f1 PIC\cf0\f0 9(0\cf1 \f1 4) V\cf0\f0 A\cf3 \f1 L\cf0\f0 \cf2 \f1 U\cf0\f0 E 0.
\par
\cf3 \f1 03\cf0\f0 \cf4 \f1 SH-AGE-MONTHS\cf0\f0 \cf2 \f1 PIC\cf0\f0 9(0\cf1 \f1 2) V\cf0\f0 A\cf3 \f1 L\cf0\f0 \cf2 \f1 U\cf0\f0 E 0.
\par
\cf3 \f1 03\cf0\f0 \cf4 \f1 SH-AGE-DAYS\cf0\f0 \cf2 \f1 PIC\cf0\f0 9(0\cf1 \f1 2) V\cf0\f0 A\cf3 \f1 L\cf0\f0 \cf2 \f1 U\cf0\f0 E 0.
\par
\cf3 \f1 03\cf0\f0 \cf4 \f1 SH-AGE-TOTDAYS\cf0\f0 \cf2 \f1 PIC\cf0\f0 9(0\cf1 \f1 8) V\cf0\f0 A\cf3 \f1 L\cf0\f0 \cf2 \f1 U\cf0\f0 E 0.
\par
\cf6 \f1 *\cf0\f0
\par
\cf3 \f1 03\cf0\f0 \cf4 \f1 SH-YEARS\cf0\f0 \cf2 \f1 PIC\cf0\f0 S9(\cf1 \f1 07) \cf0\f0 V\cf3 \f1 A\cf0\f0 \cf2 \f1 L\cf0\f0 UE 0.
\par
\cf3 \f1 03\cf0\f0 \cf4 \f1 SH-MONTHS\cf0\f0 \cf2 \f1 PIC\cf0\f0 S9(\cf1 \f1 07) \cf0\f0 V\cf3 \f1 A\cf0\f0 \cf2 \f1 L\cf0\f0 UE 0.
\par
\cf3 \f1 03\cf0\f0 \cf4 \f1 SH-DAYS\cf0\f0 \cf2 \f1 PIC\cf0\f0 S9(\cf1 \f1 07) \cf0\f0 V\cf3 \f1 A\cf0\f0 \cf2 \f1 L\cf0\f0 UE 0.
\par
\cf6 \f1 *\cf0\f0
\par
\cf3 \f1 03\cf0\f0 \cf4 \f1 SH-RESULT\cf0\f0 \cf2 \f1 PIC\cf0\f0 X(2\cf1 \f1 0) V\cf0\f0 A\cf1 \f1 LUE SP\cf0\f0 \cf2 \f1 A\cf0\f0 CES.
\par
\cf6 \f1 *\cf0\f0
\par
\cf6 \f1 ******************************************************************\cf0\f0
\par
\cf6 \f1 * *\cf0\f0
\par
\cf6 \f1 * D A T E W O R K A R E A *\cf0\f0
\par
\cf6 \f1 * *\cf0\f0
\par
\cf6 \f1 ******************************************************************\cf0\f0
\par
\cf6 \f1 *\cf0\f0
\par
\cf3 \f1 01\cf0\f0 \cf4 \f1 DATE-WORK-AREA\cf0\f0 \cf2 \f1 .\cf0\f0
\par
\cf3 \f1 03\cf0\f0 \cf4 \f1 DW-DATE-ERROR-FLAG\cf0\f0 \cf2 \f1 PIC\cf0\f0 9(\cf2 \f1 0\cf0\f0 1).
\par
\cf6 \f1 *\cf0\f0
\par
\cf6 \f1 *\cf0\f0
\par
\cf6 \f1 * ** TODAYS DATE **\cf0\f0
\par
\cf6 \f1 *\cf0\f0
\par
\cf3 \f1 03\cf0\f0 \cf4 \f1 DW-TODAYS-DATE\cf0\f0 \cf2 \f1 PIC\cf0\f0 9(\cf2 \f1 0\cf0\f0 8).
\par
\cf3 \f1 03\cf0\f0 \cf4 \f1 DW-TODAYS-DATE-ALPHA\cf0\f0 \cf1 \f1 REDEFINES\cf0\f0 \cf4 \f1 DW-TODAYS-DATE\cf0\f0 \cf2 \f1 .\cf0\f0
\par
\cf3 \f1 05\cf0\f0 \cf4 \f1 DW-TODAYS-MONTH\cf0\f0 \cf2 \f1 PIC\cf0\f0 9(\cf2 \f1 0\cf0\f0 2).
\par
\cf3 \f1 05\cf0\f0 \cf4 \f1 DW-TODAYS-DAY\cf0\f0 \cf2 \f1 PIC\cf0\f0 9(\cf2 \f1 0\cf0\f0 2).
\par
\cf3 \f1 05\cf0\f0 \cf4 \f1 DW-TODAYS-YEAR\cf0\f0 \cf2 \f1 PIC\cf0\f0 9(\cf2 \f1 0\cf0\f0 4).
\par
\cf6 \f1 *\cf0\f0
\par
\cf3 \f1 03\cf0\f0 \cf4 \f1 DW-TODAYS-YYYYMMDD\cf0\f0 \cf2 \f1 PIC\cf0\f0 9(\cf2 \f1 0\cf0\f0 8).
\par
\cf3 \f1 03\cf0\f0 \cf4 \f1 DW-TODAYS-YYYYMMDD-ALPHA\cf0\f0 \cf1 \f1 REDEFINES\cf0\f0 \cf4 \f1 DW-TODAYS-YYYYMMDD\cf0\f0 .
\par
\cf3 \f1 05\cf0\f0 \cf4 \f1 DW-TODAYS-YYYY\cf0\f0 PIC 9(04).
\par
05 DW-TODAYS-YYYY-R REDEFINES DW-TODAYS-YYYY.
\par
07 DW-TODAYS-CC PIC 9(02).
\par
07 DW-TODAYS-YY PIC 9(02).
\par
05 DW-TODAYS-MM PIC 9(02).
\par
05 DW-TODAYS-DD PIC 9(02).
\par
*
\par
*
\par
* ** DATE WORK AREA **
\par
*
\par
03 DW-WORK-DATE PIC 9(08).
\par
03 DW-WORK-DATE-ALPHA REDEFINES DW-WORK-DATE.
\par
05 DW-WORK-MONTH PIC 9(02).
\par
05 DW-WORK-DAY PIC 9(02).
\par
05 DW-WORK-YEAR PIC 9(04).
\par
*
\par
03 DW-WORK-YYYYMMDD PIC 9(08).
\par
03 DW-WORK-YYYYMMDD-ALPHA REDEFINES DW-WORK-YYYYMMDD.
\par
05 DW-WORK-YYYY PIC 9(04).
\par
05 DW-WORK-YYYY-R REDEFINES DW-WORK-YYYY.
\par
07 DW-WORK-CC PIC 9(02).
\par
07 DW-WORK-YY PIC 9(02).
\par
05 DW-WORK-MM PIC 9(02).
\par
05 DW-WORK-DD PIC 9(02).
\par
*
\par
*
\par
* ** SHORT MMDDYY DATE **
\par
*
\par
03 DW-SHORT-DATE PIC 9(06).
\par
03 DW-SHORT-DATE-ALPHA REDEFINES DW-SHORT-DATE.
\par
05 DW-SHORT-MONTH PIC 9(02).
\par
05 DW-SHORT-DAY PIC 9(02).
\par
05 DW-SHORT-YEAR PIC 9(02).
\par
*
\par
*
\par
* ** OFFSET DATE AREAS **
\par
*
\par
03 DW-OFFSET PIC S9(08).
\par
*
\par
03 DW-OFFSET-UNSIGNED PIC 9(08).
\par
03 DW-OFFSET-UNSIGNED-ALPHA REDEFINES DW-OFFSET-UNSIGNED.
\par
05 DW-OFFSET-YYYY PIC 9(04).
\par
05 DW-OFFSET-MM PIC 9(02).
\par
05 DW-OFFSET-DD PIC 9(02).
\par
*
\par
*
\par
* ** JULIAN DATE **
\par
*
\par
03 DW-JUL-DATE PIC 9(07).
\par
03 DW-JUL-DATE-ALPHA REDEFINES DW-JUL-DATE.
\par
05 DW-JUL-YYYY PIC 9(04).
\par
05 DW-JUL-YYYY-R REDEFINES DW-JUL-YYYY.
\par
07 DW-JUL-CC PIC 9(02).
\par
07 DW-JUL-YY PIC 9(02).
\par
05 DW-JUL-DDD PIC 9(03).
\par
*
\par
*
\par
* ** BEGIN DATE **
\par
*
\par
03 DW-BEG-YYYYMMDD PIC 9(08).
\par
03 DW-BEG-YYYYMMDD-ALPHA REDEFINES DW-BEG-YYYYMMDD.
\par
05 DW-BEG-YYYY PIC 9(04).
\par
05 DW-BEG-YYYY-R REDEFINES DW-BEG-YYYY.
\par
07 DW-BEG-CC PIC 9(02).
\par
07 DW-BEG-YY PIC 9(02).
\par
05 DW-BEG-MM PIC 9(02).
\par
05 DW-BEG-DD PIC 9(02).
\par
*
\par
*
\par
* ** END DATE **
\par
*
\par
03 DW-END-YYYYMMDD PIC 9(08).
\par
03 DW-END-YYYYMMDD-ALPHA REDEFINES DW-END-YYYYMMDD.
\par
05 DW-END-YYYY PIC 9(04).
\par
05 DW-END-YYYY-R REDEFINES DW-END-YYYY.
\par
07 DW-END-CC PIC 9(02).
\par
07 DW-END-YY PIC 9(02).
\par
05 DW-END-MM PIC 9(02).
\par
05 DW-END-DD PIC 9(02).
\par
*
\par
*
\par
* ** RESULTS OF AGE COMPUTATION **
\par
*
\par
03 DW-AGE-YEARS PIC 9(04).
\par
03 DW-AGE-MONTHS PIC 9(02).
\par
03 DW-AGE-DAYS PIC 9(02).
\par
03 DW-AGE-TOTDAYS PIC 9(08).
\par
*
\par
*
\par
* ** INPUT/OUTPUT VARIABLES **
\par
*
\par
03 DW-YEARS PIC S9(07).
\par
03 DW-MONTHS PIC S9(07).
\par
03 DW-DAYS PIC S9(07).
\par
03 DW-WEEKDAY PIC 9(01).
\par
*
\par
*
\par
* ** SCRATCH WORK AREAS FOR DATE ROUTINES **
\par
* ** (ASSUME MODIFIED BY ALL DATE ROUTINES) **
\par
*
\par
03 DW-WORK1 PIC S9(09).
\par
03 DW-WORK2 PIC S9(09).
\par
03 DW-WORK3 PIC S9(09).
\par
03 DW-TEMP-YYYY PIC S9(09).
\par
03 DW-TEMP-MM PIC S9(09).
\par
*
\par
*
\par
* ** NUMBER OF DAYS IN EACH MONTH **
\par
* ** (DAYS IN FEBRUARY ARE ADJUSTED BY DATE ROUTINES) **
\par
*
\par
03 DW-DAYS-IN-MONTHS VALUE "312831303130313130313031".
\par
05 DW-DAYS-IN-MONTH OCCURS 12 TIMES
\par
PIC 9(02).
\par
*
\par
*
\par
* ** HOLIDAY TABLE **
\par
*
\par
* ** THIS TABLE CONTAINS EVERY HOLIDAY ON WHICH THE BUSINESS **
\par
* ** OFFICE IS CLOSED. IT SHOULD BE UPDATED EVERY YEAR TO **
\par
* ** INCLUDE ALL THE DATES OVER WHICH BUSINESS DAYS MIGHT **
\par
* ** NEED TO BE CALCULATED. NO NEED TO ADD WEEKEND DATES. **
\par
*
\par
* ** THE ENTRIES IN THIS TABLE CONSIST OF AN 8-DIGIT DATE **
\par
* ** (YYYYMMDD), FOLLOWED BY A 2-DIGIT COUNT OF DAYS WHICH **
\par
* ** MUST BE ADDED TO THE DATE TO GET THE NEXT BUSINESS DAY. **
\par
*
\par
* ** EXAMPLE: THANKSGIVING, 1997, OFF THURSDAY 11/27 AND **
\par
* ** FRIDAY 11/28 UNTIL THE NEXT MONDAY 11/31. THE ENTRIES **
\par
* ** IN THE TABLE WOULD BE: 1997 11 27 04 AND 1997 11 28 03 **
\par
*
\par
* ** EXAMPLE: CHRISTMAS, 1998, OFF FRIDAY 12/25 THROUGH **
\par
* ** MONDAY 12/28 UNTIL TUESDAY 12/29. THE ENTRIES IN THE **
\par
* ** TABLE WOULD BE: 1998 12 25 04 AND 1998 12 28 01 **
\par
*
\par
03 DW-HOLIDAY-TABLE.
\par
05 DW-HT-VALUES.
\par
* YYYYMMDDCC
\par
07 FILLER PIC 9(10) VALUE 1997112704.
\par
07 FILLER PIC 9(10) VALUE 1997112803.
\par
07 FILLER PIC 9(10) VALUE 1998122504.
\par
07 FILLER PIC 9(10) VALUE 1998122801.
\par
*
\par
05 DW-HT-HOLIDAYS REDEFINES DW-HT-VALUES
\par
OCCURS 4 TIMES
\par
INDEXED BY DW-HT-HX.
\par
07 DW-HT-DATE.
\par
09 DW-HT-YYYY PIC 9(04).
\par
09 DW-HT-YYYY-R REDEFINES DW-HT-YYYY.
\par
11 DW-HT-CC PIC 9(02).
\par
11 DW-HT-YY PIC 9(02).
\par
09 DW-HT-MM PIC 9(02).
\par
09 DW-HT-DD PIC 9(02).
\par
07 DW-HT-DAYS PIC 9(02).
\par
*
\par
*
\par
* ** WEEKDAY NAMES **
\par
*
\par
03 DW-DAY-NAMES VALUE "SUNMONTUEWEDTHUFRISAT".
\par
05 DW-DAY-NAME OCCURS 7 TIMES
\par
PIC X(03).
\par
*
\par
SCREEN SECTION.
\par
*
\par
*
\par
* M E N U S C R E E N
\par
*
\par
01 MENU-SCREEN.
\par
03 BLANK SCREEN.
\par
03 LINE 01 COLUMN 21 VALUE
\par
"D A T E R O U T I N E T E S T".
\par
*
\par
03 LINE 03 COLUMN 10 VALUE "Press: A = Date Edit".
\par
03 LINE 04 COLUMN 17 VALUE "B = Date days".
\par
03 LINE 05 COLUMN 17 VALUE "C = Weekday".
\par
03 LINE 06 COLUMN 17 VALUE "D = Add Days".
\par
03 LINE 07 COLUMN 17 VALUE "E = Sub Days".
\par
03 LINE 08 COLUMN 17 VALUE "F = Add Months".
\par
03 LINE 09 COLUMN 17 VALUE "G = Sub Months".
\par
03 LINE 10 COLUMN 17 VALUE "H = Add Years".
\par
03 LINE 11 COLUMN 17 VALUE "I = Sub Years".
\par
03 LINE 03 COLUMN 37 VALUE "J = Calc Offset".
\par
03 LINE 04 COLUMN 37 VALUE "K = Compute Age".
\par
03 LINE 05 COLUMN 37 VALUE "L = Greg to Jul".
\par
03 LINE 06 COLUMN 37 VALUE "M = Jul to Greg".
\par
03 LINE 07 COLUMN 37 VALUE "N = Add Days, Business".
\par
03 LINE 12 COLUMN 25 VALUE "Esc = Exit: ".
\par
03 PIC X TO WS-ANSWER AUTO.
\par
*
\par
*
\par
* I N P U T S C R E E N S
\par
*
\par
*
\par
* G E T E D I T D A T E
\par
*
\par
01 GET-EDIT-DATE-SCREEN.
\par
03 LINE 14 COLUMN 10 VALUE "Date (MMDDYYYY): ".
\par
03 PIC X(08) USING SH-EDIT-DATE.
\par
*
\par
*
\par
* G E T W O R K M M D D Y Y Y Y
\par
*
\par
01 GET-WORK-MMDDYYYY-SCREEN.
\par
03 LINE 14 COLUMN 10 VALUE "Date (MM/DD/YYYY): ".
\par
03 PIC 99/99/9999 USING SH-WORK-MMDDYYYY.
\par
*
\par
*
\par
* G E T W O R K Y Y Y Y M M D D
\par
*
\par
01 GET-WORK-YYYYMMDD-SCREEN.
\par
03 LINE 14 COLUMN 10 VALUE "Date (YYYY/MM/DD): ".
\par
03 PIC 9999/99/99 USING SH-WORK-YYYYMMDD.
\par
*
\par
*
\par
* G E T J U L Y Y Y Y D D D
\par
*
\par
01 GET-JUL-YYYYDDD-SCREEN.
\par
03 LINE 14 COLUMN 10 VALUE "Julian Date (YYYY/DDD): ".
\par
03 PIC 9999/999 USING SH-JUL-DATE.
\par
*
\par
*
\par
* G E T D A T E D A Y S
\par
*
\par
01 GET-DATE-DAYS-SCREEN.
\par
03 LINE 14 COLUMN 10 VALUE "Date (YYYY/MM/DD): ".
\par
03 PIC 9999/99/99 USING SH-WORK-YYYYMMDD.
\par
03 LINE 16 COLUMN 10 VALUE "Days: ".
\par
03 PIC ZZZZZZ USING SH-DAYS.
\par
*
\par
*
\par
* G E T D A T E M O N T H S
\par
*
\par
01 GET-DATE-MONTHS-SCREEN.
\par
03 LINE 14 COLUMN 10 VALUE "Date (YYYY/MM/DD): ".
\par
03 PIC 9999/99/99 USING SH-WORK-YYYYMMDD.
\par
03 LINE 16 COLUMN 10 VALUE "Months: ".
\par
03 PIC ZZZZZZ USING SH-MONTHS.
\par
*
\par
*
\par
* G E T D A T E Y E A R S
\par
*
\par
01 GET-DATE-YEARS-SCREEN.
\par
03 LINE 14 COLUMN 10 VALUE "Date (YYYY/MM/DD): ".
\par
03 PIC 9999/99/99 USING SH-WORK-YYYYMMDD.
\par
03 LINE 16 COLUMN 10 VALUE "Years: ".
\par
03 PIC ZZZZ USING SH-YEARS.
\par
*
\par
*
\par
* G E T D A T E O F F S E T
\par
*
\par
01 GET-DATE-OFFSET-SCREEN.
\par
03 LINE 14 COLUMN 10 VALUE "Date (YYYY/MM/DD): ".
\par
03 PIC 9999/99/99 USING SH-WORK-YYYYMMDD.
\par
03 LINE 16 COLUMN 10 VALUE "Offset (ñYYYY/MM/DD): ".
\par
03 PIC -9999/99/99 USING SH-OFFSET.
\par
*
\par
*
\par
* G E T B E G / E N D D A T E S
\par
*
\par
01 GET-BEG-END-YYYYMMDD-SCREEN.
\par
03 LINE 14 COLUMN 10 VALUE "Begin Date (YYYY/MM/DD): ".
\par
03 PIC 9999/99/99 USING SH-BEG-YYYYMMDD.
\par
03 LINE 16 COLUMN 10 VALUE "End Date (YYYY/MM/DD): ".
\par
03 PIC 9999/99/99 USING SH-END-YYYYMMDD.
\par
*
\par
*
\par
* O U T P U T S C R E E N S
\par
*
\par
*
\par
* S H O W R E S U L T
\par
*
\par
01 SHOW-RESULT-SCREEN.
\par
03 LINE 18 COLUMN 20
\par
PIC X(20) FROM SH-RESULT.
\par
*
\par
*
\par
* S H O W D A T E D A Y S
\par
*
\par
01 SHOW-DATE-DAYS-SCREEN.
\par
03 LINE 18 COLUMN 20 VALUE "Date Day: ".
\par
03 PIC Z,ZZZ,ZZ9 FROM SH-DAYS.
\par
*
\par
*
\par
* S H O W N E W D A T E
\par
*
\par
01 SHOW-NEW-DATE-SCREEN.
\par
03 LINE 18 COLUMN 20 VALUE "New Date: ".
\par
03 PIC 9999/99/99 FROM SH-WORK-YYYYMMDD.
\par
*
\par
*
\par
* S H O W A G E
\par
*
\par
01 SHOW-AGE-SCREEN.
\par
03 LINE 18 COLUMN 20 VALUE "Years: ".
\par
03 PIC Z,ZZZ,ZZZ FROM SH-AGE-YEARS.
\par
03 LINE 19 COLUMN 20 VALUE "Months: ".
\par
03 PIC Z,ZZZ,ZZZ FROM SH-AGE-MONTHS.
\par
03 LINE 20 COLUMN 20 VALUE "Days: ".
\par
03 PIC Z,ZZZ,ZZZ FROM SH-AGE-DAYS.
\par
03 LINE 22 COLUMN 20 VALUE "Days Only: ".
\par
03 PIC ZZ,ZZZ,ZZZ FROM SH-AGE-TOTDAYS.
\par
*
\par
*
\par
* S H O W J U L Y Y Y Y D D D
\par
*
\par
01 SHOW-JUL-YYYYDDD-SCREEN.
\par
03 LINE 18 COLUMN 10 VALUE "Julian Date: ".
\par
03 PIC 9999/999 FROM SH-JUL-DATE.
\par
*
\par
*
\par
* S H O W Y Y Y Y M M D D
\par
*
\par
01 SHOW-YYYYMMDD-SCREEN.
\par
03 LINE 18 COLUMN 10 VALUE "Date (YYYY/MM/DD): ".
\par
03 PIC 9999/99/99 FROM SH-WORK-YYYYMMDD.
\par
*
\par
*
\par
* S H O W M M D D Y Y Y Y
\par
*
\par
01 SHOW-MMDDYYYY-SCREEN.
\par
03 LINE 18 COLUMN 10 VALUE "Date (MM/DD/YYYY): ".
\par
03 PIC 99/99/9999 FROM SH-WORK-MMDDYYYY.
\par
*
\par
PROCEDURE DIVISION.
\par
*
\par
*
\par
* C O N T R O L
\par
*
\par
000000-CONTROL.
\par
*
\par
PERFORM 000100-PROCESS
\par
THRU 000100-EXIT
\par
UNTIL (WS-ESCAPE-FLAG = 1).
\par
*
\par
000000-EXIT.
\par
STOP RUN.
\par
*
\par
*
\par
* P R O C E S S
\par
*
\par
000100-PROCESS.
\par
*
\par
MOVE SPACE TO WS-ANSWER.
\par
DISPLAY MENU-SCREEN.
\par
ACCEPT MENU-SCREEN
\par
ON ESCAPE
\par
MOVE 1 TO WS-ESCAPE-FLAG
\par
GO TO 000100-EXIT.
\par
INSPECT WS-ANSWER
\par
CONVERTING "abcdefghijklmnopqrstuvwxyz"
\par
TO "ABCDEFGHIJKLMNOPQRSTUVWXYZ".
\par
*
\par
INITIALIZE SCREEN-HOLD-AREA.
\par
*
\par
IF (WS-ANSWER = "A")
\par
PERFORM 010000-DATE-EDIT
\par
THRU 010000-EXIT
\par
ELSE
\par
IF (WS-ANSWER = "B")
\par
PERFORM 020000-DATE-DAYS
\par
THRU 020000-EXIT
\par
ELSE
\par
IF (WS-ANSWER = "C")
\par
PERFORM 030000-WEEKDAY
\par
THRU 030000-EXIT
\par
ELSE
\par
IF (WS-ANSWER = "D")
\par
PERFORM 040000-ADD-DAYS
\par
THRU 040000-EXIT
\par
ELSE
\par
IF (WS-ANSWER = "E")
\par
PERFORM 050000-SUBTRACT-DAYS
\par
THRU 050000-EXIT
\par
ELSE
\par
IF (WS-ANSWER = "F")
\par
PERFORM 060000-ADD-MONTHS
\par
THRU 060000-EXIT
\par
ELSE
\par
IF (WS-ANSWER = "G")
\par
PERFORM 070000-SUBTRACT-MONTHS
\par
THRU 070000-EXIT
\par
ELSE
\par
IF (WS-ANSWER = "H")
\par
PERFORM 080000-ADD-YEARS
\par
THRU 080000-EXIT
\par
ELSE
\par
IF (WS-ANSWER = "I")
\par
PERFORM 090000-SUBTRACT-YEARS
\par
THRU 090000-EXIT
\par
ELSE
\par
IF (WS-ANSWER = "J")
\par
PERFORM 100000-CALC-OFFSET
\par
THRU 100000-EXIT
\par
ELSE
\par
IF (WS-ANSWER = "K")
\par
PERFORM 110000-COMPUTE-AGE
\par
THRU 110000-EXIT
\par
ELSE
\par
IF (WS-ANSWER = "L")
\par
PERFORM 120000-GREG-JUL
\par
THRU 120000-EXIT
\par
ELSE
\par
IF (WS-ANSWER = "M")
\par
PERFORM 130000-JUL-GREG
\par
THRU 130000-EXIT
\par
ELSE
\par
IF (WS-ANSWER = "N")
\par
PERFORM 140000-ADD-DAYS-BUSINESS
\par
THRU 140000-EXIT.
\par
*
\par
MOVE 0 TO WS-ESCAPE-FLAG.
\par
*
\par
000100-EXIT.
\par
EXIT.
\par
*
\par
******************************************************************
\par
* *
\par
* D A T E E D I T *
\par
* *
\par
* Judson D. McClendon *
\par
* Sun Valley Systems *
\par
* 329 37th Court NE *
\par
* Birmingham, AL 35215 *
\par
* 205/853-8440 *
\par
* *
\par
* USAGE: MOVE <MMDDYYYY DATE> TO DW-WORK-DATE-ALPHA. *
\par
* PERFORM 001000-DATE-EDIT *
\par
* THRU 001000-EXIT. *
\par
* *
\par
* RESULT: DW-DATE-ERROR-FLAG = 0 IF DATE IS VALID *
\par
* DW-DATE-ERROR-FLAG = 1 IF DATE IS NOT VALID *
\par
* *
\par
* DW-WORK-YYYYMMDD = GIVEN DATE IN YYYYMMDD FORMAT *
\par
* DW-DAYS-IN-MONTH = CORRECT FOR YEAR OF THIS DATE *
\par
* *
\par
******************************************************************
\par
*
\par
001000-DATE-EDIT.
\par
*
\par
* ** ERROR FLAG WILL BE RESET TO 0 ON GOOD EXIT **
\par
*
\par
MOVE 1 TO DW-DATE-ERROR-FLAG.
\par
*
\par
IF (DW-WORK-DATE-ALPHA NOT NUMERIC)
\par
GO TO 001000-EXIT.
\par
*
\par
MOVE DW-WORK-YEAR TO DW-WORK-YYYY.
\par
MOVE DW-WORK-MONTH TO DW-WORK-MM.
\par
MOVE DW-WORK-DAY TO DW-WORK-DD.
\par
*
\par
IF (DW-WORK-MM < 01 OR > 12)
\par
GO TO 001000-EXIT.
\par
*
\par
* ** SET DAYS IN FEBRUARY **
\par
*
\par
MOVE 28 TO DW-DAYS-IN-MONTH(2).
\par
DIVIDE 400 INTO DW-WORK-YYYY GIVING DW-WORK1
\par
REMAINDER DW-WORK2.
\par
IF (DW-WORK2 = 0)
\par
MOVE 29 TO DW-DAYS-IN-MONTH(2)
\par
ELSE
\par
DIVIDE 100 INTO DW-WORK-YYYY GIVING DW-WORK1
\par
REMAINDER DW-WORK2
\par
IF (DW-WORK2 NOT = 0)
\par
DIVIDE 4 INTO DW-WORK-YYYY GIVING DW-WORK1
\par
REMAINDER DW-WORK2
\par
IF (DW-WORK2 = 0)
\par
MOVE 29 TO DW-DAYS-IN-MONTH(2).
\par
*
\par
IF (DW-WORK-DD < 01)
\par
OR
\par
(DW-WORK-DD > DW-DAYS-IN-MONTH(DW-WORK-MM))
\par
GO TO 001000-EXIT.
\par
*
\par
* ** GOOD DATE **
\par
*
\par
MOVE 0 TO DW-DATE-ERROR-FLAG.
\par
*
\par
001000-EXIT.
\par
EXIT.
\par
*
\par
*
\par
*
\par
******************************************************************
\par
* *
\par
* C A L C U L A T E D A T E D A Y N U M B E R *
\par
* *
\par
* *
\par
* RETURNS A NUMBER WHICH IS ONE GREATER FOR EACH SUCCESSIVE *
\par
* DATE. *
\par
* *
\par
* USAGE: MOVE <FIRST DATE> TO DW-WORK-YYYYMMDD. *
\par
* PERFORM 001100-DATE-DAYS *
\par
* THRU 001100-EXIT. *
\par
* *
\par
* RESULT: DW-DAYS = DATE DAY NUMBER *
\par
* *
\par
* *
\par
* THIS ROUTINE USES A VARIATION OF ZELLER'S CONGRUENCE. *
\par
* THE FORMULA IS: *
\par
* *
\par
* <DATE DAY NBR> = ( (YEAR * 365) *
\par
* + INT(YEAR / 4) *
\par
* - INT(YEAR / 100) *
\par
* + INT(YEAR / 400) *
\par
* + INT(MONTH * 30.6001) *
\par
* + DAY) ) *
\par
* *
\par
* WHERE: DAY = DAY OF THE MONTH *
\par
* *
\par
* MONTH = MONTH + 13 (JAN & FEB) *
\par
* MONTH + 1 (MAR - DEC) *
\par
* *
\par
* YEAR = YEAR - 1 (JAN & FEB) *
\par
* YEAR (MAR - DEC) *
\par
* *
\par
* INT(...) MEANS TAKE THE INTEGER PART (NO ROUNDING) *
\par
* *
\par
* *
\par
* THE DATE-DAY-NUMBER CAN BE USED TO DETERMINE THE NUMBER OF *
\par
* DAYS BETWEEN TWO DATES BY COMPUTING THE DAY NUMBER OF EACH *
\par
* DATE AND SUBTRACTING, LIKE THIS: *
\par
* *
\par
* MOVE <FIRST DATE> TO DW-WORK-YYYYMMDD. *
\par
* PERFORM 001100-DATE-DAYS *
\par
* THRU 001100-EXIT. *
\par
* MOVE DW-DAYS TO <HOLD DAY>. *
\par
* MOVE <SECOND DATE> TO DW-WORK-YYYYMMDD. *
\par
* PERFORM 001100-DATE-DAYS *
\par
* THRU 001100-EXIT. *
\par
* SUBTRACT DW-DAYS FROM <HOLD DAY> *
\par
* GIVING <DAYS BETWEEN DATES>. *
\par
* *
\par
******************************************************************
\par
*
\par
001100-DATE-DAYS.
\par
*
\par
* ** ADJUST YEAR AND MONTH **
\par
*
\par
MOVE DW-WORK-YYYY TO DW-TEMP-YYYY.
\par
MOVE DW-WORK-MM TO DW-TEMP-MM.
\par
IF (DW-WORK-MM < 03)
\par
ADD 13 TO DW-TEMP-MM
\par
SUBTRACT 1 FROM DW-TEMP-YYYY
\par
ELSE
\par
ADD 1 TO DW-TEMP-MM.
\par
*
\par
MULTIPLY DW-TEMP-YYYY BY 365 GIVING DW-DAYS.
\par
*
\par
DIVIDE DW-TEMP-YYYY BY 4 GIVING DW-WORK1.
\par
ADD DW-WORK1 TO DW-DAYS.
\par
*
\par
DIVIDE DW-TEMP-YYYY BY 100 GIVING DW-WORK1.
\par
SUBTRACT DW-WORK1 FROM DW-DAYS.
\par
*
\par
DIVIDE DW-TEMP-YYYY BY 400 GIVING DW-WORK1.
\par
ADD DW-WORK1 TO DW-DAYS.
\par
*
\par
MULTIPLY DW-TEMP-MM BY 30.6001 GIVING DW-WORK1.
\par
ADD DW-WORK1 TO DW-DAYS.
\par
*
\par
ADD DW-WORK-DD TO DW-DAYS.
\par
*
\par
001100-EXIT.
\par
EXIT.
\par
*
\par
*
\par
*
\par
******************************************************************
\par
* *
\par
* C A L C U L A T E D A Y O F W E E K *
\par
* *
\par
* *
\par
* WHEN GIVEN ANY DATE THIS ROUTINE RETURNS A NUMBER FROM *
\par
* 1 TO 7 INDICATING THE DAY OF WEEK ON WHICH THE DATE FALLS. *
\par
* *
\par
* *
\par
* USAGE: MOVE <DATE> TO DW-WORK-YYYYMMDD. *
\par
* PERFORM 001200-WEEKDAY *
\par
* THRU 001200-EXIT. *
\par
* *
\par
* RESULT: DW-WEEKDAY = DAY OF WEEK *
\par
* *
\par
* *
\par
* THIS ROUTINE USES ZELLER'S CONGRUENCE, EXPRESSED BY THE *
\par
* FOLLOWING FORMULA: *
\par
* *
\par
* <WEEKDAY> = (INT((13 * MONTH + 3) / 5) *
\par
* + DAY *
\par
* + YEAR *
\par
* + INT(YEAR / 4) *
\par
* - INT(YEAR / 100) *
\par
* + INT(YEAR / 400) *
\par
* + 1) MOD 7) + 1 *
\par
* *
\par
* WHERE: WEEKDAY = 1 TO 7 WITH 1 = SUNDAY 5 = THURSDAY *
\par
* 2 = MONDAY 6 = FRIDAY *
\par
* 3 = TUESDAY 7 = SATURDAY *
\par
* 4 = WEDNESDAY *
\par
* *
\par
* DAY = DAY OF THE MONTH *
\par
* *
\par
* MONTH = MONTH OF THE YEAR (JAN AND FEB COUNT AS *
\par
* MONTHS 13 AND 14 OF THE PREVIOUS YEAR) *
\par
* *
\par
* YEAR = FOUR DIGIT YEAR (YEAR - 1 IF MONTH IS *
\par
* JAN OR FEB) *
\par
* *
\par
* INT(...) MEANS TAKE THE INTEGER PART (NO ROUNDING) *
\par
* *
\par
* X MOD Y MEANS THE REMAINDER AFTER DIVIDING Y *
\par
* INTO X *
\par
* *
\par
******************************************************************
\par
*
\par
001200-WEEKDAY.
\par
*
\par
* ** ADJUST YEAR AND MONTH IF MONTH = JAN OR FEB **
\par
*
\par
MOVE DW-WORK-YYYY TO DW-TEMP-YYYY.
\par
MOVE DW-WORK-MM TO DW-TEMP-MM.
\par
IF (DW-WORK-MM < 03)
\par
ADD 12 TO DW-TEMP-MM
\par
SUBTRACT 1 FROM DW-TEMP-YYYY.
\par
*
\par
* ** CALCULATE INTO DW-WORK1 **
\par
*
\par
COMPUTE DW-WORK1 = (13 * DW-TEMP-MM + 3) / 5.
\par
*
\par
ADD DW-WORK-DD
\par
DW-TEMP-YYYY TO DW-WORK1.
\par
*
\par
DIVIDE DW-TEMP-YYYY BY 4 GIVING DW-WORK2.
\par
ADD DW-WORK2 TO DW-WORK1.
\par
*
\par
DIVIDE DW-TEMP-YYYY BY 100 GIVING DW-WORK2.
\par
SUBTRACT DW-WORK2 FROM DW-WORK1.
\par
*
\par
DIVIDE DW-TEMP-YYYY BY 400 GIVING DW-WORK2.
\par
ADD DW-WORK2 TO DW-WORK1.
\par
*
\par
ADD 1 TO DW-WORK1.
\par
*
\par
DIVIDE DW-WORK1 BY 7 GIVING DW-WORK2 REMAINDER DW-WEEKDAY.
\par
ADD 1 TO DW-WEEKDAY.
\par
*
\par
001200-EXIT.
\par
EXIT.
\par
*
\par
*
\par
*
\par
******************************************************************
\par
* *
\par
* A D D D A Y S T O A D A T E *
\par
* *
\par
* *
\par
* WHEN GIVEN ANY DATE AND A NUMBER OF DAYS THIS ROUTINE WILL *
\par
* ADD THE NUMBER OF DAYS TO THE DATE. *
\par
* *
\par
* *
\par
* USAGE: MOVE <DATE> TO DW-WORK-YYYYMMDD. *
\par
* MOVE <DAYS> TO DW-DAYS. *
\par
* PERFORM 001300-ADD-DAYS *
\par
* THRU 001300-EXIT. *
\par
* *
\par
* RESULT: DW-WORK-YYYYMMDD = DATE AFTER DAYS ADDED *
\par
* DW-DAYS-IN-MONTH = CORRECT FOR YEAR OF THIS DATE *
\par
* *
\par
******************************************************************
\par
*
\par
001300-ADD-DAYS.
\par
*
\par
* ** SET DAYS IN FEBRUARY **
\par
*
\par
MOVE 28 TO DW-DAYS-IN-MONTH(2).
\par
DIVIDE 400 INTO DW-WORK-YYYY GIVING DW-WORK1
\par
REMAINDER DW-WORK2.
\par
IF (DW-WORK2 = 0)
\par
MOVE 29 TO DW-DAYS-IN-MONTH(2)
\par
ELSE
\par
DIVIDE 100 INTO DW-WORK-YYYY GIVING DW-WORK1
\par
REMAINDER DW-WORK2
\par
IF (DW-WORK2 NOT = 0)
\par
DIVIDE 4 INTO DW-WORK-YYYY GIVING DW-WORK1
\par
REMAINDER DW-WORK2
\par
IF (DW-WORK2 = 0)
\par
MOVE 29 TO DW-DAYS-IN-MONTH(2).
\par
*
\par
ADD DW-WORK-DD TO DW-DAYS.
\par
*
\par
PERFORM 001320-LOOP-MONTH
\par
THRU 001320-EXIT
\par
UNTIL (DW-DAYS NOT > DW-DAYS-IN-MONTH(DW-WORK-MM)).
\par
*
\par
MOVE DW-DAYS TO DW-WORK-DD.
\par
*
\par
001300-EXIT.
\par
EXIT.
\par
*
\par
*
\par
*
\par
001320-LOOP-MONTH.
\par
*
\par
SUBTRACT DW-DAYS-IN-MONTH(DW-WORK-MM) FROM DW-DAYS.
\par
*
\par
ADD 1 TO DW-WORK-MM.
\par
IF (DW-WORK-MM > 12)
\par
ADD 1 TO DW-WORK-YYYY
\par
SUBTRACT 12 FROM DW-WORK-MM.
\par
*
\par
MOVE 28 TO DW-DAYS-IN-MONTH(2).
\par
DIVIDE 400 INTO DW-WORK-YYYY GIVING DW-WORK1
\par
REMAINDER DW-WORK2.
\par
IF (DW-WORK2 = 0)
\par
MOVE 29 TO DW-DAYS-IN-MONTH(2)
\par
ELSE
\par
DIVIDE 100 INTO DW-WORK-YYYY GIVING DW-WORK1
\par
REMAINDER DW-WORK2
\par
IF (DW-WORK2 NOT = 0)
\par
DIVIDE 4 INTO DW-WORK-YYYY GIVING DW-WORK1
\par
REMAINDER DW-WORK2
\par
IF (DW-WORK2 = 0)
\par
MOVE 29 TO DW-DAYS-IN-MONTH(2).
\par
*
\par
001320-EXIT.
\par
EXIT.
\par
*
\par
*
\par
*
\par
******************************************************************
\par
* *
\par
* S U B T R A C T D A Y S F R O M A D A T E *
\par
* *
\par
* *
\par
* WHEN GIVEN ANY DATE AND A NUMBER OF DAYS THIS ROUTINE WILL *
\par
* SUBTRACT THE NUMBER OF DAYS FROM THE DATE. *
\par
* *
\par
* *
\par
* USAGE: MOVE <DATE> TO DW-WORK-YYYYMMDD. *
\par
* MOVE <DAYS> TO DW-DAYS. *
\par
* PERFORM 001400-SUBTRACT-DAYS *
\par
* THRU 001400-EXIT. *
\par
* *
\par
* RESULT: DW-WORK-YYYYMMDD = DATE AFTER DAYS SUBTRACTED *
\par
* DW-DAYS-IN-MONTH = CORRECT FOR YEAR OF THIS DATE *
\par
* *
\par
******************************************************************
\par
*
\par
001400-SUBTRACT-DAYS.
\par
*
\par
SUBTRACT DW-DAYS FROM DW-WORK-DD GIVING DW-DAYS.
\par
*
\par
PERFORM 001420-LOOP-MONTH
\par
THRU 001420-EXIT
\par
UNTIL (DW-DAYS > 0).
\par
*
\par
MOVE DW-DAYS TO DW-WORK-DD.
\par
*
\par
001400-EXIT.
\par
EXIT.
\par
*
\par
*
\par
*
\par
001420-LOOP-MONTH.
\par
*
\par
SUBTRACT 1 FROM DW-WORK-MM.
\par
IF (DW-WORK-MM < 01)
\par
SUBTRACT 1 FROM DW-WORK-YYYY
\par
ADD 12 TO DW-WORK-MM.
\par
*
\par
MOVE 28 TO DW-DAYS-IN-MONTH(2).
\par
DIVIDE 400 INTO DW-WORK-YYYY GIVING DW-WORK1
\par
REMAINDER DW-WORK2.
\par
IF (DW-WORK2 = 0)
\par
MOVE 29 TO DW-DAYS-IN-MONTH(2)
\par
ELSE
\par
DIVIDE 100 INTO DW-WORK-YYYY GIVING DW-WORK1
\par
REMAINDER DW-WORK2
\par
IF (DW-WORK2 NOT = 0)
\par
DIVIDE 4 INTO DW-WORK-YYYY GIVING DW-WORK1
\par
REMAINDER DW-WORK2
\par
IF (DW-WORK2 = 0)
\par
MOVE 29 TO DW-DAYS-IN-MONTH(2).
\par
*
\par
ADD DW-DAYS-IN-MONTH(DW-WORK-MM) TO DW-DAYS.
\par
*
\par
001420-EXIT.
\par
EXIT.
\par
*
\par
*
\par
*
\par
******************************************************************
\par
* *
\par
* A D D M O N T H S T O A D A T E *
\par
* *
\par
* *
\par
* WHEN GIVEN ANY DATE AND A NUMBER OF MONTHS THIS ROUTINE *
\par
* WILL ADD THE NUMBER OF MONTHS TO THE DATE. *
\par
* *
\par
* *
\par
* USAGE: MOVE <DATE> TO DW-WORK-YYYYMMDD. *
\par
* MOVE <MONTHS> TO DW-MONTHS. *
\par
* PERFORM 001500-ADD-MONTHS *
\par
* THRU 001500-EXIT. *
\par
* *
\par
* RESULT: DW-WORK-YYYYMMDD = DATE AFTER MONTHS ADDED *
\par
* DW-DAYS-IN-MONTH = CORRECT FOR YEAR OF THIS DATE *
\par
* *
\par
******************************************************************
\par
*
\par
001500-ADD-MONTHS.
\par
*
\par
ADD DW-WORK-MM TO DW-MONTHS.
\par
*
\par
PERFORM 001520-LOOP-YEAR
\par
THRU 001520-EXIT
\par
UNTIL (DW-MONTHS NOT > 12).
\par
*
\par
MOVE DW-MONTHS TO DW-WORK-MM.
\par
*
\par
MOVE 28 TO DW-DAYS-IN-MONTH(2).
\par
DIVIDE 400 INTO DW-WORK-YYYY GIVING DW-WORK1
\par
REMAINDER DW-WORK2.
\par
IF (DW-WORK2 = 0)
\par
MOVE 29 TO DW-DAYS-IN-MONTH(2)
\par
ELSE
\par
DIVIDE 100 INTO DW-WORK-YYYY GIVING DW-WORK1
\par
REMAINDER DW-WORK2
\par
IF (DW-WORK2 NOT = 0)
\par
DIVIDE 4 INTO DW-WORK-YYYY GIVING DW-WORK1
\par
REMAINDER DW-WORK2
\par
IF (DW-WORK2 = 0)
\par
MOVE 29 TO DW-DAYS-IN-MONTH(2).
\par
*
\par
IF (DW-WORK-DD > DW-DAYS-IN-MONTH(DW-WORK-MM))
\par
MOVE DW-DAYS-IN-MONTH(DW-WORK-MM) TO DW-WORK-DD.
\par
*
\par
001500-EXIT.
\par
EXIT.
\par
*
\par
*
\par
*
\par
001520-LOOP-YEAR.
\par
*
\par
SUBTRACT 12 FROM DW-MONTHS.
\par
ADD 1 TO DW-WORK-YYYY.
\par
*
\par
001520-EXIT.
\par
EXIT.
\par
*
\par
*
\par
*
\par
******************************************************************
\par
* *
\par
* S U B T R A C T M O N T H S F R O M A D A T E *
\par
* *
\par
* *
\par
* WHEN GIVEN ANY DATE AND A NUMBER OF MONTHS THIS ROUTINE *
\par
* WILL SUBTRACT THE NUMBER OF MONTHS FROM THE DATE. *
\par
* *
\par
* *
\par
* USAGE: MOVE <DATE> TO DW-WORK-YYYYMMDD. *
\par
* MOVE <MONTHS> TO DW-MONTHS. *
\par
* PERFORM 001600-SUBTRACT-MONTHS *
\par
* THRU 001600-EXIT. *
\par
* *
\par
* RESULT: DW-WORK-YYYYMMDD = DATE AFTER MONTHS SUBTRACTED *
\par
* DW-DAYS-IN-MONTH = CORRECT FOR YEAR OF THIS DATE *
\par
* *
\par
******************************************************************
\par
*
\par
001600-SUBTRACT-MONTHS.
\par
*
\par
SUBTRACT DW-MONTHS FROM DW-WORK-MM GIVING DW-MONTHS.
\par
*
\par
PERFORM 001620-LOOP-YEAR
\par
THRU 001620-EXIT
\par
UNTIL (DW-MONTHS > 0).
\par
*
\par
MOVE DW-MONTHS TO DW-WORK-MM.
\par
*
\par
MOVE 28 TO DW-DAYS-IN-MONTH(2).
\par
DIVIDE 400 INTO DW-WORK-YYYY GIVING DW-WORK1
\par
REMAINDER DW-WORK2.
\par
IF (DW-WORK2 = 0)
\par
MOVE 29 TO DW-DAYS-IN-MONTH(2)
\par
ELSE
\par
DIVIDE 100 INTO DW-WORK-YYYY GIVING DW-WORK1
\par
REMAINDER DW-WORK2
\par
IF (DW-WORK2 NOT = 0)
\par
DIVIDE 4 INTO DW-WORK-YYYY GIVING DW-WORK1
\par
REMAINDER DW-WORK2
\par
IF (DW-WORK2 = 0)
\par
MOVE 29 TO DW-DAYS-IN-MONTH(2).
\par
*
\par
IF (DW-WORK-DD > DW-DAYS-IN-MONTH(DW-WORK-MM))
\par
MOVE DW-DAYS-IN-MONTH(DW-WORK-MM) TO DW-WORK-DD.
\par
*
\par
001600-EXIT.
\par
EXIT.
\par
*
\par
*
\par
*
\par
001620-LOOP-YEAR.
\par
*
\par
ADD 12 TO DW-MONTHS.
\par
SUBTRACT 1 FROM DW-WORK-YYYY.
\par
*
\par
001620-EXIT.
\par
EXIT.
\par
*
\par
*
\par
*
\par
******************************************************************
\par
* *
\par
* A D D Y E A R S T O A D A T E *
\par
* *
\par
* *
\par
* WHEN GIVEN ANY DATE AND A NUMBER OF YEARS THIS ROUTINE *
\par
* WILL ADD THE NUMBER OF YEARS TO THE DATE. *
\par
* *
\par
* *
\par
* USAGE: MOVE <DATE> TO DW-WORK-YYYYMMDD. *
\par
* MOVE <YEARS> TO DW-YEARS. *
\par
* PERFORM 001700-ADD-YEARS *
\par
* THRU 001700-EXIT. *
\par
* *
\par
* RESULT: DW-WORK-YYYYMMDD = DATE AFTER YEARS ADDED *
\par
* DW-DAYS-IN-MONTH = CORRECT FOR YEAR OF THIS DATE *
\par
* *
\par
******************************************************************
\par
*
\par
001700-ADD-YEARS.
\par
*
\par
ADD DW-YEARS TO DW-WORK-YYYY.
\par
*
\par
MOVE 28 TO DW-DAYS-IN-MONTH(2).
\par
DIVIDE 400 INTO DW-WORK-YYYY GIVING DW-WORK1
\par
REMAINDER DW-WORK2.
\par
IF (DW-WORK2 = 0)
\par
MOVE 29 TO DW-DAYS-IN-MONTH(2)
\par
ELSE
\par
DIVIDE 100 INTO DW-WORK-YYYY GIVING DW-WORK1
\par
REMAINDER DW-WORK2
\par
IF (DW-WORK2 NOT = 0)
\par
DIVIDE 4 INTO DW-WORK-YYYY GIVING DW-WORK1
\par
REMAINDER DW-WORK2
\par
IF (DW-WORK2 = 0)
\par
MOVE 29 TO DW-DAYS-IN-MONTH(2).
\par
*
\par
IF (DW-WORK-DD > DW-DAYS-IN-MONTH(DW-WORK-MM))
\par
MOVE DW-DAYS-IN-MONTH(DW-WORK-MM) TO DW-WORK-DD.
\par
*
\par
001700-EXIT.
\par
EXIT.
\par
*
\par
*
\par
*
\par
******************************************************************
\par
* *
\par
* S U B T R A C T Y E A R S F R O M A D A T E *
\par
* *
\par
* *
\par
* WHEN GIVEN ANY DATE AND A NUMBER OF YEARS THIS ROUTINE *
\par
* WILL SUBTRACT THE NUMBER OF YEARS FROM THE DATE. *
\par
* *
\par
* *
\par
* USAGE: MOVE <DATE> TO DW-WORK-YYYYMMDD. *
\par
* MOVE <YEARS> TO DW-YEARS. *
\par
* PERFORM 001800-SUBTRACT-YEARS *
\par
* THRU 001800-EXIT. *
\par
* *
\par
* RESULT: DW-WORK-YYYYMMDD = DATE AFTER YEARS SUBTRACTED *
\par
* DW-DAYS-IN-MONTH = CORRECT FOR YEAR OF THIS DATE *
\par
* *
\par
******************************************************************
\par
*
\par
001800-SUBTRACT-YEARS.
\par
*
\par
SUBTRACT DW-YEARS FROM DW-WORK-YYYY.
\par
*
\par
MOVE 28 TO DW-DAYS-IN-MONTH(2).
\par
DIVIDE 400 INTO DW-WORK-YYYY GIVING DW-WORK1
\par
REMAINDER DW-WORK2.
\par
IF (DW-WORK2 = 0)
\par
MOVE 29 TO DW-DAYS-IN-MONTH(2)
\par
ELSE
\par
DIVIDE 100 INTO DW-WORK-YYYY GIVING DW-WORK1
\par
REMAINDER DW-WORK2
\par
IF (DW-WORK2 NOT = 0)
\par
DIVIDE 4 INTO DW-WORK-YYYY GIVING DW-WORK1
\par
REMAINDER DW-WORK2
\par
IF (DW-WORK2 = 0)
\par
MOVE 29 TO DW-DAYS-IN-MONTH(2).
\par
*
\par
IF (DW-WORK-DD > DW-DAYS-IN-MONTH(DW-WORK-MM))
\par
MOVE DW-DAYS-IN-MONTH(DW-WORK-MM) TO DW-WORK-DD.
\par
*
\par
001800-EXIT.
\par
EXIT.
\par
*
\par
*
\par
*
\par
******************************************************************
\par
* *
\par
* C A L C U L A T E D A T E O F F S E T *
\par
* *
\par
* *
\par
* ADDS A SIGNED OFFSET IN THE FORM +-YYYYMMDD TO A DATE *
\par
* IN YYYYMMDD FORM. *
\par
* *
\par
* *
\par
* USAGE: MOVE <DATE> TO DW-WORK-YYYYMMDD. *
\par
* MOVE <OFFSET> TO DW-OFFSET. *
\par
* PERFORM 001900-CALC-OFFSET *
\par
* THRU 001900-EXIT. *
\par
* *
\par
* RESULT: DW-WORK-YYYYMMDD DATE AFTER OFFSET APPLIED *
\par
* DW-DAYS-IN-MONTH = CORRECT FOR YEAR OF THIS DATE *
\par
* *
\par
******************************************************************
\par
*
\par
001900-CALC-OFFSET.
\par
*
\par
MOVE DW-OFFSET TO DW-OFFSET-UNSIGNED.
\par
*
\par
IF (DW-OFFSET POSITIVE)
\par
ADD DW-OFFSET-YYYY TO DW-WORK-YYYY
\par
MOVE DW-OFFSET-MM TO DW-MONTHS
\par
PERFORM 001500-ADD-MONTHS
\par
THRU 001500-EXIT
\par
MOVE DW-OFFSET-DD TO DW-DAYS
\par
PERFORM 001300-ADD-DAYS
\par
THRU 001300-EXIT
\par
ELSE
\par
IF (DW-OFFSET NEGATIVE)
\par
SUBTRACT DW-OFFSET-YYYY FROM DW-WORK-YYYY
\par
PERFORM 001920-SUBTRACT-MONTH
\par
THRU 001920-EXIT
\par
DW-OFFSET-MM TIMES
\par
MOVE DW-OFFSET-DD TO DW-DAYS
\par
PERFORM 001400-SUBTRACT-DAYS
\par
THRU 001400-EXIT.
\par
*
\par
001900-EXIT.
\par
EXIT.
\par
*
\par
*
\par
*
\par
001920-SUBTRACT-MONTH.
\par
*
\par
SUBTRACT 1 FROM DW-WORK-MM.
\par
IF (DW-WORK-MM < 01)
\par
SUBTRACT 1 FROM DW-WORK-YYYY
\par
ADD 12 TO DW-WORK-MM.
\par
*
\par
001920-EXIT.
\par
EXIT.
\par
*
\par
*
\par
*
\par
******************************************************************
\par
* *
\par
* C O M P U T E A G E *
\par
* *
\par
* *
\par
* WHEN GIVEN THE BEGIN DATE AND END DATE THIS ROUTINE *
\par
* CALCULATES THE AGE IN YEARS, MONTHS, DAYS AND TOTAL DAYS. *
\par
* *
\par
* *
\par
* USAGE: MOVE <BEGIN DATE> TO DW-BEG-YYYYMMDD. *
\par
* MOVE <END DATE> TO DW-END-YYYYMMDD. *
\par
* PERFORM 002000-COMPUTE-AGE *
\par
* THRU 002000-EXIT. *
\par
* *
\par
* RESULT: DW-AGE-YEARS = WHOLE YEARS *
\par
* DW-AGE-MONTHS = MONTHS OVER WHOLE YEAR *
\par
* DW-AGE-DAYS = DAYS OVER WHOLE MONTH *
\par
* *
\par
* (IE: AGE = YEARS + MONTHS + DAYS) *
\par
* *
\par
* DW-AGE-TOTDAYS = TOTAL AGE IN DAYS *
\par
* *
\par
* DW-BEG-YYYYMMDD = HAS BEEN MODIFIED *
\par
* DW-END-YYYYMMDD = HAS BEEN MODIFIED *
\par
* *
\par
******************************************************************
\par
*
\par
002000-COMPUTE-AGE.
\par
*
\par
* ** CALCULATE AGE IN DAYS **
\par
*
\par
MOVE DW-END-YYYYMMDD TO DW-WORK-YYYYMMDD.
\par
PERFORM 001100-DATE-DAYS
\par
--> --------------------
--> maximum size reached
--> --------------------
[ Dauer der Verarbeitung: 0.43 Sekunden
(vorverarbeitet)
]
