QUSCRTUI(2) - User Index APIs

User Index APIs ** ** Program . . : CBX125T ** Description : Demonstrating the use of a user index ** Author . . : Carsten Flensburg ** Published . : Club Tech iSeries Programming Tips Newsletter ** Date . . . : October 14, 2004 ** ** ** Please note the explanation of the following user index attributes: ** ** Number of entries added: ** The number of entries added to the user index. The number of ** entries currently in the index can be obtained by subtracting the ** number of entries removed from the number of entries added. ** ** Number of retrieve operations: ** The number of times either the FNDINXEN (find independent index ** entry) MI instruction or Retrieve User Index Entry (QUSRTVUI) API ** has been used on this user index. The QUSRUIAT API or MATINXAT ** (materialize independent index attributes) MI instruction sets the ** number of retrieve operations to 0 after the retrieve or materialize ** is completed. ** ** ** To run this sample program compile it as described below, start a ** debug session, call it, and then step throug the program in the ** debugger: ** ** StrDbg Pgm( CBX125T ) - Press F10 ** ** Call Pgm( CBX125T ) - Press F10 repeatedly ** ** ** Compile options: ** ** CrtRpgMod Module( CBX125T ) ** DbgView( *LIST ) ** ** CrtPgm Pgm( CBX125T ) ** Module( CBX125T ) ** ** **-- Control spec: -----------------------------------------------------** H Option( *SrcStmt ) **-- Api error data structure: D ERRC0100 Ds Qualified D BytPrv 10i 0 Inz( %Size( ERRC0100 )) D BytAvl 10i 0 D MsgId 7a D 1a D MsgDta 256a **-- Global variables: D CurNbrIdxE s 10i 0 **-- Key & entry definition: D IdxEnt Ds Qualified D Key 24a Inz( *All'Key' ) D EntDta 512a Inz( *All'Data' ) **-- User index APIs parameters: D IDXE0100 Ds Qualified D BytRtn 10i 0 D BytAvl 10i 0 D Entry Like( IdxEnt ) ** D EntLoc Ds Qualified D EntOfs 10i 0 D EntLen 10i 0 ** D RtnLib s 10a D EntAdd s 10i 0 ** D SchCri s Like( IdxEnt.Key ) D RmvCri s Like( IdxEnt.Key ) D EntNbrRtv s 10i 0 D EntNbrRmv s 10i 0 ** D IDX_NAM_Q c 'USRIDX QTEMP' D ENT_FIX c 'F' D UPD_IMD c '1' D AUT_CHG c '*CHANGE' D RPL_NO c '*NO' D IDX_OPZ_SEQ c '0' D KEY_INS_BYKEY c '1' D DOM_DFT c '*DEFAULT' ** D ENT_SCH_EQ c 1 D ENT_RMV_EQ c 1 D ENT_LOC_IGN c x'0000000000000000' D IDX_INS_RPL c 2 D CRI_OFS_FIRST c 0 D RMV_ENT_MAX c 4095 D RTN_ENT_NONE c 0 D RTN_ENT_SINGLE c 1 **-- Retrieve user index attributes parameters: D IDXA0100 Ds Qualified D BytRtn 10i 0 D BytAvl 10i 0 D IdxNam 10a D LibNam 10a D EntAtr 1a D IdxUpd 1a D KeyIns 1a D IdxOpz 1a D 4a D EntLen 10i 0 D EntLenMax 10i 0 D KeyLen 10i 0 D NbrEntAdd 10i 0 D NbrEntRmv 10i 0 D NbrRtvOpr 10i 0 **-- Create user index: D CrtUsrIdx Pr ExtPgm( 'QUSCRTUI' ) D CxIdxNamQ 20a Const D CxExtAtr 10a Const D CxEntAtr 1a Const D CxEntLen 10i 0 Const D CxKeyIns 1a Const D CxKeyLen 10i 0 Const D CxIdxUpd 1a Const D CxIdxOpz 1a Const D CxPubAut 10a Const D CxText 50a Const ** Optional 1: D CxReplace 10a Const Options( *NoPass ) D CxError 32767a Options( *NoPass: *VarSize ) ** Optional 2: D CxDomain 10a Const Options( *NoPass ) **-- Add user index entries: D AddUsrIdxE Pr ExtPgm( 'QUSADDUI' ) D AxRtnLib 10a D AxEntAdd 10i 0 D AxIdxNamQ 20a Const D AxInsTyp 10i 0 Const D AxEntry 2000a Const Options( *VarSize ) D AxEntLen 10i 0 Const D AxEntLoc 8a Const D AxEntNbr 10i 0 Const D AxError 32767a Options( *VarSize ) **-- Retrieve user index entries: D RtvUsrIdxE Pr ExtPgm( 'QUSRTVUI' ) D RxRcvVar 2008a Options( *VarSize ) D RxRcvVarLen 10i 0 Const D RxEntLoc 2000a Options( *VarSize ) D RxEntLocLen 10i 0 Const D RxEntNbrRtv 10i 0 D RxRtnLib 10a D RxIdxNamQ 20a Const D RxFmtNam 10a Const D RxMaxEnt 10i 0 Const D RxSchTyp 10i 0 Const D RxSchCri 2000a Const Options( *Varsize ) D RxSchCriLen 10i 0 Const D RxSchCriOfs 10i 0 Const D RxError 32767a Options( *VarSize ) **-- Remove user index entries: D RmvUsrIdxE Pr ExtPgm( 'QUSRMVUI' ) D RmEntNbrRmv 10i 0 D RmRcvVar 2008a Options( *VarSize ) D RmRcvVarLen 10i 0 Const D RmEntLoc 2000a Options( *VarSize ) D RmEntLocLen 10i 0 Const D RmRtnLib 10a Const D RmIdxNamQ 20a Const D RmFmtNam 10a Const D RmMaxEnt 10i 0 Const D RmRmvTyp 10i 0 Const D RmRmvCri 2000a Const Options( *Varsize ) D RmRmvCriLen 10i 0 Const D RmRmvCriOfs 10i 0 Const D RmError 32767a Options( *VarSize ) **-- Retrieve user index attributes: D RtvUsrIdxA Pr ExtPgm( 'QUSRUIAT' ) D RaRcvVar 60a Options( *VarSize ) D RaRcvVarLen 10i 0 Const D RaFmtNam 10a Const D RaIdxNamQ 20a Const D RaError 32767a Options( *VarSize ) **-- Delete user index: D DltUsrIdx Pr ExtPgm( 'QUSDLTUI' ) D DxIdxNamQ 20a Const D DxError 32767a Options( *VarSize ) **-- Get current number of entries: D GetCurNbrE Pr 10i 0 D GnIdxNamQ 20a Const ** **-- Mainline -----------------------------------------------------------** /Free CrtUsrIdx( IDX_NAM_Q : *Blanks : ENT_FIX : %Size( IdxEnt ) : KEY_INS_BYKEY : %Size( IdxEnt.Key ) : UPD_IMD : IDX_OPZ_SEQ : AUT_CHG : *Blanks : RPL_NO : ERRC0100 : DOM_DFT ); //-- Check number of current entries: CurNbrIdxE = GetCurNbrE( IDX_NAM_Q ); AddUsrIdxE( RtnLib : EntAdd : IDX_NAM_Q : IDX_INS_RPL : IdxEnt : %Size( IdxEnt ) : ENT_LOC_IGN : RTN_ENT_SINGLE : ERRC0100 ); //-- Check number of current entries: CurNbrIdxE = GetCurNbrE( IDX_NAM_Q ); //-- Set retrieve key and clear receiver: SchCri = IdxEnt.Key; IdxEnt = *Blanks; RtvUsrIdxE( IDXE0100 : %Size( IDXE0100 ) : EntLoc : %Size( EntLoc ) : EntNbrRtv : RtnLib : IDX_NAM_Q : 'IDXE0100' : 1 : ENT_SCH_EQ : SchCri : %Size( SchCri ) : CRI_OFS_FIRST : ERRC0100 ); //-- Confirm retrieved entry: IdxEnt = IDXE0100.Entry; SchCri = IdxEnt.Key; IdxEnt = *Blanks; RtvUsrIdxE( IDXE0100 : %Size( IDXE0100 ) : EntLoc : %Size( EntLoc ) : EntNbrRtv : RtnLib : IDX_NAM_Q : 'IDXE0100' : 1 : ENT_SCH_EQ : SchCri : %Size( SchCri ) : CRI_OFS_FIRST : ERRC0100 ); IdxEnt = IDXE0100.Entry; //-- Set remove key: RmvCri = IdxEnt.Key; DoW GetCurNbrE( IDX_NAM_Q ) > *Zero; RmvUsrIdxE( EntNbrRmv : IDXE0100 : RTN_ENT_NONE : EntLoc : RTN_ENT_NONE : RtnLib : IDX_NAM_Q : 'IDXE0100' : RMV_ENT_MAX : ENT_RMV_EQ : RmvCri : %Size( RmvCri ) : CRI_OFS_FIRST : ERRC0100 ); EndDo; DltUsrIdx( IDX_NAM_Q: ERRC0100 ); *InLr = *On; Return; /End-Free **-- Get current number of entries: ------------------------------------** P GetCurNbrE B D Pi 10i 0 D GnIdxNamQ 20a Const /Free RtvUsrIdxA( IDXA0100 : %Size( IDXA0100 ) : 'IDXA0100' : GnIdxNamQ : ERRC0100 ); If ERRC0100.BytAvl > *Zero; Return -1; Else; Return IDXA0100.NbrEntAdd - IDXA0100.NbrEntRmv; EndIf; /End-Free P GetCurNbrE E Thanks to Carsten Flensburg writing for Club Tech iSeries Programming Tips Newsletter