Example RPGLE program to populate the JBA System21 *LDA – Fully Free

AS400

Dec 09

Ever had to populate the *LDA in correct layout for JBA ERP Modules (aka GEAC aka Infor System21? Here is a quick and easy JBA System21 *LDA – RPG Example written in RPGLE **FREE format.

Here is a simple RPGLE program to setup the *LDA priot to running a few little INFOR SYSTEM21 extraction routines:

WEBSETLDA

JBA System21 *LDA - RPG Example// -------------------------------------------------------------------
// Service Name - WEBSETLDA
// Function - Populate *LDA with Dummy values
// Version - *see Hcopyright
// Author - Nick Litten (www.nicklitten.com)
// -------------------------------------------------------------------
// Modification History:
// 2014-03-17 V1 Created
// 2014-06-26 V1.1 Set L#RTCD to blanks.
// 2015-12-09 V1.2 Modernize code to use RPGLE /FREE.
// -------------------------------------------------------------------

ctl-opt debug option(*srcstmt: *nodebugio) dftactgrp(*no) actgrp('SOAP')
 copyright('Setup dummy *LDA - Version 1.2');

dcl-ds psds PSDS;
 psdsProcName char(10) pos(1);
 psdsLibName char(10) pos(81);
 psdsJobName char(10) pos(244);
 psdsUserName char(10) pos(254);
 psdsJobNbr char(6) pos(264);
end-ds;

dcl-ds LDA dtaara(*lda);
 L#CONO char(2) inz('AA') pos(1);
 L#CONM char(35) inz('Test Company from WEBSETLDA' ) pos(3);
 L#PRQU char(10) inz('PGMOUTQ') pos(38);
 L#PLIB char(10) inz('*LIBL') pos(48);
 L#JOBQ char(10) inz('QPGMR') pos(58);
 L#JOBL char(10) inz('*LIBL') pos(68);
 L#DFNM char(10) pos(78);
 L#FMTN char(10) pos(88);
 L#PGID char(10) inz('NONE') pos(98);
 L#JOBN char(10) inz('JOBNAME') pos(108);
 L#RTCD char(2) inz(' ') pos(118);
 L#USER char(10) inz(*user) pos(120);
 L#APPN char(2) inz('SL') pos(130);
 L#FUNC char(4) inz('1234') pos(132);
 L#HOLD char(1) inz('N') pos(136);
 L#LIBL char(4) inz('IN01') pos(137);
 L#CUSC char(3) inz('TST') pos(141);
 L#JBNO char(9) inz('123456789') pos(144);
 L#SOFF char(1) inz('N') pos(153);
 L#MNCO char(1) inz('N') pos(154);
 L#RSTA char(1) inz('N') pos(155);
 L#EXCL char(1) inz('N') pos(156);
 L#TERM char(10) pos(157);
 L#RLSL char(2) inz('03') pos(167);
 L#APSR char(1) inz('O') pos(169);
 L#GLCO char(2) inz('AH') pos(170);
 L#PRCO char(2) pos(172);
 L#XXCO char(2) pos(174);
 L#CPFN char(6) pos(176);
 L#HPCD char(2) inz('AL') pos(182);
 L#NAPS char(1) pos(184);
 L#SBMX char(1) inz('N') pos(185);
 L#DTFM char(1) inz('M') pos(186);
 L#LANG char(2) inz('US') pos(187);
 L#AACD char(9) pos(189);
 L#IDAT char(7) inz('CYYMMDD') pos(198);
 L#EDAT char(6) inz('MMDDYY') pos(205);
 L#LGLB char(10) pos(211);
 L#MENU char(10) pos(221);
 L#INAM char(10) pos(231);
 L#CROW char(1) pos(241);
 L#CCOL char(1) pos(242);
 L#MCUR char(1) pos(243);
 L#USAF char(1) pos(244);
 L#VATF char(1) pos(245);
 L#WHCD char(2) pos(246);
 L#RSVD char(9) pos(248);
 L#PARMDATA char(768) pos(257);
end-ds;

dcl-pr EntryPList extpgm('WEBSETLDA') end-pr;
dcl-pi EntryPlist end-pi;

 // Read in the *LDA Data area
 In LDA;

 // Reset *LDA subfields to values defined in the INZ(values)
 reset LDA;

 // change values for this job in particular
 L#USER = psdsUsername;
 L#TERM = psdsJobName;
 L#JOBN = psdsJobName;
 L#JBNO = '000' + psdsJobNbr;
 L#IDAT = %char(%DATE:*CYMD0);
 L#EDAT = %char(%DATE:*MDY0);
 L#RTCD = *blanks;

 Clear l#ParmData; //Clear the variable space in the *LDA

 Out LDA;

 *inlr = *on;

note: This has some hard coded values in the ‘d’ specs. Set them as you wish… call the program and the LDA will be ready to call any System21 program that uses the company code defined in L#CONO

Follow

About the Author

IBM i Software Developer, Digital Dad, AS400 Anarchist, RPG Modernizer, Alpha Nerd 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 in the words of the most interesting man in the world: Stay thirsty my friend.