000101021108 ******************************************************************************** 000102021108 * Program Name: WAITER * 000103021108 * * 000104021108 * Description: This program demonstrates the usage of a VARPG data server * 000105021108 * program. * 000106021108 * * 000107021108 * This program passes data to a data queue named REQUEST and * 000108021108 * retrieves the results from the RESPONSE data queue. * 000109021108 * The VARPG program DQServer processes the commands * 000110021108 * submitted via the REQUEST data queue, looks up records in * 000111021108 * an Access table and then places the results in the RESPONSE * 000112021108 * data queue. * 000113021108 * 000114021108 * Author: Raymond Everhart * 000115021108 * November 21,2002 Edition of Midrange Programmer Newsletter * 000116021108 * http://www.midrangeserver.com/mpo/mpoindex.html * 000117021108 * * 000118021108 * * 000119021108 ******************************************************************************** 000120021108 000121021108 000122021108 FWaiterFM CF E Workstn SFile(Record1:RRN) 000200021107 FITEMMST IF E K Disk 000300021107 000302021108 * System Data Structure 000303021108 D SDS 000304021108 D JOB_NAME 244 253 * Job name 000305021108 D USER_ID 254 263 * User name 000306021108 D JOB_NUM 264 269 * Job number 000307021108 000309021108 * Data Queue API Parameter Descriptions 000311021108 D DQName_In S 10 Inz('RESPONSE') 000312021108 D DQLibrary_In S 10 INZ('MPODQS') 000313021108 D DQLength_In S 5 0 Inz(%len(DQData_In)) 000314021108 D DQData_In S Like(DtaQDS) 000316021108 D DQWait_in S 5 0 Inz(2) 000321021108 000332021108 D DQName_Out S 10 Inz('REQUEST') 000333021108 D DQLibrary_Out S 10 INZ('MPODQS') 000334021108 D DQLength_Out S 5 0 Inz(%len(DQData_Out)) 000335021108 D DQData_Out S Like(DtaQDS) 000336021108 000337021108 D DQKey_Len S 3 0 Inz(%Len(DQKey)) 000338021108 D DQKeyOrder S 2 Inz('EQ') 000340021108 D DQSndrData S 1 000341021108 D DQSndrLen S 3 0 Inz(0) 000342021108 000343021108 000344021108 * Data Structure used to describe the information passed via the Data Queue 000345021108 D DTAQDS E DS 000346021108 D DQKey 35 Overlay(DtaQDS:1) 000347021108 000348021108 000349021108 * Data Structure used to describe the information passed via the Data Queue 000350021108 D RtnDataDS E DS 000351021108 000352021108 000353021108 * Standalone Field Definitions 000500021107 D Item S N 000502021108 D NextReqNum S 9S 0 000503021108 D Retries S 5 0 000504021108 D SvrActive S N 000505021108 D RRN S 5 0 Inz(0) 000600021108 000700021108 000701021108 * Constants 000704021108 D EOF C Const('EOF') 000705021108 D ERROR C Const('ERROR') 000706021108 D Exceeded C Const(10) 000707021108 D Invalid C Const('0') 000709021108 D OK C Const('OK') 000710021108 D Valid C Const('1') 000800021107 000801021108 C 000802021108 ************************ Main Logic ************************************ 000803021108 000804021108 * First Time Display of Screen 001100021107 C Exsr DisplaySFL 001200021107 001201021108 * Loop Until F3 is pressed 001300021107 C Dow *In03 = *Off 001301021108 001302021108 * Check for a valid Item 001303021108 C Exsr ClearSFL 001400021107 C Exsr CheckItem 001401021107 C If Item = Valid 001402021108 001403021108 * Check for an active server 001500021107 C Exsr CheckServer 001501021108 C If SvrActive 001502021108 001503021108 * Send Request for data to Server 001600021107 C Exsr RequestData 001601021108 001602021108 * Retrieve returned data from the Data Queue & Load Subfile 001700021107 C Exsr RetrieveData 001702021108 001703021108 * Display pop up window - No Active Server Found 001705021108 C Else 001706021108 C Exfmt NoServer 001708021108 C EndIf 001709021108 001710021108 * Display pop up window - Item not Valid 001711021107 C Else 001712021108 C Exfmt InvalidI 001714021107 C EndIf 001715021108 001716021108 * Display the Subfile 001800021107 C Exsr DisplaySFL 001900021107 C EndDo 002000021107 002100021107 C Eval *InLR = *On 002200021107 C Exsr ShutDown 002300021107 ************************************************************************** 002302021107 /Eject 002303021107 ************************************************************************** 002304021108 * Program Initialization 002305021108 * 002306021107 C *Inzsr Begsr 002307021108 002308021108 C Eval JobName = Job_Name 002309021108 C Eval UserID = User_ID 002310021108 C Eval JobNum = Job_Num 002311021108 002312021108 C Eval *In50 = *On 002313021108 C Eval *In51 = *Off 002322021108 002338021107 C Endsr 002400021107 ************************************************************************************ 002500021107 /Eject 002600021107 ************************************************************************************ 002601021108 * Check to see if this is a Valid Item 002602021108 * 002700021107 C CheckItem Begsr 002800021107 C 002900021107 C ItemNum Chain Itemmst 003000021107 C If Not %Found 003100021107 C Eval Item = Invalid 003200021107 C Else 003300021107 C Eval Item = Valid 003400021107 C EndIf 003500021107 C 003600021107 C EndSr 003700021107 ************************************************************************************ 003800021107 /Eject 003900021107 ************************************************************************************ 003901021108 * Check to see if the Data Queue Server is Responding to commands 003902021108 * 004000021107 C CheckServer Begsr 004100021108 004102021108 C Clear CmdData 004104021108 C Clear RtnCode 004105021108 C Clear RtnData 004106021108 C Eval Command = 'PING' 004110021107 C Exsr GetReqNumber 004111021108 C Eval DQData_Out = DtaQDS 004112021107 C 004113021107 C Exsr SendRequest 004114021108 C Reset Retries 004115021108 C Dou Retries = Exceeded 004116021108 C 004117021107 C Exsr GetResponse 004118021107 C 004119021108 C If RtnCode = 'ALIVE' 004120021107 C Eval SvrActive = *On 004121021108 C Leave 004122021107 C Else 004123021107 C Eval SvrActive = *Off 004124021108 C Eval Retries = Retries + 1 004125021107 C EndIf 004126021108 C EndDo 004200021107 C 004300021107 C EndSr 004400021107 ************************************************************************************ 004500021107 /Eject 004600021107 ************************************************************************************ 004601021108 * Clear the Subfile 004602021108 * 004700021107 C ClearSFL Begsr 004800021107 C 004900021107 C Eval *In50 = *Off 005000021107 C Eval *In51 = *Off 005100021108 C Write Record1CTL 005200021107 C Eval *In50 = *On 005300021107 C Reset RRN 005400021107 C 005500021107 C EndSr 005600021107 ************************************************************************************ 005700021107 /Eject 005800021107 ************************************************************************************ 005801021108 * Display the Subfile 005802021108 * 005900021107 C DisplaySFL Begsr 006000021107 006100021107 * Check for records to Display in Subfile 006200021107 C If RRN > 1 006300021107 C Eval *In51 = *On 006400021107 C Else 006500021107 C Eval *In51 = *Off 006600021107 C EndIf 006700021107 C 006800021107 C Write Footer 006900021107 C Exfmt Record1Ctl 007000021107 C 007100021107 C EndSr 007200021107 ************************************************************************************ 007300021107 /Eject 007400021107 ************************************************************************************ 007401021108 * Get the Servers Response from the Data Queue 007504021107 * 007506021107 C GetResponse Begsr 007507021107 C 007508021107 C Call 'QRCVDTAQ' 007510021108 C Parm DQName_In 007511021108 C Parm DQLibrary_In 007512021108 C Parm DQLength_In 007514021107 C Parm DQData_In 007516021108 C Parm DQWait_In 007518021108 C Parm DQKeyOrder 007519021108 C Parm DQKey_Len 007521021108 C Parm DQKey 007523021107 C Parm 0 DQSndrLen 007524021107 C Parm DQSndrData 007525021107 C 007526021108 C If DQLength_In > 0 007527021108 C Eval DtaQDS = DQData_In 007528021108 C EndIf 007529021107 C 007530021107 C EndSr 007531021107 ************************************************************************** 007532021107 /Eject 007533021107 ************************************************************************** 007534021108 * Determine The Next Request Number 007535021108 * 007536021107 C GetReqNumber Begsr 007537021108 007538021108 C Eval NextReqNum = NextReqNum + 1 007539021108 C Move NextReqNum RQNUM 007540021108 007541021107 C EndSr 007542021108 ************************************************************************** 007543021108 /Eject 007544021108 ************************************************************************** 007545021108 * Send a Request to the Server to look up records for an Item 007547021108 * 007548021108 C RequestData Begsr 007549021108 007550021108 C Exsr GetReqNumber 007551021108 C Clear RtnCode 007552021108 C Clear RtnData 007553021108 C Eval Command = 'GETDATA' 007554021108 C Eval CmdData = ITEMNUM 007555021108 C Exsr SendRequest 007556021108 007557021108 C EndSr 007558021108 ************************************************************************** 007559021108 /Eject 007560021108 ************************************************************************** 007561021108 * Retrive the responses from the Server and Load the Subfile 007562021108 * 007563021108 C RetrieveData Begsr 007564021108 007565021108 * Clear the Subfile 007566021108 C Exsr ClearSFL 007567021108 C Reset Retries 007568021108 007569021108 * Process All records from Data Queue 007570021108 C Dou RtnCode = 'EOF' 007571021108 C or RtnCode = 'ERROR' 007572021108 C Or Retries = Exceeded 007573021108 007574021108 * Read the Response from the Server 007575021108 C Exsr GetResponse 007576021108 007577021108 * Process the Servers Response 007578021108 C Select 007579021108 C When %Len(DQData_IN) < 1 007580021108 C Eval Retries = Retries + 1 007581021108 C 007582021108 C When RtnCode = EOF 007583021108 C RRN Chain Record1 007584021108 C If %Found 007585021108 C Eval *In88 = *On 007586021108 C Update Record1 007587021108 C Eval *In88 = *Off 007588021108 C EndIf 007589021108 C 007590021108 C When RtnCode = ERROR 007591021108 C Exfmt ServerErr 007592021108 C 007593021108 C When RtnCode = OK 007594021108 C Reset Retries 007595021108 C Eval RtnDataDS = RtnData 007596021108 C Eval RRN = RRN + 1 007597021108 C Write Record1 007598021108 C 007599021108 C EndSl 007600021108 C EndDo 007601021108 007602021108 * Control Display of Subfile 007603021108 C If RRN > 0 007604021108 C Eval *In51 = *On 007605021108 C Else 007606021108 C Eval *In51 = *Off 007607021108 C EndIf 007608021108 007609021108 C EndSr 007610021107 ************************************************************************** 007611021107 /Eject 007612021107 ************************************************************************** 007613021108 * Send a request to the Data Queue 007614021107 * 007615021107 C SendRequest Begsr 007616021107 C 007617021108 C Eval DQData_Out = DtaQDS 007618021107 C 007619021107 C Call 'QSNDDTAQ' 007620021108 C Parm DQName_Out 007621021108 C Parm DQLibrary_Out 007622021108 C Parm DQLength_Out 007623021107 C Parm DQData_Out 007624021107 * 007625021108 C EndSr 007626021108 ************************************************************************** 007627021108 /Eject 007628021108 ************************************************************************** 007629021108 * End the Data Queue Server on the PC 007630021108 * 007631021108 C ShutDown Begsr 007632021108 C 007633021108 C Exsr GetReqNumber 007634021108 C Clear CmdData 007635021108 C Eval Command = 'SHUTDOWN' 007636021108 C Exsr SendRequest 007637021107 C 007638021108 C EndSr 007639021108 **************************************************************************