Category: News

Posted on

Problem with SNDPTFORD on hosted LPAR’s

We are running and IBM i hosting IBM i LPAR’s environment that we use for all of our development. The setup works perfectly for our purposes and even though we have since created a VIOS based environment on our Power9 this Power8 is our main development system.

One of the things we always try to do is keep the systems (individual LPAR’s) at the latest CUM and Group level so we use the Fix Central portal to download the latest CUM package and PTF Groups on a regular basis. Because we are now looking at the security bulletins published by IBM and the PTF’s required to fix the exposures, many of these are not included in a PTF group or CUM package. Having to sign onto the Fix Central portal and order the fixes individually is a long and manual process, especially where we need to do it for each of our partitions. The answer is the SNDPTFORD command which can be used to automatically download the PTF’s to an Image Catalog to allow installation.

We did this on our main hosting partition and everything worked perfectly, but when we tried in on the hosted partitions it failed every time! To make matters worse the only message that was sent indicated that we needed to review the job log to see the reason that the request failed, there were no other messages! So we placed a PMR with IBM asking for help, unfortunately one of the LPAR’s is running V7R2 and we needed a service extension before IBM would even consider looking at it. Thankfully we had the exact same problem on all of the LPARS running V7R3 and V7R4 so IBM could provide support against those LPARs.

This is the list of actions that IBM suggested we take to fix up the ECS links.

DLTSRVCFG DLTCMNCFG(*YES) (make sure the system value QRETSVRSEC is set to one for this to work)

WRKTCPPTP remove any profiles that are listed.

WRKLIND LIND(Q*) Remove the QESLINE/QTILINE objects (they are no longer needed)

RMVLNK OBJLNK(‘/QIBM/USERDATA/OS400/UniversalConnection/*’) this command fails with ‘Requested operation not allowed. Access problem.’ You can ignore this as the bits that need to be deleted are.

CRTSRVCFG ROLE(PRIMARY) CNNTYPE(DIRECT) CNTRYID(SELECT) STATE(SELECT) This will take you through a couple of screens where you need to select the country and province the system is located in.

SNDPTFORD PTFID((SF98720)) This simply orders a cover letter, does not matter that its for V7R2 in this instance its only used to test the download works.

SNDSRVRQS ACTION(*TEST) This will send out a PMR and close it. You will get emails about the PMR being raised and closed (3 in our case)

VFYSRVCFG SERVICE(ecs) VFYOPT(ALL) This runs some verification tests, just check the job log to make sure they all ran successfully.

Once all of the above had been done on each of the LPAR’s the SNDPTFORD was working fine except for our V7R2 LPAR, this is because IBM checks for the service extension as part of the process and if you do not have it the process fails (still same problem with absolutely no data to suggest why it failed).

This fixed the problems for us, your mileage may differ but hopefully it fixes the problem.

Happy Days… Chris…

Posted on

Security Bulletin PTF’s – Automated download

As part of our AAG product we have been looking at how we can make the security bulletin checks easy so that users can get their systems status with respect to security exposures announced by IBM. The process uses a DB we manage to look up any security exposures that have been identified and any PTF’s that have been released by IBM to fix the exposure. This then sends notifications out to the user via the Nagios interfaces so you know exactly what security exposures your system is open to.

Sending the notifications is only part of the problem, you have to make sure that you download and install the fixes or the notification just keeps coming (annoying). We have always used Fix Central to download the latest CUM and PTF groups (Another check we run from AAG) so having the individual fix information would require a manual process to load the order via fix central. We wanted this to be a bit more like the other platforms where the fixes could be downloaded and installed with a single request from the IBM i, this is where SNDPTFORD comes in. (Please see our other Blog entry about setting up ECS on partitions hosted within another IBM i partition for the problem we encountered and the fix supplied by IBM).

We developed a test program called TSSECBUL that would carry out the same checks for the PTF’s directly on the IBM i as opposed to through the AAG process. This would the check if the required Licensed Program Product is installed (see note below) and if necessary send an order for the PTF using the SNDPTFORD process. The following shows the steps taken for a specific LPAR we needed to update.

You can see from the output below that AAG had found a number of PTF’s that were required to remove the exposures identified by the Security Bulletins announced by IBM. (All of the Security Bulletins we have listed in the DB are from a list that is provided from IT Jungle). This information is collected directly from the IBM i using DB so it it specific to the system we are checking. As you can see we had 12 security exposures identified.

Prior to the request to download the PTF’s

We Installed the new command and program on the target LPAR so that we could get the PTF’s from IBM. The whole thing relies on the SNDPTFORD being able to run plus the image catalog has to be available (The IBM documentation states that when the SNDPTFORD is run, if the Image Catalog does not exist it is created? In our checks this was not the case so we had to create the Image Catalog before running the command) but does not have to be connected to any virtual optical device.

New Command to check and download fixes

Once the command is run you will see output generated to screen about the CVE’s that are being checked and the relevant LPP and option, if the LPP and option are installed and the PTF is not installed the program will submit a job to go and get the PTF from IBM. Once all of the checks have been completed pressing enter clears the screen.

Review being run and orders placed

You can see if any orders were submitted by using the WRKSBMJOB command, the following is an example of what we saw for this particular LPAR. One jobs is the SNDPTFORD which is the one we submitted, this in-turn launches another job (QESECARE) that appears to manage the download of the image to the image catalog.

SNDPTFORD being run

Once all of these QESECARE jobs have finished you can check the image catalog and see the images have been downloaded and attached.

Orders placed waiting for downloads

You can now see the image catalog entries have been added.

Updates now in Image Catalog

Before you can load and apply the PTF’s you will need to load the image catalog to the virtual optical drive you have.

Load the Image Catalog to the optical device

Next we will verify the fixes.

Verify the fixes

Once everything has been verified we can then use the PTF menu (option8) to install the fixes from the image catalog.

Go to PTF Menu option 8

On the other systems we updated we did not need to IPL the system, as you can see later for this system an IPL was required to install all of the fixes, we were doing this early one morning so an IPL was not going to be a problem. You may have to consider this on your system to ensure you are not affecting your users while the IPL occurs.

Install the PTF’s

You will see the PTF’s being installed

PTF’s being installed

As mentioned above when installing the PTF’s it came across one or more that needed an IPL to apply fully. We were in the fortunate position of not having any problems with an IPL at the time.

IPL needed on this system

IPL is going to throw us off the system, no one else is on so no problem.

Confirm the IPL

Once the system had come back up we ran the SECBUL check against the system and we can see the system is now fully up to date and no security exposures exist.

All Security Bulletins now applied.

The whole process including the IPL took about 40 minutes on this LPAR, others have been as little as 10 minutes so this is definitely a time saver for us and the bonus is we can sleep happy at night knowing that our systems are not open to the exposures identified by the CVE’s.

We developed this program and command as a test for the one that we will add to the AAG product in an upcoming update, that command will be a lot more integrated with the product environment such as having its own job queue and job descriptions.

I think this alone makes the AAG product a worthwhile investment, saving all that time to investigate and download PTF’s to fix security exposures makes our life a lot simpler! We only have 12 LPAR’s to do this on internally, some of our customers are looking after 100’s of LPAR’s so their time savings will be huge. All our other platforms have a much simpler process for downloading and installing updates, now the IBM i is getting some of that capability.

PS: Don’t forget to clean up the downloaded PTF files once the PTF’s have been installed, they may not be huge but having them sitting around can take up a lot of Disk..

Happy Days.. Chris..

Notes:

We found out that the PTF’s listed in the CVE data are LPP Option dependent (IBM does not state which LPP Option the CVE relates to) if you download the PTF’s and run the install it will not install the PTF and you will keep seeing the notifications from AAG. We fixed up the DB to include the Option affected (after a lot of trial and error) so that checks would correctly omit any options that are not installed. I have asked IBM to add the affected option to the CVE data via the ideas portal.

Posted on

Export source code to IFS

Last Updated on 11 December 2022 by Roberto De Pedrini

Colleagues and customers are increasingly asking to copy the sources of their programs stored on members of source files to IFS in order to be able to compile them using the SRCSTMF parameter available for ILE program/module creation commands or to use them, via network shares, from applications on other platforms (Windows or Linux).

CPYSRC2IFS, this is the name of the command, simplifies this export activity also supplying some information on the treated members and on the performed activity.

The command allows you to copy the members of a source file or the members of all source files of a library selected by a pattern into an IFS directory:

Copy source file member to IFS (CPYSRC2IFS)

Immettere le scelte e premere Invio.

File . . . . . . . . . . . . . . Nome, *ALL
Library . . . . . . . . . . . *LIBL Nome, *LIBL, *CURLIB
Member . . . . . . . . . . . . . Valore carattere, *
Library ASP device name . . . . *SYSBAS Nome, *SYSBAS
Directory . . . . . . . . . . .
Create directory . . . . . . . . *NO *NO, *YES
STMF extension . . . . . . . . . *DFT Valore carattere, *DFT…
STMF CCSID . . . . . . . . . . . *PCASCII 1-65533, *PCASCII, *STDASCII
End of line characters . . . . . *CRLF Valore carattere, *CRLF…
Authority . . . . . . . . . . . *INDIR *INDIR, *DFT, *FILE…
STMF description . . . . . . . . *NO *NO, *YES
Report (CSV format) . . . . . . *NO *NO, *YES
Count physical SLOC (CBL/RPG) . *NO *NO, *YES

Below is a brief description of the parameters:

FROMFILE: specifies the source file (and library) containing the members to be exported to IFS; using *ALL as file name it is possible to select all the source files of the indicated library (in this case, for each source file of the library, a job is submitted which first creates a directory called as the source file to be processed under the directory indicated in the parameter TODIR then copies the selected members there);

MBR: specify the members to export (‘*‘ is used as a wildcard and can be used in any position and even more than once, for example: MBR(‘*B*A*’));

LIBASPDEV: specifies the ASP device where the library containing the source file to be exported is located;

TODIR: specifies the path of the IFS directory where to copy the members;

CRTDIR: specifies whether to create (*YES) or not (*NO, default) the destination directory (indicated in the TODIR parameter);

STMFEXT: Specifies the extension to use to complete the target stream file name; it is possible to expressly indicate it (STMFEXT(‘.txt’), for example) or choose between: *DFT (default), to use the .MBR extension, *NONE, to have no extension and *TYPE to use the content of the TYPE field (origin type) of the member;

STMFCCSID: Specifies the CCSID of the stream file; *PCASCII is the default value (CCSID = 1252), alternatively you can use *STDASCII (CCSID = 819) or a CCSID between 1 and 65533 (the values used by the CPYTOSTMF command);

ENDLINFMT: specifies end-of-line characters; *CRLF is the default value, alternatively you can specify *LF, *CR, *LFCR, *FIXED (the values used by the CPYTOSTMF command);

AUTH: Specifies the policy used to assign authority to copied objects; the possible values are *INDIR (default value), *DFT, *FILE, *FILEINDIR (also in this case these are the values used by the CPYTOSTMF command);

REPORT: Specifies whether or not to create a report in CSV (Comma-Separated Values) format of the exported members, called “#Report-JOBNUMBER–JOBUSER_JOBNAME.csv“, containing some information about the member such as: library, source file, member, description, type, number of records, creation timestamp, last modification timestamp, byte size of the generated stream file and allocated space in bytes always of the generated stream file (“LIBRARY”;”FILE”;”MEMBER”;”TYPE”;”TEXT”;”NBRRCD”;”CRT_TIMESTAMP”;”LAST_CHG_TIMESTAMP”;”IFS_SIZE”;”IFS_ALLOC”)

STMFTXT: specifies whether to report (*YES) or not (*NO, default value) the description of the member of the source file in the description of the destination stream file;

SLOC: specifies, only if REPORT(*YES), whether or not to estimate the amount of physical code lines (ie without comment lines) for Cobol and RPG sources. In this case the columns of the report file become: “LIBRARY”;”FILE”;”MEMBER”;”TYPE”;”TEXT”;”NBRRCD”;”PHYSICAL_SLOC”;”CRT_TIMESTAMP”;”LAST_CHG_TIMESTAMP”;”IFS_SIZE” ;”IFS_ALLOC”

In addition to the report in CSV format, at the end of the execution, the command displays a summary of what has been done in terms of number of members processed, total records of members processed, size of stream files created (in bytes) and space allocated for them stream file (in bytes). Here is an example:

Member processed: 1.003 – Records: 607.422 – IFS size (byte): 25.457.910
– IFS allocated size (byte): 40.460.288

Before proceeding with the compilation of the program (CRTBNDCL command) it is necessary to create three files with the following commands:

RUNSQL SQL(‘CREATE TABLE QTEMP/PFSRCLIST AS (SELECT DBXFIL FROM QADBXREF) WITH NO DATA’) +
COMMIT(*NONE)
RUNSQL SQL(‘CREATE TABLE QTEMP/MBRLIST (MBNAME CHAR(10), MBSEU2 CHAR(10), MBMTXT CHAR(50), +
MBNRCD DECIMAL(10, 0), MBCCEN CHAR(1), MBCDAT CHAR(6), MBCTIM CHAR(6), MBUPDC CHAR(1), +
MBUPDD CHAR(6), MBUPDT CHAR(6))’) COMMIT(*NONE)
RUNSQL SQL(‘CREATE TABLE QTEMP/SLOC (NUMBER NUMERIC(10, 0))’) COMMIT(*NONE)

So, if we want to export to the /src/prj1 directory (to be created by the command), in Windows “format,” all the program sources contained in the members of the physical source files in the PRJ1LIB library, including their description, and we also want the activity report to be generated, including the estimation of the physical lines of code for Cobol and RPG language programs, we need to type the following command (in italics the parameters using the default values of the command):

CPYSRC2IFS FROMFILE(PRJ1LIB/*ALL) MBR(*) TODIR(‘/src/prj1’) CRTDIR(*YES) STMFEXT(*TYPE) +
STMFCCSID(*PCASCII) ENDLINFMT(*CRLF) AUT(*INDIR) STMFTXT(*YES) REPORT(*YES) SLOC(*YES)

Below are the sources of the CLLE command and program:

CMD PROMPT(‘Copy source file member to IFS’)

PARM KWD(FROMFILE) TYPE(FILE) MIN(1) PROMPT(‘File’ 1)

PARM KWD(TODIR) TYPE(*PNAME) LEN(128) MIN(1) EXPR(*YES) +
PROMPT(‘Directory’ 4)

PARM KWD(MBR) TYPE(*CHAR) LEN(10) DFT(*) SPCVAL((*)) +
EXPR(*YES) PROMPT(‘Member’ 2)

PARM KWD(LIBASPDEV) TYPE(*NAME) LEN(10) DFT(*SYSBAS) +
SPCVAL((*SYSBAS)) EXPR(*YES) PROMPT(‘Library ASP +
device name’ 3)

PARM KWD(CRTDIR) TYPE(*CHAR) LEN(4) RSTD(*YES) DFT(*NO) +
VALUES(*NO *YES) EXPR(*YES) PROMPT(‘Create +
directory’ 5)

PARM KWD(STMFEXT) TYPE(*CHAR) LEN(10) DFT(*DFT) +
SPCVAL((*DFT) (*NONE) (*TYPE)) EXPR(*YES) +
PROMPT(‘STMF extension’ 6)

PARM KWD(STMFCCSID) TYPE(*INT4) DFT(*PCASCII) RANGE(1 +
65533) SPCVAL((*PCASCII 1252) (*STDASCII 850)) +
EXPR(*YES) PROMPT(‘STMF CCSID’ 7)

PARM KWD(ENDLINFMT) TYPE(*CHAR) LEN(6) DFT(*CRLF) +
SPCVAL((*CRLF) (*LF) (*CR) (*LFCR) (*FIXED)) +
EXPR(*YES) PROMPT(‘End of line characters’ 8)

PARM KWD(AUT) TYPE(*CHAR) LEN(10) RSTD(*YES) +
DFT(*INDIR) VALUES(*INDIR *DFT *FILE *INDIRFILE) +
EXPR(*YES) PROMPT(‘Authority’ 9)

PARM KWD(STMFTXT) TYPE(*CHAR) LEN(4) RSTD(*YES) +
DFT(*NO) VALUES(*NO *YES) EXPR(*YES) +
PROMPT(‘STMF description’ 10)

PARM KWD(REPORT) TYPE(*CHAR) LEN(4) RSTD(*YES) DFT(*NO) +
VALUES(*NO *YES) EXPR(*YES) PROMPT(‘Report (CSV +
format)’ 11)

PARM KWD(SLOC) TYPE(*CHAR) LEN(4) RSTD(*YES) DFT(*NO) +
VALUES(*NO *YES) EXPR(*YES) PMTCTL(LOC) +
PROMPT(‘Count physical SLOC (CBL/RPG)’ 12)

FILE: QUAL TYPE(*NAME) LEN(10) SPCVAL((*ALL)) EXPR(*YES)
QUAL TYPE(*NAME) LEN(10) DFT(*LIBL) SPCVAL((*LIBL) +
(*CURLIB)) EXPR(*YES) PROMPT(‘Library’)

LOC: PMTCTL CTL(REPORT) COND((*EQ *YES)) NBRTRUE(*ALL)

PGM PARM(&PFROMFILE &PTODIR &PMBR &PLIBASPDEV &PCRTDIR +
&PSTMFEXT &PSTMFCCSID &PENDLINFMT &PAUT +
&PSTMFTXT &PREPORT &PSLOC)

/* Parameters */
DCL VAR(&PFROMFILE) TYPE(*CHAR) LEN(20)
DCL VAR(&FROMFILE) TYPE(*CHAR) STG(*DEFINED) LEN(10) +
DEFVAR(&PFROMFILE 1)
DCL VAR(&FROMLIB) TYPE(*CHAR) STG(*DEFINED) LEN(10) +
DEFVAR(&PFROMFILE 11)
DCL VAR(&PTODIR) TYPE(*CHAR) LEN(128)
DCL VAR(&PMBR) TYPE(*CHAR) LEN(10)
DCL VAR(&PLIBASPDEV) TYPE(*CHAR) LEN(10)
DCL VAR(&PCRTDIR) TYPE(*CHAR) LEN(4)
DCL VAR(&PSTMFEXT) TYPE(*CHAR) LEN(10)
DCL VAR(&PSTMFCCSID) TYPE(*INT) LEN(4)
DCL VAR(&PENDLINFMT) TYPE(*CHAR) LEN(6)
DCL VAR(&PAUT) TYPE(*CHAR) LEN(10)
DCL VAR(&PSTMFTXT) TYPE(*CHAR) LEN(4)
DCL VAR(&PREPORT) TYPE(*CHAR) LEN(4)
DCL VAR(&PSLOC) TYPE(*CHAR) LEN(4)

/* Variables */
DCL VAR(&OBJATR) TYPE(*CHAR) LEN(10)
DCL VAR(&NBRSELMBR) TYPE(*DEC) LEN(10 0)
DCL VAR(&NBRSELPFS) TYPE(*DEC) LEN(10 0)
DCL VAR(&ASPPATH) TYPE(*CHAR) LEN(11)
DCL VAR(&MBRPATH) TYPE(*CHAR) LEN(256)
DCL VAR(&TODIR) TYPE(*CHAR) LEN(128)
DCL VAR(&STMFEXT) TYPE(*CHAR) LEN(10)
DCL VAR(&STMF) TYPE(*CHAR) LEN(256)
DCL VAR(&REPORT) TYPE(*CHAR) LEN(256)
DCL VAR(&MBRCRTCEN) TYPE(*CHAR) LEN(2)
DCL VAR(&MBRCRTDAT) TYPE(*CHAR) LEN(10)
DCL VAR(&MBRCRTTIM) TYPE(*CHAR) LEN(8)
DCL VAR(&MBRCRTTS) TYPE(*CHAR) LEN(26)
DCL VAR(&MBRCHGCEN) TYPE(*CHAR) LEN(2)
DCL VAR(&MBRCHGDAT) TYPE(*CHAR) LEN(10)
DCL VAR(&MBRCHGTIM) TYPE(*CHAR) LEN(8)
DCL VAR(&MBRCHGTS) TYPE(*CHAR) LEN(26)
DCL VAR(&MBRCNTX) TYPE(*DEC) LEN(10 0)
DCL VAR(&MBRCNT) TYPE(*DEC) LEN(10 0)
DCL VAR(&MBRCNTCHAR) TYPE(*CHAR) LEN(19) /* +
xxx.xxx.xxx.xxx.xxx */
DCL VAR(&RCDCNT) TYPE(*DEC) LEN(10 0)
DCL VAR(&RCDCNTCHAR) TYPE(*CHAR) LEN(19) /* +
xxx.xxx.xxx.xxx.xxx */
DCL VAR(&IFSSIZ) TYPE(*INT) LEN(8)
DCL VAR(&IFSSIZCHAR) TYPE(*CHAR) LEN(19) /* +
xxx.xxx.xxx.xxx.xxx */
DCL VAR(&IFSALC) TYPE(*INT) LEN(8)
DCL VAR(&IFSALCCHAR) TYPE(*CHAR) LEN(19) /* +
xxx.xxx.xxx.xxx.xxx */
DCL VAR(&SLOCCNT) TYPE(*DEC) LEN(10 0)
DCL VAR(&SLOCCNTCHR) TYPE(*CHAR) LEN(19) /* +
xxx.xxx.xxx.xxx.xxx */
DCL VAR(&SLOC) TYPE(*LGL) LEN(1)

/* Files */
DCLF FILE(PFSRCLIST) OPNID(PFSRC)
DCLF FILE(SLOC) OPNID(SLOC)
DCLF FILE(MBRLIST) OPNID(MBRINFO)

/* stat64 */
DCL VAR(&STATRTNVAL) TYPE(*INT) LEN(4)
DCL VAR(&STATPATH) TYPE(*CHAR) LEN(256)
DCL VAR(&STATBUFFER) TYPE(*CHAR) LEN(4096)
DCL VAR(&STATOBJSIZ) TYPE(*INT) STG(*DEFINED) LEN(8) +
DEFVAR(&STATBUFFER 17)
DCL VAR(&STATALCSIZ) TYPE(*UINT) STG(*DEFINED) LEN(8) +
DEFVAR(&STATBUFFER 49)
DCL VAR(&STATOBJTYP) TYPE(*CHAR) STG(*DEFINED) LEN(10) +
DEFVAR(&STATBUFFER 61)

/* strlen */
DCL VAR(&STRTMP) TYPE(*CHAR) LEN(32767)
DCL VAR(&LENINT) TYPE(*UINT) LEN(4)

/* SUBR(VFYPFSRC): Start *********************************************/
DCL VAR(&VFYPFSRC) TYPE(*INT) LEN(4)

/* QDBRTVFD */
DCL VAR(&FILD0100) TYPE(*CHAR) LEN(400)
DCL VAR(&QDBFHFLG) TYPE(*CHAR) STG(*DEFINED) LEN(1) +
DEFVAR(&FILD0100 9)
DCL VAR(&QDBFHMNUM) TYPE(*INT) STG(*DEFINED) LEN(2) +
DEFVAR(&FILD0100 48)
DCL VAR(&FILD0100L) TYPE(*INT) LEN(4) VALUE(400)
DCL VAR(&QDBFOUT) TYPE(*CHAR) LEN(20)
DCL VAR(&QDBFIN) TYPE(*CHAR) LEN(20)
DCL VAR(&QDBFRCDFMT) TYPE(*CHAR) LEN(10)
DCL VAR(&QDBFOVR) TYPE(*CHAR) LEN(1)
DCL VAR(&QDBFSYS) TYPE(*CHAR) LEN(10)
DCL VAR(&QDBFFMTTYP) TYPE(*CHAR) LEN(10)

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)
DCL VAR(&FILEATRB) TYPE(*CHAR) LEN(2)
DCL VAR(&FILETYPE) TYPE(*CHAR) LEN(3)
DCL VAR(&NBRALLMBR) TYPE(*INT) LEN(2)
/* SUBR(VFYPFSRC): End ***********************************************/

/* SUBR(EDTNUM): Start ***********************************************/
DCL VAR(&EDTNUM) TYPE(*INT) LEN(4)

/* QECCVTEC, QECEDT */
DCL VAR(&SIZEDEC) TYPE(*DEC) LEN(15 0)
DCL VAR(&SIZECHAR) TYPE(*CHAR) LEN(19) /* +
xxx.xxx.xxx.xxx.xxx */
DCL VAR(&EDTMASK) TYPE(*CHAR) LEN(256)
DCL VAR(&EDTMASKLEN) TYPE(*CHAR) LEN(4)
DCL VAR(&RCVVARLEN) TYPE(*CHAR) LEN(4)
DCL VAR(&ZROBAL) TYPE(*CHAR) LEN(1)
DCL VAR(&EDTCODE) TYPE(*CHAR) LEN(1) VALUE(‘1’)
DCL VAR(&CURRENCY) TYPE(*CHAR) LEN(1)
DCL VAR(&SRCVARPCSN) TYPE(*CHAR) LEN(4)
DCL VAR(&SRCVARDEC) TYPE(*CHAR) LEN(4)
/* SUBR(EDTNUM): End *************************************************/

/* SUBR(DUPQUOTE): Start *********************************************/
DCL VAR(&DUPQUOTE) TYPE(*INT) LEN(4)

DCL VAR(&TEXTIN) TYPE(*CHAR) LEN(50)
DCL VAR(&TEXTOUT) TYPE(*CHAR) LEN(100)
DCL VAR(&TEXT_I) TYPE(*UINT) LEN(2)
DCL VAR(&TEXT_J) TYPE(*UINT) LEN(2)
/* SUBR(DUPQUOTE): End ***********************************************/

/* RUNSQL */
DCL VAR(&SQL) TYPE(*CHAR) LEN(5000)

/* API Error & SUBR(RSTAPIERR): Start ********************************/
DCL VAR(&RSTAPIERR) TYPE(*INT) LEN(4)

DCL VAR(&APINAME) TYPE(*CHAR) LEN(10)
DCL VAR(&PRCNAME) TYPE(*CHAR) LEN(256) /* CALLPRC */
DCL VAR(&APIERROR) TYPE(*CHAR) LEN(528)
DCL VAR(&AEBYTPRO) TYPE(*INT) STG(*DEFINED) LEN(4) +
DEFVAR(&APIERROR 1)
DCL VAR(&AEBYTAVL) TYPE(*INT) STG(*DEFINED) LEN(4) +
DEFVAR(&APIERROR 5)
DCL VAR(&AEEXCPID) TYPE(*CHAR) STG(*DEFINED) LEN(7) +
DEFVAR(&APIERROR 9)
DCL VAR(&AEEXCPDTA) TYPE(*CHAR) STG(*DEFINED) LEN(512) +
DEFVAR(&APIERROR 17)
/* API Error & SUBR(RSTAPIERR): End **********************************/

/* _MATPGMNM */
DCL VAR(&DATA) TYPE(*CHAR) LEN(80)
DCL VAR(&PGMNAME) TYPE(*CHAR) LEN(10)
DCL VAR(&PGMLIB) TYPE(*CHAR) LEN(10)

/* RTVJOBA */
DCL VAR(&JOBNAME) TYPE(*CHAR) LEN(10)
DCL VAR(&JOBUSER) TYPE(*CHAR) LEN(10)
DCL VAR(&JOBNBR) TYPE(*CHAR) LEN(6)
DCL VAR(&JOBTYPE) TYPE(*CHAR) LEN(1) /* 0=Batch 1=Inter */

/* RCVMSG & SNDPGMMSG */
DCL VAR(&CMDNAME) TYPE(*CHAR) LEN(10)
DCL VAR(&ERROR) TYPE(*LGL) VALUE(‘0’)
DCL VAR(&PGMERROR) TYPE(*LGL) VALUE(‘0’)
DCL VAR(&SUBRNAME) TYPE(*CHAR) LEN(10)
DCL VAR(&ERRORTEXT) TYPE(*CHAR) LEN(100)
DCL VAR(&MSGID) TYPE(*CHAR) LEN(7)
DCL VAR(&MSGDTA) TYPE(*CHAR) LEN(512)
DCL VAR(&MSGDTALEN) TYPE(*DEC) LEN(5 0)
DCL VAR(&MSG) TYPE(*CHAR) LEN(1024)
DCL VAR(&MSGLEN) TYPE(*DEC) LEN(5 0)
DCL VAR(&SECLVL) TYPE(*CHAR) LEN(1024)
DCL VAR(&SECLVLLEN) TYPE(*DEC) LEN(5 0)
DCL VAR(&MSGF) TYPE(*CHAR) LEN(10)
DCL VAR(&MSGFLIB) TYPE(*CHAR) LEN(10)
DCL VAR(&MSGKEY) TYPE(*CHAR) LEN(4)
DCL VAR(&MSGKEYRQS) TYPE(*CHAR) LEN(4)
DCL VAR(&MSGTYPE) TYPE(*CHAR) LEN(7)
DCL VAR(&RTNTYPE) TYPE(*CHAR) LEN(2)
DCL VAR(&SENDER) TYPE(*CHAR) LEN(80)
DCL VAR(&SD_PGMSDR) TYPE(*CHAR) STG(*DEFINED) LEN(10) +
DEFVAR(&SENDER 27)

/* Constants */
DCL VAR(&LOOP) TYPE(*LGL) VALUE(‘1’)
DCL VAR(&NULL) TYPE(*CHAR) LEN(1) VALUE(X’00’)
DCL VAR(&QUOTE) TYPE(*CHAR) LEN(1) VALUE(X’7D’)

/* Global monitor for any error messages */
MONMSG MSGID(CPF0000) EXEC(GOTO CMDLBL(ERROR))

/* Retrieve program name & library */
CHGVAR VAR(%BIN(&DATA 1 4)) VALUE(80)
CHGVAR VAR(%BIN(&DATA 5 4)) VALUE(80)
CHGVAR VAR(%BIN(&DATA 9 4)) VALUE(0)
CHGVAR VAR(%BIN(&DATA 13 4)) VALUE(0)
CALLPRC PRC(‘_MATPGMNM’) PARM((&DATA))
CHGVAR VAR(&PGMNAME) VALUE(%SST(&DATA 51 10))
CHGVAR VAR(&PGMLIB) VALUE(%SST(&DATA 19 10))

/* Retrieve job attributes */
RTVJOBA JOB(&JOBNAME) USER(&JOBUSER) NBR(&JOBNBR) +
TYPE(&JOBTYPE)

IF COND(&FROMFILE *NE ‘*ALL’) THEN(DO)

/* Check library and file */
RTVOBJD OBJ(&FROMLIB/&FROMFILE) OBJTYPE(*FILE) +
OBJATR(&OBJATR)
MONMSG MSGID(CPF9810) EXEC(DO) /* Library &1 not found. */
CHGVAR VAR(&MSGID) VALUE(‘CPF9897’)
CHGVAR VAR(&MSGDTA) VALUE(‘Library’ *BCAT &FROMLIB +
*BCAT ‘not found.’)
SNDPGMMSG MSGID(&MSGID) MSGF(QCPFMSG) MSGDTA(&MSGDTA) +
TOPGMQ(*PRV (*)) TOMSGQ(*TOPGMQ) MSGTYPE(*DIAG)
GOTO CMDLBL(CLEANUP)
ENDDO /* MSGID(CPF9810) */
MONMSG MSGID(CPF9812) EXEC(DO) /* File &1 in library +
&2 not found. */
CHGVAR VAR(&MSGID) VALUE(‘CPF9897’)
CHGVAR VAR(&MSGDTA) VALUE(‘File’ *BCAT &FROMFILE +
*BCAT ‘not found in library’ *BCAT +
&FROMLIB *TCAT ‘.’)
SNDPGMMSG MSGID(&MSGID) MSGF(QCPFMSG) MSGDTA(&MSGDTA) +
TOPGMQ(*PRV (*)) TOMSGQ(*TOPGMQ) MSGTYPE(*DIAG)
GOTO CMDLBL(CLEANUP)
ENDDO /* MSGID(CPF9801) */

IF COND(&OBJATR *NE ‘PF’) THEN(DO)
CHGVAR VAR(&MSGID) VALUE(‘CPF9897’)
CHGVAR VAR(&MSGDTA) VALUE(‘File’ *BCAT &FROMFILE +
*BCAT ‘in library’ *BCAT &FROMLIB *BCAT +
‘is not a physical file (‘ *CAT &OBJATR +
*TCAT ‘).’)
SNDPGMMSG MSGID(&MSGID) MSGF(QCPFMSG) MSGDTA(&MSGDTA) +
TOPGMQ(*PRV (*)) TOMSGQ(*TOPGMQ) MSGTYPE(*DIAG)
GOTO CMDLBL(CLEANUP)
ENDDO /* COND(&OBJATR *NE ‘PF’) */

/* Check file type */
CHGVAR VAR(&QDBFIN) VALUE(&PFROMFILE)
CHGVAR VAR(&QDBFOVR) VALUE(‘0’)
CHGVAR VAR(&QDBFSYS) VALUE(‘*LCL’)

CALLSUBR SUBR(VFYPFSRC) RTNVAL(&VFYPFSRC)

IF COND(&VFYPFSRC *NE 0) THEN(DO)
GOTO CMDLBL(ERROR)
ENDDO /* COND(&VFYPFSRC *NE 0) */

IF COND((&FILEATRB *NE ‘PF’) *OR (&FILETYPE *NE +
‘SRC’)) THEN(DO)
CHGVAR VAR(&MSGID) VALUE(‘CPF9897’)
CHGVAR VAR(&MSGDTA) VALUE(‘File’ *BCAT &FROMFILE +
*BCAT ‘in library’ *BCAT &FROMLIB *BCAT +
‘is not a source physical file (‘ *CAT +
&FILEATRB *CAT ‘-‘ *CAT &FILETYPE *CAT ‘).’)
SNDPGMMSG MSGID(&MSGID) MSGF(QCPFMSG) MSGDTA(&MSGDTA) +
TOPGMQ(*PRV (*)) TOMSGQ(*TOPGMQ) MSGTYPE(*DIAG)
GOTO CMDLBL(CLEANUP)
ENDDO /* COND((&FILEATRB *NE ‘PF’) *OR (&FILETYPE *NE +
‘SRC’) */

ENDDO /* COND(&FROMFILE *NE ‘*ALL’) */

/* Check TODIR parameter */
CHGVAR VAR(&STATPATH) VALUE(&PTODIR *TCAT &NULL)

CALLPRC PRC(‘stat64’) PARM((&STATPATH) (&STATBUFFER)) +
RTNVAL(&STATRTNVAL)

IF COND(&STATRTNVAL *NE 0) THEN(DO)
IF COND(&PCRTDIR *EQ ‘*YES’) THEN(DO)
CRTDIR DIR(&PTODIR) DTAAUT(*INDIR) OBJAUT(*INDIR)
ENDDO /* COND(&PCRTDIR *EQ ‘*YES’) */
ELSE CMD(DO)
CHGVAR VAR(&MSGID) VALUE(‘CPFA0A9’) /* Object not +
found */
CALLPRC PRC(‘strlen’) PARM((&STATPATH)) RTNVAL(&LENINT)
CHGVAR VAR(%BIN(&MSGDTA 1 4)) VALUE(&LENINT)
CHGVAR VAR(%SST(&MSGDTA 5 &LENINT)) +
VALUE(%SST(&PTODIR 1 &LENINT))
SNDPGMMSG MSGID(&MSGID) MSGF(QCPFMSG) MSGDTA(&MSGDTA) +
TOPGMQ(*PRV (*)) TOMSGQ(*TOPGMQ) MSGTYPE(*DIAG)
GOTO CMDLBL(CLEANUP)
ENDDO /* COND(&PCRTDIR *NE ‘*YES’) */
ENDDO /* COND(&STATRTNVAL *NE 0) */
ELSE CMD(DO)
IF COND(&STATOBJTYP *NE ‘*DIR’) THEN(DO)
CHGVAR VAR(&MSGID) VALUE(‘CPF9897’)
CHGVAR VAR(&MSGDTA) VALUE(‘TODIR parameter must be +
a directory (‘ *CAT &QUOTE *CAT +
&STATOBJTYP *TCAT &QUOTE *CAT ‘).’)
SNDPGMMSG MSGID(&MSGID) MSGF(QCPFMSG) MSGDTA(&MSGDTA) +
TOPGMQ(*PRV (*)) TOMSGQ(*TOPGMQ) MSGTYPE(*DIAG)
GOTO CMDLBL(CLEANUP)
ENDDO /* COND(&STATOBJTYP *NE ‘*DIR’) */
ENDDO /* COND(&STATRTNVAL *EQ 0) */

/* Check last &PTODIR char */
CALLPRC PRC(‘strlen’) PARM((&STATPATH)) RTNVAL(&LENINT)

IF COND(%SST(&STATPATH &LENINT 1) *NE ‘/’) THEN(DO)
CHGVAR VAR(&TODIR) VALUE(&PTODIR *TCAT ‘/’)
ENDDO /* COND(%SST(&STATPATH &LENINT 1) *NE ‘/’) */
ELSE CMD(DO)
CHGVAR VAR(&TODIR) VALUE(&PTODIR)
ENDDO /* COND(%SST(&STATPATH &LENINT 1) *EQ ‘/’) */

/* Work with multiple PF-SRC */
IF COND(&FROMFILE *EQ ‘*ALL’) THEN(DO)

/* Extract PF-SRC to be processed */
DLTF FILE(QTEMP/PFSRCLIST)
MONMSG MSGID(CPF2105) /* Object &1 in &2 type *&3 not +
found */

CHGVAR VAR(&SQL) VALUE(‘CREATE TABLE QTEMP/PFSRCLIST +
AS (SELECT DBXFIL FROM QADBXREF WHERE DBXTYP +
= ”S” AND DBXLIB = ”’ *CAT &FROMLIB *TCAT +
”’ ORDER BY DBXFIL) WITH DATA’)

RUNSQL SQL(&SQL) COMMIT(*NONE)

/* Check PF-SRC to be processed */
RTVMBRD FILE(QTEMP/PFSRCLIST) MBR(*FIRST) +
NBRCURRCD(&NBRSELPFS)

IF COND(&NBRSELPFS *EQ 0) THEN(DO)
CHGVAR VAR(&MSGID) VALUE(‘CPF9897’)
CHGVAR VAR(&MSGDTA) VALUE(‘No PF-SRC found in +
library’ *BCAT &FROMLIB *TCAT ‘.’)
SNDPGMMSG MSGID(&MSGID) MSGF(QCPFMSG) MSGDTA(&MSGDTA) +
TOPGMQ(*PRV (*)) TOMSGQ(*TOPGMQ) MSGTYPE(*DIAG)
GOTO CMDLBL(CLEANUP)
ENDDO /* COND(&NBRSELPFS *EQ 0) */

/* Read PF-SRC file */
OVRDBF FILE(PFSRCLIST) TOFILE(QTEMP/PFSRCLIST) +
MBR(*FIRST) LVLCHK(*NO) OVRSCOPE(*CALLLVL) +
SHARE(*NO)

DOWHILE COND(&LOOP)
RCVF OPNID(PFSRC)
MONMSG MSGID(CPF0864) EXEC(LEAVE)
SBMJOB CMD(CPYSRC2IFS +
FROMFILE(&FROMLIB/&PFSRC_DBXFIL) +
MBR(&PMBR) LIBASPDEV(&PLIBASPDEV) +
TODIR(&TODIR *TCAT &PFSRC_DBXFIL) +
CRTDIR(&PCRTDIR) STMFEXT(&PSTMFEXT) +
STMFCCSID(&PSTMFCCSID) +
ENDLINFMT(&PENDLINFMT) AUT(&PAUT) +
STMFTXT(&PSTMFTXT) REPORT(&PREPORT) +
SLOC(&PSLOC)) JOB(&PFSRC_DBXFIL)
ENDDO /* WHILE */

GOTO CMDLBL(CLEANUP)

ENDDO /* COND(&FROMFILE *EQ ‘*ALL’) */

/* Set STMF extension (1) */
SELECT
WHEN COND(&PSTMFEXT *EQ ‘*NONE’) THEN(DO)
CHGVAR VAR(&STMFEXT) VALUE(‘ ‘)
ENDDO /* COND(&PSTMFEXT *EQ ‘*NONE’) */
WHEN COND(&PSTMFEXT *EQ ‘*DFT’) THEN(DO)
CHGVAR VAR(&STMFEXT) VALUE(‘.MBR’)
ENDDO /* COND(&PSTMFEXT *EQ ‘*DFT’) */
OTHERWISE CMD(DO)
IF COND(%SST(&PSTMFEXT 1 1) *EQ ‘.’) THEN(DO)
CHGVAR VAR(&STMFEXT) VALUE(&PSTMFEXT)
ENDDO /* COND(%SST(&PSTMFEXT 1 1) *EQ ‘.’) */
ELSE CMD(DO)
CHGVAR VAR(&STMFEXT) VALUE(‘.’ *CAT &PSTMFEXT)
ENDDO /* COND(%SST(&PSTMFEXT 1 1) *NE ‘.’) */
ENDDO /* OTHERWISE */
ENDSELECT

/* Set MBR path (1) */
IF COND(&PLIBASPDEV *EQ ‘*SYSBAS’) THEN(DO)
CHGVAR VAR(&ASPPATH) VALUE(‘ ‘)
ENDDO /* COND(&PLIBASPDEV *EQ ‘*SYSBAS’) */
ELSE CMD(DO)
CHGVAR VAR(&ASPPATH) VALUE(‘/’ *CAT &PLIBASPDEV)
ENDDO /* COND(&PLIBASPDEV *NE ‘*SYSBAS’) */

/* Build member list in output file */
DLTF FILE(QTEMP/MEMBERLIST)
MONMSG MSGID(CPF2105) /* Object &1 in &2 type *&3 not found */

DSPFD FILE(&FROMLIB/&FROMFILE) TYPE(*MBR) +
OUTPUT(*OUTFILE) OUTFILE(QTEMP/MEMBERLIST) +
OUTMBR(*FIRST *REPLACE)

/* Extract members to be processed */
DLTF FILE(QTEMP/MBRLIST)
MONMSG MSGID(CPF2105) /* Object &1 in &2 type *&3 not found */

CHGVAR VAR(&SQL) VALUE(‘CREATE TABLE QTEMP.MBRLIST AS +
(SELECT MBNAME, MBSEU2, MBMTXT, MBNRCD, MBCCEN, +
MBCDAT, MBCTIM, MBUPDC, MBUPDD, MBUPDT FROM +
QTEMP.MEMBERLIST WHERE MBNAME NOT LIKE ” %” +
AND MBNAME LIKE REPLACE(”’ *CAT &PMBR *TCAT +
”’, ”*”, ”%”) ORDER BY MBNAME) WITH DATA’)

RUNSQL SQL(&SQL) COMMIT(*NONE)

/* Check the number of members to be processed */
RTVMBRD FILE(QTEMP/MBRLIST) MBR(*FIRST) NBRCURRCD(&NBRSELMBR)

IF COND(&NBRSELMBR *EQ 0) THEN(DO)
IF COND((&JOBTYPE *EQ ‘1’) *AND (&PCRTDIR *EQ +
‘*YES’)) THEN(DO)
RMVDIR DIR(&PTODIR) SUBTREE(*NONE)
ENDDO /* COND((&JOBTYPE *EQ ‘1’) *AND (&PCRTDIR *EQ +
‘*YES’)) */
CHGVAR VAR(&MSGID) VALUE(‘CPF9897’)
CHGVAR VAR(&MSGDTA) VALUE(‘No members selected.’)
SNDPGMMSG MSGID(&MSGID) MSGF(QCPFMSG) MSGDTA(&MSGDTA) +
TOPGMQ(*PRV (*)) TOMSGQ(*TOPGMQ) MSGTYPE(*DIAG)
GOTO CMDLBL(CLEANUP)
ENDDO /* COND(&NBRSELMBR *EQ 0) */

/* Create report file */
IF COND(&PREPORT *EQ ‘*YES’) THEN(DO)

DLTF FILE(QTEMP/REPORT)
MONMSG MSGID(CPF2105) /* Object &1 in &2 type *&3 not +
found */

CRTPF FILE(QTEMP/REPORT) RCDLEN(200)

IF COND(&PSLOC *EQ ‘*NO’) THEN(DO)
CHGVAR VAR(&SQL) VALUE(‘INSERT INTO QTEMP.REPORT +
VALUES(””LIBRARY”;”FILE”;”MEMBER”;”TYPE”;”T+
EXT”;”NBR_RCD”;”CRT_TIMESTAMP”;”LAST_CHG_TIM+
ESTAMP”;”IFS_SIZE”;”IFS_ALLOC””)’)
ENDDO /* COND(&PSLOC *EQ ‘*NO’) */
ELSE CMD(DO)
CHGVAR VAR(&SQL) VALUE(‘INSERT INTO QTEMP.REPORT +
VALUES(””LIBRARY”;”FILE”;”MEMBER”;”TYPE”;”T+
EXT”;”NBRRCD”;”PHYSICAL_SLOC”;”CRT_TIMESTAMP+
“;”LAST_CHG_TIMESTAMP”;”IFS_SIZE”;”IFS_ALLOC+
“”)’)
ENDDO /* COND(&PSLOC *NE ‘*NO’) */

RUNSQL SQL(&SQL) COMMIT(*NONE)

CHGVAR VAR(&REPORT) VALUE(&TODIR *TCAT ‘#Report_’ *CAT +
&JOBNBR *TCAT ‘-‘ *CAT &JOBUSER *TCAT ‘-‘ +
*CAT &JOBNAME *TCAT ‘.csv’)

RMVLNK OBJLNK(&STMF)
MONMSG MSGID(CPFA0A9)

/* Create temporary file to estimate physical SLOC for Cobol and RPG */
IF COND(&PSLOC *EQ ‘*YES’) THEN(DO)

DLTF FILE(QTEMP/SLOC)
MONMSG MSGID(CPF2105)

CHGVAR VAR(&SQL) VALUE(‘CREATE TABLE QTEMP/SLOC +
(NUMBER NUMERIC(10, 0))’)

RUNSQL SQL(&SQL) COMMIT(*NONE)

CHGVAR VAR(&SQL) VALUE(‘INSERT INTO +
QTEMP/SLOC(NUMBER) VALUES(0)’)

RUNSQL SQL(&SQL) COMMIT(*NONE)

OVRDBF FILE(SLOC) TOFILE(QTEMP/SLOC) MBR(*FIRST) +
LVLCHK(*NO) OVRSCOPE(*CALLLVL)

ENDDO /* COND(&PSLOC *EQ ‘*YES’) */

ENDDO /* COND(&PREPORT *EQ ‘*YES’) */

/* Read member list file */
OVRDBF FILE(MBRLIST) TOFILE(QTEMP/MBRLIST) MBR(*FIRST) +
LVLCHK(*NO) OVRSCOPE(*CALLLVL) SHARE(*NO)

DOWHILE COND(&LOOP)

RCVF OPNID(MBRINFO)
MONMSG MSGID(CPF0864) EXEC(LEAVE)

/* Count members */
CHGVAR VAR(&MBRCNTX) VALUE(&MBRCNTX + 1)

/* Send *INFO or *STATUS message indicating the member being processed */
CHGVAR VAR(&MSGDTA) VALUE(‘Processing MBR(‘ *CAT +
&MBRINFO_MBNAME *TCAT ‘) TYPE(‘ *CAT +
&MBRINFO_MBSEU2 *TCAT ‘) NBRRCD(‘ *CAT +
%CHAR(&MBRINFO_MBNRCD) *TCAT ‘) [‘ *CAT +
%CHAR(&MBRCNTX) *TCAT ‘/’ *CAT +
%CHAR(&NBRSELMBR) *TCAT ‘|’ *CAT +
%CHAR(&NBRALLMBR) *TCAT ‘]’)

IF COND(&JOBTYPE *EQ ‘0’) THEN(DO) /* Batch */
SNDPGMMSG MSGID(CPI8859) MSGF(QCPFMSG) MSGDTA(&MSGDTA) +
TOPGMQ(*PRV (*)) TOMSGQ(*TOPGMQ) MSGTYPE(*INFO)
ENDDO /* COND(&JOBTYPE *EQ ‘0’) */
ELSE CMD(DO) /* Interactive */
SNDPGMMSG MSGID(CPI8859) MSGF(QCPFMSG) MSGDTA(&MSGDTA) +
TOPGMQ(*EXT) TOMSGQ(*TOPGMQ) MSGTYPE(*STATUS)
ENDDO /* COND(&JOBTYPE *NE ‘0’) */

/* Set MBR path (2) */
CHGVAR VAR(&MBRPATH) VALUE(&ASPPATH *TCAT ‘/QSYS.LIB/’ +
*CAT &FROMLIB *TCAT ‘.LIB/’ *CAT &FROMFILE +
*TCAT ‘.FILE/’ *CAT &MBRINFO_MBNAME *TCAT ‘.MBR’)

/* Set STMF extension (2) & STMF path */
IF COND(&PSTMFEXT *NE ‘*TYPE’) THEN(DO)
CHGVAR VAR(&STMF) VALUE(&TODIR *TCAT +
&MBRINFO_MBNAME *TCAT &STMFEXT)
ENDDO /* COND(&PSTMFEXT *NE ‘*TYPE’) */
ELSE CMD(DO)
IF COND(&MBRINFO_MBSEU2 *NE ‘ ‘) THEN(DO)
CHGVAR VAR(&STMF) VALUE(&TODIR *TCAT +
&MBRINFO_MBNAME *TCAT ‘.’ *CAT +
&MBRINFO_MBSEU2)
ENDDO /* COND(&MBRINFO_MBSEU2 *NE ‘ ‘) */
ELSE CMD(DO)
CHGVAR VAR(&STMF) VALUE(&TODIR *TCAT &MBRINFO_MBNAME)
ENDDO /* COND(&MBRINFO_MBSEU2 *EQ ‘ ‘) */

ENDDO /* COND(&PSTMFEXT *EQ ‘*TYPE’) */

/* Copy MBR to STMF */
CPYTOSTMF FROMMBR(&MBRPATH) TOSTMF(&STMF) +
STMFOPT(*REPLACE) CVTDTA(*AUTO) +
DBFCCSID(*FILE) STMFCCSID(&PSTMFCCSID) +
ENDLINFMT(&PENDLINFMT) AUT(&PAUT)

/* Set STMF description */
IF COND(&PSTMFTXT *EQ ‘*YES’) THEN(DO)
CHGATR OBJ(&STMF) ATR(*TEXT) VALUE(*NONE) +
TEXT(&MBRINFO_MBMTXT)
ENDDO /* COND(&PSTMFTXT *EQ ‘*YES’) */

/* Count members */
CHGVAR VAR(&MBRCNT) VALUE(&MBRCNT + 1)

/* Count records */
CHGVAR VAR(&RCDCNT) VALUE(&RCDCNT + &MBRINFO_MBNRCD)

/* Retrieve STMF information */
CHGVAR VAR(&STATPATH) VALUE(&STMF *TCAT &NULL)
CALLPRC PRC(‘stat64’) PARM((&STATPATH) (&STATBUFFER)) +
RTNVAL(&STATRTNVAL)
IF COND(&STATRTNVAL *EQ 0) THEN(DO)
CHGVAR VAR(&IFSSIZ) VALUE(&IFSSIZ + &STATOBJSIZ)
CHGVAR VAR(&IFSALC) VALUE(&IFSALC + &STATALCSIZ)
ENDDO /* COND(&STATRTNVAL *EQ 0) */
ELSE CMD(DO)
CHGVAR VAR(&PRCNAME) VALUE(‘stat64’)
CHGVAR VAR(&SUBRNAME) VALUE(‘MAIN’)
CHGVAR VAR(&ERRORTEXT) VALUE(‘ (PRC’ *BCAT &PRCNAME +
*BCAT ‘in’ *BCAT &SUBRNAME *TCAT ‘)’)
GOTO CMDLBL(ERROR)
ENDDO /* COND(&STATRTNVAL *NE 0) */

/* Update report file */
IF COND(&PREPORT *EQ ‘*YES’) THEN(DO)

CHGVAR VAR(&TEXTIN) VALUE(&MBRINFO_MBMTXT)
CALLSUBR SUBR(DUPQUOTE) RTNVAL(&DUPQUOTE)

IF COND(&MBRINFO_MBCCEN *EQ ‘0’) THEN(DO)
CHGVAR VAR(&MBRCRTCEN) VALUE(’19’)
ENDDO /* COND(&MBRINFO_MBCCEN *EQ ‘0’) */
ELSE CMD(DO)
CHGVAR VAR(&MBRCRTCEN) VALUE(’20’)
ENDDO /* COND(&MBRINFO_MBCCEN *NE ‘0’) */

CHGVAR VAR(&MBRCRTDAT) VALUE(&MBRCRTCEN *CAT +
%SST(&MBRINFO_MBCDAT 1 2) *CAT ‘-‘ *CAT +
%SST(&MBRINFO_MBCDAT 3 2) *CAT ‘-‘ *CAT +
%SST(&MBRINFO_MBCDAT 5 2))

CHGVAR VAR(&MBRCRTTIM) VALUE(%SST(&MBRINFO_MBCTIM 1 +
2) *CAT ‘.’ *CAT %SST(&MBRINFO_MBCTIM 3 2) +
*CAT ‘.’ *CAT %SST(&MBRINFO_MBCTIM 5 2))

CHGVAR VAR(&MBRCRTTS) VALUE(&MBRCRTDAT *CAT ‘-‘ +
*CAT &MBRCRTTIM *CAT ‘.000000’)

IF COND(&MBRINFO_MBUPDC *EQ ‘0’) THEN(DO)
CHGVAR VAR(&MBRCHGCEN) VALUE(’19’)
ENDDO /* COND(&MBRINFO_MBUPDC *EQ ‘0’) */
ELSE CMD(DO)
CHGVAR VAR(&MBRCHGCEN) VALUE(’20’)
ENDDO /* COND(&MBRINFO_MBUPDC *NE ‘0’) */

CHGVAR VAR(&MBRCHGDAT) VALUE(&MBRCHGCEN *CAT +
%SST(&MBRINFO_MBUPDD 1 2) *CAT ‘-‘ *CAT +
%SST(&MBRINFO_MBUPDD 3 2) *CAT ‘-‘ *CAT +
%SST(&MBRINFO_MBUPDD 5 2))

CHGVAR VAR(&MBRCHGTIM) VALUE(%SST(&MBRINFO_MBUPDT 1 +
2) *CAT ‘.’ *CAT %SST(&MBRINFO_MBUPDT 3 2) +
*CAT ‘.’ *CAT %SST(&MBRINFO_MBUPDT 5 2))

CHGVAR VAR(&MBRCHGTS) VALUE(&MBRCHGDAT *CAT ‘-‘ +
*CAT &MBRCHGTIM *CAT ‘.000000’)

/* Estimate physical SLOC for Cobol and RPG */
IF COND(&PSLOC *EQ ‘*YES’) THEN(DO)

SELECT
WHEN COND((%SCAN(‘CBL’ &MBRINFO_MBSEU2) *GT +
0) *OR (%SCAN(‘CBL’ &PSTMFEXT) *GT +
0)) THEN(DO)
CHGVAR VAR(&SQL) VALUE(‘UPDATE QTEMP/SLOC +
SET NUMBER = (SELECT COUNT(*) +
FROM +
TABLE(QSYS2.IFS_READ(PATH_NAME => +
”’ *CAT &STMF *TCAT ”’, +
END_OF_LINE => ”’ *CAT +
%SST(&PENDLINFMT 2 5) *TCAT ”’)) +
WHERE LINE LIKE ”_%” AND NOT +
REGEXP_LIKE(LINE, ”^.{6}*.*”) +
AND NOT REGEXP_LIKE(LINE, +
”^.{6}s.*processs.*”, ”i”))’)
CHGVAR VAR(&SLOC) VALUE(‘1’)
ENDDO /* COND((%SCAN(‘CBL’ &MBRINFO_MBSEU2) +
*LE 0) *OR (%SCAN(‘CBL’ &PSTMFEXT) +
*LE 0)) */
WHEN COND((%SCAN(‘RPG’ &MBRINFO_MBSEU2) *GT +
0) *OR (%SCAN(‘RPG’ &PSTMFEXT) *GT +
0)) THEN(DO)
CHGVAR VAR(&SQL) VALUE(‘UPDATE QTEMP/SLOC +
SET NUMBER = (SELECT COUNT(*) +
FROM +
TABLE(QSYS2.IFS_READ(PATH_NAME => +
”’ *CAT &STMF *TCAT ”’, +
END_OF_LINE => ”’ *CAT +
%SST(&PENDLINFMT 2 5) *TCAT ”’)) +
WHERE LINE LIKE ”_%” AND NOT +
REGEXP_LIKE(LINE, ”^**free”, +
”i”) AND NOT REGEXP_LIKE(LINE, +
”^s*ctl-opts.*”, ”i”) AND +
NOT REGEXP_LIKE(LINE, +
”^s*//(.)*”) AND NOT +
REGEXP_LIKE(LINE, +
”^s*/[a-zA-Z]”, ”i”) AND +
NOT REGEXP_LIKE(LINE, +
”^.{6}*((?!;).)*$”))’)
CHGVAR VAR(&ampSLOC) VALUE(‘1’)
ENDDO /* COND((%SCAN(‘RPG’ &ampMBRINFO_MBSEU2) +
*GT 0) *OR (%SCAN(‘RPG’ &ampPSTMFEXT) +
*GT 0)) */
OTHERWISE CMD(DO)
CHGVAR VAR(&ampSLOC) VALUE(‘0’)
ENDDO /* OTHERWISE */
ENDSELECT

IF COND(&ampSLOC) THEN(DO)
RUNSQL SQL(&ampSQL) COMMIT(*NONE)
RCVF OPNID(SLOC)
CLOSE OPNID(SLOC) /* RCVF */
CHGVAR VAR(&ampSQL) VALUE(‘INSERT INTO +
QTEMP.REPORT VALUES(””‘ *CAT +
&ampFROMLIB *TCAT ‘”;”‘ *CAT &ampFROMFILE +
*TCAT ‘”;”‘ *CAT &ampMBRINFO_MBNAME +
*TCAT ‘”;”‘ *CAT &ampMBRINFO_MBSEU2 +
*TCAT ‘”;”‘ *CAT &ampTEXTOUT *TCAT +
‘”;”‘ *CAT %CHAR(&ampMBRINFO_MBNRCD) +
*TCAT ‘”;”‘ *CAT %CHAR(&ampSLOC_NUMBER) +
*TCAT ‘”;”‘ *CAT &ampMBRCRTTS *TCAT +
‘”;”‘ *CAT &ampMBRCHGTS *TCAT ‘”;”‘ +
*CAT %CHAR(&ampSTATOBJSIZ) *TCAT ‘”;”‘ +
*CAT %CHAR(&ampSTATALCSIZ) *TCAT ‘””)’)
ENDDO /* COND(&ampSLOC) */
ELSE CMD(DO)
CHGVAR VAR(&ampSLOC_NUMBER) VALUE(0)
CHGVAR VAR(&ampSQL) VALUE(‘INSERT INTO +
QTEMP.REPORT VALUES(””‘ *CAT +
&ampFROMLIB *TCAT ‘”;”‘ *CAT &ampFROMFILE +
*TCAT ‘”;”‘ *CAT &ampMBRINFO_MBNAME +
*TCAT ‘”;”‘ *CAT &ampMBRINFO_MBSEU2 +
*TCAT ‘”;”‘ *CAT &ampTEXTOUT *TCAT +
‘”;”‘ *CAT %CHAR(&ampMBRINFO_MBNRCD) +
*TCAT ‘”;” “;”‘ *CAT &ampMBRCRTTS *TCAT +
‘”;”‘ *CAT &ampMBRCHGTS *TCAT ‘”;”‘ +
*CAT %CHAR(&ampSTATOBJSIZ) *TCAT ‘”;”‘ +
*CAT %CHAR(&ampSTATALCSIZ) *TCAT ‘””)’)
ENDDO /* COND(*NOT &ampSLOC) */
CHGVAR VAR(&ampSLOCCNT) VALUE(&ampSLOCCNT + &ampSLOC_NUMBER)

ENDDO /* COND(&ampPSLOC *EQ ‘*YES’) */

ELSE CMD(DO)

CHGVAR VAR(&ampSQL) VALUE(‘INSERT INTO QTEMP.REPORT +
VALUES(””‘ *CAT &ampFROMLIB *TCAT ‘”;”‘ +
*CAT &ampFROMFILE *TCAT ‘”;”‘ *CAT +
&ampMBRINFO_MBNAME *TCAT ‘”;”‘ *CAT +
&ampMBRINFO_MBSEU2 *TCAT ‘”;”‘ *CAT +
&ampTEXTOUT *TCAT ‘”;”‘ *CAT +
%CHAR(&ampMBRINFO_MBNRCD) *TCAT ‘”;”‘ *CAT +
&ampMBRCRTTS *TCAT ‘”;”‘ *CAT &ampMBRCHGTS +
*TCAT ‘”;”‘ *CAT %CHAR(&ampSTATOBJSIZ) +
*TCAT ‘”;”‘ *CAT %CHAR(&ampSTATALCSIZ) +
*TCAT ‘””)’)

ENDDO /* COND(&ampPSLOC *NE ‘*YES’) */

RUNSQL SQL(&ampSQL) COMMIT(*NONE)

ENDDO /* COND(&ampPREPORT *EQ ‘*YES’) */

ENDDO /* DOWHILE */

/* Display run statistics */
CHGVAR VAR(&ampSIZEDEC) VALUE(&ampMBRCNT)
CALLSUBR SUBR(EDTNUM) RTNVAL(&ampEDTNUM)
IF COND(&ampEDTNUM *EQ 0) THEN(DO)
CHGVAR VAR(&ampMBRCNTCHAR) VALUE(&ampSIZECHAR)
ENDDO /* COND(&ampEDTNUM *EQ 0) */
ELSE CMD(DO)
CHGVAR VAR(&ampMBRCNTCHAR) VALUE(‘0’)
ENDDO /* COND(&ampEDTNUM *NE 0) */

CHGVAR VAR(&ampSIZEDEC) VALUE(&ampRCDCNT)
CALLSUBR SUBR(EDTNUM) RTNVAL(&ampEDTNUM)
IF COND(&ampEDTNUM *EQ 0) THEN(DO)
CHGVAR VAR(&ampRCDCNTCHAR) VALUE(&ampSIZECHAR)
ENDDO /* COND(&ampEDTNUM *EQ 0) */
ELSE CMD(DO)
CHGVAR VAR(&ampRCDCNTCHAR) VALUE(‘0’)
ENDDO /* COND(&ampEDTNUM *NE 0) */

CHGVAR VAR(&ampSIZEDEC) VALUE(&ampIFSSIZ)
CALLSUBR SUBR(EDTNUM) RTNVAL(&ampEDTNUM)
IF COND(&ampEDTNUM *EQ 0) THEN(DO)
CHGVAR VAR(&ampIFSSIZCHAR) VALUE(&ampSIZECHAR)
ENDDO /* COND(&ampEDTNUM *EQ 0) */
ELSE CMD(DO)
CHGVAR VAR(&ampIFSSIZCHAR) VALUE(‘0’)
ENDDO /* COND(&ampEDTNUM *NE 0) */

CHGVAR VAR(&ampSIZEDEC) VALUE(&ampIFSALC)
CALLSUBR SUBR(EDTNUM) RTNVAL(&ampEDTNUM)
IF COND(&ampEDTNUM *EQ 0) THEN(DO)
CHGVAR VAR(&ampIFSALCCHAR) VALUE(&ampSIZECHAR)
ENDDO /* COND(&ampEDTNUM *EQ 0) */
ELSE CMD(DO)
CHGVAR VAR(&ampIFSALCCHAR) VALUE(‘0’)
ENDDO /* COND(&ampEDTNUM *NE 0) */

IF COND(&ampPSLOC *EQ ‘*YES’) THEN(DO)
CHGVAR VAR(&ampSIZEDEC) VALUE(&ampSLOCCNT)
CALLSUBR SUBR(EDTNUM) RTNVAL(&ampEDTNUM)
IF COND(&ampEDTNUM *EQ 0) THEN(DO)
CHGVAR VAR(&ampSLOCCNTCHR) VALUE(&ampSIZECHAR)
ENDDO /* COND(&ampEDTNUM *EQ 0) */
ELSE CMD(DO)
CHGVAR VAR(&ampSLOCCNTCHR) VALUE(‘0’)
ENDDO /* COND(&ampEDTNUM *NE 0) */
ENDDO /* COND(&ampPSLOC *EQ ‘*YES’) */

/* Create CSV report */
IF COND(&ampPREPORT *EQ ‘*YES’) THEN(DO)

IF COND(&ampPSLOC *EQ ‘*NO’) THEN(DO)
CHGVAR VAR(&ampSQL) VALUE(‘INSERT INTO QTEMP.REPORT +
VALUES(”””;””;”‘ *CAT %CHAR(&ampMBRCNT) +
*TCAT ‘”;””;””;”‘ *CAT %CHAR(&ampRCDCNT) +
*TCAT ‘”;””;””;”‘ *CAT %CHAR(&ampIFSSIZ) +
*TCAT ‘”;”‘ *CAT %CHAR(&ampIFSALC) *TCAT ‘””)’)
ENDDO /* COND(&ampPSLOC *EQ ‘*NO’) */
ELSE CMD(DO)
CHGVAR VAR(&ampSQL) VALUE(‘INSERT INTO QTEMP.REPORT +
VALUES(”””;””;”‘ *CAT %CHAR(&ampMBRCNT) +
*TCAT ‘”;””;””;”‘ *CAT %CHAR(&ampRCDCNT) +
*TCAT ‘”;”‘ *CAT %CHAR(&ampSLOCCNT) *TCAT +
‘”;””;””;”‘ *CAT %CHAR(&ampIFSSIZ) *TCAT +
‘”;”‘ *CAT %CHAR(&ampIFSALC) *TCAT ‘””)’)
ENDDO /* COND(&ampPSLOC *NE ‘*NO’) */

RUNSQL SQL(&ampSQL) COMMIT(*NONE)

CPYTOSTMF +
FROMMBR(‘/QSYS.LIB/QTEMP.LIB/REPORT.FILE/REPORT+
.MBR’) TOSTMF(&ampREPORT) STMFOPT(*REPLACE) +
CVTDTA(*AUTO) DBFCCSID(*FILE) +
STMFCCSID(&ampPSTMFCCSID) ENDLINFMT(&ampPENDLINFMT) +
AUT(&ampPAUT)

DLTF FILE(QTEMP/REPORT)
MONMSG MSGID(CPF0000)

ENDDO /* COND(&ampPREPORT *EQ ‘*YES’) */

IF COND(&ampPSLOC *EQ ‘*NO’) THEN(DO)
CHGVAR VAR(&ampMSGDTA) VALUE(‘Member processed:’ *BCAT +
%TRIML(&ampMBRCNTCHAR) *BCAT ‘- Records:’ *BCAT +
%TRIML(&ampRCDCNTCHAR) *BCAT ‘- IFS size +
(byte):’ *BCAT %TRIML(&ampIFSSIZCHAR) *BCAT ‘- +
IFS allocated size (byte):’ *BCAT +
%TRIML(&ampIFSALCCHAR))
ENDDO /* COND(&ampPSLOC *EQ ‘*NO’) */
ELSE CMD(DO)
CHGVAR VAR(&ampMSGDTA) VALUE(‘Member processed:’ *BCAT +
%TRIML(&ampMBRCNTCHAR) *BCAT ‘- Records:’ *BCAT +
%TRIML(&ampRCDCNTCHAR) *BCAT ‘- Cobol SLOC:’ +
*BCAT %TRIML(&ampSLOCCNTCHR) *BCAT ‘- IFS size +
(byte):’ *BCAT %TRIML(&ampIFSSIZCHAR) *BCAT ‘- +
IFS allocated size (byte):’ *BCAT +
%TRIML(&ampIFSALCCHAR))
ENDDO /* COND(&ampPSLOC *NE ‘*NO’) */

SNDPGMMSG MSGID(CPI8859) MSGF(QCPFMSG) MSGDTA(&ampMSGDTA) +
TOPGMQ(*PRV (*)) TOMSGQ(*TOPGMQ) MSGTYPE(*INFO)

GOTO CMDLBL(CLEANUP)

ERROR:
RCVMSG PGMQ(*SAME) MSGTYPE(*LAST) RMV(*YES) MSG(&ampMSG) +
MSGLEN(&ampMSGLEN) SECLVL(&ampSECLVL) +
SECLVLLEN(&ampSECLVLLEN) MSGDTA(&ampMSGDTA) +
MSGDTALEN(&ampMSGDTALEN) MSGID(&ampMSGID) +
RTNTYPE(&ampRTNTYPE) MSGF(&ampMSGF) SNDMSGFLIB(&ampMSGFLIB)

CHGVAR VAR(&ampPGMERROR) VALUE(‘1’)

CLEANUP:
DLTF FILE(QTEMP/MEMBERLIST)
MONMSG MSGID(CPF0000)

CLOSE OPNID(PFSRC) /* RCVF */
MONMSG MSGID(CPF0000)

CLOSE OPNID(SLOC) /* RCVF */
MONMSG MSGID(CPF0000)

CLOSE OPNID(MBRINFO) /* RCVF */
MONMSG MSGID(CPF0000)

DLTOVR FILE(*ALL) LVL(*) /* OVRDBF */
MONMSG MSGID(CPF0000)

DLTF FILE(QTEMP/PFSRCLIST)
MONMSG MSGID(CPF0000)

DLTF FILE(QTEMP/SLOC)
MONMSG MSGID(CPF0000)

DLTF FILE(QTEMP/MBRLIST)
MONMSG MSGID(CPF0000)

/* Goto exit */
IF COND(&ampPGMERROR *EQ ‘0’) THEN(DO)
GOTO CMDLBL(RETURN)
ENDDO /* COND(&ampPGMERROR *EQ ‘0’) */

/* Call error subroutine */
CALLSUBR SUBR(ERROR)

RETURN:
RETURN

/* SUBR(VFYPFSRC): Start *********************************************/

VFYPFSRC: SUBR SUBR(VFYPFSRC)

CHGVAR VAR(&ampSUBRNAME) VALUE(‘VFYPFSRC’)
CHGVAR VAR(&ampVFYPFSRC) VALUE(0)

CHGVAR VAR(&ampQDBFFMTTYP) VALUE(‘*INT’)

CALLSUBR SUBR(RSTAPIERR) RTNVAL(&ampRSTAPIERR)

CALL PGM(QDBRTVFD) PARM(&ampFILD0100 &ampFILD0100L +
&ampQDBFOUT ‘FILD0100’ &ampQDBFIN &ampQDBFRCDFMT +
&ampQDBFOVR &ampQDBFSYS &ampQDBFFMTTYP &ampAPIERROR)

IF COND(&ampAEBYTAVL *NE 0) THEN(DO)
SNDPGMMSG MSGID(&ampAEEXCPID) MSGF(QCPFMSG) +
MSGDTA(&ampAEEXCPDTA) TOPGMQ(*SAME (*)) +
TOMSGQ(*TOPGMQ) MSGTYPE(*DIAG)
CHGVAR VAR(&ampAPINAME) VALUE(‘QDBRTVFD’)
CHGVAR VAR(&ampERRORTEXT) VALUE(‘ (API’ *BCAT &ampAPINAME +
*BCAT ‘in’ *BCAT &ampSUBRNAME *TCAT ‘)’)
CHGVAR VAR(&ampVFYPFSRC) VALUE(-1)
ENDDO /* COND(&ampAEBYTAVL *NE 0) */
ELSE CMD(DO)
/* Test type of file: On -&gt LF, Off -&gt PF */
CHGVAR VAR(&ampBIT_POS) VALUE(2)
CALLPRC PRC(‘_TSTBTS’) PARM((&ampQDBFHFLG) (&ampBIT_POS +
*BYVAL)) RTNVAL(&ampBIT_POS)
CHGVAR VAR(&ampBIT_2_ON) VALUE(&ampBIT_POS *EQ 1)
/* Test FILETYPE: On -&gt SRC, Off -&gt DTA */
CHGVAR VAR(&ampBIT_POS) VALUE(4)
CALLPRC PRC(‘_TSTBTS’) PARM((&ampQDBFHFLG) (&ampBIT_POS +
*BYVAL)) RTNVAL(&ampBIT_POS)
CHGVAR VAR(&ampBIT_4_ON) VALUE(&ampBIT_POS *EQ 1)
IF COND(&ampBIT_2_ON) THEN(DO)
CHGVAR VAR(&ampFILEATRB) VALUE(‘LF’)
ENDDO
ELSE CMD(DO)
CHGVAR VAR(&ampFILEATRB) VALUE(‘PF’)
ENDDO
IF COND(&ampBIT_4_ON) THEN(DO)
CHGVAR VAR(&ampFILETYPE) VALUE(‘SRC’)
ENDDO
ELSE CMD(DO)
CHGVAR VAR(&ampFILETYPE) VALUE(‘DTA’)
ENDDO
CHGVAR VAR(&ampNBRALLMBR) VALUE(&ampQDBFHMNUM)
CHGVAR VAR(&ampVFYPFSRC) VALUE(0)
ENDDO /* COND(&ampAEBYTAVL *EQ 0) */

ENDSUBR RTNVAL(&ampVFYPFSRC)

/* SUBR(VFYPFSRC): End ***********************************************/

/* SUBR(DUPQUOTE): Start *********************************************/

DUPQUOTE: SUBR SUBR(DUPQUOTE)

CHGVAR VAR(&ampSUBRNAME) VALUE(‘DUPQUOTE’)
CHGVAR VAR(&ampDUPQUOTE) VALUE(0)

CHGVAR VAR(&ampTEXTOUT) VALUE(‘ ‘)
CHGVAR VAR(&ampTEXT_J) VALUE(1)

DOFOR VAR(&ampTEXT_I) FROM(1) TO(%SIZE(&ampTEXTIN))
IF COND(%SST(&ampTEXTIN &ampTEXT_I 1) *NE &ampQUOTE) THEN(DO)
CHGVAR VAR(%SST(&ampTEXTOUT &ampTEXT_J 1)) +
VALUE(%SST(&ampTEXTIN &ampTEXT_I 1))
CHGVAR VAR(&ampTEXT_J) VALUE(&ampTEXT_J + 1)
ENDDO /* COND(%SST(&ampTEXTIN &ampTEXT_I 1) *NE &ampQUOTE) */
ELSE CMD(DO)
CHGVAR VAR(%SST(&ampTEXTOUT &ampTEXT_J 2)) +
VALUE(&ampQUOTE *CAT &ampQUOTE *CAT &ampQUOTE +
*CAT &ampQUOTE)
CHGVAR VAR(&ampTEXT_J) VALUE(&ampTEXT_J + 2)
ENDDO /* COND(%SST(&ampTEXTIN &ampTEXT_I 1) *EQ &ampQUOTE) */
IF COND(&ampTEXT_J *GT %SIZE(&ampTEXTOUT)) THEN(DO)
LEAVE
ENDDO /* COND(&ampTEXT_J *GT %SIZE(&ampTEXTOUT)) */
ENDDO /* DOFOR */

ENDSUBR RTNVAL(&ampDUPQUOTE)

/* SUBR(DUPQUOTE): End ***********************************************/

/* SUBR(EDTNUM): Start ***********************************************/

EDTNUM: SUBR SUBR(EDTNUM)

CHGVAR VAR(&ampSUBRNAME) VALUE(‘EDTNUM’)
CHGVAR VAR(&ampEDTNUM) VALUE(0)

CHGVAR VAR(%BIN(&ampSRCVARPCSN)) VALUE(15)

CHGVAR VAR(%BIN(&ampSRCVARDEC)) VALUE(0)

CALL PGM(QECCVTEC) PARM(&ampEDTMASK &ampEDTMASKLEN +
&ampRCVVARLEN &ampZROBAL &ampEDTCODE &ampCURRENCY +
&ampSRCVARPCSN &ampSRCVARDEC &ampAPIERROR)

CALL PGM(QECEDT) PARM(&ampSIZECHAR &ampRCVVARLEN &ampSIZEDEC +
‘*PACKED’ &ampSRCVARPCSN &ampEDTMASK &ampEDTMASKLEN +
&ampZROBAL &ampAPIERROR)

ENDSUBR RTNVAL(&ampEDTNUM)

/* SUBR(EDTNUM): End *************************************************/

/* SUBR(RSTAPIERR): Start ********************************************/

RSTAPIERR: SUBR SUBR(RSTAPIERR)

CHGVAR VAR(&ampSUBRNAME) VALUE(‘RSTAPIERR’)
CHGVAR VAR(&ampRSTAPIERR) VALUE(0)

CHGVAR VAR(&ampAEBYTPRO) VALUE(0)
CHGVAR VAR(&ampAEBYTAVL) VALUE(0)

ENDSUBR RTNVAL(&ampRSTAPIERR)

/* SUBR(RSTAPIERR): End **********************************************/

/* SUBR(ERROR): Start ************************************************/

ERROR: SUBR SUBR(ERROR)

CHGVAR VAR(&ampSUBRNAME) VALUE(‘ERROR’)

IF COND(&ampERROR) THEN(RETURN)

CHGVAR VAR(&ampERROR) VALUE(‘1’)

/* 02: Diagnostic – 15: Escape (exception already handled at time of RCVMSG) +
– 17: Escape (exception not handled at time of RCVMSG) */
IF COND((&ampRTNTYPE *EQ ’02’) *OR (&ampRTNTYPE *EQ +
’15’) *OR (&ampRTNTYPE *EQ ’17’)) THEN(DO)
/* Send DIAGNOSTIC message */
SNDPGMMSG MSGID(&ampMSGID) MSGF(&ampMSGFLIB/&ampMSGF) +
MSGDTA(&ampMSGDTA) TOPGMQ(*PRV (*)) +
TOMSGQ(*TOPGMQ) MSGTYPE(*DIAG)
MONMSG MSGID(CPF0000)
ENDDO /* COND((&ampRTNTYPE *EQ ’02’) *OR (&ampRTNTYPE *EQ +
’15’) *OR (&ampRTNTYPE *EQ ’17’)) */

/* Send ESCAPE message */
IF COND(&ampPGMERROR) THEN(DO)
CHGVAR VAR(&ampMSGDTA) VALUE(&ampPGMNAME *BCAT ‘ended +
abnormally’ *CAT %TRIMR(&ampERRORTEXT))
SNDPGMMSG MSGID(CPF9898) MSGF(QCPFMSG) MSGDTA(&ampMSGDTA) +
TOPGMQ(*PRV (*)) TOMSGQ(*TOPGMQ) +
MSGTYPE(*ESCAPE)
ENDDO /* COND(&ampPGMERROR) */

ENDSUBR RTNVAL(0)

/* SUBR(ERROR): End **************************************************/

ENDPGM:
ENDPGM

References:

Copy To Stream File (CPYTOSTMF)

Find Source Member (FNDSRCMBR): Subroutine VFY_SRCF (verify source file attributes)

Related Posts

ncdu – IFS Disk Space Analyzer

If we want to check the disk space occupied by IFS files and directories, we have the possibility to install Read more


IFS – Find files and directories in your IFS

I take advantage of a question asked on the Midrange.com discussion groups ( Is there an easy way to find Read more


IFS files management

I believe that all of us who work in the IBM i environment have happened, and continue to do, to Read more

L’articolo Export source code to IFS proviene da BlogFaq400.

Verified by MonsterInsights