Does anyone on your team have an AS400 script handy to purge out oldest members of appended files?

Tags:
AS/400
Performance/Tuning
tips and tricks
Tools
Basically, I'm hoping that somebody out there might already have a script or program that they use to purge out old members that get appended to static physical files on the MC400 (HNNE). I would be much obliged if you could send me the program or provide me a tip on where I can find a good script example online. My personal OS/400 experience: Novice, at best! Looking for a home-spun script/program only. (I am not at liberty to purchase any kind of software package with this functionality included in it.) Thanks! Gary
ASKED: March 22, 2005  2:07 PM
UPDATED: October 20, 2009  6:25 AM

Answer Wiki

Thanks. We'll let you know when a new response is added.

Here’s the code we use to remove members. Sorry about the format – you’ll have to copy/paste to remove the blanks.

/****************************************************************/
/* */
/* JPRGMEM SOURCE – PURGES MEMBERS WITHIN A FILE */
/* OLDER THAN QQ DAYS */
/* */
/****************************************************************/

PURGOLD: PGM

DCL VAR(&QQ) TYPE(*DEC) LEN(2 0) VALUE(15) /*DAYS*/
DCL VAR(&RUNAWAY) TYPE(*DEC) LEN(3 0) VALUE(0)
DCL VAR(&COUNT) TYPE(*DEC) LEN(3 0) VALUE(0)
DCL VAR(&LIB) TYPE(*CHAR) LEN(9) VALUE(‘LIBNAME’)
DCL VAR(&FILE) TYPE(*CHAR) LEN(9) VALUE(‘FILENAME’)
DCL VAR(&CSDATE) TYPE(*CHAR) LEN(6)
DCL VAR(&CSJULIAN) TYPE(*CHAR) LEN(5)
DCL VAR(&DSJULYR) TYPE(*DEC) LEN(2 0)
DCL VAR(&DSJULDAY) TYPE(*DEC) LEN(3 0)
DCL VAR(&DSCUTOFF) TYPE(*DEC) LEN(5 0)
DCL VAR(&CMNAME) TYPE(*CHAR) LEN(10)
DCL VAR(&CMLAST) TYPE(*CHAR) LEN(10)
DCL VAR(&CMREF) TYPE(*CHAR) LEN(10)
DCL VAR(&CMDATE) TYPE(*CHAR) LEN(13)
DCL VAR(&CMCRTJUL) TYPE(*CHAR) LEN(5)
DCL VAR(&CCOUNT) TYPE(*CHAR) LEN(3)
DCL VAR(&CRUNAWAY) TYPE(*CHAR) LEN(3)
DCL VAR(&DMCRTJUL) TYPE(*DEC) LEN(5 0)

/* DETERMINE THE CUTOFF DATE: &DSCUTOFF */

RTVSYSVAL SYSVAL(QDATE) RTNVAR(&CSDATE)
CVTDAT DATE(&CSDATE) TOVAR(&CSJULIAN) +
FROMFMT(*SYSVAL) TOFMT(*JUL) TOSEP(*NONE)
CHGVAR VAR(&DSJULYR) VALUE(%SST(&CSJULIAN 1 2))
CHGVAR VAR(&DSJULDAY) VALUE(%SST(&CSJULIAN 3 3))
IF COND(&DSJULDAY *LT &QQ) +
THEN(DO)
CHGVAR VAR(&DSJULYR) VALUE(&DSJULYR – 1)
IF COND(&DSJULYR *EQ -1) THEN(CHGVAR +
VAR(&DSJULYR) VALUE(99))
CHGVAR VAR(&DSCUTOFF) VALUE(&DSJULYR * 1000 + 366 + +
&DSJULDAY – &QQ)
ENDDO

ELSE CMD(CHGVAR VAR(&DSCUTOFF) VALUE(&DSJULYR * +
1000 + &DSJULDAY – &QQ))

/* GET MEMBER CREATE DATES AND COMPARE WITH */

RTVMBRD FILE(&LIB/&FILE) MBR(*LASTMBR) RTNMBR(&CMREF)
MONMSG MSGID(CPF3019) EXEC(DO)
RCVMSG MSGTYPE(*EXCP)
SNDUSRMSG MSG(‘NO MEMBERS FOUND WITHIN’ *BCAT &LIB +
*TCAT ‘/’ *TCAT &FILE) MSGTYPE(*INFO)
GOTO CMDLBL(EOF)
ENDDO

RTVMBRD FILE(&LIB/&FILE) MBR(*FIRSTMBR) RTNMBR(&CMLAST)
IF COND(&CMLAST *EQ &CMREF) THEN(GOTO CMDLBL(END))

LOOP: RTVMBRD FILE(&LIB/&FILE) MBR(&CMREF *PRV) +
RTNMBR(&CMNAME) CRTDATE(&CMDATE)
IF COND(%SST(&CMNAME 1 4) *EQ ‘O999′) +
THEN(CHGVAR VAR(&CMDATE) VALUE(’0991231′))
CHGVAR VAR(&CMDATE) VALUE(%SST(&CMDATE 2 6))
CVTDAT DATE(&CMDATE) TOVAR(&CMCRTJUL) FROMFMT(*YMD) +
TOFMT(*JUL) TOSEP(*NONE)
CHGVAR VAR(&DMCRTJUL) VALUE(&CMCRTJUL)
CHGVAR VAR(&RUNAWAY) VALUE(&RUNAWAY + 1)
IF COND(&RUNAWAY *GT 997) THEN(GOTO CMDLBL(END))

/* INSERT FILENAME IN CMD */
IF COND(&DMCRTJUL *LE &DSCUTOFF *AND &CMNAME *NE +
‘FILENAME’) +
THEN(DO)
RMVM FILE(&LIB/&FILE) MBR(&CMNAME)
CHGVAR VAR(&COUNT) VALUE(&COUNT + 1)
ENDDO
ELSE CMD(CHGVAR VAR(&CMREF) VALUE(&CMNAME))
IF COND(&CMNAME *NE &CMLAST) THEN(GOTO +
CMDLBL(LOOP))

END:
RTVMBRD FILE(&LIB/&FILE) MBR(*LASTMBR) +
RTNMBR(&CMNAME) CRTDATE(&CMDATE)
CHGVAR VAR(&CMDATE) VALUE(%SST(&CMDATE 2 6))
CVTDAT DATE(&CMDATE) TOVAR(&CMCRTJUL) FROMFMT(*YMD) +
TOFMT(*JUL) TOSEP(*NONE)
CHGVAR VAR(&DMCRTJUL) VALUE(&CMCRTJUL)
CHGVAR VAR(&RUNAWAY) VALUE(&RUNAWAY + 1)
IF COND(%SST(&CMNAME 1 4) *EQ ‘O999′) THEN(GOTO +
CMDLBL(SND))
IF COND(&DMCRTJUL *LE &DSCUTOFF) +
THEN(DO)
RMVM FILE(&LIB/&FILE) MBR(&CMNAME)
CHGVAR VAR(&COUNT) VALUE(&COUNT + 1)
ENDDO

SND: CHGVAR VAR(&CCOUNT) VALUE(&COUNT)
CHGVAR VAR(&CRUNAWAY) VALUE(&RUNAWAY)
SNDUSRMSG MSG(‘FILE:’ *BCAT &LIB *TCAT ‘/’ *TCAT &FILE +
*BCAT ‘ MEMBERS ANALYSED:’ *BCAT +
&CRUNAWAY *BCAT ‘ MEMBERS PURGED:’ +
*BCAT &CCOUNT) MSGTYPE(*INFO)

EOF:
ENDPGM

================================================================

It’s not clear what you mean by “oldest members”. Do you mean “the single oldest members in each of a list of files”? I.e., only one member will be removed from each file. Or do you mean “the old members that will be determined by some criteria such as a cut-off date for a list of files”? I.e., the oldest members are deleted from the files and there might be a lot of members removed from each file.

This command in a CL program:
<pre>
RTVMBRD FILE(MYLIB/MYFILE)
MBR(*FIRST)
RTNMBR(&OLDMBR)
CRTDATE(&CRTDATE)
NBRDTAMBRS(&NBRDTAMBRS)
</pre>
…will return the name of the oldest member of file MYLIB/MYFILE along with its creation date/time and the total number of members. You can remove the member:
<pre>
RMVM FILE(MYLIB/MYFILE)
MBR(&OLDMBR)
</pre>
Those can be in a loop over a list of libraries/files. Or they can also be in an inner loop that checks &CRTDATE, removing members until the cut-off date is passed. Each time you remove the *FIRST member, the next oldest becomes the new *FIRST.

Can you clarify more what you actually want to do?

Tom

Discuss This Question:  

 
There was an error processing your information. Please try again later.
Thanks. We'll let you know when a new response is added.
Send me notifications when members answer or reply to this question.

REGISTER or login:

Forgot Password?
By submitting you agree to receive email from TechTarget and its partners. If you reside outside of the United States, you consent to having your personal data transferred to and processed in the United States. Privacy

Forgot Password

No problem! Submit your e-mail address below. We'll send you an e-mail containing your password.

Your password has been sent to:

To follow this tag...

There was an error processing your information. Please try again later.

REGISTER or login:

Forgot Password?
By submitting you agree to receive email from TechTarget and its partners. If you reside outside of the United States, you consent to having your personal data transferred to and processed in the United States. Privacy

Thanks! We'll email you when relevant content is added and updated.

Following