| products/sources/formale Sprachen/Cobol/verschiedene-Autoren/Judson-McClendon/date/ |
|
Quellcode-Bibliothek
© Kompilation durch diese Firma
[Weder Korrektheit noch Funktionsfähigkeit der Software werden zugesichert.]
Datei: namet.cob Sprache: Cobol
|
Haftungsausschluß.rtf KontaktText {Text[227] Haskell[233] Abap[325]}diese Dinge liegen außhalb unserer Verantwortung {\rtf1\ansi\ansicpg1252\deff0{\fonttbl{\f0\fnil\fcharset0 Fixedsys;}{\f1\fmodern\ {\colortbl;\red255\green0\blue0;\red0\green0\blue255;\red0\green0\blue128;\red0\ {\*\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\cf \par \cf3 \f1 77\cf0\f0 \cf4 \f1 WS-ESCAPE-FLAG\cf0\f0 \cf2 \f1 PIC\cf0\f0 9(01) \cf1 \f1 V\cf0\f \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 \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 \par \cf3 \f1 03\cf0\f0 \cf4 \f1 SH-WORK-MMDDYYYY-ALPHA\cf0\f0 \cf1 \f1 REDEFINES\cf0\f0 \cf4 \ \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 \par \cf3 \f1 03\cf0\f0 \cf4 \f1 SH-WORK-YYYYMMDD-ALPHA\cf0\f0 \cf1 \f1 REDEFINES\cf0\f0 \cf4 \ \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\ \par \cf3 \f1 03\cf0\f0 \cf4 \f1 SH-JUL-DATE-ALPHA\cf0\f0 \cf1 \f1 REDEFINES\cf0\f0 \cf4 \f1 SH- \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\ \par \cf3 \f1 03\cf0\f0 \cf4 \f1 SH-BEG-YYYYMMDD-ALPHA\cf0\f0 \cf1 \f1 REDEFINES\cf0\f0 \cf4 \f \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\ \par \cf3 \f1 03\cf0\f0 \cf4 \f1 SH-END-YYYYMMDD-ALPHA\cf0\f0 \cf1 \f1 REDEFINES\cf0\f0 \cf4 \f \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\cf \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 \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 \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\ \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\f \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 \par \cf3 \f1 03\cf0\f0 \cf4 \f1 SH-MONTHS\cf0\f0 \cf2 \f1 PIC\cf0\f0 S9(\cf1 \f1 07) \cf0\f0 V\cf \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 \ \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\cf \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\ \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 \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\ \par \cf3 \f1 03\cf0\f0 \cf4 \f1 DW-TODAYS-YYYYMMDD-ALPHA\cf0\f0 \cf1 \f1 REDEFINES\cf0\f0 \cf \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 --> -------------------- [ Verzeichnis aufwärts0.304unsichere Verbindung ] |