RE: How to scan an entire array all at once (Corrected source) -- RPG400-L

Hi Michael,

Unfortunately the routines for getting and putting the messages are all embedded in other inherited code within the Advantage Plex (client server code generator that used to be Synon Obsydian) generated application that is already in Production.

My function will be called by other functions that are all being called further down the call stack from the GET and PUT unfortunately.

So your method, albeit a great one, is not possible for this release of the project we are working on. Perhaps I can persuade management to rethink the overall solution at a later date.

thanks again
Marilyn

From: "Rooney, Michael P" <michael.p.rooney@xxxxxxxxxxxxx>
Reply-To: RPG programming on the AS400 / iSeries <rpg400-l@xxxxxxxxxxxx>
To: "RPG programming on the AS400 / iSeries" <rpg400-l@xxxxxxxxxxxx>
Subject: RE: How to scan an entire array all at once (Corrected source)
Date: Mon, 3 May 2004 11:02:42 -0400
Marilyn,
In cutting & pasting previous post, I inadvertantly omitted some source
statements.  The following is the corrected source:
Regards,
Michael Rooney
Citigroup International
H ********************************************************************* * Bind with service program LIBMQM in library QMQM and * service program QC2IO in QSYS library. * * Compile using: * * CRTRPGMOD MODULE(MQSample) * CRTPGM PGM(MQSample) BNDSRVPGM(QMQM/LIBMQM QSYS/QC2IO) * ********************************************************************* DMQSample PR * DMQCC_FAILED C CONST(2) D* Message Identifier DMQMI_NONE C CONST(X'00000000000000000000- D 0000000000000000000000000000- D ') D* D* Correlation Identifier DMQCI_NONE C CONST(X'00000000000000000000- D 0000000000000000000000000000- D ') D* Open Options DMQOO_... DINPUT_AS_Q_DEF C CONST(1) DMQOO_BROWSE C CONST(8) D* Object Types DMQOT_Q C CONST(1) DMQRC_NO_MSG_... DAVAILABLE C CONST(2033) * D/COPY QMQM/QRPGLESRC,CMQG DMQGMO DS D/COPY QMQM/QRPGLESRC,CMQGMOG DMQMD DS D/COPY QMQM/QRPGLESRC,CMQMDG DMQOD DS D/COPY QMQM/QRPGLESRC,CMQODG * DMQSample PI * * Dprintf PR EXTPROC('printf') D * value options(*string) * Queue Manager Name DQMgrName S 48A inz(*blank) * Connection handle DHconn S 10I 0 * Completion code DCompCode S 10I 0 * Reason code qualifying CompCode DReason S 10I 0 * Options that control the action of MQOPEN DOptions S 10I 0 * Object handle for inquirying MQ Manager DHobj S 10I 0 * Length of the message DBufferLength S 10I 0 * Length of the message DDataLength S 10I 0 * Selector Count for MQINQ DReplyptr S * * C EVAL QMgrName = ' ' * C MONITOR * C CALLP MQCONN(QMgrName:Hconn:CompCode:Reason) * C ON-ERROR C callp printf('Error loading MQSeries Prod'+ C 'uct.....program terminating.' + C x'15') C move *on *inlr C return C ENDMON * C if CompCode = MQCC_FAILED * C callp printf('Program failed to connect to'+ C ' Queue Manager('+%trimr(QMgrName)+').' + C ' Reason Code is '+%char(Reason)+'.'+ C x'15') * C callp printf('Program is terminating.' + C x'15') * C move *on *inlr C return C endif * * Set Open Options to Input & Browse * C EVAL Options = (MQOO_BROWSE + MQOO_INPUT_AS_Q_DEF) /* Get the queue name */ C EVAL ODON = 'EXCELLER.LATAM.LISTEN' * C EVAL ODOT = MQOT_Q * C CALLP MQOPEN(Hconn:MQOD:Options:Hobj:CompCode: C Reason) C CompCode IFEQ MQCC_FAILED C callp printf('Program failed to open queue '+ C %trimr(ODON) +'.' + ' Reason Code is '+ C %char(Reason)+'.'+ C 'Program is terminating.' + C x'15') * C move *on *inlr C return C endif ******************************************************************** * Prepare to Get Messages from Queue * ******************************************************************** * * Define Message Buffer Length * C EVAL BufferLength = 10000 C eval Replyptr = %alloc(BufferLength) * C GetNxtMsg tag * * (re)Set Get Message Options to Accept Truncated Message, Fail if Quiescing & Browse * C EVAL GMOPT = (64 + 8192 + 32 + 16384) * * Initialize Message and Correlation Id (may have been modified by MQPUT). * C EVAL MDMID = MQMI_NONE C EVAL MDCID = MQCI_NONE * * Execute MQGET in Browse Mode * C CALLP MQGET(Hconn:Hobj:MQMD:MQGMO: C BufferLength:Replyptr: C DataLength:CompCode: C REASON) * C CompCode IFEQ MQCC_FAILED C if REASON = MQRC_NO_MSG_AVAILABLE C callp printf('Program completed!' + C x'15') * C else C callp printf('MQGET failed! '+ C 'Reason Code is '+ C C %char(Reason)+'.'+ C 'Program is terminating.' + C x'15') * C endif * C dealloc Replyptr C move *on *inlr C return * C endif * C callp printf(%trimr(%str(Replyptr)) + C x'15') * C goto GetNxtMsg
_______________________________________________
This is the RPG programming on the AS400 / iSeries (RPG400-L) mailing list
To post a message email: RPG400-L@xxxxxxxxxxxx
To subscribe, unsubscribe, or change list options,
visit: http://lists.midrange.com/mailman/listinfo/rpg400-l
or email: RPG400-L-request@xxxxxxxxxxxx
Before posting, please take a moment to review the archives
at http://archive.midrange.com/rpg400-l.

_________________________________________________________________ MSN Premium with Virus Guard and Firewall* from McAfee® Security : 2 months FREE* http://join.msn.com/?pgmarket=en-ca&page=byoa/prem&xAPID=1994&DI=1034&SU=http://hotmail.com/enca&HL=Market_MSNIS_Taglines