Fourth episode of the RPG series – FAQ & Howtos, the previous episodes can be found here;
Index
We often need to “remap” a series of items (for example Mese01, Mese02 … Month12) in an array to manage the individual values of the fields in DO loops etc.
We can use different techniques … I take a couple from this Midrange.com thread;
Example 01:
Dcl-DS * N;
SlOthCtr1;
SlOthCtr2;
SlOthCtr3;
SlOthCtr4;
SlOthCtr5;
SlOthCtr6;
SlOthCtr7;
SlOthCtr8;
SlOthCtr9;
SlOthCtr10;
SlOthCtr11;
SlOthCtr12;
SlOthCtr13;
SlOthCtr14;
SlOthCtr15;
SlOthCtr16;
SlOthCtr17;
SlOthCtr18;
SlOthCtr19;
SlOthCtr20;
SlOthCtr21;
SlOthCtr22;
SlOthCtr23;
SlOthCtr24;
SlOthCtr25;
SlOthCtr26;
SlOthCtr27;
SlOthCtr28;
Containers Char (40) Dim (28) Pos (1);
End-Ds;
Example 2, usinge SAMEPOS
dcl-ds * n;
SlOthCtr1;
SlOthCtr2;
.
.
SlOthCtr28;
Containers like (SlOthCtr1) dim (28) samepos (SlOthCtr1);
end-ds;
Example 3, using pointer
Since you already have a data structure that contains the S1othCtr *
fields, try this:
Dcl-S Container Char (40) Dim (28) based (ptrCTR);
Dcl-S ptrCTR Pointer inz (% addr (S1OthCtr1));An interesting alternative is to use the LATERAL join to bring the data “vertical” then allow a FETCH from SQL Embedded directly into the array:
create table qtemp / monthly (month1 numeric (11,2), month2 numeric (11,
2), month3 numeric (11,2), month4 numeric (11,2), month5 numeric (11,2),
month6 numeric (11,2), month7 numeric (11,2), month8 numeric (11,2),
month9 numeric (11,2), month10 numeric (11,2),
month11 numeric (11,2), month12 numeric (11,2));
insert into qtemp / monthly values (100, 200, 300, 400, 500, 600, 700, 800, 900, 1000, 1100, 1200);
select mo. * from monthly, lateral (values
(1, month1),
(2, month2),
(3, month3),
(4, month4),
(5, month5),
(6, month6),
(7, month7),
(8, month8),
(9, month9),
(10, month10),
(11, month11),
(12, month12)
) as mo (month, total)
To catch errors when using the Unix-Like API we must “read” Error Number using the “__errno” procedure, as in this example
// * - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
// * GetErrorMessageId
// * Get the error message Id for the Unix Error.
// * Input - None
// * Out - None
// * Returns - Message Id.
// * - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
dcl-proc GetErrorMessageId;
dcl-pi * N Char (7) end-pi;
dcl-pr GetErrorNumberApi Pointer ExtProc ('__ errno') end-pr;
dcl-s ErrorNumber Int (10) Based (PtrErrorNumber);
PtrErrorNumber = GetErrorNumberApi ();
Return 'CPE' +% Char (ErrorNumber);
end-proc;Or, alternatively, using the QCLE procedures as in this example:
H BNDDIR ('QC2LE')
D / copy qrpglesrc, socket_h
D / copy qrpglesrc, errno_h
.... more code is found here ....
c if socket (AF_INET: SOCK_STREAM: IPPROTO_IP) <0
c
c select
c when errno = EACCES
c eval Msg = 'Permission Denied'
c when errno = EAFNOSUPPORT
c eval Msg = 'Address Family not supported!'
c when errno = EIO
c goto TryAgainMaybe
... etc, etc, etc ...
c endsl
.... more code is found here ....
/ define ERRNO_LOAD_PROCEDURE
/ copy libsor / qrpglesrc, errno_hRead more in this post by Scott Klement: RPG IV Socket Tutorial – Error Handling
We can manage (write, read, modify etc.) IFS files and directories from RPG using different techniques:
A request on Midrange.com asked “I need a way to retrieve messages from a message file and merge the MSGDTA values into it.” and some sources have arrived that use the QMHRTVM API:
RTVMSGTXT By Thomas Raddatz
** free
// =============================================== ================== *
// Retrieve message text with QMHRTVM API
// By Thomas Raddatz
// =============================================== ================== *
ctl-opt main (main) dftactgrp (* no) actgrp (* new);
dcl-pr main extpgm ('RTVMSGTXT');
end-pr;
dcl-pr retrieveMessageText like (string_t) extproc (* dclcase);
i_library char (10) const;
i_msgF char (10) const;
i_msgID char (10) const;
i_msgData char (4096) options (* varsize) const;
end-pr;
// Commonly used templates
dcl-s string_t varchar (2048) template;
dcl-ds qObj_t qualified template;
name char (10);
lib char (10);
end-ds;
dcl-ds errCode_t qualified template;
bytPrv int (10);
bytAvl int (10);
excID char (7);
reserved_1 char (1);
excDta char (256);
end-ds;
// The program entry point
dcl-proc main;
dcl-pi * n;
end-pi;
dcl-s msgText like (string_t);
dcl-s dsplyTxt varchar (50);
dcl-s rc char (1);
msgText = retrieveMessageText (
'QSYS': 'QCPFMSG': 'CPF9811': 'MYPGM MYLIBRARY');
dsplyTxt =% subst (msgText: 1: 50);
dsply dsplyTxt rc;
end-proc;
// ------------------------------------------------ -------------------
// Retrieve message text.
// ------------------------------------------------ -------------------
dcl-proc retrieveMessageText;
dcl-pi * n like (string_t);
i_library char (10) const;
i_msgF char (10) const;
i_msgID char (10) const;
i_msgData char (4096) options (* varsize) const;
end-pi;
// The return value
dcl-s msgText like (string_t);
// Format RTVM0100 of QMHRTVM API
dcl-ds rtvm0100_t qualified template;
bytRet int (10);
bytAvl int (10);
lenMsgRet int (10);
lenMsgAvl int (10);
lenHlpRet int (10);
lenHlpAvl int (10);
date char (4096);
end-ds;
// The Retrieve Message (QMHRTVM) API
dcl-pr QMHRTVM extpgm ('QMHRTVM');
o_msgInf char (32767) options (* varsize);
i_length int (10) const;
i_format char (8) const;
i_msgID char (7) const;
i_qMsgF char (20) const;
i_rplData char (32767) const options (* varsize);
i_rpldataLen int (10) const;
i_rplVars char (10) const;
i_rtnCtrlChrs char (10) const;
io_ErrCode char (32767) options (* varsize);
end-pr;
dcl-ds qMsgF likeds (qObj_t);
dcl-ds errCode likeds (errCode_t);
dcl-ds rtvm0100 likeds (rtvm0100_t);
qMsgF.name = i_msgF;
qMsgF.lib = i_library;
QMHRTVM (rtvm0100:% size (rtvm0100): 'RTVM0100': i_msgID: qMsgF:
i_msgData:% len (i_msgData): '* YES': '* NO': errCode);
if (errCode.bytAvl = 0 and rtvm0100.lenMsgRet> 0);
msgText =% subst (rtvm0100.data: 1: rtvm0100.lenMsgRet);
else;
msgText = '';
endif;
return msgText;
end-proc;and Darryl Freinkel’s SYIMSGR
F * Program Name: SYIMSGR Created: 4/22/2021 By DHF
F * Overview: This program is a utility program that retrieves a message from a
F * message file and substitutes the MSGDTA values into the
message
F * returning the message to the calling program.
F * This utility is needed as there are program in the system
that are either
F * cloned from an interactive program or are part of an
interactive program
F * but the screen functions have been bypassed. However, the
programs still
F * have code to display the message in the command line. When
the screen
F * displays are bypassed, the messages are sent to the
message queue but are
F * never displayed.
F *
F * Use this utility to get a complete message and email the
message out,
F * or send the message to the joblog.
F *
F * When emailing, use the command SYREMLC.
F *
F * By Darryl Freinkel
F *
F ************************************************* *******************
F * Notes:
F *
F ************************************************* *******************
F * Modifications: *
F ************************************************* *******************
F *
F ************************************************* *******************
H *
H optimize (* basic) option (* expdds: * nodebugio)
h / if defined (* CRTBNDRPG)
h dftactgrp (* no) actgrp (* New)
h / else
h * dftactgrp (* NO)
h / endif
H *
F ************************************************* **************************
* Retrieve Message data (QMHRTVM) API
************************************************** ************************
D * #RtvMsg ...
D * PI 32766a varying
D syimsgr pi extpgm ('SYIMSGR')
D pMsgId 7 const
D pMsgFlib 20 const
D pMsgRplDta 2048a const options (* varsize)
D pRplSubVal 10 const
D pFmtCtlChar 10 const
D pRtn_Message 80a
* includes downloads / qcopysrc, RTVM0200Ds
* Return format for QMHRTVM api
D RTVM0200Ds DS
D rBytRtn 10i 0
D rBytAvl 10i 0
D rMsgSev 10i 0
D rAlertIndx 10i 0
D rAlertOpt 9a
D rLogInd 1a
D 2a
D rLenRplyRet 10i 0
D rLenRplyAvl 10i 0
D rLenMsgRet 10i 0
D rLenMsgAvl 10i 0
D rLenMsgHlpRet 10i 0
D rLenMsgHlpAvl 10i 0
D rMessage 4096a
D rMessageHelp 4096a
* includes downloads / qcopysrc, QMHRTVM
* Receive Message QMHRTVM API
D QMHRTVM PR extpgm ('QMHRTVM')
D pMsgData 32767a const options (* varsize)
D pMsgDataLen 10i 0 const
D pFormat 8th const
D pMsgId 7th const
D pMsgFileLib 20th const
D pRplData 32767a const options (* varsize)
D pRplDataLen 10i 0 const
D pRplSubVar 10th const
D pRtnCtlChar 10th const
D pErr0200 like (Errc0200Ds)
* API Error Data Structure - ERRC0200 format
d ERRC0200ds Ds inz qualified
d MsgKey 10i 0 inz (-1)
d BytesProv 10i 0 inz (% size (ERRC0200Ds.MsgData))
d BytesAval 10i 0
d MsgID 7a
d filler 1a
d cCCSID 10i 0
d OffMsgData 10i 0
d LenMsgData 10i 0
d MsgData 32767a
D LenRplDta s 10i 0 inz
D LenMsgDta s 10i 0 inz
d FmtCtlChr s 10a
d RplSubVal s 10a
/ free
clear Errc0200Ds;
clear RTVM0200Ds;
Errc0200Ds.BytesProv =% size (Errc0200Ds.MsgData);
LenMsgDta =% size (RTVM0200ds);
LenRplDta = 0;
LenRplDta =% len (pMsgRplDta);
if LenRplDta> 0;
RplSubVal = '* YES';
FmtCtlChr = '* NO';
else;
RplSubVal = '* NO';
FmtCtlChr = '* NO';
Endif;
// Get message data
QMHRTVM (RTVM0200Ds: LenMsgDta:
'RTVM0200': pMsgID:
pMsgFlib:
pMsgRplDta: LenRplDta:
RplSubVal: FmtCtlChr:
Errc0200Ds);
// return RTVM0200ds;
prtn_message =% trim (rMessage);
* inlr = * on;
/ end-free
P * #RtvMsg ...
P * EHere is a series of links to the Booth Martin Tribute web site under Midrange.com …. Booth Martin, who passed away in August 2020, had created a really interesting collection of RPG and SQL code … I bring you just a few examples and I invite you to visit the new site at the url: https://boothmartin.midrange.com/
Let’s start with a guide to using Check Boxes in DSPF Display Files: https://boothmartin.midrange.com/Code_Samples/Check_Boxes/check_boxes.html
An example of a program that writes on IFS: https://boothmartin.midrange.com/Code_Samples/IFS/ifs.html
Use the Menu Bars (drop-down menus) in the DSPF interacting with the mouse? Here is an example: https://boothmartin.midrange.com/Code_Samples/Menu_Bar/menu_bar.html
We remain in the Display Files with a Progress Bar to see the progress of a JOB: https: //boothmartin.midrange.com/Code_Samples/_Progress_Bar/_progress_bar.html
A 5250 text data editor built with a Subfile: https://boothmartin.midrange.com/Subfiles/Data_Editor/data_editor.html
Display product / item images from a Subfile? Here is an example with STRPCCMD: https://boothmartin.midrange.com/Subfiles/Show_Image/show_image.html
If you work with IBM i, I recommend reading this insightful article by Giancarlo Lui: IBM i System Management: Simpler…
In his recent article "RPG Free and option *convert" , Aldo Succi explores the *CONVERT option in the RPG language,…
Updating Java and DCM Certificates for ECB Exchange Rate Retrieval on IBM i In our blog, we have previously discussed…
We are pleased to receive and share this "tip & trick" from Patrick Rizzi, which introduces a technique that allows…
I take inspiration from a response by Michael Mayer on the Midrange.com mailing lists to someone who asked how to…
Businesses are increasingly seeking tools to enhance efficiency, collaboration, and resource management. Enterprise Resource Planning (ERP) systems provide a comprehensive…
View Comments
So glad you provided the link to the new Booth Martin site. I was devastated when I could not find his original site as I draw inspiration from his examples. Many thanks to you.