Server System Variables

At times within a Visual LANSA application, we require information such as system date and time to come from an iSeries server instead of from the local Windows machine. There have been a number of questions recently from the LANSA community on how to make this happen.

Over the course of the last year, I spent a great deal of time thinking through this issue and testing alternatives.  Here are all of the pieces of the cross-machine calling architecture that I built for system variables.  There is a similar architecture for executing business logic on the server.

There is  overhead having a system variable invoking a deriver that calls a BIF that calls a function that returns the value.  This is required, however, due to a severe limitation on system variable derivation functions.  They are not allowed to call other functions. But they are allowed to invoke BIFs.

If you need clarification or have issues, feel free to contact me.

System Variable

The system variable is defined in the data dictionary.  All system variables that must run on the iSeries are prefixed by I# so *I#YYYYMMDD returns the iSeries value of *YYYYMMDD.  As shown below, there are two derivation functions: one for numeric and one for alpha.  Since this date is numeric, we use the numeric deriver.

System Variable Derivation Function

Both the numeric and alphanumeric derivation functions are shown below. Each function uses a user-defined BIF to perform the cross-machine function call.  We do this because functions defined as system variable derivers have severe limitations on what they can call.  BIF deriver functions do not have those limitations.

[codesyntax title=”Numeric System Variable Deriver”]

function options(*DIRECT *NOMESSAGES *HEAVYUSAGE *NUM_SYSTEM_VARIABLE)
define field(#@SVVALUE) reffld(#SYSVAR$NV)
use builtin(UD_I#SYSVARNUM) with_args(#SYSVAR$NM) to_get(#@SVVALUE #$RETCODE)
if cond(‘#$RETCODE *EQ OK’)
change field(#SYSVAR$NV) to(#@SVVALUE)
else
change field(#SYSVAR$NV) to(*NULL)
endif
return[/codesyntax]

[codesyntax title=”Alphanumeric System Variable Deriver”]

function options(*DIRECT *NOMESSAGES *HEAVYUSAGE *ALP_SYSTEM_VARIABLE)
define field(#@SVVALUE) reffld(#SYSVAR$AV)
use builtin(UD_I#SYSVARALP) with_args(#SYSVAR$NM) to_get(#@SVVALUE #$RETCODE)
if cond(‘#$RETCODE *EQ OK’)
change field(#SYSVAR$AV) to(#@SVVALUE)
else
change field(#SYSVAR$AV) to(*NULL)
endif
return[/codesyntax]

Director

This architecture uses BIFs and implements a Director/Worker model.  The BIF deriver function (the Director) determines whether it is running on the iSeries or not.  If it is, it executes the worker function via CALL.  If not, it executes the worker function via CALL_SERVER_FUNCTION.

You will need to change NBIFWRK to the name of your numeric worker function and ABIFWRK to the name of your alphanumeric worker function.  This version of call server function uses *SSERVER_SSN which assumes our app is running over a client to iSeries connection.  If your app is local Windows application, you can just as easily hard code the name of your server.
[codesyntax title=”Numeric Director”]
function options(*DIRECT *NOMESSAGES *HEAVYUSAGE *BUILTIN)

define field(#BIF_NAME) type(*CHAR) length(20) desc(‘iSeries Sys Var Derivation: Numeric’) default(UD_I#SYSVARNUM)
define field(#BIF_ARG01) type(*CHAR) length(20) desc(‘System variable name’)
define field(#BIF_RET01) type(*DEC) length(30) decimals(9) desc(‘Value of iSeries numeric system variable’)
define field(#BIF_RET02) type(*CHAR) length(2) desc(‘Return code’)
define field(#@SVNAME) type(*CHAR) length(20) desc(‘System variable name’)
define field(#@SVVALUE) type(*DEC) length(30) decimals(9) desc(‘Value of iSeries numeric system variable’)

change field(#@SVNAME) to(#BIF_ARG01)
change field(#BIF_RET02) to(OK)
change field(#@SVVALUE) to(*NULL)

if cond(‘#CPUTYPE *EQ AS400’)
execute subroutine(ONSERVER)
else
execute subroutine(ONCLIENT)
endif

change field(#BIF_RET01) to(#@SVVALUE)
return

subroutine name(ONSERVER)
exchange fields(#@SVNAME)
call process(*DIRECT) function(NBIFWRK) exit_used(ER1) menu_used(ER1) if_error(ER1)
change field(#BIF_RET02) to(#$RETCODE)
return
ER1: change field(#$RETCODE #BIF_RET02) to(ER)
endroutine

subroutine name(ONCLIENT)
exchange fields(#@SVNAME)
use builtin(CALL_SERVER_FUNCTION) with_args(*SSERVER_SSN NBIFWRK Y Y) to_get(#$CSFRTNCD)

if cond(‘(#$CSFRTNCD *NE OK) *OR (#$RETCODE *NE OK)’)
if cond(‘(#$RETCODE *NE OK)’)
change field(#BIF_RET02) to(#$RETCODE)
else
change field(#BIF_RET02) to(ER)
endif
endif
endroutine
[/codesyntax]

[codesyntax title=”Alphanumeric Director”]
function options(*DIRECT *NOMESSAGES *HEAVYUSAGE *BUILTIN)

define field(#BIF_NAME) type(*CHAR) length(20) desc(‘iSeries Sys Var Derivation: Alphanumeric’) default(UD_I#SYSVARALP)
define field(#BIF_ARG01) type(*CHAR) length(20) desc(‘System variable name’)
define field(#BIF_RET01) type(*CHAR) length(256) desc(‘Value of iSeries alpha system variable’)
define field(#BIF_RET02) type(*CHAR) length(2) desc(‘Return code’)
define field(#@SVNAME) type(*CHAR) length(20) desc(‘System variable name’)
define field(#@SVVALUE) type(*CHAR) length(256) desc(‘Value of iSeries alpha system variable’)

change field(#@SVNAME) to(#BIF_ARG01)
change field(#BIF_RET02) to(OK)
change field(#@SVVALUE) to(*NULL)

if cond(‘#CPUTYPE *EQ AS400’)
execute subroutine(ONSERVER)
else
execute subroutine(ONCLIENT)
endif
change field(#BIF_RET01) to(#@SVVALUE)
return

subroutine name(ONSERVER)
exchange fields(#@SVNAME)
call process(*DIRECT) function(ABIFW) exit_used(ER1) menu_used(ER1) if_error(ER1)
change field(#BIF_RET02) to(#$RETCODE)
return
ER1: change field(#$RETCODE #BIF_RET02) to(ER)
endroutine

subroutine name(ONCLIENT)
exchange fields(#@SVNAME)
use builtin(CALL_SERVER_FUNCTION) with_args(*SSERVER_SSN ABIFWRK Y Y) to_get(#$CSFRTNCD)

if cond(‘(#$CSFRTNCD *NE OK) *OR (#$RETCODE *NE OK)’)
if cond(‘(#$RETCODE *NE OK)’)
change field(#BIF_RET02) to(#$RETCODE)
else
change field(#BIF_RET02) to(ER)
endif
endif
endroutine
[/codesyntax]

Worker

The Worker function always executes on the iSeries but we still check to make sure.  Any field name starting with a dollar sign is defined in the data dictionary.  For instance #$PARENL is *CHAR 1 DEFAULT(‘(‘).
[codesyntax title=”Numeric Worker”]
* Passed Parms:
* #@SVNAME   *char 20  System variable name
* Returned Parms:
* #@SVVALUE  *dec 30,9 System variable return value
* #$RETCODE  *char 2
function options(*DIRECT *HEAVYUSAGE)
exchange fields(#$RETCODE) option(*ALWAYS)
define field(#@SVNAME) type(*CHAR) length(20) desc(‘System variable name’)
define field(#@SVVALUE) type(*DEC) length(30) decimals(9) desc(‘Value of iSeries numeric system variable’)

change field(#$RETCODE) to(OK)
change field(#@SVVALUE) to(*NULL)

if cond(‘#CPUTYPE *EQ AS400’)
execute subroutine(PROCESS)
else
execute subroutine(INVOKEERR)
endif

exchange fields(#@SVVALUE)
return

subroutine name(PROCESS)

* Which system variable are we processing?
case of_field(#@SVNAME)

when value_is(‘= ”*I#CPU_NUMBER”’)
change field(#@SVVALUE) to(*CPU_NUMBER)

when value_is(‘= ”*I#DATE”’)
change field(#@SVVALUE) to(*DATE)

when value_is(‘= ”*I#DATE8”’)
change field(#@SVVALUE) to(*DATE8)

when value_is(‘= ”*I#DATETIME”’)
change field(#@SVVALUE) to(*DATETIME)

when value_is(‘= ”*I#DAY”’)
change field(#@SVVALUE) to(*DAY)

when value_is(‘= ”*I#DDMMYY”’)
change field(#@SVVALUE) to(*DDMMYY)

when value_is(‘= ”*I#DDMMYYYY”’)
change field(#@SVVALUE) to(*DDMMYYYY)

when value_is(‘= ”*I#JULIAN”’)
change field(#@SVVALUE) to(*JULIAN)

when value_is(‘= ”*I#MMDDYY”’)
change field(#@SVVALUE) to(*MMDDYY)

when value_is(‘= ”*I#MMDDYYD”’)
change field(#@SVVALUE) to(*MMDDYYD)

when value_is(‘= ”*I#MMDDYYYY”’)
change field(#@SVVALUE) to(*MMDDYYYY)

when value_is(‘= ”*I#MMDDYYYYD”’)
change field(#@SVVALUE) to(*MMDDYYYYD)

when value_is(‘= ”*I#MONTH”’)
change field(#@SVVALUE) to(*MONTH)

when value_is(‘= ”*I#TIME”’)
change field(#@SVVALUE) to(*TIME)

when value_is(‘= ”*I#TIMEDATE”’)
change field(#@SVVALUE) to(*TIMEDATE)

when value_is(‘= ”*I#TIMEDATE8”’)
change field(#@SVVALUE) to(*TIMEDATE8)

when value_is(‘= ”*I#TOMORROW”’)
change field(#@SVVALUE) to(*TOMORROW)

when value_is(‘= ”*I#YEAR”’)
change field(#@SVVALUE) to(*YEAR)

when value_is(‘= ”*I#YESTERDAY”’)
change field(#@SVVALUE) to(*YESTERDAY)

when value_is(‘= ”*I#YYMMDD”’)
change field(#@SVVALUE) to(*YYMMDD)

when value_is(‘= ”*I#YYYY”’)
change field(#@SVVALUE) to(*YYYY)

when value_is(‘= ”*I#YYYYMMDD”’)
change field(#@SVVALUE) to(*YYYYMMDD)

when value_is(‘= ”*I#YYYYMMDDD”’)
change field(#@SVVALUE) to(*YYYYMMDDD)

endcase

return

ERR: change field(#$RETCODE) to(ER)
return

endroutine

subroutine name(INVOKEERR)

define field(#@TEXT) type(*CHAR) length(80)
change field(#@TEXT) to(”’must be invoked on the iSeries”’)
use builtin(BCONCAT) with_args(#FUNCDESC #$PARENL #FUNCTION #$PARENR #@TEXT) to_get(#@TEXT)
use builtin(MESSAGE_BOX_SHOW) with_args(*DFT *DFT *DFT *DFT #@TEXT)

change field(#$RETCODE) to(ER)

endroutine
[/codesyntax]

[codesyntax title=”Alphanumeric Worker”]
* Passed Parms:
* #@SVNAME *char 20 System variable name
* Returned Parms:
* #@SVVALUE *char 256 System variable return value
* #$RETCODE *char 2
function options(*DIRECT *HEAVYUSAGE)
exchange fields(#$RETCODE) option(*ALWAYS)
define field(#@SVNAME) type(*CHAR) length(20) desc(‘System variable name’)
define field(#@SVVALUE) type(*CHAR) length(256) desc(‘Value of iSeries alpha system variable’)

change field(#$RETCODE) to(OK)
change field(#@SVVALUE) to(*NULL)

if cond(‘#CPUTYPE *EQ AS400’)
execute subroutine(PROCESS)
else
execute subroutine(INVOKEERR)
endif

exchange fields(#@SVVALUE)
return

subroutine name(PROCESS)
use builtin(UPPERCASE) with_args(#@SVNAME) to_get(#@SVNAME)

* Which system variable are we processing?
case of_field(#@SVNAME)

when value_is(‘= ”*I#DATE8C”’)
change field(#@SVVALUE) to(*DATE8C)

when value_is(‘= ”*I#DATEC”’)
change field(#@SVVALUE) to(*DATEC)

when value_is(‘= ”*I#DATETIMEC”’)
change field(#@SVVALUE) to(*DATETIMEC)

when value_is(‘= ”*I#DAYC”’)
change field(#@SVVALUE) to(*DAYC)

when value_is(‘= ”*I#DDMMYYC”’)
change field(#@SVVALUE) to(*DDMMYYC)

when value_is(‘= ”*I#DDMMYYYYC”’)
change field(#@SVVALUE) to(*DDMMYYYYC)

* when value_is(‘= ”*I#ENVIRONMENT”’)
* change field(#@SVVALUE) to(*ENVIRONMENT)

when value_is(‘= ”*I#EXTENDEDDATETIME”’)
change field(#@SVVALUE) to(*EXTENDEDDATETIME)

when value_is(‘= ”*I#GROUP_AUTHORITY”’)
change field(#@SVVALUE) to(*GROUP_AUTHORITY)

when value_is(‘= ”*I#GROUP_OWNER”’)
change field(#@SVVALUE) to(*GROUP_OWNER)

when value_is(‘= ”*I#GROUP_PROFILE”’)
change field(#@SVVALUE) to(*GROUP_PROFILE)

when value_is(‘= ”*I#GUIDEVICE”’)
change field(#@SVVALUE) to(*GUIDEVICE)

when value_is(‘= ”*I#JOBMODE”’)
change field(#@SVVALUE) to(*JOBMODE)

when value_is(‘= ”*I#JOBNAME”’)
change field(#@SVVALUE) to(*JOBNAME)

when value_is(‘= ”*I#JOBNBR”’)
change field(#@SVVALUE) to(*JOBNBR)

when value_is(‘= ”*I#JULIANC”’)
change field(#@SVVALUE) to(*JULIANC)

when value_is(‘= ”*I#MMDDYYYYC”’)
change field(#@SVVALUE) to(*MMDDYYYYC)

when value_is(‘= ”*I#MONTHC”’)
change field(#@SVVALUE) to(*MONTHC)

when value_is(‘= ”*I#SHDN”’)
change field(#@SVVALUE) to(*SHDN)

when value_is(‘= ”*I#TIMEC”’)
change field(#@SVVALUE) to(*TIMEC)

when value_is(‘= ”*I#TIMEDATE8C”’)
change field(#@SVVALUE) to(*TIMEDATE8C)

when value_is(‘= ”*I#TIMEDATEC”’)
change field(#@SVVALUE) to(*TIMEDATEC)

when value_is(‘= ”*I#TIMESTAMP_DFT”’)
change field(#@SVVALUE) to(*TIMESTAMP_DFT)

when value_is(‘= ”*I#TIMESTAMP_HIVAL”’)
change field(#@SVVALUE) to(*TIMESTAMP_HIVAL)

when value_is(‘= ”*I#TIMESTAMP_LOVAL”’)
change field(#@SVVALUE) to(*TIMESTAMP_LOVAL)

when value_is(‘= ”*I#YEARC”’)
change field(#@SVVALUE) to(*YEARC)

when value_is(‘= ”*I#YYMMDDC”’)
change field(#@SVVALUE) to(*YYMMDDC)

when value_is(‘= ”*I#YYYYC”’)
change field(#@SVVALUE) to(*YYYYC)

when value_is(‘= ”*I#YYYYMMDDC”’)
change field(#@SVVALUE) to(*YYYYMMDDC)

endcase
return

ERR: change field(#$RETCODE) to(ER)
return
endroutine

subroutine name(INVOKEERR)
define field(#@TEXT) type(*CHAR) length(80)
change field(#@TEXT) to(”’must be invoked on the iSeries”’)
use builtin(BCONCAT) with_args(#FUNCDESC #$PARENL #FUNCTION #$PARENR #@TEXT) to_get(#@TEXT)
use builtin(MESSAGE_BOX_SHOW) with_args(*DFT *DFT *DFT *DFT #@TEXT)
change field(#$RETCODE) to(ER)
endroutine
[/codesyntax]

Posted on March 24, 2011, in Lansa. Bookmark the permalink. Comments Off on Server System Variables.

Comments are closed.