RDML for SET211B

LANSA

RDML for SET211B
* =======================================================
* Process ........: SET_211
* Function .......: SET211B
* Created on .....: 19/10/01 at 11:41:13
* Description ....: Function Skeleton
* Version.........: 1
*
* Full Description:
*
* This function runs in batch to produce a very simple
* report with the NASDAQ stock quotes.
* Working lists cannot be EXCHANGEd between interactive
* and batch programs. SET211S submits this function and
* previously uses the SAVE_LIST bif to save the NAMEVALUE
* working list. This function restores it and calls the
* SET211Q to get the stock quotes from the NASDAQ web
* service.
*
* Disclaimer: The following material is supplied as an
* example only. No warranty is expressed or implied.
*
* ======================================================*
Function Options(*DIRECT)
* Field to send text of generic message DCM9899
Define Field(#MSGDTA) Type(*CHAR) Length(132)
* Store saved list name
Define Field(#LISTNAME) Type(*CHAR) Length(010)
*
* Print line for title
Def_Head Name(#TITLE_LIN) Fields((#STD_TEXTL *NOID))
*
* Print line with stock values
Def_Line Name(#QUOTE_LIN) Fields(#S_211VALU #S_211ISSU #S_211THIG #S_211TLOW #S_211YHIG #S_211YLOW #S_211LAST)
*
* Working list to pass the symbols to NASDAQ interface
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)
*
* Open JSM
Use Builtin(JSM_OPEN) To_Get(#S_JSMSTS #S_JSMMSG)
Execute Subroutine(CHECK_STS)
*
Clr_List Named(#NASQUOTES)
*
* Restore list saved by SET211S
Use Builtin(RESTORE_SAVED_LIST) With_Args(#LISTNAME) To_Get(#NASD_SYMB #S_RETCDA2)
*
If Cond('#S_RETCDA2 = OK')
Message Msgtxt('Symbols list restored successfully.')
* Invoke the Nasdaq inquiry SET211Q
Call Process(*DIRECT) Function(SET211Q) Exit_Used(*NEXT) Menu_Used(*NEXT) Pass_Lst(#NASD_SYMB #NASQUOTES)
Else
Use Builtin(BCONCAT) With_Args('Problem restoring saved_list' #LISTNAME) To_Get(#MSGDTA)
Execute Subroutine(CLOSE_JSM)
Abort Msgid(DCM9899) Msgf(DC@M01) Msgdta(#MSGDTA)
Endif
*
* Print break
Change Field(#STD_TEXTL) To('RESULT FROM NASDAQ STOCK INQUIRY SERVICE')
Print
*
* 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)
* Must get the Stock symbol from received NASD_SYMB list
* because the symbol is not passed in #NASQUOTES
Change Field(#LISTENTRY) To('#LISTENTRY + 1')
Get_Entry Number(#LISTENTRY) From_List(#NASD_SYMB)
If_Null Field(#S_211ISSU)
Use Builtin(BCONCAT) With_Args('Invalid Code' #S_211VALU) To_Get(#S_211ISSU)
Endif
*
Print Line(#QUOTE_LIN)
Endselect
*
Endprint
* Delete the saved list
Use Builtin(DELETE_SAVED_LIST) With_Args(#LISTNAME)
*
* Close service
Execute Subroutine(CLOSE_JSM)
*
Return
*
Subroutine Name(CLOSE_JSM)
Use Builtin(JSM_CLOSE) To_Get(#S_JSMSTS #S_JSMMSG)
Execute Subroutine(CHECK_STS)
Endroutine
* Check the status of the JSM command issued
Subroutine Name(CHECK_STS)
*
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)
Use Builtin(JSM_CLOSE) To_Get(#S_JSMSTS #S_JSMMSG)
Abort Msgid(DCM9899) Msgf(DC@M01) Msgdta(#MSGDTA)
*
Endif
*
Endroutine
*