Function SET193T: Transaction Interface Manager

LANSA

Function SET193T: Transaction Interface Manager
********** COMMENT(=======================================================);
********** COMMENT();
********** COMMENT(Process ........: SET_193);
********** COMMENT(Function .......: SET193T);
********** COMMENT(Created on .....: 11th October 2000);
********** COMMENT(Description ....: Transaction Interface Manager);
********** COMMENT(Version.........: 1);
********** COMMENT();
********** COMMENT(Full Description: This function manages and assembles);
********** COMMENT( transaction details being sent out to Windows NT);
********** COMMENT( or 2000 server systems.);
********** 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);
********** COMMENT(x);
********** COMMENT(Local Variable Definitions);
********** COMMENT(x);
DEFINE FIELD(#S_193RQN) REFFLD(#S_193DQN);
********** COMMENT(------------------------);
********** COMMENT(The primary storage list);
********** COMMENT(------------------------);
DEFINE FIELD(#W_193VNM) REFFLD(#S_193VNM);
DEFINE FIELD(#W_193VIN) REFFLD(#S_193VIN);
DEFINE FIELD(#W_193VTP) REFFLD(#S_193VTP);
DEFINE FIELD(#W_193VAV) REFFLD(#S_193VAV);
DEFINE FIELD(#W_193VSN) TYPE(*CHAR) LENGTH(001) TO_OVERLAY(#W_193VAV 001);
DEFINE FIELD(#W_193VNV) REFFLD(#S_193VNV) TO_OVERLAY(#W_193VAV 002);
DEF_LIST NAME(#S_193EXL) FIELDS((#W_193VNM)(#W_193VIN)(#W_193VTP)(#W_193VAV)) TYPE(*WORKING) ENTRYS(0000123);
********** COMMENT(-----------------------------------------------);
********** COMMENT(Handle various requests exchanged in by the);
********** COMMENT(caller in the #S_193GSR (Generic Short Request));
********** COMMENT(variable.);
********** COMMENT(-----------------------------------------------);
CASE OF_FIELD(#S_193GSR);
********** COMMENT(----------------------);
********** COMMENT(Handle a Reset request);
********** COMMENT(----------------------);
WHEN VALUE_IS('= I');
CLR_LIST NAMED(#S_193EXL);
********** COMMENT(Insert internal values into the list);
EXECUTE SUBROUTINE(ADD_ALPHA) WITH_PARMS('FUNCTION_193' 1 *BLANKS);
EXECUTE SUBROUTINE(ADD_ALPHA) WITH_PARMS('COMPONENT_193' 1 *BLANKS);
EXECUTE SUBROUTINE(ADD_ALPHA) WITH_PARMS('REPLYQUEUE_193' 1 *BLANKS);
********** COMMENT(--------------------------);
********** COMMENT(Handle a Put Alpha Request);
********** COMMENT(--------------------------);
WHEN VALUE_IS('= A');
EXECUTE SUBROUTINE(ADD_ALPHA) WITH_PARMS(#S_193VNM #S_193VIN #S_193VAV);
********** COMMENT(----------------------------);
********** COMMENT(Handle a Put Numeric Request);
********** COMMENT(----------------------------);
WHEN VALUE_IS('= B');
EXECUTE SUBROUTINE(ADD_NUMBER) WITH_PARMS(#S_193VNM #S_193VIN #S_193VNV);
********** COMMENT(--------------------------);
********** COMMENT(Handle a Get Alpha Request);
********** COMMENT(--------------------------);
WHEN VALUE_IS('= C');
EXECUTE SUBROUTINE(GET_ALPHA) WITH_PARMS(#S_193VNM #S_193VIN #S_193VAV);
EXCHANGE FIELDS(#S_193VAV #S_193GSR);
********** COMMENT(----------------------------);
********** COMMENT(Handle a Get Numeric Request);
********** COMMENT(----------------------------);
WHEN VALUE_IS('= D');
EXECUTE SUBROUTINE(GET_NUMBER) WITH_PARMS(#S_193VNM #S_193VIN #S_193VNV);
EXCHANGE FIELDS(#S_193VNV #S_193GSR);
********** COMMENT(---------------------);
********** COMMENT(Handle a Send request);
********** COMMENT(---------------------);
WHEN VALUE_IS('= S');
********** COMMENT(Allocate reply queue name (if required));
IF_NULL FIELD(#S_193RQN);
CALL PROCESS(*DIRECT) FUNCTION(SET193A);
CHANGE FIELD(#S_193RQN) TO(#S_193DQN);
ENDIF;
********** COMMENT(Update internal values into the list);
EXECUTE SUBROUTINE(ADD_ALPHA) WITH_PARMS('FUNCTION_193' 1 #S_193FUN);
EXECUTE SUBROUTINE(ADD_ALPHA) WITH_PARMS('COMPONENT_193' 1 #S_193COM);
EXECUTE SUBROUTINE(ADD_ALPHA) WITH_PARMS('REPLYQUEUE_193' 1 #S_193RQN);
********** COMMENT(Send the list to the data queue);
USE BUILTIN(TCONCAT) WITH_ARGS(SET193 #S_193SERV) TO_GET(#S_193DQN);
USE BUILTIN(SND_TO_DATA_QUEUE) WITH_ARGS(#S_193DQN 256 #S_193EXL);
********** COMMENT(------------------------);
********** COMMENT(Handle a receive request);
********** COMMENT(------------------------);
WHEN VALUE_IS('= R');
IF_NULL FIELD(#S_193RQN);
CALL PROCESS(*DIRECT) FUNCTION(SET193A);
CHANGE FIELD(#S_193RQN) TO(#S_193DQN);
ENDIF;
CLR_LIST NAMED(#S_193EXL);
DOUNTIL COND('#W_193VTP *NE M');
SELECTLIST NAMED(#S_193EXL);
CHANGE FIELD(#S_193MSG) TO(#W_193VAV);
MESSAGE MSGID(DCM9899) MSGF(DC@M01) MSGDTA(#S_193MSG);
ENDSELECT;
CLR_LIST NAMED(#S_193EXL);
USE BUILTIN(RCV_FROM_DATA_QUEUE) WITH_ARGS(#S_193RQN 256 #S_193MAXW) TO_GET(#S_193EXL);
CHANGE FIELD(#W_193VTP) TO(*NULL);
GET_ENTRY NUMBER(1) FROM_LIST(#S_193EXL);
ENDUNTIL;
********** COMMENT(-------------------------------);
********** COMMENT(Handle an end/terminate request);
********** COMMENT(-------------------------------);
WHEN VALUE_IS('= T');
********** COMMENT(Deallocate the assigned queue (if any));
IF COND('#S_193RQN *NE *BLANKS');
CHANGE FIELD(#S_193DQN) TO(#S_193RQN);
EXCHANGE FIELDS(#S_193DQN);
CALL PROCESS(*DIRECT) FUNCTION(SET193D);
CHANGE FIELD(#S_193RQN) TO(*NULL);
ENDIF;
********** COMMENT(------------------------);
********** COMMENT(Handle a list priming request');
********** COMMENT(------------------------);
WHEN VALUE_IS('= L');
CHANGE FIELD(#S_193GSR) TO(R);
EXCHANGE FIELDS(#S_193GSR);
CALL PROCESS(*DIRECT) FUNCTION(SET193L) PASS_LST(#S_193EXL );
********** COMMENT(------------------------);
********** COMMENT(Handle a list saving request');
********** COMMENT(------------------------);
WHEN VALUE_IS('= M');
CHANGE FIELD(#S_193GSR) TO(S);
EXCHANGE FIELDS(#S_193GSR);
CALL PROCESS(*DIRECT) FUNCTION(SET193L) PASS_LST(#S_193EXL );
********** COMMENT(----------------------);
********** COMMENT(Handle unknown request);
********** COMMENT(----------------------);
OTHERWISE;
ABORT MSGTXT('SET193T encountered an unknown request in #S_193GSR');
ENDCASE;
********** COMMENT(x);
********** COMMENT(Finished);
********** COMMENT();
RETURN;
********** COMMENT(=============================================);
********** COMMENT(Add_Alpha : Add a new alpha value to the list);
********** COMMENT(used as Add_alpha( <nam> <ins> <val> ));
********** COMMENT(where :);
********** COMMENT( <nam> is the variable name);
********** COMMENT( <ins> is the instance number);
********** COMMENT( <val> is the variable value);
********** COMMENT(=============================================);
SUBROUTINE NAME(ADD_ALPHA) PARMS((#P_193VNM *RECEIVED) (#P_193VIN *RECEIVED) (#P_193VAV *RECEIVED));
DEFINE FIELD(#P_193VNM) REFFLD(#S_193VNM);
DEFINE FIELD(#P_193VIN) REFFLD(#S_193VIN);
DEFINE FIELD(#P_193VAV) REFFLD(#S_193VAV);
********** COMMENT(Look for an entry with the same name);
********** COMMENT(and instance number);
SELECTLIST NAMED(#S_193EXL);
CONTINUE IF('#W_193VIN *NE #P_193VIN');
CONTINUE IF('#W_193VNM *NE #P_193VNM');
CHANGE FIELD(#W_193VAV) TO(#P_193VAV);
UPD_ENTRY IN_LIST(#S_193EXL);
RETURN;
ENDSELECT;
CHANGE FIELD(#W_193VNM) TO(#P_193VNM);
CHANGE FIELD(#W_193VIN) TO(#P_193VIN);
CHANGE FIELD(#W_193VTP) TO(A);
CHANGE FIELD(#W_193VAV) TO(#P_193VAV);
ADD_ENTRY TO_LIST(#S_193EXL);
ENDROUTINE;
********** COMMENT(================================================);
********** COMMENT(Add_Number : Add a new numeric value to the list);
********** COMMENT(used as Add_Number( <nam> <ins> <val> ));
********** COMMENT(where :);
********** COMMENT( <nam> is the variable name);
********** COMMENT( <ins> is the instance number);
********** COMMENT( <val> is the variable value);
********** COMMENT(================================================);
SUBROUTINE NAME(ADD_NUMBER) PARMS((#P_193VNM *RECEIVED) (#P_193VIN *RECEIVED) (#P_193VNV *RECEIVED));
DEFINE FIELD(#P_193VNV) REFFLD(#S_193VNV);
********** COMMENT(Look for an entry with the same name);
********** COMMENT(and instance number);
SELECTLIST NAMED(#S_193EXL);
CONTINUE IF('#W_193VIN *NE #P_193VIN');
CONTINUE IF('#W_193VNM *NE #P_193VNM');
CHANGE FIELD(#W_193VAV) TO(*NULL);
IF COND('#P_193VNV < 0');
CHANGE FIELD(#W_193VSN) TO(N);
CHANGE FIELD(#W_193VNV) TO('0 - #P_193VNV');
ELSE;
CHANGE FIELD(#W_193VSN) TO(P);
CHANGE FIELD(#W_193VNV) TO(#P_193VNV);
ENDIF;
UPD_ENTRY IN_LIST(#S_193EXL);
RETURN;
ENDSELECT;
CHANGE FIELD(#W_193VNM) TO(#P_193VNM);
CHANGE FIELD(#W_193VIN) TO(#P_193VIN);
CHANGE FIELD(#W_193VTP) TO(N);
CHANGE FIELD(#W_193VAV) TO(*NULL);
IF COND('#P_193VNV < 0');
CHANGE FIELD(#W_193VSN) TO(N);
CHANGE FIELD(#W_193VNV) TO('0 - #P_193VNV');
ELSE;
CHANGE FIELD(#W_193VSN) TO(P);
CHANGE FIELD(#W_193VNV) TO(#P_193VNV);
ENDIF;
ADD_ENTRY TO_LIST(#S_193EXL);
ENDROUTINE;
********** COMMENT(=============================================);
********** COMMENT(Get_Alpha : Get an alpha value from the list);
********** COMMENT(used as Get_Alpha( <nam> <ins> <val> ));
********** COMMENT(where :);
********** COMMENT( <nam> is the variable name);
********** COMMENT( <ins> is the instance number);
********** COMMENT( <val> is the variable value);
********** COMMENT(=============================================);
SUBROUTINE NAME(GET_ALPHA) PARMS((#P_193VNM *RECEIVED) (#P_193VIN *RECEIVED) (#P_193VAV));
********** COMMENT(Look for an entry with the same name);
********** COMMENT(and instance number);
CHANGE FIELD(#S_193GSR) TO(N);
SELECTLIST NAMED(#S_193EXL);
CONTINUE IF('#W_193VIN *NE #P_193VIN');
CONTINUE IF('#W_193VNM *NE #P_193VNM');
CHANGE FIELD(#S_193GSR) TO(Y);
CHANGE FIELD(#P_193VAV) TO(#W_193VAV);
RETURN;
ENDSELECT;
ENDROUTINE;
********** COMMENT(=============================================);
********** COMMENT(Get_Number : Get an numeric value from the list);
********** COMMENT(used as Get_Number( <nam> <ins> <val> ));
********** COMMENT(where :);
********** COMMENT( <nam> is the variable name);
********** COMMENT( <ins> is the instance number);
********** COMMENT( <val> is the variable value);
********** COMMENT(=============================================);
SUBROUTINE NAME(GET_NUMBER) PARMS((#P_193VNM *RECEIVED) (#P_193VIN *RECEIVED) (#P_193VNV));
********** COMMENT(Look for an entry with the same name);
********** COMMENT(and instance number);
CHANGE FIELD(#S_193GSR) TO(N);
SELECTLIST NAMED(#S_193EXL);
CONTINUE IF('#W_193VIN *NE #P_193VIN');
CONTINUE IF('#W_193VNM *NE #P_193VNM');
CHANGE FIELD(#S_193GSR) TO(Y);
IF COND('#W_193VSN = N');
CHANGE FIELD(#P_193VNV) TO('0 - #W_193VNV');
ELSE;
CHANGE FIELD(#P_193VNV) TO(#W_193VNV);
ENDIF;
RETURN;
ENDSELECT;
ENDROUTINE;