.st0{fill:#FFFFFF;}

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

 January 26, 2016

By  NickLitten

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

Modernize RPG
// 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);

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

// Retrieve System Name Subprocedure
dcl-proc RtvSysName export;
dcl-pi RtvSysName char(8) end-pi;
dcl-pr QWCRNETA 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
QWCRNETA(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 šŸ˜‰

NickLitten


IBM i Software Developer, Digital Dad, AS400 Anarchist, RPG Modernizer, Shameless Trekkie, Belligerent Nerd, Englishman Abroad and Passionate Eater of Cheese and Biscuits. Nick Litten Dot Com is a mixture of blog posts that can be sometimes serious, frequently playful and probably down-right pointless all in the space of a day. Enjoy your stay, feel free to comment and remember: If at first you don't succeed then skydiving probably isn't a hobby you should look into.

Nick Litten

related posts:

{"email":"Email address invalid","url":"Website address invalid","required":"Required field missing"}
__CONFIG_colors_palette__{"active_palette":0,"config":{"colors":{"cff50":{"name":"Main Accent","parent":-1},"a344d":{"name":"Accent Transparent","parent":"cff50"}},"gradients":[]},"palettes":[{"name":"Default","value":{"colors":{"cff50":{"val":"var(--tcb-skin-color-0)"},"a344d":{"val":"rgba(46, 138, 229, 0.85)","hsl_parent_dependency":{"h":210,"l":0.54,"s":0.78}}},"gradients":[]},"original":{"colors":{"cff50":{"val":"rgb(0, 178, 255)","hsl":{"h":198,"s":1,"l":0.5}},"a344d":{"val":"rgba(0, 178, 255, 0.85)","hsl_parent_dependency":{"h":198,"s":1,"l":0.5}}},"gradients":[]}}]}__CONFIG_colors_palette__

Get In Touch

Iā€™m always looking for awesome input, feedback and critique!

>