× The internal search function is temporarily non-functional. The current search engine is no longer viable and we are researching alternatives.
As a stop gap measure, we are using Google's custom search engine service.
If you know of an easy to use, open source, search engine ... please contact support@midrange.com.


  • Subject: Re: Determine Day of Week
  • From: bmorris@xxxxxxxxxx
  • Date: Fri, 17 Dec 1999 15:09:43 -0500




>Date: Fri, 17 Dec 1999 11:56:01 -0800
>From: Pat Barber <MBOCEANSIDE@postoffice.worldnet.att.net>
>
>This is from last week but it works very well:
>
>G$DW at the bottom of the routine will contain the day of the week....
> GTOJR1
>Transfer Program
>  0001 C           *ENTRY    PLIST
>       C                     PARM           G$MM    20
>       C                     PARM           G$DD    20
>       C                     PARM           G$YYYY  40
>       C                     PARM           G$JD    50
>       C*
> ...

WARNING!!!

I wrote a test program to call this program and it doesn't
reliably give sequential day-of-week values.

I modified the program to display the input date and the
returned day-of-week.  It doesn't work for March of 1900
or 2100 (a bit understandable since these are years divisible
by 4 that are not leap years).  It also fails oddly late in 2173
(that's as far as I tested).  (Actually, I'm not sure it "works"
at all - I was assuming the first day-of-week was correct, and
just checking for the sequence of values.  The day number given
for today (Friday) was 2.)

Here are a couple of pairs of results that are obviously wrong:
DSPLY  02-28-1900    1
DSPLY  03-01-1900    1

DSPLY  12-11-2173    4
DSPLY  12-12-2173    0

I am sorry to say this, but I don't think this routine is
reliable enough, even though it does seem to give a predictable
day-of-week for 1940-2099.

Using the exact same interface, you can write an RPG IV program
to produce correct results:

An additional bonus of this program is that it gives an exception
if you try to give it an invalid date like 02 29 2100.

H DATFMT(*ISO)
D INDATE          DS
D DATE                            D   DATFMT(*USA) INZ
D   DATE_MM                      2S 0 OVERLAY(DATE:1)
D   DATE_DD                      2S 0 OVERLAY(DATE:4)
D   DATE_YYYY                    4S 0 OVERLAY(DATE:7)
D                 DS
D DEC31                           D   DATFMT(*ISO) INZ(D'0001-12-31')
D   DEC31_YYYY                   4S 0 OVERLAY(DEC31:1)
D Sunday          C                   D'1999-12-19'
D Days            S             15P 0

 * Packed numeric parameters
C     *ENTRY        PLIST
C     DATE_MM       PARM                    G$MM              2 0
C     DATE_DD       PARM                    G$DD              2 0
C     DATE_YYYY     PARM                    G$YYYY            4 0
C                   PARM                    G$DW              1 0

 * Calculate the day of the year (julian days)
 * (Number of days between the input date and the previous Dec 31)
C                   EVAL      DEC31_YYYY = DATE_YYYY - 1
C     DATE          SUBDUR    DEC31         G$JD:*DAYS

 * Calculate the day of the week (0 = Sunday)
C     DATE          SUBDUR    Sunday        Days:*DAYS
C                   DIV       7             DAYS
C                   MVR                     G$DW              1 0
C                   IF        G$DW < 0
C                   EVAL      G$DW = G$DW + 7
C                   ENDIF

C*    G$JD          DSPLY                   G$DW
C                   RETURN

Barbara Morris


+---
| This is the Midrange System Mailing List!
| To submit a new message, send your mail to MIDRANGE-L@midrange.com.
| To subscribe to this list send email to MIDRANGE-L-SUB@midrange.com.
| To unsubscribe from this list send email to MIDRANGE-L-UNSUB@midrange.com.
| Questions should be directed to the list owner/operator: david@midrange.com
+---

As an Amazon Associate we earn from qualifying purchases.

This thread ...

Follow-Ups:

Follow On AppleNews
Return to Archive home page | Return to MIDRANGE.COM home page

This mailing list archive is Copyright 1997-2024 by midrange.com and David Gibbs as a compilation work. Use of the archive is restricted to research of a business or technical nature. Any other uses are prohibited. Full details are available on our policy page. If you have questions about this, please contact [javascript protected email address].

Operating expenses for this site are earned using the Amazon Associate program and Google Adsense.