01 - Programming (EN)01a - RPG (EN)

RPG – FAQ & Howtos (IT Part.4)

Fourth episode of the RPG series – FAQ & Howtos, the previous episodes can be found here;

RPG-FAQ-028: RPG Remap single fields in an Array

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)

RPG-FAQ-029: Error handling in “Unix-Like” API

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_h

Read more in this post by Scott Klement: RPG IV Socket Tutorial – Error Handling

RPG-FAQ-030: IFS Files and Directory Management with RPG

We can manage (write, read, modify etc.) IFS files and directories from RPG using different techniques:

RPG-FAQ-031: Retrieve Message from a Message File

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 * E

RPG-FAQ-032: DSPF and the Check-Boxes (Booth Martin Tribute)

Here 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

CheckBoxes02

RPG-FAQ-033: Writing on IFS with RPG (Booth Martin Tribute)

An example of a program that writes on IFS: https://boothmartin.midrange.com/Code_Samples/IFS/ifs.html

WRKLNK0203

RPG-FAQ-034: DSPF and Menu Bar (Booth Martin Tribute)

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

RPG-FAQ-035: Progress Bar and DSPF (Booth Martin Tribute)

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

RPG-FAQ-036: A 5250 Text Data Editor? (Booth Martin Tribute)

A 5250 text data editor built with a Subfile: https://boothmartin.midrange.com/Subfiles/Data_Editor/data_editor.html

Data Editor

RPG-FAQ-037: Display images from 5250 (STRPCCMD)? (Booth Martin Tribute)

Display product / item images from a Subfile? Here is an example with STRPCCMD: https://boothmartin.midrange.com/Subfiles/Show_Image/show_image.html

SFL Image02
--- Roberto De Pedrini Faq400.com
About author

Founder of Faq400 Srl, IBM Champion, creator of Faq400.com and blog.faq400.com web sites. RPG developer since I was wearing shorts, strong IBM i supporter, I have always tried to share my knowledge with others through forums, events and courses. Now, with my company Faq400 Srl, I help companies to make the most of this great platform IBM i.

Leave a Reply

%d bloggers like this: