Re: QMHRDQM API

["Werner Grzemba" <kv@xxxxxxxx>]

On 8 Sep 2003 at 18:38, sachin_kr_gupta wrote:

> Has anyone used the API "QMHRDQM" to retrieve contents of DATAQ in Cobol/400 
> ? Please provide a code sample.

Hi Sachin,

here follows a sample program for a data queue with a fixed entry length of 64 
bytes:
---------------------------------------------------------------------------------------------------------------
 identification division.
       program-id. testrddtaq.
       environment division.
       configuration section.

       data division.
       working-storage section.

       01  recvar.
           02 bytes-returned     pic s9(9) binary.
           02 bytes-available    pic s9(9) binary.
           02 number-msgs-enqu   pic s9(9) binary.
           02 number-msgs-avail  pic s9(9) binary.
           02 key-len-returned   pic s9(9) binary.
           02 actual-key-len     pic s9(9) binary.
           02 msg-len-returned   pic s9(9) binary.
           02 actual-msg-len     pic s9(9) binary.
           02 entry-len-ret      pic s9(9) binary.
           02 entry-len-avail    pic s9(9) binary.
           02 offset-first-ent   pic s9(9) binary.
           02 returned-lib-name  pic x(10).
           02                    pic x(202).
       01  len-recvar            pic s9(9) binary.
       01  fmt                   pic x(08) value "RDQM0100".
       01  dqname.
           02  dqnam             pic x(10) value "DTAQVSD100".
           02  dqlib             pic x(10) value "BVVVSP1600".
       01  msgsel.
           02  seltype           pic x     value "F".
           02                    pic xxx.
           02  msglen            pic s9(9) binary value 64.
       01  msgslen               pic s9(9) binary.
       01  msgsfmt               pic x(08) value "RDQS0100".
       01  errparm               pic s9(9) binary value zero.
       01  dtaptr                pic s9(4) binary.
       01  dtafld.
           02  dtatod            pic x(08).
           02  dtaval            pic x(64).

       01  infmt                 pic x(10) value "*DTS".
       01  invar                 pic x(08).
       01  outfmt                pic x(10) value "*SYSVAL".
       01  outvar.
           02                    pic x.
           02  xdate             pic x(06).
           02  xtime             pic x(06).
           02                    pic x(03).

       01  dummy                 pic x.

       procedure division.
       main.
           move length of recvar to len-recvar
           move length of msgsel to msgslen
           call "QMHRDQM" using  recvar
                                 len-recvar
                                 fmt
                                 dqname
                                 msgsel
                                 msgslen
                                 msgsfmt
                                 errparm
           end-call
           if  number-msgs-enqu not = zero
               add 5 offset-first-ent giving dtaptr
               move recvar (dtaptr:72) to dtafld
               move dtatod to invar
               perform cvt-tod
               display "Data enqueued on " xdate " at " xtime
               display "Data: " dtaval
               accept dummy
           else
              display "No data enqueued."
           end-if
           goback.

       cvt-tod.
           call "QWCCVTDT" using infmt
                                 invar
                                 outfmt
                                 outvar
                                 errparm
           end-call.
---------------------------------------------------------------------------------------------------------------
Regards,
Werner Grzemba.