Function SET193A: Allocate Next Data Queue from Pool
********** COMMENT(=======================================================);
********** COMMENT();
********** COMMENT(Process ........: SET_193);
********** COMMENT(Function .......: SET193A);
********** COMMENT(Created on .....: 11th October 2000);
********** COMMENT(Description ....: Allocate next data queue from pool);
********** COMMENT(Version.........: 1);
********** COMMENT();
********** COMMENT(Full Description: This function allocates the next);
********** COMMENT( available data queue name from a pool.);
********** 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(*DIRECT *HEAVYUSAGE *MLOPTIMISE *NOMESSAGES);
********** COMMENT();
********** COMMENT(Local Definitions);
********** COMMENT();
DEFINE FIELD(#S_193DQQ) TYPE(*CHAR) LENGTH(021) DESC('Fully Qualified Data Queue Name');
DEFINE FIELD(#S_193DAV) TYPE(*CHAR) LENGTH(256) DESC('Data Area Value');
DEFINE FIELD(#SS) REFFLD(#STD_NUM) DESC('Array Index');
DEF_ARRAY NAME(#DAV) INDEXES(#SS) OVERLAYING(#S_193DAV) TYPE(*CHAR) TOT_ENTRY(0256) ENTRY_LEN(001);
DEFINE FIELD(#S_193DQX) LENGTH(004) DECIMALS(0) REFFLD(#DATE) EDIT_CODE(4) DEFAULT(0) TO_OVERLAY(#S_193DQN 007);
********** COMMENT();
********** COMMENT(Get data queue pool data area with a lock);
********** COMMENT();
USE BUILTIN(GET_CHAR_AREA) WITH_ARGS(#S_193DAN #S_193DAL Y) TO_GET(#S_193DAV);
********** COMMENT();
********** COMMENT(Loop through data area value looking for);
********** COMMENT(the first free data queue slot);
********** COMMENT();
BEGIN_LOOP USING(#SS) TO(256);
CASE OF_FIELD(#DAV#SS);
********** COMMENT(------------------------);
********** COMMENT(Handle already allocated);
********** COMMENT(------------------------);
WHEN VALUE_IS('= A');
CONTINUE;
********** COMMENT(-------------------------------);
********** COMMENT(Handle exists and not allocated);
********** COMMENT(-------------------------------);
WHEN VALUE_IS('= E');
********** COMMENT(Make the data queue name);
CHANGE FIELD(#S_193DQN) TO(SET193);
CHANGE FIELD(#S_193DQX) TO(#SS);
CHANGE FIELD(#S_193DQL) TO(*PARTDTALIB);
********** COMMENT(Clear the data queue);
CALL PGM(QCLRDTAQ) PARM(#S_193DQN #S_193DQL);
********** COMMENT(Update and release the pool data area);
CHANGE FIELD(#DAV#SS) TO(A);
USE BUILTIN(PUT_CHAR_AREA) WITH_ARGS(#S_193DAV #S_193DAN #S_193DAL Y);
********** COMMENT(Return the allocated queue name and library);
EXCHANGE FIELDS(#S_193DQN #S_193DQL);
RETURN;
********** COMMENT(---------------------);
********** COMMENT(Handle does not exist);
********** COMMENT(---------------------);
WHEN VALUE_IS('= *BLANKS');
********** COMMENT(Make the data queue name);
CHANGE FIELD(#S_193DQN) TO(SET193);
CHANGE FIELD(#S_193DQX) TO(#SS);
CHANGE FIELD(#S_193DQL) TO(*PARTDTALIB);
USE BUILTIN(TCONCAT) WITH_ARGS(#S_193DQL '/' #S_193DQN) TO_GET(#S_193DQQ);
********** COMMENT(Create the data queue);
EXEC_OS400 COMMAND('CRTDTAQ DTAQ(#S_193DQQ) MAXLEN(31488) AUT(*ALL)');
********** COMMENT(Update and release the pool data area);
CHANGE FIELD(#DAV#SS) TO(A);
USE BUILTIN(PUT_CHAR_AREA) WITH_ARGS(#S_193DAV #S_193DAN #S_193DAL Y);
********** COMMENT(Return the allocated queue name and library);
EXCHANGE FIELDS(#S_193DQN #S_193DQL);
RETURN;
********** COMMENT(-----------------------);
********** COMMENT(Handle unexpected value);
********** COMMENT(-----------------------);
OTHERWISE;
********** COMMENT(Release data area lock);
USE BUILTIN(PUT_CHAR_AREA) WITH_ARGS(#S_193DAV #S_193DAN #S_193DAL Y);
********** COMMENT(Abort with an error);
ABORT MSGTXT('SET193A encountered an unknown data area value');
ENDCASE;
END_LOOP;
********** COMMENT();
********** COMMENT(If we reach here release data area);
********** COMMENT(and abort with an error);
********** COMMENT();
USE BUILTIN(PUT_CHAR_AREA) WITH_ARGS(#S_193DAV #S_193DAN #S_193DAL Y);
ABORT MSGTXT('SET193A unable to allocate a free data queue name');
RETURN;
********** COMMENT(=======================================================);
********** COMMENT();
********** COMMENT(Process ........: SET_193);
********** COMMENT(Function .......: SET193A);
********** COMMENT(Created on .....: 11th October 2000);
********** COMMENT(Description ....: Allocate next data queue from pool);
********** COMMENT(Version.........: 1);
********** COMMENT();
********** COMMENT(Full Description: This function allocates the next);
********** COMMENT( available data queue name from a pool.);
********** 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(*DIRECT *HEAVYUSAGE *MLOPTIMISE *NOMESSAGES);
********** COMMENT();
********** COMMENT(Local Definitions);
********** COMMENT();
DEFINE FIELD(#S_193DQQ) TYPE(*CHAR) LENGTH(021) DESC('Fully Qualified Data Queue Name');
DEFINE FIELD(#S_193DAV) TYPE(*CHAR) LENGTH(256) DESC('Data Area Value');
DEFINE FIELD(#SS) REFFLD(#STD_NUM) DESC('Array Index');
DEF_ARRAY NAME(#DAV) INDEXES(#SS) OVERLAYING(#S_193DAV) TYPE(*CHAR) TOT_ENTRY(0256) ENTRY_LEN(001);
DEFINE FIELD(#S_193DQX) LENGTH(004) DECIMALS(0) REFFLD(#DATE) EDIT_CODE(4) DEFAULT(0) TO_OVERLAY(#S_193DQN 007);
********** COMMENT();
********** COMMENT(Get data queue pool data area with a lock);
********** COMMENT();
USE BUILTIN(GET_CHAR_AREA) WITH_ARGS(#S_193DAN #S_193DAL Y) TO_GET(#S_193DAV);
********** COMMENT();
********** COMMENT(Loop through data area value looking for);
********** COMMENT(the first free data queue slot);
********** COMMENT();
BEGIN_LOOP USING(#SS) TO(256);
CASE OF_FIELD(#DAV#SS);
********** COMMENT(------------------------);
********** COMMENT(Handle already allocated);
********** COMMENT(------------------------);
WHEN VALUE_IS('= A');
CONTINUE;
********** COMMENT(-------------------------------);
********** COMMENT(Handle exists and not allocated);
********** COMMENT(-------------------------------);
WHEN VALUE_IS('= E');
********** COMMENT(Make the data queue name);
CHANGE FIELD(#S_193DQN) TO(SET193);
CHANGE FIELD(#S_193DQX) TO(#SS);
CHANGE FIELD(#S_193DQL) TO(*PARTDTALIB);
********** COMMENT(Clear the data queue);
CALL PGM(QCLRDTAQ) PARM(#S_193DQN #S_193DQL);
********** COMMENT(Update and release the pool data area);
CHANGE FIELD(#DAV#SS) TO(A);
USE BUILTIN(PUT_CHAR_AREA) WITH_ARGS(#S_193DAV #S_193DAN #S_193DAL Y);
********** COMMENT(Return the allocated queue name and library);
EXCHANGE FIELDS(#S_193DQN #S_193DQL);
RETURN;
********** COMMENT(---------------------);
********** COMMENT(Handle does not exist);
********** COMMENT(---------------------);
WHEN VALUE_IS('= *BLANKS');
********** COMMENT(Make the data queue name);
CHANGE FIELD(#S_193DQN) TO(SET193);
CHANGE FIELD(#S_193DQX) TO(#SS);
CHANGE FIELD(#S_193DQL) TO(*PARTDTALIB);
USE BUILTIN(TCONCAT) WITH_ARGS(#S_193DQL '/' #S_193DQN) TO_GET(#S_193DQQ);
********** COMMENT(Create the data queue);
EXEC_OS400 COMMAND('CRTDTAQ DTAQ(#S_193DQQ) MAXLEN(31488) AUT(*ALL)');
********** COMMENT(Update and release the pool data area);
CHANGE FIELD(#DAV#SS) TO(A);
USE BUILTIN(PUT_CHAR_AREA) WITH_ARGS(#S_193DAV #S_193DAN #S_193DAL Y);
********** COMMENT(Return the allocated queue name and library);
EXCHANGE FIELDS(#S_193DQN #S_193DQL);
RETURN;
********** COMMENT(-----------------------);
********** COMMENT(Handle unexpected value);
********** COMMENT(-----------------------);
OTHERWISE;
********** COMMENT(Release data area lock);
USE BUILTIN(PUT_CHAR_AREA) WITH_ARGS(#S_193DAV #S_193DAN #S_193DAL Y);
********** COMMENT(Abort with an error);
ABORT MSGTXT('SET193A encountered an unknown data area value');
ENDCASE;
END_LOOP;
********** COMMENT();
********** COMMENT(If we reach here release data area);
********** COMMENT(and abort with an error);
********** COMMENT();
USE BUILTIN(PUT_CHAR_AREA) WITH_ARGS(#S_193DAV #S_193DAN #S_193DAL Y);
ABORT MSGTXT('SET193A unable to allocate a free data queue name');
RETURN;