Get List Entry

Summary

The following are the RPG/LE fully free-form definitions and instructions needed for using the Get List Entry service procedure. This service procedure simply allows the caller to retrieve the nth entry from a comma-separated list of values. See also In List and In String.

Service Prototype

Place the following in a separate copybook for inclusion in both the caller and the service program source members.

**free

//==============================================================================
// This procedure retrieves the value of the specified entry from the supplied
// comma-delimited list.  If no particular entry is requested, then the first
// entry is returned by default.  If no entries found or the requested entry
// is not found, then blanks are returned.
//==============================================================================
dcl-pr GenUtl_GetListEntry   varchar(300);
  pList                      varchar(65530) const;
  pEntry                     packed(5:0)    const     options(*nopass);
end-pr;

Service Procedure

Place the following in a service program source member.

**free
ctl-opt NoMain AlwNull(*UsrCtl) Debug Option(*SrcStmt:*NoDebugIo)
        DatFmt(*ISO) TimFmt(*ISO) DftActGrp(*No) ActGrp(*Caller);

//==============================================================================
// This procedure retrieves the value of the specified entry from the supplied
// comma-delimited list.  If no particular entry is requested, then the first
// entry is returned by default.  If no entries found or the requested entry
// is not found, then blanks are returned.
//==============================================================================
dcl-proc GenUtl_GetListEntry      export;
  dcl-pi *n             varchar(300);
    pList               varchar(65530) const;
    pEntry              packed(5:0)    const     options(*nopass);
  end-pi;

  dcl-s len             packed(3:0);
  dcl-s beg             packed(5:0) inz(1);
  dcl-s end             packed(5:0);
  dcl-s idx             packed(5:0);

  if %parms < %parmnum(pEntry)         // if optional parm not passed
  or %addr(pEntry) = *null             // or was omitted
  or pEntry <= *zero;                  // or is invalid
    idx = *zero;                       // assume first entry
  else;                                // else
    idx = pEntry - 1;                  // selected entry based on zero-offset
  endif;

  dow idx > *zero                      // keep searching until entry found
  and beg > *zero;                     // or end of list is reached
    if ((beg + 1) <= %len(pList));     // not end of list, yet?
      idx -= 1;                        // decremement entry counter
      beg = %scan(',': pList: beg + 1); // search for next entry
      if beg > *zero;                  // comma for next entry found?
        beg += 1;                      // point to beginning of next entry
      endif;
    else;                              // else
      beg = *zero;                     // signal end of list
    endif;
  enddo;

  if beg <= *zero;                     // if no entry found
    return *blank;                     // return blanks
  endif;

  end = %scan(',': pList: beg + 1);    // find beginning of the next entry
  if end <= *zero;                     // if current entry is last entry
    end = %len(pList) + 1;             // set beg. of next entry past endof list
  endif;
  len = end - beg;                     // calculate end of current entry
  if len < *zero;                      // if no entry found
    len = *zero;                       // default to zero length
  endif;

  return %subst(pList: beg: len);      // return resulting entry
end-proc;