UIM Panel Group
UIM a display without DDS.
What is a Panel Group
List panels are a powerful feature of the User Interface Manager (UIM). You can use them in place of subfiles to present lists of information on the screen. The Create Panel Group (CRTPNLGRP) command creates panel groups that contain online help information, which can be shown in conjunction with your data description specifications (DDS) displays, CL commands, or a search index.
This UIM example is typical of a panel group created for list presentation. IBM provides APIs to generate lists and UIM is a good tool to make use of the list data. In this case, the panel group was created to display a list of file fields.
.*===================================================================== .* WRKFFLPG : Panel group for WRKFFLDSC command .* Author : Steve Croy, iSoftwerks, Inc. .* To compile: .* CRTPNLGRP PNLGRP(XXX/YTDSOFPG) SRCFILE(XXX/QMNUSRC) .*===================================================================== :PNLGRP. .*===================================================================== .* Define clases .*===================================================================== :CLASS NAME=optcls BASETYPE=action. :ECLASS. :CLASS NAME=objcls BASETYPE='OBJNAME 10'. :ECLASS. :CLASS NAME=lencls BASETYPE='CHAR 4'. :ECLASS. :CLASS NAME=deccls BASETYPE='CHAR 1'. :ECLASS. :CLASS NAME=attcls BASETYPE='CHAR 1'. :ECLASS. :CLASS NAME=txtcls BASETYPE='CHAR 30'. :ECLASS. :CLASS NAME=prmcls BASETYPE='CHAR 255'. :ECLASS. .*===================================================================== .* Define variables .*===================================================================== :VAR NAME=opt CLASS=optcls. :VAR NAME=filNam CLASS=objcls. :VAR NAME=fdNam CLASS=objcls. :VAR NAME=fdlen CLASS=lencls. :VAR NAME=fdTyp CLASS=attcls. :VAR NAME=fdIbf CLASS=lencls. :VAR NAME=fdObf CLASS=lencls. :VAR NAME=fdDig CLASS=lencls. :VAR NAME=fdDec CLASS=deccls. :VAR NAME=FdTxt CLASS=txtcls. :VAR NAME=prm CLASS=prmcls. .*==================================================================== .* Define variable records and list definition .*==================================================================== :VARRCD NAME=header VARS='filnam' NOGET='filnam'. :VARRCD NAME=detail VARS='opt fdNam fdLen fdTyp fdIbf fdObf fdDig fdDec fdTxt' NOGET='fdNam fdLen fdTyp fdIbf fdObf fdDig fdDec fdTxt'. :LISTDEF NAME=detlst VARS='opt fdNam fdLen fdTyp fdIbf fdObf fdDig fdDec fdTxt'. .*===================================================================== .* Define function keys .*===================================================================== :KEYL NAME=fkeys. :KEYI KEY=enter HELP=genhlp ACTION=enter. :KEYI KEY=f1 HELP=genhlp ACTION=help. :KEYI KEY=F3 HELP=genhlp ACTION='RETURN 3' VARUPD=no. F3=Exit :KEYI KEY=f4 HELP=genhlp ACTION=prompt.F4=Prompt :KEYI KEY=f5 HELP=genhlp ACTION='RETURN 5' VARUPD=NO.F5=Refresh :KEYI KEY=f9 HELP=genhlp ACTION=retrieve.F9=Retrieve :KEYI KEY=f12 HELP=genhlp ACTION='CANCEL SET' VARUPD=no. F12=Cancel :KEYI KEY=help HELP=genhlp ACTION=help. :KEYI KEY=pagedown HELP=genhlp ACTION=pagedown. :KEYI KEY=pageup HELP=genhlp ACTION=pageup. :KEYI KEY=print HELP=genhlp ACTION=print. :EKEYL. .*===================================================================== .* Define the panel .*===================================================================== :PANEL NAME=WRKFFLD HELP=genhlp KEYL=fkeys TOPSEP=space.Display File Fields :DATA DEPTH=2. :DATACOL WIDTH=16. :DATACOL WIDTH=10. :DATAGRP GRPSEP=qindent HELP=genhlp COMPACT. :DATAI VAR=filnam USAGE=out.File :EDATAGRP. :EDATA. .*===================================================================== .* Define the list .*===================================================================== :LIST DEPTH=16 LISTDEF=detlst MAXHEAD=1 ACTOR=uim PARMS=prm. :TOPINST .Type options, press Enter. :LISTACT ENTER='CMD HAWKEYE/DSPFILX FILE(&filNam.) FIELD(&fdNam.) &prm' PROMPT='CMD ?HAWKEYE/DSPFILX FILE(&filNam.) FIELD(&fdNam.) &prm.' HELP=genhlp OPTION=3.3=Display file x-ref :LISTACT ENTER='CMD HAWKEYE/DSPFLDU FIELD(&fdNam.) FILE(&filNam.) &prm' PROMPT='CMD ?HAWKEYE/DSPFLDU FIELD(&fdNam.) FILE(&filNam.) &prm.' HELP=genhlp OPTION=5.5=Display field use :LISTCOL VAR=opt USAGE=inout MAXWIDTH=3 HELP=genhlp.Opt :LISTCOL VAR=fdNam USAGE=out MAXWIDTH=10 HELP=genhlp.Field :LISTCOL VAR=fdLen USAGE=out MAXWIDTH=4 HELP=genhlp.Len :LISTCOL VAR=fdTyp USAGE=out MAXWIDTH=1 HELP=genhlp.T :LISTCOL VAR=fdIbf USAGE=out MAXWIDTH=4 HELP=genhlp.From :LISTCOL VAR=fdObf USAGE=out MAXWIDTH=4 HELP=genhlp.To :LISTCOL VAR=fdDig USAGE=out MAXWIDTH=4 HELP=genhlp.Nbr :LISTCOL VAR=fdDec USAGE=out MAXWIDTH=1 HELP=genhlp.D :LISTCOL VAR=fdTxt USAGE=out MAXWIDTH=30 HELP=genhlp.Text :LISTVIEW COLS='opt fdNam fdLen fdTyp fdIbf fdObf fdDig fdDec fdTxt'. :ELIST. :CMDLINE SIZE=short.Parameters or command :EPANEL. .*===================================================================== .* Define help .*===================================================================== :HELP NAME=genhlp. :EHELP. :EPNLGRP.
The RPG program was written to use the panel group above. The UIM APIs are highlighted in red in the source code. The Open Display Application (QUIOPNDA) API initiates a UIM display by opening the panel group the program specified. On exit the Close Application (QUICLOA) API is invoked to close the UIM display application. The program is bound to a service program which creates the list.
*=====================================================================*
* Author : Steve Croy *
* Date : 02.15.2005 *
* E-mail : scroy@isoftwerks.net *
* Homepage: www.isoftwerks.net *
*=====================================================================*
* *
* This software is free software, you can redistribute it and/or *
* modify it under the terms of the GNU General Public License (GPL) *
* as published by the Free Software Foundation. *
* *
* See GNU General Public License for details. *
* http://www.opensource.org *
* http://www.opensource.org/licenses/gpl-license.html *
* *
*=====================================================================*
* >>Compile Instructions<< *
* *
* >>CRTCMD<< CRTRPGMOD MODULE(&LI/&OB) + *
* SRCFILE(&SL/&SF) + *
* SRCMBR(&SM); *
* *
* >>COMPILE<< *
* >>PARM<< TRUNCNBR(*NO); *
* >>PARM<< DBGVIEW(*LIST); *
* >>END-COMPILE<< *
* *
* >>EXECUTE<< *
* *
* >>CMD<< CRTPGM PGM(&LI/&OB) + *
* MODULE(*PGM) + *
* BNDSRVPGM(&LI/RTVFLDL) + *
* ACTGRP(QILE); *
* *
*=====================================================================*
H EXTBININT(*YES)
H DATFMT(*ISO) TIMFMT(*ISO) DEBUG(*YES)
H OPTION(*SRCSTMT : *NODEBUGIO) DFTACTGRP(*NO) ACTGRP('QILE')
H BNDDIR('SC0000_BD')
*=====================================================================*
*
/COPY PRTVFLDL
*
* Reference fields
/IF NOT DEFINED (msg_t)
/DEFINE msg_t
D msg_t E DS extname(XDMSG ) based(pDummy)
D prefix(msg_t_ )
/ENDIF
*
D WRKFFLRP PR extpgm('WRKFFLRP')
D gi_file_1 10A const
D gi_lib_1 10A const
D gi_mbr_1 10A const
D gi_ord_1 10A const
*
* Prototype for internal function
D p_main...
D PR
D i_file_1 10A const
D i_lib_1 10A const
D i_mbr_1 10A const
D i_ord_1 10A const
*
* Global Constants
*
D cTrue C const(*on )
D cFalse C const(*off)
*
********************************************************************
* Program procedure interface
********************************************************************
D WRKFFLRP PI
D gi_file_1 10A const
D gi_lib_1 10A const
D gi_mbr_1 10A const
D gi_ord_1 10A const
*
/free
MONITOR;
Callp p_main(gi_file_1:gi_lib_1:gi_mbr_1:gi_ord_1);
ON-ERROR;
ENDMON;
*inlr = *on;
/end-free
*==================================================================*
* Main Procedure
*==================================================================*
*
P p_main...
P B export
*
D p_main...
D PI
D i_file_1 10A const
D i_lib_1 10A const
D i_mbr_1 10A const
D i_ord_1 10A const
*
D OpenPanel PR extpgm('QUIOPNDA')
D Handle 8A
D pnlgrp 20A
D Appscp 9B 0
D Extprm 9B 0
D Fulhlp 1A
D Errcod 9B 0
*
D PutName PR extpgm('QUIPUTV')
D Handle 8A
D FilNam 10A
D Varlen 9B 0
D Rcdnam 10A
D Errcod 9B 0
*
D AddData PR extpgm('QUIADDLE')
D Handle 8A
D Varbuf 60A
D Varlen 9B 0
D Rcdnam 10A
D Lstnam 10A
D Option 4A
D Lenhdl 4A
D Errcod 9B 0
*
D DspPanel pr extpgm('QUIDSPP')
D Handle 8A
D Fkey 9B 0
D Pnlnam 10A
D Redspo 10A
D Errcod 9B 0
*
D DltList pr extpgm('QUIDLTL')
D Handle 8A
D Lstnam 10A
D Errcod 9B 0
D ClosePnl pr extpgm('QUICLOA')
D Handle 8A
D ClosOpt 1A
D Errcod 9B 0
* Local workfields
*
D isDone1 S N inz
D handle1 S like(fldLst_handle_t) inz
D data S like(data_1) inz
D PNLGRP S 20A INZ('WRKFFLPG *LIBL ')
D Appscp S 9B 0
D Extprm S 9B 0
D Errcod S 9B 0
D filnam S 10A
D Fkey S 9B 0
D Varlen S 9B 0
D Lib S 10A
D Handle S 8A
D Fulhlp S 1A
D Rcdnam S 10A
D Option S 4A
D Lstnam S 10A
D Lenhdl S 4A
D Pnlnam S 10A
D Redspo S 10A
D ClosOpt S 1A
D frompos S 4S 0
D topos S 4S 0
*
D Varbuf DS
D Opt 1 2B 0
D fdNam 3 12
D fdLen 13 16
D fdTyp 17 17
D fdIbf 18 21
D fdObf 22 25
D fdDig 26 29
D fdDec 30 30
D fdTxt 31 60
*
D data_1 E DS extname(XDFLDL0100) inz
D prefix(data_1_ )
*
D panel_dspl E DS extname(xdfldl0100)
*
D ok S 1A inz
D msg S like(msg_t ) inz
*-------------------------------------------------------------------
* Start main block
*-------------------------------------------------------------------
/free
Clear panel_dspl;
//* open panel group
appscp = -1;
fulhlp = 'N';
OpenPanel(handle: pnlgrp : appscp: extprm: fulhlp: errcod);
//* Put file name on panel
filnam = i_file_1;
Varlen = %size(filnam);
Rcdnam= 'HEADER';
PutName(handle: filnam : Varlen: Rcdnam: errcod);
DOU FKEY = 3 or FKEY = 12;
// open file
isDone1 = f_opnFldLst(i_file_1 :
i_lib_1 :
i_mbr_1 :
i_ord_1 :
handle1 :
msg );
// get file handle
isDone1 = f_getFirstFld(handle1 : data );
If isDone1;
data_1 = data;
Else;
Clear data_1;
Endif;
OPTION = 'FRST';
Dow isDOne1;
// put data to the buffer
frompos = data_1_InBufPos;
topos = data_1_InBufPos + (data_1_length - 1);
OPT = 0;
fdNam = data_1_name;
evalr fdLen = %editc(data_1_length:'Z');
fdTyp = data_1_type;
evalr fdIbf = %editc(frompos:'Z');
evalr fdObf = %editc(topos:'Z');
evalr fdDig = %editc(data_1_digits:'Z');
evalr fdDec = %editc(data_1_decpos:'Z');
fdTxt = data_1_text;
Rcdnam= 'DETAIL';
LstNam= 'DETLST';
Varlen = %size(Varbuf);
AddData(handle:
VarBuf :
Varlen :
rcdnam :
lstnam :
option :
lenhdl :
errcod);
option = 'NEXT';
// get next field
isDone1 = f_getNextFld(handle1: data);
IF isDone1;
data_1 = data;
ELSE;
CLEAR data_1;
ENDIF;
ENDDO;
//------------------------------- Close file
isDone1 = f_cloFldLst(handle1 );
//------------------------------- Display panel
errcod = 0;
redspo = 'N';
pnlnam = 'WRKFFLD';
DspPanel(handle: fkey: pnlnam: redspo: errcod);
// Delete the list if F3 pressed
errcod = 0;
IF FKEY=3;
DltList(handle: LstNam: errcod);
ENDIF;
ENDDO;
//------------------------------- Close program
closopt = 'M';
errcod = 0;
ClosePnl(handle: closopt: errcod);
RETURN;
/end-free
P p_main...
P E
The code below was created by Thomas Raddatz who published the example under GNU considerations.
‚ *=====================================================================* RADDAT
‚ * Author : Thomas Raddatz * RADDAT
‚ * Date : 15.02.2002 * RADDAT
‚ * E-mail : Thomas.Raddatz§Tools400.de * RADDAT
‚ * Homepage: www.tools400.de * RADDAT
‚ *=====================================================================* RADDAT
‚ * * RADDAT
‚ * This software is free software, you can redistribute it and/or * RADDAT
‚ * modify it under the terms of the GNU General Public License (GPL) * RADDAT
‚ * as published by the Free Software Foundation. * RADDAT
‚ * * RADDAT
‚ * See GNU General Public License for details. * RADDAT
‚ * http://www.opensource.org * RADDAT
‚ * http://www.opensource.org/licenses/gpl-license.html * RADDAT
‚ * * RADDAT
‚ *=====================================================================* RADDAT
‚ * History: * RADDAT
‚ * * RADDAT
‚ * Datum Name „nderung * RADDAT
‚ * ---------- ------------ --------------------------------------- * RADDAT
‚ * 06.06.2002 Th.Raddatz Fixed problem that CEEGSI changed * RADDAT
‚ * foreign storage becauce of a wrong * RADDAT
‚ * prototype. (Forgotten FC parameter.) * RADDAT
‚ * 26.09.2002 Th.Raddatz Added DEFINE statements to the * RADDAT
RAD‚ * reference fields to prevent compiler * RADDAT
RAD‚ * error message RNF3316 * RADDAT
‚ * 26.09.2002 Th.Raddatz Changed how the API error message is * RADDAT
RAD‚ * is assigned to o_msg in routine * RADDAT
RAD‚ * f_opnFldLst() to ensure proper value. * RADDAT
‚ * 03.06.2003 Th.Raddatz Changed service program to use a pointer * RADDAT
‚ * instead of a data structure as the * RADDAT
‚ * handle. * RADDAT
‚ * Added reference field for handle. * RADDAT
‚ * 30.06.2003 Th.Raddatz Changed definition of errCode parameter * RADDAT
‚ * to use reference field. * RADDAT
‚ * * RADDAT
‚ *=====================================================================* RADDAT
‚ * >>PRE-COMPILER<< * RADDAT
‚ * * RADDAT
‚ * >>CRTCMD<< CRTRPGMOD MODULE(&LI/&OB) + * RADDAT
‚ * SRCFILE(&SL/&SF) + * RADDAT
‚ * SRCMBR(&SM); * RADDAT
‚ * * RADDAT
‚ * >>COMPILE<< * RADDAT
‚ * >>PARM<< TRUNCNBR(*NO); * RADDAT
‚ * >>PARM<< DBGVIEW(*LIST); * RADDAT
‚ * >>END-COMPILE<< * RADDAT
‚ * * RADDAT
‚ * >>EXECUTE<< * RADDAT
‚ * * RADDAT
‚ * >>CMD<< CRTSRVPGM SRVPGM(&LI/&OB) + * RADDAT
‚ * MODULE(&LI/&OB) + * RADDAT
‚ * EXPORT(*ALL) + * RADDAT
‚ * ACTGRP(*CALLER) + * RADDAT
‚ * DETAIL(*BASIC) + * RADDAT
‚ * ALWUPD(*YES) + * RADDAT
‚ * ALWLIBUPD(*YES) + * RADDAT
‚ * TEXT('SrvPgm : Retrieve + * RADDAT
‚ * Field List'); * RADDAT
‚ * * RADDAT
‚ * >>END-PRE-COMPILER<< * RADDAT
‚ *=====================================================================* RADDAT
H NOMAIN RADDAT
H EXTBININT(*YES) BNDDIR('QC2LE')
H DATFMT(*ISO) TIMFMT(*ISO) DEBUG(*YES)
‚ *=====================================================================* RADDAT
‚ *
‚ * Prototypes of exported procedures RADDAT
CPY‚ /COPY PRTVFLDL RADDAT
‚ * RADDAT
‚ * Reference fields RADDAT
‚ /IF NOT DEFINED (errCode_t) RADDAT
‚ /DEFINE errCode_t RADDAT
D errCode_t E DS extname(xderrcode) based(pDummy) RADDAT
D prefix(errCode_t_) RADDAT
‚ /ENDIF RADDAT
‚ * RADDAT
‚ /IF NOT DEFINED (msg_t) RADDAT
‚ /DEFINE msg_t RADDAT
D msg_t E DS extname(XDMSG ) based(pDummy) RADDAT
D prefix(msg_t_ ) RADDAT
‚ /ENDIF RADDAT
é ‚ *
é ‚ * Prototypes of internal used procedures RADDAT
D f_getEntry... RADDAT
D PR N opdesc RADDAT
D i_handle value like(fldLst_handle_t) RADDAT
D o_data 32767A options(*varsize) RADDAT
D i_length 10I 0 value RADDAT
é ‚ * RADDAT
D f_crtUsrSpc... RADDAT
D PR N RADDAT
D i_spcName 10A value RADDAT
D i_spcLib 10A value RADDAT
D i_text 50A value RADDAT
D o_errCode like(errCode_t ) RADDAT
é ‚ * RADDAT
D f_dltUsrSpc... RADDAT
D PR N RADDAT
D i_spcName 10A value RADDAT
D i_spcLib 10A value RADDAT
é ‚ *
D f_getTmpName...
D PR N
D o_fileName 10A
D o_fileLib 10A
é ‚ *
D f_isApiError...
D PR N
D i_errCode value like(errCode_t ) RADDAT
é ‚ * RADDAT
D f_newApiErrCode... RADDAT
D PR like(errCode_t ) RADDAT
D i_monmsg N value RADDAT
é ‚ * RADDAT
D f_cvtApiErrCodeToMsg... RADDAT
D PR like(msg_t ) RADDAT
D i_errCode value like(errCode_t ) RADDAT
‚ *
D f_fdlSort... RADDAT
D PR N
D i_pUsrSpc * value
D i_compare 10A value
‚ *
D f_fdlSortByName... RADDAT
D PR 10I 0
D i_pKey * value
D i_pElement * value
‚ * RADDAT
é ‚ * Prototypes of CEE procedures RADDAT
D ceegsi PR extproc('CEEGSI') RADDAT
D i_posN 10I 0 const RADDAT
D o_dataType 10I 0 RADDAT
D o_currLen 10I 0 RADDAT
D o_maxLen 10I 0 RADDAT
D o_fc 12A options(*omit) RADDAT
é ‚ *
é ‚ * Prototypes of C functions RADDAT
D tmpnam PR * extproc('tmpnam')
D io_pTmpName * value
é ‚ *
D strtok PR * extproc('strtok')
D i_string * value options(*string)
D i_token * value options(*string)
é ‚ *
D qsort PR extproc('qsort')
D i_pBase * value
D i_num 10I 0 value
D i_width 10I 0 value
D i_pCompare * value procptr
é ‚ * RADDAT
D memcpy PR extproc('memcpy') RADDAT
D i_dest * value RADDAT
D i_src * value RADDAT
D i_count 10I 0 value RADDAT
é ‚ *
é ‚ * Global Constants RADDAT
D cTrue C const(*on ) RADDAT
D cFalse C const(*off) RADDAT
é ‚ *
é ‚ *==================================================================*
é ‚ * Open Field List RADDAT
é ‚ * -----------------------------------------------------------------
é ‚ * Using format: FLDL0100 RADDAT
é ‚ *==================================================================*
é ‚ *
] P f_opnFldLst... RADDAT
] P B export
é ‚ *
D f_opnFldLst... RADDAT
D PI N opdesc RADDAT
D i_fileName 10A value
D i_fileLib 10A value
D i_rcdFormat 10A value RADDAT
D i_orderBy 10A value
D o_handle like(fldLst_handle_t) RADDAT
D o_msg 32767A options(*nopass : RADDAT
D *varsize) RADDAT
é ‚ *
é ‚ * Return value RADDAT
D o_isDone S N inz(cFalse) RADDAT
é ‚ * RADDAT
é ‚ * Parameter positions RADDAT
D cpMsg C const(6) RADDAT
é ‚ * RADDAT
é ‚ * Optional input parameters RADDAT
D msg E DS extname(XDMSG ) inz RADDAT
D prefix(msg_ ) RADDAT
é ‚ *
é ‚ * Local fields ... RADDAT
é ‚ * ... f_crtUsrSpc
D qualSpcName DS
D spcName 10A inz
D spcLib 10A inz
D text S 50A inz
‚ * ... QUSPTRUS
‚ *qualSpcName DS
‚ * spcName 10A inz
‚ * spcLib 10A inz
D pUsrSpc S * inz
‚ * ... QUSLFLD RADDAT
D format S 8A inz
D qualFileName DS
D fileName 10A inz
D fileLib 10A inz
D rcdFormat S 10A inz RADDAT
D override S 1A inz
é ‚ *
é ‚ * Handle RADDAT
D handle DS based(pHandle)
D hPointer *
D hNbrEntry 10I 0
D hRes_01 36A
é ‚ * RADDAT
D handleSize S 10I 0 inz(%size(handle)) RADDAT
é ‚ *
é ‚ * API Error Code RADDAT
D errCode E DS extname(xderrcode) inz RADDAT
D prefix(errCode_ ) RADDAT
é ‚ * RADDAT
é ‚ * Local fields RADDAT
D isUsrSpc S N inz RADDAT
é ‚ *
é ‚ * CEEGSI work fields RADDAT
D o_msgType S 10I 0 inz RADDAT
D o_msgCurrLen S 10I 0 inz RADDAT
D o_msgMaxLen S 10I 0 inz RADDAT
é ‚ *-------------------------------------------------------------------
é ‚ *
é ‚ * If a temporary object name is produced ... RADDAT
B01šC If f_getTmpName(spcName: spcLib)
é ‚ * ... then RADDAT
é ‚ * If a user space is created ... RADDAT
šC Eval text = 'List Fields, ' + RADDAT
šC 'FLDL0100, ' + i_orderBy RADDAT
B02C If f_crtUsrSpc(spcName: spcLib: text: errCode) RADDAT
C Eval isUsrSpc = cTrue RADDAT
é ‚ * ... then RADDAT
é ‚ * retrieve member list RADDAT
C Eval format = 'FLDL0100' RADDAT
C Eval fileName = i_fileName RADDAT
C Eval fileLib = i_fileLib RADDAT
C Eval rcdFormat = i_rcdFormat RADDAT
C Eval override = '0' RADDAT
C Eval errCode = f_newApiErrCode(cTrue) RADDAT
é ‚ *
C Call 'QUSLFLD' RADDAT
C Parm qualSpcName
C Parm format
C Parm qualFileName
C Parm rcdFormat RADDAT
C Parm override
C Parm errCode RADDAT
é ‚ *
é ‚ * If the list is retrieved ... RADDAT
B03C If not f_isApiError(errCode) RADDAT
é ‚ * ... then RADDAT
é ‚ * get pointer to user space RADDAT
C Call 'QUSPTRUS'
C Parm qualSpcName
C Parm pUsrSpc
C Parm errCode RADDAT
é ‚ *
é ‚ * If the pointer is retrieved ... RADDAT
B04˜C If not f_isApiError(errCode) RADDAT
é ‚ * ... then RADDAT
é ‚ * sort user space entries RADDAT
˜C Eval o_isDone = f_fdlSort(pUsrSpc: i_orderBy) RADDAT
é ‚ *
X04˜C Else
é ‚ * ... else RADDAT
é ‚ * signal error (retrieve user space pointer) RADDAT
˜C Eval o_isDone = cFalse RADDAT
E04˜C Endif
é ‚ *
X03C Else
é ‚ * ... else RADDAT
é ‚ * signal error (retrieve field list) RADDAT
C Eval o_isDone = cFalse RADDAT
E03C Endif
é ‚ *
é ‚ *
X02C Else
é ‚ * ... else RADDAT
é ‚ * signal error (create user space) RADDAT
C Eval o_isDone = cFalse RADDAT
C Eval isUsrSpc = cFalse RADDAT
E02C Endif
é ‚ *
X01šC Else
é ‚ * ... else RADDAT
é ‚ * signal error (temporary object name) RADDAT
šC Eval o_isDone = cFalse RADDAT
šC Eval isUsrSpc = cFalse RADDAT
šC Clear errCode RADDAT
šC Eval errCode_bytPrv = %size(errCode) RADDAT
šC Eval errCode_bytAvl = %size(errCode) RADDAT
šC Eval errCode_excID = 'CPF9898' RADDAT
šC Eval errCode_excDta = 'Temporary object name + RADDAT
šC could not be produced.' RADDAT
E01šC Endif RADDAT
é ‚ * RADDAT
é ‚ * Create error message from API error code RADDAT
C Eval msg = f_cvtApiErrCodeToMsg(errCode) RADDAT
é ‚ *
é ‚ * If everything is fine ... RADDAT
B01šC If o_isDone
é ‚ * ... set handle data RADDAT
šC Alloc handleSize pHandle RADDAT
šC Eval hPointer = pUsrSpc
šC Eval hNbrEntry = 0
šC Eval hRes_01 = '' RADDAT
X01šC Else
é ‚ * ... free ressources RADDAT
B02C If isUsrSpc RADDAT
C Callp f_dltUsrSpc(spcName: spcLib) RADDAT
E02C Endif RADDAT
šC Eval pHandle = *NULL RADDAT
E01šC Endif
é ‚ * RADDAT
é ‚ * Set output values RADDAT
C Eval o_handle = pHandle RADDAT
é ‚ * RADDAT
B01šC If %parms >= cpMsg RADDAT
šC Callp ceegsi(cpMsg : o_msgType : RADDAT
šC o_msgCurrLen : o_msgMaxLen : *omit) RADDAT
šC Eval %subst(o_msg: 1: o_msgCurrLen) = msg RADDAT
E01šC Endif RADDAT
é ‚ *
C Return o_isDone
é ‚ *
] P f_opnFldLst... RADDAT
] P E
é ‚ *
é ‚ *==================================================================*
é ‚ * Close Field List RADDAT
é ‚ *==================================================================*
é ‚ *
] P f_cloFldLst... RADDAT
] P B export
é ‚ *
D f_cloFldLst... RADDAT
D PI N
D io_handle like(fldLst_handle_t) RADDAT
é ‚ *
é ‚ * Return value RADDAT
D o_isDone S N inz(cFalse) RADDAT
é ‚ *
é ‚ * Handle RADDAT
D handle DS based(pHandle)
D hPointer *
D hNbrEntry 10I 0
D hRes_01 36A
é ‚ *
é ‚ * List API Generic Data Structure RADDAT
D genDtaStrc E DS prefix(genDtaStrc_) RADDAT
D based(pGenDtaStrc)
é ‚ *
é ‚ * Input Section of QUSLFLD API RADDAT
D inpSct DS based(pInpSct)
D x_qualSpcName 20A
D x_spcName 10A overlay(x_qualSpcName: 1)
D x_spcLib 10A overlay(x_qualSpcName: 11)
D x_format 8A
D x_qualFileNme 20A
D x_fileName 10A overlay(x_qualFileNme: 1)
D x_fileLib 10A overlay(x_qualFileNme: 11)
D x_rcdFormat 10A RADDAT
D x_override 1A
é ‚ *-------------------------------------------------------------------
é ‚ *
C Eval pHandle = io_handle RADDAT
é ‚ *
é ‚ * Get user space name RADDAT
C Eval pGenDtaStrc = hPointer
C Eval pInpSct = hPointer + genDtaStrc_ofsInpSct RADDAT
é ‚ *
é ‚ * Delete user space RADDAT
C Eval o_isDone = f_dltUsrSpc(x_spcName: x_spcLib)
é ‚ *
é ‚ * Clear handle data RADDAT
C Eval hPointer = *NULL
C Eval hNbrEntry = 0
C Eval hRes_01 = '' RADDAT
é ‚ * RADDAT
é ‚ * Free handle memory RADDAT
C Dealloc(N) pHandle RADDAT
é ‚ * RADDAT
é ‚ * Set output values RADDAT
C Eval io_handle = pHandle RADDAT
é ‚ *
C Return o_isDone
é ‚ *
] P f_cloFldLst... RADDAT
] P E
é ‚ *
é ‚ *==================================================================*
é ‚ * Get First Field RADDAT
é ‚ *==================================================================*
é ‚ *
] P f_getFirstFld... RADDAT
] P B export
é ‚ *
D f_getFirstFld... RADDAT
D PI N opdesc RADDAT
D i_handle value like(fldLst_handle_t) RADDAT
D o_data 32767A options(*varsize) RADDAT
é ‚ *
é ‚ * Return value RADDAT
D o_isDone S N inz(cFalse) RADDAT
é ‚ *
é ‚ * Handle RADDAT
D handle DS based(pHandle)
D hPointer *
D hNbrEntry 10I 0
D hRes_01 36A
é ‚ * RADDAT
é ‚ * Local fields RADDAT
D o_dataPosN C const(2) RADDAT
D o_dataType S 10I 0 inz RADDAT
D o_dataCurrLen S 10I 0 inz RADDAT
D o_dataMaxLen S 10I 0 inz RADDAT
é ‚ *------------------------------------------------------------------- RADDAT
é ‚ * RADDAT
C Eval pHandle = i_handle RADDAT
é ‚ * RADDAT
é ‚ * Get length of o_data RADDAT
C Callp ceegsi(o_dataPosN : o_dataType : RADDAT
C o_dataCurrLen: o_dataMaxLen : *omit) RADDAT
é ‚ * RADDAT
é ‚ * Get first entry RADDAT
C Eval hNbrEntry = 0 RADDAT
é ‚ * RADDAT
é ‚ * Retrieve entry data RADDAT
C Eval o_isDone = f_getEntry(i_handle : RADDAT
C o_data : RADDAT
C o_dataCurrLen ) RADDAT
é ‚ *
C Return o_isDone
é ‚ *
] P f_getFirstFld... RADDAT
] P E
é ‚ *
é ‚ *==================================================================*
é ‚ * Get Next Field RADDAT
é ‚ *==================================================================*
é ‚ *
] P f_getNextFld... RADDAT
] P B export
é ‚ *
D f_getNextFld... RADDAT
D PI N opdesc RADDAT
D i_handle value like(fldLst_handle_t) RADDAT
D o_data 32767A options(*varsize) RADDAT
é ‚ *
é ‚ * Return value RADDAT
D o_isDone S N inz(cFalse) RADDAT
é ‚ * RADDAT
é ‚ * Local fields RADDAT
D o_dataPosN C const(2) RADDAT
D o_dataType S 10I 0 inz RADDAT
D o_dataCurrLen S 10I 0 inz RADDAT
D o_dataMaxLen S 10I 0 inz RADDAT
é ‚ *------------------------------------------------------------------- RADDAT
é ‚ * RADDAT
é ‚ * Get length of o_data RADDAT
C Callp ceegsi(o_dataPosN : o_dataType : RADDAT
C o_dataCurrLen: o_dataMaxLen : *omit) RADDAT
é ‚ *
é ‚ * Retrieve entry data RADDAT
C Eval o_isDone = f_getEntry(i_handle : RADDAT
C o_data : RADDAT
C o_dataCurrLen ) RADDAT
é ‚ *
C Return o_isDone
é ‚ *
] P f_getNextFld... RADDAT
] P E
é ‚ * RADDAT
é ‚ *==================================================================* RADDAT
é ‚ * Get Number of Fields available RADDAT
é ‚ *==================================================================* RADDAT
é ‚ * RADDAT
] P f_getNumFldAvl... RADDAT
] P B export RADDAT
é ‚ * RADDAT
D f_getNumFldAvl... RADDAT
D PI 10I 0 RADDAT
D i_handle value like(fldLst_handle_t) RADDAT
é ‚ * RADDAT
é ‚ * Return value RADDAT
D numFldAvl S 10I 0 inz RADDAT
é ‚ * RADDAT
é ‚ * Handle RADDAT
D handle DS based(pHandle) RADDAT
D hPointer * RADDAT
D hNbrEntry 10I 0 RADDAT
D hRes_01 36A RADDAT
é ‚ * RADDAT
é ‚ * List API Generic Data Structure RADDAT
D genDtaStrc E DS prefix(genDtaStrc_) RADDAT
D based(pGenDtaStrc) RADDAT
é ‚ *------------------------------------------------------------------- RADDAT
é ‚ * RADDAT
C Eval pHandle = i_handle RADDAT
é ‚ * RADDAT
C Eval pGenDtaStrc = hPointer RADDAT
é ‚ * RADDAT
C Return genDtaStrc_nbrEntries RADDAT
é ‚ * RADDAT
] P f_getNumFldAvl... RADDAT
] P E RADDAT
é ‚ *
é ‚ *==================================================================*
é ‚ * Get Entry
é ‚ *==================================================================*
é ‚ *
] P f_getEntry...
] P B
é ‚ *
D f_getEntry...
D PI N opdesc RADDAT
D i_handle value like(fldLst_handle_t) RADDAT
D o_data 32767A options(*varsize) RADDAT
D i_length 10I 0 value RADDAT
é ‚ *
é ‚ * Return value RADDAT
D o_isDone S N inz(cFalse) RADDAT
é ‚ *
é ‚ * Handle RADDAT
D handle DS based(pHandle)
D hPointer *
D hNbrEntry 10I 0
D hRes_01 36A
é ‚ *
é ‚ * Local fields RADDAT
D pDest S * inz RADDAT
D pSrc S * inz RADDAT
D count S 10I 0 inz RADDAT
é ‚ *
é ‚ * List API Generic Data Structure RADDAT
D genDtaStrc E DS prefix(genDtaStrc_) RADDAT
D based(pGenDtaStrc)
é ‚ *-------------------------------------------------------------------
é ‚ *
C Eval pHandle = i_handle RADDAT
é ‚ *
C Eval pGenDtaStrc = hPointer
é ‚ * RADDAT
é ‚ * If more entries are available ... RADDAT
B01šC If (genDtaStrc_nbrEntries > 0 ) and RADDAT
šC (hNbrEntry < genDtaStrc_nbrEntries) RADDAT
é ‚ * ... set memcpy() values RADDAT
šC Eval pDest = %addr(o_data) RADDAT
šC Eval pSrc = hPointer + RADDAT
šC genDtaStrc_ofsLstSct + RADDAT
šC hNbrEntry * genDtaStrc_sizeEntry RADDAT
B02C If i_length < genDtaStrc_sizeEntry RADDAT
C Eval count = i_length RADDAT
X02C Else RADDAT
C Eval count = genDtaStrc_sizeEntry RADDAT
E02C Endif RADDAT
é ‚ * retrieve entry data RADDAT
šC Callp memCpy(pDest: pSrc: count) RADDAT
é ‚ * set entry number RADDAT
šC Eval hNbrEntry = hNbrEntry + 1
é ‚ * signal OK RADDAT
šC Eval o_isDone = cTrue RADDAT
X01šC Else
é ‚ * ... signal error RADDAT
šC Eval o_isDone = cFalse RADDAT
E01šC Endif
é ‚ *
C Return o_isDone
é ‚ *
] P f_getEntry...
] P E
é ‚ *
é ‚ *==================================================================*
é ‚ * Create User Space
é ‚ *==================================================================*
é ‚ *
] P f_crtUsrSpc...
] P B
é ‚ *
D f_crtUsrSpc...
D PI N
D i_spcName 10A value
D i_spcLib 10A value
D i_text 50A value
D o_errCode like(errCode_t ) RADDAT
é ‚ *
é ‚ * Deklarieren Funktionswert
D o_isDone S N inz(cFalse) RADDAT
é ‚ *
é ‚ * Deklarieren Arbeitsfelder
é ‚ * ... QUSCRTUS
D qualSpcName DS
D spcName 10A inz
D spcLib 10A inz
D extAtr S 10A inz
D iniSize S 10I 0 inz
D iniValue S 1A inz
D pubAuth S 10A inz
D text S 50A inz
D replace S 10A inz
é ‚ *
é ‚ * Deklarieren API Fehlercode
D errCode E DS extname(xderrcode) inz RADDAT
D prefix(errCode_ ) RADDAT
é ‚ *-------------------------------------------------------------------
é ‚ *
C Eval spcName = i_spcName
C Eval spcLib = i_spcLib
C Eval extAtr = 'TEMP'
C Eval iniSize = 65536 RADDAT
C Eval iniValue = x'00'
C Eval pubAuth = '*USE'
C Eval text = i_text
C Eval replace = '*NO'
C Eval errCode = f_newApiErrCode(cTrue) RADDAT
é ‚ *
C Call 'QUSCRTUS'
C Parm qualSpcName
C Parm extAtr
C Parm iniSize
C Parm iniValue
C Parm pubAuth
C Parm text
C Parm replace
C Parm errCode RADDAT
é ‚ *
C Eval o_isDone = not f_isApiError(errCode) RADDAT
C Eval o_errCode = errCode RADDAT
é ‚ *
C Return o_isDone
é ‚ *
] P f_crtUsrSpc...
] P E
é ‚ *
é ‚ *==================================================================*
é ‚ * Delete User Space
é ‚ *==================================================================*
é ‚ *
] P f_dltUsrSpc...
] P B
é ‚ *
D f_dltUsrSpc...
D PI N
D i_spcName 10A value
D i_spcLib 10A value
é ‚ *
é ‚ * Deklarieren Funktionswert
D o_isDone S N inz(cFalse) RADDAT
é ‚ *
é ‚ * Deklarieren Arbeitsfelder
é ‚ * ... QUSCRTUS
D qualSpcName DS
D spcName 10A inz
D spcLib 10A inz
é ‚ *
é ‚ * Deklarieren API Fehlercode
D errCode E DS extname(xderrcode) inz RADDAT
D prefix(errCode_ ) RADDAT
é ‚ *-------------------------------------------------------------------
é ‚ *
C Eval spcName = i_spcName
C Eval spcLib = i_spcLib
C Eval errCode = f_newApiErrCode(cTrue) RADDAT
é ‚ *
C Call 'QUSDLTUS'
C Parm qualSpcName
C Parm errCode RADDAT
é ‚ *
C Eval o_isDone = not f_isApiError(errCode) RADDAT
é ‚ *
C Return o_isDone
é ‚ *
] P f_dltUsrSpc...
] P E
é ‚ *
é ‚ *==================================================================*
é ‚ * Get Temporary Object Name
é ‚ *==================================================================*
é ‚ *
] P f_getTmpName...
] P B
é ‚ *
D f_getTmpName...
D PI N
D o_fileName 10A
D o_fileLib 10A
é ‚ *
é ‚ * Deklarieren Konstanten
D L_tmpnam C const(39) Ü
é ‚ *
é ‚ * Deklarieren Funktionswert
D o_isDone S N inz(cFalse) RADDAT
é ‚ *
é ‚ * Deklarieren Arbeitsfelder
D tmpName S 1A dim(L_tmpnam)
D based(pTmpName)
é ‚ *-------------------------------------------------------------------
é ‚ *
C Eval pTmpName = tmpnam(%addr(tmpName))
é ‚ * Wenn ein temp. Dateiname generiert werden konnte, ...
B01šC If pTmpName <> *NULL
é ‚ * ... dann
é ‚ * aufteilen in Name & Bibliothek
šC Eval o_fileLib = %str(strtok(pTmpName:'/'))
šC Eval o_fileName = %str(strtok(*NULL :'/'))
šC Eval o_isDone = cTrue RADDAT
X01šC Else
é ‚ * ... sonst
é ‚ * zur¾ckmelden Fehler
šC Eval o_isDone = cFalse RADDAT
E01šC Endif
é ‚ *
C Return o_isDone
é ‚ *
] P f_getTmpName...
] P E
é ‚ *
é ‚ *==================================================================*
é ‚ * Is API Error?
é ‚ * -----------------------------------------------------------------
é ‚ * cTrue - error RADDAT
é ‚ * cFalse - no error RADDAT
é ‚ *==================================================================*
é ‚ *
] P f_isApiError...
] P B
é ‚ *
D f_isApiError...
D PI N
D i_errCode value like(errCode_t ) RADDAT
é ‚ *
é ‚ * Deklarieren Funktionswert
D o_isError S N inz(cFalse) RADDAT
é ‚ *
é ‚ * Deklarieren API Fehlercode
D errCode E DS extname(xderrcode) RADDAT
D prefix(errCode_ ) RADDAT
D based(pErrCode ) RADDAT
é ‚ *-------------------------------------------------------------------
é ‚ *
C Eval pErrCode = %addr(i_errCode) RADDAT
é ‚ *
B01šC If errCode_bytAvl = 0 RADDAT
šC Eval o_isError = cFalse RADDAT
X01šC Else
šC Eval o_isError = cTrue RADDAT
E01šC Endif
é ‚ *
C Return o_isError
é ‚ *
] P f_isApiError...
] P E
é ‚ * RADDAT
é ‚ *==================================================================* RADDAT
é ‚ * Erstellen leere API error code Datenstruktur RADDAT
é ‚ *==================================================================* RADDAT
é ‚ * RADDAT
] P f_newApiErrCode... RADDAT
] P B RADDAT
é ‚ * RADDAT
D f_newApiErrCode... RADDAT
D PI like(errCode_t ) RADDAT
D i_monmsg N value RADDAT
é ‚ * RADDAT
é ‚ * Deklarieren Funktionswert RADDAT
D errCode E DS extname(xderrcode) inz RADDAT
D prefix(errCode_ ) RADDAT
é ‚ *------------------------------------------------------------------- RADDAT
é ‚ * RADDAT
C Clear errCode RADDAT
é ‚ * RADDAT
B01šC If i_monMsg = cTrue RADDAT
šC Eval errCode_bytPrv = %size(errCode) RADDAT
X01šC Else RADDAT
šC Eval errCode_bytPrv = 0 RADDAT
E01šC Endif RADDAT
é ‚ * RADDAT
C Return errCode RADDAT
é ‚ * RADDAT
] P f_newApiErrCode... RADDAT
] P E RADDAT
é ‚ * RADDAT
é ‚ *==================================================================* RADDAT
é ‚ * Convert API error code to message RADDAT
é ‚ *==================================================================* RADDAT
é ‚ * RADDAT
] P f_cvtApiErrCodeToMsg... RADDAT
] P B RADDAT
é ‚ * RADDAT
D f_cvtApiErrCodeToMsg... RADDAT
D PI like(msg_t ) RADDAT
D i_errCode value like(errCode_t ) RADDAT
é ‚ * RADDAT
é ‚ * Deklarieren Funktionswert RADDAT
D o_msg E DS extname(XDMSG ) inz RADDAT
D prefix(o_msg_ ) RADDAT
é ‚ * RADDAT
é ‚ * Deklarieren API Fehlercode RADDAT
D errCode E DS extname(xderrcode) RADDAT
D prefix(errCode_ ) RADDAT
D based(pErrCode ) RADDAT
é ‚ *------------------------------------------------------------------- RADDAT
é ‚ * RADDAT
C Eval pErrCode = %addr(i_errCode) RADDAT
é ‚ *
B01šC If errCode_bytAvl = 0 RADDAT
šC Clear o_msg RADDAT
X01šC Else RADDAT
šC Clear o_msg RADDAT
šC Eval o_msg_ID = errCode_excID RADDAT
šC Eval o_msg_data = errCode_excDta RADDAT
šC Eval o_msg_type = '*ESCAPE' RADDAT
šC Eval o_msg_file = 'QCPFMSG' RADDAT
šC Eval o_msg_lib = 'QSYS' RADDAT
E01šC Endif RADDAT
é ‚ * RADDAT
C Return o_msg RADDAT
é ‚ * RADDAT
] P f_cvtApiErrCodeToMsg... RADDAT
] P E RADDAT
é ‚ *
é ‚ *==================================================================*
é ‚ * Sort User Space
é ‚ *==================================================================*
é ‚ *
] P f_fdlSort... RADDAT
] P B
é ‚ *
D f_fdlSort... RADDAT
D PI N
D i_pUsrSpc * value
D i_compare 10A value
é ‚ *
é ‚ * Deklarieren Funktionswert
D o_isDone S N inz(cFalse) RADDAT
é ‚ *
é ‚ * Deklarieren Arbeitsfelder
D genDtaStrc E DS prefix(genDtaStrc_) RADDAT
D based(pGenDtaStrc)
D pCompFunc S * inz procptr
é ‚ *-------------------------------------------------------------------
é ‚ *
é ‚ * Ermitteln Sortierfunktion ...
B01šC Select
é ‚ * ... nicht sortieren
šC When i_compare = '*NONE'
šC Eval pCompFunc = *NULL
šC Eval o_isDone = cTrue RADDAT
é ‚ * ... sortieren nach Name
šC When i_compare = '*NAME'
šC Eval pCompFunc = %paddr('F_FDLSORTBYNAME') RADDAT
šC Eval o_isDone = cTrue RADDAT
é ‚ * ... unbekannte Sortierung = Fehler
X01šC Other
šC Eval pCompFunc = *NULL
šC Eval o_isDone = cFalse RADDAT
E01šC Endsl
é ‚ *
é ‚ * Wenn eine Sortierfunktion ermittelt werden konnte, ...
B01šC If pCompFunc <> *NULL
é ‚ * ... dann
é ‚ * ermitteln Anzahl Eintr¯ge und L¯nge pro Eintrag
šC Eval pGenDtaStrc = i_pUsrSpc
é ‚ * und sortieren User Space
šC Callp qsort(i_pUsrSpc + genDtaStrc_ofsLstSct : RADDAT
šC genDtaStrc_nbrEntries : RADDAT
šC genDtaStrc_sizeEntry : RADDAT
šC pCompFunc ) RADDAT
X01šC Else
é ‚ * ... sonst
é ‚ * keine Sortierung durchf¾hren
E01šC Endif
é ‚ *
C Return o_isDone
é ‚ *
] P f_fdlSort... RADDAT
] P E
é ‚ *
é ‚ *==================================================================*
é ‚ * Field List: Sort By Name RADDAT
é ‚ *==================================================================*
é ‚ *
] P f_fdlSortByName... RADDAT
] P B
é ‚ *
D f_fdlSortByName... RADDAT
D PI 10I 0
D i_pKey * value
D i_pElement * value
é ‚ *
é ‚ * Deklarieren KEY
D key DS based(i_pKey)
D k_fldName 10A RADDAT
é ‚ *
é ‚ * Deklarieren ELEMENT
D element DS based(i_pElement)
D e_fldName 10A RADDAT
é ‚ *
é ‚ * Deklarieren Funktionswert
D o_result S 10I 0 inz
é ‚ *-------------------------------------------------------------------
é ‚ *
B01šC Select
šC When k_fldName < e_fldName RADDAT
šC Eval o_result = -1
šC When k_fldName > e_fldName RADDAT
šC Eval o_result = 1
X01šC Other
šC Eval o_result = 0
E01šC Endsl
é ‚ *
C Return o_result
é ‚ *
] P f_fdlSortByName... RADDAT
] P E