Retrieve Member Description

From MidrangeWiki
Jump to: navigation, search


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 just 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.

By Dave Clark

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 not GenUtl_inList(MbrDFmt: 'MBRD0100,MBRD0200,MBRD0300,MBRD0400,'
                              + '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;

References