H NOMAIN
      *T: GetProcName()
      *O: CRTRPGMOD DBGVIEW(*SOURCE)
      *C: CRTSRVPGM SRVPGM(&L/&E) MODULE(&E) EXPORT(*ALL)
      *
      * SYNOPSIS: This source should be compiled as a module and then bound
      *           into a service program called PROCNAME, which should be 
      *           added to a utility binding directort. Then, in your own
      *           applications, you can include the PROCNAME_P copybook at
      *           the top of the source member and in each procedure, you
      *           can include the following line of code:
      *
      *            /free
      *            ...
      *              GetProcName( qproc );
      *            ...
      *            /end-free
      *
      *           Following this call, the qproc data-structure will
      *           contain the name of the procedure, module, program (or
      *           service program) and library. There is no need to
      *           initialize the qproc structure prior to the call.
      *=====================================================================
     D/COPY QRPGLESRC,PROCNAME_P                 ‚GetProcName()
      *
     D QUSEC           DS
     D  ErrBytesProv                 10I 0 Inz(%size(QUSEC))
     D  ErrBytesAvail                10I 0 Inz
     D  ErrMsgID                      7A
     D                                1
     D  ErrMsgDta                   512A
      *
     D qwvrcstk        PR                  Extpgm('QWVRCSTK')
     D   RcvVar                   65535A         Options(*Varsize)
     D   RcvVarLen                   10I 0 Const
     D   Format                       8A   Const
     D   JobIDInfo                65535A   Const Options(*Varsize)
     D   JobIDFormat                  8A   Const
     D   ApiError                                Like(QUSEC)
      *
     D CSTK0100        DS         65535    Qualified
     D   BytesReturn                 10I 0
     D   BytesAvail                  10I 0
     D   CSENumber                   10I 0
     D   CSEOffset                   10I 0
     D   CSENbrRtn                   10I 0
     D   ThreadID                     8A
     D   InfoStatus                   1A
      *
     D CSTK0100Data    DS         65535    Qualified Based(CSTK0100Data@)
     D   CallStackLen                10I 0
     D   StmtIDDisp                  10I 0
     D   StmtIDNbr                   10I 0
     D   ProcNameDisp                10I 0
     D   ProcNameLen                 10I 0
     D   RequestLevel                10I 0
     D   Program                     10A
     D   Library                     10A
     D   MIInstNbr                   10I 0
     D   Module                      10A
     D   ModuleLib                   10A
     D   CtlBdry                       N
     D                                3A
     D   ActGrpNbr                   10U 0
     D   ActGrpName                  10A
     D                                2A
     D   PgmASPName                  10A
     D   LibASPName                  10A
     D   PgmASPNbr                   10I 0
     D   LibASPNbr                   10I 0
      *
     D JIDF0100        DS                  Qualified
     D   JobName                     10A   Inz('*')
     D   JobUser                     10A   Inz
     D   JobNumber                    6A   Inz
     D   IntJobID                    16A   Inz
     D                                5I 0 Inz
     D   ThreadInd                   10I 0 Inz(1)
     D   ThreadID                    20I 0 Inz
      *
      *=====================================================================
      *‚GetProcName(): Returns the full qualified name of the procedure.
      *=====================================================================
     P GetProcName     B                   Export
     D                 PI
     D p_qproc                             Like(qproc)
      *---------------------------------------------------------------------
     D pssr            S               N   Inz(*off)
      *---------------------------------------------------------------------
      /free

        clear qproc;

        reset JIDF0100;
        clear CSTK0100;
        reset QUSEC;
        qwvrcstk( CSTK0100 : %len( CSTK0100 ) : 'CSTK0100' : JIDF0100 :
                  'JIDF0100' : QUSEC );
        if ErrMsgID <> *blanks;
          exsr *pssr;
        endif;
        CSTK0100Data@ = %addr( CSTK0100 ) + CSTK0100.CSEOffset;
        CSTK0100Data@ = CSTK0100Data@ + CSTK0100Data.CallStackLen;
        qproc.library = CSTK0100Data.Library;
        qproc.program = CSTK0100Data.Program;
        qproc.module  = CSTK0100Data.Module;
        if CSTK0100Data.ProcNameDisp > 0;
          qproc.proc = %subst( CSTK0100Data :
                               CSTK0100Data.ProcNameDisp + 1 :
                               CSTK0100Data.ProcNameLen );
        endif;

        p_qproc = qproc;

        begsr *pssr;
          if pssr = *off;
            pssr = *on;
            clear qproc;
            p_qproc = qproc;
          endif;
          return;
        endsr;

      /end-free
     P                 E