Modernize RPG code for ‘Get the System Name’ for IBM i, iSeries and AS400

For any RPG programmer, writing RPGLE code (sometimes called RPG4) is fun. But, upgrading older RPG programs to the latest free form program layout is even more fun! The joy experienced when the Project is to “Modernize RPG” always puts an inane grin on my face.

So lets look at a simple example:

Get Sysname using IBM API written in iSERIES style RPGLE

 // Prototype for the Rtvsysname function 
D RtvSysName PR 8A 

// Variable that will hold the system name 
D MYSYSTEM S 8A 

 // simply add this line of code to get the system name 
C eval MYSYSTEM = RtvSysName() 
C mysystem dsply(e) 
C eval *inlr = *on 

 // Retrieve System Name Subprocedure 
P RtvSysName B Export 
D RtvSysName PI 8A 
D QWCRNETA PR ExtPgm('QWCRNETA') 
D RcvVar 32766A OPTIONS(*VARSIZE) 
D RcvVarLen 10I 0 const 
D NbrNetAtr 10I 0 const 
D AttrNames 10A const 
D ErrorCode 256A 
// Error code structure 
D apiError DS 256 
// Receiver variable for QWCRNETA 
D apiData ds 
D Filler 32A 
D RtnSystem 8A 
// Call the *API and return the system name 
C callp QWCRNETA (apiData : 
C %size(apiData) : 
C 1 : 
C 'SYSNAME' : 
C apiError ) 
C return RtnSystem 
P E

Lets put on our RPG MODERNIZER hat

and here you have the same code in free format style RPGLE (which I much prefer)

// Prototype for the Rtvsysname function
ctl-opt expropts(*resdecpos) option(*nodebugio: *nounref)
dftactgrp(*no) actgrp(*caller) datfmt(*iso) timfmt(*iso);

// Global Variable that will hold the system name
dcl-s MYSYSTEM char(8);

// MAINLINE CODE
// Add this line of code (calling the RtvSysName subprocedure) to get the system name

MYSYSTEM = RtvSysName();

// Display the value on the screen
dsply(e) mysystem;

// Program termination
*inlr = *on;
return;


// --------------------------------------
// Retrieve System Name Subprocedure
// --------------------------------------
dcl-proc RtvSysName export;
dcl-pi RtvSysName char(8) end-pi;

dcl-pr rtvSystemInfo extpgm('QWCRNETA');
  *n char(32766) options(*varsize); // RcvVar
  *n int(10) const; // RcvVarLen
  *n int(10) const; // NbrNetAtr
  *n char(10) const; // AttrNames
  *n char(256); // ErrorCode
end-pr;

// Error code structure
dcl-ds apiError len(256) end-ds;

// Receiver variable for QWCRNETA
dcl-ds apiData;
  Filler char(32);
  RtnSystem char(8);
end-ds;

// Call the *API and return the system name
rtvSystemInfo ( apiData :
                %size(apiData) :
                1 :
                'SYSNAME' :
                apiError );

return RtnSystem;

end-proc;

Come’on – look at how beautiful that is!

note: All code converted automatically using the free command UPGRPGSRC from the Projex4i Toolkit.

Imagine what the old AS400 programmers would think if they came out of retirement and saw this modern IBM i language code?

/me puts on his flame-retardent underpants 😉