          |
 Built-in functions are similar to operation codes in that they perform operations on data you specify. All IBM built-in functions have the percent symbol (%) as their first character. The syntax of built-in functions is
What I have done here is created my own built-in functions (i.e. stored procedures for C programmers) to capture today's and yesterday's date. The date format return can be any of the supported date format provided on the AS/400. |
Figure 1Testing Date Function Example *************** Beginning of data *******************************
H COPYRIGHT('(C) PGMR, Inc. 1997')
****************************************************************
* Programmers Group & Management Resource Copyright 1997 *
* *
* \\\\\\\ *
* ( o o ) *
*----------------------oOO----(_)----OOo-----------------------*
* *
* Module name. . : TESTDATE *
* Text . . . . . : Sample Code to test Date Built-in Function*
* *
* Author . . . . : Alex Nubla *
* Creation Date. : 08/26/97 *
* *
*--------------------------------------------------------------*
* *
* Module Creation: CRTRPGMOD MODULE(library/TESTDATE) *
* SRCFILE(library/QRPGLESRC) *
* *
* Program Creation: CRTPGM PGM(library/TESTDATE) *
* MODULE(library/TESTDATE *
* library/DATESVC *
* library/DAYSVC) *
* *
****************************************************************
/COPY QRPGLESRC,DATEPR
/COPY QRPGLESRC,DAYPR
*
* Standalone fields
*
D FmtMDY S 4 Inz('*MDY')
D FmtUSA S 4 Inz('*USA')
D FmtJUL S 4 Inz('*JUL')
*
D ds
D DtMDY D DatFmt(*mdy)
D Date1 8 overlay(DtMDY: 1)
*
D ds
D DtUSA D DatFmt(*usa)
D Date2 10 overlay(DtUSA: 1)
*
D ds
D DtJUL D DatFmt(*jul)
D Date3 6 overlay(DtJUL: 1)
*
* Get Today's Date
*
C 'MDY:' DSPLY
C Eval Date1 = f_CurrDate(FmtMDY)
C DtMDY DSPLY
*
C 'USA:' DSPLY
C Eval Date2 = f_CurrDate(FmtUSA)
C DtUSA DSPLY
*
C 'JUL:' DSPLY
C Eval Date3 = f_CurrDate(FmtJUL)
C DtJUL DSPLY
*
* Get 5 Days Ago
*
C '-5 MDY:' DSPLY
C Eval Date1 = f_SubToday(FmtMDY: 5)
C DtMDY DSPLY
*
C '-5 USA:' DSPLY
C Eval Date2 = f_SubToday(FmtUSA: 5)
C DtUSA DSPLY
*
C '-5 JUL:' DSPLY
C Eval Date3 = f_SubToday(FmtJUL: 5)
C DtJUL DSPLY
*
* Get 2 Days Ahead
*
C '+2 MDY:' DSPLY
C Eval Date1 = f_AddToDay(FmtMDY: 2)
C DtMDY DSPLY
*
C '+2 USA:' DSPLY
C Eval Date2 = f_AddToday(FmtUSA: 2)
C DtUSA DSPLY
*
C '+2 JUL:' DSPLY
C Eval Date3 = f_AddToday(FmtJUL: 2)
C DtJUL DSPLY
*
* Get 0 Days Ahead
*
C '+0 MDY:' DSPLY
C Eval Date1 = f_AddToDay(FmtMDY: 0)
C DtMDY DSPLY
*
C '+0 USA:' DSPLY
C Eval Date2 = f_AddToday(FmtUSA: 0)
C DtUSA DSPLY
*
C '+0 JUL:' DSPLY
C Eval Date3 = f_AddToday(FmtJUL: 0)
C DtJUL DSPLY
*
C Eval *InLR = *On
****************** End of data **********************************
|
| Figure 1
illustrates the function f_CurrDate, f_PrevDate, f_SubToday and f_AddToday.
The function f_CurrDate will return today's date in the format requested(e.g FmtUSA).
Likewise, f_PrevDate returns yesterday's date on the result of the function.
f_AddToday is similar to doing ADDDUR, while f_SubToday is similar to SUBDUR. Both
f_AddToday and f_SubToday however returns you the date format you requested. These function require a date format as a parameter. The subprocedure (built-in function) accepts a date format variable whose length is 4. The subprocedure returns the date requested based on the date format you passed in the built-in function. |
Figure 2ARPG Subprocedure to execute Date Services *************** Beginning of data *******************************
****************************************************************
* Programmers Group & Management Resource Copyright 1997 *
* *
* \\\\\\\ *
* ( o o ) *
*----------------------oOO----(_)----OOo-----------------------*
* *
* Module name. . : DATESVC *
* Text . . . . . : Sample Code to test Date Built-in Function*
* *
* Author . . . . : Alex Nubla *
* Creation Date. : 08/26/97 *
* *
*--------------------------------------------------------------*
* *
****************************************************************
H NOMAIN COPYRIGHT('(C) PGMR, Inc. 1997')
/COPY QRPGLESRC,DATEPR
****************************************************************
* S U B P R O C E D U R E S *
****************************************************************
*
****************************************************************
* *
* f_CurrDate - Retrieve Today's Date *
* *
****************************************************************
Pf_Currdate B Export
*
* Input Values
*
D f_CurrDate PI 10
D Dt_Fmt 4 Value
*
* Standalone fields
*
D DateMDY S D datfmt(*mdy)
D DateDMY S D datfmt(*dmy)
D DateYMD S D datfmt(*ymd)
D DateJUL S D datfmt(*jul)
D DateISO S D datfmt(*iso)
D DateUSA S D datfmt(*usa)
D DateEUR S D datfmt(*eur)
D DateJIS S D datfmt(*jis)
D DateAlpha S 10 Inz
*
D ds
D TimeDate 14 0
D Time60 6 0 overlay(TimeDate: 1)
D Date80 8 0 overlay(TimeDate: 7)
*
*----------------------------------------------------*
* Get the current time *
*----------------------------------------------------*
C Time TimeDate
C Select
C When Dt_Fmt = '*MDY'
C *usa Move Date80 DateMDY
C Movel DateMDY DateAlpha
*
C When Dt_Fmt = '*DMY'
C *usa Move Date80 DateDMY
C Movel DateDMY DateAlpha
*
C When Dt_Fmt = '*YMD'
C *usa Move Date80 DateYMD
C Movel DateYMD DateAlpha
*
C When Dt_Fmt = '*JUL'
C *usa Move Date80 DateJUL
C Movel DateJUL DateAlpha
*
C When Dt_Fmt = '*ISO'
C *usa Move Date80 DateISO
C Movel DateISO DateAlpha
*
C When Dt_Fmt = '*USA'
C *usa Move Date80 DateUSA
C Movel DateUSA DateAlpha
*
C When Dt_Fmt = '*EUR'
C *usa Move Date80 DateEUR
C Movel DateEUR DateAlpha
*
C When Dt_Fmt = '*JIS'
C *usa Move Date80 DateJIS
C Movel DateJIS DateAlpha
C EndSl
*
C Return DateAlpha
P f_CurrDate E
*
****************************************************************
* *
* f_PrevDate - Retrieve Yesterday's Date *
* *
****************************************************************
Pf_PrevDate B Export
*
* Input Values
*
D f_PrevDate PI 10
D Dt_Fmt2 4 Value
*
* Standalone fields
*
D CurrDate S D datfmt(*usa)
D Yesterday S D datfmt(*usa)
D DateMDY S D datfmt(*mdy)
D DateDMY S D datfmt(*dmy)
D DateYMD S D datfmt(*ymd)
D DateJUL S D datfmt(*jul)
D DateISO S D datfmt(*iso)
D DateUSA S D datfmt(*usa)
D DateEUR S D datfmt(*eur)
D DateJIS S D datfmt(*jis)
D DateAlpha S 10 Inz
*
D ds
D TimeDate 14 0
D Time60 6 0 overlay(TimeDate: 1)
D Date80 8 0 overlay(TimeDate: 7)
*
*----------------------------------------------------*
* Get the current time *
*----------------------------------------------------*
C Time TimeDate
C *usa Move Date80 CurrDate
*----------------------------------------------------*
* Compute for yesterday's date *
*----------------------------------------------------*
C CurrDate subdur 1:*d Yesterday
*
C Select
C When Dt_Fmt2 = '*MDY'
C Yesterday adddur 0:*d DateMDY
C Movel DateMDY DateAlpha
*
C When Dt_Fmt2 = '*DMY'
C Yesterday adddur 0:*d DateDMY
C Movel DateDMY DateAlpha
*
C When Dt_Fmt2 = '*YMD'
C Yesterday adddur 0:*d DateYMD
C Movel DateYMD DateAlpha
*
C When Dt_Fmt2 = '*JUL'
C Yesterday adddur 0:*d DateJUL
C Movel DateJUL DateAlpha
*
C When Dt_Fmt2 = '*ISO'
C Yesterday adddur 0:*d DateISO
C Movel DateISO DateAlpha
*
C When Dt_Fmt2 = '*USA'
C Yesterday adddur 0:*d DateUSA
C Movel DateUSA DateAlpha
*
C When Dt_Fmt2 = '*EUR'
C Yesterday adddur 0:*d DateEUR
C Movel DateEUR DateAlpha
*
C When Dt_Fmt2 = '*JIS'
C Yesterday adddur 0:*d DateJIS
C Movel DateJIS DateAlpha
C EndSl
*
C Return DateAlpha
P f_PrevDate E
****************** End of data **********************************
|
Figure 2BRPG Subprocedure to execute Day Services *************** Beginning of data *******************************
****************************************************************
* Programmers Group & Management Resource Copyright 1997 *
* *
* \\\\\\\ *
* ( o o ) *
*----------------------oOO----(_)----OOo-----------------------*
* *
* Module name. . : DAYSVC *
* Text . . . . . : Function: Add/Sub Day Duration *
* *
* Author . . . . : Alex Nubla *
* Creation Date. : 08/26/97 *
* Description. . : These are all user-defined functions for *
* adding & subtracting days. *
* *
* Use the CRTRPGMOD to compile this module. *
* *
****************************************************************
* USER DEFINED FUNCTIONS: *
* *
* Function Description *
* =============== =========================================== *
* f_AddToday Retrieve today's date passing in the Date *
* Format & Number of days to add from today. *
* Returned Date will be in 10 char. *
* *
* f_SubToday Retrieve today's date passing in the Date *
* Format & Number of days to subtract from *
* today. Returned Date will be in 10 char. *
* *
****************************************************************
* MODIFICATION LOG : *
* *
* Task Programmer/ *
* Date No. Description *
* ======== ====== ========================================== *
* 09/18/97 Alex Nubla *
* Creation Date *
* *
****************************************************************
H NOMAIN COPYRIGHT('(C) PGMR, Inc. 1997')
/COPY QRPGLESRC,DAYPR
****************************************************************
* S U B P R O C E D U R E S *
****************************************************************
*
****************************************************************
* *
* f_AddToday - Add number of Days from Today *
* *
****************************************************************
Pf_AddToday B Export
*
* Input Values
*
D f_AddToday PI 10
D Dt_Fmt 4 Value
D Dt_AddDay 3S 0 Value
*
* Standalone fields
*
D DateMDY S D datfmt(*mdy)
D DateDMY S D datfmt(*dmy)
D DateYMD S D datfmt(*ymd)
D DateJUL S D datfmt(*jul)
D DateISO S D datfmt(*iso)
D DateUSA S D datfmt(*usa)
D DateEUR S D datfmt(*eur)
D DateJIS S D datfmt(*jis)
D DateAlpha S 10 Inz
*
D Lilian S 9B 0 Inz
D Second S 8A Inz
D GregDt S 17A Inz
D Picture S 32A
D DateRtn S 32A
*
D ds
D DateReq D datfmt(*iso)
D DateRtnA 10 overlay(DateReq: 1)
*
*----------------------------------------------------*
* Get the local time & add number of days *
*----------------------------------------------------*
C Callb(d) 'CEELOCT'
C Parm Lilian
C Parm Second
C Parm GregDt
C Parm *Omit
*
C Move *blanks DateRtn
*
C Callb(d) 'CEEDATE'
C Parm Lilian
C Parm 'YYYY-MM-DD' Picture
C Parm DateRtn
C Parm *Omit
*
C Movel DateRtn DateRtnA
*
C Select
C When Dt_Fmt = '*MDY'
C DateReq adddur Dt_AddDay:*d DateMDY
C Movel DateMDY DateAlpha
*
C When Dt_Fmt = '*YMD'
C DateReq adddur Dt_AddDay:*d DateYMD
C Movel DateYMD DateAlpha
*
C When Dt_Fmt = '*JUL'
C DateReq adddur Dt_AddDay:*d DateJUL
C Movel DateJUL DateAlpha
*
C When Dt_Fmt = '*ISO'
C DateReq adddur Dt_AddDay:*d DateISO
C Movel DateISO DateAlpha
*
C When Dt_Fmt = '*USA'
C DateReq adddur Dt_AddDay:*d DateUSA
C Movel DateUSA DateAlpha
*
C When Dt_Fmt = '*DMY'
C DateReq adddur Dt_AddDay:*d DateDMY
C Movel DateDMY DateAlpha
*
C When Dt_Fmt = '*EUR'
C DateReq adddur Dt_AddDay:*d DateEUR
C Movel DateEUR DateAlpha
*
C When Dt_Fmt = '*JIS'
C DateReq adddur Dt_AddDay:*d DateJIS
C Movel DateJIS DateAlpha
C EndSl
*
C Return DateAlpha
Pf_AddToday E
*
****************************************************************
* *
* f_SubToday - Subtract number of Days from Today *
* *
****************************************************************
Pf_SubToday B Export
*
* Input Values
*
D f_SubToday PI 10
D Dt_Fmt2 4 Value
D Dt_SubDay 3S 0 Value
*
* Standalone fields
*
D DateMDY S D datfmt(*mdy)
D DateDMY S D datfmt(*dmy)
D DateYMD S D datfmt(*ymd)
D DateJUL S D datfmt(*jul)
D DateISO S D datfmt(*iso)
D DateUSA S D datfmt(*usa)
D DateEUR S D datfmt(*eur)
D DateJIS S D datfmt(*jis)
D DateAlpha S 10 Inz
*
D Lilian S 9B 0 Inz
D Second S 8A Inz
D GregDt S 17A Inz
D Picture S 32A
D DateRtn S 32A
*
D ds
D DateReq D datfmt(*iso)
D DateRtnA 10 overlay(DateReq: 1)
*
*----------------------------------------------------*
* Get the local time & subtract number of days *
*----------------------------------------------------*
C Callb(d) 'CEELOCT'
C Parm Lilian
C Parm Second
C Parm GregDt
C Parm *Omit
*
C Move *blanks DateRtn
*
C Callb(d) 'CEEDATE'
C Parm Lilian
C Parm 'YYYY-MM-DD' Picture
C Parm DateRtn
C Parm *Omit
*
C Movel DateRtn DateRtnA
*
C Select
C When Dt_Fmt2 = '*MDY'
C DateReq subdur Dt_SubDay:*d DateMDY
C Movel DateMDY DateAlpha
*
C When Dt_Fmt2 = '*YMD'
C DateReq subdur Dt_SubDay:*d DateYMD
C Movel DateYMD DateAlpha
*
C When Dt_Fmt2 = '*JUL'
C DateReq subdur Dt_SubDay:*d DateJUL
C Movel DateJUL DateAlpha
*
C When Dt_Fmt2 = '*ISO'
C DateReq subdur Dt_SubDay:*d DateISO
C Movel DateISO DateAlpha
*
C When Dt_Fmt2 = '*USA'
C DateReq subdur Dt_SubDay:*d DateUSA
C Movel DateUSA DateAlpha
*
C When Dt_Fmt2 = '*DMY'
C DateReq subdur Dt_SubDay:*d DateDMY
C Movel DateDMY DateAlpha
*
C When Dt_Fmt2 = '*EUR'
C DateReq subdur Dt_SubDay:*d DateEUR
C Movel DateEUR DateAlpha
*
C When Dt_Fmt2 = '*JIS'
C DateReq subdur Dt_SubDay:*d DateJIS
C Movel DateJIS DateAlpha
C EndSl
*
C Return DateAlpha
Pf_SubToday E
****************** End of data **********************************
|
Figure 3ADATEPR Prototype *************** Beginning of data ******************************* **************************************************************** * * * Prototype. . . : DATEPR * * Text . . . . . : Prototypes for DATESVC * * * * Author . . . . : Alex Nubla * * Creation Date. : 08/26/97 * * * * Description. . : These are prototypes used in the DATESVC * * procedures. This prototype member must * * be updated for any added subprocedure in * * DATESVC * * * **************************************************************** * * Prototype for f_CurrDate * D f_CurrDate PR 10 D Dt_Fmt 4 Value * * Prototype for f_PrevDate * D f_PrevDate PR 10 D Dt_Fmt2 4 Value ****************** End of data ********************************** |
Figure 3BDAYPR Prototype *************** Beginning of data ******************************* **************************************************************** * * * Prototype. . . : DAYPR * * Text . . . . . : Prototypes for DAYSVC * * * * Author . . . . : Alex Nubla * * Creation Date. : 09/18/97 * * * * Description. . : These are prototypes used in the DAYSVC * * procedures. This prototype member must * * be updated for any added subprocedure in * * DAYSVC * * * **************************************************************** * MODIFICATION LOG : * * * * Task Programmer/ * * Date No. Description * * ======== ======== ========================================== * * 09/18/97 Alex Nubla * * Creation Date * * * **************************************************************** * * Prototype for f_AddToday * D f_AddToday PR 10 D Dt_Fmt 4 Value D Dt_AddDay 3S 0 Value * * Prototype for f_SubToday * D f_SubToday PR 10 D Dt_Fmt2 4 Value D Dt_SubDay 3S 0 Value ****************** End of data ********************************** |
| Figure 2 shows the
ILE RPG/400 module with 4 subprocedures (2 for date service & 2 for day service). The
modules do not have a main procedure, hence for the NOMAIN keyword. If you
are planning on building built-in functions, it is good to make these modules NOMAIN
modules except for the ones that actually contain program entry procedures. The lack of
the main procedure reduces the actual size of the program. Note: you cannot use the
CRTBNDRPG command to create a program. Instead, you must use the CRTPGM to bind the module
with your NOMAIN module being your secondary module. All subprocedures must have a corresponding prototype (see /COPY of DATEPR and Figure 3A) in the data definition (D specs). The prototype (PR on positions 24-25) is used by the compiler to call your procedure properly and to ensure that the calling module passes the correct parameters. If the prototype procedure has other call parameters or is returning value to the calling module, then the subprocedure must have a procedure interface definition. A procedure interface (PI on positions 24-25) is a duplicate of a prototype information within the subprocedure. It is used to define all parameter values for the procedure and to ensure that the definition of the subprocedure is the same as that of the external definition (from the prototype). I made my prototype and procedure interface identical. In Figure 2A, my procedure interface defines Dt_Fmt as the parameter for f_CurrDate function and Dt_Fmt2 for f_PrevDate. There are 2 procedures for this module. Each starts with a Begin Procedure (B in position 24 of the procedure specification). The AS/400 treats all variables defined within each procedure separately. Any variables defined within the procedure are local. That is why you can see that all my variables for my Standalone fields are identical. You will also see that my local variable that I defined in the procedure interface is identical to the global variable defined on my Prototype. When the subprocedure is executed, any reference to that name in the subprocedure use the local variable definition (i.e. I could have named Dt_Fmt for my procedure interface for both f_CurrDate and f_PrevDate). The VALUE keyword within the procedure interface indicates that a parameter is passed in. The parameter is return back to the calling module after the RETURN operation. Another keyword I forgot to mention earlier is the EXPORT keyword at the beginning of each procedure. This allows each procedure to be called by another module in the program. To create the subprocedure DATESVC & DAYSVC modules, you use the Create RPG Module (CRTRPGMOD) command. Anytime you wish to use either of the functions, you will use the Create Program (CRTPGM) command to bind the module together with your primary module. DATESVC or DAYSVC must be the secondary module always. |
Copyright © 1999, Programmers Group & Management Resource, Inc. All rights reserved.