ave you ever owned a nifty gadget, a tool, or a watch or anything mechanical,
sophisticated, yet always reliable? The routine I am about to present is
about at this level. When you have finished reading this code, you will
probably not know much more about how it works except that it does to the
job. I stumbled upon the Date/38 routine about 10 years ago.
I have kept copies of it ever since. Used it, tried it, converted it and
used it in C language, it could also easily be converted into COBOL or
any other language. When the photocopied document containing this routine
came to me, it had no trace of authorship, no trace of anything, except
this routine, and the title "SOFTIME". I share it with you, acknowledging
that I am not the author of the code to follow.
The newest AS/400 op-codes are very powerful. They can give the difference between two dates with the flick of a command, and the day of the week routines (which can be found in last December's News/400) are short and easy to use. All these routines, however, require that you have the latest version of RPG installed, and that you can use the data type "D" (as in DATE data type). This is a not a fool-proof solution if you are dealing with a larger base of customers, at various stages of operating system levels. Date/38 is a comprehensive date conversion method. Originally written in RPGIII, its hallmark is its simplicity and its adaptability, especially for people who have older generation systems, and there are a lot of them still churning data in the world today. It allows you to perform most common date calculations with ease, uses no tables and is virtually maintenance free.
Most conventional date conversion routines on the AS/400, including the IBM CVTDAT CL command either work directly with the Gregorian date (year/month/day) or with a so-called Julian date (year/day of the year) format. The deficiency of this approach lies in the fact that the date is made up of components, each of which must be manipulated and interpreted as a separate entity. Date/38, however, utilizes a single seven-digit serial number. The count began at 0,000,001 on January 1 in the year 4713 BC. On each day that has passed since then, the serial number has been incremented by one. Thus, the value of the number for January 1, 1984 is 2,445,701 and for January 1, 1985 it is 2,446,067 (note that 1984 is a leap year). Note that this seven-digit number will not reach an overflow condition for over 7,500,000 days, which is more than 20,000 years from now! Thus, for practical business purposes, seven digits will always be sufficient. In addition, if you want to find the day of the week for a particular day, all that needs to be done is to divide the serial number by 7. The remainder will be a number from 0 through 6. If the remainder is 0, the day is Monday. If it is 1, the day is Tuesday, 3 is Wednesday and so forth.
The two subroutines that comprise the RPG III code portion of Date/38 allow you to convert back and forth between the Gregorian date and the serial date. Subroutine GTOS converts a Gregorian date (year/month/day) to the Date/38 serial date, and subroutine STOG converts the DATE/38 serial date to its corresponding Gregorian date. If you pass a complete four-digit variable for the year to subroutine GTOS, it will never require any maintenance. However, in many cases, you may only be able to pass a two-digit variable for the year. In this case, you may modify subroutine GTOS by inserting an IF group at the beginning. The subroutine will then produce correct results for only 100 years. The example shown will work for the years 1995 to 2094 inclusive. You may, of course, modify this IF group to suit any 100 year period you desire. The RPG III code for subroutine STOG will never need any modification, and will always return a four-digit Gregorian Year. These subroutines have been coded as external subroutines which are invoked by the CALL operation. You may, of course, use them as internal subroutines, in which case they need to be preceded by BEGSR, followed by ENDSR and invoked with the EXSR operation.
Once a Gregorian date has been converted to its serial counterpart, date calculations become greatly simplified. One often asked question about date routines is whether it can handle leap years? No problem. Date/38 eats leap years for lunch. This serial date system allows you, in addition, to figure out with great ease and accuracy date calculations that can be a bit of a head-ache otherwise. For example, "What will be the day/date be 120 days from now?" You can do this by adding 120 to today's serial date and converting the sum back to a Gregorian date format. "What was the date 90 days ago?" Subtract 90 from today's serial date and convert the result back to Gregorian. You could also, with this routine, without much effort, print on your bills such friendly messages as "Your invoice is due 30 days from now, on Monday April 8, 1996".
We are all aware, in the data-processing realm, of the coming of the year 2000. Even more than all the psychics of the world, we will be sensitive to this event. How many comparisons are made on the last two digits of the year in your system today? Soon, a lot of us who are not retiring in 1999 will have to start planning on changing a lot of old code to accommodate the change in century. In most parts, I would gamble the modifications to be made would only involve increasing the YEAR field length from 2 to 4. For old fashioned date comparisons, the ones that look at the months and the year separately, there could be some more work ahead.
In the example code that follows, please note that there
is a decimal point in the constant 365.25 and the constant .0075. All other
constants are whole numbers. Also note that the four work fields (F1 through
F4) are defined to 15 digits with zero decimal positions. So: code once, reuse many times! This is one flexible
and easy way to go if you need to play with dates. It works, and it could
be the last date routine you will ever need, for the next 20,000 years!
Factor 1 | Operation | Factor 2 | Result | L/D |
*ENTRY | PLIST | |||
PARM | GY | 40 | ||
PARM | GM | 20 | ||
PARM | GD | 20 | ||
PARM | SERIAL | 70 | ||
GTOS | BEGSR | |||
GM | SUB | 14 | F1 | 150 |
DIV | 12 | F1 | ||
F1 | ADD | GY | F2 | 150 |
ADD | 4800 | F2 | ||
MULT | 365.25 | F2 | ||
F1 | MULT | -12 | F3 | 150 |
ADD | GM | F3 | ||
SUB | 2 | F3 | ||
MULT | 367 | F3 | ||
DIV | 12 | F3 | ||
F1 | ADD | GY | F4 | 150 |
ADD | 4900 | F4 | ||
MULT | .0075 | F4 | ||
SUB | F4 | F2 | ||
ADD | F3 | F2 | ||
SUB | 32075 | F2 | ||
GD | ADD | F2 | SERIAL | |
ENDSR |
Factor 1 | Operation | Factor 2 | Result | L/D |
*ENTRY | PLIST | |||
PARM | GY2 | 20 | ||
PARM | GM | 20 | ||
PARM | GD | 20 | ||
PARM | SERIAL | 70 | ||
GTOS | BEGSR | |||
GY2 | IFGE | 95 | ||
1900 | ADD | GY2 | GY | 40 |
ELSE | ||||
2000 | ADD | GY2 | GY | |
ENDIF | ||||
GM | SUB | 14 | F1 | 150 |
DIV | 12 | F1 | ||
F1 | ADD | GY | F2 | 150 |
ADD | 4800 | F2 | ||
MULT | 365.25 | F2 | ||
F1 | MULT | -12 | F3 | 150 |
ADD | GM | F3 | ||
SUB | 2 | F3 | ||
MULT | 367 | F3 | ||
DIV | 12 | F3 | ||
F1 | ADD | GY | F4 | 150 |
ADD | 4900 | F4 | ||
MULT | .0075 | F4 | ||
SUB | F4 | F2 | ||
ADD | F3 | F2 | ||
SUB | 32075 | F2 | ||
GD | ADD | F2 | SERIAL | |
ENDSR |
Factor 1 | Operation | Factor 2 | Result | L/D |
*ENTRY | PLIST | |||
PARM | GM | 20 | ||
PARM | GD | 20 | ||
PARM | GY | 40 | ||
PARM | SERIAL | 70 | ||
STOG | BEGSR | |||
SERIAL | ADD | 68569 | F4 | 150 |
F4 | MULT | 4 | F6 | 150 |
DIV | 146097 | F6 | ||
F6 | MULT | 146097 | F5 | 150 |
ADD | 3 | F5 | ||
MULT | .25 | F5 | ||
SUB | F5 | F4 | ||
F4 | ADD | 1 | F1 | 150 |
MULT | 4000 | F1 | ||
DIV | 1461001 | F1 | ||
F1 | MULT | 365.25 | F5 | |
SUB | F5 | F4 | ||
AD | 31 | F4 | ||
F4 | MULT | 80 | F2 | 150 |
DIV | 2447 | F2 | ||
F2 | MULT | 2447 | F5 | |
MULT | .0125 | F5 | ||
F4 | SUB | F5 | F3 | 150 |
F2 | DIV | 11 | F4 | |
F4 | MULT | 12 | F5 | |
ADD | 2 | F2 | ||
SUB | F5 | F2 | ||
SUB | 49 | F6 | ||
MULT | 100 | F6 | ||
ADD | F6 | F1 | ||
ADD | F4 | F1 | ||
Z-ADD | F1 | GY | ||
Z-ADD | F2 | GM | ||
Z-ADD | F3 | GD | ||
ENDSR |