RDML for SET211Q

LANSA

RDML for SET211Q
* =======================================================
* Process ........: SET_211
* Function .......: SET211Q
* Created on .....: 19/10/01 at 11:41:13
* Description ....: Function Skeleton
* Version.........: 1
*
* Full Description:
*
* This function is an interface to the NASDAQ stock
* price query service. It is invoked by the other
* functions in this process to use the Java Services
* Manager to access the NASDAQ service that provides
* information on certain stocks.
* In this example, we provide the stock symbols of 5
* well known NASDAQ stocks:
* IBM (IBM), Microsoft (MSFT), Sun Microsystems (SUNW),
* Apple Computers (AAPL) and Compaq (CPQ).
* These values are passed into this function as
* Name-Value pairs in the working list #NAsd_symb.
*
* Disclaimer: The following material is supplied as an
* example only. No warranty is expressed or implied.
*
* ======================================================*
Function Options(*DIRECT) Rcv_List(#NASD_SYMB #NASQUOTES)
*
* These fields are used to build the JSM commands. See
* subroutines START_CMD and KEYWRD
Define Field(#KEYWORD) Reffld(#STD_TEXT)
Define Field(#KEYW_VAL1) Reffld(#STD_TEXTL)
Define Field(#KEYW_VAL2) Reffld(#STD_TEXTL)
*
* working list #NAMEVALUE with Name-Value pairs
Def_List Name(#NAMEVALUE) Fields(#S_211NAME #S_211VALU) Type(*WORKING)
*
* Working list to receive the requested symbols from the
* user interface functions
Def_List Name(#NASD_SYMB) Fields(#S_211VALU) Type(*WORKING)
*
* Working list with NASDAQ Stock quotes for:
*
* #S_211ISSU - the issuer of the stock
* #S_211THIG - todays highest
* #S_211TLOW - todays lowest
* #S_211YHIG - 52 week high
* #S_211TLOW - 52 week low
* #S_211LAST - Last Sale
Def_List Name(#NASQUOTES) Fields(#S_211ISSU #S_211THIG #S_211TLOW #S_211YHIG #S_211YLOW #S_211LAST) Type(*WORKING)
*
Change Field(#S_JSMSTS #S_JSMMSG) To(*BLANKS)
*
* Load HTTPCLIENT service
Execute Subroutine(START_CMD) With_Parms('SERVICE_LOAD')
Execute Subroutine(KEYWRD) With_Parms('SERVICE' 'HTTPCLIENT' *BLANKS)
Use Builtin(JSM_COMMAND) With_Args(#S_JSMCMD) To_Get(#S_JSMSTS #S_JSMMSG)
Execute Subroutine(CHECK_STS)
*
* Format working list as required by Nasdaq
Execute Subroutine(FILLNAMVAL)
Clr_List Named(#NASQUOTES)
*
* Build the SEND command to post symbols to NASDAQ
*
* HANDLER(onvl) refers to the Outbound Name Value Handler
* Refer to the HTTPService.properties file that in the
* Properties directory of your JSM installation (for
* example /jsm/instance/properties/).
*
* HOST(QUOTES.NASDAQ.COM) is the NASDAQ machine
* hosting the service
* URI(/quote.dll) is the NASDAQ module that will receive
* and process the request
*
* SERVICE_LIST has the names of the fields that define
* the working list #NAMEVALUE.
Execute Subroutine(START_CMD) With_Parms('SEND')
Execute Subroutine(KEYWRD) With_Parms('HANDLER' 'onvl' *BLANKS)
Execute Subroutine(KEYWRD) With_Parms('HOST' 'QUOTES.NASDAQ.COM' *BLANKS)
Execute Subroutine(KEYWRD) With_Parms('URI' '/quote.dll' *BLANKS)
Execute Subroutine(KEYWRD) With_Parms('METHOD' '*GET' *BLANKS)
Execute Subroutine(KEYWRD) With_Parms('SERVICE_LIST' 'S_211NAME,S_211VALU' *BLANKS)
Use Builtin(JSM_COMMAND) With_Args(#S_JSMCMD) To_Get(#S_JSMSTS #S_JSMMSG #NAMEVALUE)
Execute Subroutine(CHECK_STS)
*
* Receive quotes in XML format and transform using
* style sheet.
*
* HANDLER(ixml) refers to the Inbound xml handler
* Refer to the HTTPService.properties file that in the
* Properties directory of your JSM installation (for
* example /jsm/instance/properties/).
*
* XSL(set211_nasdaq_quote) is a reference to the style
* sheet used to transform the XML received from NASDAQ.
* set211_nasdaq_quote is a symbolic name resolved in the
* HTTPService.properties file found in the Properties
* directory of your JSM installation:
* xsl.set211_nasdaq_quote=xsl/set211_receive-nasdaq.xsl
*
* SERVICE_LIST has the names of the fields that define
* the working list #NASQUOTES.
Execute Subroutine(START_CMD) With_Parms('RECEIVE')
Execute Subroutine(KEYWRD) With_Parms('HANDLER' 'IXML' *BLANKS)
Execute Subroutine(KEYWRD) With_Parms('XSL' 'set211_nasdaq_quote' *BLANKS)
Execute Subroutine(KEYWRD) With_Parms('SERVICE_LIST' 'S_211ISSU,S_211THIG,S_211TLOW,' 'S_211YHIG,S_211YLOW,S_211LAST')
Use Builtin(JSM_COMMAND) With_Args(#S_JSMCMD) To_Get(#S_JSMSTS #S_JSMMSG #NASQUOTES)
Execute Subroutine(CHECK_STS)
*
* Unload service
Execute Subroutine(START_CMD) With_Parms('SERVICE_UNLOAD')
Use Builtin(JSM_COMMAND) With_Args(#S_JSMCMD) To_Get(#S_JSMSTS #S_JSMMSG)
Execute Subroutine(CHECK_STS)
*
* Go through the list to detect whether any entries were
* returned as null (blank for alpha, zeros for numeric
* fields). If so, it means the symbol supplied was
* invalid.
Change Field(#LISTENTRY) To(0)
Selectlist Named(#NASQUOTES)
Change Field(#LISTENTRY) To('#LISTENTRY + 1')
If_Null Field(#S_211ISSU)
Get_Entry Number(#LISTENTRY) From_List(#NASD_SYMB)
Use Builtin(BCONCAT) With_Args('Invalid Code' #S_211VALU) To_Get(#S_211ISSU)
Upd_Entry In_List(#NASQUOTES)
Endif
Endselect
*
* Return to caller
Exchange Fields(#NASD_SYMB #NASQUOTES)
Return
*
* SUBROUTINES
*
Subroutine Name(START_CMD) Parms((#STD_TEXTS *RECEIVED))
Change Field(#S_JSMCMD) To(#STD_TEXTS)
Endroutine
*
Subroutine Name(KEYWRD) Parms(#KEYWORD #KEYW_VAL1 #KEYW_VAL2)
Use Builtin(BCONCAT) With_Args(#S_JSMCMD #KEYWORD) To_Get(#S_JSMCMD)
Use Builtin(TCONCAT) With_Args(#S_JSMCMD '(' #KEYW_VAL1 #KEYW_VAL2 ')') To_Get(#S_JSMCMD)
Endroutine
*
Subroutine Name(FILLNAMVAL)
Clr_List Named(#NAMEVALUE)
* NASDAQ requires the first two pairs to be these values
Execute Subroutine(ADD_NAMVAL) With_Parms('page' XML)
Execute Subroutine(ADD_NAMVAL) With_Parms('mode' STOCK)
* The rest of the list requires the word 'symbol' in the
* Name and the stock symbol in the value column
Selectlist Named(#NASD_SYMB)
* NASDAQ requires the NAME part of the Name-Value pair to
* be the literal 'symbol'. The value part is the symbol
* in the browselist.
Execute Subroutine(ADD_NAMVAL) With_Parms('symbol' #S_211VALU)
Endselect
Endroutine
*
Subroutine Name(ADD_NAMVAL) Parms((#S_211NAME *RECEIVED) (#S_211VALU *RECEIVED))
Add_Entry To_List(#NAMEVALUE)
Endroutine
*
* Check the status of the JSM command issued
Subroutine Name(CHECK_STS)
*
Define Field(#MSGDTA) Type(*CHAR) Length(132)
*
If Cond('#S_JSMSTS *NE OK')
*
Use Builtin(BCONCAT) With_Args('Error Status Code: ' #S_JSMSTS) To_Get(#MSGDTA)
Message Msgid(DCM9899) Msgf(DC@M01) Msgdta(#MSGDTA)
Use Builtin(BCONCAT) With_Args('Error Message: ' #S_JSMMSG) To_Get(#MSGDTA)
Message Msgid(DCM9899) Msgf(DC@M01) Msgdta(#MSGDTA)
Use Builtin(BCONCAT) With_Args(*FUNCTION 'ended in error. Review previous messages.') To_Get(#MSGDTA)
Message Msgid(DCM9899) Msgf(DC@M01) Msgdta(#MSGDTA)
Execute Subroutine(OP_CL_JSM) With_Parms(ABORT)
*
Endif
*
Endroutine
*
Subroutine Name(OP_CL_JSM) Parms((#W_ACTION *RECEIVED))
Define Field(#W_ACTION) Type(*CHAR) Length(005)
Group_By Name(#S_EXCHFLD) Fields(#S_JSMSTS #S_JSMMSG #W_ACTION)
Exchange Fields(#S_EXCHFLD)
Call Process(*DIRECT) Function(SETJSMO) Exit_Used(*NEXT) Menu_Used(*NEXT)
Endroutine
*