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

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

// -------------------------------------------------------------------
// 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