RDML for SET215G

LANSA

RDML for SET215G
* =======================================================
* Process ........: SET_215
* Function .......: set215G
* Created on .....: 19/10/01 at 11:41:13
* Description ....: Function Skeleton
* Version.........: 1
*
* This 5250 function requests up to 5 Order Numbers.
* The selected orders are exchanged with SET215R
* together with a working list where potential errors
* would be returned.
* In this case, unlike in example 214/216, there are two
* working lists involved. A working list of orders, each
* of them having more than one error, hence the error
* working list.
*
* A host selection is required. The selected host is the
* the host where the status of the order is looked up.
* If you select the lansa host, a dummy cgi program
* will send back a response with order details status.
*
* Refer to SET215R and SET217S 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)
*
Define Field(#WK_ORDN) Reffld(#S_214ORDN)
* Lansa host name and port
Define Field(#LANSAHOST) Reffld(#S_214HOST) Input_Atr(LC) Default('demo.lansa.com.au')
*
Override Field(#S_214HOST) Label('Your Host:Port')
*
* Conditions to verify the chosen transaction service
Def_Cond Name(*LANSAHOST) Cond('(#S_214HOST = *BLANKS) or (#s_214host = demo.lansa.com.au)')
*
* Field and condition to verify whether any errors
* occurred when looking up the order status.
Define Field(#BERRCOUNT) Reffld(#LISTCOUNT)
Def_Cond Name(*NO_ERRORS) Cond('#BERRCOUNT = 0')
*
* Working list with order numbers going out.
Def_List Name(#OUT_LIST) Fields(#S_214ORDN) Counter(#LISTCOUNT) Type(*WORKING)
*
* Working list with order status details coming back in
Def_List Name(#IN_LIST) Fields(#S_214ORDN #S_214STAT #S_214COST #S_214SDAT #S_214IOST #S_214ERRO) Type(*WORKING)
*
* Order status fields to display
Def_List Name(#DSP_ORDER) Fields(#S_214ORDN #S_214STAT #S_214COST #S_214SDAT)
*
* Browselist to input order number(s)
Def_List Name(#INP_LIST) Fields(#S_214ORDN)
*
* Group of fields to exchange with host related
* information
Group_By Name(#OUT_DATA) Fields(#S_214HOST #S_214URI)
* Group with screen fileds.
Group_By Name(#PANELDATA) Fields((#STD_INST2 *L3 *P2 *NOID *OUTPUT) (#STD_INSTR *L7 *P2 *NOID *OUTPUT) (#S_214HOST *L5 *P2))
*
* Open the JSM Service by calling SETJSMO
Execute Subroutine(OP_CL_JSM) With_Parms(OPEN)
* 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)
* Loop until F12
Begin_Loop
*
Change Field(#S_214ORDN) To(*ZEROS)
* Initialize browselist of input ordernumbers with 5
* entrie.
Inz_List Named(#INP_LIST) Num_Entrys(0000005) With_Mode(*ADD)
*
Clr_List Named(#OUT_LIST)
Change Field(#STD_INST2) To('''Specify Transaction Server Host and Port. Blank out to use a LANSA Host.''')
Change Field(#STD_INSTR) To('''Type in the Order Numbers. Press Enter''')
*
* Request the browselist of order numbers and the
* selection of the host where the service runs.
Request Fields(#PANELDATA) Browselist(#INP_LIST) Exit_Key(*YES CLS) Menu_Key(*YES CLS) Prompt_Key(*NO)
*
* Verify at least one order number was entered
Selectlist Named(#INP_LIST) Get_Entrys(*NOTNULL)
Add_Entry To_List(#OUT_LIST)
Endselect
*
* If no order number was entered redisplay request screen
*
Continue If('#LISTCOUNT = 0')
*
* 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.
Execute Subroutine(SET_URI)
*
Clr_List Named(#IN_LIST)
Exchange Fields(#OUT_DATA)
Call Process(*DIRECT) Function(SET215R) Exit_Used(*NEXT) Menu_Used(*NEXT) Pass_Lst(#OUT_LIST #IN_LIST)
*
* Verify if any errors occurred
Clr_List Named(#DSP_ORDER)
Change Field(#WK_ORDN) To(*zeros)
Selectlist Named(#IN_LIST)
*
Begincheck
* Check the status of each order
Valuecheck Field(#S_214IOST) With_List('OK') Msgid(DCM9899) Msgdta(#S_214ERRO)
Endcheck If_Error(*NEXT)
*
* There will be as many entries in the error working list
* as errors, for one order. Only add one entry per order
* number to display
If Cond('#wk_ordn *ne #s_214ordn')
Add_Entry To_List(#DSP_ORDER)
Change Field(#WK_ORDN) To(#S_214ORDN)
Endif
*
Endselect
*
Change Field(#STD_INSTR) To('''Here are your order details.''')
Display Fields((#STD_INSTR *NOID)) Browselist(#DSP_ORDER) Exit_Key(*YES CLS) Menu_Key(*YES CLS) Prompt_Key(*NO)
*
End_Loop
*
* Close JSM
CLS: Execute Subroutine(OP_CL_JSM) With_Parms(CLOSE)
Return
*
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(SET_URI)
If Cond(*LANSAHOST)
Change Field(#S_214HOST) To(#LANSAHOST)
Change Field(#S_214URI) To('set215srv')
Else
Change Field(#S_214URI) To(SET217_ORDERSTATUS_SERVICE)
Endif
*
Change Field(#S_214ERRO) To(*BLANKS)
Endroutine
*
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
*