ステップ3：RDMLファンクション・コード
以下は、これらの注文の処理に使用できるRDMLコードです。コード内の注釈で状況を説明しているため、注釈をよくお読みください。XMLBindFileServiceのRDMLX例もあります。
FUNCTION OPTIONS(*DIRECT)
* Define the fields to be used in this application
* Define the fields used by the JSM Commands
DEFINE FIELD(#JSMSTS) TYPE(*CHAR) LENGTH(020)
DEFINE FIELD(#JSMMSG) TYPE(*CHAR) LENGTH(255)
DEFINE FIELD(#JSMCMD) TYPE(*CHAR) LENGTH(255)
* Define the fields used for the orders.
* These fields will hold values read from and written to
* the XML documents
* Define the Order number and date
DEFINE FIELD(#SONUM) TYPE(*CHAR) LENGTH(010) LABEL('Order #')
DEFINE FIELD(#ORDDTE) TYPE(*CHAR) LENGTH(010) LABEL('Order Date')
* Define the Customer details
DEFINE FIELD(#CUSTNUM) TYPE(*CHAR) LENGTH(010) LABEL('Customer #')
DEFINE FIELD(#CUSTNME) TYPE(*CHAR) LENGTH(050) LABEL('Customer name')
DEFINE FIELD(#STREET) TYPE(*CHAR) LENGTH(050) LABEL('Street')
DEFINE FIELD(#CITY) TYPE(*CHAR) LENGTH(050) LABEL('City')
DEFINE FIELD(#STATE) TYPE(*CHAR) LENGTH(005) LABEL('State')
DEFINE FIELD(#ZIP) TYPE(*CHAR) LENGTH(005) LABEL('Post Code')
* Define the order line details. We will also define a
* list that holds the order line details
DEFINE FIELD(#LINENUM) TYPE(*DEC) LENGTH(003) DECIMALS(0) LABEL('Line #')
DEFINE FIELD(#PARTNUM) TYPE(*DEC) LENGTH(003) DECIMALS(0) LABEL('Part #')
DEFINE FIELD(#PARTDSC) TYPE(*CHAR) LENGTH(020) LABEL('Part Desc.')
DEFINE FIELD(#PARTAMT) TYPE(*DEC) LENGTH(010) DECIMALS(2) LABEL('Amount')
DEFINE FIELD(#PARTQTY) TYPE(*DEC) LENGTH(003) DECIMALS(0) LABEL('Quantity')
DEFINE FIELD(#ORDTOT) TYPE(*DEC) LENGTH(010) DECIMALS(2) LABEL('Grand Total')
DEF_LIST NAME(#ORDLINES) FIELDS(#LINENUM #PARTNUM #PARTDSC #PARTAMT #PARTQTY)
* The following field will hold the file name and path
* for the archived files
DEFINE FIELD(#ARCHIVE) TYPE(*CHAR) LENGTH(30) DESC('Archived Orders Directory') INPUT_ATR(LC) DEFAULT('''archive''')
DEFINE FIELD(#X_POSN) TYPE(*DEC) LENGTH(2) DECIMALS(0) DESC('Working field to find the file name')
* Define the order response details
DEFINE FIELD(#COMMENTS) TYPE(*CHAR) LENGTH(256) LABEL('Comments')
DEFINE FIELD(#LINSTAT) TYPE(*CHAR) LENGTH(20) LABEL('Line Status')
DEFINE FIELD(#RESPONSE) TYPE(*CHAR) LENGTH(30) LABEL('Resp filename')
DEFINE FIELD(#TOGGLE) TYPE(*DEC) LENGTH(1) DECIMALS(0)
DEF_LIST NAME(#LSTCMNT) FIELDS(#COMMENTS) TYPE(*WORKING)
DEF_LIST NAME(#RSPLINES) FIELDS(#LINENUM #PARTNUM #PARTDSC #PARTAMT #PARTQTY #LINSTAT) TYPE(*WORKING)
* A single field working list needs to be defined to
* hold the list of order returned from our LIST command.
* The field needs to be long enough to hold the expected
* length of the canonical file path returned from the
* LIST command.
DEFINE FIELD(#FILENAME) TYPE(*CHAR) LENGTH(100)
DEF_LIST NAME(#ORDERLSTW) FIELDS(#FILENAME) COUNTER(#LISTCOUNT) TYPE(*WORKING)
DEF_LIST NAME(#ORDERLSTB) FIELDS(#FILENAME) COUNTER(#LISTCOUNT)
* We will now start the funcionality by opening the JSM
USE BUILTIN(JSM_OPEN) TO_GET(#JSMSTS #JSMMSG)
EXECUTE SUBROUTINE(CHECK) WITH_PARMS(#JSMSTS #JSMMSG)
* Next we will load the JSM service - in this example we
* have selected to have tracing on.
CHANGE FIELD(#JSMCMD) TO('SERVICE_LOAD SERVICE(XMLBINDFILESERVICE) TRACE(*YES) DOMSET(*READER)')
USE BUILTIN(JSM_COMMAND) WITH_ARGS(#JSMCMD) TO_GET(#JSMSTS #JSMMSG)
EXECUTE SUBROUTINE(CHECK) WITH_PARMS(#JSMSTS #JSMMSG)
* The first thing we want to do is to get a list of all
* the orders that are in the neworders directory. To do
* this we will use the LIST command. In this scenario,
* the neworders directory is immediately under the JSM
* Instance directory on our server, so we can refer to
* the directory simply as 'neworders'.
* In this example the file extension has been hard coded
* as XML. This means that only files with an extension of
* XML will be returned.
CLR_LIST NAMED(#ORDERLSTW)
CHANGE FIELD(#JSMCMD) TO('''LIST DIR(NEWORDERS) SERVICE_LIST(FILENAME) EXT(XML)''')
USE BUILTIN(JSM_COMMAND) WITH_ARGS(#JSMCMD) TO_GET(#JSMSTS #JSMMSG #ORDERLSTW)
EXECUTE SUBROUTINE(CHECK) WITH_PARMS(#JSMSTS #JSMMSG)
* Display the list returned from the LIST command.
CLR_LIST NAMED(#ORDERLSTB)
SELECTLIST NAMED(#ORDERLSTW)
ADD_ENTRY TO_LIST(#ORDERLSTB)
ENDSELECT
DISPLAY FIELDS(#JSMCMD) BROWSELIST(#ORDERLSTB) EXIT_KEY(*YES *NEXT) MENU_KEY(*YES *NEXT)
IF_KEY WAS(*MENU *EXIT)
* Nicely close down JSM if the user has select the Exit
* or Menu key (F3 or F12)
USE BUILTIN(JSM_CLOSE) TO_GET(#JSMSTS #JSMMSG)
ENDIF
* The next step of our application is to run through
* the orders in our list and process the data order by
* order. To do this we will need to use the READ, BIND,
* and GET commands.
SELECTLIST NAMED(#ORDERLSTW)
* Next we will use the READ command. For the READ
* command we need to specify the file that we want
* to access, including the file path. In this example,
* if an order is named order1.xml for example, then the
* FILE keyword would normally be specified as
* FILE(neworder/order1.xml), and it would assume that the
* neworder directory is under the JSM Instance directory
* for the server. We could take this approach, but we
* already have the full directory path and file name
* specified in the list (in the field #FILENAME) so it
* will be much simpler to use this. The actual ARCHIVE
* file name and path will be verified in the ARCHIVE
* sub-routine.
* If we were going to be using a hard coded READ, then
* this is what it might look like:
* . USE BUILTIN( BUILTIN) WITH_ARGS(JSM_COMMAND)
* . WITH_ARGS('READ FILE(neworder/order1.xml)
* . ARCHIVE(archive/arc_order1.xml)')
* . TO_GET(#JSMSTS #JSMMSG)
EXECUTE SUBROUTINE(ARCHIVE)
CHANGE FIELD(#JSMCMD) TO('READ FILE(')
USE BUILTIN(TCONCAT) WITH_ARGS(#JSMCMD #FILENAME ') ARCHIVE(' #ARCHIVE ')') TO_GET(#JSMCMD)
USE BUILTIN(JSM_COMMAND) WITH_ARGS(#JSMCMD) TO_GET(#JSMSTS #JSMMSG)
EXECUTE SUBROUTINE(CHECK) WITH_PARMS(#JSMSTS #JSMMSG)
* The next command to run is the BIND. We named the
* service to handle the inbound XML documents as
* 'inboundorder'.
CHANGE FIELD(#JSMCMD) TO('''BIND SERVICE(INBOUNDORDER) TYPE(*INBOUND) BINDTRACE(*YES)''')
USE BUILTIN(JSM_COMMAND) WITH_ARGS(#JSMCMD) TO_GET(#JSMSTS #JSMMSG)
EXECUTE SUBROUTINE(CHECK) WITH_PARMS(#JSMSTS #JSMMSG)
* The next step is to retrieve the data using the GET
* command.
USE BUILTIN(JSM_COMMAND) WITH_ARGS('GET FRAGMENT(ORDERS) SERVICE_EXCHANGE(*FIELD)') TO_GET(#JSMSTS #JSMMSG)
EXECUTE SUBROUTINE(CHECK) WITH_PARMS(#JSMSTS #JSMMSG)
CHANGE FIELD(#JSMCMD) TO('GET FRAGMENT(SALESORDER) SERVICE_EXCHANGE(*FIELD)')
USE BUILTIN(JSM_COMMAND) WITH_ARGS(#JSMCMD) TO_GET(#JSMSTS #JSMMSG)
EXECUTE SUBROUTINE(CHECK) WITH_PARMS(#JSMSTS #JSMMSG)
CHANGE FIELD(#JSMCMD) TO('GET FRAGMENT(CUSTOMER) SERVICE_EXCHANGE(*FIELD)')
USE BUILTIN(JSM_COMMAND) WITH_ARGS(#JSMCMD) TO_GET(#JSMSTS #JSMMSG)
EXECUTE SUBROUTINE(CHECK) WITH_PARMS(#JSMSTS #JSMMSG)
CHANGE FIELD(#JSMCMD) TO('GET FRAGMENT(ORDERDATE) SERVICE_EXCHANGE(*FIELD)')
USE BUILTIN(JSM_COMMAND) WITH_ARGS(#JSMCMD) TO_GET(#JSMSTS #JSMMSG)
EXECUTE SUBROUTINE(CHECK) WITH_PARMS(#JSMSTS #JSMMSG)
* The line details of our order technically make up a
* list. In this example though, we have defined the lines
* as fragments. As such, we need to handle them a little
* differently. We need to place the GET FRAGMENT(LINE) in
* a loop and continue in the loop until all the line
* details are retrieved. The following demonstrates how
* we do this.
CLR_LIST NAMED(#ORDLINES)
BEGIN_LOOP
USE BUILTIN(JSM_COMMAND) WITH_ARGS('GET FRAGMENT(LINE) SERVICE_EXCHANGE(*FIELD)') TO_GET(#JSMSTS #JSMMSG)
IF COND('#JSMSTS *EQ NOFRAGMENT')
LEAVE
ENDIF
EXECUTE SUBROUTINE(CHECK) WITH_PARMS(#JSMSTS #JSMMSG)
* We also need to get the part details for this line.
USE BUILTIN(JSM_COMMAND) WITH_ARGS('GET FRAGMENT(PART) SERVICE_EXCHANGE(*FIELD)') TO_GET(#JSMSTS #JSMMSG)
ADD_ENTRY TO_LIST(#ORDLINES)
END_LOOP
* Now that we have everything for the order let us
* display it. In a real application of course you would
* carry on an load it into your ERP system or what have
* you, but we will just display it.
DISPLAY FIELDS(#SONUM #ORDDTE #CUSTNUM #CUSTNME #STREET #CITY #STATE #ZIP) BROWSELIST(#ORDLINES) EXIT_KEY(*YES *NEXT) MENU_KEY(*YES *NEXT)
IF_KEY WAS(*MENU *EXIT)
* Nicely close down JSM if the user has select the Exit
* or Menu key (F3 or F12)
USE BUILTIN(JSM_CLOSE) TO_GET(#JSMSTS #JSMMSG)
ENDIF
* Now that we have the data we need and have saved a copy
* of the file in the archive, we can close the bind on
* this file and delete the file from our inbound
* directory.
USE BUILTIN(JSM_COMMAND) WITH_ARGS(CLOSE) TO_GET(#JSMSTS #JSMMSG)
CHANGE FIELD(#JSMCMD) TO('DELETE FILE(')
USE BUILTIN(TCONCAT) WITH_ARGS(#JSMCMD #FILENAME ')') TO_GET(#JSMCMD)
USE BUILTIN(JSM_COMMAND) WITH_ARGS(#JSMCMD) TO_GET(#JSMSTS #JSMMSG)
* Now we will work on a response XML in reply to this
* order. To keep things clean, we will do this in a
* separate subroutine.
EXECUTE SUBROUTINE(RESPONSE)
ENDSELECT
*
* SUB ROUTINES
* The CHECK subroutine is used to capture errors returned
* from the JSM commands. For any errors encountered, a
* screen will be displayed with the error message and the
* program will exit after this.
SUBROUTINE NAME(CHECK) PARMS((#JSMSTS *RECEIVED) (#JSMMSG *RECEIVED))
IF COND('#JSMSTS *NE OK')
DISPLAY FIELDS(#JSMSTS #JSMMSG)
USE BUILTIN(JSM_CLOSE) TO_GET(#JSMSTS #JSMMSG)
MENU MSGTXT('Java service error has occured')
ENDIF
ENDROUTINE
* The ARCHIVE subroutine will build the file name and
* path for the ARCHIVE keyword of the READ command.
SUBROUTINE NAME(ARCHIVE)
USE BUILTIN(SCANSTRING) WITH_ARGS(#FILENAME 'neworders' *DEFAULT '0') TO_GET(#X_POSN)
CHANGE FIELD(#X_POSN) TO('#X_POSN + 10')
SUBSTRING FIELD(#FILENAME #X_POSN) INTO_FIELD(#ARCHIVE)
USE BUILTIN(TCONCAT) WITH_ARGS('archive/arc_' #ARCHIVE) TO_GET(#ARCHIVE)
ENDROUTINE
* This RESPONSE subroutine will do all the processing
* required to build and create the response XML document.
SUBROUTINE NAME(RESPONSE)
* The first thing we need to do is create a new empty
* outbound XML document and BIND it to the outbound
* service that we created with the XML Binding Wizard.
* Note that we specify the type as *OUTBOUND.
USE BUILTIN(JSM_COMMAND) WITH_ARGS('BIND SERVICE(OUTBOUNDRESPONSE) TYPE(*OUTBOUND)') TO_GET(#JSMSTS #JSMMSG)
EXECUTE SUBROUTINE(CHECK) WITH_PARMS(#JSMSTS #JSMMSG)
* Much of the information for the response we already
* have, but a couple of fields need to be populated so
* we will make up some fictitious data here. We will
* create some comments, and add them to a list first.
* The other new data we need to add is the LINSTAT field
* to give an indication of the status of the order line.
CLR_LIST NAMED(#LSTCMNT)
CHANGE FIELD(#COMMENTS) TO('''Thank you for your order''')
ADD_ENTRY TO_LIST(#LSTCMNT)
USE BUILTIN(BCONCAT) WITH_ARGS('We have processed your order' #SONUM 'on date:' *DDMMYYYYC) TO_GET(#COMMENTS)
ADD_ENTRY TO_LIST(#LSTCMNT)
CHANGE FIELD(#COMMENTS) TO('''Please refer below for the full details of your order.''')
ADD_ENTRY TO_LIST(#LSTCMNT)
CHANGE FIELD(#COMMENTS) TO('''One of our sales people will be in touch with you shortly.''')
ADD_ENTRY TO_LIST(#LSTCMNT)
CHANGE FIELD(#COMMENTS) TO('''For immediate assistance on your order please call 1234567''')
ADD_ENTRY TO_LIST(#LSTCMNT)
CHANGE FIELD(#COMMENTS) TO('''one more line''')
ADD_ENTRY TO_LIST(#LSTCMNT)
CHANGE FIELD(#COMMENTS) TO('''two more lines''')
ADD_ENTRY TO_LIST(#LSTCMNT)
CHANGE FIELD(#COMMENTS) TO('''three more lines''')
ADD_ENTRY TO_LIST(#LSTCMNT)
CLR_LIST NAMED(#RSPLINES)
* NOTE: The #TOGGLE field is used to alternate status
* messages - to add a bit of variety.
SELECTLIST NAMED(#ORDLINES)
IF COND('#TOGGLE = 0')
CHANGE FIELD(#TOGGLE) TO(1)
CHANGE FIELD(#LINSTAT) TO(OK)
ELSE
CHANGE FIELD(#TOGGLE) TO(0)
CHANGE FIELD(#LINSTAT) TO('OUT OF STOCK')
ENDIF
ADD_ENTRY TO_LIST(#RSPLINES)
ENDSELECT
* Now that we have some data, we can start using the SET
* command to populate the outbound document object. As
* per the reading of data from the order documents, since
* this example is using fragments only, we will need to
* set up loops to add any repeating data (specifically
* the comments and the order lines).
CHANGE FIELD(#JSMCMD) TO('SET FRAGMENT(ORDERRESPONSE) SERVICE_EXCHANGE(*FIELD)')
USE BUILTIN(JSM_COMMAND) WITH_ARGS(#JSMCMD) TO_GET(#JSMSTS #JSMMSG)
EXECUTE SUBROUTINE(CHECK) WITH_PARMS(#JSMSTS #JSMMSG)
SELECTLIST NAMED(#LSTCMNT)
CHANGE FIELD(#JSMCMD) TO('SET FRAGMENT(RESPONSECOMMENTS) SERVICE_EXCHANGE(*FIELD)')
USE BUILTIN(JSM_COMMAND) WITH_ARGS(#JSMCMD) TO_GET(#JSMSTS #JSMMSG)
EXECUTE SUBROUTINE(CHECK) WITH_PARMS(#JSMSTS #JSMMSG)
ENDSELECT
CHANGE FIELD(#JSMCMD) TO('SET FRAGMENT(SALESORDER) SERVICE_EXCHANGE(*FIELD)')
USE BUILTIN(JSM_COMMAND) WITH_ARGS(#JSMCMD) TO_GET(#JSMSTS #JSMMSG)
EXECUTE SUBROUTINE(CHECK) WITH_PARMS(#JSMSTS #JSMMSG)
CHANGE FIELD(#JSMCMD) TO('SET FRAGMENT(CUSTOMER) SERVICE_EXCHANGE(*FIELD)')
USE BUILTIN(JSM_COMMAND) WITH_ARGS(#JSMCMD) TO_GET(#JSMSTS #JSMMSG)
EXECUTE SUBROUTINE(CHECK) WITH_PARMS(#JSMSTS #JSMMSG)
SELECTLIST NAMED(#RSPLINES)
CHANGE FIELD(#JSMCMD) TO('SET FRAGMENT(LINE) SERVICE_EXCHANGE(*FIELD)')
USE BUILTIN(JSM_COMMAND) WITH_ARGS(#JSMCMD) TO_GET(#JSMSTS #JSMMSG)
EXECUTE SUBROUTINE(CHECK) WITH_PARMS(#JSMSTS #JSMMSG)
CHANGE FIELD(#JSMCMD) TO('SET FRAGMENT(PART) SERVICE_EXCHANGE(*FIELD)')
USE BUILTIN(JSM_COMMAND) WITH_ARGS(#JSMCMD) TO_GET(#JSMSTS #JSMMSG)
EXECUTE SUBROUTINE(CHECK) WITH_PARMS(#JSMSTS #JSMMSG)
ENDSELECT
* Now we have all the data prepared, we will serialize
* the document object out to a specified file using the
* WRITE command. We will construct a file name based on
* the customer and order number.
USE BUILTIN(TCONCAT) WITH_ARGS('response/RSP_' #CUSTNUM '_' #SONUM '.xml') TO_GET(#RESPONSE)
USE BUILTIN(TCONCAT) WITH_ARGS('WRITE FILE(' #RESPONSE ') INDENT(*YES) INDENT-AMOUNT(1)') TO_GET(#JSMCMD)
USE BUILTIN(JSM_COMMAND) WITH_ARGS(#JSMCMD) TO_GET(#JSMSTS #JSMMSG)
EXECUTE SUBROUTINE(CHECK) WITH_PARMS(#JSMSTS #JSMMSG)
* Finally we will CLOSE the bind then go onto the next
* XML document.
USE BUILTIN(JSM_COMMAND) WITH_ARGS(CLOSE) TO_GET(#JSMSTS #JSMMSG)
ENDROUTINE