ibmi-brunch-learn

Announcement

Collapse
No announcement yet.

Using SLEEP function and API QMHSNDM

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

  • Using SLEEP function and API QMHSNDM

    Just an example of using the sleep function instead of
    using QCMDEXC and DLYJOB from within an RPG Program.
    With the added bonus value of...........
    showing how to use API QMHSNDM to send messages to
    QSYSOPR message queue.

    PHP Code:
    ~
         
    H Option( *SrcStmt: *NoDebugIo )  BndDir'QC2LE' )
          *=======================================================================
          * 
    PROGRAM 
          * 
    PURPOSE 
          * 
    WRITTEN 
          * 
    AUTHOR  
          *
          * 
    PROGRAM DESCRIPTION
          
    *   This program will send/receive all EDI documents delay a period of time
          
    *   then run again.
          *
          *
          * 
    INDICATOR USAGE
          
    *   n/a
          
    *
          *=======================================================================
          *
          *  
    Field Definitions.
          *
         
    d Company         s              2     inz('15')
         
    d CmdLength       s             15  5
         d CmdString       s            256
         d Count           s              4  0
         d DelayMinutes    s              4  0  inz
    (7200)
         
    d Loop            s              1     inz('Y')
         
    d Message         s            100A   varying
         d MsgKey          s              4A
         d MsgQ            s             20A   dim
    (1inz('*SYSOPR')
         
    d Network         s              2
         d PassCompany     s              2
         d Q               s              1    inz
    ('''')
         
    d Ran852          s              1
         d Reply           s            100A
         d SessionType     s              1    inz
    ('3')
         
    d OutNetwork      s              2    inz('IX')

         
    d QMHSNDM         PR                  ExtPgm('QMHSNDM')
         
    d   MsgID                        7A   const
         
    d   QualMsgF                    20A   const
         
    d   MsgTxt                   32767A   const options(*varsize)
         
    d   MsgTxtLen                   10I 0 const
         
    d   MsgType                     10A   const
         
    d   MsgQueues                   20A   const dim(50options(*varsize)
         
    d   NumQueues                   10I 0 const
         
    d   RpyQueue                    20A   const
         
    d   MsgKey                       4A
         d   ErrorCode                 8000A   options
    (*varsize)
         
    d   CCSID                       10I 0 const options(*nopass)

         
    d ErrorCode       ds                  qualified
         d   BytesProv                   10I 0 inz
    (0)
         
    d   BytesAvail                  10I 0 inz(0)
          *
         
    d sleep           pr            10i 0 ExtProc'sleep' )
         
    d  seconds                      10u 0 Value
          
    *
          * 
    Program Info
          
    *
         
    d PgmInfo        SDS
         d  
    @PgmName               1     10
         d  
    @Parms                37     39  0
         d  
    @MsgID                40     46
         d  
    @JobName             244    253
         d  
    @UserId              254    263
         d  
    @JobNumber           264    269  0

          
    *==========================================================
          * 
    MAIN LINE
          
    *==========================================================
         
    c                   exsr      Hskpg

         c                   dow       Loop 
    'Y'
          
    *
         
    c                   eval      Message 'Starting EDI p' +
         
    c                             'rocesses ' +
         
    c                             'Time: ' + %char(%time())
         
    c                   exsr      $SendMessage
          
    *
          * 
    process the inbound documents
          
    *
         
    c                   call(e)   'EDI0024C0'
         
    c                   callp     sleep(120 )
          *
         
    c                   call(e)   'EDI0044C0'
         
    c                   parm                    Company
         c                   callp     sleep
    (120 )
          *
         
    c                   call(e)   'EDI0010C01'
         
    c                   callp     sleep(120 )
          *
          * 
    only run this once a day!
          *
         
    c                   if        Ran852 = *blanks
         c                   call
    (e)   'EDI0043C0'
         
    c                   parm                    Company
         c                   callp     sleep
    (120 )
         
    c                   eval      Ran852 'Y'
         
    c                   endif
          *
         
    c                   call(e)   'EDI0048C0'
         
    c                   parm                    Company
         c                   callp     sleep
    (120 )
          *
         
    c                   call(e)   'EDI0042C0'
         
    c                   callp     sleep(120 )
          *
          *                  
    CALL       PGM(CED8622BPARM(IX '2')
         
    c                   call(e)   'CED8622B'
         
    c                   parm                    OutNetwork
         c                   parm                    SessionType
          
    *
          * 
    ending edi processing
          
    *
         
    c                   eval      Message 'Ending EDI p' +
         
    c                             'rocesses ' +
         
    c                             'Time: ' + %char(%time())
         
    c                   exsr      $SendMessage

         c                   callp     sleep
    7200 )


         
    c                   enddo
          
    *
         
    c                   eval      *inlr = *on
          
    *

          /
    free

            
    //-------------------------------------------
            // $SendMessage - send the message to QSYSOPR
            //-------------------------------------------

               
    begsr $SendMessage;


               
    QMHSNDM(   *blanks
                        
    : *blanks
                        
    Message
                        
    : %len(Message)
                        : 
    '*INFO'
                        
    MsgQ
                        
    : %elem(MsgQ)
                        : 
    '*PGMQ'
                        
    MsgKey
                        
    ErrorCode );

               
    endsr;

          /
    end-free
          
    *=================================================
          *    
    Hskpg One time run House keeping subroutine
          
    *=================================================
         
    c     Hskpg         begsr
          
    *
          * 
    addlible edi4xxpgm
          
    *
         
    c                   eval      cmdstring 'addlible edi4xxpgm'
         
    c                   eval      cmdlength = %len(%trim(cmdstring))
          *
         
    c                   call(e)   'QCMDEXC'
         
    c                   parm                    CmdString
         c                   parm                    CmdLength
          
    *
          *
          * 
    addlible edi4xxdta
          
    *
         
    c                   eval      cmdstring 'addlible edi4xxdta'
         
    c                   eval      cmdlength = %len(%trim(cmdstring))
          *
         
    c                   call(e)   'QCMDEXC'
         
    c                   parm                    CmdString
         c                   parm                    CmdLength
          
    *
         
    c                   endsr


    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