Tweet
display contents of dataq..
this is from another site - just wanted to remember it..
Code:
FQSYSPRT O F 132 PRINTER OFLIND(*INOF)
//--*STAND ALONE-------------------------------------------
d ColumnShift s 10i 0 inz
d cSflPag c const(7)
d ff s 5u 0 inz
d ForCounter s 10i 0 inz
d Hex40 c const(x'40')
d i_DtaqNameQual s 20a inz('DATAQ JAMIELIB')
d ipaddress s 20
d IsHexMode s n inz(*off)
d ofs s 10i 0 inz
d p1data s 125
d qTrimLen s 10i 0 inz
d Rcvar S 5000A Inz
d sflDspPag s 10i 0 inz
d Shift s 5u 0 inz(58)
d TempqDS s 116a inz
d torecNum s 5u 0 inz
d v0200len s 10i 0 inz
d xx s 10i 0 inz
d UserSpaceName s 20a inz('DTAQDUMP QTEMP ')
//--*DATA STRUCTURES---------------------------------------
// Move pointer through message entries
d ListEntryDS ds qualified based(ListEntryPtr)
d NextEntry 10i 0
d Datetime 8a TOD format
d MessageData 1000a variable text
//
// Program Info
//
d SDS
d @PGM 001 010
d @PARMS 037 039 0
d @MSGDTA 91 170
d @MSGID 171 174
d @JOB 244 253
d @USER 254 263
d @JOB# 264 269 0
d qmhrdqm PR extpgm('QMHRDQM ') Get q Entry
db like(qmhrdqmDS) Receiver
d Options(*varsize)
d 10i 0 const Length
d 8a const Api Format
d 20a Dtaq and Lib
db like(RDQS0200DS) Options(*varsize) Key Information
d const
d 10i 0 const Key Info Length
d 8a const Information
db like(ApiErrDS) Options(*varsize) Error Parm
// parms for QMHRDQM retrieve dataq entries
d qmhrdqmDS ds qualified based(uheadPtr)
d BytesReturned 10i 0 overlay(qmhrdqmDS:1)
d BytesAvail 10i 0 overlay(qmhrdqmDS:5)
d MsgRtnCount 10i 0 overlay(qmhrdqmDS:9)
d MsgAvlCount 10i 0 overlay(qmhrdqmDS:13)
d KeyLenRtn 10i 0 overlay(qmhrdqmDS:17)
d KeyLenAvl 10i 0 overlay(qmhrdqmDS:21)
d MsgTxtRtn 10i 0 overlay(qmhrdqmDS:25)
d MsgTxtAvl 10i 0 overlay(qmhrdqmDS:29)
d EntryLenRtn 10i 0 overlay(qmhrdqmDS:33)
d EntryLenAvl 10i 0 overlay(qmhrdqmDS:37)
d OffsetToEntry 10i 0 overlay(qmhrdqmDS:41)
d DtaqLib 10a overlay(qmhrdqmDS:45)
// Message selection info - RDQS0100 nonkeyed queues RDQS0200 Keyed data queues
d rdqs0100DS ds qualified
d Selection 1a inz('A') all
d Reserved 3a
d MsgByteRtv 10i 0 inz overlay(rdqs0100DS:5) message bytes to rtv
// Error return code parm for APIs.
d ApiErrDS ds qualified
d BytesProvided 10i 0
d BytesReturned 10i 0
d ErrMsgId 7a
d ReservedSpace 1a
d MsgReplaceVal 112a
d rdqs0200DS ds qualified
d Selection 1a inz('K') Keyed
d KeyOrder 2a inz('GE')
d MsgByteRtv 10i 0 inz overlay(rdqs0200DS:5) message bytes to rtv
d KeyByteRtv 10i 0 inz overlay(rdqs0200DS:9) keys bytes to rtv
d KeyLen 10i 0 inz overlay(rdqs0200DS:13) key length
d Key 256a overlay(rdqs0200DS:17) key value
d quscrtus PR extpgm('QUSCRTUS')
d 20a
d 10a const
d 10i 0 const
d 1a const
d 10a const
d 50a const
d 10a const
db like(ApiErrDS)
d f_Quscrtus PR *
d 20a
d qusptrus PR extpgm('QUSPTRUS')
d 20a
d *
db like(ApiErrDS)
d qmhqrdqd PR extpgm('QMHQRDQD') Data q Description
db like(qmhqrdqdDS) Receiver
d 10i 0 const Length
d 8a const Api Format
dd 20a Dtaq and Lib
d qmhqrdqdDS ds qualified inz
d MsgLength 10i 0 overlay(qmhqrdqdDS:9)
d KeyLength 10i 0 overlay(qmhqrdqdDS:13)
d Sequence 1a overlay(qmhqrdqdDS:17)
d SenderID 1a overlay(qmhqrdqdDS:18)
d Text 50a overlay(qmhqrdqdDS:20)
d LocalOrDDM 1a overlay(qmhqrdqdDS:70)
d EntryCount 10i 0 overlay(qmhqrdqdDS:73)
d MaxOverFlow 10i 0 overlay(qmhqrdqdDS:77)
d DtaqName 10a overlay(qmhqrdqdDS:81)
d DtaqLib 10a overlay(qmhqrdqdDS:91)
d APIError ds Qualified
d BytesP 1 4I 0 inz(%size(apiError))
d BytesA 5 8I 0 inz(0)
d Messageid 9 15
d Reserved 16 16
d messagedta 17 256
d Infds ds INFDS data structure
d Choice 369 369
d Currec 378 379I 0
//---------------------------------------------------------
/free
except head;
// create user space
callp QUSCRTUS(
UserSpaceName:
'TEST':
13000000:
x'00':
'*ALL':
'List Objects ':
'*NO ':
ApiErrDS);
// Get pointer to object list user spaces
callp QUSPTRUS(
UserSpaceName:
uHeadPtr:
ApiErrDS);
// Call API to retrieve data queue description.
callp QMHQRDQD(
qmhqrdqdDS:
%size(qmhqrdqdDS):
'RDQD0100':
i_DtaqNameQual);
exsr srRefreshScreen;
*inlr = *on;
return;
//---------------------------------------------------------
// Call API to retrieve data queue entries
// Different type dataqs require a different parm list to the API.
//---------------------------------------------------------
begsr srRefreshScreen;
1b if qmhqrdqdDS.Sequence = 'K';
rdqs0200DS.MsgByteRtv = qmhqrdqdDS.MsgLength;
rdqs0200DS.KeyByteRtv = qmhqrdqdDS.KeyLength;
rdqs0200DS.KeyLen = qmhqrdqdDS.KeyLength;
v0200Len = 16 + qmhqrdqdDS.KeyLength; //len of info
callp QMHRDQM(
qmhrdqmDS:
12000000:
'RDQM0200':
i_DtaqNameQual:
rdqs0200DS:
v0200Len:
'RDQS0200':
ApiErrDS);
1x else;
// non keyed
rdqs0100DS.MsgByteRtv = qmhqrdqdDS.MsgLength;
callp QMHRDQM(
qmhrdqmDS:
12000000:
'RDQM0100':
i_DtaqNameQual:
rdqs0100DS:
%size(rdqs0100DS):
'RDQS0100':
ApiErrDS);
1e endif;
//---------------------------------------------------------
// Spin through the dataq entries.
// Convert API date/time stamp to human-readable.
// Load to subfile.
//---------------------------------------------------------
1b if qmhrdqmDS.MsgRtnCount > 0;
//---------------------------------------------------------
// Move pointer through message entries
//---------------------------------------------------------
ListEntryPtr = uHeadPtr + qmhrdqmDS.OffsetToEntry;
2b for ForCounter = 1 to qmhrdqmDS.MsgRtnCount;
exsr srTempqDS;
//viewqDS = %subst(TempqDS: 1);
ListEntryPtr = uHeadPtr + ListEntryDS.NextEntry;
2e endfor;
1e endif;
endsr;
//---------------------------------------------------------
// Fill TempqDS from User Space Data.
// Note: If Keyed data queue, then there is an unexplained
// 5 bytes at the beginning of each key.
// not sure if this a bug or an undocumented feature.
// Also the size of the msg entry could be larger than msg variable
// allowed. qTrimLen is used to make sure this doesn't blow up!
//---------------------------------------------------------
begsr srTempqDS;
qTrimLen = qmhqrdqdDS.MsgLength - ofs;
1b if qmhqrdqdDS.Sequence = 'K';
2b If (5 + qmhqrdqdDS.KeyLength) + qmhqrdqdDS.MsgLength
> %size(ListEntryDS.MessageData);
qTrimLen =
%size(ListEntryDS.MessageData) - (5 + qmhqrdqdDS.KeyLength);
2e endif;
// RMH -Entry/Key display mode.
TempqDS =
%subst(ListEntryDS.MessageData:
5 + qmhqrdqdDS.KeyLength + ofs: qTrimLen);
1x else;
2b if qmhqrdqdDS.MsgLength > %size(ListEntryDS.MessageData);
qTrimLen = %size(ListEntryDS.MessageData);
2e endif;
// When the actual message
// received is shorter than the maximum entry possible
// TempqDS = %subst(ListEntryDS.MessageData: 1 + ofs: qTrimLen);
2b if ofs + 1 <= %size(ListEntryDS.MessageData);
TempqDS = %subst(ListEntryDS.MessageData: 1 + ofs);
2x else;
TempqDS = *blanks;
2e endif;
// write records to subfile
p1data = %trim(tempqDS);
if *inof = *on;
except head;
*inof = *off;
endif;
except detail;
1e endif;
endsr;
/end-free
OQSYSPRT E HEAD 1 03
O 10 'data'
O E DETAIL 1
O p1data 130
Comment