Form S_193FMF: Windows NT/2000 Service Manager
* ===================================================================;
*;
* Component : S_193FMF;
* Type : Form;
* Ancestor : PRIM_FORM;
* ;
* Description : Manages a Windows NT/2000 service;
*;
* Disclaimer : The following material is supplied as sample material ;
* only. No warranty concerning this material or its use ;
* in any way whatsoever is expressed or implied. ;
* ;
* ===================================================================;
;
FUNCTION OPTIONS(*DIRECT);
BEGIN_COM HEIGHT(183) LAYOUTMANAGER(#SPLM_1) LEFT(14) TOP(538) VISUALSTYLE(#VS_NORM) WIDTH(593);
DEFINE_COM CLASS(#PRIM_SPLM) NAME(#SPLM_1) ORIENTATION(Vertical);
DEFINE_COM CLASS(#PRIM_PANL) NAME(#PANL_1) DISPLAYPOSITION(1) HEIGHT(156) LAYOUTMANAGER(#ATLM_1) LEFT(0) PARENT(#COM_OWNER) TABPOSITION(1) TABSTOP(False) TOP(0) WIDTH(458);
DEFINE_COM CLASS(#PRIM_PANL) NAME(#PANL_2) DISPLAYPOSITION(2) HEIGHT(156) LAYOUTMANAGER(#FWLM_1) LEFT(462) PARENT(#COM_OWNER) TABPOSITION(2) TABSTOP(False) TOP(0) WIDTH(123);
DEFINE_COM CLASS(#PRIM_SPLI) NAME(#SPLI_1) MANAGE(#PANL_1) PARENT(#SPLM_1);
DEFINE_COM CLASS(#PRIM_SPLI) NAME(#SPLI_2) MANAGE(#PANL_2) PARENT(#SPLM_1) WEIGHT(1);
DEFINE_COM CLASS(#PRIM_ATLM) NAME(#ATLM_1) MARGINBOTTOM(2) MARGINLEFT(2) MARGINRIGHT(2) MARGINTOP(2);
DEFINE_COM CLASS(#PRIM_ATLI) NAME(#ATLI_1) ATTACHMENT(Center) MANAGE(#EVENTS) PARENT(#ATLM_1);
DEFINE_COM CLASS(#PRIM_FWLM) NAME(#FWLM_1) DIRECTION(TopToBottom) FLOWOPERATION(Center) FLOWOPERATIONHOR(Decrease) MARGINTOP(4);
DEFINE_COM CLASS(#PRIM_PANL) NAME(#DISCONNECT_PANEL) DISPLAYPOSITION(1) HEIGHT(54) LAYOUTMANAGER(#FWLM_2) LEFT(-53) PARENT(#PANL_2) TABPOSITION(1) TABSTOP(False) TOP(4) WIDTH(110);
DEFINE_COM CLASS(#PRIM_FWLI) NAME(#FWLI_1) MANAGE(#DISCONNECT_PANEL) PARENT(#FWLM_1);
DEFINE_COM CLASS(#PRIM_PANL) NAME(#CONNECT_PANEL) DISPLAYPOSITION(2) HEIGHT(60) LAYOUTMANAGER(#FWLM_3) LEFT(-53) PARENT(#PANL_2) TABPOSITION(2) TABSTOP(False) TOP(68) WIDTH(110);
DEFINE_COM CLASS(#PRIM_FWLI) NAME(#FWLI_2) MANAGE(#CONNECT_PANEL) PARENT(#FWLM_1);
DEFINE_COM CLASS(#PRIM_FWLM) NAME(#FWLM_2) DIRECTION(TopToBottom) FLOWOPERATION(Center) FLOWOPERATIONVER(Spread);
DEFINE_COM CLASS(#PRIM_FWLM) NAME(#FWLM_3) DIRECTION(TopToBottom) FLOWOPERATION(Center) FLOWOPERATIONVER(Spread);
DEFINE_COM CLASS(#PRIM_PHBN) NAME(#CONNECT_BTN) CAPTION('Connect to AS/400') DISPLAYPOSITION(2) LEFT(0) PARENT(#DISCONNECT_PANEL) TABPOSITION(2) TOP(29) WIDTH(110);
DEFINE_COM CLASS(#PRIM_FWLI) NAME(#FWLI_3) MANAGE(#CONNECT_BTN) PARENT(#FWLM_2);
DEFINE_COM CLASS(#PRIM_PHBN) NAME(#DISCONNECT_BTN) CAPTION('Disconnect AS/400') DISPLAYPOSITION(1) LEFT(0) PARENT(#CONNECT_PANEL) TABPOSITION(1) TOP(0) WIDTH(110);
DEFINE_COM CLASS(#PRIM_FWLI) NAME(#FWLI_4) MANAGE(#DISCONNECT_BTN) PARENT(#FWLM_3);
DEFINE_COM CLASS(#PRIM_PHBN) NAME(#HOLD_RELEASE_BTN) CAPTION('Hold Processing') DISPLAYPOSITION(2) HINT('Hold all processing. Click once and wait for message in event log.') LEFT(0) PARENT(#CONNECT_PANEL) TABPOSITION(2) TOP(35) WIDTH(110);
DEFINE_COM CLASS(#PRIM_FWLI) NAME(#FWLI_5) MANAGE(#HOLD_RELEASE_BTN) PARENT(#FWLM_3);
DEFINE_COM CLASS(#PRIM_PHBN) NAME(#MINIMIZE_BTN) CAPTION('Minimize') DISPLAYPOSITION(1) LEFT(0) PARENT(#ALWAYS_PANEL) TABPOSITION(1) TOP(1) WIDTH(110);
DEFINE_COM CLASS(#PRIM_FWLI) NAME(#FWLI_6) MANAGE(#MINIMIZE_BTN) PARENT(#FWLM_2);
DEFINE_COM CLASS(#PRIM_PANL) NAME(#ALWAYS_PANEL) DISPLAYPOSITION(3) HEIGHT(63) LAYOUTMANAGER(#FWLM_4) LEFT(67) PARENT(#PANL_2) TABPOSITION(3) TABSTOP(False) TOP(4) WIDTH(110);
DEFINE_COM CLASS(#PRIM_FWLI) NAME(#FWLI_7) MANAGE(#ALWAYS_PANEL) PARENT(#FWLM_1);
DEFINE_COM CLASS(#PRIM_FWLM) NAME(#FWLM_4) DIRECTION(TopToBottom) FLOWOPERATION(Center) FLOWOPERATIONVER(Spread);
DEFINE_COM CLASS(#PRIM_FWLI) NAME(#FWLI_8) MANAGE(#MINIMIZE_BTN) PARENT(#FWLM_4);
DEFINE_COM CLASS(#VL_SAM003) NAME(#AS400);
DEFINE_COM CLASS(#PRIM_TIMR) NAME(#TIMER) INTERVAL(0);
DEFINE_COM CLASS(#S_193SERV.Visual) NAME(#S_193SERV) CAPTION('Service Name') DISPLAYPOSITION(1) HEIGHT(19) HINT('Service name must always be exactly 4 characters of the English alphabet') LABELTYPE(Caption) MARGINLEFT(68) PARENT(#DISCONNECT_PANEL) TABPOSITION(1) WIDTH(107);
DEFINE_COM CLASS(#PRIM_FWLI) NAME(#FWLI_9) MANAGE(#S_193SERV) PARENT(#FWLM_2);
DEFINE_COM CLASS(#PRIM_PHBN) NAME(#CLEAR_MESSAGES_BTN) CAPTION('Clear Messages') DISPLAYPOSITION(2) LEFT(0) PARENT(#ALWAYS_PANEL) TABPOSITION(2) TOP(37) WIDTH(110);
DEFINE_COM CLASS(#PRIM_FWLI) NAME(#FWLI_10) MANAGE(#CLEAR_MESSAGES_BTN) PARENT(#FWLM_4);
DEFINE_COM CLASS(#PRIM_TAB) NAME(#TAB_1) DISPLAYPOSITION(1) HEIGHT(152) LEFT(2) PARENT(#PANL_1) TABPOSITION(1) TOP(2) WIDTH(454);
DEFINE_COM CLASS(#PRIM_ATLI) NAME(#ATLI_2) ATTACHMENT(Center) MANAGE(#TAB_1) PARENT(#ATLM_1);
DEFINE_COM CLASS(#PRIM_TBSH) NAME(#TBSH_1) CAPTION('Event Log') DISPLAYPOSITION(1) HEIGHT(126) LAYOUTMANAGER(#ATLM_2) LEFT(4) PARENT(#TAB_1) TABPOSITION(1) TABSTOP(False) TOP(22) WIDTH(446);
DEFINE_COM CLASS(#PRIM_TBSH) NAME(#TBSH_2) CAPTION('Using S_193FMF') DISPLAYPOSITION(2) HEIGHT(126) LAYOUTMANAGER(#ATLM_3) LEFT(4) PARENT(#TAB_1) TABPOSITION(2) TABSTOP(False) TOP(22) WIDTH(446);
DEFINE_COM CLASS(#PRIM_TBSH) NAME(#TBSH_3) CAPTION('Load Balancing') DISPLAYPOSITION(3) HEIGHT(126) LAYOUTMANAGER(#ATLM_4) LEFT(4) PARENT(#TAB_1) TABPOSITION(3) TABSTOP(False) TOP(22) WIDTH(446);
DEFINE_COM CLASS(#PRIM_TBSH) NAME(#TBSH_4) CAPTION('Directing and Prioriting Services') DISPLAYPOSITION(4) HEIGHT(126) LAYOUTMANAGER(#ATLM_5) LEFT(4) PARENT(#TAB_1) TABPOSITION(4) TABSTOP(False) TOP(22) WIDTH(446);
DEFINE_COM CLASS(#PRIM_ATLM) NAME(#ATLM_2);
DEFINE_COM CLASS(#PRIM_LTVW) NAME(#EVENTS) COLUMNHEADERS(False) DISPLAYPOSITION(1) HEIGHT(126) LEFT(0) PARENT(#TBSH_1) TABPOSITION(1) TOP(0) WIDTH(446);
DEFINE_COM CLASS(#PRIM_ATLI) NAME(#ATLI_3) ATTACHMENT(Center) MANAGE(#EVENTS) PARENT(#ATLM_2);
DEFINE_COM CLASS(#PRIM_LVCL) NAME(#LVCL_1) DISPLAYPOSITION(1) PARENT(#EVENTS) SOURCE(#SYSVAR$AV) WIDTH(100) WIDTHTYPE(Remainder);
DEFINE_COM CLASS(#PRIM_ATLM) NAME(#ATLM_3);
DEFINE_COM CLASS(#PRIM_ATLM) NAME(#ATLM_4);
DEFINE_COM CLASS(#PRIM_ATLM) NAME(#ATLM_5);
DEFINE_COM CLASS(#PRIM_LABL) NAME(#LABL_1) CAPTION('S_193FMF handles requests coming from applications running on an AS/400 server. It can process requests coming from multiple concurrent AS/400 sources (eg: 20 x 5250 based applications, 10 web transactions and 3 batch jobs all executing concurrently). You should start S_193FMF running, connect it to an AS/400 server and then leave it running until the Windows NT/2000 server system is shutdown. Normally you would leave S_193FMF running in a minimized state on the task bar. When interacting with S_193FMF you should allow 3 or 4 seconds for it to respond to your request. ') DISPLAYPOSITION(1) HEIGHT(126) LEFT(0) PARENT(#TBSH_2) TABPOSITION(1) TABSTOP(False) TOP(0) VISUALSTYLE(#S_193VYB) WIDTH(446);
DEFINE_COM CLASS(#PRIM_ATLI) NAME(#ATLI_4) ATTACHMENT(Center) MANAGE(#LABL_1) PARENT(#ATLM_3);
DEFINE_COM CLASS(#PRIM_LABL) NAME(#LABL_2) CAPTION('You can run multiple instances of S_193FMF to create a dynamic load balancing environment. If you started S_193FMF running on 3 separate Windows NT/2000 servers (say), all using the service name GENL, then requests coming from AS/400 based applications would be automatically load balanced across the 3 available Windows NT/2000 servers. The load balancing happens because an AS/400 request is passed to the first S_193FMF instance that is waiting for work. Likewise you could start 2 or 3 instances of S_193FMF on a single Windows NT/2000 server to better utilize the Windows NT/2000 resources you have available. ') DISPLAYPOSITION(1) HEIGHT(126) LEFT(0) PARENT(#TBSH_3) TABPOSITION(1) TABSTOP(False) TOP(0) VISUALSTYLE(#S_193VYB) WIDTH(446);
DEFINE_COM CLASS(#PRIM_ATLI) NAME(#ATLI_5) ATTACHMENT(Center) MANAGE(#LABL_2) PARENT(#ATLM_4);
DEFINE_COM CLASS(#PRIM_LABL) NAME(#LABL_3) CAPTION('S_193FMF provides services to AS/400 based applications. By default the service name GENL is used throughout example 193. By using different service names you can direct and prioritize service requests coming from AS/400 applications. For example, if you started S_193FMF on one Windows NT/2000 server providing a service named EFAX and another providing a service named EMAL on another server you could direct AS/400 fax and email service request to different NT/2000 servers. Similarly you could start 3 instances of S_193FMF on a single Windows NT/200 server providing services named PTY1, PTY2 and PTY3 to achieve different priorities for incoming AS/400 requests. ') DISPLAYPOSITION(1) HEIGHT(126) LEFT(0) PARENT(#TBSH_4) TABPOSITION(1) TABSTOP(False) TOP(0) VISUALSTYLE(#S_193VYB) WIDTH(446);
DEFINE_COM CLASS(#PRIM_ATLI) NAME(#ATLI_6) ATTACHMENT(Center) MANAGE(#LABL_3) PARENT(#ATLM_5);
;
*;
* Define the primary storage list);
*;
;
DEFINE FIELD(#W_193EXT) REFFLD(#STD_NUM) Desc('List #S_193EXL Entry Counter');
DEF_LIST NAME(#S_193EXL) FIELDS(#S_193VNM #s_193VIN #s_193VTP #s_193VAV) COUNTER(#W_193EXT) TYPE(*WORKING) ENTRYS(123);
DEFINE FIELD(#W_193MSC) REFFLD(#STD_NUM) Desc('List #S_193MSL Entry Counter');
DEF_LIST NAME(#S_193MSL) FIELDS(#S_193MSG) TYPE(*WORKING) ENTRYS(120) COUNTER(#W_193MSC);
;
*;
* Define local variables;
*;
;
Define #S_193ssn reffld(#std_Obj) Desc('AS/400 Symbolic Server Name');
Define #S_193RPQ RefFld(#S_193DQN) Desc('Reply Data Queue name');
;
* --------------------------;
* Handle form initialization;
* --------------------------;
;
EVTROUTINE handling(#com_owner.Initialize);
SET #com_owner caption(*component_desc);
Set #Connect_panel Visible(False);
Set #DisConnect_panel Visible(True);
;
Invoke #Com_Owner.LogEvent Type(Info) Message('Windows NT/200 service Manager Started.') ;
;
Change #S_193SERV GENL ;
;
Invoke #Com_Owner.LogEvent Type(Info) Message('Use the connect button to connect to an AS/400 system to commence servicing requests.') ;
;
ENDROUTINE;
;
* ----------------------------------------------------;
* Log the text details of an event into the event area;
* ----------------------------------------------------;
;
MthRoutine LogEvent;
;
Define_map *input #std_obj #Type mandatory('INFO');
Define_map *input #sysvar$av #Message mandatory(' ');
Define_map *input #sysvar$av #Message2 mandatory(' ');
Define_map *input #sysvar$av #Message3 mandatory(' ');
Define_map *input #sysvar$av #Message4 mandatory(' ');
Define_map *input #sysvar$av #Message5 mandatory(' ');
Define_map *input #sysvar$av #ClearMessages mandatory(FALSE);
;
Use Bconcat (#Message.value #Message2.value #Message3.value #Message4.value #Message5.value) (#SysVar$av);
;
If '(#Events.Entries > 100) or (#ClearMessages.Value = TRUE)';
Clr_List #Events;
Endif;
;
Add_Entry #Events;
;
Set #Events.CurrentItem EnsureVisible(True);
;
Invoke #events.UpdateDisplay;
;
EndRoutine;
;
* -------------------;
* Handle Form Closing;
* -------------------;
;
EVTROUTINE HANDLING(#Com_Owner.Closing);
Set #Timer Interval(0);
Invoke #as400.uDisconnect;
ENDROUTINE;
;
* ---------------------;
* Handle minmize button;
* ---------------------;
;
EVTROUTINE HANDLING(#MINIMIZE_BTN.Click);
Set #TbSH_1 Opened(True);
Invoke #Com_Owner.MinimizeForm;
ENDROUTINE;
;
* ---------------------;
* Handle Connect button;
* ---------------------;
;
EVTROUTINE HANDLING(#Connect_Btn.Click);
Set #TbSH_1 Opened(True);
Invoke #Com_Owner.LogEvent Type(Info) Message('AS/400 connection requested.') ;
Invoke #as400.uConnectModal;
ENDROUTINE;
;
* -----------------------------;
* Handle change to service name;
* -----------------------------;
;
EVTROUTINE HANDLING(#S_193SERV.Changed);
DEFINE FIELD(#T_193SERV) REFFLD(#S_193SERV);
DEFINE FIELD(#SS) REFFLD(#STD_NUM);
DEF_ARRAY NAME(#SRV) INDEXES(#SS) OVERLAYING(#T_193SERV) TYPE(*CHAR) TOT_ENTRY(4) ENTRY_LEN(1);
;
Change #T_193SERV #S_193SERV;
;
Begin_loop to(4) using(#ss);
Case #Srv#ss;
When ('= A' '= B' '= C' '= D' '= E' '= F' '= G');
When ('= H' '= I' '= J' '= K' '= L' '= M' '= N');
When ('= O' '= P' '= Q' '= R' '= S' '= T' '= U');
When ('= V' '= W' '= X' '= Y' '= Z');
Otherwise;
Set #Connect_Btn Enabled(False);
Return;
Endcase;
End_Loop;
;
Set #Connect_Btn Enabled(True);
;
ENDROUTINE;
;
* -----------------;
* Handle Disconnect;
* -----------------;
;
EVTROUTINE HANDLING(#DisConnect_Btn.Click);
Set #TbSH_1 Opened(True);
Invoke #Com_Owner.LogEvent Type(Info) Message('AS/400 connection being ended.') ;
Invoke #as400.uDisconnect;
ENDROUTINE;
;
* -------------------------;
* Handle connection created;
* -------------------------;
;
EVTROUTINE HANDLING(#AS400.uConnectionCreated);
Set #Connect_panel Visible(True);
Set #DisConnect_panel Visible(False) ;
Invoke #Com_Owner.LogEvent Type(Info) Message('AS/400 connection started.') ;
Invoke #Com_Owner.LogEvent Type(Info) Message('Service being provided is named') Message2(#S_193SERV) Message3('.');
Use BConcat ('Active' #S_193SERV 'Service Manager') (#SysVar$av);
Set #Com_Owner Caption(#SysVar$av) ;
Change #S_193ssn #AS400.uUsingSSN;
USE Disconnect_File ('*' #S_193SSN);
Set #Timer Interval(1);
ENDROUTINE;
;
* -----------------------;
* Handle connection ended;
* -----------------------;
;
EVTROUTINE HANDLING(#AS400.uConnectionDestroyed);
Set #TbSH_1 Opened(True);
Set #Timer Interval(0);
Set #Connect_panel Visible(False);
Set #DisConnect_panel Visible(True);
Invoke #Com_Owner.LogEvent Type(Info) Message('AS/400 connection ended.') ;
SET #com_owner caption(*component_desc);
ENDROUTINE;
;
* ----------------------------------;
* Handle the hold and release button ;
* ----------------------------------;
;
EVTROUTINE HANDLING(#HOLD_RELEASE_BTN.Click);
;
Set #TbSH_1 Opened(True);
;
If '#HOLD_RELEASE_BTN.Caption = ''Hold Processing''';
Set #Timer Interval(0);
Set #HOLD_RELEASE_BTN Caption('Release Processing') Hint('Release for processing. Click once and wait for message in event log.');
Invoke #Com_Owner.LogEvent Type(Info) Message('AS/400 processing now HELD.') ;
Else;
Set #HOLD_RELEASE_BTN Caption('Hold Processing') Hint('Hold all processing. Click once and wait for message in event log.') ;
Invoke #Com_Owner.LogEvent Type(Info) Message('AS/400 processing now RELEASED.') ;
Set #Timer Interval(1);
Endif;
;
ENDROUTINE;
;
* --------------------;
* Handle Clear Message;
* --------------------;
;
EVTROUTINE HANDLING(#CLEAR_MESSAGES_BTN.Click);
Set #TbSH_1 Opened(True);
Invoke #Com_Owner.LogEvent Type(Info) Message('Message log cleared.') ClearMessages(TRUE) ;
ENDROUTINE;
;
* ---------------------------------------------------------------------;
* Handle tick of the timer by looking for and handling inbound requests;
* ---------------------------------------------------------------------;
;
Evtroutine Handling(#timer.Tick);
;
* Kill the timer;
;
Set #Timer Interval(0);
;
* Wait 2 seconds for data to appear on the AS/400 data queue;
;
Change #S_193maxw 2;
;
Exchange (#S_193maxw #S_193serv);
;
Clr_List #s_193EXL;
Clr_List #S_193MSL;
Change #S_193GSR R;
Exchange #S_193GSR;
;
USE BUILTIN(CALL_SERVER_FUNCTION) WITH_ARGS(#S_193SSN SET193P Y Y #S_193EXL #S_193MSL) TO_GET(#S_RETCDA2);
;
* Handle an error;
;
If '#S_RETCDA2 *ne OK';
;
Invoke #Com_Owner.LogEvent Type(Severe) Message('Receive Call to remote server function SET193P failed.') ;
;
else;
;
* If something was returned in the list then we have work to do;
;
if '#W_193EXT > 0';
;
* Use SET193L to save the list details ;
;
Change #S_193GSR S;
Exchange #S_193GSR;
Call Process(*Direct) Function(SET193L) Pass_Lst(#S_193EXL) Exit_Used(*next) Menu_used(*Next);
;
* Now get SET193T to prime itself from the saved list;
;
Change #S_193GSR L ;
Exchange #S_193GSR;
Call Process(*Direct) Function(SET193T) Exit_Used(*next) Menu_used(*Next);
;
* Now look for the a function in list the details;
;
Execute First_Set;
;
Change #Function *Null ;
Execute Get_Alpha (FUNCTION_193 #Function) ;
Execute Get_Alpha (REPLYQUEUE_193 #S_193RPQ) ;
;
* If a function name is not present ;
;
IF_Null #Function;
;
Invoke #Com_Owner.LogEvent Type(Severe) Message('Function name not found in received data.') ;
;
Else;
;
* Log the event ;
;
Invoke #Com_Owner.LogEvent Type(Info) Message('Request for function') Message2(#Function) Message3('received from AS/400 system.') ;
;
* Otherwise call the function ;
;
Change #S_RETCDA2 ER;
;
Exchange #S_193ssn;
;
Call Process(*Direct) Function(#Function) Exit_Used(*next) Menu_used(*Next) If_Error(L10) ;
;
Change #S_RETCDA2 OK ;
;
* Handle an error ;
;
L10: If '#S_RETCDA2 *ne OK' ;
Invoke #Com_Owner.LogEvent Type(Severe) Message('Call to function') Message2(#Function) Message3('failed.') ;
endif;
;
* Get SET193T to save its current list;
;
Change #S_193GSR M ;
Exchange #S_193GSR;
Call Process(*Direct) Function(SET193T) Exit_Used(*next) Menu_used(*Next);
;
* Now used SET193L to restore the list back to this program;
;
Change #S_193GSR R;
Exchange #S_193GSR;
Call Process(*Direct) Function(SET193L) Pass_Lst(#S_193EXL) Exit_Used(*next) Menu_used(*Next);
;
* Built up a list of any message;
;
Clr_List #S_193MSL;
;
USE BUILTIN(GET_MESSAGE) WITH_ARGS(Y) TO_GET(#S_RETCDA2 #S_193MSG);
DoWhile '#S_RETCDA2 = OK';
Leave '#W_193MSC >= 120';
ADD_ENTRY TO_LIST(#S_193MSL);
USE BUILTIN(GET_MESSAGE) WITH_ARGS(Y) TO_GET(#S_RETCDA2 #S_193MSG);
ENDWHILE;
;
Use Clr_Messages;
;
* Now pass the lists to the RPC so that it can send it back to the requestor ;
;
Change #S_193GSR S;
Exchange (#S_193GSR #S_193RPQ);
;
USE BUILTIN(CALL_SERVER_FUNCTION) WITH_ARGS(#S_193SSN SET193P Y Y #S_193EXL #S_193MSL) TO_GET(#S_RETCDA2);
;
* Handle an error;
;
If '#S_RETCDA2 *ne OK';
Invoke #Com_Owner.LogEvent Type(Severe) Message('Send Call to remote server function SET193P failed.') ;
Endif;
;
Endif;
;
Endif;
;
Endif;
;
* Restart the timer ;
;
Set #Timer Interval(1);
;
EndRoutine;
;
* --------------------------------------------------------------------------;
* First_Set : Sets up for the processing the first set of variable instances;
* --------------------------------------------------------------------------;
;
SUBROUTINE NAME(FIRST_SET);
CHANGE FIELD(#S_193VIN) TO(1);
ENDROUTINE;
;
* ----------------------------------------------------------;
* Get_Alpha: Get the value of an alpha variable instance. ;
* Used as Get_Alpha ( <nam> <val> );
* where : <nam> is the variable's symbolic name;
* <val> is the variable's returned value;
* ----------------------------------------------------------;
;
SUBROUTINE NAME(GET_ALPHA) PARMS((#S_193VNM *RECEIVED) (#S_193VAV *RETURNED));
CHANGE FIELD(#S_193GSR) TO(C);
EXCHANGE FIELDS(#S_193GSR #S_193VNM #S_193VIN #S_193VAV);
CALL PROCESS(*DIRECT) FUNCTION(SET193T) Exit_Used(*next) Menu_Used(*Next);
ENDROUTINE;
;
END_COM;
* ===================================================================;
*;
* Component : S_193FMF;
* Type : Form;
* Ancestor : PRIM_FORM;
* ;
* Description : Manages a Windows NT/2000 service;
*;
* Disclaimer : The following material is supplied as sample material ;
* only. No warranty concerning this material or its use ;
* in any way whatsoever is expressed or implied. ;
* ;
* ===================================================================;
;
FUNCTION OPTIONS(*DIRECT);
BEGIN_COM HEIGHT(183) LAYOUTMANAGER(#SPLM_1) LEFT(14) TOP(538) VISUALSTYLE(#VS_NORM) WIDTH(593);
DEFINE_COM CLASS(#PRIM_SPLM) NAME(#SPLM_1) ORIENTATION(Vertical);
DEFINE_COM CLASS(#PRIM_PANL) NAME(#PANL_1) DISPLAYPOSITION(1) HEIGHT(156) LAYOUTMANAGER(#ATLM_1) LEFT(0) PARENT(#COM_OWNER) TABPOSITION(1) TABSTOP(False) TOP(0) WIDTH(458);
DEFINE_COM CLASS(#PRIM_PANL) NAME(#PANL_2) DISPLAYPOSITION(2) HEIGHT(156) LAYOUTMANAGER(#FWLM_1) LEFT(462) PARENT(#COM_OWNER) TABPOSITION(2) TABSTOP(False) TOP(0) WIDTH(123);
DEFINE_COM CLASS(#PRIM_SPLI) NAME(#SPLI_1) MANAGE(#PANL_1) PARENT(#SPLM_1);
DEFINE_COM CLASS(#PRIM_SPLI) NAME(#SPLI_2) MANAGE(#PANL_2) PARENT(#SPLM_1) WEIGHT(1);
DEFINE_COM CLASS(#PRIM_ATLM) NAME(#ATLM_1) MARGINBOTTOM(2) MARGINLEFT(2) MARGINRIGHT(2) MARGINTOP(2);
DEFINE_COM CLASS(#PRIM_ATLI) NAME(#ATLI_1) ATTACHMENT(Center) MANAGE(#EVENTS) PARENT(#ATLM_1);
DEFINE_COM CLASS(#PRIM_FWLM) NAME(#FWLM_1) DIRECTION(TopToBottom) FLOWOPERATION(Center) FLOWOPERATIONHOR(Decrease) MARGINTOP(4);
DEFINE_COM CLASS(#PRIM_PANL) NAME(#DISCONNECT_PANEL) DISPLAYPOSITION(1) HEIGHT(54) LAYOUTMANAGER(#FWLM_2) LEFT(-53) PARENT(#PANL_2) TABPOSITION(1) TABSTOP(False) TOP(4) WIDTH(110);
DEFINE_COM CLASS(#PRIM_FWLI) NAME(#FWLI_1) MANAGE(#DISCONNECT_PANEL) PARENT(#FWLM_1);
DEFINE_COM CLASS(#PRIM_PANL) NAME(#CONNECT_PANEL) DISPLAYPOSITION(2) HEIGHT(60) LAYOUTMANAGER(#FWLM_3) LEFT(-53) PARENT(#PANL_2) TABPOSITION(2) TABSTOP(False) TOP(68) WIDTH(110);
DEFINE_COM CLASS(#PRIM_FWLI) NAME(#FWLI_2) MANAGE(#CONNECT_PANEL) PARENT(#FWLM_1);
DEFINE_COM CLASS(#PRIM_FWLM) NAME(#FWLM_2) DIRECTION(TopToBottom) FLOWOPERATION(Center) FLOWOPERATIONVER(Spread);
DEFINE_COM CLASS(#PRIM_FWLM) NAME(#FWLM_3) DIRECTION(TopToBottom) FLOWOPERATION(Center) FLOWOPERATIONVER(Spread);
DEFINE_COM CLASS(#PRIM_PHBN) NAME(#CONNECT_BTN) CAPTION('Connect to AS/400') DISPLAYPOSITION(2) LEFT(0) PARENT(#DISCONNECT_PANEL) TABPOSITION(2) TOP(29) WIDTH(110);
DEFINE_COM CLASS(#PRIM_FWLI) NAME(#FWLI_3) MANAGE(#CONNECT_BTN) PARENT(#FWLM_2);
DEFINE_COM CLASS(#PRIM_PHBN) NAME(#DISCONNECT_BTN) CAPTION('Disconnect AS/400') DISPLAYPOSITION(1) LEFT(0) PARENT(#CONNECT_PANEL) TABPOSITION(1) TOP(0) WIDTH(110);
DEFINE_COM CLASS(#PRIM_FWLI) NAME(#FWLI_4) MANAGE(#DISCONNECT_BTN) PARENT(#FWLM_3);
DEFINE_COM CLASS(#PRIM_PHBN) NAME(#HOLD_RELEASE_BTN) CAPTION('Hold Processing') DISPLAYPOSITION(2) HINT('Hold all processing. Click once and wait for message in event log.') LEFT(0) PARENT(#CONNECT_PANEL) TABPOSITION(2) TOP(35) WIDTH(110);
DEFINE_COM CLASS(#PRIM_FWLI) NAME(#FWLI_5) MANAGE(#HOLD_RELEASE_BTN) PARENT(#FWLM_3);
DEFINE_COM CLASS(#PRIM_PHBN) NAME(#MINIMIZE_BTN) CAPTION('Minimize') DISPLAYPOSITION(1) LEFT(0) PARENT(#ALWAYS_PANEL) TABPOSITION(1) TOP(1) WIDTH(110);
DEFINE_COM CLASS(#PRIM_FWLI) NAME(#FWLI_6) MANAGE(#MINIMIZE_BTN) PARENT(#FWLM_2);
DEFINE_COM CLASS(#PRIM_PANL) NAME(#ALWAYS_PANEL) DISPLAYPOSITION(3) HEIGHT(63) LAYOUTMANAGER(#FWLM_4) LEFT(67) PARENT(#PANL_2) TABPOSITION(3) TABSTOP(False) TOP(4) WIDTH(110);
DEFINE_COM CLASS(#PRIM_FWLI) NAME(#FWLI_7) MANAGE(#ALWAYS_PANEL) PARENT(#FWLM_1);
DEFINE_COM CLASS(#PRIM_FWLM) NAME(#FWLM_4) DIRECTION(TopToBottom) FLOWOPERATION(Center) FLOWOPERATIONVER(Spread);
DEFINE_COM CLASS(#PRIM_FWLI) NAME(#FWLI_8) MANAGE(#MINIMIZE_BTN) PARENT(#FWLM_4);
DEFINE_COM CLASS(#VL_SAM003) NAME(#AS400);
DEFINE_COM CLASS(#PRIM_TIMR) NAME(#TIMER) INTERVAL(0);
DEFINE_COM CLASS(#S_193SERV.Visual) NAME(#S_193SERV) CAPTION('Service Name') DISPLAYPOSITION(1) HEIGHT(19) HINT('Service name must always be exactly 4 characters of the English alphabet') LABELTYPE(Caption) MARGINLEFT(68) PARENT(#DISCONNECT_PANEL) TABPOSITION(1) WIDTH(107);
DEFINE_COM CLASS(#PRIM_FWLI) NAME(#FWLI_9) MANAGE(#S_193SERV) PARENT(#FWLM_2);
DEFINE_COM CLASS(#PRIM_PHBN) NAME(#CLEAR_MESSAGES_BTN) CAPTION('Clear Messages') DISPLAYPOSITION(2) LEFT(0) PARENT(#ALWAYS_PANEL) TABPOSITION(2) TOP(37) WIDTH(110);
DEFINE_COM CLASS(#PRIM_FWLI) NAME(#FWLI_10) MANAGE(#CLEAR_MESSAGES_BTN) PARENT(#FWLM_4);
DEFINE_COM CLASS(#PRIM_TAB) NAME(#TAB_1) DISPLAYPOSITION(1) HEIGHT(152) LEFT(2) PARENT(#PANL_1) TABPOSITION(1) TOP(2) WIDTH(454);
DEFINE_COM CLASS(#PRIM_ATLI) NAME(#ATLI_2) ATTACHMENT(Center) MANAGE(#TAB_1) PARENT(#ATLM_1);
DEFINE_COM CLASS(#PRIM_TBSH) NAME(#TBSH_1) CAPTION('Event Log') DISPLAYPOSITION(1) HEIGHT(126) LAYOUTMANAGER(#ATLM_2) LEFT(4) PARENT(#TAB_1) TABPOSITION(1) TABSTOP(False) TOP(22) WIDTH(446);
DEFINE_COM CLASS(#PRIM_TBSH) NAME(#TBSH_2) CAPTION('Using S_193FMF') DISPLAYPOSITION(2) HEIGHT(126) LAYOUTMANAGER(#ATLM_3) LEFT(4) PARENT(#TAB_1) TABPOSITION(2) TABSTOP(False) TOP(22) WIDTH(446);
DEFINE_COM CLASS(#PRIM_TBSH) NAME(#TBSH_3) CAPTION('Load Balancing') DISPLAYPOSITION(3) HEIGHT(126) LAYOUTMANAGER(#ATLM_4) LEFT(4) PARENT(#TAB_1) TABPOSITION(3) TABSTOP(False) TOP(22) WIDTH(446);
DEFINE_COM CLASS(#PRIM_TBSH) NAME(#TBSH_4) CAPTION('Directing and Prioriting Services') DISPLAYPOSITION(4) HEIGHT(126) LAYOUTMANAGER(#ATLM_5) LEFT(4) PARENT(#TAB_1) TABPOSITION(4) TABSTOP(False) TOP(22) WIDTH(446);
DEFINE_COM CLASS(#PRIM_ATLM) NAME(#ATLM_2);
DEFINE_COM CLASS(#PRIM_LTVW) NAME(#EVENTS) COLUMNHEADERS(False) DISPLAYPOSITION(1) HEIGHT(126) LEFT(0) PARENT(#TBSH_1) TABPOSITION(1) TOP(0) WIDTH(446);
DEFINE_COM CLASS(#PRIM_ATLI) NAME(#ATLI_3) ATTACHMENT(Center) MANAGE(#EVENTS) PARENT(#ATLM_2);
DEFINE_COM CLASS(#PRIM_LVCL) NAME(#LVCL_1) DISPLAYPOSITION(1) PARENT(#EVENTS) SOURCE(#SYSVAR$AV) WIDTH(100) WIDTHTYPE(Remainder);
DEFINE_COM CLASS(#PRIM_ATLM) NAME(#ATLM_3);
DEFINE_COM CLASS(#PRIM_ATLM) NAME(#ATLM_4);
DEFINE_COM CLASS(#PRIM_ATLM) NAME(#ATLM_5);
DEFINE_COM CLASS(#PRIM_LABL) NAME(#LABL_1) CAPTION('S_193FMF handles requests coming from applications running on an AS/400 server. It can process requests coming from multiple concurrent AS/400 sources (eg: 20 x 5250 based applications, 10 web transactions and 3 batch jobs all executing concurrently). You should start S_193FMF running, connect it to an AS/400 server and then leave it running until the Windows NT/2000 server system is shutdown. Normally you would leave S_193FMF running in a minimized state on the task bar. When interacting with S_193FMF you should allow 3 or 4 seconds for it to respond to your request. ') DISPLAYPOSITION(1) HEIGHT(126) LEFT(0) PARENT(#TBSH_2) TABPOSITION(1) TABSTOP(False) TOP(0) VISUALSTYLE(#S_193VYB) WIDTH(446);
DEFINE_COM CLASS(#PRIM_ATLI) NAME(#ATLI_4) ATTACHMENT(Center) MANAGE(#LABL_1) PARENT(#ATLM_3);
DEFINE_COM CLASS(#PRIM_LABL) NAME(#LABL_2) CAPTION('You can run multiple instances of S_193FMF to create a dynamic load balancing environment. If you started S_193FMF running on 3 separate Windows NT/2000 servers (say), all using the service name GENL, then requests coming from AS/400 based applications would be automatically load balanced across the 3 available Windows NT/2000 servers. The load balancing happens because an AS/400 request is passed to the first S_193FMF instance that is waiting for work. Likewise you could start 2 or 3 instances of S_193FMF on a single Windows NT/2000 server to better utilize the Windows NT/2000 resources you have available. ') DISPLAYPOSITION(1) HEIGHT(126) LEFT(0) PARENT(#TBSH_3) TABPOSITION(1) TABSTOP(False) TOP(0) VISUALSTYLE(#S_193VYB) WIDTH(446);
DEFINE_COM CLASS(#PRIM_ATLI) NAME(#ATLI_5) ATTACHMENT(Center) MANAGE(#LABL_2) PARENT(#ATLM_4);
DEFINE_COM CLASS(#PRIM_LABL) NAME(#LABL_3) CAPTION('S_193FMF provides services to AS/400 based applications. By default the service name GENL is used throughout example 193. By using different service names you can direct and prioritize service requests coming from AS/400 applications. For example, if you started S_193FMF on one Windows NT/2000 server providing a service named EFAX and another providing a service named EMAL on another server you could direct AS/400 fax and email service request to different NT/2000 servers. Similarly you could start 3 instances of S_193FMF on a single Windows NT/200 server providing services named PTY1, PTY2 and PTY3 to achieve different priorities for incoming AS/400 requests. ') DISPLAYPOSITION(1) HEIGHT(126) LEFT(0) PARENT(#TBSH_4) TABPOSITION(1) TABSTOP(False) TOP(0) VISUALSTYLE(#S_193VYB) WIDTH(446);
DEFINE_COM CLASS(#PRIM_ATLI) NAME(#ATLI_6) ATTACHMENT(Center) MANAGE(#LABL_3) PARENT(#ATLM_5);
;
*;
* Define the primary storage list);
*;
;
DEFINE FIELD(#W_193EXT) REFFLD(#STD_NUM) Desc('List #S_193EXL Entry Counter');
DEF_LIST NAME(#S_193EXL) FIELDS(#S_193VNM #s_193VIN #s_193VTP #s_193VAV) COUNTER(#W_193EXT) TYPE(*WORKING) ENTRYS(123);
DEFINE FIELD(#W_193MSC) REFFLD(#STD_NUM) Desc('List #S_193MSL Entry Counter');
DEF_LIST NAME(#S_193MSL) FIELDS(#S_193MSG) TYPE(*WORKING) ENTRYS(120) COUNTER(#W_193MSC);
;
*;
* Define local variables;
*;
;
Define #S_193ssn reffld(#std_Obj) Desc('AS/400 Symbolic Server Name');
Define #S_193RPQ RefFld(#S_193DQN) Desc('Reply Data Queue name');
;
* --------------------------;
* Handle form initialization;
* --------------------------;
;
EVTROUTINE handling(#com_owner.Initialize);
SET #com_owner caption(*component_desc);
Set #Connect_panel Visible(False);
Set #DisConnect_panel Visible(True);
;
Invoke #Com_Owner.LogEvent Type(Info) Message('Windows NT/200 service Manager Started.') ;
;
Change #S_193SERV GENL ;
;
Invoke #Com_Owner.LogEvent Type(Info) Message('Use the connect button to connect to an AS/400 system to commence servicing requests.') ;
;
ENDROUTINE;
;
* ----------------------------------------------------;
* Log the text details of an event into the event area;
* ----------------------------------------------------;
;
MthRoutine LogEvent;
;
Define_map *input #std_obj #Type mandatory('INFO');
Define_map *input #sysvar$av #Message mandatory(' ');
Define_map *input #sysvar$av #Message2 mandatory(' ');
Define_map *input #sysvar$av #Message3 mandatory(' ');
Define_map *input #sysvar$av #Message4 mandatory(' ');
Define_map *input #sysvar$av #Message5 mandatory(' ');
Define_map *input #sysvar$av #ClearMessages mandatory(FALSE);
;
Use Bconcat (#Message.value #Message2.value #Message3.value #Message4.value #Message5.value) (#SysVar$av);
;
If '(#Events.Entries > 100) or (#ClearMessages.Value = TRUE)';
Clr_List #Events;
Endif;
;
Add_Entry #Events;
;
Set #Events.CurrentItem EnsureVisible(True);
;
Invoke #events.UpdateDisplay;
;
EndRoutine;
;
* -------------------;
* Handle Form Closing;
* -------------------;
;
EVTROUTINE HANDLING(#Com_Owner.Closing);
Set #Timer Interval(0);
Invoke #as400.uDisconnect;
ENDROUTINE;
;
* ---------------------;
* Handle minmize button;
* ---------------------;
;
EVTROUTINE HANDLING(#MINIMIZE_BTN.Click);
Set #TbSH_1 Opened(True);
Invoke #Com_Owner.MinimizeForm;
ENDROUTINE;
;
* ---------------------;
* Handle Connect button;
* ---------------------;
;
EVTROUTINE HANDLING(#Connect_Btn.Click);
Set #TbSH_1 Opened(True);
Invoke #Com_Owner.LogEvent Type(Info) Message('AS/400 connection requested.') ;
Invoke #as400.uConnectModal;
ENDROUTINE;
;
* -----------------------------;
* Handle change to service name;
* -----------------------------;
;
EVTROUTINE HANDLING(#S_193SERV.Changed);
DEFINE FIELD(#T_193SERV) REFFLD(#S_193SERV);
DEFINE FIELD(#SS) REFFLD(#STD_NUM);
DEF_ARRAY NAME(#SRV) INDEXES(#SS) OVERLAYING(#T_193SERV) TYPE(*CHAR) TOT_ENTRY(4) ENTRY_LEN(1);
;
Change #T_193SERV #S_193SERV;
;
Begin_loop to(4) using(#ss);
Case #Srv#ss;
When ('= A' '= B' '= C' '= D' '= E' '= F' '= G');
When ('= H' '= I' '= J' '= K' '= L' '= M' '= N');
When ('= O' '= P' '= Q' '= R' '= S' '= T' '= U');
When ('= V' '= W' '= X' '= Y' '= Z');
Otherwise;
Set #Connect_Btn Enabled(False);
Return;
Endcase;
End_Loop;
;
Set #Connect_Btn Enabled(True);
;
ENDROUTINE;
;
* -----------------;
* Handle Disconnect;
* -----------------;
;
EVTROUTINE HANDLING(#DisConnect_Btn.Click);
Set #TbSH_1 Opened(True);
Invoke #Com_Owner.LogEvent Type(Info) Message('AS/400 connection being ended.') ;
Invoke #as400.uDisconnect;
ENDROUTINE;
;
* -------------------------;
* Handle connection created;
* -------------------------;
;
EVTROUTINE HANDLING(#AS400.uConnectionCreated);
Set #Connect_panel Visible(True);
Set #DisConnect_panel Visible(False) ;
Invoke #Com_Owner.LogEvent Type(Info) Message('AS/400 connection started.') ;
Invoke #Com_Owner.LogEvent Type(Info) Message('Service being provided is named') Message2(#S_193SERV) Message3('.');
Use BConcat ('Active' #S_193SERV 'Service Manager') (#SysVar$av);
Set #Com_Owner Caption(#SysVar$av) ;
Change #S_193ssn #AS400.uUsingSSN;
USE Disconnect_File ('*' #S_193SSN);
Set #Timer Interval(1);
ENDROUTINE;
;
* -----------------------;
* Handle connection ended;
* -----------------------;
;
EVTROUTINE HANDLING(#AS400.uConnectionDestroyed);
Set #TbSH_1 Opened(True);
Set #Timer Interval(0);
Set #Connect_panel Visible(False);
Set #DisConnect_panel Visible(True);
Invoke #Com_Owner.LogEvent Type(Info) Message('AS/400 connection ended.') ;
SET #com_owner caption(*component_desc);
ENDROUTINE;
;
* ----------------------------------;
* Handle the hold and release button ;
* ----------------------------------;
;
EVTROUTINE HANDLING(#HOLD_RELEASE_BTN.Click);
;
Set #TbSH_1 Opened(True);
;
If '#HOLD_RELEASE_BTN.Caption = ''Hold Processing''';
Set #Timer Interval(0);
Set #HOLD_RELEASE_BTN Caption('Release Processing') Hint('Release for processing. Click once and wait for message in event log.');
Invoke #Com_Owner.LogEvent Type(Info) Message('AS/400 processing now HELD.') ;
Else;
Set #HOLD_RELEASE_BTN Caption('Hold Processing') Hint('Hold all processing. Click once and wait for message in event log.') ;
Invoke #Com_Owner.LogEvent Type(Info) Message('AS/400 processing now RELEASED.') ;
Set #Timer Interval(1);
Endif;
;
ENDROUTINE;
;
* --------------------;
* Handle Clear Message;
* --------------------;
;
EVTROUTINE HANDLING(#CLEAR_MESSAGES_BTN.Click);
Set #TbSH_1 Opened(True);
Invoke #Com_Owner.LogEvent Type(Info) Message('Message log cleared.') ClearMessages(TRUE) ;
ENDROUTINE;
;
* ---------------------------------------------------------------------;
* Handle tick of the timer by looking for and handling inbound requests;
* ---------------------------------------------------------------------;
;
Evtroutine Handling(#timer.Tick);
;
* Kill the timer;
;
Set #Timer Interval(0);
;
* Wait 2 seconds for data to appear on the AS/400 data queue;
;
Change #S_193maxw 2;
;
Exchange (#S_193maxw #S_193serv);
;
Clr_List #s_193EXL;
Clr_List #S_193MSL;
Change #S_193GSR R;
Exchange #S_193GSR;
;
USE BUILTIN(CALL_SERVER_FUNCTION) WITH_ARGS(#S_193SSN SET193P Y Y #S_193EXL #S_193MSL) TO_GET(#S_RETCDA2);
;
* Handle an error;
;
If '#S_RETCDA2 *ne OK';
;
Invoke #Com_Owner.LogEvent Type(Severe) Message('Receive Call to remote server function SET193P failed.') ;
;
else;
;
* If something was returned in the list then we have work to do;
;
if '#W_193EXT > 0';
;
* Use SET193L to save the list details ;
;
Change #S_193GSR S;
Exchange #S_193GSR;
Call Process(*Direct) Function(SET193L) Pass_Lst(#S_193EXL) Exit_Used(*next) Menu_used(*Next);
;
* Now get SET193T to prime itself from the saved list;
;
Change #S_193GSR L ;
Exchange #S_193GSR;
Call Process(*Direct) Function(SET193T) Exit_Used(*next) Menu_used(*Next);
;
* Now look for the a function in list the details;
;
Execute First_Set;
;
Change #Function *Null ;
Execute Get_Alpha (FUNCTION_193 #Function) ;
Execute Get_Alpha (REPLYQUEUE_193 #S_193RPQ) ;
;
* If a function name is not present ;
;
IF_Null #Function;
;
Invoke #Com_Owner.LogEvent Type(Severe) Message('Function name not found in received data.') ;
;
Else;
;
* Log the event ;
;
Invoke #Com_Owner.LogEvent Type(Info) Message('Request for function') Message2(#Function) Message3('received from AS/400 system.') ;
;
* Otherwise call the function ;
;
Change #S_RETCDA2 ER;
;
Exchange #S_193ssn;
;
Call Process(*Direct) Function(#Function) Exit_Used(*next) Menu_used(*Next) If_Error(L10) ;
;
Change #S_RETCDA2 OK ;
;
* Handle an error ;
;
L10: If '#S_RETCDA2 *ne OK' ;
Invoke #Com_Owner.LogEvent Type(Severe) Message('Call to function') Message2(#Function) Message3('failed.') ;
endif;
;
* Get SET193T to save its current list;
;
Change #S_193GSR M ;
Exchange #S_193GSR;
Call Process(*Direct) Function(SET193T) Exit_Used(*next) Menu_used(*Next);
;
* Now used SET193L to restore the list back to this program;
;
Change #S_193GSR R;
Exchange #S_193GSR;
Call Process(*Direct) Function(SET193L) Pass_Lst(#S_193EXL) Exit_Used(*next) Menu_used(*Next);
;
* Built up a list of any message;
;
Clr_List #S_193MSL;
;
USE BUILTIN(GET_MESSAGE) WITH_ARGS(Y) TO_GET(#S_RETCDA2 #S_193MSG);
DoWhile '#S_RETCDA2 = OK';
Leave '#W_193MSC >= 120';
ADD_ENTRY TO_LIST(#S_193MSL);
USE BUILTIN(GET_MESSAGE) WITH_ARGS(Y) TO_GET(#S_RETCDA2 #S_193MSG);
ENDWHILE;
;
Use Clr_Messages;
;
* Now pass the lists to the RPC so that it can send it back to the requestor ;
;
Change #S_193GSR S;
Exchange (#S_193GSR #S_193RPQ);
;
USE BUILTIN(CALL_SERVER_FUNCTION) WITH_ARGS(#S_193SSN SET193P Y Y #S_193EXL #S_193MSL) TO_GET(#S_RETCDA2);
;
* Handle an error;
;
If '#S_RETCDA2 *ne OK';
Invoke #Com_Owner.LogEvent Type(Severe) Message('Send Call to remote server function SET193P failed.') ;
Endif;
;
Endif;
;
Endif;
;
Endif;
;
* Restart the timer ;
;
Set #Timer Interval(1);
;
EndRoutine;
;
* --------------------------------------------------------------------------;
* First_Set : Sets up for the processing the first set of variable instances;
* --------------------------------------------------------------------------;
;
SUBROUTINE NAME(FIRST_SET);
CHANGE FIELD(#S_193VIN) TO(1);
ENDROUTINE;
;
* ----------------------------------------------------------;
* Get_Alpha: Get the value of an alpha variable instance. ;
* Used as Get_Alpha ( <nam> <val> );
* where : <nam> is the variable's symbolic name;
* <val> is the variable's returned value;
* ----------------------------------------------------------;
;
SUBROUTINE NAME(GET_ALPHA) PARMS((#S_193VNM *RECEIVED) (#S_193VAV *RETURNED));
CHANGE FIELD(#S_193GSR) TO(C);
EXCHANGE FIELDS(#S_193GSR #S_193VNM #S_193VIN #S_193VAV);
CALL PROCESS(*DIRECT) FUNCTION(SET193T) Exit_Used(*next) Menu_Used(*Next);
ENDROUTINE;
;
END_COM;