The following sample source code can be found as member BI@P001CLP in source file DC@F28 in your LANSA data library, which is usually called DC@DTALIB.
/*=================================================================*/
/* Standard Built-In Function Provider Disclaimer */
/*=================================================================*/
/* +
Provider Name : XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX +
+
The BIF facility is a very powerful and very open interface to +
LANSA generated applications. +
+
As such, if you decide to define a user defined built in function +
or purchase other vendor supplied Built-In Functions you are +
totally responsible and totally liable for any effect whatsoever it +
has on the integrity, usability, security, maintainability or +
portability of any LANSA generated application on your system(s). +
+
Although your product vendor may assist you with Built-In Function +
definitions and maintenance, they are not responsible or liable in +
any way for its function. +
/*=================================================================*/
/* Basic Program Details */
/*=================================================================*/
/* +
Copyright : XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX, 1991. +
+
Program Name : XXXXXXX +
+
Builtin Name : XXXXXXXXXXXXXXXXXXXX +
+
Date written : DD/DD/DD +
+
Authors Name : XXXXXXXXXXXXXX +
+
Description : XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX +
XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX +
XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX +
XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX +
*/
/*=================================================================*/
/* Program Amendment History */
/*=================================================================*/
/* +
Ref Date Amendor Name Brief Description of Amendment +
--- ---- ------------ ------------------------------ +
NNNNN DD/DD/DD XXXXXXXXXXXXXX XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX +
NNNNN DD/DD/DD XXXXXXXXXXXXXX XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX +
NNNNN DD/DD/DD XXXXXXXXXXXXXX XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX +
*/
/*=================================================================*/
/* Entry Parameter List Specifications */
/*=================================================================*/
/* +
Fixed parameters (all built in functions) +
----------------------------------------- +
DC@IDS : Standard information data structure +
DC@EDS : Standard exchange data structure +
PR@IDS : Standard process information data structure +
Variable arguments and return values as per DC@F48 definition +
------------------------------------------------------------- +
B$###n : Built in function arg/ret descriptor number n. +
B@###n : Built in function arg/ret value number n. +
*/
/*=================================================================*/
BI@P###: PGM PARM(&DC@IDS &DC@EDS &PR@IDS)
/*=================================================================*/
/* Variable Declarations */
/*=================================================================*/
DCL VAR(&DC@IDS) TYPE(*CHAR) LEN(1024)
DCL VAR(&DC@EDS) TYPE(*CHAR) LEN(1024)
DCL VAR(&PR@IDS) TYPE(*CHAR) LEN(1024)
DCL VAR(&$PGMNM) TYPE(*CHAR) LEN(10)
DCL VAR(&PR@PGM) TYPE(*CHAR) LEN(10)
DCL VAR(&PR@B@N) TYPE(*CHAR) LEN(3)
DCL VAR(&PR@B@A) TYPE(*CHAR) LEN(1)
DCL VAR(&DC@RET) TYPE(*CHAR) LEN(1)
DCL VAR(&DC@MID) TYPE(*CHAR) LEN(7)
DCL VAR(&DC@MVR) TYPE(*CHAR) LEN(132)
DCL VAR(&@COPYR) TYPE(*CHAR) LEN(80) VALUE('(C) +
COPYRIGHT <<Your Organization's Name +
here>>, 1991. ALL RIGHTS RESERVED')
/*=================================================================*/
/* Global Error Handler */
/*=================================================================*/
MONMSG MSGID(CPF0000 MCH0000) EXEC(GOTO ARGERR)
/*=================================================================*/
/* Program Mainline */
/*=================================================================*/
/* Set up some fields and map some from the data structures .... */
CHGVAR &$PGMNM '??????????'
CHGVAR &PR@PGM %SST(&PR@IDS 424 10)
CHGVAR &PR@B@N %SST(&PR@IDS 157 3)
CHGVAR &PR@B@A %SST(&PR@IDS 160 1)
/* Initially assume that a "good" return will be the result .... */
CHGVAR &DC@RET 'Y'
/* Perform the required evaluation / action here ..... */
/* End of program processing logic */
ENDPGM: CHGVAR %SST(&DC@EDS 38 1) &DC@RET
CHGVAR %SST(&DC@EDS 39 7) &DC@MID
CHGVAR %SST(&DC@EDS 46 132) &DC@MVR
RETURN
/*==================================================================*/
/* ARGERR : Handle a detected error in argument(s) passed to program*/
/* Caller should set DC@MID and DC@MVR to reflect the */
/* cause of the error before executing this logic. Note that */
/* the entire program terminates when this logic is invoked. */
/* It will cause the calling RDML function to fail and issue */
/* the message details returned to it in DC@MID/DC@MVR */
/*==================================================================*/
ARGERR:
/* Route messages any additional messages back to the caller ..... */
CALL PGM(DC@P9007) PARM(&$PGMNM &PR@PGM)
MONMSG (CPF0000 MCH0000)
/* Set up a "bad" return code .... */
CHGVAR &DC@RET 'N'
MONMSG (CPF0000 MCH0000)
/* Return control to the calling program .... */
GOTO ENDPGM
/*==================================================================*/
CHGVAR VAR(%SST(&@COPYR 80 1)) VALUE(' ')
ENDPGM
