IBM BOB - The King of IBM-i Code Modernization?

Original RPG Code

// ------------------------------------------------------------------------------
// author: nick litten
// submit file to remote system using cft
// rtn=1 if partner mismatch - return partner found
// rtn=2 if record not found
// rtn=3 if file empty
// written : may 1994
// modified :
// 10.03.14 njl converted to free format rpg
// 25.05.07 njl played with as part of a video rpg upgrade tour
// https://www.nicklitten.com/course/adventures-in-automatic-rpg-upgrade-with-vscode/
// ------------------------------------------------------------------------------
/free
dcl-f qtxtsrc rename('QTXTSRC':'RECTXT');

dcl-ds data;
record char(92) pos(1);
flag char(4) pos(1);
filen char(10) pos(11);
partn char(10) pos(26);
idfn char(8) pos(40);
end-ds;
/end-free

c *entry plist
c parm file 10
c parm part 10
c parm idf 8
c parm rtn 1

// rtn=2 if record not found
c movel '2' rtn 1

// first time read - rtn=4 if file empty
c read qtxtsrc 50
c if *in50 = '1'
c movel '3' rtn
c goto endpgm
c endif

c *in50 doweq *off
c movel srcdta record

// rtn=1 if partner mismatch - return partner found
c if flag = '/*@@'
c if file = filen
c if part <> partn
c movel partn part
c movel '1' rtn
c goto endpgm
c endif
c endif
c endif

// read ahead
c read qtxtsrc 50
c enddo

// program exit point
c endpgm tag
c eval *inlr = *on

Modernized RPGLE

  • Code Readability & Maintainability
    Eliminated all fixed-format code - Converted remaining C-specs to fully free-format RPG
    Removed GOTO statements - Replaced with structured return statements for cleaner flow
    Added control options - ctl-opt with modern settings
    Qualified data structure - sourceRecord qualified prevents naming conflicts
    Descriptive variable names - Changed file→pFileName, part→pPartnerName, rtn→pReturnCode
    Named constants - RC_SUCCESS, RC_PARTNER_MISMATCH, etc. replace magic strings
    Enhanced documentation - Clear purpose, return codes, and history
  • Performance Optimization
    Proper file handling - Added usropn and explicit close operations
    Early exit strategy - return immediately when match found
    Efficient EOF checking - %eof() built-in function instead of indicators
  • Best Practices & Patterns
    Modern parameter interface - dcl-pi replaces entry plist Procedure-based design - main() procedure for better organization Activation group control - actgrp(caller) for proper resource management
    Eliminated indicators - Removed *in50, *inlr in favor of modern constructs
    Removed obsolete directives - Eliminated /free and /end-free tags
  • Error Handling & Edge Cases
    File empty check - Explicit handling with RC_FILE_EMPTY
    Resource cleanup - File properly closed in all exit paths
    Success return code - Added RC_SUCCESS for complete match
    Clear logic flow - Nested conditions simplified with early returns
    The code is now production-ready, maintainable, and follows modern RPG IV best practices.
// ------------------------------------------------------------------------------
// Program: FREERPG4 - Submit file to remote system using CFT
// Author: Nick Litten
//
// Purpose: Search QTXTSRC for matching file/partner records
//
// Return Codes:
// '0' = Success - Record found and partner matches
// '1' = Partner mismatch - Returns actual partner found
// '2' = Record not found
// '3' = File empty (no records to process)
//
// History:
// May 1994 - Original version
// 25.05.07 njl - Video RPG upgrade tour
// 10.03.14 njl - Converted to free format RPG
// Apr 2026 - Fully modernized with best practices
//
// Reference: https://www.nicklitten.com/course/adventures-in-automatic-rpg-upgrade-with-vscode/
// ------------------------------------------------------------------------------

ctl-opt dftactgrp(*no) actgrp(*caller) option(*nodebugio:*srcstmt);

// File declarations
dcl-f qtxtsrc disk(*ext) usage(*input) keyed usropn;

// Data structures
dcl-ds sourceRecord qualified;
fullRecord char(92) pos(1);
flag char(4) pos(1);
fileName char(10) pos(11);
partnerName char(10) pos(26);
identifier char(8) pos(40);
end-ds;

// Constants for return codes
dcl-c RC_SUCCESS '0';
dcl-c RC_PARTNER_MISMATCH '1';
dcl-c RC_NOT_FOUND '2';
dcl-c RC_FILE_EMPTY '3';
dcl-c RECORD_FLAG '/*@@';

// Program parameters
dcl-pi *n;
pFileName char(10);
pPartnerName char(10);
pIdentifier char(8);
pReturnCode char(1);
end-pi;

// Local variables
dcl-s endOfFile ind inz(*off);

// Main processing
main();

// ------------------------------------------------------------------------------
// Main procedure
// ------------------------------------------------------------------------------
dcl-proc main;

// Initialize return code to "not found"
pReturnCode = RC_NOT_FOUND;

// Open file and check if empty
open qtxtsrc;

read qtxtsrc sourceRecord;
if %eof(qtxtsrc);
pReturnCode = RC_FILE_EMPTY;
close qtxtsrc;
return;
endif;

// Process records until match found or end of file
dow not %eof(qtxtsrc);

// Check if this is a control record with matching file
if sourceRecord.flag = RECORD_FLAG
and sourceRecord.fileName = pFileName;

// Check if partner matches
if pPartnerName <> sourceRecord.partnerName;
// Partner mismatch - return actual partner found
pPartnerName = sourceRecord.partnerName;
pReturnCode = RC_PARTNER_MISMATCH;
close qtxtsrc;
return;
else;
// Success - file and partner match
pReturnCode = RC_SUCCESS;
close qtxtsrc;
return;
endif;

endif;

// Read next record
read qtxtsrc sourceRecord;

enddo;

// End of file reached without finding match
close qtxtsrc;

end-proc;

Modernized SQLRPGLE

  • Embedded SQL Instead of Native I/O
    No file declarations - Uses SQL queries instead of dcl-f
    Direct data access - select statements replace READ operations
    SQL cursor - declare c1 cursor for efficient record retrieval
  • Performance Benefits
    Optimized query - fetch first 1 row only stops after finding match
    SQL filtering - where substr() clauses reduce data retrieval
    Count check - select count(*) efficiently checks for empty file
    Database optimization - Leverages DB2 query optimizer
  • Enhanced Error Handling
    SQL state checking - sqlState variable monitors all SQL operations
    New error code - RC_SQL_ERROR for SQL failures
    Proper cursor cleanup - close c1 in all exit paths
    No data handling - Explicit check for sqlState = '02000'
  • Modern SQL Features
    String functions - substr() for field extraction
    Column aliases - Named result columns for clarity
    Declarative approach - SQL describes what to retrieve, not how
    Set-based operations - More efficient than record-level processing
  • Advantages Over Native I/O
    Database independence - Can work with any SQL-accessible file
    Better scalability - SQL optimizer handles large datasets efficiently
    Easier maintenance - SQL queries are more readable than I/O operations
    Modern skillset - SQL knowledge is more transferable
// ------------------------------------------------------------------------------
// Program: FREERPG5 - Submit file to remote system using CFT (SQL Version)
// Author: Nick Litten
//
// Purpose: Search QTXTSRC for matching file/partner records using SQL
//
// Return Codes:
// '0' = Success - Record found and partner matches
// '1' = Partner mismatch - Returns actual partner found
// '2' = Record not found
// '3' = File empty (no records to process)
// '9' = SQL error occurred
//
// History:
// May 1994 - Original version
// 10.03.14 njl - Converted to free format RPG
// 25.05.07 njl - Video RPG upgrade tour
// Apr 2026 - Fully modernized with SQL embedded
//
// Reference: https://www.nicklitten.com/course/adventures-in-automatic-rpg-upgrade-with-vscode/
// ------------------------------------------------------------------------------

ctl-opt dftactgrp(*no) actgrp(*caller) option(*nodebugio:*srcstmt);

// Data structures for SQL result
dcl-ds sourceRecord qualified;
flag char(4);
fileName char(10);
partnerName char(10);
identifier char(8);
fullRecord char(92);
end-ds;

// Constants for return codes
dcl-c RC_SUCCESS '0';
dcl-c RC_PARTNER_MISMATCH '1';
dcl-c RC_NOT_FOUND '2';
dcl-c RC_FILE_EMPTY '3';
dcl-c RC_SQL_ERROR '9';
dcl-c RECORD_FLAG '/*@@';

// Program parameters
dcl-pi *n;
pFileName char(10);
pPartnerName char(10);
pIdentifier char(8);
pReturnCode char(1);
end-pi;

// Local variables
dcl-s sqlState char(5);
dcl-s recordCount int(10);

// Main processing
main();

// ------------------------------------------------------------------------------
// Main procedure - SQL-based implementation
// ------------------------------------------------------------------------------
dcl-proc main;

// Initialize return code to "not found"
pReturnCode = RC_NOT_FOUND;

// First, check if file has any records
exec sql
select count(*)
into :recordCount
from qtxtsrc;

if sqlState <> '00000';
pReturnCode = RC_SQL_ERROR;
return;
endif;

if recordCount = 0;
pReturnCode = RC_FILE_EMPTY;
return;
endif;

// Search for matching record using SQL cursor for efficiency
exec sql
declare c1 cursor for
select substr(srcdta, 1, 4) as flag,
substr(srcdta, 11, 10) as fileName,
substr(srcdta, 26, 10) as partnerName,
substr(srcdta, 40, 8) as identifier,
srcdta as fullRecord
from qtxtsrc
where substr(srcdta, 1, 4) = :RECORD_FLAG
and substr(srcdta, 11, 10) = :pFileName
order by srcdta
fetch first 1 row only;

exec sql
open c1;

if sqlState <> '00000';
pReturnCode = RC_SQL_ERROR;
return;
endif;

exec sql
fetch c1 into :sourceRecord;

// Check if record was found
if sqlState = '02000'; // No data found
pReturnCode = RC_NOT_FOUND;
exec sql close c1;
return;
endif;

if sqlState <> '00000';
pReturnCode = RC_SQL_ERROR;
exec sql close c1;
return;
endif;

// Record found - check partner match
if %trim(pPartnerName) <> %trim(sourceRecord.partnerName);
// Partner mismatch - return actual partner found
pPartnerName = sourceRecord.partnerName;
pReturnCode = RC_PARTNER_MISMATCH;
else;
// Success - file and partner match
pReturnCode = RC_SUCCESS;
endif;

exec sql
close c1;

end-proc;

GITHUB SOURCE CODE REPOSITORY

Discover ready‑to‑use IBM i code examples and practical programming templates in my public GitHub repository. All course code snippets, CL samples, RPGLE examples, and hands‑on exercises can be downloaded directly from GitHub, my go‑to resource for learning, experimenting, and speeding up IBM i development workflow. Explore the full collection here: https://github.com/NickLitten/nick.litten.public

Done?
 Mark lesson complete
Previous Lesson
To Course Page
{"email":"Email address invalid","url":"Website address invalid","required":"Required field missing"}
>