×
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.
At 08:44 AM 5/27/99 -0500, you wrote:
>So, any ideas on how I could get my hands on it?
Here is the original as I presented it at COMMON. Note that this is not the RTVHOLIDAY in TAA Tool, which is different:
RTVHOLIDAY (Retrieve Holiday Date and Day) Command
The Retrieve Holiday Date and Day (RTVHOLIDAY) command retrieves the date and day of the week for many legal United States holidays. Legal conventions for calculating the exact dates is followed, and the day of the week is also returned.
The following national holidays are supported:
New Year's Day
Martin Luther King's Birthday
President's Day
Memorial Day
Flag Day
Independence Day (Fourth of July)
Labor Day
Columbus Day
Election Day
Thanksgiving Day
Christmas Day
In addition, the following non-holidays are supported, as they
frequently have associated business implications:
The day after Thanksgiving
Christmas Eve
The command supports the following parameters:
HOLIDAY Parameter: Specifies the holiday to be retrieved. The valid values are: *NEWYEARS, *NEWYEAR, *NEWYEARDAY, *MARTINLUTHERKING, *PRESIDENTS, *PRESIDENT, *PRESIDENTSDAY, *MEMORIAL, *MEMORIALDAY, *FLAG, *FLAGDAY, *FOURTHOFJULY, *LABOR, *LABORDAY, *COLUMBUS, *COLUMBUSDAY, *ELECTION, *ELECTIONDAY, *THANKSGIVING, *THANKSGIVINGDAY, *DAYAFTERTHANKSGIVING, *CHRISTMASEVE, *CHRISTMAS and *CHRISTMASDAY.
YEAR Parameter: Specifies the year for which the specified holiday is to be retrieved. The default is QYEAR.
CENTURY Parameter: Specifies the century for the year for which the specified holiday is to be retrieved. The default is QCENTURY. Valid centuries range from 16 to 99.
DATE Parameter: Specifies the six character return variable in which the date is returned in the format MMDDYY.
DAY Parameter: Specifies one character return variable in which the number of the day of the week is returned. 1 is Sunday, etc.
RETURN /* Normal end of program */
ERRORSTART: /* Standard error handling routine */
IF COND(&ERRORSW) THEN(SNDPGMMSG MSGID(CPF9999) +
MSGF(QCPFMSG) MSGTYPE(*ESCAPE)) /* Func ck */
CHGVAR VAR(&ERRORSW) VALUE('1') /* Fail on error */
ERRORLOOP: RCVMSG MSGTYPE(*DIAG) MSGDTA(&MSGDTA) MSGID(&MSGID) +
MSGF(&MSGF) MSGFLIB(&MSGFLIB)
IF COND(&MSGID *EQ ' ') THEN(GOTO CMDLBL(ESCAPE))
SNDPGMMSG MSGID(&MSGID) MSGF(&MSGFLIB/&MSGF) +
MSGDTA(&MSGDTA) MSGTYPE(*DIAG)
GOTO CMDLBL(ERRORLOOP) /* Loop for addl diag's */
ESCAPE: RCVMSG MSGTYPE(*EXCP) MSGDTA(&MSGDTA) MSGID(&MSGID) +
MSGF(&MSGF) MSGFLIB(&MSGFLIB)
SNDPGMMSG MSGID(&MSGID) MSGF(&MSGFLIB/&MSGF) +
MSGDTA(&MSGDTA) MSGTYPE(*DIAG)
SNDPGMMSG MSGID(CPF0001) MSGF(QCPFMSG) +
MSGDTA(RTVHOLIDAY) MSGTYPE(*ESCAPE)
ENDPGM
H/TITLE -- RETRIEVE HOLIDAY --
H
F*¹
F*¹ Copyright 1992 - Barsa Consulting Group, Inc.
F*¹ 220 Westchester Avenue
F*¹ Port Chester, New York 10573-4516
F*¹
E ARMO1 12 12 3 0 DAYS OF YEAR
E TABHOL 1 13 6 TABKEY 7 HOLIDAY DATA
I/SPACE
I DS
I 1 20YR
I 3 40MO
I 5 60DA
I 1 60DATE
I/SPACE
IDSNAME DS
I 1 40MODA
I 5 50BREAK
I 6 70OFFSET
I 5 70TEST
C/SPACE
C *ENTRY PLIST
C PARM HOLDAY 6 HOLIDAY
C PARM YEAR 20 YEAR
C PARM CENTRY 20 CENTURY
C PARM DATEOU 6 DATE
C PARM DAY 1 DAY OF WEEK
C* COMMON PROCESSING
C YEAR IFEQ -1 CONVERT YEAR
C Z-ADDUYEAR YEAR FOR *QYEAR
C ENDIF YEAR IFEQ -1
C/SPACE
C CENTRY IFEQ -1 CONVERT DEFAULT
C UYEAR IFLT 40 CENTURY-TAKE AN
C Z-ADD20 CY 20 EDUCATED GUESS
C ELSE AT THE CURRENT
C Z-ADD19 CY CENTURY.
C ENDIF UYEAR IFLT 40
C ELSE USE SPECIFIC
C Z-ADDCENTRY CY CENTURY.
C ENDIF CENTRY IFEQ -1
C/SPACE
C HOLDAY LOKUPTABHOL TABKEY 05(05 IS UNUSED)
C MOVE TABKEY DSNAME
C YEAR MULT 10000 DATE
C ADD MODA DATE
C EXSR DATESR
C TEST IFNE *ZEROS
C I IFLE BREAK
C I ADD 7 J
C ELSE
C Z-ADDI J
C ENDIF I IFLE BREAK
C OFFSET SUB J DA
C ENDIF TEST IFNE 0
C* CALCULATE DAY OF WEEK FOR THE VARIABLE DATE
C EXSR DATESR
C MOVE DATE DATEOU
C MOVE I DAY
C MOVE *ON *INLR
C/SPACE 2
C DATESR BEGSR
C CY MULT 100 YR4 GET THE DAY OF
C ADD YR YR4 THE WEEK
C *LIKE DEFN YR YR4 + 2
C YR4 SUB 1600 YEARS 40
C YEARS MULT 365 DAYS 70
C YEARS DIV 4 LEAPS 40
C ADD LEAPS DAYS
C CY SUB 16 CENTS 20
C SUB CENTS DAYS
C CENTS DIV 4 J
C ADD J DAYS
C YR DIV 4 J 50 J IS UNUSED
C MVR I 10
C I IFEQ 0 LEAP YEAR
C MO IFLE 2
C SUB 1 DAYS
C ENDIF MO IFLE 2
C ENDIF I IFEQ 0
C ADD ARMO1,MO DAYS
C ADD DA DAYS
C DAYS DIV 7 J J IS UNUSED
C MVR I
C ENDSR
**
000031059090120151181212243273304334
** TABHOL/TABKEY
NUYEAR0101000
MLKING0101224
PRESID0201224
MEMORL0501638
FLAG 0601521
JULY4 0704000
LABOR 0901210
GOODBY1001217
ELECT 1101211
TURKEY1101534
DAYAFT1101535
SANTA11224000
SANTA21225000
Background Technical Information:
The command definition object (RTVHOLIDAY) acts as more than a user
friendly funnel to the command processing program. It translates the
various long holiday names into six bytes strings which are easy to
handle in RPG. (e.g.: *CHRISTMASEVE to SANTA1 and *CHRISTMASDAY to
SANTA2).
The command processing program (RTVHOLIDAY) simply provides for the
standard error handler, the call to the RPG program, and the final
date conversion to the format of the job.
The RPG program, RTVHOLIDYR determines the century using AS/400 rules.
In V2R2 it would be possible to actually get the century in RPG. The
related tables TABHOL and TABKEY give the program instructions to
process the various holidays. Holidays with a defined date (e.g.: New
Years Day or July 4th) and simply specified with a month and day in
TABKEY. Moveable holidays are defined with a reference date (e.g.:
Thanksgiving is referenced by November 1 for any given year), which
has its day calculated. Offsetting days and a BREAK day variable are
used to determine what the date should be for any given year.
The subroutine (DATESR) computes the number of offsetting number of
days from January 1, 1600 to any given date. This routine is accurate
across centuries, and abides by all rules of the Gregorian Calendar
system, including Leap Year and Century Day. January 1, 1600 was a
Monday, so to get any day of the week from a date, calculate the
difference in days and divide by 7. The remainder is the day of the
week.
>
Al
>Dave
>
>> ----------
>> From: Al Barsa, Jr.[SMTP:barsa2@ibm.net]
>> Reply To: MIDRANGE-L@midrange.com
>> Sent: Tuesday, May 25, 1999 3:17 PM
>> To: MIDRANGE-L@midrange.com
>> Subject: RE: Date Validation File
>>
>> At 12:59 PM 5/25/99 -0500, you wrote:
>> >Al:
>> >
>> >I know you said I could find your RTVHOLIDAY program at the COMMON
>> >website. Well, I can't find it anywhere there. Any ideas?
>> >
>> Not website. There was an AS/400 Utility Library produced once upon a
>> time.
>>
>> Al
>>
>>
>>
>>
>> +--------------------------------------------------+
>> | Please do not send private mail to this address. |
>> | Private mail should go to barsa@ibm.net. |
>> +--------------------------------------------------+
>>
>> Al Barsa, Jr. - Account for Midrange-L
>> Barsa Consulting, LLC.
>> 400 > 390
>>
>> Phone: 914-251-1234
>> Fax: 914-251-9406
>> http://www.barsaconsulting.com
>> http://www.taatool.com
>>
>> +---
>> | 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
>> +---
>>
>+---
>| 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
>+---
>
>
+--------------------------------------------------+
| Please do not send private mail to this address. |
| Private mail should go to barsa@ibm.net. |
+--------------------------------------------------+
Al Barsa, Jr. - Account for Midrange-L
Barsa Consulting, LLC.
400 > 390
+--- | 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 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.
midrange.com
