Can We Have Procedure Definition In A Copy Book??

[sam400]

Hello,

I have uploaded a source which demonstrate use of Copy Books.

I want to confirm that is it possible that we can have Procedure into a Copy Book. It means that the Prototype Procedure will exist in the main program and the procedure itself exist in a Copy Book defined in the main program.

If possible can any one upload an example of it.

Thanks

[jamief]

I think this is what your looking for

Okay I created a source physical file call QPRCSRC

CRTSRCPF  JAMIELIB/QPRCSRC RCDLEN(112)

Then I put this member in there


Named CALLER_CP

      * CALLER_CP - Copy Member for proc to return pgm name

     D Caller          PR           256
     D  EProgram                     10    VALUE

Then I put this member in QRPGLESRC

Named CALLER

 h nomain expropts(*resdecpos)
      *=============================================
      * Program - CALLER
      * Purpose - return the name of the program that called the
      *           program that uses this procedure.

      * Written - 07/01/04
      * Author  - Jamie Flanary

      * Program Description
      *   This program will return the program name that called the
      *   program that uses this procedure.

      *   The CALLER_CP copy member should be used by programs that
      *   call this procedure to obtain the procedure prototype fields.
      *
      *    InProgram               Char 10     Input/OutPut
      *
      * Indicator Usage
      *   None
      *=============================================

      /COPY QPRCSRC,CALLER_CP

      * Work fields

     d Qusec           DS
     d  QusBPrv                1      4B 0
     d  QusBAvl                5      8B 0
     d  Qusei                  9     15
     d  Quserved              16     16

      * Type definition for the RCVM0200 format

     d RCVM0200        DS           120
     d  ProgramName          111    120

      ****************************************************
      * Standalone Field Definitions                                 *
      ****************************************************

      * Program message parameters

     d Pm_MsgId        S              7    Inz(*BLANKS)
     d Pm_MsgF         S             20    Inz(*BLANKS)
     d Pm_MsgDta       S             12    Inz('Who are you?')
     d Pm_Length       S              9B 0
     d Pm_MType        S             10    Inz('*INFO')
     d Pm_MKey         S              4    Inz(*BLANKS)
     d Pm_CSEntry      S             10    Inz('*')
     d Pm_Counter      S              9B 0 Inz(4)

     d Pm_Format       S              8    Inz('RCVM0200')
     d Pm_Wait         S              9B 0 Inz(0)
     d Pm_Action       S             10    Inz('*REMOVE')
     d WorkProgram     S             10

      * Beginning of procedure

     P CALLER          B                   EXPORT

      * Procedure interface

     d CALLER          PI           256
     d  InProgram                    10    VALUE

     c                   exsr      Hskpg
     c                   eval      WorkProgram = InProgram
      *
      * Set error code structure not to use exceptions
      *
     c                   Z-Add     16            QusBPrv
      *
      * Set length of message data
      *
     c                   Z-Add     12            Pm_Length
      *
      * Send program message
      *
     c                   Call      'QMHSNDPM'
     c                   Parm                    Pm_MsgId
     c                   Parm                    Pm_MsgF
     c                   Parm                    Pm_MsgDta
     c                   Parm                    Pm_Length
     c                   Parm                    Pm_MType
     c                   Parm                    Pm_CSEntry
     c                   Parm                    Pm_Counter
     c                   Parm                    Pm_MKey
     c                   Parm                    Qusec
      *
      * Clear return data structure
      *
     c                   Clear                   RCVM0200
      *
      * Set length of message information
      *
     c                   Z-Add     120           Pm_Length
      *
      * Receive program message
      *
     c                   Call      'QMHRCVPM'
     c                   Parm                    RCVM0200
     c                   Parm                    Pm_Length
     c                   Parm                    Pm_Format
     c                   Parm                    Pm_CSEntry
     c                   Parm                    Pm_Counter
     c                   Parm                    Pm_MType
     c                   Parm                    Pm_MKey
     c                   Parm                    Pm_Wait
     c                   Parm                    Pm_Action
     c                   Parm                    Qusec
      *
     c                   eval      WorkProgram = ProgramName
     c                   return    WorkProgram

      *=============================================
      * HSKPG - OneTime run subroutine
      *=============================================
     c     HSKPG         begsr

     c                   endsr

      *=============================================
     P CALLER          E

I then use option 15 CRTRPGMOD to get the module below

Object      Type      Library     Attribute   Text                
CALLER      *MODULE   LBIOBJ      RPGLE       return program name

Then I wrote this to test the module

Named CALLTST

*
      * COPY FIELDS PROCEDURE PROTOTYPES
      *
      /COPY QprcSRC,CALLER_CP
      *
     D ProgramName     S            010
      *
      * Program Info
      *
     D                SDS
     D  @PGM                 001    010
     D  @PARMS               037    039  0
     D  @MSGID                40     46
     D  @MSGDTA               91    170
     D  @JOB                 244    253
     D  @USER                254    263
     D  @JOB#                264    269  0
      *
      *
     c                   EXSR      HSKPG
     c                   eval      ProgramName = CALLER(@pgm)
     c                   SETON                                        LR
      *
      ****************************************************
      * HSKPG - First time sub-routine
      ****************************************************
      *
     C     HSKPG         BEGSR
      *
     C                   ENDSR

Compiled it with option 15 CRTRPGMOD

Then used CRTPGM

CRTPGM PGM(JAMIELIB/CALLTST) MODULE(JAMIELIB/CALLTST JAMIELIB/CALLER)

Hope this helps
jamie

[sam400]

Thanks

Thanks for the reply

It helped.

I think that this also means that we can have any thing in COPY BOOKS.

Thanks Once again