Sequentially process all rows in a table

To improve program readability and facilitate debugging, the table will be opened with an explicit open command. To obtain the rows in a sequence, the FC (Fetch by Count) command will be used with full manual control of the counter.

In COBOL
 PROCEDURE DIVISION.
 HOUSE-KEEPING.
*** OPEN A TABLE FOR WRITE AND SET COMMAND TO FETCH BY COUNT.
      MOVE 'OW'      TO    xxxx-COMMAND

      CALL 'TBLBASE' USING TB-PARM
                           xxxx-COMMAND-AREA
                           xxxx-PASSWORD
                           GENERATION

      MOVE 'FC'      TO    xxxx-COMMAND
      MOVE ZERO      TO    xxxx-COUNT
      MOVE ' '       TO    xxxx-FOUND

      PERFORM UNTIL  xxxx-FOUND = 'N'
          ADD +1     TO    xxxx-COUNT

          CALL 'TBLBASE' USING TB-PARM
                               xxxx-COMMAND-AREA
                               xxxx-ROW-AREA

          IF xxxx-FOUND = 'Y'
*             (process table row obtained)
          END-IF
      END-PERFORM
In C
#include <stdio.h>
#include <string.h>
#include <stdlib.h>
#include "dkh.h"
/*
 * DK1TEX2C
 *
 * Process every row in a table sequentially.
 *
 * This program will explicitly open the table for write,
 * So no other program can change the data while the program
 * is reading the table.
 * But we did not explicitly close the table after the fetch
 * by count. It is because once the batch job is finish execution.
 * The operation system will release the table.
 */
 
/*
 * Assume these are user inputs.
 */
static char szTableName[6] = "AARON";
static char szStatus[6] = "NYYYN";
static char szWritePassword[2] = " ";
static int nGen = 0;

int main(void)
{
    TbParmStruct tbParm;
    TbCommandAreaStruct tbCommArea;
    TbTableDefinitionStruct tbTableDef;
    char sWritePassword[8];
    char * pRowArea = NULL;
    char sStatus[8];
    char sTableName[8];
    int nGeneration = nGen;
    int nCount = 0;
    int notFound = 1;
    
    /*
     * Initialize the parameters.
     */
    fixStringLength( szTableName, sTableName, 8 );
    InitTbParm( &tbParm );
    InitTbCommandArea( &tbCommArea, sTableName );
    InitTableDef( &tbTableDef );
    
    /*
     * Initialize tableBASE with CS, ChangeStatus.
     */
    fixStringLength( szStatus, sStatus, 8 );
    memcpy( tbCommArea.tbCommand, "CS", 2 );
    TBLBASE( &tbParm, &tbCommArea, sStatus );
    if( tbCommArea.tbError != TB_SUCCESS )
    {
        printf( "CS\n");
        printf( "Found code: %c\n", tbCommArea.tbFound );
        printf( "Error code: %d\n", tbCommArea.tbError );
        printf( "Sub code: %d\n", tbCommArea.tbErrorSubcode );
        return tbCommArea.tbError;
    }
    
    /*
     * Call tableBASE with OW, OpenforWrite.
     */
    fixStringLength( szWritePassword, sWritePassword, 8 );
    memcpy( tbCommArea.tbCommand, "OW", 2 );
    TBLBASE( &tbParm, &tbCommArea, sWritePassword, nGeneration);
    if( tbCommArea.tbError != TB_SUCCESS )
    {
        printf( "OW\n");
        printf( "Found code: %c\n", tbCommArea.tbFound );
        printf( "Error code: %d\n", tbCommArea.tbError );
        printf( "Sub code: %d\n", tbCommArea.tbErrorSubcode );
        return tbCommArea.tbError;
    }
    
    /*
     * GD, get table definition to retrieve both the row length
     * and key length.
     */
    memcpy( tbCommArea.tbCommand, "GD", 2 );
    TBLBASE( &tbParm, &tbCommArea, &tbTableDef, nGeneration );
    if( (tbCommArea.tbError != TB_SUCCESS)
          || (tbCommArea.tbFound == 'N') )
    {
        printf( "GD\n");
        printf( "Found code: %c\n", tbCommArea.tbFound );
        printf( "Error code: %d\n", tbCommArea.tbError );
        printf( "Sub code: %d\n", tbCommArea.tbErrorSubcode );
        return tbCommArea.tbError;
    }
    
    /*
     * Allocate space for a row (with an additional string
     * terminator).
     */
    pRowArea = (char *) malloc( tbTableDef.rowSize + 1 );
    if( pRowArea == NULL )
       return TB_ERROR;
    memset( pRowArea, ' ', tbTableDef.rowSize);

    memcpy( tbCommArea.tbCommand, "FC", 2 );
    nCount = 0;
    while( notFound )
    {
        tbCommArea.tbCount = ++nCount;
        /* Call tableBASE with FC, FetchbyCount */
        TBLBASE( &tbParm, &tbCommArea, pRowArea );
        if( tbCommArea.tbFound == 'N' )
            notFound = 0;
        else
        {
            pRowArea[tbTableDef.rowSize] = '\0';
            printf( "Row %d: %s\n", nCount, pRowArea );
            notFound = 1;
        }
    }
    
    if( pRowArea != NULL )
        free( pRowArea );
    
    return TB_SUCCESS;
}
In PL/I
%process s list map compile xref attributes limits(extname(30));
%process PP(macro);
 /******************************************************************/
 /* This program demonstrates how to sequentially fetch all rows   */
 /* from a table                                                   */
 /******************************************************************/
 smplepli: proc options(main);
 declare
   tblbase external entry options(asm);
 /*                                                                */
 /* tbparmsp contains the PL/I copybooks for TBPARM and TB-COMMAND */
 /* and can be found in your distribution library                  */
 /*                                                                */
 %include tbparmsp;
 /*                        */
 /* row area for table     */
 /*                        */
 dcl tb_row_area char(99);
 /*                        */
 /* open table for read    */
 /*                        */
 tb_command_code = 'OR';
 tb_table = 'EXAMPLE';
 call tblbase(tb_parm,
              tb_command);
 tb_count = 0;
 if (tb_error = 0) then
   do;
     /*                           */
     /* fetch all rows from table */
     /* starting with count 1     */
     /*                           */
     do until (tb_found = 'N');
         tb_count = tb_count + 1;
         tb_command_code = 'FC';
         call tblbase(tb_parm,
                      tb_command,
                      tb_row_area);
         put list (tb_row_area) skip;
     end;
     /*                               */
     /* close table                   */
     /*                               */
     tb_command_code = 'CL';
     call tblbase(tb_parm,
                  tb_command); 
   end;
 else
   put list ('or return code:',tb_error ) skip;
 end smplepli;