I wanted a handy little RPG code snippet to return the day name for a date. My requirement was to feed in a date like “Nov 30 2017” and it to tell me that its ‘Thursday’. Google to the rescue, I found a nice little article by RAFAEL VICTORIA-PEREIRA (Thankyou Sir!) which has a code sample doing 99% of what I want. It’s a couple of years old so, a quick code refactor, modernize and here it is.
Original old style RPG article is here
Here are the two main code snippets in a Service program ready for your copy/paste delight:
Service Program @SRVDATE to find DAY OF THE WEEK
// +---------------------------------------------------------+
// | Name - @SRVDATE |
// | Function - Look up a date and return the day name |
// +---------------------------------------------------------+
//
// CRTRPGMOD MODULE(@srvdate )
// DBGVIEW(*NONE)
// BNDDIR('yourbinder')
// ----------
// CRTSRVPGM SRVPGM(@srvdate )
// MODULE(@srvdate )
// EXPORT(*ALL)
// SRCFILE(@BINDER)
// SRCMBR(@srvdate )
// ACTGRP(*CALLER)
// REPLACE(*YES)
//
// Modification History
// 2017-11-30 NJL01 Created as part of version(185) revamp project.
// ----------------------------------------------------------------
ctl-opt
debug
option(*nodebugio:*srcstmt)
datfmt(*iso-) timfmt(*iso.)
fixnbr(*zoned:*inputpacked)
indent('| ') truncnbr(*yes)
expropts(*resdecpos)
copyright('| @srvdate 2017.11.30')
nomain;
// Day of the week (returns the day of the week of a given date as nbr)
// From Monday(1) thru Sunday(7)
dcl-proc #rtvDayNumber export;
dcl-pi #rtvDayNumber zoned(1);
p_Date date const;
end-pi;
dcl-s rtnDayNumber zoned(1) inz(9);
dcl-s RefDate date inz(d'0001-01-01');
// Validate input date (this should be good but lets double check to be sure)
TEST(E) p_Date;
IF %ERROR;
RETURN rtnDayNumber;
ENDIF;
// If the input parm is ok, calculate the day of the week
rtnDayNumber = %REM(%DIFF(p_Date:RefDate:*DAYS):7)+1;
return rtnDayNumber;
end-proc;
// Day of the week (returns the day of the week of a given date in text)
dcl-proc #rtvDayName export;
dcl-pi #rtvDayName char(10);
p_Date date const;
end-pi;
dcl-s rtnDayName char(10) inz(*blanks);
dcl-s p_daynbr zoned(1);
// calculate the day number for our input date
p_daynbr = #rtvDayNumber(p_date);
// if our date is squiffy then return an error
IF p_DayNbr < 1 Or p_DayNbr > 7;
rtnDayName = '*UNKNOWN';
else;
// If the input date is ok, Return the corresponding text
select;
when p_DayNbr = 1;
rtnDayName = 'Monday';
when p_DayNbr = 2;
rtnDayName = 'Tuesday';
when p_DayNbr = 3;
rtnDayName = 'Wednesday';
when p_DayNbr = 4;
rtnDayName = 'Thursday';
when p_DayNbr = 5;
rtnDayName = 'Friday';
when p_DayNbr = 6;
rtnDayName = 'Saturday';
when p_DayNbr = 7;
rtnDayName = 'Sunday';
endsl;
endif;
return rtnDayName;
end-proc;
Binder Language
STRPGMEXP PGMLVL(*CURRENT) SIGNATURE('your signature here')
EXPORT SYMBOL(#rtvDayNumber)
EXPORT SYMBOL(#rtvDayName)
ENDPGMEXP
Code Example
In our programs we would add that service program and then just do this for any given date:
// +-----------------------------------------------------------------+ // | #DATE - Date Handlign Procedures from SRVPGM (@SRVDATE) | // +-----------------------------------------------------------------+ dcl-pr #rtvDayNumber zoned(1); *n date const; // p_date end-pr; dcl-pr #rtvDayName char(10); *n date const; // p_date end-pr;
then in our mainline code we simply ask it for the day name
name_of_day = @rtvDayName ( someDate );
*boom
Worked like a charm.
So, I’ve got the little service program working, documented it, written this blog in less time than I would have taken to figure it out and written it myself.
This internet thing is bloody useful sometimes. I think it’s going to catch on….
Should really add the Date Format keyword to the Pr/Pi Nick or you may get “interesting” results if the programmer who uses this routine just happens to code a different default on the Ctl-Opt than was used when the service proc was created. Hard-coding th format along with Const deals with that.
Also, although the logic I use is not exactly the same (a slightly bastardized version of mine appears in the RPG “Sorcerers” redbook) – if you do away with the +1 in the main calc and then add 7 if the result was < 1 then you don't need to handle a special case "unknown". In other words: WorkNum = %diff( WorkDate : Anysunday : *days); WorkDay = %rem(WorkNum :7); // Testing for < 1 allows for the situation where the input date // is earlier than the base date (AnySunday) If WorkDay < 1; Return WorkDay += 7; Else; Return WorkDay; Endif; In mine I use two lines to do the base calc because it was a teaching example developed when we first introduced subprocs back in V3r2.