This example shows how to create and manipulate a user index with a call from an MI program. For another example using the QUSCRTUI API, see Creating Your Own Telephone Directory.
/********************************************************************/
/* */
/* PROGRAM: GLOBALV */
/* */
/* LANGUAGE: MI/IRP */
/* */
/* DESCRIPTION: MAINTAINS AN INDEPENDENT INDEX. EACH INDEX ENTRY */
/* CONTAINS 100 BYTES OF USER DATA. THE ENTRIES ARE */
/* KEYED TWO 10 BYTE VALUES: THE USER PROFILE AND A */
/* VALUE IDENTIFIER. */
/* */
/* APIs USED: QUSCRTUI */
/* */
/* PARAMETERS: */
/* */
/* PARM TYPE DESCRIPTION */
/* */
/* 1 CHAR(1) FUNCTION: */
/* */
/* 'U': UPDATE GLOBALV INFORMATION */
/* 'R': RETRIEVE GLOBALV INFORMATION */
/* */
/* 2 CHAR(10) USER PROFILE */
/* */
/* THE NAME OF THE USER PROFILE FOR WHICH */
/* INFORMATION IS TO BE SAVED OR RETRIEVED. */
/* */
/* 3 CHAR(10) VALUE ID */
/* */
/* THE NAME OF THE GLOBALV VARIABLE ID FOR WHICH */
/* INFORMATION IS TO BE SAVED OR RETRIEVED. */
/* */
/* 4 CHAR(100) VALUE */
/* */
/* IF FUNCTION IS 'U', THIS VALUE SHOULD CONTAIN */
/* THE NEW VALUE TO BE ASSOCIATED WITH THE */
/* USER ID AND VALUE ID. */
/* */
/* IF FUNCTION IS 'R', THIS VARIABLE WILL BE */
/* SET TO THE VALUE ASSOCIATED WITH THE USER ID */
/* AND VALUE ID. IF NO VALUE EXISTS, *NONE */
/* IS SPECIFIED. */
/* */
/********************************************************************/
ENTRY * (GLOBALV_PARM) EXT;
/********************************************************************/
/* PARAMETER VALUE POINTERS FOR GLOBALV. */
/********************************************************************/
DCL SPCPTR GV_REQUEST@ PARM;
DCL SPCPTR GV_USERID@ PARM;
DCL SPCPTR GV_VALUEID@ PARM;
DCL SPCPTR GV_VALUE@ PARM;
/********************************************************************/
/* PARAMETER VALUES FOR GLOBALV. */
/********************************************************************/
DCL DD GV_REQUEST CHAR(1) BAS(GV_REQUEST@);
DCL DD GV_USERID CHAR(10) BAS(GV_USERID@);
DCL DD GV_VALUEID CHAR(10) BAS(GV_VALUEID@);
DCL DD GV_VALUE CHAR(100) BAS(GV_VALUE@);
/********************************************************************/
/* PARAMETER LIST FOR GLOBALV. */
/********************************************************************/
DCL OL GLOBALV_PARM (GV_REQUEST@
,GV_USERID@
,GV_VALUEID@
,GV_VALUE@
) PARM EXT;
/********************************************************************/
/* ARGUMENT VALUES FOR CREATE USER INDEX (QUSCRTUI) API. */
/********************************************************************/
DCL DD UI_NAME CHAR(20) INIT("GLOBALV QGPL ");
DCL DD UI_ATTR CHAR(10) INIT(" ");
DCL DD UI_EATR CHAR(1) INIT("F");
DCL DD UI_ELEN BIN(4) INIT(120);
DCL DD UI_KATR CHAR(1) INIT("1");
DCL DD UI_KLEN BIN(4) INIT(20);
DCL DD UI_IUPD CHAR(1) INIT("0");
DCL DD UI_OPT CHAR(1) INIT("0");
DCL DD UI_AUT CHAR(10) INIT("*CHANGE ");
DCL DD UI_TEXT CHAR(50)
INIT("GLOBALV INDEX ");
/********************************************************************/
/* POINTERS TO ARGUMENT VALUES FOR QUSCRTUI API. */
/********************************************************************/
DCL SPCPTR UI_NAME@ INIT(UI_NAME);
DCL SPCPTR UI_ATTR@ INIT(UI_ATTR);
DCL SPCPTR UI_EATR@ INIT(UI_EATR);
DCL SPCPTR UI_ELEN@ INIT(UI_ELEN);
DCL SPCPTR UI_KATR@ INIT(UI_KATR);
DCL SPCPTR UI_KLEN@ INIT(UI_KLEN);
DCL SPCPTR UI_IUPD@ INIT(UI_IUPD);
DCL SPCPTR UI_OPT@ INIT(UI_OPT);
DCL SPCPTR UI_AUT@ INIT(UI_AUT);
DCL SPCPTR UI_TEXT@ INIT(UI_TEXT);
/********************************************************************/
/* ARGUMENT LIST FOR QUSCRTUI API. */
/********************************************************************/
DCL OL QUSCRTUI_ARG (UI_NAME@
,UI_ATTR@
,UI_EATR@
,UI_ELEN@
,UI_KATR@
,UI_KLEN@
,UI_IUPD@
,UI_OPT@
,UI_AUT@
,UI_TEXT@
) ARG;
/********************************************************************/
/* SYTSEM POINTER TO QUSCRTUI API *PGM OBJECT. */
/********************************************************************/
DCL SYSPTR QUSCRTUI INIT("QUSCRTUI",TYPE(PGM));
/********************************************************************/
/* SYSTEM POINTER TO GLOBALV *USRIDX OBJECT. */
/********************************************************************/
DCL SYSPTR INX@;
DCL DD INX_OBJECTID CHAR(34);
DCL DD INX_OBJECTID_TYPE CHAR(2) DEF(INX_OBJECTID) POS(1)
INIT(X'0E0A');
DCL DD INX_OBJECTID_NAME CHAR(30) DEF(INX_OBJECTID) POS(3)
INIT('GLOBALV ');
DCL DD INX_OBJECTID_AUT CHAR(2) DEF(INX_OBJECTID) POS(33)
INIT(X'0000');
/********************************************************************/
/* EXCEPTION MONITOR TO DETECT 2201X EXCEPTIONS (OBJECT NOT FOUND) */
/********************************************************************/
DCL EXCM EXCM_NOOBJECT EXCID(H"2201") INT(CREATE_INDEX) IMD;
/********************************************************************/
/* PASA INVOCATION ENTRY FOR RETURN FROM EXCEPTION. */
/********************************************************************/
DCL DD RTN_NOOBJECT CHAR(18) BDRY(16);
DCL SPCPTR RTN_NOOBJECT@ INIT(RTN_NOOBJECT);
DCL DD RTN_NOOBJECT_ADDR CHAR(16) DEF(RTN_NOOBJECT);
DCL DD RTN_NOOBJECT_OPT CHAR(1) DEF(RTN_NOOBJECT) POS(18)
INIT(X'00');
/********************************************************************/
/* RECEIVER VARIABLE FOR INDEPENDENT INDEX OPERATIONS. */
/********************************************************************/
DCL DD INX_RECEIVER CHAR(120);
DCL SPCPTR INX_RECEIVER@ INIT(INX_RECEIVER);
/********************************************************************/
/* OPTION TEMPLATE FOR INDEPENDENT INDEX OPERATIONS. */
/********************************************************************/
DCL DD INX_OPT CHAR(14);
DCL SPCPTR INX_OPT@ INIT(INX_OPT);
DCL SPC INX_OPT_SPC BAS(INX_OPT@);
DCL DD INX_OPT_RULE CHAR(2) DIR;
DCL DD INX_OPT_ARGL BIN(2) DIR;
DCL DD INX_OPT_ARGO BIN(2) DIR;
DCL DD INX_OPT_OCCC BIN(2) DIR;
DCL DD INX_OPT_RTNC BIN(2) DIR;
DCL DD INX_OPT_ELEN BIN(2) DIR;
DCL DD INX_OPT_EOFF BIN(2) DIR;
/********************************************************************/
/* ARGUMENT VARIABLE FOR INDEPENDENT INDEX OPERATIONS. */
/********************************************************************/
DCL DD INX_ARG CHAR(120);
DCL SPCPTR INX_ARG@ INIT(INX_ARG);
/********************************************************************/
/* START OF CODE */
/********************************************************************/
MATINVE RTN_NOOBJECT_ADDR,*,X'03'; /* MATERIALIZE THIS PROGRAM'S */
/* INVOCATION ENTRY IN THE */
/* PASA. THIS ENTRY IS USED */
/* WHEN RETURNING FROM THE */
/* EXCEPTION HANDLER BELOW. */
RSLVSP INX@,INX_OBJECTID,*,*; /* RESOLVE TO "GLOBALV" USER INDEX */
/* OBJECT. IF THE OBJECT DOES NOT */
/* EXIST, THEN THE X'2201' EXCEPTION*/
/* IS RETURNED, CAUSING THE "OBJECT */
/* NOT FOUND" EXCEPTION HANDLER AT */
/* THE END OF THE PROGRAM TO RUN. */
CMPBLA(B) GV_REQUEST,'U'/NEQ(NOT_UPDATE); /* IF GV_REQUEST ¬= U */
/* BRANCH TO NOT_UPDATE */
/* SET UP OPTIONS FOR INSERT INDEPENDENT INDEX ENTRY (INSINXEN) */
/* OPERATION. */
CPYBLA INX_OPT_RULE,X'0002'; /* RULE= INSERT. */
CPYNV INX_OPT_OCCC,1; /* OCCURRENCE COUNT = 1. */
CPYBLA INX_ARG(1:10),GV_USERID; /* SPECIFY INDEX ENTRY. */
CPYBLA INX_ARG(11:10),GV_VALUEID;
CPYBLA INX_ARG(21:100),GV_VALUE;
INSINXEN INX@,INX_ARG@,INX_OPT@; /* INSERT THE INDEX ENTRY. */
RTX *; /* RETURN */
NOT_UPDATE:
CMPBLA(B) GV_REQUEST,'R'/NEQ(NOT_RETRIEVE); /* IF GV_REQUEST ¬= R */
/* GOTO NOT_RETRIEVE. */
/* SET UP OPTIONS FOR FIND INDEPENDENT INDEX ENTRY (FNDINXEN) */
/* OPERATION. */
CPYBLA INX_OPT_RULE,X'0001'; /* RULE= FIND WITH EQUAL KEY. */
CPYNV INX_OPT_ARGL,20; /* ARGUMENT LENGTH= 20. */
CPYNV INX_OPT_OCCC,1; /* OCCURRENCE COUNT=1. */
CPYBLA INX_ARG(1:10),GV_USERID; /* SPECIFY SEARCH ARGUMENT. */
CPYBLA INX_ARG(11:10),GV_VALUEID;
FNDINXEN INX_RECEIVER@,INX@,INX_OPT@,INX_ARG@; /* FIND ENTRY. */
CMPNV(B) INX_OPT_RTNC,1/EQ(FOUND_ENTRY); /* IF RETURN_COUNT = 1 */
/* GOTO FOUND_ENTRY. */
CPYBLAP GV_VALUE,'*NONE',' '; /* ENTRY WAS NOT FOUND, SPECIFY */
/* VALUE OF *NONE. */
RTX *; /* RETURN */
FOUND_ENTRY:
CPYBLA GV_VALUE,INX_RECEIVER(21:100); /* ENTRY WAS FOUND, */
/* COPY VALUE TO USER */
/* PARAMETER. */
RTX *; /* RETURN */
NOT_RETRIEVE:
RTX *; /* UNKNOWN FUNCTION CODE. RETURN. */
/********************************************************************/
/* "OBJECT NOT FOUND" EXCEPTION HANDLER. */
/********************************************************************/
ENTRY CREATE_INDEX INT;
MODEXCPD EXCM_NOOBJECT,X'0000',X'01'; /* TURN OFF EXCEPTION */
/* MONITOR. */
CALLX QUSCRTUI,QUSCRTUI_ARG,*; /* USE QUSCRTUI API TO CREATE THE */
/* USER INDEX OBJECT. */
RTNEXCP RTN_NOOBJECT@; /* RETURN FROM THE EXCEPTION HANDLER AND */
/* RETRY THE OPERATION. */
PEND;