Display SAVF PTF status

This program displays SAVF and their respective PTF status; function to delete SAVF that have been applied/superseded.

This Content Component encountered an error

This program displays SAVF and their respective PTF status; function to delete SAVF that have been applied/superseded.

Code for dspf:

 

     A*%%TS  SD  20050907  120621  RICHQSEC    REL-V5R3M0  5722-WDS
     A*%%EC
     A                                      DSPSIZ(24 80 *DS3)
     A                                      PRINT
     A*----------------------------------------------------------------
     A          R SCNSFL                    SFL
     A*%%TS  SD  20050810  130856  RICHQSEC    REL-V5R3M0  5722-WDS
     A  95                                  SFLNXTCHG
     A            @NAME         10A  O  6  3
     A            @TXT          26A  O  6 15
     A            @STS          36A  O  6 43
     A            LOADSTATUS     1A  H
     A            PRODUCTID      7A  H
     A            FILEPTF        7A  H
     A*----------------------------------------------------------------
     A          R SCNCTL                    SFLCTL(SCNSFL)
     A*%%TS  SD  20050810  130856  RICHQSEC    REL-V5R3M0  5722-WDS
     A                                      SFLSIZ(0200)
     A                                      SFLPAG(0015)
     A                                      CF03(03 'EXIT')
     A                                      CF05(05 'REFRESH')
     A                                      CF07(07 'SORT BY')
     A                                      CF12(12 'CANCEL')
     A                                      OVERLAY
     A                                      SFLCSRRRN(&CURRRN)
     A  90                                  SFLDSP
     A  91                                  SFLDSPCTL
     A  92                                  SFLDLT
     A  93                                  SFLCLR
     A  94                                  SFLEND(*MORE)
     A            CURRRN         5S 0H
     A                                  1  3DATE
     A                                      EDTCDE(Y)
     A                                  1 12TIME
     A                                  1 29'Display SAVF PTF Status'
     A                                      DSPATR(HI)
     A                                  1 62SYSNAME
     A                                  5  3'Save File '
     A                                      DSPATR(HI)
     A                                      DSPATR(UL)
     A                                  5 15'Description               '
     A                                      DSPATR(HI)
     A                                      DSPATR(UL)
     A                                  5 43'Status
-
     A                                        '
     A                                      DSPATR(HI)
     A                                      DSPATR(UL)
     A          R SCNFTR
     A*%%TS  SD  20050907  120621  RICHQSEC    REL-V5R3M0  5722-WDS
     A                                 23  3'F3=Exit'
     A                                      COLOR(BLU)
     A                                 23 15'F5=Refresh'
     A                                      COLOR(BLU)
     A                                 23 30'F7=Delete Applied/Superseded'
     A                                      COLOR(BLU)
     A                                 23 63'F12=Cancel'
     A                                      COLOR(BLU)

code for rpgle:

     h DEBUG  OPTION(*SRCSTMT:*NODEBUGIO) DFTACTGRP(*NO)

??*--------------------------------------------------------------------
    ??* Display SAVF PTF Status

??*--------------------------------------------------------------------

      *--------------------------------------------------------------------
      * CRTBNDRPG PGM(SYCUST/DSPSAVPTF) SRCFILE(SYCUST/QRPGLESRC)
      * DFTACTGRP(*NO) ACTGRP(ILE)
      *--------------------------------------------------------------------

    ?fdspsavptf cf   e             workstn
     f                                     sfile(scnsfl:sflrrn)

     d  CrtUsrSpc      PR              *
     d   CrtSpcName                  20    const

     d ListFormat      s              8
     d ObjNamLIb       s             20    inz('*ALL      QGPL     ')
     d ObjType         s             10    inz('*FILE     ')
     d SpacePtr        s               *
     d UserSpace       s             20    inz('DSPSAVPTF QTEMP')
     d sflrrn          s              5  0

     d EntryFmt        s             10
     d FormatType      s             10
     d OveRide         s              1
     d ReceivLen       s             10i 0
     d System          s             10
     d PTFinfo         s             50
     d  RecvrLen       s             10i 0 inz(%size(QPZR0100))

     d Command         s             80a   INZ
     d CommandLen      s             15p 5 INZ(80)

      *--------------------------------------------------------------------
      * Main output from QUSRTVFD API
      *--------------------------------------------------------------------
     d Receiver        DS                  based(ListPtr)
     d  NbrFormats            62     63b 0
     d  DBFileOffs           317    320b 0
     d  AcessType            337    338
     d  LFFileOffs           369    372b 0

      *--------------------------------------------------------------------
      * General Header Data structure as copied from QUSGEN in
      * source file QRPGLESRC in library QSYSINC
      *--------------------------------------------------------------------
     dQUSH0300         DS                  Based(GenDsPoint)
     d*                                             Qus Generic Header 0300
     d QUSUA00                 1     64
     d*                                             User Area
     d QUSSGH00               65     68B 0
     d*                                             Size Generic Header
     d QUSSRL00               69     72
     d*                                             Structure Release Level
     d QUSFN00                73     80
     d*                                             Format Name
     d QUSAU00                81     90
     d*                                             Api Used
     d QUSDTC00               91    103
     d*                                             Date Time Created
     d QUSIS00               104    104
     d*                                             Information Status
     d QUSSUS00              105    108B 0
     d*                                             Size User Space
     d QUSOIP00              109    112B 0
     d*                                             Offset Input Parameter
     d QUSSIP00              113    116B 0
     d*                                             Size Input Parameter
     d QUSOHS00              117    120B 0
     d*                                             Offset Header Section
     d QUSSHS00              121    124B 0
     d*                                             Size Header Section
     d QUSOLD00              125    128B 0
     d*                                             Offset List Data
     d QUSSLD00              129    132B 0
     d*                                             Size List Data
     d QUSNBRLE00            133    136B 0
     d*                                             Number List Entries
     d QUSSEE00              137    140B 0
     d*                                             Size Each Entry
     d QUSSIDLE00            141    144B 0
     d*                                             CCSID List Ent
     d QUSCID00              145    146
     d*                                             Country ID
     d QUSLID00              147    149
     d*                                             Language ID
     d QUSSLI00              150    150
     d*                                             Subset List Indicator
     d QUSRSV1               151    192
     d*                                             Reserved 1
     d QUSEPN                193    448
     d*                                             Entry Point Name
     d QUSRSV2               449    576
     d*                                             Reserved 2

      *--------------------------------------------------------------------
      * Format QUSL010003 List Objects. Copied from
      * member QUSLOBJ, source file QRPGLESRC, in library QSYSINC
      *--------------------------------------------------------------------
     dQUSL010003       DS                  Based(ListPoint)
     d*                                             Qus OBJL0200
     d QUSOBJNU                1     10
     d*                                             Object Name Used
     d QUSOLNU                11     20
     d*                                             Object Lib Name Used
     d QUSOBJTU               21     30
     d*                                             Object Type Used
     d FileLib                 1     20
     d*                                             Object Name Lib Used
     d FilePrefix              1      3
     d*                                             Object Name Prefix
     d FilePTF                 2      8
     d*                                             Object Name PTF
     d FileAttr               32     41
     d*                                             Object Name Attr
     d FileDesc               42     70
     d*                                             Object Name Desc

      *--------------------------------------------------------------------
      * PTF Informaton
      *--------------------------------------------------------------------
     DQPZR0100         DS
     D ProductID              13     19
     D LoadStatus             41     41

      *--------------------------------------------------------------------
      * Standard Error Code data structure
      *--------------------------------------------------------------------
     dQusEc            DS           116
     d QUSBPRV                 1      4B 0          inz(116)
     d QUSBAVL                 5      8B 0

      *--------------------------------------------------------------------
      * Receiver structure to determine correct size for variable
      *--------------------------------------------------------------------
     d Receiver1       DS
     d  BytesRtn1                    10i 0
     d  BytesAvl1                    10i 0

      *--------------------------------------------------------------------
      *  Build Subfile
      *--------------------------------------------------------------------
     c                   exsr      BldSfl

      *--------------------------------------------------------------------
      *  Display Workstation Screen
      *--------------------------------------------------------------------
     c                   dow       *inkl = *off
     c                             and *inkc = *off

     c                   write     scnftr
     c                   exfmt     scnctl

      * Check for Refresh
     c                   if        *inke = *on
     c                   exsr      BldSfl
     c                   iter
     c                   endif

      * Check for Delete
     c                   if        *inkg = *on
     c                   exsr      DltSavf
     c                   exsr      BldSfl
     c                   iter
     c                   endif

     c                   enddo

      *--------------------------------------------------------------------
      *  End Program
      *--------------------------------------------------------------------
     c                   eval      *inlr = *on

      *--------------------------------------------------------------------
      *  Build Subfile
      *--------------------------------------------------------------------
     c     BldSfl        begsr

      *  Clear Subfile
     c                   eval      *in93 = *on
     c                   write     scnctl
     c                   eval      *in93 = *off
     c                   eval      *in95 = *on
     c                   eval      sflrrn = 0

      *--------------------------------------------------------------------
      *  Create user space for Object List information
      *--------------------------------------------------------------------
     c                   Eval      SpacePtr = CrtUsrSpc(UserSpace)

      *--------------------------------------------------------------------
      *  List Objects to user space
      *--------------------------------------------------------------------
     c                   Call      'QUSLOBJ'
     c                   Parm                    UserSpace
     c                   Parm      'OBJL0200'    ListFormat
     c                   Parm                    ObjNamLib
     c                   Parm                    ObjType
     c                   Parm                    QusEc

      *--------------------------------------------------------------------
      *  Load the general data structure
      *--------------------------------------------------------------------
     c                   Eval      GenDsPoint = SpacePtr

      *  If the list API was complete or partially complete
     c                   if        QuSIS00 = 'C' OR
     c                             QuSIS00 = 'P'

      *  Load the list data structure
     c                   Eval      ListPoint = GenDsPoint + QusOLD00

b01  c                   Do        QusNbrLE00

      *--------------------------------------------------------------------
      *  Retrieve File Description
      *--------------------------------------------------------------------
     c                   Call      'QDBRTVFD'
     c                   Parm                    Receiver
     c                   Parm      16776704      ReceivLen
     c                   Parm                    FileLib
     c                   Parm      'FILD0100'    ListFormat
     c                   Parm                    FileLib
     c                   Parm                    EntryFmt
     c                   Parm      '0'           OveRide
     c                   Parm      '*LCL'        System
     c                   Parm      '*EXT'        FormatType
     c                   Parm                    QusEc

      *--------------------------------------------------------------------
      *  Write Subfile Record
      *--------------------------------------------------------------------
     c                   if        FileAttr = 'SAVF'
     c                   if        FilePrefix = 'QMF'
     c                             or FilePrefix = 'QSI'
     c                   eval      @Name = FileLib
     c                   eval      @Txt  = FileDesc

      *--------------------------------------------------------------------
      *  Get PTF Information
      *--------------------------------------------------------------------
     c                   eval      PTFinfo = FilePTF + '*ONLY'
     c                   Call      'QPZRTVFX'
     c                   Parm                    QPZR0100
     c                   parm                    RecvrLen
     c                   Parm                    PTFinfo
     c                   Parm      'PTFR0100'    ListFormat
     c                   Parm                    QusEc

     c                   select
     c     LoadStatus    wheneq    '0'
     c                   eval      @Sts = 'The PTF has never been loaded.'
     c     LoadStatus    wheneq    '1'
     c                   eval      @Sts = 'The PTF has been loaded.'
     c     LoadStatus    wheneq    '2'
     c                   eval      @Sts = 'The PTF has been applied.'
     c     LoadStatus    wheneq    '3'
     c                   eval      @Sts = 'The PTF has been applied +
     c                                      permanently.'
     c     LoadStatus    wheneq    '4'
     c                   eval      @Sts = 'The PTF has been permanently +
     c                                      removed.'
     c     LoadStatus    wheneq    '5'
     c                   eval      @Sts = 'The PTF is damaged.'
     c     LoadStatus    wheneq    '6'
     c                   eval      @Sts = 'The PTF is superseded.'
     c                   other
     c                   eval      LoadStatus = ' '
     c                   eval      @Sts = 'Unkown Status'
     c                   endsl

     c                   add       1             sflrrn
     c                   write     scnsfl
     c                   endif
     c                   endif

     c                   Eval      ListPoint = ListPoint + QusSEE00

e01  c                   EndDo
     c                   Endif

      *--------------------------------------------------------------------
      *  Set Up Subfile Control
      *--------------------------------------------------------------------
     c                   if        sflrrn = 0
     c                   eval      *in91 = *on
     c                   else
     c                   eval      *in94 = *on
     c                   eval      *in90 = *on
     c                   eval      *in91 = *on
     c                   endif

     c                   endsr
      *--------------------------------------------------------------------
     c     DltSavf       begsr
      *--------------------------------------------------------------------
     c                   if        sflrrn > 0
     c                   eval      *in95 = *on
     c                   readc     scnsfl                                 21
     c                   dow       *in21 = *off

      * Only delete if Applied, Applied Perm, or superseded
     c                   if        LoadStatus = '2'
     c                             or LoadStatus = '3'
     c                             or LoadStatus = '6'

     c                   eval      Command = 'DLTPTF PTF('         +
     c                                        %trimr(FilePTF)      +
     c                                        ') LICPGM('          +
     c                                        %trimr(ProductId) + ')'
     c                   call      'QCMDEXC'
     c                   parm                    Command
     c                   parm                    CommandLen

     c                   endif

     c                   readc     scnsfl                                 21
     c                   enddo

     c                   endif

     c                   endsr
      *====================================================================
      *  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                    QusEc

      * 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                    QusEc

     c                   return    ListPtr

     p  CrtUsrSpc      E


               
       

This was first published in September 2005

Dig deeper on iSeries system performance and monitoring

0 comments

Oldest 

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:

-ADS BY GOOGLE

SearchEnterpriseLinux

SearchDataCenter

Close