RDML for SET214W

LANSA

RDML for SET214W
* =======================================================
* Process ........: SET_214
* Function .......: SET214W
* Created on .....: 19/11/01 at 13:24:10
*
* Full Description:
*
* This Lansa for the Web function requests some basic
* Order information. The information is validated
* and then and passed on to SET214R to use JSM and
* send the information to the web service SET216S to
* create the Order.
* Refer to SET214R and SET216S for details on how to use
* JSM to do two way XML transactions.
*
* Disclaimer: The following material is supplied as an
* example only. No warranty is expressed or implied.
*
* ======================================================*
Function Options(*DIRECT *WEBEVENT)
*
* Lansa host name and port
Define Field(#LANSAHOST) Reffld(#S_214HOST) Input_Atr(LC) Default('demo.lansa.com.au')
*
* Field to evalutate what button was clicked. In this
* case there is only one.
Define Field(#S_CLICKED) Type(*CHAR) Length(030) Default('FORM.INITIALIZE')
*
Override Field(#S_214HOST) Label('Your Host:Port')
*
* Conditions to verify the chosen transaction server
Def_Cond Name(*LANSAHOST) Cond('(#S_214HOST = *BLANKS) or (#s_214host = demo.lansa.com.au)')
*
* Browselist to select product and quantity to create the
* order detail records. The selected product and quantity
* are added to the OUT_LIST working list and exchanged
Def_List Name(#S_214INPB) Fields(#S_214PROD (#S_214QTY *INPUT))
*
* Working list with product and quantity values required
* to create the order detail records
Def_List Name(#OUT_LIST) Fields(#S_214PROD #S_214QTY) Counter(#LISTCOUNT) Type(*WORKING)
*
Def_Cond Name(*NO_ERRORS) Cond('#s_214ERRO = *blanks')
*
* Incoming working list with validation errors if
* occurred
Def_List Name(#INERR_LST) Fields(#S_214ERRO) Type(*WORKING)
*
* Group of fields in the request command
Group_By Name(#PANELDATA) Fields((#S_CLICKED *HIDDEN) #S_214CUST #S_214SADD #S_214BADD #S_214HOST (#S_214STAT *OUTPUT) (#S_214ORDN *OUTPUT) (#S_214COST *OUTPUT) (#S_214SDAT *OUTPUT) (#S_214CRTO *NOID) (#S_214ERRO *HIDDEN) (#S_214DESC *NOID))
*
* Group of fields to store order information going out:
* S_214BADD - billing address
* S_214SADD - Shipment address
* S_214CUST - customer name
*
* And coming back in (provided no validation errors
* occurred):
* S_214ORDN - order number
* S_214COST - total cost of the order
* S_214SDAT - Shipment date
* S_214STAT - order status
*
Group_By Name(#OUT_DATA) Fields(#S_214BADD #S_214SADD #S_214CUST #S_214HOST #S_214URI #S_214ORDN #S_214COST #S_214SDAT #S_214STAT)
*
Clr_List Named(#S_214INPB)
*
* Prefil the input list with hard coded products and
* quantities
Execute Subroutine(PREFIL_LST) With_Parms('Modem' 100)
Execute Subroutine(PREFIL_LST) With_Parms('Network Card' 100)
Execute Subroutine(PREFIL_LST) With_Parms('Sound Card' 100)
*
Case Of_Field(#S_CLICKED)
When Value_Is('= FORM.INITIALIZE')
* Change the host field to the value of the SET system
* variable S_HOSTURL. This variable is used across the
* SET collection to hold the value of the host location.
* Depending on whether you have executed other SET
* examples, this variable might or might not have a value
* If it has a value, concatenate it with the host port
* value held in a system variable with the same
* functionality as S_HOSTURL
Execute Subroutine(SET_HOST)
Otherwise
* Set S_214host to the host of the transaction server
Execute Subroutine(CHK_INPUT)
* If no quantity was typed in, redisplay request screen
If Cond('#listcount > 0')
* Call SETJSMO to open JSM
Execute Subroutine(OP_CL_JSM) With_Parms(OPEN)
* Set S_214host to the host of the transaction server
Execute Subroutine(SET_URI)
* Call service in specified Transaction server
Execute Subroutine(CRT_ORDER)
* Get Order details and/or errors
Execute Subroutine(GET_ORDER)
* Close JSM
Execute Subroutine(OP_CL_JSM) With_Parms(CLOSE)
*
Endif
*
Endcase
*
* Request Customer name, Shipment and billing address and
* product quantities
Request Fields(#PANELDATA) Identify(*LABEL) Browselist(#S_214INPB) Exit_Key(*NO) Menu_Key(*NO) Prompt_Key(*NO)
*
Subroutine Name(SET_HOST)
Change Field(#S_214HOST) To(*S_HOSTURL)
If Cond('#s_214host *ne *blanks')
Use Builtin(TCONCAT) With_Args(#S_214HOST ':' *S_HOSTPORT) To_Get(#S_214HOST)
Endif
Endroutine
*
Subroutine Name(CHK_INPUT)
Clr_List Named(#OUT_LIST)
* Select the entries of the input browselist and add them
* to the exchange working list
Selectlist Named(#S_214INPB)
Continue If('#S_214QTY *EQ *ZEROS')
Add_Entry To_List(#OUT_LIST)
Endselect
Endroutine
*
Subroutine Name(SET_URI)
* Set the exchanged fields with the host value and the
* URI (Uniform Resource I). The URI value is a symbolic
* name resolved in file DC@W29 to a process and function
* name and partition identifier for the service to run.
If Cond(*LANSAHOST)
Change Field(#S_214HOST) To(#LANSAHOST)
Change Field(#S_214URI) To('set214srv')
Else
Change Field(#S_214URI) To(SET216_ORDER_SERVICE)
Endif
*
Change Field(#S_214ERRO) To(*BLANKS)
Endroutine
*
* Call the interface program to send the requested data
* and receive back the order details
Subroutine Name(CRT_ORDER)
Clr_List Named(#INERR_LST)
Exchange Fields(#OUT_DATA)
Call Process(*DIRECT) Function(SET214R) Exit_Used(*NEXT) Menu_Used(*NEXT) Pass_Lst(#OUT_LIST #INERR_LST)
Endroutine
*
Subroutine Name(GET_ORDER)
* Verify whether any validation error occurred when
* creating the orders by reading through the returned
* error list.
Change Field(#S_214ERRO) To(NOERROR)
Selectlist Named(#INERR_LST)
Message Msgid(DCM9899) Msgf(DC@M01) Msgdta(#S_214ERRO)
Endselect
*
Endroutine
*
Subroutine Name(PREFIL_LST) Parms(#S_214PROD #S_214QTY)
* Prefill the browselist with product names
Add_Entry To_List(#S_214INPB)
Endroutine
*
* Call SETJSMO to issue a JSM open or close
*
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
*