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