SET208H

LANSA

SET208H
* =======================================================
* Process ........: SET_208
* Function .......: SET208H
* Created on .....: 4/10/01 at 14:53:37
* Description ....: Act as a RPC for S_208FMF
*
* This function is called as a remote procedure by
* S_208FMF and passed up to 5 lists of extracted
* document values. The values have been extracted
* from MS-Word orMS-Excel documents and are being
* presented to the this application for processing.
*
* This function returns to S_208FMF a list of messages
* and spool file (ie: report) data. The returned material
* is what S_208FMF sends as a response to the original
* email sender.
*
* Disclaimer: The following material is supplied as
* sample material only. No warranty concerning the
* material or its use in any way whatsoever is
* expressed or implied.
*
* =======================================================
*
* Function definition as an RPC receiving up to 5 lists
*
FUNCTION OPTIONS(*DIRECT *HEAVYUSAGE) RCV_LIST(#LIST01 #LIST02 #LIST03 #LIST04 #LIST05 #MESSAGES #SPOOL01 #SPOOL02 #SPOOL03 #SPOOL04)
*
* Lists that have been passed by and returned to S_208FMF
*
DEF_LIST NAME(#LIST01) FIELDS(#S_208NAME #S_208INST #S_208AVAL #S_208NVAL) TYPE(*WORKING) ENTRYS(0000100)
DEF_LIST NAME(#LIST02) FIELDS(#S_208NAME #S_208INST #S_208AVAL #S_208NVAL) TYPE(*WORKING) ENTRYS(0000100)
DEF_LIST NAME(#LIST03) FIELDS(#S_208NAME #S_208INST #S_208AVAL #S_208NVAL) TYPE(*WORKING) ENTRYS(0000100)
DEF_LIST NAME(#LIST04) FIELDS(#S_208NAME #S_208INST #S_208AVAL #S_208NVAL) TYPE(*WORKING) ENTRYS(0000100)
DEF_LIST NAME(#LIST05) FIELDS(#S_208NAME #S_208INST #S_208AVAL #S_208NVAL) TYPE(*WORKING) ENTRYS(0000100)
DEFINE FIELD(#MESSCOUNT) REFFLD(#LISTCOUNT)
DEF_LIST NAME(#MESSAGES) FIELDS(#S_208MSG) COUNTER(#MESSCOUNT) TYPE(*WORKING) ENTRYS(200)
DEFINE FIELD(#SPOOLTOT) REFFLD(#LISTCOUNT)
DEF_LIST NAME(#SPOOL01) FIELDS(#S_208MSG) TYPE(*WORKING) ENTRYS(240)
DEF_LIST NAME(#SPOOL02) FIELDS(#S_208MSG) TYPE(*WORKING) ENTRYS(240)
DEF_LIST NAME(#SPOOL03) FIELDS(#S_208MSG) TYPE(*WORKING) ENTRYS(240)
DEF_LIST NAME(#SPOOL04) FIELDS(#S_208MSG) TYPE(*WORKING) ENTRYS(240)
*
* Define other local variables
*
DEFINE FIELD(#RETCODE) TYPE(*CHAR) LENGTH(002)
*
* Ask function SET208L to clear the current list
*
EXECUTE SUBROUTINE(SET208L) WITH_PARMS(CLEAR)
*
* Now add details of all the new list entries
* to the master list maintained by SET208L
*
SELECTLIST NAMED(#LIST01)
EXECUTE SUBROUTINE(SET208L) WITH_PARMS(ADD)
ENDSELECT
CLR_LIST NAMED(#LIST01)
*
SELECTLIST NAMED(#LIST02)
EXECUTE SUBROUTINE(SET208L) WITH_PARMS(ADD)
ENDSELECT
CLR_LIST NAMED(#LIST02)
*
SELECTLIST NAMED(#LIST03)
EXECUTE SUBROUTINE(SET208L) WITH_PARMS(ADD)
ENDSELECT
CLR_LIST NAMED(#LIST03)
*
SELECTLIST NAMED(#LIST04)
EXECUTE SUBROUTINE(SET208L) WITH_PARMS(ADD)
ENDSELECT
CLR_LIST NAMED(#LIST04)
*
SELECTLIST NAMED(#LIST05)
EXECUTE SUBROUTINE(SET208L) WITH_PARMS(ADD)
ENDSELECT
CLR_LIST NAMED(#LIST05)
*
* Clear the reply message list
*
CLR_LIST NAMED(#MESSAGES)
*
* And also clear the returned spool file details
*
CHANGE FIELD(#SPOOLTOT) TO(0)
CLR_LIST NAMED(#SPOOL01)
CLR_LIST NAMED(#SPOOL02)
CLR_LIST NAMED(#SPOOL03)
CLR_LIST NAMED(#SPOOL04)
*
* Now using the standard lookup routines look for a
* variable named RDML_FUNCTION that is used to
* identify the function to be called. Get the answer
* back in #Function
*
CHANGE FIELD(#FUNCTION) TO(UNKNOWN)
EXECUTE SUBROUTINE(LOC_ALPHA) WITH_PARMS('RDML_FUNCTION' 1 #FUNCTION)
USE BUILTIN(UPPERCASE) WITH_ARGS(#FUNCTION) TO_GET(#FUNCTION)
*
* Set the returned spool file name to blanks
*
CHANGE FIELD(#S_208SPLF) TO(*BLANKS)
*
* Now call the specified function to handle this document
*
CALL PROCESS(*DIRECT) FUNCTION(#FUNCTION) EXIT_USED(*NEXT) MENU_USED(*NEXT) IF_ERROR(*NEXT)
*
* Now collect all messages to send back to the caller
*
EXECUTE SUBROUTINE(GETMESSAGE)
*
* Now handle any returned spool file details as well
*
EXECUTE SUBROUTINE(SENDSPOOL)
*
* Now collect final messages to send back to the caller
*
EXECUTE SUBROUTINE(GETMESSAGE)
*
* Finished, so return control to S_208FMF running on
* a Windows NT/2000 server system.
*
RETURN
* =====================================================
* Subroutine SET208L
* =====================================================
SUBROUTINE NAME(SET208L) PARMS((#S_208OPER *RECEIVED))
EXCHANGE FIELDS(#S_208OPER #S_208NAME #S_208INST #S_208AVAL #S_208NVAL)
CALL PROCESS(*DIRECT) FUNCTION(SET208L)
ENDROUTINE
* =====================================================
* Subroutine Locate
* =====================================================
SUBROUTINE NAME(LOC_ALPHA) PARMS((#S_208NAME *RECEIVED) (#S_208INST *RECEIVED) #S_208AVAL)
EXECUTE SUBROUTINE(SET208L) WITH_PARMS(LOCATE)
ENDROUTINE
* =====================================================
* Subroutine GetMessage
* =====================================================
SUBROUTINE NAME(GETMESSAGE)
USE BUILTIN(GET_MESSAGE) TO_GET(#RETCODE #S_208MSG)
DOWHILE COND('(#MessCount < 200) and (#RetCode = OK)')
ADD_ENTRY TO_LIST(#MESSAGES)
USE BUILTIN(GET_MESSAGE) TO_GET(#RETCODE #S_208MSG)
ENDWHILE
USE BUILTIN(CLR_MESSAGES)
ENDROUTINE
* =====================================================
* Subroutine SendSpool
* =====================================================
SUBROUTINE NAME(SENDSPOOL)
*
* If a spool file name has been specified
*
IF COND('#S_208SPLF *ne *Blanks')
*
* Create the holding file SPOOLDTA in QTEMP
*
EXEC_OS400 COMMAND('CRTPF QTEMP/SPOOLDTA RCDLEN(132) AUT(*ALL)') IF_ERROR(*NEXT)
USE BUILTIN(CLR_MESSAGES)
*
* Copy the spool file
*
EXEC_OS400 COMMAND('CPYSPLF FILE(#S_208SPLF) TOFILE(QTEMP/SPOOLDTA) SPLNBR(*LAST)') IF_ERROR(*RETURN)
*
* Now read the spool file data and add to returned
* spool file details
*
USE BUILTIN(ACCESS_FILE) WITH_ARGS(OPEN SPOOLDTA QTEMP) TO_GET(#RETCODE)
USE BUILTIN(ACCESS_FILE) WITH_ARGS(READ SPOOLDTA QTEMP) TO_GET(#RETCODE #S_208MSG)
DOWHILE COND('#RETCODE = OK')
CASE OF_FIELD(#SPOOLTOT)
WHEN VALUE_IS('< 240')
ADD_ENTRY TO_LIST(#SPOOL01)
WHEN VALUE_IS('< 480')
ADD_ENTRY TO_LIST(#SPOOL02)
WHEN VALUE_IS('< 720')
ADD_ENTRY TO_LIST(#SPOOL03)
WHEN VALUE_IS('< 960')
ADD_ENTRY TO_LIST(#SPOOL04)
ENDCASE
CHANGE FIELD(#SPOOLTOT) TO('#SPOOLTOT + 1')
USE BUILTIN(ACCESS_FILE) WITH_ARGS(READ SPOOLDTA QTEMP) TO_GET(#RETCODE #S_208MSG)
ENDWHILE
USE BUILTIN(ACCESS_FILE) WITH_ARGS(CLOSE SPOOLDTA QTEMP) TO_GET(#RETCODE)
*
* Delete the spool file
*
EXEC_OS400 COMMAND('DLTSPLF FILE(#S_208SPLF) SPLNBR(*LAST)') IF_ERROR(*NEXT)
*
* Finished
*
ENDIF
ENDROUTINE