ステップ3. RDMLXフォームのコード
以下は、これらの注文の処理に使用できるRDMLXコードです。コード内の注釈をよく読んでください。
* **************************************************
*
* COMPONENT: STD_FORM
*
* **************************************************
Function Options(*DIRECT)
Begin_Com Role(*EXTENDS #PRIM_FORM) Clientheight(666) Clientwidth(622) Height(693) Left(300) Top(47) Width(630)
Define_Com Class(#PRIM_GRID) Name(#ORDXML) Captionnoblanklines(True) Columnbuttonheight(19) Columnscroll(False) Componentversion(1) Displayposition(1) Height(129) Left(8) Parent(#COM_OWNER) Showbuttonselection(True) Showselection(True) Showselectionhilight(False) Showsortarrow(True) Tabposition(1) Top(8) Width(513)
Define_Com Class(#PRIM_GDCL) Name(#GDCL_1) Displayposition(1) Parent(#ORDXML) Source(#RDXFILENM) Width(100)
Define_Com Class(#PRIM_PHBN) Name(#GETORDERS) Caption('Get Orders') Displayposition(2) Height(26) Left(528) Parent(#COM_OWNER) Tabposition(2) Top(32)
Define_Com Class(#PRIM_PHBN) Name(#PROCESS_ORDER) Caption('Process Orders') Displayposition(3) Enabled(False) Height(26) Left(528) Parent(#COM_OWNER) Tabposition(3) Top(73)
Define_Com Class(#PRIM_GPBX) Name(#GPBX_1) Caption('Order Details') Displayposition(4) Height(329) Left(8) Parent(#COM_OWNER) Tabposition(4) Tabstop(False) Top(264) Width(601)
Define_Com Class(#CUSTNUM.Visual) Name(#CUSTNUM) Displayposition(1) Left(8) Parent(#GPBX_1) Tabposition(1) Top(64)
Define_Com Class(#CUSTNME.Visual) Name(#CUSTNME) Displayposition(2) Left(8) Parent(#GPBX_1) Tabposition(2) Top(88)
Define_Com Class(#ORDDTE.Visual) Name(#ORDDTE) Displayposition(3) Height(19) Left(8) Parent(#GPBX_1) Tabposition(3) Top(40) Usepicklist(False) Width(247)
Define_Com Class(#SONUM.Visual) Name(#SONUM) Displayposition(4) Height(19) Left(8) Parent(#GPBX_1) Tabposition(4) Top(16) Usepicklist(False) Width(247)
Define_Com Class(#STREET.Visual) Name(#STREET) Displayposition(5) Left(10) Parent(#GPBX_1) Tabposition(5) Top(110)
Define_Com Class(#CITY.Visual) Name(#CITY) Displayposition(6) Left(8) Parent(#GPBX_1) Tabposition(6) Top(128)
Define_Com Class(#STATE.Visual) Name(#STATE) Displayposition(7) Left(8) Parent(#GPBX_1) Tabposition(7) Top(151)
Define_Com Class(#ZIP.Visual) Name(#ZIP) Displayposition(8) Left(12) Parent(#GPBX_1) Tabposition(8) Top(173)
Define_Com Class(#PRIM_GRID) Name(#LINES) Captionnoblanklines(True) Columnbuttonheight(18) Columnscroll(False) Componentversion(1) Displayposition(9) Height(105) Left(40) Parent(#GPBX_1) Showbuttonselection(True) Showselection(True) Showselectionhilight(False) Showsortarrow(True) Tabposition(9) Top(200) Width(493)
Define_Com Class(#PRIM_GDCL) Name(#GDCL_2) Displayposition(1) Parent(#LINES) Source(#LINENUM) Width(10)
Define_Com Class(#PRIM_GDCL) Name(#GDCL_3) Displayposition(2) Parent(#LINES) Source(#PARTNUM) Width(10)
Define_Com Class(#PRIM_GDCL) Name(#GDCL_4) Displayposition(3) Parent(#LINES) Source(#PARTDSC) Width(50)
Define_Com Class(#PRIM_GDCL) Name(#GDCL_5) Displayposition(4) Parent(#LINES) Source(#PARTAMT)
Define_Com Class(#PRIM_GDCL) Name(#GDCL_6) Displayposition(5) Parent(#LINES) Source(#PARTQTY) Width(10)
Define_Com Class(#PRIM_GRID) Name(#ORDERS) Captionnoblanklines(True) Columnscroll(False) Componentversion(1) Displayposition(5) Height(102) Left(8) Parent(#COM_OWNER) Showbuttonselection(True) Showselection(True) Showselectionhilight(False) Showsortarrow(True) Tabposition(5) Top(144) Width(513)
Define_Com Class(#PRIM_GDCL) Name(#GDCL_7) Displayposition(1) Parent(#ORDERS) Source(#SONUM)
Define_Com Class(#PRIM_GDCL) Name(#GDCL_8) Parent(#ORDERS) Source(#ORDDTE) Visible(False)
Define_Com Class(#PRIM_GDCL) Name(#GDCL_9) Displayposition(2) Parent(#ORDERS) Source(#CUSTNME) Widthtype(Remainder)
Define_Com Class(#PRIM_GDCL) Name(#GDCL_10) Parent(#ORDERS) Source(#CUSTNUM) Visible(False)
Define_Com Class(#PRIM_GDCL) Name(#GDCL_11) Parent(#ORDERS) Source(#STREET) Visible(False)
Define_Com Class(#PRIM_GDCL) Name(#GDCL_12) Parent(#ORDERS) Source(#CITY) Visible(False)
Define_Com Class(#PRIM_GDCL) Name(#GDCL_13) Parent(#ORDERS) Source(#STATE) Visible(False)
Define_Com Class(#PRIM_GDCL) Name(#GDCL_14) Parent(#ORDERS) Source(#ZIP) Visible(False)
Define_Com Class(#PRIM_GDCL) Name(#GDCL_16) Parent(#LINES) Source(#STD_NUM) Visible(False)
Define_Com Class(#PRIM_GDCL) Name(#GDCL_15) Parent(#ORDERS) Source(#STD_NUM) Visible(False)
Define_Com Class(#PRIM_STBR) Name(#STBR_1) Displayposition(6) Height(24) Left(0) Messageposition(1) Parent(#COM_OWNER) Tabposition(6) Tabstop(False) Top(642) Width(622)
* 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 Field(#JSMHND) Type(*CHAR) Length(4)
* NOTE: You will need to define the following commented fields in your repository as they appear on the form
* 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 #STD_NUM) Type(*Working)
Group_By Name(#ORDHDR) Fields(#SONUM #ORDDTE #CUSTNUM #CUSTNME #STREET #CITY #STATE #ZIP)
* 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(#RDXFILENM) Type(*char) Length(100)
Def_List Name(#ORDERLSTW) Fields(#RDXFILENM) Counter(#LISTCOUNT) Type(*WORKING)
Evtroutine Handling(#com_owner.Initialize)
Set Com(#com_owner) Caption(*component_desc)
* We will now start the funcionality by opening the JSM
Use Builtin(JSMX_OPEN) To_Get(#JSMSTS #JSMMSG #JSMHND)
Execute Subroutine(CHECK) With_Parms(#JSMSTS #JSMMSG)
* Next we will load the JSM service - in this example we have selected to have tracing on.
#JSMCMD := 'SERVICE_LOAD SERVICE(XMLBINDFILESERVICE) TRACE(*YES) DOMSET(*READER)'
Use Builtin(JSMX_COMMAND) With_Args(#JSMHND #JSMCMD) To_Get(#JSMSTS #JSMMSG)
Execute Subroutine(CHECK) With_Parms(#JSMSTS #JSMMSG)
Endroutine
* 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 ('#JSMSTS *NE OK')
* Display FIELDS(#JSMSTS #JSMMSG)
Use Builtin(JSMX_CLOSE) With_Args(#JSMHND) To_Get(#JSMSTS #JSMMSG)
Message Msgtxt('Java service error has occured')
Endif
Endroutine
Evtroutine Handling(#GETORDERS.Click)
* Clear out all lists and fields first
Clr_List Named(#ORDERS)
Clr_List Named(#LINES)
Clr_List Named(#ORDERLSTW)
#ORDHDR := *default
* 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.
#JSMCMD := 'LIST DIR(NEWORDERS) SERVICE_LIST(FILENAME) EXT(XML)'
Use Builtin(JSMX_COMMAND) With_Args(#JSMHND #JSMCMD) To_Get(#JSMSTS #JSMMSG #ORDERLSTW)
Execute Subroutine(CHECK) With_Parms(#JSMSTS #JSMMSG)
* Display the list returned from the LIST command.
Clr_List Named(#ORDXML)
Selectlist Named(#ORDERLSTW)
Add_Entry To_List(#ORDXML)
Endselect
If ('#LISTCOUNT > 0')
#PROCESS_ORDER.Enabled := True
Endif
Endroutine
Evtroutine Handling(#PROCESS_ORDER.Click)
Clr_List Named(#ORDLINES)
#std_num := 0
* 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)
#std_num := #std_num + 1
* 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)
#JSMCMD := 'READ FILE(' + #RDXFILENM + ') ARCHIVE(' + #ARCHIVE + ')'
Use Builtin(JSMX_COMMAND) With_Args(#JSMHND #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'.
#JSMCMD := 'BIND SERVICE(INBOUNDORDER) TYPE(*INBOUND) BINDTRACE(*YES)'
Use Builtin(JSMX_COMMAND) With_Args(#JSMHND #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(JSMX_COMMAND) With_Args(#JSMHND 'GET FRAGMENT(ORDERS) SERVICE_EXCHANGE(*FIELD)') To_Get(#JSMSTS #JSMMSG)
Execute Subroutine(CHECK) With_Parms(#JSMSTS #JSMMSG)
#JSMCMD := 'GET FRAGMENT(SALESORDER) SERVICE_EXCHANGE(*FIELD)'
Use Builtin(JSMX_COMMAND) With_Args(#JSMHND #JSMCMD) To_Get(#JSMSTS #JSMMSG)
Execute Subroutine(CHECK) With_Parms(#JSMSTS #JSMMSG)
#JSMCMD := 'GET FRAGMENT(CUSTOMER) SERVICE_EXCHANGE(*FIELD)'
Use Builtin(JSMX_COMMAND) With_Args(#JSMHND #JSMCMD) To_Get(#JSMSTS #JSMMSG)
Execute Subroutine(CHECK) With_Parms(#JSMSTS #JSMMSG)
#JSMCMD := 'GET FRAGMENT(ORDERDATE) SERVICE_EXCHANGE(*FIELD)'
Use Builtin(JSMX_COMMAND) With_Args(#JSMHND #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(JSMX_COMMAND) With_Args(#JSMHND 'GET FRAGMENT(LINE) SERVICE_EXCHANGE(*FIELD)') To_Get(#JSMSTS #JSMMSG)
If ('#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(JSMX_COMMAND) With_Args(#JSMHND 'GET FRAGMENT(PART) SERVICE_EXCHANGE(*FIELD)') To_Get(#JSMSTS #JSMMSG)
Add_Entry To_List(#ORDLINES)
End_Loop
* 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(JSMX_COMMAND) With_Args(#JSMHND CLOSE) To_Get(#JSMSTS #JSMMSG)
#JSMCMD := 'DELETE FILE(' + #RDXFILENM + ')'
Use Builtin(JSMX_COMMAND) With_Args(#JSMHND #JSMCMD) To_Get(#JSMSTS #JSMMSG)
* Add the order header details to the ORDERS grid
Add_Entry To_List(#ORDERS)
* 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
* Clear the header details fields so they do not appear with values until an order is selected.
#ORDHDR := *default
* Disable the Process Orders button
#PROCESS_ORDER.Enabled := False
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(#RDXFILENM 'neworders' *DEFAULT '0') To_Get(#X_POSN)
#X_POSN := #X_POSN + 10
Substring Field(#RDXFILENM #X_POSN) Into_Field(#ARCHIVE)
#ARCHIVE := 'archive/arc_' + #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(JSMX_COMMAND) With_Args(#JSMHND '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)
#COMMENTS := 'Thank you for your order'
Add_Entry To_List(#LSTCMNT)
#COMMENTS := 'We have processed your order ' + #SONUM + ' on date: ' + *DDMMYYYYC
Add_Entry To_List(#LSTCMNT)
#COMMENTS := 'Please refer below for the full details of your order.'
Add_Entry To_List(#LSTCMNT)
#COMMENTS := 'One of our sales people will be in touch with you shortly.'
Add_Entry To_List(#LSTCMNT)
#COMMENTS := 'For immediate assistance on your order please call 1234567'
Add_Entry To_List(#LSTCMNT)
#COMMENTS := 'one more line'
Add_Entry To_List(#LSTCMNT)
#COMMENTS := 'two more lines'
Add_Entry To_List(#LSTCMNT)
#COMMENTS := '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 ('#TOGGLE = 0')
#TOGGLE := 1
#LINSTAT := OK
Else
#TOGGLE := 0
#LINSTAT := '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).
#JSMCMD := 'SET FRAGMENT(ORDERRESPONSE) SERVICE_EXCHANGE(*FIELD)'
Use Builtin(JSMX_COMMAND) With_Args(#JSMHND #JSMCMD) To_Get(#JSMSTS #JSMMSG)
Execute Subroutine(CHECK) With_Parms(#JSMSTS #JSMMSG)
Selectlist Named(#LSTCMNT)
#JSMCMD := 'SET FRAGMENT(RESPONSECOMMENTS) SERVICE_EXCHANGE(*FIELD)'
Use Builtin(JSMX_COMMAND) With_Args(#JSMHND #JSMCMD) To_Get(#JSMSTS #JSMMSG)
Execute Subroutine(CHECK) With_Parms(#JSMSTS #JSMMSG)
Endselect
#JSMCMD := 'SET FRAGMENT(SALESORDER) SERVICE_EXCHANGE(*FIELD)'
Use Builtin(JSMX_COMMAND) With_Args(#JSMHND #JSMCMD) To_Get(#JSMSTS #JSMMSG)
Execute Subroutine(CHECK) With_Parms(#JSMSTS #JSMMSG)
#JSMCMD := 'SET FRAGMENT(CUSTOMER) SERVICE_EXCHANGE(*FIELD)'
Use Builtin(JSMX_COMMAND) With_Args(#JSMHND #JSMCMD) To_Get(#JSMSTS #JSMMSG)
Execute Subroutine(CHECK) With_Parms(#JSMSTS #JSMMSG)
Selectlist Named(#RSPLINES)
#JSMCMD := 'SET FRAGMENT(LINE) SERVICE_EXCHANGE(*FIELD)'
Use Builtin(JSMX_COMMAND) With_Args(#JSMHND #JSMCMD) To_Get(#JSMSTS #JSMMSG)
Execute Subroutine(CHECK) With_Parms(#JSMSTS #JSMMSG)
#JSMCMD := 'SET FRAGMENT(PART) SERVICE_EXCHANGE(*FIELD)'
Use Builtin(JSMX_COMMAND) With_Args(#JSMHND #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.
#JSMCMD := 'WRITE FILE(response/RSP_' + #CUSTNUM + '_' + #SONUM + '.xml) INDENT(*YES) INDENT-AMOUNT(1)'
Use Builtin(JSMX_COMMAND) With_Args(#JSMHND #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(JSMX_COMMAND) With_Args(#JSMHND CLOSE) To_Get(#JSMSTS #JSMMSG)
Endroutine
Evtroutine Handling(#COM_OWNER.Closing) Options(*NOCLEARMESSAGES *NOCLEARERRORS)
Use Builtin(JSMX_COMMAND) With_Args(#JSMHND SERVICE_UNLOAD) To_Get(#JSMSTS #JSMMSG)
Use Builtin(JSMX_CLOSE) With_Args(#JSMHND) To_Get(#JSMSTS #JSMMSG)
Endroutine
Evtroutine Handling(#ORDERS.ItemGotSelection) Options(*NOCLEARMESSAGES *NOCLEARERRORS)
Define Field(#whichone) Reffld(#std_num)
#whichone := #std_num
Clr_List Named(#LINES)
Selectlist Named(#ORDLINES)
If ('#std_num = #whichone')
Add_Entry To_List(#LINES)
Endif
Endselect
Endroutine
End_Com