Tip

Display SAVF PTF status

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

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.