Skip to content

Instantly share code, notes, and snippets.

@MikeWills

MikeWills/DATE.bnd

Created April 11, 2011 21:20
Show Gist options
  • Save MikeWills/914374 to your computer and use it in GitHub Desktop.
Save MikeWills/914374 to your computer and use it in GitHub Desktop.
Download ZIP
Work with dates in RPG
Raw
DATE.bnd
/* ********************************************************************** */
/* Program . . . . . DATE */
/* */
/* Created on . . . 06/08/2006 */
/* by . . . Mike Wills (http://mikewills.me) */
/* */
/* Description . . . */
/* */
/* CHANGE LOG: */
/* Date | Name | Description */
/* ---------------------------------------------------------------------- */
/* | | */
/* | | */
/* | | */
/* ************************************************************************/
STRPGMEXP PGMLVL(*CURRENT) LVLCHK(*YES) SIGNATURE('1.4')
EXPORT SYMBOL(IsValidDate)
EXPORT SYMBOL(ConvertDecimalDateToUsa)
EXPORT SYMBOL(ConvertDecimalDateToIso)
EXPORT SYMBOL(ZeroDateToBlank)
EXPORT SYMBOL(BlankToZeroDate)
EXPORT SYMBOL(DayOfWeek)
EXPORT SYMBOL(IsHoliday)
ENDPGMEXP
Raw
DATE.rpgle
H NoMain
//*************************************************************************
// Program . . . . . DATE
//
// Created on . . . 06/08/2006
// by . . . Mike Wills (http://mikewills.me)
//
// Description . . .
//
// CHANGE LOG:
// Date | Name | Description
// -----------------------------------------------------------------------
// | |
// | |
// | |
//*************************************************************************
FHOLIDAYP IF E K DISK usropn
// Prototypes
/copy QSRVSRC,DATE_H
// **********************************************************************
// Global Definitions
P*--------------------------------------------------
P* Procedure name: IsValidDate
P* Purpose: Validate a date in numeric format
P* Returns:
P* Parameter: DateIn YYYYMMDD format only
P*--------------------------------------------------
P IsValidDate B EXPORT
D IsValidDate PI N
D DateIn 8P 0 CONST
// Work fields
D workDate S D
D retField S N inz(*ON)
/free
// Check for valid YYYYMMDD
monitor;
retField = *ON; // Assume is valid
workDate = %date(DateIn:*ISO);
on-error *ALL;
retField = *OFF; // It is not valid
endmon;
if (not retField);
// Maybe the date is in MMDDYYYY format
monitor;
retField = *ON; // Assume is valid
workDate = %date(DateIn:*USA);
on-error;
retField = *OFF;
endmon;
endif;
return retField; // It is valid
/end-free
P IsValidDate E
P*--------------------------------------------------
P* Procedure name: ConvertDecimalDateToUsa
P* Purpose:
P* Returns:
P* Parameter: dateIn
P*--------------------------------------------------
P ConvertDecimalDateToUsa...
P B EXPORT
D ConvertDecimalDateToUsa...
D PI 8P 0
D dateIn 8P 0 CONST
D* Local fields
D retField S 8P 0
/free
monitor;
retField = %int(%char(%date(dateIn):*usa0));
on-error *all;
retField = 0;
endmon;
return retField;
/end-free
P ConvertDecimalDateToUsa...
P E
P*--------------------------------------------------
P* Procedure name: ConvertDecimalDateToIso
P* Purpose:
P* Returns:
P* Parameter: dateIn
P*--------------------------------------------------
P ConvertDecimalDateToIso...
P B EXPORT
D ConvertDecimalDateToIso...
D PI 8P 0
D dateIn 8P 0 CONST
D* Local fields
D retField S 8P 0
/free
monitor;
retField = %int(%char(%date(dateIn:*usa):*iso0));
on-error *all;
retField = 0;
endmon;
return retField;
/end-free
P ConvertDecimalDateToIso...
P E
P*--------------------------------------------------
P* Procedure name: ZeroDateToBlank
P* Purpose:
P* Returns:
P*--------------------------------------------------
P ZeroDateToBlank...
P B EXPORT
D ZeroDateToBlank...
D PI 10A
D dateIn D
/free
if (dateIn = %date('0001-01-01'));
return ' ';
else;
return %char(dateIn:*usa);
endif;
return ' ';
/end-free
P ZeroDateToBlank...
P E
P*--------------------------------------------------
P* Procedure name: BlankToZeroDate
P* Purpose:
P* Returns:
P*--------------------------------------------------
P BlankToZeroDate...
P B EXPORT
D BlankToZeroDate...
D PI D
D dateIn 10A
/free
if (dateIn = ' ');
return %date('0001-01-01');
else;
return %date(dateIn:*usa);
endif;
return %date('0001-01-01');
/end-free
P BlankToZeroDate...
P E
P*--------------------------------------------------
P* Procedure name: DayOfWeek
P* Purpose: Calculates the day of the week
P* Returns:
P*--------------------------------------------------
P DayOfWeek B EXPORT
D DayOfWeek PI 10A
D dt D value datfmt(*iso)
D returnDay S 10P 0
/free
returnDay = %rem (%diff (dt: d'1800-01-05': *days): 7);
select;
when (returnDay = 0);
return 'Sunday';
when (returnDay = 1);
return 'Monday';
when (returnDay = 2);
return 'Tuesday';
when (returnDay = 3);
return 'Wednesday';
when (returnDay = 4);
return 'Thursday';
when (returnDay = 5);
return 'Friday';
when (returnDay = 6);
return 'Saturday';
endsl;
/end-free
P DayOfWeek E
P*--------------------------------------------------
P* Procedure name: IsHoliday
P* Purpose:
P* Returns:
P* Parameter: dateIn
P*--------------------------------------------------
P IsHoliday B EXPORT
D IsHoliday PI N
D dateIn D DATFMT(*ISO)
D CONST
D* Local fields
D retField S N
/free
open HOLIDAYP;
chain (dateIn) HOLIDAYR;
if (%found());
retField = *on;
else;
retField = *off;
endif;
close HOLIDAYP;
return retField;
/end-free
P IsHoliday E
Raw
DATE_H.rpgle
// **********************************************************************
// Copybook for misc commands
D*--------------------------------------------------
D* Procedure name: IsValidDate
D* Purpose: Validate a date in numeric format
D* Returns:
D* Parameter: DateIn
D*--------------------------------------------------
D IsValidDate PR N
D DateIn 8P 0 CONST
D*--------------------------------------------------
D* Procedure name: ConvertDecimalDateToUsa
D* Purpose:
D* Returns:
D* Parameter: dateIn
D*--------------------------------------------------
D ConvertDecimalDateToUsa...
D PR 8P 0
D dateIn 8P 0 CONST
D*--------------------------------------------------
D* Procedure name: ConvertDecimalDateToIso
D* Purpose:
D* Returns:
D* Parameter: dateIn
D*--------------------------------------------------
D ConvertDecimalDateToIso...
D PR 8P 0
D dateIn 8P 0 CONST
D*--------------------------------------------------
D* Procedure name: ZeroDateToBlank
D* Purpose:
D* Returns:
D*--------------------------------------------------
D ZeroDateToBlank...
D PR 10A
D dateIn D
D*--------------------------------------------------
D* Procedure name: BlankToZeroDate
D* Purpose:
D* Returns:
D*--------------------------------------------------
D BlankToZeroDate...
D PR D
D dateIn 10A
P*--------------------------------------------------
P* Procedure name: DayOfWeek
P* Purpose: Calculates the day of the week
P* Returns:
P*--------------------------------------------------
D DayOfWeek PR 10A
D dt D value datfmt(*iso)
D*--------------------------------------------------
D* Procedure name: IsHoliday
D* Purpose:
D* Returns:
D* Parameter: dateIn
D*--------------------------------------------------
D IsHoliday PR N
D dateIn D DATFMT(*ISO)
D CONST
Raw
HOLIDAY.pf
A**************************************************************************
A* * Compiler Options:
A* COMPILE OPTIONS HERE
A*
A* File . . . . . . HOLIDAYP
A*
A* Created on . . . 09/01/2009
A* by . . . Mike Wills (http://mikewills.me)
A*
A* Description . . . Stores all bank holidays
A*
A* CHANGE LOG:
A* Date | Name | Description
A* ------------------------------------------------------------------------
A* | |
A* | |
A* | |
A**************************************************************************
A UNIQUE
A R HOLIDAYR
* Primary Key
A HDATE L ALIAS(HOLIDAY_DATE)
A COLHDG('HOLIDAY' 'DATE')
A TEXT('HOLIDAY DATE')
* Regular Fields
A
* Set primary key
A K HDATE
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment