Tip

Delete members based on numbers of days old

Don't waste your time searching, call this utility program to remove file members based on numbers of days old.

 
     h DEBUG OPTION(*SRCSTMT:*NODEBUGIO) DATFMT(*ISO)
     h DFTACTGRP(*NO) ACTGRP('ILE')

    ‚‚*--------------------------------------------------------------------
    ‚‚* Utility to Remove Members based on Numbers Days Old
    ‚‚*--------------------------------------------------------------------

      *--------------------------------------------------------------------
      * EX: CALL PGM(MBRDLT) PARM('EDILOGF' '*LIBL' '0014' ' ')
      *--------------------------------------------------------------------
      * THIS WILL DELETE ALL MEMBERS FROM THE FILE EDILOGF THAT ARE
      * 14 DAYS AND OLDER. (THIS UTILITY DOES NOT DELETE THE MEMBER NAME
      * NOTE: THIS UTILITY DOES NOT DELETE THE MEMBER NAME SAME AS FILE
      *--------------------------------------------------------------------

     d/COPY QSYSINC/QRPGLESRC,QUSRUSAT
     d/COPY QSYSINC/QRPGLESRC,QUSGEN
     d/COPY QSYSINC/QRPGLESRC,QUSLMBR
     d/COPY QSYSINC/QRPGLESRC,QUSRMBRD

     d  CrtUsrSpc      PR              *
     d   CrtSpcName                  20    const

     d SpacePtr        s               *
     d UserSpace       s             20    inz('MBRLST    QTEMP')

     d FormatList      s              8A   Inz('MBRL0200')
     d FormatMbr       s              8A   Inz('MBRD0200')
     d AllMbrs         s             10A   Inz('*ALL      ')
     d OvrDbf          s              1A   Inz('1')
     d Member          s             10

     d GenLen          s              9B 0
     d StrPos          s              9B 0
     d RtvLen          s              9B 0
     d RcvLen          s              9B 0
     d Count           s             15  0

     d Command         s             80a   INZ
     d CommandLen      s             15p 5 INZ(80)
     d SQuote          c                   ''''
     d ObjNamLib       ds
     d   ObjNam                      10    OVERLAY(ObjNamLib)
     d   ObjLib                      10    OVERLAY(ObjNamLib:11)

     d Days            ds
     d NDays                          4  0 OVERLAY(Days)
     d ADays                          4    OVERLAY(Days)

      *--------------------------------------------------------------------
      * Standard Error Code data structure
      *--------------------------------------------------------------------
     dError            ds           116
     d QUSBPRV                 1      4B 0          inz(116)
     d QUSBAVL                 5      8B 0
     d MessageId               9     15
     d MessageDta             17    116

      *--------------------------------------------------------------------
      * Member Date data structure   - Alpha 13
      *--------------------------------------------------------------------
     dQusDte           ds
     d QusCC                   1      1
     d QusYMD                  2      7
     d QusTim                  8     13

      *--------------------------------------------------------------------
      * Member Date data structure   - Alpha 8
      *--------------------------------------------------------------------
     d MbrDtCrt        ds
     d   MbrCY                        4    OVERLAY(MbrDtCrt)
     d   MbrMM                        2    OVERLAY(MbrDtCrt:5)
     d   MbrDD                        2    OVERLAY(MbrDtCrt:7)

      *----------------------------------------------------------------
      * DATE DATA STRUCTURE  (*ISO 'ccyy-mm-dd')
      *----------------------------------------------------------------
     d                 ds                  INZ
     d  NewDat                         D   DATFMT(*ISO) INZ
     d   NewCY                        4    OVERLAY(NewDat)
     d   NewMM                        2    OVERLAY(NewDat:6)
     d   NewDD                        2    OVERLAY(NewDat:9)

      *----------------------------------------------------------------
      * ISO DATES            (*ISO 'ccyy-mm-dd')
      *----------------------------------------------------------------
     d Today           s               D   Inz(*SYS)
     d CompDat         s               D   Inz(*SYS)

      *--------------------------------------------------------------------
      *  Receive Parms for Object Name, Library, Days, MsgId
      *--------------------------------------------------------------------
     c     *Like         Define    ObjNam        pmObjNam
     c     *Like         Define    ObjLib        pmObjLib
     c     *Like         Define    ADays         pmDays
     c     *Like         Define    MessageId     pmMsgId

     c     *entry        plist
     c                   parm                    pmObjNam
     c                   parm                    pmObjLib
     c                   parm                    pmDays
     c                   parm                    pmMsgId

     c                   Eval      ObjNam = pmObjNam
     c                   Eval      ObjLib = pmObjLib
     c                   Eval      ADays  = pmDays

      *--------------------------------------------------------------------
      *  Calculate new Comparison Date based on Number Days Old
      *--------------------------------------------------------------------
     c     Today         subdur    NDays:*DAYS   CompDat

      *--------------------------------------------------------------------
      *  Create User Space for Member List Information
      *--------------------------------------------------------------------
     c                   Eval      SpacePtr = CrtUsrSpc(UserSpace)

      *--------------------------------------------------------------------
      *  Create Member List in User Space
      *--------------------------------------------------------------------
     c                   Call      'QUSLMBR'
     c                   Parm                    UserSpace
     c                   Parm                    FormatList
     c                   Parm                    ObjNamLib
     c                   Parm                    AllMbrs
     c                   Parm                    OvrDbf
     c                   Parm                    Error

      *--------------------------------------------------------------------
      * Continue if no Errors
      *--------------------------------------------------------------------
     c                   Eval      pmMsgId = MessageId
     c                   if        MessageId = *blanks

      *--------------------------------------------------------------------
      * Set Values for Generic Header
      *--------------------------------------------------------------------
     c                   Eval      GenLen = 140
     c                   Eval      StrPos = 1

      *--------------------------------------------------------------------
      * Retreive Number of Entries, Offset, and the size of each entry
      *--------------------------------------------------------------------
     c                   Call      'QUSRTVUS'
     c                   Parm                    UserSpace
     c                   Parm                    StrPos
     c                   Parm                    GenLen
     c                   Parm                    QUSH0100
     c                   Parm                    Error

      *--------------------------------------------------------------------
      * Check the Generic Header data structure for number of list entry
      * offset to list entries, and size of each list entry
      *--------------------------------------------------------------------
     c                   Eval      StrPos = ( QUSOLD + 1 )
     c                   Eval      RtvLen = QUSSEE
     c                   Eval      RcvLen = 209
     c                   Eval      Count = 1

      *--------------------------------------------------------------------
      *  Process Members
      *--------------------------------------------------------------------
     c                   DoW       Count <= QUSNBRLE

     c                   Call      'QUSRTVUS'
     c                   Parm                    UserSpace
     c                   Parm                    StrPos
     c                   Parm                    RtvLen
     c                   Parm                    QUSL0200
     c                   Parm                    Error

     c                   Eval      StrPos = QUSSEE + StrPos
     c                   Eval      Count = Count + 1

     c                   movel(p)  QUSMN01       Member

      *--------------------------------------------------------------------
      *  Get Member Information
      *--------------------------------------------------------------------
     c                   Call      'QUSRMBRD'
     c                   Parm                    QusM0200
     c                   Parm                    GenLen
     c                   Parm                    FormatMbr
     c                   Parm                    ObjNamLib
     c                   Parm                    Member
     c                   Parm                    OvrDbf
     c                   Parm                    Error

      *--------------------------------------------------------------------
      *  Remove Member if not same as File Name and Member Create Date
      *  is Less/Equal to new comparison Date
      *--------------------------------------------------------------------
     c                   if        Member <> ObjNam

     c                   eval      QusDte = QusCD03

     c                   if        QusCC = '1'
     c                   eval      MbrDtCrt = '20' + QusYMD
     c                   else
     c                   eval      MbrDtCrt = '19' + QusYMD
     c                   endif

     c                   eval      NewCY = MbrCY
     c                   eval      NewMM = MbrMM
     c                   eval      NewDD = MbrDD

     c                   if        NewDat <= CompDat

     c                   eval      Command = 'RMVM FILE('          +
     c                                        %trimr(ObjLib)       +
     c                                        '/' + %trimr(ObjNam) +
     c                                        ') MBR('             +
     c                                        %trimr(Member) + ')'
     c                   call      'QCMDEXC'
     c                   parm                    Command
     c                   parm                    CommandLen

     c                   endif

     c                   endif

e01  c                   EndDo

      *--------------------------------------------------------------------
      *  End Program
      *--------------------------------------------------------------------
     c                   endif

     c                   eval      *inlr = *on

      *====================================================================
      *  Procedure to create extendable user space, return pointer to it.
      *====================================================================
     p  CrtUsrSpc      B                   export
     d  CrtUsrSpc      PI              *
     d   CrtSpcName                  20    const

      * Local Variables
     d PasSpcName      DS            20
     d  SLib                  11     20
     d ChgAttrDs       DS            13
     d  NumberAttr                    9B 0 inz(1)
     d  KeyAttr                       9B 0 inz(3)
     d  DataSize                      9B 0 inz(1)
     d  AttrData                      1    inz('1')
     d ListPtr         S               *
     d SpaceAttr       S             10    inz
     d SpaceAuth       S             10    INZ('*CHANGE')
     d SpaceLen        S              9B 0 INZ(2048)
     d SpaceReplc      S             10    INZ('*YES')
     d SpaceText       S             50
     d SpaceValue      S              1

      * Create the user space
     c                   move      CrtSpcName    PasSpcName
     c                   CALL      'QUSCRTUS'
     c                   PARM                    PasSpcName
     c                   PARM                    SpaceAttr
     c                   PARM                    SpaceLen
     c                   PARM                    SpaceValue
     c                   PARM                    SpaceAuth
     c                   PARM                    SpaceText
     c                   PARM      '*YES'        SpaceReplc
     c                   PARM                    Error

      * Get pointer to user space
     c                   CALL      'QUSPTRUS'
     c                   PARM                    PasSpcName
     c                   PARM                    ListPtr

      * Change user space to be extendable
     c                   CALL      'QUSCUSAT'
     c                   PARM                    Slib
     c                   PARM                    PasSpcName
     c                   PARM                    ChgAttrDs
     c                   PARM                    Error

     c                   return    ListPtr

     p  CrtUsrSpc      E
  
  


This was first published in April 2005

There are Comments. Add yours.

 
TIP: Want to include a code block in your comment? Use <pre> or <code> tags around the desired text. Ex: <code>insert code</code>

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
Sort by: OldestNewest

Forgot Password?

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

Your password has been sent to:

Disclaimer: Our Tips Exchange is a forum for you to share technical advice and expertise with your peers and to learn from other enterprise IT professionals. TechTarget provides the infrastructure to facilitate this sharing of information. However, we cannot guarantee the accuracy or validity of the material submitted. You agree that your use of the Ask The Expert services and your reliance on any questions, answers, information or other materials received through this Web site is at your own risk.