Tweet
Makes it easy to use data queues in RPGLE. See the CMDTOOLS thread to see how to install this.
Copy book:
Procedures:
If you have any questions, just give me a shout.
Copy book:
Code:
*****************************************************************
* *
* Copy Book for procedures defined in the service program *
* DATAQTOOLS *
* *
* Because this module deals with business data, the source *
* code has been placed in FRNSRC010 and the object in *
* FRNPGM010 *
* *
*****************************************************************
D CreateDataQ PR LIKE(@@ErrorDS)
D Name 10 CONST
D Library 10 OPTIONS(*NOPASS) CONST
D Size 5P 0 OPTIONS(*NOPASS) CONST
D Text 50 OPTIONS(*NOPASS) CONST
D DeleteDataQ PR LIKE(@@ErrorDS)
D Name 10 CONST OPTIONS(*NOPASS)
D ClearDataQ PR LIKE(@@ErrorDS )
D Name 10 CONST OPTIONS(*NOPASS)
D PushDataQ PR LIKE(@@ErrorDS)
D Data 10000 CONST
D Name 10 CONST OPTIONS(*NOPASS)
D PopDataQ PR 10000
D Name 10 CONST OPTIONS(*NOPASS)
D Wait 5P 0 CONST OPTIONS(*NOPASS)
D PeekDataQ PR 10000
D Name 10 CONST OPTIONS(*NOPASS)
D Wait 5P 0 CONST OPTIONS(*NOPASS)
D SetDataQ PR
D Name 10 CONST
D Library 10 OPTIONS(*NOPASS) CONST
D #ofEntries PR 5S 0
D Name 10 CONST OPTIONS(*NOPASS)
Code:
H OPTION(*NODEBUGIO:*SRCSTMT) DEBUG(*YES) NOMAIN
H BNDDIR('CMDTOOLS':'MSGTOOLS')
*****************************************************************
* *
* Service Program Name: DATAQTOOLS *
* Author .............: Soup Dog *
* Date Written .......: May 25, 2007 *
* Description ........: This service program contains *
* routines to make the handling of *
* data queues easier. *
* *
*****************************************************************
*----------------------------------------------------------------
* Variable declarations.
*----------------------------------------------------------------
D @@ErrorDS DS Qualified
D ByteProv 9B 0 INZ(0)
D BytesAval 9B 0 INZ(0)
D Msgid 7A INZ(*BLANKS)
D Filler 1A INZ(*BLANKS)
D MsgData 256A INZ(*BLANKS)
D SenderDS DS Qualified
D ByteProv 9B 0 INZ(0)
D BytesAval 9B 0 INZ(0)
D Job 10A INZ(*BLANKS)
D JobProfile 10A INZ(*BLANKS)
D JobNumber 6A INZ(*BLANKS)
D CurrentUser 10A INZ(*BLANKS)
* Program Status Data Structure.
D PSDS SDS QUALIFIED
D MsgId 40 46
D MsgData 91 170
* User Index Handling Fields
D DQ_Name DS
D DQ_NameSub 10 INZ(*BLANKS)
D DQ_LibrarySub 10 INZ('QTEMP ')
D DQ_Size S 5P 0 INZ(2000)
D DQ_Text S 50 INZ('Temporary Data Queue')
D DQ_KeyOrder S 2 INZ('EQ')
D DQ_KeyLen S 3P 0 INZ(0)
D DQ_KeyData S 1 INZ(' ')
D DQ_Wait S 5P 0 INZ(0)
D DQ_RcvLen S 5P 0 INZ(0)
D DQ_RmvMsg S 10 INZ('*YES')
D DQ_ReceiverLen S 5P 0 INZ(%SIZE(DataQ_Entry))
D DQ_Sender S LIKE(SenderDS)
D DQ_SenderLen S 3P 0 INZ(%SIZE(DQ_Sender))
D DataQ_Entry S 10000A
*----------------------------------------------------------------
* Procedure prototypes.
*----------------------------------------------------------------
/COPY QCPYSRC,MSGTOOLS
/COPY QCPYSRC,CMDTOOLS
/COPY QCPYSRC,DATAQTOOLS
*----------------------------------------------------------------
* CreateDataQ - Procedure definition for creating a data queue.
*----------------------------------------------------------------
P CreateDataQ B EXPORT
D CreateDataQ PI LIKE(@@ErrorDS )
D Name 10 CONST
D Library 10 OPTIONS(*NOPASS) CONST
D Size 5P 0 OPTIONS(*NOPASS) CONST
D Text 50 OPTIONS(*NOPASS) CONST
C IF %PARMS > 3
C EVAL DQ_Text = Text
C ENDIF
C IF %PARMS > 2
C EVAL DQ_Size = Size
C ENDIF
C IF %PARMS > 1
C EVAL DQ_LibrarySub = Library
C ENDIF
C EVAL DQ_NameSub = Name
C IF DQ_LibrarySub = '*LIBL'
C EVAL DQ_LibrarySub = 'QTEMP'
C ENDIF
/FREE
@@ErrorDS = RunCommand('CRTDTAQ DTAQ(' +
%TRIM(DQ_LibrarySub) + '/' +
%TRIM(DQ_NameSub) + ') MAXLEN(' +
%CHAR(DQ_Size) + ') FORCE(*YES) SEQ(*LIFO)' +
' SENDERID(*NO) AUTORCL(*YES) TEXT(' +
'''' + %TRIM(DQ_Text) + '''' + ')');
/END-FREE
C SELECT
C WHEN @@ErrorDS.MsgID = ' '
C WHEN @@ErrorDS.MsgID = 'CPF9870'
C CALLP ClearDataQ
C OTHER
C CALLP SendEscMsg(@@ErrorDS.MsgData)
C ENDSL
C RETURN @@ErrorDS
P E
*----------------------------------------------------------------
* DeleteDataQ - Procedure definition for deleting a data Queue.
*----------------------------------------------------------------
P DeleteDataQ B EXPORT
D DeleteDataQ PI LIKE(@@ErrorDS )
D Name 10 CONST OPTIONS(*NOPASS)
C IF %PARMS > 0
C EVAL DQ_NameSub = Name
C ENDIF
C EVAL DQ_LibrarySub = '*LIBL'
C RESET @@ErrorDS
/FREE
@@ErrorDS = RunCommand('DLTDTAQ DTAQ(' +
%TRIM(DQ_LibrarySub) + '/' +
%TRIM(DQ_NameSub) + ')');
/END-FREE
C IF @@ErrorDS.MsgID <> *BLANKS
C CALLP SendEscMsg(@@ErrorDS.MsgData)
C ENDIF
C RETURN @@ErrorDS
P E
*----------------------------------------------------------------
* ClearDataQ - Procedure definition for clearing a data queue.
*----------------------------------------------------------------
P ClearDataQ B EXPORT
D ClearDataQ PI LIKE(@@ErrorDS )
D Name 10 CONST OPTIONS(*NOPASS)
C RESET @@ErrorDS
C IF %PARMS > 0
C EVAL DQ_NameSub = Name
C ENDIF
C EVAL DQ_LibrarySub = '*LIBL'
C CALL 'QCLRDTAQ'
C PARM DQ_NameSub
C PARM DQ_LibrarySub
C PARM DQ_KeyOrder
C PARM DQ_KeyLen
C PARM DQ_KeyData
C PARM @@ErrorDS
C IF @@ErrorDS.MsgID <> *BLANKS
C CALLP SendEscMsg(@@ErrorDS.MsgData)
C ENDIF
C RETURN @@ErrorDS
P E
*----------------------------------------------------------------
* PushDataQ - Procedure definition for pushing a record onto
* the data queue
*----------------------------------------------------------------
P PushDataQ B EXPORT
D PushDataQ PI LIKE(@@ErrorDS)
D Data 10000 CONST
D Name 10 CONST OPTIONS(*NOPASS)
C RESET @@ErrorDS
C IF %PARMS > 1
C EVAL DQ_NameSub = Name
C ENDIF
C EVAL DQ_LibrarySub = '*LIBL'
C RESET @@ErrorDS
C MONITOR
C CALL 'QSNDDTAQ'
C PARM DQ_NameSub
C PARM DQ_LibrarySub
C PARM DQ_Size
C PARM Data DataQ_Entry
C ON-ERROR
C EVAL @@ErrorDS.MsgId = PSDS.MsgId
C EVAL @@ErrorDS.MsgData = PSDS.MsgData
C ENDMON
C IF @@ErrorDS.MsgID <> *BLANKS
C CALLP SendEscMsg(@@ErrorDS.MsgData)
C ENDIF
C RETURN @@ErrorDS
P E
*----------------------------------------------------------------
* PopDataQ - Procedure definition for popping a record off
* of the data queue.
*----------------------------------------------------------------
P PopDataQ B EXPORT
D PopDataQ PI 10000
D Name 10 CONST OPTIONS(*NOPASS)
D Wait 5P 0 CONST OPTIONS(*NOPASS)
C RESET @@ErrorDS
C IF %PARMS > 0
C EVAL DQ_NameSub = Name
C ENDIF
C EVAL DQ_LibrarySub = '*LIBL'
C IF %PARMS = 2
C EVAL DQ_Wait = Wait
C ELSE
C EVAL DQ_Wait = 0
C ENDIF
C CALL 'QRCVDTAQ'
C PARM DQ_NameSub
C PARM DQ_LibrarySub
C PARM DQ_RcvLen
C PARM DataQ_Entry
C PARM DQ_Wait
C PARM DQ_KeyOrder
C PARM DQ_KeyLen
C PARM DQ_KeyData
C PARM DQ_SenderLen
C PARM DQ_Sender
C PARM '*YES' DQ_RmvMsg
C PARM DQ_ReceiverLen
C PARM @@ErrorDS
C IF @@ErrorDS.MsgID <> *BLANKS
C CALLP SendEscMsg(@@ErrorDS.MsgData)
C ENDIF
C IF DQ_RcvLen = 0
C EVAL Dataq_Entry = *BLANKS
C ENDIF
C RETURN DataQ_Entry
P E
*----------------------------------------------------------------
* PeekDataQ - Procedure definition for searching for a record
* in the data queue.
*----------------------------------------------------------------
P PeekDataQ B EXPORT
D PeekDataQ PI 10000
D Name 10 CONST OPTIONS(*NOPASS)
D Wait 5P 0 CONST OPTIONS(*NOPASS)
C IF %PARMS > 0
C EVAL DQ_NameSub = Name
C ENDIF
C EVAL DQ_LibrarySub = '*LIBL'
C IF %PARMS > 1
C EVAL DQ_Wait = Wait
C ELSE
C EVAL DQ_Wait = 0
C ENDIF
C RESET @@ErrorDS
C CALL 'QRCVDTAQ'
C PARM DQ_NameSub
C PARM DQ_LibrarySub
C PARM DQ_RcvLen
C PARM DataQ_Entry
C PARM DQ_Wait
C PARM DQ_KeyOrder
C PARM DQ_KeyLen
C PARM DQ_KeyData
C PARM DQ_SenderLen
C PARM DQ_Sender
C PARM '*NO' DQ_RmvMsg
C PARM DQ_ReceiverLen
C PARM @@ErrorDS
C IF @@ErrorDS.MsgID <> *BLANKS
C CALLP SendEscMsg(@@ErrorDS.MsgData)
C ENDIF
C IF DQ_RcvLen = 0
C EVAL Dataq_Entry = *BLANKS
C ENDIF
C RETURN DataQ_Entry
P E
*----------------------------------------------------------------
* SetDataQ - Initialize the name of the data queue.
*----------------------------------------------------------------
P SetDataQ B EXPORT
D SetDataQ PI
D Name 10 CONST
D Library 10 CONST OPTIONS(*NOPASS)
c RESET @@ErrorDS
C IF %PARMS > 1
C EVAL DQ_LibrarySub = Library
C ENDIF
C EVAL DQ_NameSub = Name
C RETURN
P E
*----------------------------------------------------------------
* #ofEntries Procedure definition for returning the number of
* entries in the data queue.
*----------------------------------------------------------------
P #ofEntries B EXPORT
D #ofEntries PI 5S 0
D Name 10 CONST OPTIONS(*NOPASS)
D DQ_Buffer DS
D DQ_BytesRet 9B 0
D DQ_Bytes_Avl 9B 0
D DQ_MsgLen 9B 0
D DQ_KeyLen 9B 0
D DQ_Seq 1A
D DQ_IncludeSnd 1A
D DQ_ForceInd 1A
D DQ_Text 50A
D DQ_Type 1A
D DQ_Reclaim 1A
D DQ_Reserved 1A
D DQ_#ofEntries 9B 0
D DQ_#Alloc 9B 0
D DQ_NameUsed 10A
D DQ_LibUsed 10A
D DQ_Max#ofEntr 9B 0
D DQ_Init#ofEntr 9B 0
D DQ_BufferLen S 9B 0 INZ(%LEN(DQ_Buffer))
D DQ_Format S 8 INZ('RDQD0100')
C IF %PARMS > 0
C EVAL DQ_NameSub = Name
C ENDIF
C EVAL DQ_LibrarySub = '*LIBL'
C MONITOR
C CALL 'QMHQRDQD'
C PARM DQ_Buffer
C PARM DQ_BufferLen
C PARM DQ_Format
C PARM DQ_Name
C ON-ERROR
C RETURN -1
C ENDMON
C RETURN DQ_#ofEntries
P E
If you have any questions, just give me a shout.