Retrieve Member Description
From MidrangeWiki
Revision as of 21:58, 14 December 2018 by DaveLClarkI (talk | contribs) (Created page with "Category:Sample Code Category:Service Procedures __FORCETOC__ == Summary == The following are the RPG/LE fully free-form definitions and instructions needed for using...")
Summary
The following are the RPG/LE fully free-form definitions and instructions needed for using the Retrieve Member Description service procedure. This service procedure simply allows the caller to retrieve a member description from a file based on the member name rather than the file name. This means that rather than stopping at the first file with a matching name, the process continues searching until both a matching file and a matching member name is found.
Service Prototype
Place the following in a separate copybook for inclusion in both the caller and the service program source members.
**free //****************************************************************************** // Find a member description using *BYMBRNAME search rather than *BYFILENAME. //****************************************************************************** dcl-pr GenUtl_RtvMbrDesc varchar(32768); MbrName char(10) const; MbrFile char(20) const; MbrDFmt char(8) const; MbrDLen int(10) const; 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); //****************************************************************************** // Find a member description using *BYMBRNAME search rather than *BYFILENAME. //****************************************************************************** dcl-proc GenUtl_RtvMbrDesc export; dcl-pi *n varchar(32768); MbrName char(10) const; MbrFile char(20) const; MbrDFmt char(8) const; MbrDLen int(10) const; end-pi; dcl-s ObjDesc char(32768); if MbrName <= *blanks; // if no member name return '*ERR-MBRNAME'; // indicate an error endif; if MbrFile <= *blanks; // if no file name return '*ERR-MBRFILE'; // indicate an error endif; if MbrDFmt <> 'MBRD0100' and MbrDFmt <> 'MBRD0200' and MbrDFmt <> 'MBRD0300' and MbrDFmt <> 'MBRD0400' and MbrDFmt <> 'MBRD0500'; // if invalid desc format return '*ERR-MBRDFMT'; // indicate an error endif; if MbrDLen < %len(QUSM0100) or MbrDLen > 32768; // if invalid desc length return '*ERR-MBRDLEN'; // indicate an error endif; callp IBMAPI_RtvMbrDesc( ObjDesc: MbrDLen: MbrDFmt : MbrFile: MbrName: '1': ApiErrC: '1'); if ApiErrC.BytAvail > *zero; // if an error occurred return '*ERR-' + ApiErrC.MsgId; // return the message id endif; QUSM0100 = %subst(ObjDesc: 1: %len(QUSM0100)); // map the header return %subst(ObjDesc: 1: QUSBRTN02); // return the member description end-proc;