Welcome to my RPG examples Blog. This is intended as a way for the common, real world RPG programmer to exchange programming examples, techniques and stories about work related problems and solutions.
Mostly you will find free format RPG (RPG IV) code. These examples are for the ILE compilers. I no longer use subruotines but only procedures in a highly modular environment.
The days of programs with 8000 lines of code are gone forever. We now create programs with a simple main program entry point to set the environment and then calls to multiple modules as necessary.
Consider the following code for the main entry point of program UPC060:
* +-----------------------------------------------------------------+
* + Program Id.......: UPC060 +
* + Module...........: UPC060 +
* + Date Written.....: 09/25/2007 +
* + Author...........: Daniel Batista +
* + Platform.........: OS/400 +
* + OS Version.......: V5R3M0 or Later +
* + Description......: UPC Invoice Item Recoding Program. +
* + Program Main Entry Point Module. +
* + +
* + Compile Inst.....: +
* + CRTRPGMOD MODULE(lib/UPC060) SRCFILE(/QRPGLESRC) +
* + CRTPGM PGM(lib/UPC060) BNDDIR(EDITBNDDIR) ACTGRP(QILE) +
* + ALWLIBUPD(*YES) +
* + +
* + Message File.....: N/A +
* + Prefix........: +
* + +
* + Service Programs Used: +
* + +
* +-----------------------------------------------------------------+
* + Indicator Usage..: +
* + +
* + Standard to All Interactive programs and modules: +
* + 35 = Subfile Next Changed Indicator +
* + 36-38= Reserved for Subfile Usage (Available) +
* + 39 = FRCDTA Display Keyword +
* + 40-48= Reserved for Program Wide (Non Session Dependend) +
* + 49 = Program called in Inquiry Mode +
* + 88 = Color White for All Subfile Records +
* + +
* + Specific to this module: +
* + None +
* + +
* +-----------------------------------------------------------------+
* + Modification Log.: +
* + 09/25/2007: Daniel Batista +
* + - Created Original Version +
* + +
* +-----------------------------------------------------------------+
* -----------------> Compiler Directives <-------------------
H Thread(*Serialize)
H AlwNull(*USRCTL)
H Copyright('Program UPC060. +
H Copyright(c) DB Consulting. 2001-2008. +
H UPC Invoice Item Recoding. Main Entry Point Module. +
H Version 1.0. Version Date 11/01/2007. ')
* ----------------> Data Definition Area <------------------
* --> Main Program Prototype
D/Copy UPC060_P
* --> Subfile Driver Module
D/Copy UPC060M1_P
* --> Prototype for UPC060C
D/Copy UPC060C_P
* ----> Locally Defined Prototyped Functions and Procedures
* ------> Module Level Constants
* ------> Module Level Date, Time and TimeStamp Variables
* ------> Module Level Numeric Variables
* ------> Module Level Character Variables
* ------> Module Level Boolean Variables
D True S N Inz(*On)
D False S N Inz(*Off)
* ------> Module Arrays
* ------> Module Level Data Structures
* Main Program Interface Definition
D UPC060 PI
D piExitKey 2A
D piSortType 1A Const Options(*NoPass)
/Free
// Set Program Overrides
UPC060C(True);
// Calls Subfile Driver. Display All Files List
If %Parms() >= 2;
UPC060M1(piExitKey: piSortType);
Else;
UPC060M1(piExitKey);
EndIf;
// Remove Program Overrides
UPC060C(False);
// End Program
*InLr = True;
/End-Free
Monday, July 4, 2011
Setting a Range of Indicators Using a FOR Loop
Ok. Let's talk about indicators. No matter what you do you still need indicators in RPG. In fact, if you are using SDA and green screens you still need them.
Over many years I found that I need more precision when dealing with indicators for green screens. Normally I reserve indicators 1-39 for display files usage. I also dedicate indicators 40-49 to store session independent status. We can now use boolean variables of course but still it is nice to have indicators. Usually indicators 50-89 are reserved for field attributes.
In order to have more control over the setting of indicators I created the following sub-procedure SetInds:
* +----------------------------------------------------------------+
* + Function/Proc...: SetInds +
* + Type............: SubProcedure +
* + Author..........: Daniel Batista (DB Consulting) +
* + Version.........: 1.0 +
* + Date Written....: 06/25/2004 +
* + Description.....: Sets Indicators to True or False +
* + +
* + Modification Log: +
* + 06/25/2004. Daniel Batista (DB Consulting) +
* + - Created Original Version +
* + +
* +----------------------------------------------------------------+
P SetInds B
D SetInds PI
D lpiFrmInd 3U 0 Const
D lpiToInd 3U 0 Const
D lpiSetOnOff N Const
D lpiUseNamInd N Const Options(*NoPass)
* ------> Local Variables
D lIx S 3U 0
/Free
// --> Proceed To set Indicator Status
For lIx = lpiFrmInd to lpiToInd;
*In(lIx) = lpiSetOnOff;
If %Parms() = 4;
If lpiUseNamInd;
AllIndics(lIx) = lpiSetOnOff;
EndIf;
EndIf;
EndFor;
/End-Free
The prototype for this procedure is:
D SetInds PR
D FrmInd 3U 0 Const
D ToInd 3U 0 Const
D SetOnOff N Const
D UseNamedInds N Const Options(*NoPass)
Please note the 4th parameter which is optional. If passed the procedure will also set the status of the named indicators area. I always create a named indicator area with the module level array name AllIndics. The named indicators area is defined like this:
* Display File
FDspFile CF E WorkStn
F UsrOpn
F InfDs(dsWsFbck)
F IndDs(NamedIndics)
F Sfile(Sfl01:mS1RecNum)
F Sfil(SflD1:mD1RecNum)
* ------> Module Level Arrays
D NamedIndics DS
D AllIndics N Overlay(NamedIndics: 1) Dim(99)
D* Subfile Record and Control Indicators
D in30_SflClr N Overlay(NamedIndics: 30)
D in33_SflDsp N Overlay(NamedIndics: 33)
D in34_SflEnd N Overlay(NamedIndics: 34)
D in35_SflNxtChgd...
D N Overlay(NamedIndics: 35)
D in36_SflMode N Overlay(NamedIndics: 36)
D
D in39_ForceDisplay...
D N Overlay(NamedIndics: 39)
This is how you use this:
SetInds(50: 99: False: True); // Clear Attribute Indicators
In this case we are setting indicators 50 through 99 to *OFF and we are also setting the named indicators area.
Over many years I found that I need more precision when dealing with indicators for green screens. Normally I reserve indicators 1-39 for display files usage. I also dedicate indicators 40-49 to store session independent status. We can now use boolean variables of course but still it is nice to have indicators. Usually indicators 50-89 are reserved for field attributes.
In order to have more control over the setting of indicators I created the following sub-procedure SetInds:
* +----------------------------------------------------------------+
* + Function/Proc...: SetInds +
* + Type............: SubProcedure +
* + Author..........: Daniel Batista (DB Consulting) +
* + Version.........: 1.0 +
* + Date Written....: 06/25/2004 +
* + Description.....: Sets Indicators to True or False +
* + +
* + Modification Log: +
* + 06/25/2004. Daniel Batista (DB Consulting) +
* + - Created Original Version +
* + +
* +----------------------------------------------------------------+
P SetInds B
D SetInds PI
D lpiFrmInd 3U 0 Const
D lpiToInd 3U 0 Const
D lpiSetOnOff N Const
D lpiUseNamInd N Const Options(*NoPass)
* ------> Local Variables
D lIx S 3U 0
/Free
// --> Proceed To set Indicator Status
For lIx = lpiFrmInd to lpiToInd;
*In(lIx) = lpiSetOnOff;
If %Parms() = 4;
If lpiUseNamInd;
AllIndics(lIx) = lpiSetOnOff;
EndIf;
EndIf;
EndFor;
/End-Free
The prototype for this procedure is:
D SetInds PR
D FrmInd 3U 0 Const
D ToInd 3U 0 Const
D SetOnOff N Const
D UseNamedInds N Const Options(*NoPass)
Please note the 4th parameter which is optional. If passed the procedure will also set the status of the named indicators area. I always create a named indicator area with the module level array name AllIndics. The named indicators area is defined like this:
* Display File
FDspFile CF E WorkStn
F UsrOpn
F InfDs(dsWsFbck)
F IndDs(NamedIndics)
F Sfile(Sfl01:mS1RecNum)
F Sfil(SflD1:mD1RecNum)
* ------> Module Level Arrays
D NamedIndics DS
D AllIndics N Overlay(NamedIndics: 1) Dim(99)
D* Subfile Record and Control Indicators
D in30_SflClr N Overlay(NamedIndics: 30)
D in33_SflDsp N Overlay(NamedIndics: 33)
D in34_SflEnd N Overlay(NamedIndics: 34)
D in35_SflNxtChgd...
D N Overlay(NamedIndics: 35)
D in36_SflMode N Overlay(NamedIndics: 36)
D
D in39_ForceDisplay...
D N Overlay(NamedIndics: 39)
This is how you use this:
SetInds(50: 99: False: True); // Clear Attribute Indicators
In this case we are setting indicators 50 through 99 to *OFF and we are also setting the named indicators area.
Sunday, July 3, 2011
Converting a Date (Even If Invalid) To The Proper Format in RPG IV
So you are dealing with an old file and in that file there is a date field. All cool but then you realize that this file is getting to you via a flat file and the customer that is sending it has no idea how to create a valid date and most of the times the dates are correct but sometimes they are not. They could be blank or contain the month, day or year in the wrong place.
The thing is your company wants a display program to allow the correction of the data the customers are sending. So you have a problem. You cannnot use a proper date field because the date in the file could be invalid. You cannot use the %DATE or the %DEC to play with the date because they won't work. So what do you do?
Well I had this exact problem. I had to display these fields on the screen and then allow correction into a proper date. So I created these functions. I added them to a service program but they can be used as internal functions in OPM mode (Non-ILE) as long as you use RPG IV:
Here they are:
// +----------------------------------------------------------------+
// + Procedure CvtDteToMDYY. Convert Date from YYYYMMDD to MMDDYYYY +
// + Note: Must Do it This way because date could be invalid +
// + Author.: Daniel Batista +
// + Version: 1.0 +
// + Date...: 12/14/2006 +
// + +
// + Modification Log: +
// + 12/14/2006. Daniel Batista (DB Consulting) +
// + - Created Original Version +
// +----------------------------------------------------------------+
P CvtDteToMDYY B
D CvtDteToMDYY PI 8S 0
D piDteInYYMD 8S 0 Const
* -----> Locally Defined Variables
D laWkInDte S 8A
D laWkOutDte S 8A
/Free
// Convert Date from YYYYMMDD to MMDDYYYY
laWkInDte = %EditC(piDteInYYMD: 'X'); // Convert Date to String
laWkOutDte = %SubSt(laWkInDte: 5: 2) + %SubSt(laWkInDte: 7: 2) +
%SubSt(laWkInDte: 1: 4);
Return %Dec(laWkOutDte: 8: 0);
/End-Free
P CvtDteToMDYY E
// +----------------------------------------------------------------+
// + Procedure CvtDteToYYMD. Convert Date from MMDDYYYY to YYYYMMDD +
// + Note: Must Do it This way because date could be invalid +
// + +
// + Author.: Daniel Batista +
// + Version: 1.0 +
// + Date...: 12/14/2006 +
// + +
// + Modification Log: +
// + 12/14/2006. Daniel Batista (DB Consulting) +
// + - Created Original Version +
// + +
// +----------------------------------------------------------------+
P CvtDteToYYMD B
D CvtDteToYYMD PI 8S 0
D piDteInMDYY 8S 0 Const
* -----> Locally Defined Variables
D laWkInDte S 8A
D laWkOutDte S 8A
/Free
// Convert Date from MMDDYYYY to YYYYMMDD
laWkInDte = %EditC(piDteInMDYY: 'X'); // Convert Date to String
laWkOutDte = %SubSt(laWkInDte: 5: 4) + %SubSt(laWkInDte: 1: 2) +
%SubSt(laWkInDte: 3: 2);
Return %Dec(laWkOutDte: 8: 0);
/End-Free
P CvtDteToYYMD E
Here are the prototypes for the functions:
D CvtDteToMDYY PR 8S 0
D DteInYYMD 8S 0 Const
D CvtDteToYYMD PR 8S 0
D DteInMDYY 8S 0 Const
This example converts a date field into YYYYMMDD format:
/Free
If ScInvDte <> *Zero;
HInvDt = CvtDteToYYMD(ScInvDte);
EndIf;
/End-Free
The thing is your company wants a display program to allow the correction of the data the customers are sending. So you have a problem. You cannnot use a proper date field because the date in the file could be invalid. You cannot use the %DATE or the %DEC to play with the date because they won't work. So what do you do?
Well I had this exact problem. I had to display these fields on the screen and then allow correction into a proper date. So I created these functions. I added them to a service program but they can be used as internal functions in OPM mode (Non-ILE) as long as you use RPG IV:
Here they are:
// +----------------------------------------------------------------+
// + Procedure CvtDteToMDYY. Convert Date from YYYYMMDD to MMDDYYYY +
// + Note: Must Do it This way because date could be invalid +
// + Author.: Daniel Batista +
// + Version: 1.0 +
// + Date...: 12/14/2006 +
// + +
// + Modification Log: +
// + 12/14/2006. Daniel Batista (DB Consulting) +
// + - Created Original Version +
// +----------------------------------------------------------------+
P CvtDteToMDYY B
D CvtDteToMDYY PI 8S 0
D piDteInYYMD 8S 0 Const
* -----> Locally Defined Variables
D laWkInDte S 8A
D laWkOutDte S 8A
/Free
// Convert Date from YYYYMMDD to MMDDYYYY
laWkInDte = %EditC(piDteInYYMD: 'X'); // Convert Date to String
laWkOutDte = %SubSt(laWkInDte: 5: 2) + %SubSt(laWkInDte: 7: 2) +
%SubSt(laWkInDte: 1: 4);
Return %Dec(laWkOutDte: 8: 0);
/End-Free
P CvtDteToMDYY E
// +----------------------------------------------------------------+
// + Procedure CvtDteToYYMD. Convert Date from MMDDYYYY to YYYYMMDD +
// + Note: Must Do it This way because date could be invalid +
// + +
// + Author.: Daniel Batista +
// + Version: 1.0 +
// + Date...: 12/14/2006 +
// + +
// + Modification Log: +
// + 12/14/2006. Daniel Batista (DB Consulting) +
// + - Created Original Version +
// + +
// +----------------------------------------------------------------+
P CvtDteToYYMD B
D CvtDteToYYMD PI 8S 0
D piDteInMDYY 8S 0 Const
* -----> Locally Defined Variables
D laWkInDte S 8A
D laWkOutDte S 8A
/Free
// Convert Date from MMDDYYYY to YYYYMMDD
laWkInDte = %EditC(piDteInMDYY: 'X'); // Convert Date to String
laWkOutDte = %SubSt(laWkInDte: 5: 4) + %SubSt(laWkInDte: 1: 2) +
%SubSt(laWkInDte: 3: 2);
Return %Dec(laWkOutDte: 8: 0);
/End-Free
P CvtDteToYYMD E
Here are the prototypes for the functions:
D CvtDteToMDYY PR 8S 0
D DteInYYMD 8S 0 Const
D CvtDteToYYMD PR 8S 0
D DteInMDYY 8S 0 Const
This example converts a date field into YYYYMMDD format:
/Free
If ScInvDte <> *Zero;
HInvDt = CvtDteToYYMD(ScInvDte);
EndIf;
/End-Free
Subscribe to:
Posts (Atom)