× The internal search function is temporarily non-functional. The current search engine is no longer viable and we are researching alternatives.
As a stop gap measure, we are using Google's custom search engine service.
If you know of an easy to use, open source, search engine ... please contact support@midrange.com.


  • Subject: Re: Help using the Retrieve Data Queue Message (QMHRDQM) API
  • From: watern@xxxxxxxxxxxxxx
  • Date: Wed, 31 May 2000 09:38:49 +0100



Hi Tom,

I did some work with this API a couple of months ago, I remember spending quite
a bit of time trying to work out what was going on with the date.   I eventually
came up with the a method of decoding the date, I seem to remember the important
bit being the *DTS as the input format!

I have pasted in two lots of code, one for the date conversion and one for the
way I went about decoding the entries. Hope I havent missed anything important !

I created the routine CvtDTSDate to return the decoded date & time in field
Wk_RtnDate, in the format 28/01/00 08:49:49.

 * Parms for QWCCVTDT API
D Inp_Format      S             10A   inz('*DTS')
D Inp_Date        S              8A   inz(' ')
D Out_Format      S             10A   inz('*YMD')
D Out_Date        S             18A
D Qcvt_ErrCd      DS
D  Qcvt_ErrByPrv                10I 0 inz(%SIZE(Qcvt_ErrCd))
D  Qcvt_ErrByAvl                10I 0 inz(0)
D  Qcvt_ErrByExc                 7A   inz('       ')
D  Qcvt_ErrByRsv                 1A
....
 *   Workfields
D WK_Date         S              6A
D WK_Time         S              6A
D WK_DatYMD       S               D   DATFMT(*ISO)
D WK_TimHMS       S               T   TIMFMT(*ISO)
D WK_Char1        S              8A
D WK_Char2        S              8A
D WK_RtnDate      S             17A

C                   EVAL      Inp_Date = QDQE_EnqDtTm
C                   EXSR      CvtDTSDate
....
C     CvtDTSDate    BEGSR
                                                                                
                                 


C                   CALL      'QWCCVTDT'
C                   PARM                    Inp_Format
C                   PARM                    Inp_Date
C                   PARM                    Out_Format
C                   PARM                    Out_Date
C                   PARM                    Qcvt_ErrCd

C                   EVAL      WK_Date = %SUBST(Out_Date:2:6)
C                   EVAL      WK_Time = %SUBST(Out_Date:8:6)
C     *YMD0         MOVE      WK_Date       WK_DatYMD
C     *HMS0         MOVE      WK_Time       WK_TimHMS
C     *DMY          MOVE      WK_DatYMD     WK_Char1
C     *HMS          MOVE      WK_TimHMS     WK_Char2
C                   EVAL      WK_RtnDate = WK_Char1 + ' ' + Wk_Char2


As far decoding the entries are concerned, I came up with the following. I am
sure that you can work out what is going on, the QDQD_ fields are returned from
the data qeue description API. The @3 fields are fields on the display file. The
array ArrPtrs contains pointers for the start position of the data queue entries
returned. The entries are displayed one at a time.


D QDQE_RtnData    DS          9999    BASED(PtrRtnDqe)
D  QDQE_BytRtn                  10I 0
D  QDQE_BytAvl                  10I 0
D  QDQE_MsgsRtn                 10I 0
D  QDQE_MsgsAvl                 10I 0
D  QDQE_KeyLRtn                 10I 0
D  QDQE_KeyLAvl                 10I 0
D  QDQE_TxtLRtn                 10I 0
D  QDQE_TxtLAvl                 10I 0
D  QDQE_EntLRtn                 10I 0
D  QDQE_EntLAvl                 10I 0
D  QDQE_Offset1                 10I 0
D  QDQE_LibName                 10A
D  QDQE_Reservd                  1A
D  QDQE_Entry     DS          9999    BASED(PtrDqeEnt)
D   QDQE_Offset2                10I 0
D   QDQE_EnqDtTm                 8A
D   QDQE_MsgText              9987A


 *   Pointers
D PtrRtnDqd       S               *
D PtrRtnDqe       S               *
D PtrDqeEnt       S               *
D ArrPtrs         S               *   DIM(99)
D #ArrPtrsMax     S              3P 0


C                   EVAL      PtrDqeEnt = PtrRtnDqe + QDQE_Offset1
C                   DO        *HIVAL

 *   Leave if out of bounds
C                   IF           (#MsgNo > QDQE_MsgsRtn)
C                             or (#MsgNo <= 0)
C                   LEAVE
C                   ENDIF

C                   EVAL      #X       = QDQE_KeyLRtn
C                   EVAL      #Y       = QDQE_KeyLRtn + 1
C                   EVAL      #Z       = QDQE_TxtLRtn
C                   EVAL      @3KEY    = %SUBST(QDQE_MsgText:1:#X)
C                   IF        QDQD_SndId = 'Y'
C                   EVAL      @3SNDID  = %SUBST(QDQE_MsgText:#Y:36)
C                   EVAL      #Y       = #Y + 36
C                   EVAL      #Z       = #Z - 36
C                   EVAL      @3TEXT   = %SUBST(QDQE_MsgText:#Y:#Z)
C                   ELSE
C                   EVAL      @3SNDID  = 'N/A'
C                   EVAL      @3TEXT   = %SUBST(QDQE_MsgText:#Y:#Z)
C                   ENDIF

 *   Display the screen with values for current dataqueue entry
C                   EXFMT     SCN3

 *   F3 = Quick Exit
C                   IF        *INKC = *ON
C                   LEAVE
C                   ENDIF


 *   Maintain array with list of pointers for dataq entries
C                   IF        #MsgNo > #ArrPtrsMax
C                   EVAL      #ArrPtrsMax = #ArrPtrsMax + 1
C                   EVAL      ArrPtrs(#ArrPtrsMax) = PtrDqeEnt
C                   ENDIF

 *   Set next message to be displayed
C                   IF        *INKL = *OFF
C                   EVAL      #MsgNo   = #MsgNo + 1
C                   ELSE
C                   EVAL      #MsgNo   = #MsgNo - 1
C                   ENDIF

 *   Set pointer for structure for data queue entry to be displayed nxt
C                   IF        #MsgNo > #ArrPtrsMax
C                   EVAL      PtrDqeEnt = PtrRtnDqe + QDQE_Offset2
C                   ELSE
C                   EVAL      PtrDqeEnt = ArrPtrs(#MsgNo)
C                   ENDIF

C                   ENDDO


HTH
Nigel.











+---
| This is the RPG/400 Mailing List!
| To submit a new message, send your mail to RPG400-L@midrange.com.
| To subscribe to this list send email to RPG400-L-SUB@midrange.com.
| To unsubscribe from this list send email to RPG400-L-UNSUB@midrange.com.
| Questions should be directed to the list owner/operator: david@midrange.com
+---

As an Amazon Associate we earn from qualifying purchases.

This thread ...


Follow On AppleNews
Return to Archive home page | Return to MIDRANGE.COM home page

This mailing list archive is Copyright 1997-2024 by midrange.com and David Gibbs as a compilation work. Use of the archive is restricted to research of a business or technical nature. Any other uses are prohibited. Full details are available on our policy page. If you have questions about this, please contact [javascript protected email address].

Operating expenses for this site are earned using the Amazon Associate program and Google Adsense.