Figure 1. Bill of Materials example

DDS for PARTS file
A          R PARTS
A            PART_ID       15A
A            REQ_ID        15A
A            REQ_QTY       15P 0
A          K PART_ID
RPG prototype file BOM_PR
 // Note the use of the library-qualified file in EXTNAME

D partsDs_in    E DS                  extname('DEVLIB/PARTS'
D                                           : *INPUT)
D                                     qualified
D                                     template

D bom             PR
D   filename                    21a   const
D   itemId                            like(partsDs_in.part_id) 
D                                     const
D   quantity                    10i 0 value options(*nopass)
D   indentLen                   10i 0 value options(*nopass)
RPG source file
 /copy BOM_PR

P bom             B
 // F-specs: Note
 // - the use of files local to a subprocedure
 // - the use of the STATIC keyword for outFile
 //   so the same file open is used for all calls
 // - the use of the QUALIFIED keyword for inFile
 //   so the record format PARTS will be infile.parts
 // - the use of the EXTDESC keyword to tell the
 //   compiler where to find the file at compile time
FoutFile   o    f   80        printer static

NF                                     extfile('QSYSPRT')
F                                     usropn

FinFile    if   e           k disk    qualified
F                                     extdesc('DEVLIB/PARTS')
F                                     extfile(filename)

D bom             PI
D   filename                    21a   const
D   itemId                            like(partsDs_in.part_id) 
D                                     const
D   quantityParm                10i 0 value options(*nopass)
D   indentLenParm...
D                               10i 0 value options(*nopass)
D quantityParmNum...
D                 c                   3
D indentLenParmNum...
D                 c                   4

D outDs           ds                  len(80)

D inDs            ds                  likeDs(partsDS_in)
D closeOutfile    s               n   inz(*off)
D indentLen       s             10i 0 inz(0)
D quantity        s             10i 0 inz(1)

D indentVal       s               a   len(80) varying inz(*blanks)

 // This data structure "totals" is much larger than the
 // former limit of 65535.
D totals          ds                  qualified static
D   numParts                    10i 0 inz
 // Array "info" has a dimension much higher than the former
 // limit of 32767.
D   info                              dim(100000)
D   part                              like(partsDs_in.part_id)
D                                     overlay(info:*next)
D   quantity                    10i 0 overlay(info:*next)
D ix              s             10i 0
D qty_factor      s             10i 0 inz(1)
 /free
       // Get the "quantity" from the parameter, if passed
       if %parms >= quantityParmNum;
          quantity = quantityParm;
       endif;
       // Get the "indentLen" from the parameter, if passed
       if %parms >= indentLenParmNum;
          indentLen = indentLenParm;
       endif;
       // Open the file if necessary
       // (This is the initial call)
       if not %open(outFile);
          open outFile;
          closeOutfile = *on;
          // Since this is the initial call, write out
          // the main part to have its bill-of-materials
          // exploded
          outDs = itemId + ' '
                + %char(quantity);
          write outFile outDs;
          // Increase the indent length for any required subparts
          indentLen += 2;
          // Initialize the totals data structure, in case
          // this procedure has been run before
          totals.numParts = 0;
       endif;
       // Set up the number of blanks for indentation
       %len(indentVal) = indentLen;
       // Find all other parts required for this part
       // Note
       // - the use of the qualified record format infile.parts
       // - the use of the result data structure inDs
       // - how using a qualified record format makes it
       //   easier to relate the %FOUND(filename) to the
       //   CHAIN operation to the record format

       chain itemId inFile.parts inDs;
       if %found(inFile);
          dow %status(inFile) = 0;
             outDs = indentVal
                   + inDs.req_id
                   + %char(inDs.req_qty);
             write outFile outDs;
             // Call this procedure recursively to handle
             // the items required by the required part
             bom (filename : inDs.req_id
                : inDS.req_qty * quantity: indentLen + 2);
             reade itemId inFile.parts inDs;
          enddo;

       else;
          // This part doesn't require any other parts
          // so just keep track of totals number needed
          ix = %lookup(itemId : totals.part
                     : 1 : totals.numParts);
          if ix = 0;
             // We haven't seen this part before so add
             // it to the totals array
             totals.numParts += 1;
             ix = totals.numParts;
             totals.part(ix) = itemId;
             totals.quantity(ix) = 0;
          endif;
          totals.quantity(ix) += quantity;
       endif;
       // If this is the controlling invocation of the
       // subprocedure, print out the totals now
       if closeOutfile;
          outDs = '***** TOTALS *****';
          write outFile outDs;
          for ix = 1 to totals.numParts;
             outDs = totals.part(ix) + ' '
                   + %editc(totals.quantity(ix) : 'P');
             write outFile outDs;
          endfor;
          close outFile;
       endif;
 /end-free
P bom             E
Sample input
PART_ID          REQ_ID        REQ_QTY
FAUCET_001       HANDLE_002          2
CUPBOARD_007     HINGE_013           3
HANDLE_002       MECH_003            1
MECH_003         WASHER_009          4
MECH_003         SCREW_017           6
FAUCET_001       TAP_063             1
Sample output, for part FAUCET_001, quantity 3
FAUCET_001      3
  HANDLE_002     2
    MECH_003       1
      WASHER_009     4
      SCREW_017      6
  TAP_063        1
***** TOTALS *****
WASHER_009               24
SCREW_017                36
TAP_063                   3