× 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: Can I get the Day of the week?
  • From: rob@xxxxxxxxx
  • Date: Wed, 16 May 2001 09:58:39 -0500


And this is a perfect example of why you would want to switch to ILERPG and
date processing.

Rob Berendt

==================
Remember the Cole!


                                                                                
                                       
                    "Christopher J.                                             
                                       
                    Devous"                  To:     "'RPG400-L@midrange.com'" 
<RPG400-L@midrange.com>                 
                    <cdevous@antigua.        cc:                                
                                       
                    com>                     Subject:     RE: Can I get the Day 
of the week?                           
                    Sent by:                                                    
                                       
                    owner-rpg400-l@mi                                           
                                       
                    drange.com                                                  
                                       
                                                                                
                                       
                                                                                
                                       
                    05/15/01 05:03 PM                                           
                                       
                    Please respond to                                           
                                       
                    RPG400-L                                                    
                                       
                                                                                
                                       
                                                                                
                                       




Try this, it's based on the famous "Doomsday" algorithm by JH Conway:

    100
**************************************************************************
    200       ***
    300       ***      Program Name --  DOWK
    400       ***      Description  --  Calculate Day of Week from
Gregorian
    500       ***                       Date
    600       ***      Author       --  Christopher J. Devous
    700       ***
    800       ***      Algorithm    --
    900       ***
   1000       ***      The last of February, of January will do
   1100       ***      (Except that in Leap Years it's Jan 32)
   1200       ***      Then for even months use the month's own day
   1300       ***      And for odd ones add four, or take it away*
   1400       ***
   1500       ***      Now to work out your doomsday the orthodox way
   1600       ***      Three things you should add to the century day
   1700       ***      Dozens, remainder, and fours in the latter,
   1800       ***      (If you alter by sevens of course it won't matter)
   1900       ***
   2000       ***      In Julian times, lackaday, lackaday
   2100       ***      Zero was Sunday, centuries fell back a day
   2200       ***      But Gregorian four hundreds are always a Tues
   2300       ***      And now centuries extra will take us back twos.
   2400       ***
   2500       ***      *According to length or simply remember
   2600       ***       you only subtract for September or November
   2700       ***
   2800       ***                                                 --J.H.
Conway
   2900       ***
   3000
**************************************************************************
   3100       ***      A R R A Y   S P E C I F I C A T I O N S
   3200
**************************************************************************
   3300      E                    DAR     7   7 10
   3400      E                    SAR     7   7 10
   3500
**************************************************************************
   3600       ***      D A T A   S T R U C T U R E S
   3700
**************************************************************************
   3800      I            DS
   3900      I                                        1   8 RTDATE
   4000      I                                        1   2 RTMM
   4100      I                                        3   4 RTDD
   4200      I                                        5   6 RTCN
   4300      I                                        7   8 RTYN
   4400      I                                        5   8 RTYR
   4500
**************************************************************************
   4600       ***      M A I N L I N E   P R O C E S S I N G
   4700
**************************************************************************
   4800       *
   4900      C                     RESET#C1
   5000      C                     RESET#R1
   5100       *
   5200       *        But Gregorian four hundreds are always a Tues
   5300       *        And now centuries extra will take us back twos.
   5400       *
   5500      C           #CN       DIV  4         #C1
   5600      C                     MVR            #R1
   5700      C                     MULT 2         #R1
   5800       *
   5900      C           #R1       IFGT 2
   6000      C           10        SUB  #R1       #CD
   6100      C                     ELSE
   6200      C           3         SUB  #R1       #CD
   6300      C                     ENDIF
   6400       *
   6500       *        Now to work out your doomsday the orthodox way
   6600       *        Three things you should add to the century day
   6700       *        Dozens, remainder, and fours in the latter,
   6800       *        (If you alter by sevens of course it won't matter)
   6900       *
   7000      C           #YN       DIV  12        #C1
   7100      C                     MVR            #R1
   7200      C           #R1       DIV  4         #DD1
   7300       *
   7400      C                     ADD  #R1       #DD1
   7500      C                     ADD  #C1       #DD1
   7600      C                     ADD  #CD       #DD1
   7700       *
   7800      C           #DD1      DOWGT7
   7900      C                     SUB  7         #DD1
   8000      C                     ENDDO
   8100       *
   8200       *        The last of February, of January will do
   8300       *        (Except that in Leap Years it's Jan 32)
   8400       *        Then for even months use the month's own day
   8500       *        And for odd ones add four, or take it away*
   8600       *
   8700      C                     SELEC
   8800       *
   8900      C           #MM       WHEQ 01
   9000      C           #MM       OREQ 02
   9100      C                     EXSR JANFEB
   9200       *
   9300       *        And for odd ones add four, or take it away*
   9400       *
   9500      C           #MM       WHEQ 03
   9600      C           #MM       OREQ 05
   9700      C           #MM       OREQ 07
   9800      C           #MM       ADD  4         #MDN
   9900       *
  10000       *        *According to length or simply remember
  10100       *         you only subtract for September or November
  10200       *
  10300      C           #MM       WHEQ 09
  10400      C           #MM       OREQ 11
  10500      C           #MM       SUB  4         #MDN
  10600       *
  10700       *        Then for even months use the month's own day
  10800       *
  10900      C                     OTHER
  11000      C                     Z-ADD#MM       #MDN
  11100       *
  11200      C                     ENDSL
  11300       *
  11400      C           #DD       COMP #MDN                 999897
  11500       *
  11600      C                     SELEC
  11700      C           *IN99     WHEQ *ON
  11800      C           #DD       SUB  #MDN      #DIF
  11900       *
  12000      C           *IN98     WHEQ *ON
  12100      C           #MDN      SUB  #DD       #DIF
  12200       *
  12300      C           *IN97     WHEQ *ON
  12400      C                     Z-ADD*ZERO     #DIF
  12500       *
  12600      C                     ENDSL
  12700       *
  12800      C           #DIF      IFGT 7
  12900      C           #DIF      DIV  7         #C1
  13000      C                     MVR            #R1
  13100      C                     Z-ADD#R1       #DIF
  13200      C                     ENDIF
  13300       *
  13400      C                     SELEC
  13500      C           *IN99     WHEQ *ON
  13600      C                     ADD  #DIF      #DD1
  13700       *
  13800      C           *IN98     WHEQ *ON
  13900      C           #DIF      IFGE #DD1
  14000      C                     ADD  7         #DD1
  14100      C                     ENDIF
  14200      C                     SUB  #DIF      #DD1
  14300       *
  14400      C                     ENDSL
  14500       *
  14600      C           #DD1      DOWGT7
  14700      C                     SUB  7         #DD1
  14800      C                     ENDDO
  14900       *
  15000      C           RTLONG    IFEQ 'Y'
  15100      C                     MOVE DAR,#DD1  RTDOW
  15200      C                     ELSE
  15300      C                     MOVE SAR,#DD1  RTDOW
  15400      C                     ENDIF
  15500       *
  15600      C                     MOVE *ON       *INLR
  15700
**************************************************************************
  15800       ***      S U B R O U T I N E S
  15900
**************************************************************************
  16000
**************************************************************************
  16100       ***      I N I T I A L I Z A T I O N
  16200
**************************************************************************
  16300      CSR         *INZSR    BEGSR
  16400       *
  16500      C           *ENTRY    PLIST
  16600      C                     PARM           PDATE   8
  16700      C                     PARM           RTLONG  1
  16800      C                     PARM           RTDOW  10
  16900       *
  17000      C                     MOVE PDATE     RTDATE
  17100      C                     MOVE RTMM      #MM     20
  17200      C                     MOVE RTDD      #DD     20
  17300      C                     MOVE RTCN      #CN     20
  17400      C                     MOVE RTYN      #YN     20
  17500      C                     MOVE RTYR      #YR     40
  17600       *
  17700       *   Variable Declarations
  17800       *
  17900      C                     Z-ADD*ZERO     #C1     20
  18000      C                     Z-ADD*ZERO     #R1     20
  18100      C                     Z-ADD*ZERO     #CD     20
  18200      C                     Z-ADD*ZERO     #DD1    20
  18300      C                     Z-ADD*ZERO     #MDN    20
  18400      C                     Z-ADD*ZERO     #DIF    20
  18500      C                     MOVE *OFF      #LY     1
  18600       *
  18700       *   Is the year of the date passed a leap year?
  18800       *   Leap years are years that are evenly divisible by four,

  18900       *   unless they are evenly divisible by 100.

  19000       *

  19100       *   If a year is evenly divisible by 100, it must be evenly

  19200       *   divisible by 400 to be a leap year.  This is the change

  19300       *   to the Julian calendar implemented by Pope Gregory XIII.

  19400       *   Hence, the Gregorian calendar.

  19500       *

  19600      C           #YR       DIV  100       #C1

  19700      C                     MVR            #R1

  19800       *

  19900      C           #R1       IFEQ 0

  20000      C           #YR       DIV  400       #C1

  20100      C                     MVR            #R1

  20200      C           #R1       IFEQ 0

  20300      C                     MOVE *ON       #LY

  20400      C                     ENDIF

  20500      C                     ELSE

  20600      C           #YR       DIV  4         #C1
  20700      C                     MVR            #R1
  20800      C           #R1       IFEQ *ZERO
  20900      C                     MOVE *ON       #LY
  21000      C                     ENDIF
  21100      C                     ENDIF

  21200       *
  21300      CSR                   ENDSR
  21400
**************************************************************************
  21500       ***      J A N F E B -- January or February
  21600
**************************************************************************
  21700       *
  21800       *        The last of February, of January will do
  21900       *        (Except that in Leap Years it's Jan 32)
  22000       *
  22100      CSR         JANFEB    BEGSR
  22200       *
  22300      C                     SELEC
  22400       *
  22500      C           #MM       WHEQ 01
  22600      C           #LY       ANDEQ*ON
  22700      C                     SUB  1         #DD1
  22800      C                     Z-ADD31        #MDN
  22900       *
  23000      C           #MM       WHEQ 01
  23100      C           #LY       ANDEQ*OFF
  23200      C                     Z-ADD31        #MDN
  23300       *
  23400      C           #MM       WHEQ 02
  23500      C           #LY       ANDEQ*ON
  23600      C                     Z-ADD29        #MDN
  23700       *
  23800      C           #MM       WHEQ 02
  23900      C           #LY       ANDEQ*OFF
  24000      C                     Z-ADD28        #MDN
  24100       *
  24200      C                     ENDSL
  24300       *
  24400      CSR                   ENDSR
  24500
**************************************************************************
  24600       ***      E N D   O F   S O U R C E
  24700
**************************************************************************
  24800 **  DAR  Long Day Names
  24900 Sunday    Monday    Tuesday   Wednesday Thursday  Friday
Saturday
  25000 **  SAR  Short Day Names
  25100 Sun       Mon       Tue       Wed       Thu       Fri       Sat


                                  * * * *  E N D  O F  S O U R C E  * * * *


On Tuesday, May 15, 2001 13:44, Jade Richtsmeier
[SMTP:jade.richtsmeier@mcis.cog.mn.us] wrote:
> One our projects here prints a letter and we need to be able to print the
> day of the week of a given date.  I know that the system value QDAYOFWEEK
> tells me what the day of the week is for today, but how can I find out
the
> day of the week for a given date?
>
> BTW, the letter program is written in RPG - (just to confirm that it
belongs
> on the RPG400-L list :).
>
> TIA,
> Jade Richtsmeier
> jade.richtsmeier@mcis.cog.mn.us
>
>
> +---
> | This is the RPG/400 Mailing List!
> | To submit a new message, send your mail to RPG400-L@midrange.com.
> | To subscribe to this list send email to RPG400-L-SUB@midrange.com.
> | To unsubscribe from this list send email to
RPG400-L-UNSUB@midrange.com.
> | Questions should be directed to the list owner/operator:
david@midrange.com
> +---
+---
| This is the RPG/400 Mailing List!
| To submit a new message, send your mail to RPG400-L@midrange.com.
| To subscribe to this list send email to RPG400-L-SUB@midrange.com.
| To unsubscribe from this list send email to RPG400-L-UNSUB@midrange.com.
| Questions should be directed to the list owner/operator:
david@midrange.com
+---




+---
| This is the RPG/400 Mailing List!
| To submit a new message, send your mail to RPG400-L@midrange.com.
| To subscribe to this list send email to RPG400-L-SUB@midrange.com.
| To unsubscribe from this list send email to RPG400-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 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.