|
midrange.com
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 mailing list archive is Copyright 1997-2025 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.
