| 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: dir1.jar Sprache: CobolOriginal von: verschiedene© |
|
||||||
|
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.77 Sekunden (vorverarbeitet) ¤ |
schauen Sie vor die Tür
Fenster
Die Firma ist wie angegeben erreichbar.Die farbliche Syntaxdarstellung ist noch experimentell.Bot Zugriff |
