ibmi-brunch-learn

Announcement

Collapse
No announcement yet.

procedure to get calling programs name

Collapse
X
 
  • Filter
  • Time
  • Show
Clear All
new posts

  • procedure to get calling programs name

    This procudure will return the calling program's name
    Included in zip file are example of using the procedure

    procedure compiled with pdm option 15 then CRTPGM to get program referencing the procedure. (or binding directory)

    Code:
    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
    Attached Files
    All my answers were extracted from the "Big Dummy's Guide to the As400"
    and I take no responsibility for any of them.

    www.code400.com
Working...
X