Find Source Member (FNDSRCMBR)

From MidrangeWiki
Revision as of 21:54, 3 January 2019 by DaveLClarkI (talk | contribs) (CL/ILE Program)
Jump to: navigation, search

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