Function SET193P: Data Queue Polling RPC

LANSA

Function SET193P: Data Queue Polling RPC
********** COMMENT(=======================================================);
********** COMMENT();
********** COMMENT(Process ........: SET_193);
********** COMMENT(Function .......: SET193P);
********** COMMENT(Created on .....: 12th October 2000);
********** COMMENT(Description ....: Data Queue Polling Manager);
********** COMMENT(Version.........: 1);
********** COMMENT();
********** COMMENT(Full Description: This function is used as remote);
********** COMMENT( procedure by form S_193FMF to look for data on);
********** COMMENT( a data queue.);
********** COMMENT();
********** COMMENT(Disclaimer: The following material is supplied as);
********** COMMENT( example material only. No warranty concerning the);
********** COMMENT( material or its use in any way whatsoever is);
********** COMMENT( expressed or implied.);
********** COMMENT();
********** COMMENT(Minimum Release of LANSA Required : 8.0);
********** COMMENT();
********** COMMENT(=======================================================);
FUNCTION OPTIONS(*HEAVYUSAGE *DIRECT) RCV_LIST(#S_193EXL #S_193MSL );
********** COMMENT();
********** COMMENT(Define the lists used);
********** COMMENT();
DEF_LIST NAME(#S_193EXL) FIELDS((#S_193VNM)(#S_193VIN)(#S_193VTP)(#S_193VAV)) TYPE(*WORKING) ENTRYS(0000123);
DEF_LIST NAME(#S_193MSL) FIELDS(#S_193MSG) TYPE(*WORKING) ENTRYS(0000120);
DEFINE FIELD(#S_193WRC) REFFLD(#STD_NUM) DESC('S_193WRK Entry counter');
DEF_LIST NAME(#S_193WRK) FIELDS((#S_193VNM)(#S_193VIN)(#S_193VTP)(#S_193VAV)) COUNTER(#S_193WRC) TYPE(*WORKING) ENTRYS(0000123);
********** COMMENT();
********** COMMENT(Define local variables);
********** COMMENT();
DEFINE FIELD(#RENTRY) TYPE(*CHAR) LENGTH(001) DESC('Re Entry Flag') DEFAULT(N);
DEFINE FIELD(#S_193DQQ) TYPE(*CHAR) LENGTH(021) DESC('Fully Qualified Data Queue Name');
DEFINE FIELD(#S_193RPQ) REFFLD(#S_193DQN) DESC('Reply Data Queue name');
********** COMMENT();
********** COMMENT(Make up the data queue name and library);
********** COMMENT();
USE BUILTIN(TCONCAT) WITH_ARGS(SET193 #S_193SERV) TO_GET(#S_193DQN);
********** COMMENT();
********** COMMENT(On the first call, create the queue);
********** COMMENT();
IF COND('#RENTRY *NE Y');
CHANGE FIELD(#RENTRY) TO(Y);
USE BUILTIN(TCONCAT) WITH_ARGS(*PARTDTALIB '/' #S_193DQN) TO_GET(#S_193DQQ);
EXEC_OS400 COMMAND('CRTDTAQ DTAQ(#S_193DQQ) MAXLEN(31488) AUT(*ALL)') IF_ERROR(*NEXT);
USE BUILTIN(CLR_MESSAGES);
ENDIF;
********** COMMENT();
********** COMMENT(If requested wait on the queue for the specified time);
********** COMMENT();
CASE OF_FIELD(#S_193GSR);
********** COMMENT(------------------------);
********** COMMENT(Handle a receive request);
********** COMMENT(------------------------);
WHEN VALUE_IS('= R');
CLR_LIST NAMED(#S_193EXL);
CLR_LIST NAMED(#S_193MSL);
USE BUILTIN(RCV_FROM_DATA_QUEUE) WITH_ARGS(#S_193DQN 256 #S_193MAXW) TO_GET(#S_193EXL);
********** COMMENT(---------------------);
********** COMMENT(Handle a send request);
********** COMMENT(---------------------);
WHEN VALUE_IS('= S');
********** COMMENT(If any messages exist send them first);
CLR_LIST NAMED(#S_193WRK);
SELECTLIST NAMED(#S_193MSL);
CHANGE FIELD(#S_193VNM) TO(MESSAGE_);
CHANGE FIELD(#S_193VTP) TO(M);
CHANGE FIELD(#S_193VAV) TO(#S_193MSG);
ADD_ENTRY TO_LIST(#S_193WRK);
ENDSELECT;
IF COND('#S_193WRC > 0');
USE BUILTIN(SND_TO_DATA_QUEUE) WITH_ARGS(#S_193RPQ 256 #S_193WRK);
ENDIF;
********** COMMENT(Now send the variables (if any exist));
USE BUILTIN(SND_TO_DATA_QUEUE) WITH_ARGS(#S_193RPQ 256 #S_193EXL);
********** COMMENT(Clear both lists to minimize return comms traffic);
CLR_LIST NAMED(#S_193EXL);
CLR_LIST NAMED(#S_193MSL);
********** COMMENT(handle an invalid request);
OTHERWISE;
ABORT MSGTXT('Unknown request received by SET193P');
ENDCASE;
********** COMMENT();
********** COMMENT(Finished);
********** COMMENT();
RETURN;