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 :
      // 25.05.07 njl played with as part of a video rpg upgrade tour
      // 10.03.14 njl converted to free format rpg    
      // 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.
**free

///
/// Program: FREERPG4 - Submit File to Remote System using CFT (Fully Modernized)
///
/// Description: Searches QTXTSRC source file for matching file and partner
///              records. This version demonstrates fully modernized RPG with
///              best practices including named constants, qualified data
///              structures, and proper error handling.
///
/// Purpose: Educational example demonstrating:
///   - Complete RPG modernization with best practices
///   - Named constants instead of magic values
///   - Qualified data structures
///   - Proper control options
///   - Clear return code patterns
///   - Modern file handling
///
/// Features:
///   - Uses named constants for all return codes
///   - Qualified data structure for record parsing
///   - Proper activation group management
///   - Clear, self-documenting code
///   - No indicators or GOTO statements
///
/// 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)
///
/// Usage: CALL FREERPG4 PARM(fileName partnerName identifier returnCode)
///
/// Parameters:
///   - pFileName: char(10) - File name to search for
///   - pPartnerName: char(10) - Partner name to match
///   - pIdentifier: char(8) - Identifier
///   - pReturnCode: char(1) - Return code (output)
///
/// Reference:
/// https://www.nicklitten.com/course/adventures-in-automatic-rpg-upgrade-with-vscode/
///
/// Modification History:
///   V.000 1994-05-01 | Nick Litten | Initial creation
///   V.001 2007-05-25 | Nick Litten | Video RPG upgrade tour
///   V.002 2014-03-10 | Nick Litten | Converted to free format RPG
///   V.003 2026-04-01 | Nick Litten | Fully modernized with best practices
///

ctl-opt
  dftactgrp(*no)
  actgrp(*caller)
  option(*nodebugio:*srcstmt)
  copyright('FREERPG4 | V.003 | Fully Modernized CFT File Submission')
  ;

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

///
/// Program: FREERPG5 - Submit File to Remote System using CFT (SQL Version)
///
/// Description: Searches QTXTSRC source file for matching file and partner
///              records using embedded SQL instead of native file I/O. This
///              version demonstrates SQL integration in RPG for file access.
///
/// Purpose: Educational example demonstrating:
///   - Embedded SQL in RPG for file access
///   - SQL cursor operations
///   - SQL error handling with SQLSTATE
///   - Modern SQL/RPG integration patterns
///   - Comparison with native file I/O approach
///
/// Features:
///   - Uses SQL SELECT instead of READ operations
///   - SQL cursor for record processing
///   - SQLSTATE checking for error handling
///   - Named constants for return codes
///   - Qualified data structures
///
/// 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
///
/// Usage: CALL FREERPG5 PARM(fileName partnerName identifier returnCode)
///
/// Parameters:
///   - pFileName: char(10) - File name to search for
///   - pPartnerName: char(10) - Partner name to match
///   - pIdentifier: char(8) - Identifier
///   - pReturnCode: char(1) - Return code (output)
///
/// Reference:
/// https://www.nicklitten.com/course/adventures-in-automatic-rpg-upgrade-with-vscode/
///
/// Modification History:
///   V.000 1994-05-01 | Nick Litten | Initial creation
///   V.001 2014-03-10 | Nick Litten | Converted to free format RPG
///   V.002 2007-05-25 | Nick Litten | Video RPG upgrade tour
///   V.003 2026-04-01 | Nick Litten | Fully modernized with embedded SQL
///

ctl-opt
  dftactgrp(*no)
  actgrp(*caller)
  option(*nodebugio:*srcstmt)
  copyright('FREERPG5 | V.003 | CFT File Submission with SQL')
  ;

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