From: Leroy.Donnelly@drbbs.omahug.org (Leroy Donnelly)
Newsgroups: alt.cobol
Subject: COBOL date routine
Date: 10 Oct 92 04:10:24 CST
Reply-To: leroy.donnelly@drbbs.omahug.org
Organization: DRBBS Technical BBS, Omaha
Followup-To: alt.cobol

This should take care of you with the dates.
 
******************************************************************
*    JULIAN-DATE-WORK      DATE CONVERSION WORKING STORAGE       *
*                                                                *
******************************************************************
 
 01  WJULIAN-WORK.
     02  WDTE-RSUL               PIC 99.
     02  WDTE-LEAP               PIC 99.
     02  WJUL-DAYS-2             PIC 999.
     02  WJUL-END-SW             PIC 9.
         88  WJUL-END                              VALUE 1.
     02  WCAL-DTE                PIC 9(6).
     02  WCAL-DTE-2 REDEFINES WCAL-DTE.
         03  WCAL-MONTH          PIC 99.
         03  WCAL-DAY            PIC 99.
         03  WCAL-YEAR           PIC 99.
     02  WJUL-DTE-AREA.
         03  WJUL-DTE            PIC 9(5).
         03  FILLER              PIC 9.
     02  WJUL-DTE-AREA-2 REDEFINES WJUL-DTE-AREA.
         03  WJUL-YEAR           PIC 99.
         03  WJUL-DAYS           PIC 999.
         03  FILLER              PIC 9.
     02  WJUL-TAB.
         03  FILLER              PIC 9(18)
                 VALUE 000031059090120151.
         03  FILLER              PIC 9(18)
                 VALUE 181212243273304334.
     02  WJUL-TAB-2 REDEFINES WJUL-TAB.
         04  WJUL-ENT            OCCURS 12 TIMES
                                 PIC 999.
 
******************************************************************
*    CALANDER-JULIAN       CALANDER TO JULIAN CONVERSION         *
*                                                                *
*        ENTRY  = 9110-CAL-JUL-CONV                              *
*        EXIT   = 9110-EXIT                                      *
*                                                                *
*        INPUT  = WCAL-DTE                 PIC 9(6)              *
*        OUTPUT = WJUL-DTE                 PIC 9(5)              *
*                                                                *
******************************************************************
*
 9110-CAL-JUL-CONV.
     IF WCAL-MONTH < 1 OR > 12
         MOVE 0 TO WJUL-DAYS
     ELSE
         MOVE WJUL-ENT (WCAL-MONTH) TO WJUL-DAYS.
 
     ADD WCAL-DAY TO WJUL-DAYS.
     DIVIDE 4 INTO WCAL-YEAR GIVING WDTE-RSUL
         REMAINDER WDTE-LEAP.
 
     IF WCAL-YEAR > 0 AND WDTE-LEAP = 00 AND WCAL-MONTH > 2
         ADD 1 TO WJUL-DAYS.
 
     MOVE WCAL-YEAR TO WJUL-YEAR.
 
 9110-EXIT.
     EXIT.
******************************************************************
*    DAY-OF-WEEK-WORK      DAY OF WEEK WORKING STORAGE           *
*                                                                *
******************************************************************
 
 01  WDAY-WEEK-WORK.
     02  WWKY-TDAYS              PIC 9(5).
     02  WWKY-WRK                PIC 9(5).
     02  WWKY-LEFT               PIC 99.
     02  WWKY-LEFT-2 REDEFINES WWKY-LEFT.
         03  FILLER              PIC 9.
         03  WWKY-DAY            PIC 9.
     02  WWKY-COMP               PIC 9(5)V999.
     02  WWKY-COMP-2 REDEFINES WWKY-COMP.
         03  WWKY-WHOLE          PIC 9(5).
         03  WWKY-FRACT          PIC 999.
     02  WWKY-TAB.
         03  FILLER              PIC X(9)    VALUE "SUNDAY   ".
         03  FILLER              PIC X(9)    VALUE "MONDAY   ".
         03  FILLER              PIC X(9)    VALUE "TUESDAY  ".
         03  FILLER              PIC X(9)    VALUE "WEDNESDAY".
         03  FILLER              PIC X(9)    VALUE "THURSDAY ".
         03  FILLER              PIC X(9)    VALUE "FRIDAY   ".
         03  FILLER              PIC X(9)    VALUE "SATURDAY ".
     02  WWKY-TAB-2 REDEFINES WWKY-TAB.
         03  WWKY-ENT            OCCURS 7 TIMES
                                 PIC X(9).
     02  WDAY-OF-WEEK            PIC X(9).
******************************************************************
*    DAY-OF-WEEK           CALCULATE THE DAY OF THE WEEK         *
*                                                                *
*        ENTRY  = 9140-DAY-OF-WEEK                               *
*        EXIT   = 9140-EXIT                                      *
*                                                                *
*        INPUT  = WJUL-DTE                 PIC 9(5)              *
*        OUTPUT = WWKY-DAY                 PIC 9                 *
*                     1 = SUN ... 7 = SAT                        *
*                 WDAY-OF-WEEK             PIC X(9)              *
*                                                                *
******************************************************************
*
 9140-DAY-OF-WEEK.
     MULTIPLY WJUL-YEAR BY 365.250 GIVING WWKY-COMP.
     MOVE WWKY-WHOLE TO WWKY-TDAYS.
 
     IF WWKY-TDAYS NOT = 0 AND WWKY-FRACT = 0
         SUBTRACT 1 FROM WWKY-TDAYS.
 
     ADD WJUL-DAYS TO WWKY-TDAYS.
     DIVIDE WWKY-TDAYS BY 7 GIVING WWKY-WRK
         REMAINDER WWKY-LEFT.
 
     ADD 1 TO WWKY-LEFT.
     MOVE WWKY-ENT (WWKY-LEFT) TO WDAY-OF-WEEK.
 
 9140-EXIT.
     EXIT.