× 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.



I've implemented the Zeller Congruence in RPG IV.
I attempted to do both RPG IV on OS/400 V4R4 and later and for V5R1 and
later.
That is what the /IF DEFINED(*V5R1M0) is doing.

Here's the code and thanks to Rick for pointing out the website that had
the equation.

There are two procedures: DayOfWeek which returns the day of the week
using the IBM-supplied API. It work good and should be used in all
cases. The second procedure is named GetDayEx() and returns the day of
the week using the Zeller Congruence

Bob Cozzi
www.rpgworld.com


These are the prototypes, stored in the /COPY named DATES in QCPYSRC.
      /IF NOT DEFINED(RTK_DATES)
      /DEFINE RTK_DATES
     D DayOfWeek       PR            10I 0
     D  InDate                         D   Const DATFMT(*ISO)

     D GetDayEx        PR            10I 0
     D  InDate                         D   Const DATFMT(*ISO)

     D GetEndOfMonth   PR              D   DATFMT(*ISO)
     D  InDate                         D   Const DATFMT(*ISO)
      /ENDIF

This is the source for the two procedures DayOfWeek() and GetDateEx(),
since I simply updated the source from my RPG ToolKit it has some
additional comments and other stuff (like copyrights) in there.
Hope this helps

Bob Cozzi

     H NOMAIN BNDDIR('QC2LE')
     H Copyright('2002 by Robert Cozzi, Jr. All Rights Reserved.')
      ******************************************************************
      **  (c) Copyright 2002 by Robert Cozzi, Jr.
      **      Portions Copyright 1988 by Robert Cozzi, Jr.
      **      All rights reserved.
      **      Part of the RPG ToolKit for OS/400 www.rpgiv.com/toolkit
      ******************************************************************
      /COPY QCPYSRC,dates

.....P*rocName+++++++..B...................Functions++++++++++++++++++++
+++++++
     P DayOfWeek       B                   EXPORT
      ** Procedure interface for DayOfWeek function
.....D*ame+++++++++++EUDS.......Length+TDc.Functions++++++++++++++++++++
+++++++
     D DayOfWeek       PI            10I 0
     D  InputDate                      D   CONST DATFMT(*ISO)
     ** Base date is based on calendar changed date
     D BaseDate        S               D   Static INZ(D'1582-10-14')
     D nDayOfWeek      S             10I 0
     D nDays           S             10I 0
.....C*Rn01Factor1+++++++OpCode(ex)Factor2+++++++Result++++++++Len++DcHi
LoEq
     C                   TEST(E)                 InputDate
     C                   If        %ERROR
     C                   Return    -1
     C                   Endif
     C     InputDate     SubDur    BaseDate      nDays:*DAYS

     C                   CALLB     'CEEDYWK'
     C                   Parm                    nDays
     C                   Parm                    nDayofWeek

     C                   return    nDayOfWeek
     P DayOfWeek       E

     P GetDayEx        B                   Export

     D GetDayEx        PI            10I 0
     D  InDate                         D   Const DATFMT(*ISO)

     D nPart1          S             10I 0
     D nDay            S             10I 0
     D nMonth          S             10I 0
     D nYear           S             10I 0
     D nMod            S             10I 0
     D nDayOfWeek      S             10I 0

     C                   Extrct    InDate:*D     nDay
     C                   Extrct    InDate:*M     nMonth
     C                   Extrct    InDate:*Y     nYear
     C                   if        nMonth < 3
     C                   eval      nMonth = nMonth + 12
     C                   eval      nYear  = nYear  -  1
     C                   endif
      /IF DEFINED(*V5R1M0)
     C                   Eval      nDayOfWeek =
%Rem(%div((13*nMonth+3):5) +
     C                                      nDay + nYear + %div(nYear:4)
-
     C                                      %div(nYear/100) +
%div(nYear:400))
     C                                      : 7)
     C/ELSE
     C                   eval      nPart1 = %Int((13*nMonth+3)/5) +
     C                                      nDay + nYear + %int(nYear/4)
-
     C                                      %int(nYear/100) +
%int(nYear/400)
     C     nPart1        DIV       7             nMod
     C                   MVR                     nDayOfWeek
     C/ENDIF
      **  The date we return is ones-based and Sunday oriented (1=Sun,
2=Mon, etc.)
      **  whereas the calculation produces a zero-based and
Monday-oriented
      **    (e.g., 0=Mon, 1=Tues, 3=Wed, etc. 7=Sun).
      **  We need to convert the day from the Mon=0-based value to the
Sun=1 based value.
     C                   If        nDayOfWeek > 5
     C                   Eval      nDayOfWeek = nDayOfWeek - 5
     C                   else
     C                   eval      nDayOfWeek + 2
     C                   endif
     C                   return    nDayOfWeek
     PGetDayEx         E


-----Original Message-----
From: rpg400-l-admin@midrange.com [mailto:rpg400-l-admin@midrange.com]
On Behalf Of rick.pezzimenti@denso.com.au
Sent: Tuesday, December 10, 2002 9:28 PM
To: rpg400-l@midrange.com
Subject: Re: Day of the week


This is a multipart message in MIME format.
--
--
[ Picked text/plain from multipart/alternative ]
Not sure if it has been mentioned here, but chap by the name of Zeller
had a formula for finding the day of the week for any date. Do a search
on google for "zeller's congruence" and it should turn up quite a few
results.  Alternatively, have a look here

http://www.sciencenet.org.uk/database/Maths/Original/m00030d.html

I believe it only works on dates between 1562-3999, which should be ok
for your purpose I would think!




As an Amazon Associate we earn from qualifying purchases.

This thread ...

Replies:

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.