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