Difference between revisions of "Find Source Member (FNDSRCMBR)"

From MidrangeWiki
Jump to: navigation, search
(Sample Application)
(References)
 
(12 intermediate revisions by the same user not shown)
Line 85: Line 85:
  
 
     /* work variables */
 
     /* work variables */
 +
            DCL        VAR(&CONTINUE)  TYPE(*LGL)  LEN(1)  VALUE('1')
 
             DCL        VAR(&EOFSRC)    TYPE(*LGL)  LEN(1)  VALUE('0')
 
             DCL        VAR(&EOFSRC)    TYPE(*LGL)  LEN(1)  VALUE('0')
 
             DCL        VAR(&GOTMBR)    TYPE(*LGL)  LEN(1)  VALUE('0')
 
             DCL        VAR(&GOTMBR)    TYPE(*LGL)  LEN(1)  VALUE('0')
Line 126: Line 127:
 
             DCL        VAR(&WTIME)    TYPE(*INT)  LEN(4)  VALUE(-1)
 
             DCL        VAR(&WTIME)    TYPE(*INT)  LEN(4)  VALUE(-1)
 
             DCL        VAR(&HANDLE)    TYPE(*CHAR) LEN(8)
 
             DCL        VAR(&HANDLE)    TYPE(*CHAR) LEN(8)
 +
            DCL        VAR(&MBRLST)    TYPE(*CHAR) LEN(10)  VALUE('MBRLST')
 
             DCL        VAR(&PNLGRP)    TYPE(*CHAR) LEN(20) +
 
             DCL        VAR(&PNLGRP)    TYPE(*CHAR) LEN(20) +
 
                           VALUE('FNDSRCMBR *LIBL')
 
                           VALUE('FNDSRCMBR *LIBL')
Line 161: Line 163:
  
 
     /* work files */
 
     /* work files */
             DCLF      FILE(QAFDPHY) OPNID(SRC) ALWVARLEN(*YES)
+
             DCLF      FILE(QAFDBASI) OPNID(SRC) ALWVARLEN(*YES)
  
 
     /* ============================================================= */
 
     /* ============================================================= */
Line 195: Line 197:
  
 
     /* loop on screen interactions */
 
     /* loop on screen interactions */
             DOWHILE    COND(&FUNC *EQ 5)
+
             DOWHILE    COND(&CONTINUE)
  
          /* retrieve available file descriptions */
+
                 IF        COND(&FUNC *EQ 5) THEN(DO) /* (re)build list? */
                 SNDPGMMSG  MSGID(CPF9897) MSGF(&MSGF) MSGDTA('Searching +
 
                            for source files...') TOPGMQ(*EXT) +
 
                            MSGTYPE(*STATUS)
 
  
                 DSPFD      FILE(&SRCLIB/&SRCF) TYPE(*ATR) FILEATR(*PF) +
+
            /* retrieve available file descriptions */
                            OUTPUT(*OUTFILE) OUTFILE(QTEMP/SRCFLIST) +
+
                  SNDPGMMSG  MSGID(CPF9897) MSGF(&MSGF) MSGDTA('Searching +
                            OUTMBR(*FIRST *REPLACE)
+
                                for source files...') TOPGMQ(*EXT) +
                MONMSG    MSGID(CPF0000 CPE0000 CPD0000) EXEC(GOTO +
+
                                MSGTYPE(*STATUS)
                            CMDLBL(ABORT))
+
 
 +
                /* special handling for *USRLIBL filter */
 +
                  IF        COND(&SRCLIB *EQ *USRLIBL) THEN(DO)
 +
                      CHGVAR    VAR(&SRCF) VALUE(&SRCF *TCAT '*')
 +
                  ENDDO
 +
 
 +
                 /* list matching files into an output file */
 +
                  DSPFD      FILE(&SRCLIB/&SRCF) TYPE(*BASATR) +
 +
                                OUTPUT(*OUTFILE) OUTFILE(QTEMP/SRCFLIST) +
 +
                                OUTMBR(*FIRST *REPLACE)
 +
                  MONMSG    MSGID(CPF0000 CPE0000 CPD0000) EXEC(GOTO +
 +
                                CMDLBL(ABORT))
  
          /* override to the source file list */
+
            /* override to the source file list */
                OVRDBF    FILE(QAFDPHY) TOFILE(QTEMP/SRCFLIST)
+
                  OVRDBF    FILE(QAFDBASI) TOFILE(QTEMP/SRCFLIST)
                CHGVAR    VAR(&EOFSRC) VALUE('0')
+
                  CHGVAR    VAR(&EOFSRC) VALUE('0')
  
          /* retrieve matching member descriptions */
+
            /* retrieve matching member descriptions */
                SNDPGMMSG  MSGID(CPF9897) MSGF(&MSGF) MSGDTA('Building +
+
                  SNDPGMMSG  MSGID(CPF9897) MSGF(&MSGF) MSGDTA('Building +
                            member list...') TOPGMQ(*EXT) +
+
                                member list...') TOPGMQ(*EXT) +
                            MSGTYPE(*STATUS)
+
                                MSGTYPE(*STATUS)
  
                CHGVAR    VAR(&OPTION) VALUE('FRST')
+
                  CHGVAR    VAR(&OPTION) VALUE('FRST')
  
                 DOWHILE (*NOT &EOFSRC)
+
                 /* build member list */
                  CALLSUBR  SUBR(GET_SRCF)
+
                  DOWHILE (*NOT &EOFSRC)
                  IF        COND(*NOT &EOFSRC) THEN(DO)
+
                      CALLSUBR  SUBR(GET_SRCF)
                      IF        COND(&SRCMBR *EQ '*') THEN(DO)
+
                      IF        COND(*NOT &EOFSRC) THEN(DO)
                        CHGVAR    VAR(&MBRNAME) VALUE(*FIRSTMBR)
+
                        IF        COND(&SRCMBR *EQ '*') THEN(DO)
                      ENDDO
+
                            CHGVAR    VAR(&MBRNAME) VALUE(*FIRSTMBR)
                      ELSE      CMD(DO)
+
                        ENDDO
                        CHGVAR    VAR(&MBRNAME) VALUE(&SRCMBR)
+
                        ELSE      CMD(DO)
                      ENDDO
+
                            CHGVAR    VAR(&MBRNAME) VALUE(&SRCMBR)
                      CHGVAR    VAR(&MBROPT) VALUE(*SAME)
+
                        ENDDO
                      CALLSUBR  SUBR(GET_MBRD)
+
                        CHGVAR    VAR(&MBROPT) VALUE(*SAME)
                      IF        COND(*NOT &GOTMBR) THEN(DO)
 
                        ITERATE
 
                      ENDDO
 
                      CALLSUBR  SUBR(PUT_MBRD)
 
                      CHGVAR    VAR(&MBROPT) VALUE(*NEXT)
 
                      DOWHILE    COND(&MBRNAME *NE &SRCMBR)
 
 
                         CALLSUBR  SUBR(GET_MBRD)
 
                         CALLSUBR  SUBR(GET_MBRD)
                         IF        COND(&GOTMBR) THEN(DO)
+
                         IF        COND(*NOT &GOTMBR) THEN(DO)
                             CALLSUBR  SUBR(PUT_MBRD)
+
                             ITERATE
 +
                        ENDDO
 +
                        CALLSUBR  SUBR(PUT_MBRD)
 +
                        CHGVAR    VAR(&MBROPT) VALUE(*NEXT)
 +
                        DOWHILE    COND(&MBRNAME *NE &SRCMBR)
 +
                            CALLSUBR  SUBR(GET_MBRD)
 +
                            IF        COND(&GOTMBR) THEN(DO)
 +
                              CALLSUBR  SUBR(PUT_MBRD)
 +
                            ENDDO
 
                         ENDDO
 
                         ENDDO
 
                       ENDDO
 
                       ENDDO
 
                   ENDDO
 
                   ENDDO
                ENDDO
 
  
                SNDPGMMSG  MSGID(CPF9897) MSGF(&MSGF) MSGDTA(' ') +
+
                  SNDPGMMSG  MSGID(CPF9897) MSGF(&MSGF) MSGDTA(' ') +
                            TOPGMQ(*EXT) MSGTYPE(*STATUS)
+
                                TOPGMQ(*EXT) MSGTYPE(*STATUS)
  
          /* close the source file list and remove override */
+
                 ENDDO
                 CLOSE      OPNID(SRC)
 
                DLTOVR    FILE(QAFDPHY)
 
  
 
           /* display the panel */
 
           /* display the panel */
Line 257: Line 266:
 
                 MONMSG    MSGID(CPF0000 CPE0000 CPD0000) EXEC(GOTO +
 
                 MONMSG    MSGID(CPF0000 CPE0000 CPD0000) EXEC(GOTO +
 
                             CMDLBL(ABORT))
 
                             CMDLBL(ABORT))
 +
 +
          /* user pressed F3=EXIT key? */
 +
                IF        COND(&FUNC *LT 0) THEN(DO)
 +
                  CHGVAR    VAR(&CONTINUE) VALUE('0')
 +
                ENDDO
  
 
           /* user pressed ENTER key? */
 
           /* user pressed ENTER key? */
Line 280: Line 294:
 
                 ENDDO
 
                 ENDDO
  
           /* user requested a REFRESH? */
+
          /* user pressed F17=TOP key? */
 +
                IF        COND(&FUNC *EQ 2) THEN(DO)
 +
                  CALL      PGM(QUISETLA) PARM(&HANDLE &MBRLST 'SAME' +
 +
                                '*SAME' 'TOP' 'S' &ERRCOD)
 +
                  MONMSG    MSGID(CPF0000 CPE0000 CPD0000) EXEC(GOTO +
 +
                                CMDLBL(ABORT))
 +
                ENDDO
 +
 
 +
          /* user pressed F18=BOTTOM key? */
 +
                IF        COND(&FUNC *EQ 3) THEN(DO)
 +
                  CALL      PGM(QUISETLA) PARM(&HANDLE &MBRLST 'SAME' +
 +
                                '*SAME' 'BOT' 'S' &ERRCOD)
 +
                  MONMSG    MSGID(CPF0000 CPE0000 CPD0000) EXEC(GOTO +
 +
                                CMDLBL(ABORT))
 +
                ENDDO
 +
 
 +
           /* user requested a F5=REFRESH? */
 
                 IF        COND(&FUNC *EQ 5 +
 
                 IF        COND(&FUNC *EQ 5 +
 
                           *AND &OPTION *NE 'FRST') THEN(DO)
 
                           *AND &OPTION *NE 'FRST') THEN(DO)
 
                 /* delete subfile on refresh */
 
                 /* delete subfile on refresh */
                   CALL      PGM(QUIDLTL) PARM(&HANDLE 'MBRLST' &ERRCOD)
+
                   CALL      PGM(QUIDLTL) PARM(&HANDLE &MBRLST &ERRCOD)
 +
                ENDDO
 +
 
 +
          /* close the source file list and remove override */
 +
                CLOSE      OPNID(SRC)
 +
 
 +
                DLTOVR    FILE(QAFDBASI)
 +
                MONMSG    MSGID(CPF9841) EXEC(DO)
 +
                  RCVMSG    MSGTYPE(*LAST) RMV(*YES)
 
                 ENDDO
 
                 ENDDO
  
Line 330: Line 368:
 
  GET_MBRD:  SUBR      SUBR(GET_MBRD)
 
  GET_MBRD:  SUBR      SUBR(GET_MBRD)
 
                 CHGVAR    VAR(&GOTMBR) VALUE('1')
 
                 CHGVAR    VAR(&GOTMBR) VALUE('1')
                 RTVMBRD    FILE(&SRC_PHLIB/&SRC_PHFILE) MBR(&MBRNAME +
+
                 RTVMBRD    FILE(&SRC_ATLIB/&SRC_ATFILE) MBR(&MBRNAME +
 
                             &MBROPT) RTNMBR(&MBRNAME) SRCTYPE(&SRCTYPE) +
 
                             &MBROPT) RTNMBR(&MBRNAME) SRCTYPE(&SRCTYPE) +
 
                             SRCCHGDATE(&CHGDATE) CRTDATE(&CRTDATE) +
 
                             SRCCHGDATE(&CHGDATE) CRTDATE(&CRTDATE) +
Line 358: Line 396:
 
     /* ============================================================= */
 
     /* ============================================================= */
 
  PUT_MBRD:  SUBR      SUBR(PUT_MBRD)
 
  PUT_MBRD:  SUBR      SUBR(PUT_MBRD)
                 CHGVAR    VAR(&VAR_SRCLIB) VALUE(&SRC_PHLIB)
+
                 CHGVAR    VAR(&VAR_SRCLIB) VALUE(&SRC_ATLIB)
 
                 CHGVAR    VAR(&VAR_SRCMBR) VALUE(&MBRNAME)
 
                 CHGVAR    VAR(&VAR_SRCMBR) VALUE(&MBRNAME)
 
                 CHGVAR    VAR(&VAR_MBRTYP) VALUE(&SRCTYPE)
 
                 CHGVAR    VAR(&VAR_MBRTYP) VALUE(&SRCTYPE)
Line 398: Line 436:
 
                 CHGVAR    VAR(&VARLEN) VALUE(132)
 
                 CHGVAR    VAR(&VARLEN) VALUE(132)
 
                 CALL      PGM(QUIADDLE) PARM(&HANDLE &VARBUF &VARLEN +
 
                 CALL      PGM(QUIADDLE) PARM(&HANDLE &VARBUF &VARLEN +
                             'MEMBERS' 'MBRLST' &OPTION &LEHNDL &ERRCOD)
+
                             'MEMBERS' &MBRLST &OPTION &LEHNDL &ERRCOD)
 
                 CHGVAR    VAR(&OPTION) VALUE('NEXT')
 
                 CHGVAR    VAR(&OPTION) VALUE('NEXT')
 
             ENDSUBR
 
             ENDSUBR
Line 407: Line 445:
 
  VFY_SRCF:  SUBR      SUBR(VFY_SRCF) /* verify source file attributes */
 
  VFY_SRCF:  SUBR      SUBR(VFY_SRCF) /* verify source file attributes */
 
                 CHGVAR    VAR(&QFNM) VALUE(&SRCF *CAT '*LIBL')
 
                 CHGVAR    VAR(&QFNM) VALUE(&SRCF *CAT '*LIBL')
                 CHGVAR    VAR(&API_BPROV) VALUE(3016)
+
                 CHGVAR    VAR(&API_BPROV) VALUE(%LEN(&APIERRC))
 
                 CALL      PGM(QDBRTVFD) PARM(&RCVR &RCVL &QOUT +
 
                 CALL      PGM(QDBRTVFD) PARM(&RCVR &RCVL &QOUT +
 
                             'FILD0100' &QFNM '*FIRST' '1' '*LCL' +
 
                             'FILD0100' &QFNM '*FIRST' '1' '*LCL' +
Line 455: Line 493:
 
     /* ============================================================= */
 
     /* ============================================================= */
  
             ENDPGM  
+
             ENDPGM
 
</pre>
 
</pre>
  
Line 558: Line 596:
 
:cond    name=MBRVIEW2  expr='MBRVIEW=1'.
 
:cond    name=MBRVIEW2  expr='MBRVIEW=1'.
 
:cond    name=MBRVIEW3  expr='MBRVIEW=2'.
 
:cond    name=MBRVIEW3  expr='MBRVIEW=2'.
 
 
:tt      name=MBRTT    conds='MBRVIEW1 MBRVIEW2 MBRVIEW3'.
 
:tt      name=MBRTT    conds='MBRVIEW1 MBRVIEW2 MBRVIEW3'.
 
:ttrow  values='  1        0        0  '.
 
:ttrow  values='  1        0        0  '.
Line 585: Line 622:
 
:keyi    key=F11        help=CHGVIEW  action='CHGVIEW'    cond=MBRVIEW3.
 
:keyi    key=F11        help=CHGVIEW  action='CHGVIEW'    cond=MBRVIEW3.
 
F11=Member size
 
F11=Member size
 +
:keyi    key=F17        help=TOP      action='RETURN 2'.
 +
F17=Top of List
 +
:keyi    key=F18        help=BOTTOM    action='RETURN 3'.
 +
F18=End of List
 +
:keyi    key=F24        help=MOREKEYS  action='MOREKEYS'.
 +
F24=More keys
 
:keyi    key=ENTER      help=ENTERKY  action='ENTER'.
 
:keyi    key=ENTER      help=ENTERKY  action='ENTER'.
 
:keyi    key=HELP      help=HELPKY    action='HELP'.
 
:keyi    key=HELP      help=HELPKY    action='HELP'.
Line 612: Line 655:
 
:datai  var=LIBL      usage=INOUT.
 
:datai  var=LIBL      usage=INOUT.
 
Library
 
Library
:datac.Name, *ALL, *ALLUSER, *USRLIBL, *CURLIB
+
:datac.Name, *ALL, *ALLUSR, *USRLIBL, *CURLIB
 
:edatagrp.
 
:edatagrp.
 
:datai  var=MEMB      usage=INOUT    help='FNDSRCMBR/SRCMBR'.
 
:datai  var=MEMB      usage=INOUT    help='FNDSRCMBR/SRCMBR'.
Line 645: Line 688:
 
:listact option=3
 
:listact option=3
 
         enter='CMD ?CPYF ?*FROMFILE(&lib./&srcf.) ?*FROMMBR(&mbr.)'
 
         enter='CMD ?CPYF ?*FROMFILE(&lib./&srcf.) ?*FROMMBR(&mbr.)'
         enter='          ??TOMBR(*FROMMBR) ?*MBROPT(*REPLACE) &prm.'
+
         enter='          ??TOMBR(*FROMMBR) ??MBROPT(*REPLACE) &prm.'
 
         prompt='CMD ?CPYF ?*FROMFILE(&lib./&srcf.) ?*FROMMBR(&mbr.)'
 
         prompt='CMD ?CPYF ?*FROMFILE(&lib./&srcf.) ?*FROMMBR(&mbr.)'
         prompt='          ??TOMBR(*FROMMBR) ?*MBROPT(*REPLACE) &prm.'
+
         prompt='          ??TOMBR(*FROMMBR) ??MBROPT(*REPLACE) &prm.'
 
         help='MLIST/OPT3'.
 
         help='MLIST/OPT3'.
 
3=Copy
 
3=Copy
Line 714: Line 757:
 
:p.The Work with Source Member panel displays the libraries and member
 
:p.The Work with Source Member panel displays the libraries and member
 
names that were found by the Find Source Member (FNDSRCMBR) command.
 
names that were found by the Find Source Member (FNDSRCMBR) command.
:ehelp.
 
 
.*---------------------------------------------------------------------
 
:help    name='MLIST/HEADER'.
 
Source file - Help
 
:xh3.Source file
 
:p.This is the source file name that was requested.
 
:parml.
 
:pt.Library
 
:pd.
 
This is the libraries requested to search.
 
:eparml.
 
 
:ehelp.
 
:ehelp.
  
Line 895: Line 926:
 
:pd.
 
:pd.
 
Switches to an alternate view of the display.
 
Switches to an alternate view of the display.
 +
:eparml.
 +
:ehelp.
 +
 +
:help    name=TOP.
 +
:parml.
 +
:pt.F17=Top of List
 +
:pd.
 +
Position to the first entry in the list.
 +
:eparml.
 +
:ehelp.
 +
 +
:help    name=BOTTOM.
 +
:parml.
 +
:pt.F18=End of List
 +
:pd.
 +
Position to the last entry in the list.
 +
:eparml.
 +
:ehelp.
 +
 +
:help    name=MOREKEYS.
 +
:parml.
 +
:pt.F24=More keys
 +
:pd.
 +
Shows additional function keys on the display.  The function keys
 +
can be used even when they are not shown on the display.
 
:eparml.
 
:eparml.
 
:ehelp.
 
:ehelp.
Line 950: Line 1,006:
 
:p.The Find Source Member (FNDSRCMBR) command searches the specified
 
:p.The Find Source Member (FNDSRCMBR) command searches the specified
 
libraries for matching source file and member names.  The resulting
 
libraries for matching source file and member names.  The resulting
list displays in a subfile for subsequent optional processing.
+
list displays in a subfile for subsequent option processing.
 +
:ehelp.
 +
 
 +
.*******************************************
 +
.*  Help for parameter SRCMBR
 +
.*******************************************
 +
:help name='FNDSRCMBR/SRCMBR'.
 +
Source member (SRCMBR) - Help
 +
:xh3.Source member (SRCMBR)
 +
:p.This specifies the member name to search for in the specified
 +
source file(s).
 +
:p.This is a required parameter.
 +
:parml.
 +
:pt.:pv.name:epv.
 +
:pd.
 +
Specify the name of a specific source member to find.
 +
:pt.:pv.generic-name:epv.
 +
:pd.
 +
You may specify a generic source member name if you wish to find several
 +
members with the same prefix characters in their name.  To qualify as a
 +
generic name, the value specified must end with an asterisk.
 +
:pt.:pv.*:epv.
 +
:pd.
 +
Use this special value to match on all members in a source file.
 +
:eparml.
 
:ehelp.
 
:ehelp.
  
Line 961: Line 1,041:
 
:p.This specifies the source files to search for the specified
 
:p.This specifies the source files to search for the specified
 
member name(s).
 
member name(s).
:p.This is a required parameter.
 
 
:p.:hp2.Qualifier 1: Source file:ehp2.
 
:p.:hp2.Qualifier 1: Source file:ehp2.
 
:parml.
 
:parml.
 
:pt.:pv.name:epv.
 
:pt.:pv.name:epv.
 
:pd.
 
:pd.
Specify the source file name in which to search.  The default is the
+
Specify the name of a specific source physical file to be searched.  The
QRPGLESRC file, but any source file name may be specified.
+
default is the QRPGLESRC file, but any source file name may be specified.
 
:eparml.
 
:eparml.
 
:p.:hp2.Qualifier 2: Library:ehp2.
 
:p.:hp2.Qualifier 2: Library:ehp2.
 
:parml.
 
:parml.
:pt.:pk def.*LIBL:epk.
+
:pt.:pv.name:epv.
 +
:pd.
 +
Specify the name of the library to be searched.
 +
:pt.:pk def.*CURLIB:epk.
 
:pd.
 
:pd.
Specify this value to search only in the current library list and
+
The current library for the thread is searched.  If no library is
is the default.
+
specified as the current library for the thread, the QGPL library is
 +
searched.  This is the default.
 
:pt.:pk.*ALL:epk.
 
:pt.:pk.*ALL:epk.
 
:pd.
 
:pd.
Specify this value to search all system and user libraries.
+
All libraries in the system, including QSYS, are searched.
 
:pt.:pk.*ALLUSR:epk.
 
:pt.:pk.*ALLUSR:epk.
 
:pd.
 
:pd.
Specify this value to search all user libraries.
+
All user libraries are searched.  This includes all libraries with
 +
names that do not begin with the letter Q (with some exceptions).
 
:pt.:pk.*USRLIBL:epk.
 
:pt.:pk.*USRLIBL:epk.
 
:pd.
 
:pd.
This indicates that only user libraries in the current library list
+
The current library entry (if any) and the libraries in the user
are searched.
+
portion of the library list are searched.
 
:eparml.
 
:eparml.
 
:ehelp.
 
:ehelp.
  
.*******************************************
+
:epnlgrp.
.*  Help for parameter SRCMBR
 
.*******************************************
 
:help name='FNDSRCMBR/SRCMBR'.
 
Source member (SRCMBR) - Help
 
:xh3.Source member (SRCMBR)
 
:p.This specifies the member name to search for in the specified
 
source files.
 
:p.This is a required parameter.
 
:parml.
 
:pt.:pv.name:epv.
 
:pd.
 
Specify the name of a specific source member to find.
 
:pt.:pv.generic-name:epv.
 
:pd.
 
You may specify a generic source member name if you wish to find several
 
members with the same prefix characters in their name.  To qualify as a
 
generic name, the value specified must end with an asterisk.
 
:eparml.
 
:ehelp.
 
 
 
:epnlgrp.  
 
 
</pre>
 
</pre>
  
Line 1,018: Line 1,081:
 
* RPG/ILE version of [[Retrieve Database File Description (QDBRTVFD)]] API
 
* RPG/ILE version of [[Retrieve Database File Description (QDBRTVFD)]] API
 
* RPG/ILE version of [[UIM Open Display Application (QUIOPNDA)]] API
 
* RPG/ILE version of [[UIM Open Display Application (QUIOPNDA)]] API
 +
* RPG/ILE version of [[UIM Get Dialog Variable (QUIGETV)]] API
 
* RPG/ILE version of [[UIM Put Dialog Variable (QUIPUTV)]] API
 
* RPG/ILE version of [[UIM Put Dialog Variable (QUIPUTV)]] API
* RPG/ILE version of [[UIM Get Dialog Variable (QUIGETV)]] API
+
* RPG/ILE version of [[UIM Set List Attributes (QUISETLA)]] API
 
* RPG/ILE version of [[UIM Add List Entry (QUIADDLE)]] API
 
* RPG/ILE version of [[UIM Add List Entry (QUIADDLE)]] API
 
* RPG/ILE version of [[UIM Delete List (QUIDLTL)]] API
 
* RPG/ILE version of [[UIM Delete List (QUIDLTL)]] API
 
* RPG/ILE version of [[UIM Display Panel (QUIDSPP)]] API
 
* RPG/ILE version of [[UIM Display Panel (QUIDSPP)]] API
 +
* RPG/ILE version of [[UIM Close Application (QUICLOA)]] API

Latest revision as of 19:22, 7 January 2019

Summary

The following are the complete definitions and instructions needed for using the Find Source Member (FNDSRCMBR) command. This command searches for multiple occurrences of a specified (generic) member name, as found anywhere on the system (according to your specified filter criteria), and then uses a UIM list panel to allow you to work with them—while also making their attributes available for viewing. From that panel you can compare, change, copy, remove, display, and/or rename the members shown. Your enhancements to this code could form a basis for "the poor-man's PDM."

By Dave Clark

Sample Application

Note that the CL program included in this sample uses two different CL-based data structures. Thus, this is also an example of the easy way to use data structures in CL programming. The &VARBUF data structure is used with the UIM Put Dialog Variable (QUIPUTV) API and the UIM Add List Entry (QUIADDLE) API. The &APIERRC data structure is a CL/ILE version of the RPG/ILE API Error Code Structure (ApiErrC).

Command Definition

Place the following in a QCMDSRC member named FNDSRCMBR and compile it.

/******************************************************************************/
/* Program Name:      FNDSRCMBR -- Find Source Member                         */
/* Programmer:        Dave L Clark I                                          */
/* Date:              June 17, 2016                                           */
/* Project/Request #: JIRA IN-40 -- Create command to find source members     */
/* Purpose:           This command searches the specified libraries for a     */
/*                    matching source file and member name.  The resulting    */
/*                    list displays in a subfile for option processing.       */
/*----------------------------------------------------------------------------*/
/* Create as follows:                                                         */
/*                                                                            */
/*   CRTCMD CMD(*CURLIB/FNDSRCMBR) PGM(*LIBL/FNDSRCMBR)                       */
/*                                                                            */
/*----------------------------------------------------------------------------*/
/* Modification Log:                                                          */
/*                                                                            */
/* Mod#    Date       User       Description                                  */
/* ---- ---------- ---------- ----------------------------------------------- */
/* M000                                                                       */
/******************************************************************************/
 FNDSRCMBR:  CMD        PROMPT('Find Source Member') TEXT('Find +
                          Source Member') HLPID(*CMD) +
                          HLPPNLGRP(FNDSRCMBR)
             PARM       KWD(SRCMBR) TYPE(*GENERIC) LEN(10) MIN(1) +
                          SPCVAL(('*')) PROMPT('Source member')
             PARM       KWD(SRCFILE) TYPE(SRCF) PROMPT('Source file')
 SRCF:       QUAL       TYPE(*NAME) LEN(10) DFT(QRPGLESRC)
             QUAL       TYPE(*NAME) LEN(10) DFT(*CURLIB) +
                          SPCVAL((*ALL) (*ALLUSR) (*USRLIBL) +
                          (*CURLIB)) PROMPT('Library')

[top]

CL/ILE Program

Place the following in a QCLSRC or QCLLESRC member named FNDSRCMBR and compile it.

/******************************************************************************/
/* Program Name:      FNDSRCMBR -- Find Source Member                         */
/* Programmer:        Dave L Clark I                                          */
/* Date:              June 17, 2016                                           */
/* Project/Request #: JIRA IN-40 -- Create command to find source members     */
/* Purpose:           This command searches the specified libraries for a     */
/*                    matching source file and member name.  The resulting    */
/*                    list displays in a subfile for option processing.       */
/*----------------------------------------------------------------------------*/
/* Create as follows:                                                         */
/*                                                                            */
/*   CRTBNDCL PGM(*CURLIB/FNDSRCMBR) SRCFILE(*CURLIB/QCLSRC)                  */
/*                                                                            */
/*----------------------------------------------------------------------------*/
/* Modification Log:                                                          */
/*                                                                            */
/* Mod#    Date       User       Description                                  */
/* ---- ---------- ---------- ----------------------------------------------- */
/* M000                                                                       */
/******************************************************************************/
 FNDSRCMBR:  PGM        PARM(&SRCMBR &SRCFILE)

             DCLPRCOPT  TEXT('Find Source Member') +
                          DFTACTGRP(*NO) ACTGRP(QILE)

    /* parameter variables */
             DCL        VAR(&SRCMBR)    TYPE(*CHAR) LEN(10)
             DCL        VAR(&SRCFILE)   TYPE(*CHAR) LEN(20)
             DCL        VAR(&SRCF)      TYPE(*CHAR) LEN(10) +
                          STG(*DEFINED) DEFVAR(&SRCFILE 1)
             DCL        VAR(&SRCLIB)    TYPE(*CHAR) LEN(10) +
                          STG(*DEFINED) DEFVAR(&SRCFILE 11)

    /* work variables */
             DCL        VAR(&CONTINUE)  TYPE(*LGL)  LEN(1)   VALUE('1')
             DCL        VAR(&EOFSRC)    TYPE(*LGL)  LEN(1)   VALUE('0')
             DCL        VAR(&GOTMBR)    TYPE(*LGL)  LEN(1)   VALUE('0')
             DCL        VAR(&INTERACT)  TYPE(*CHAR) LEN(1)
             DCL        VAR(&FILEATRB)  TYPE(*CHAR) LEN(3)
             DCL        VAR(&FILETYPE)  TYPE(*CHAR) LEN(5)
             DCL        VAR(&MBROPT)    TYPE(*CHAR) LEN(5)
             DCL        VAR(&TIME)      TYPE(*CHAR) LEN(8)
             DCL        VAR(&DATE)      TYPE(*CHAR) LEN(10)
             DCL        VAR(&MBRNAME)   TYPE(*CHAR) LEN(10)
             DCL        VAR(&SRCTYPE)   TYPE(*CHAR) LEN(10)
             DCL        VAR(&CRTDATE)   TYPE(*CHAR) LEN(19)
             DCL        VAR(&CHGDATE)   TYPE(*CHAR) LEN(19)
             DCL        VAR(&MBRTEXT)   TYPE(*CHAR) LEN(50)
             DCL        VAR(&PFX)       TYPE(*DEC)  LEN(3 0)
             DCL        VAR(&RCDCOUNT)  TYPE(*DEC)  LEN(10 0)
             DCL        VAR(&DLTCOUNT)  TYPE(*DEC)  LEN(10 0)
             DCL        VAR(&MBRSIZE)   TYPE(*DEC)  LEN(15 0)

             DCL        VAR(&RCVR)      TYPE(*CHAR) LEN(400)
             DCL        VAR(&RCVL)      TYPE(*INT)  LEN(4) VALUE(400)
             DCL        VAR(&QOUT)      TYPE(*CHAR) LEN(20)
             DCL        VAR(&QFNM)      TYPE(*CHAR) LEN(20)

    /* bit testing */
             DCL        VAR(&CHAR)      TYPE(*CHAR) LEN(1)
             DCL        VAR(&BIT_2_ON)  TYPE(*LGL)  LEN(1)
             DCL        VAR(&BIT_4_ON)  TYPE(*LGL)  LEN(1)
             DCL        VAR(&BIT_POS)   TYPE(*INT)  LEN(4)

    /* API variables */
             DCL        VAR(&FULHLP)    TYPE(*CHAR) LEN(1)   VALUE('N')
             DCL        VAR(&REDSPO)    TYPE(*CHAR) LEN(1)   VALUE('N')
             DCL        VAR(&USRTSK)    TYPE(*CHAR) LEN(1)   VALUE('N')
             DCL        VAR(&CSTKC)     TYPE(*INT)  LEN(4)   VALUE(0)
             DCL        VAR(&CSTKQ)     TYPE(*CHAR) LEN(10)  VALUE('*CALLER')
             DCL        VAR(&MSGKEY)    TYPE(*CHAR) LEN(4)
             DCL        VAR(&CSROPT)    TYPE(*CHAR) LEN(1)   VALUE('D')
             DCL        VAR(&LSTENT)    TYPE(*CHAR) LEN(4)   VALUE('NONE')
             DCL        VAR(&ERRENT)    TYPE(*CHAR) LEN(4)   VALUE('NONE')
             DCL        VAR(&WTIME)     TYPE(*INT)  LEN(4)   VALUE(-1)
             DCL        VAR(&HANDLE)    TYPE(*CHAR) LEN(8)
             DCL        VAR(&MBRLST)    TYPE(*CHAR) LEN(10)  VALUE('MBRLST')
             DCL        VAR(&PNLGRP)    TYPE(*CHAR) LEN(20) +
                          VALUE('FNDSRCMBR *LIBL')
             DCL        VAR(&OPTION)    TYPE(*CHAR) LEN(4)
             DCL        VAR(&APPSCP)    TYPE(*INT)  LEN(4)   VALUE(-1)
             DCL        VAR(&EXTPRM)    TYPE(*INT)  LEN(4)
             DCL        VAR(&ERRCOD)    TYPE(*INT)  LEN(4)   VALUE(0)
             DCL        VAR(&FUNC)      TYPE(*INT)  LEN(4)   VALUE(5)
             DCL        VAR(&LEHNDL)    TYPE(*INT)  LEN(4)

  DCL VAR(&VARLEN) TYPE(*INT)  LEN(4)
  /* this buffer performs double duty for both panel header and list detail */
  DCL VAR(&VARBUF) TYPE(*CHAR) LEN(132)
    DCL VAR(&VAR_SRCLIB) TYPE(*CHAR) LEN(10)  STG(*DEFINED) DEFVAR(&VARBUF 1)
    DCL VAR(&VAR_SRCMBR) TYPE(*CHAR) LEN(10)  STG(*DEFINED) DEFVAR(&VARBUF 11)
    DCL VAR(&VAR_MBRTYP) TYPE(*CHAR) LEN(10)  STG(*DEFINED) DEFVAR(&VARBUF 21)
    DCL VAR(&VAR_MBRTXT) TYPE(*CHAR) LEN(50)  STG(*DEFINED) DEFVAR(&VARBUF 31)
    DCL VAR(&VAR_CRTDAT) TYPE(*CHAR) LEN(19)  STG(*DEFINED) DEFVAR(&VARBUF 81)
    DCL VAR(&VAR_CHGDAT) TYPE(*CHAR) LEN(19)  STG(*DEFINED) DEFVAR(&VARBUF 100)
    DCL VAR(&VAR_RCDCNT) TYPE(*DEC) LEN(10 0) STG(*DEFINED) DEFVAR(&VARBUF 119)
    DCL VAR(&VAR_MBRSIZ) TYPE(*DEC) LEN(15 0) STG(*DEFINED) DEFVAR(&VARBUF 125)

    /* error handling variables */
             DCL        VAR(&MSGID)     TYPE(*CHAR) LEN(7)
             DCL        VAR(&MSGF)      TYPE(*CHAR) LEN(10)  VALUE('QCPFMSG')
             DCL        VAR(&MSGLIB)    TYPE(*CHAR) LEN(10)  VALUE('*LIBL')
             DCL        VAR(&MSGDATA)   TYPE(*CHAR) LEN(3000)

  DCL VAR(&APIERRC) TYPE(*CHAR) LEN(3016)
    DCL VAR(&API_BPROV) TYPE(*UINT)  LEN(4)   STG(*DEFINED) DEFVAR(&APIERRC 1)
    DCL VAR(&API_BAVAIL) TYPE(*UINT) LEN(4)   STG(*DEFINED) DEFVAR(&APIERRC 5)
    DCL VAR(&API_MSGID) TYPE(*CHAR)  LEN(7)   STG(*DEFINED) DEFVAR(&APIERRC 9)
    DCL VAR(&API_RSRVD) TYPE(*CHAR)  LEN(1)   STG(*DEFINED) DEFVAR(&APIERRC 16)
    DCL VAR(&API_MDATA) TYPE(*CHAR) LEN(3000) STG(*DEFINED) DEFVAR(&APIERRC 17)

    /* work files */
             DCLF       FILE(QAFDBASI) OPNID(SRC) ALWVARLEN(*YES)

    /* ============================================================= */
    /* =======================   S E T U P   ======================= */
    /* ============================================================= */
             OVRMSGF    MSGF(&MSGF) TOMSGF(&MSGLIB/&MSGF)

             RTVJOBA    TYPE(&INTERACT)

    /* verify source file attributes */
             CALLSUBR   SUBR(VFY_SRCF)

    /* ============================================================= */
    /* ============   B E G I N   P R O C E S S I N G   ============ */
    /* ============================================================= */

    /* open the display application */
             CALL       PGM(QUIOPNDA) PARM(&HANDLE &PNLGRP &APPSCP +
                          &EXTPRM &FULHLP &ERRCOD)
             MONMSG     MSGID(CPF0000 CPE0000 CPD0000) EXEC(GOTO +
                          CMDLBL(ABORT))

    /* put panel id and source file name on the screen */
             CHGVAR     VAR(&VAR_SRCLIB) VALUE(&PNLGRP)
             CHGVAR     VAR(&VAR_SRCMBR) VALUE(&SRCF)
             CHGVAR     VAR(&VAR_MBRTYP) VALUE(&SRCLIB)
             CHGVAR     VAR(&VAR_MBRTXT) VALUE(&SRCMBR)
             CHGVAR     VAR(&VARLEN) VALUE(40)
             CALL       PGM(QUIPUTV) PARM(&HANDLE &VARBUF &VARLEN +
                          'HEADER' &ERRCOD)
             MONMSG     MSGID(CPF0000 CPE0000 CPD0000) EXEC(GOTO +
                          CMDLBL(ABORT))

    /* loop on screen interactions */
             DOWHILE    COND(&CONTINUE)

                IF         COND(&FUNC *EQ 5) THEN(DO) /* (re)build list? */

             /* retrieve available file descriptions */
                   SNDPGMMSG  MSGID(CPF9897) MSGF(&MSGF) MSGDTA('Searching +
                                for source files...') TOPGMQ(*EXT) +
                                MSGTYPE(*STATUS)

                /* special handling for *USRLIBL filter */
                   IF         COND(&SRCLIB *EQ *USRLIBL) THEN(DO)
                      CHGVAR     VAR(&SRCF) VALUE(&SRCF *TCAT '*')
                   ENDDO

                /* list matching files into an output file */
                   DSPFD      FILE(&SRCLIB/&SRCF) TYPE(*BASATR) +
                                OUTPUT(*OUTFILE) OUTFILE(QTEMP/SRCFLIST) +
                                OUTMBR(*FIRST *REPLACE)
                   MONMSG     MSGID(CPF0000 CPE0000 CPD0000) EXEC(GOTO +
                                CMDLBL(ABORT))

             /* override to the source file list */
                   OVRDBF     FILE(QAFDBASI) TOFILE(QTEMP/SRCFLIST)
                   CHGVAR     VAR(&EOFSRC) VALUE('0')

             /* retrieve matching member descriptions */
                   SNDPGMMSG  MSGID(CPF9897) MSGF(&MSGF) MSGDTA('Building +
                                member list...') TOPGMQ(*EXT) +
                                MSGTYPE(*STATUS)

                   CHGVAR     VAR(&OPTION) VALUE('FRST')

                /* build member list */
                   DOWHILE (*NOT &EOFSRC)
                      CALLSUBR   SUBR(GET_SRCF)
                      IF         COND(*NOT &EOFSRC) THEN(DO)
                         IF         COND(&SRCMBR *EQ '*') THEN(DO)
                            CHGVAR     VAR(&MBRNAME) VALUE(*FIRSTMBR)
                         ENDDO
                         ELSE       CMD(DO)
                            CHGVAR     VAR(&MBRNAME) VALUE(&SRCMBR)
                         ENDDO
                         CHGVAR     VAR(&MBROPT) VALUE(*SAME)
                         CALLSUBR   SUBR(GET_MBRD)
                         IF         COND(*NOT &GOTMBR) THEN(DO)
                            ITERATE
                         ENDDO
                         CALLSUBR   SUBR(PUT_MBRD)
                         CHGVAR     VAR(&MBROPT) VALUE(*NEXT)
                         DOWHILE    COND(&MBRNAME *NE &SRCMBR)
                            CALLSUBR   SUBR(GET_MBRD)
                            IF         COND(&GOTMBR) THEN(DO)
                               CALLSUBR   SUBR(PUT_MBRD)
                            ENDDO
                         ENDDO
                      ENDDO
                   ENDDO

                   SNDPGMMSG  MSGID(CPF9897) MSGF(&MSGF) MSGDTA(' ') +
                                TOPGMQ(*EXT) MSGTYPE(*STATUS)

                ENDDO

          /* display the panel */
                CALL       PGM(QUIDSPP) PARM(&HANDLE &FUNC 'WRKSRCM' +
                             &REDSPO &ERRCOD &USRTSK &CSTKC  &CSTKQ +
                             &MSGKEY &CSROPT &LSTENT &ERRENT &WTIME)
                MONMSG     MSGID(CPF0000 CPE0000 CPD0000) EXEC(GOTO +
                             CMDLBL(ABORT))

          /* user pressed F3=EXIT key? */
                IF         COND(&FUNC *LT 0) THEN(DO)
                   CHGVAR     VAR(&CONTINUE) VALUE('0')
                ENDDO

          /* user pressed ENTER key? */
                IF         COND(&FUNC *EQ 1) THEN(DO)
                   CHGVAR     VAR(&VARLEN) VALUE(40)
                   CALL       PGM(QUIGETV) PARM(&HANDLE &VARBUF &VARLEN +
                                'HEADER' &ERRCOD)
                   MONMSG     MSGID(CPF0000 CPE0000 CPD0000) EXEC(GOTO +
                                CMDLBL(ABORT))
                   CHGVAR     VAR(&SRCF) VALUE(&VAR_SRCMBR)
                   CHGVAR     VAR(&SRCLIB) VALUE(&VAR_MBRTYP)
                   CHGVAR     VAR(&SRCMBR) VALUE(&VAR_MBRTXT)
                   CALLSUBR   SUBR(VFY_SRCF)
                   CHGVAR     VAR(&VAR_SRCMBR) VALUE(&SRCF)
                   CHGVAR     VAR(&VAR_MBRTYP) VALUE(&SRCLIB)
                   CHGVAR     VAR(&VAR_MBRTXT) VALUE(&SRCMBR)
                   CHGVAR     VAR(&VARLEN) VALUE(40)
                   CALL       PGM(QUIPUTV) PARM(&HANDLE &VARBUF &VARLEN +
                                'HEADER' &ERRCOD)
                   MONMSG     MSGID(CPF0000 CPE0000 CPD0000) EXEC(GOTO +
                                CMDLBL(ABORT))
                   CHGVAR     VAR(&FUNC) VALUE(5) /* do refresh */
                ENDDO

          /* user pressed F17=TOP key? */
                IF         COND(&FUNC *EQ 2) THEN(DO)
                   CALL       PGM(QUISETLA) PARM(&HANDLE &MBRLST 'SAME' +
                                '*SAME' 'TOP' 'S' &ERRCOD)
                   MONMSG     MSGID(CPF0000 CPE0000 CPD0000) EXEC(GOTO +
                                CMDLBL(ABORT))
                ENDDO

          /* user pressed F18=BOTTOM key? */
                IF         COND(&FUNC *EQ 3) THEN(DO)
                   CALL       PGM(QUISETLA) PARM(&HANDLE &MBRLST 'SAME' +
                                '*SAME' 'BOT' 'S' &ERRCOD)
                   MONMSG     MSGID(CPF0000 CPE0000 CPD0000) EXEC(GOTO +
                                CMDLBL(ABORT))
                ENDDO

          /* user requested a F5=REFRESH? */
                IF         COND(&FUNC *EQ 5 +
                           *AND &OPTION *NE 'FRST') THEN(DO)
                /* delete subfile on refresh */
                   CALL       PGM(QUIDLTL) PARM(&HANDLE &MBRLST &ERRCOD)
                ENDDO

          /* close the source file list and remove override */
                CLOSE      OPNID(SRC)

                DLTOVR     FILE(QAFDBASI)
                MONMSG     MSGID(CPF9841) EXEC(DO)
                   RCVMSG     MSGTYPE(*LAST) RMV(*YES)
                ENDDO

    /* loop on screen interactions */
             ENDDO

    /* close the display application */
             CALL       PGM(QUICLOA) PARM(&HANDLE 'M' &ERRCOD)
             MONMSG     MSGID(CPF0000 CPE0000 CPD0000) EXEC(GOTO +
                          CMDLBL(ABORT))

    /* ============================================================= */
    /* ===========   E N D   O F   P R O C E S S I N G   =========== */
    /* ============================================================= */
             RETURN
 ABORT:
    /* if running interactively, relay message to line 24 of menu    */
             IF         COND(&INTERACT *EQ '1') THEN(DO)
                RCVMSG     MSGTYPE(*LAST) RMV(*NO) MSGDTA(&MSGDATA) +
                             MSGID(&MSGID) MSGF(&MSGF) MSGFLIB(&MSGLIB)
                SNDPGMMSG  MSGID(&MSGID) MSGF(&MSGLIB/&MSGF) +
                             MSGDTA(&MSGDATA) TOPGMQ(*PRV) +
                             MSGTYPE(*ESCAPE)
             ENDDO
    /* else...                                                       */
             ELSE       CMD(DO)
                CHGJOB     LOG(4 *SAME *SECLVL) /* print joblog */
             ENDDO

             RETURN

    /* ============================================================= */
    /* =============   G E T   S O U R C E   F I L E   ============= */
    /* ============================================================= */
 GET_SRCF:   SUBR       SUBR(GET_SRCF)
                RCVF       OPNID(SRC)
                MONMSG     MSGID(CPF0864) EXEC(DO)
                   CHGVAR     VAR(&EOFSRC) VALUE('1')
                ENDDO
             ENDSUBR

    /* ============================================================= */
    /* ======   G E T   M E M B E R   D E S C R I P T I O N   ====== */
    /* ============================================================= */
 GET_MBRD:   SUBR       SUBR(GET_MBRD)
                CHGVAR     VAR(&GOTMBR) VALUE('1')
                RTVMBRD    FILE(&SRC_ATLIB/&SRC_ATFILE) MBR(&MBRNAME +
                             &MBROPT) RTNMBR(&MBRNAME) SRCTYPE(&SRCTYPE) +
                             SRCCHGDATE(&CHGDATE) CRTDATE(&CRTDATE) +
                             TEXT(&MBRTEXT) NBRCURRCD(&RCDCOUNT) +
                             NBRDLTRCD(&DLTCOUNT) DTASPCSIZ(&MBRSIZE)
                /* end of member list? */
                MONMSG     MSGID(CPF3018 CPF3019 CPF3049 CPF9815) EXEC(DO)
                   RCVMSG     MSGTYPE(*LAST) RMV(*YES)
                   CHGVAR     VAR(&MBRNAME) VALUE(&SRCMBR)
                   CHGVAR     VAR(&GOTMBR) VALUE('0')
                ENDDO
                IF         COND(&GOTMBR +
                           *AND &MBROPT *EQ '*NEXT') THEN(DO)
                   /* end of generic member list? */
                   IF         COND(&PFX *GT 0) THEN(DO)
                      IF         COND(%SST(&SRCMBR 1 &PFX) +
                                  *NE %SST(&MBRNAME 1 &PFX)) THEN(DO)
                         CHGVAR     VAR(&MBRNAME) VALUE(&SRCMBR)
                         CHGVAR     VAR(&GOTMBR) VALUE('0')
                      ENDDO
                   ENDDO
                ENDDO
             ENDSUBR

    /* ============================================================= */
    /* ======   P U T   M E M B E R   D E S C R I P T I O N   ====== */
    /* ============================================================= */
 PUT_MBRD:   SUBR       SUBR(PUT_MBRD)
                CHGVAR     VAR(&VAR_SRCLIB) VALUE(&SRC_ATLIB)
                CHGVAR     VAR(&VAR_SRCMBR) VALUE(&MBRNAME)
                CHGVAR     VAR(&VAR_MBRTYP) VALUE(&SRCTYPE)
                CHGVAR     VAR(&VAR_MBRTXT) VALUE(&MBRTEXT)

                IF         COND(%SST(&CRTDATE 1 1) *EQ '0') THEN(DO)
                   CHGVAR     VAR(&DATE) VALUE('19' || %SST(&CRTDATE 2 2) +
                                 *CAT '/' *CAT %SST(&CRTDATE 4 2) +
                                 *CAT '/' *CAT %SST(&CRTDATE 6 2))
                ENDDO
                ELSE       CMD(DO)
                   CHGVAR     VAR(&DATE) VALUE('20' || %SST(&CRTDATE 2 2) +
                                 *CAT '/' *CAT %SST(&CRTDATE 4 2) +
                                 *CAT '/' *CAT %SST(&CRTDATE 6 2))
                ENDDO
                CHGVAR     VAR(&TIME) VALUE(%SST(&CRTDATE  8 2) +
                              *CAT ':' *CAT %SST(&CRTDATE 10 2) +
                              *CAT ':' *CAT %SST(&CRTDATE 12 2))
                CHGVAR     VAR(&VAR_CRTDAT) VALUE(&DATE *BCAT &TIME)

                IF         COND(%SST(&CHGDATE 1 1) *EQ '0') THEN(DO)
                   CHGVAR     VAR(&DATE) VALUE('19' || %SST(&CHGDATE 2 2) +
                                 *CAT '/' *CAT %SST(&CHGDATE 4 2) +
                                 *CAT '/' *CAT %SST(&CHGDATE 6 2))
                ENDDO
                ELSE       CMD(DO)
                   CHGVAR     VAR(&DATE) VALUE('20' || %SST(&CHGDATE 2 2) +
                                 *CAT '/' *CAT %SST(&CHGDATE 4 2) +
                                 *CAT '/' *CAT %SST(&CHGDATE 6 2))
                ENDDO
                CHGVAR     VAR(&TIME) VALUE(%SST(&CHGDATE  8 2) +
                              *CAT ':' *CAT %SST(&CHGDATE 10 2) +
                              *CAT ':' *CAT %SST(&CHGDATE 12 2))
                CHGVAR     VAR(&VAR_CHGDAT) VALUE(&DATE *BCAT &TIME)

                CHGVAR     VAR(&VAR_RCDCNT) VALUE(&RCDCOUNT)
                CHGVAR     VAR(&VAR_MBRSIZ) VALUE(&MBRSIZE)

                CHGVAR     VAR(&VARLEN) VALUE(132)
                CALL       PGM(QUIADDLE) PARM(&HANDLE &VARBUF &VARLEN +
                             'MEMBERS' &MBRLST &OPTION &LEHNDL &ERRCOD)
                CHGVAR     VAR(&OPTION) VALUE('NEXT')
             ENDSUBR

    /* ============================================================= */
    /* ==========   V E R I F Y   S O U R C E   F I L E   ========== */
    /* ============================================================= */
 VFY_SRCF:   SUBR       SUBR(VFY_SRCF) /* verify source file attributes */
                CHGVAR     VAR(&QFNM) VALUE(&SRCF *CAT '*LIBL')
                CHGVAR     VAR(&API_BPROV) VALUE(%LEN(&APIERRC))
                CALL       PGM(QDBRTVFD) PARM(&RCVR &RCVL &QOUT +
                             'FILD0100' &QFNM '*FIRST' '1' '*LCL' +
                             '*INT' &APIERRC)
                IF         COND(&API_BAVAIL *GT 0) THEN(DO)
                   SNDPGMMSG  MSGID(&API_MSGID) MSGF(QCPFMSG) +
                                MSGDTA(&API_MDATA) MSGTYPE(*ESCAPE)
                ENDDO

                CHGVAR     VAR(&CHAR) VALUE(%SST(&RCVR 9 1)) /* atrb byte */

                CHGVAR     VAR(&BIT_POS) VALUE(2) /* test file atrb bit */
                CALLPRC    PRC('_TSTBTS') PARM((&CHAR) (&BIT_POS *BYVAL)) +
                             RTNVAL(&BIT_POS)
                CHGVAR     VAR(&BIT_2_ON) VALUE(&BIT_POS *EQ 1)

                CHGVAR     VAR(&BIT_POS) VALUE(4) /* test file type bit */
                CALLPRC    PRC('_TSTBTS') PARM((&CHAR) (&BIT_POS *BYVAL)) +
                             RTNVAL(&BIT_POS)
                CHGVAR     VAR(&BIT_4_ON) VALUE(&BIT_POS *EQ 1)

                IF         (&BIT_2_ON) +
                              (CHGVAR &FILEATRB *LF)   /* on  = lf   */
                ELSE       CMD(CHGVAR &FILEATRB *PF)   /* off = pf   */
                IF         (&BIT_4_ON) +
                              (CHGVAR &FILETYPE *SRC)  /* on  = src  */
                ELSE       CMD(CHGVAR &FILETYPE *DATA) /* off = data */

                IF         COND(&FILEATRB *NE '*PF' +
                            *OR &FILETYPE *NE '*SRC') THEN(DO)
                   SNDPGMMSG  MSGID(CPF9897) MSGF(&MSGF) MSGDTA('File is +
                                not a physical source file.') +
                                MSGTYPE(*ESCAPE)
                ENDDO

             /* set length of generic prefix */
                CHGVAR     VAR(&PFX) VALUE(1)
                DOWHILE    COND(%SST(&SRCMBR &PFX 1) *NE '*' +
                           *AND &PFX *LT 10)
                   CHGVAR     VAR(&PFX) VALUE(&PFX + 1)
                ENDDO
                IF         COND(%SST(&SRCMBR &PFX 1) *EQ '*') THEN(DO)
                   CHGVAR     VAR(&PFX) VALUE(&PFX - 1)
                ENDDO
             ENDSUBR

    /* ============================================================= */

             ENDPGM

[top]

UIM Panel Group

Place the following in a QPNLSRC member named FNDSRCMBR and compile it.

.******************************************************************************
.* Program Name:      FNDSRCMBR -- Find Source Member                         *
.* Programmer:        Dave L Clark I                                          *
.* Date:              June 17, 2016                                           *
.* Project/Request #: JIRA IN-40 -- Create command to find source members     *
.* Purpose:           This command searches the specified libraries for a     *
.*                    matching source file and member name.  The resulting    *
.*                    list displays in a subfile for option processing.       *
.*----------------------------------------------------------------------------*
.* Create as follows:                                                         *
.*                                                                            *
.*   CRTPNLGRP PNLGRP(*CURLIB/FNDSRCMBR) SRCFILE(*CURLIB/QPNLSRC)             *
.*                                                                            *
.*----------------------------------------------------------------------------*
.* Modification Log:                                                          *
.*                                                                            *
.* Mod#    Date       User       Description                                  *
.* ---- ---------- ---------- ----------------------------------------------- *
.* M000                                                                       *
.******************************************************************************
:pnlgrp.

.*=====================================================================
.* Define data classes
.*=====================================================================
:class   name=BIN2      basetype='BIN 15'.
:eclass.
:class   name=OPTCLS    basetype='ACTION'.
:eclass.
:class   name=OBJCLS    basetype='OBJNAME 10'.
:eclass.
:class   name=OBJLIB    basetype='OBJNAME 10'.
:tl.
:ti      value='"*ALL"'.
*ALL
:ti      value='"*ALLUSR"'.
*ALLUSR
:ti      value='"*USRLIBL"'.
*USRLIBL
:ti      value='"*CURLIB"'.
*CURLIB
:etl.
:eclass.
:class   name=GENCLS    basetype='NAME 10 GENERIC'.
:tl.
:ti      value='"*"'.
*
:etl.
:eclass.
:class   name=INTCLS10  basetype='PACKED 10 0'.
:eclass.
:class   name=INTCLS15  basetype='PACKED 15 0'.
:eclass.
:class   name=DTETME    basetype='CHAR 19'.
:eclass.
:class   name=TXTCLS    basetype='CHAR 50'.
:eclass.
:class   name=PRMCLS    basetype='CHAR 255'.
:eclass.

.*============================~========================================
.* Define data variables
.*=====================================================================
:var     name=PNLID     class=OBJCLS.
:var     name=SRCF      class=OBJCLS.
:var     name=LIBL      class=OBJLIB.
:var     name=MEMB      class=GENCLS.
:var     name=MBRVIEW   class=BIN2.

:var     name=OPT       class=OPTCLS.
:var     name=LIB       class=OBJCLS.
:var     name=MBR       class=OBJCLS.
:var     name=TYP       class=OBJCLS.
:var     name=REC       class=INTCLS10.
:var     name=SIZ       class=INTCLS15.
:var     name=CRT       class=DTETME.
:var     name=CHG       class=DTETME.
:var     name=TXT       class=TXTCLS.

:var     name=PRM       class=PRMCLS.

.*====================================================================
.* Define variable records and list definition
.*====================================================================
:varrcd  name=HEADER    vars='PNLID SRCF LIBL MEMB'.
:varrcd  name=MEMBERS   vars='LIB MBR TYP TXT CRT CHG REC SIZ'.

:listdef name=MBRLST    vars='OPT LIB MBR TYP TXT CRT CHG REC SIZ'.

.*====================================================================
.* Define conditions and truth tables
.*====================================================================
:cond    name=MBRVIEW1  expr='MBRVIEW=0'.
:cond    name=MBRVIEW2  expr='MBRVIEW=1'.
:cond    name=MBRVIEW3  expr='MBRVIEW=2'.
:tt      name=MBRTT     conds='MBRVIEW1 MBRVIEW2 MBRVIEW3'.
:ttrow   values='   1        0        0   '.
:ttrow   values='   0        1        0   '.
:ttrow   values='   0        0        1   '.
:ett.

.*=====================================================================
.* Define the key list
.*=====================================================================
:keyl    name=KEYS      help=KLIST.
:keyi    key=F1         help=HELP      action='HELP'.
F1=Help
:keyi    key=F3         help=EXIT      action='EXIT SET'   varupd=NO.
F3=Exit
:keyi    key=F4         help=PROMPT    action='PROMPT'.
F4=Prompt
:keyi    key=F5         help=REFRESH   action='RETURN 5'   varupd=NO.
F5=Refresh
:keyi    key=F9         help=RETRIEVE  action='RETRIEVE'.
F9=Retrieve
:keyi    key=F11        help=CHGVIEW   action='CHGVIEW'    cond=MBRVIEW1.
F11=Member dates
:keyi    key=F11        help=CHGVIEW   action='CHGVIEW'    cond=MBRVIEW2.
F11=Member text
:keyi    key=F11        help=CHGVIEW   action='CHGVIEW'    cond=MBRVIEW3.
F11=Member size
:keyi    key=F17        help=TOP       action='RETURN 2'.
F17=Top of List
:keyi    key=F18        help=BOTTOM    action='RETURN 3'.
F18=End of List
:keyi    key=F24        help=MOREKEYS  action='MOREKEYS'.
F24=More keys
:keyi    key=ENTER      help=ENTERKY   action='ENTER'.
:keyi    key=HELP       help=HELPKY    action='HELP'.
:keyi    key=PAGEUP     help=PAGEUPKY  action='PAGEUP'.
:keyi    key=PAGEDOWN   help=PAGEDNKY  action='PAGEDOWN'.
:keyi    key=PRINT      help=PRINTKY   action='PRINT'.
:ekeyl.

.*=====================================================================
.* Define the panel
.*=====================================================================
:panel   name=WRKSRCM   help=MLIST     keyl=KEYS      enter='RETURN 1'
         panelid=PNLID  depth=FIT      width=80       topsep=SYSNAM
         tt=mbrtt.
Work with Source Member

:data    depth=4.
:datacol width=20.
:datacol width=12.
:datacol width='*'.

:datagrp grpsep=NONE    COMPACT.
:datagrp grpsep=QINDENT COMPACT        help='FNDSRCMBR/SRCFILE'.
:datai   var=SRCF       usage=INOUT.
Source file
:datac.Name
:datai   var=LIBL       usage=INOUT.
Library
:datac.Name, *ALL, *ALLUSR, *USRLIBL, *CURLIB
:edatagrp.
:datai   var=MEMB       usage=INOUT    help='FNDSRCMBR/SRCMBR'.
Source member
:datac.Name, generic*, *
:edatagrp.

:edata.

.*=====================================================================
.* Define the List
.*=====================================================================
:list    actor=UIM      depth='*'      extact=NO      listdef=MBRLST
         maxhead=1      maxactl=1      view=MBRVIEW   parms=PRM.

:topinst.Type options, press Enter.

.*---------------------------------------------------------------------
.* Define the actions for each option in the list
.*---------------------------------------------------------------------
:listact option=1
         enter='CMD ?CMPPFM ?*NEWFILE(&lib./&srcf.) ?*NEWMBR(&mbr.) &prm.'
         prompt='CMD ?CMPPFM ?*NEWFILE(&lib./&srcf.) ?*NEWMBR(&mbr.) &prm.'
         help='MLIST/OPT1'.
1=Compare
:listact option=2
         enter='CMD ?CHGPFM ?*FILE(&lib./&srcf.) ?*MBR(&mbr.)'
         enter=' ?-EXPDATE() ?-SHARE() ?-UNIT() &prm.'
         prompt='CMD ?CHGPFM ?*FILE(&lib./&srcf.) ?*MBR(&mbr.) &prm.'
         help='MLIST/OPT2'.
2=Change
:listact option=3
         enter='CMD ?CPYF ?*FROMFILE(&lib./&srcf.) ?*FROMMBR(&mbr.)'
         enter='          ??TOMBR(*FROMMBR) ??MBROPT(*REPLACE) &prm.'
         prompt='CMD ?CPYF ?*FROMFILE(&lib./&srcf.) ?*FROMMBR(&mbr.)'
         prompt='          ??TOMBR(*FROMMBR) ??MBROPT(*REPLACE) &prm.'
         help='MLIST/OPT3'.
3=Copy
:listact option=4
         enter='CMD ?RMVM ?*FILE(&lib./&srcf.) ?*MBR(&mbr.) &prm.'
         prompt='CMD ?RMVM ?*FILE(&lib./&srcf.) ?*MBR(&mbr.) &prm.'
         help='MLIST/OPT4'.
4=Remove
:listact option=5
         enter='CMD DSPPFM FILE(&lib./&srcf.) MBR(&mbr.) &prm.'
         prompt='CMD ?DSPPFM ?*FILE(&lib./&srcf.) ?*MBR(&mbr.) &prm.'
         help='MLIST/OPT5'.
5=Display
:listact option=7
         enter='CMD ?RNMM ?*FILE(&lib./&srcf.) ?*MBR(&mbr.) &prm.'
         prompt='CMD ?RNMM ?*FILE(&lib./&srcf.) ?*MBR(&mbr.) &prm.'
         help='MLIST/OPT7'.
7=Rename

.*---------------------------------------------------------------------
.* Define the columns and headings in the list
.*---------------------------------------------------------------------
:listcol var=OPT        usage=INOUT    maxwidth=2     help='MLIST/OPTIONS'.
Op
:listcol var=LIB        usage=OUT      maxwidth=10    help='MLIST/LIB'.
Library
:listcol var=MBR        usage=OUT      maxwidth=10    help='MLIST/MBR'.
Member
:listcol var=TYP        usage=OUT      maxwidth=10    help='MLIST/TYP'.
Type
:listcol var=REC        usage=OUT      maxwidth=11    help='MLIST/REC'.
Records
:listcol var=SIZ        usage=OUT      maxwidth=16    help='MLIST/SIZ'.
Size
:listcol var=CRT        usage=OUT      maxwidth=19    help='MLIST/CRT'.
Created
:listcol var=CHG        usage=OUT      maxwidth=19    help='MLIST/CHG'.
'Last changed'
:listcol var=TXT        usage=OUT      maxwidth=50    help='MLIST/TXT'.
Text

.*---------------------------------------------------------------------
.* Define the views in the list (toggle with F11)
.*---------------------------------------------------------------------
:listview cols='OPT LIB MBR TYP REC SIZ'.
:listview cols='OPT LIB MBR CRT CHG'.
:listview cols='OPT LIB MBR TXT'.

:elist.

.*---------------------------------------------------------------------
.* include a command line that allows parameters for options
.*---------------------------------------------------------------------
:cmdline size=SHORT.Parameters or command

.*=====================================================================
.* End of panel
.*=====================================================================
:epanel.

.*=====================================================================
.*  Help for member list display
.*=====================================================================
:help    name=MLIST.
Work with Source Member - Help
:p.The Work with Source Member panel displays the libraries and member
names that were found by the Find Source Member (FNDSRCMBR) command.
:ehelp.

.*---------------------------------------------------------------------
:help    name='MLIST/OPTIONS'.
Options - Help
:xh3.Options
:ehelp.

:help    name='MLIST/OPT1'.
:parml.
:pt.1=Compare
:pd.
Compare a source member with an older member.
:eparml.
:ehelp.

:help    name='MLIST/OPT2'.
:parml.
:pt.2=Change
:pd.
Change a source member's attributes.
:eparml.
:ehelp.

:help    name='MLIST/OPT3'.
:parml.
:pt.3=Copy
:pd.
Copy a source member to a new member.
:eparml.
:ehelp.

:help    name='MLIST/OPT4'.
:parml.
:pt.4=Remove
:pd.
Remove (delete) a source member from its source file.
:eparml.
:ehelp.

:help    name='MLIST/OPT5'.
:parml.
:pt.5=Display
:pd.
Display the content of a source member.
:eparml.
:ehelp.

:help    name='MLIST/OPT7'.
:parml.
:pt.7=Rename
:pd.
Rename a source member to a new member name.
:eparml.
:ehelp.

.*---------------------------------------------------------------------
:help    name='MLIST/LIB'.
Library - Help
:xh3.Library
:p.This is the library in which the source member was found.
:ehelp.

.*---------------------------------------------------------------------
:help    name='MLIST/MBR'.
Member - Help
:xh3.Member
:p.This is the name of the source member found.
:ehelp.

.*---------------------------------------------------------------------
:help    name='MLIST/TYP'.
Type - Help
:xh3.Type
:p.This is the associated member source type.
:ehelp.

.*---------------------------------------------------------------------
:help    name='MLIST/REC'.
Records - Help
:xh3.Records
:p.This is the number of records in the source member.
:ehelp.

.*---------------------------------------------------------------------
:help    name='MLIST/SIZ'.
Size - Help
:xh3.Size
:p.This is the size (in bytes) of the source member.
:ehelp.

.*---------------------------------------------------------------------
:help    name='MLIST/CRT'.
Created - Help
:xh3.Created
:p.This is the date and time the source member was created.
:ehelp.

.*---------------------------------------------------------------------
:help    name='MLIST/CHG'.
Changed - Help
:xh3.Changed
:p.This is the date and time the source member was last changed.
:ehelp.

.*---------------------------------------------------------------------
:help    name='MLIST/TXT'.
Text - Help
:xh3.Text
:p.This is the associated source member's text description.
:ehelp.

.*---------------------------------------------------------------------
:help    name=KLIST.
Function Keys - Help
:xh3.Function keys
:ehelp.

:help    name=HELP.
:parml.
:pt.F1=Help
:pd.
Provides additional information about using the display or a
specific field on the display.
:eparml.
:ehelp.

:help    name=EXIT.
:parml.
:pt.F3=Exit
:pd.
Ends the current task and returns to the display from which the
task was started.
:eparml.
:ehelp.

:help    name=PROMPT.
:parml.
:pt.F4=Prompt
:pd.
Provides assistance in typing additional parameter values for an
option or in using a command.
:eparml.
:ehelp.

:help    name=REFRESH.
:parml.
:pt.F5=Refresh
:pd.
Shows the display you are viewing with updated information.
:eparml.
:ehelp.

:help    name=RETRIEVE.
:parml.
:pt.F9=Retrieve
:pd.
Displays the last command you entered on the command line and
any parameters you included.  The first time this key is pressed, it
shows the last command you ran.  The second time this key is pressed,
it shows the command you ran before that -- and so on.
:eparml.
:ehelp.

:help    name=CHGVIEW.
:parml.
:pt.F11=Alternate view
:pd.
Switches to an alternate view of the display.
:eparml.
:ehelp.

:help    name=TOP.
:parml.
:pt.F17=Top of List
:pd.
Position to the first entry in the list.
:eparml.
:ehelp.

:help    name=BOTTOM.
:parml.
:pt.F18=End of List
:pd.
Position to the last entry in the list.
:eparml.
:ehelp.

:help    name=MOREKEYS.
:parml.
:pt.F24=More keys
:pd.
Shows additional function keys on the display.  The function keys
can be used even when they are not shown on the display.
:eparml.
:ehelp.

:help    name=ENTERKY.
:parml.
:pt.ENTER key
:pd.
Submits information on the display for processing.
:eparml.
:ehelp.

:help    name=HELPKY.
:parml.
:pt.HELP key
:pd.
Provides additional information about using the display or a
specific field on the display.
:eparml.
:ehelp.

:help    name=PAGEDNKY.
:parml.
:pt.PageDown (RollUp) key
:pd.
Moves forward to show additional information for this display.  Page
Down (Roll Up) shows the next group of items until you reach the end
of the information.
:eparml.
:ehelp.

:help    name=PAGEUPKY.
:parml.
:pt.PageUp (RollDown) key
:pd.
Moves backward to show additional information for this display.  Page
Up (Roll Down) shows the previous group of items until you reach the
beginning of the information.
:eparml.
:ehelp.

:help    name=PRINTKY.
:parml.
:pt.PRINT key
:pd.
Prints information currently shown on the display.
:eparml.
:ehelp.

.**********************************************************************
.*  Help for command FNDSRCMBR
.**********************************************************************
:help name='FNDSRCMBR'.
Find Source Member - Help
:p.The Find Source Member (FNDSRCMBR) command searches the specified
libraries for matching source file and member names.  The resulting
list displays in a subfile for subsequent option processing.
:ehelp.

.*******************************************
.*   Help for parameter SRCMBR
.*******************************************
:help name='FNDSRCMBR/SRCMBR'.
Source member (SRCMBR) - Help
:xh3.Source member (SRCMBR)
:p.This specifies the member name to search for in the specified
source file(s).
:p.This is a required parameter.
:parml.
:pt.:pv.name:epv.
:pd.
Specify the name of a specific source member to find.
:pt.:pv.generic-name:epv.
:pd.
You may specify a generic source member name if you wish to find several
members with the same prefix characters in their name.  To qualify as a
generic name, the value specified must end with an asterisk.
:pt.:pv.*:epv.
:pd.
Use this special value to match on all members in a source file.
:eparml.
:ehelp.

.*******************************************
.*   Help for parameter SRCFILE
.*******************************************
:help name='FNDSRCMBR/SRCFILE'.
Source file (SRCFILE) - Help
:xh3.Source file (SRCFILE)
:p.This specifies the source files to search for the specified
member name(s).
:p.:hp2.Qualifier 1: Source file:ehp2.
:parml.
:pt.:pv.name:epv.
:pd.
Specify the name of a specific source physical file to be searched.  The
default is the QRPGLESRC file, but any source file name may be specified.
:eparml.
:p.:hp2.Qualifier 2: Library:ehp2.
:parml.
:pt.:pv.name:epv.
:pd.
Specify the name of the library to be searched.
:pt.:pk def.*CURLIB:epk.
:pd.
The current library for the thread is searched.  If no library is
specified as the current library for the thread, the QGPL library is
searched.  This is the default.
:pt.:pk.*ALL:epk.
:pd.
All libraries in the system, including QSYS, are searched.
:pt.:pk.*ALLUSR:epk.
:pd.
All user libraries are searched.  This includes all libraries with
names that do not begin with the letter Q (with some exceptions).
:pt.:pk.*USRLIBL:epk.
:pd.
The current library entry (if any) and the libraries in the user
portion of the library list are searched.
:eparml.
:ehelp.

:epnlgrp.

[top]

References