Don, here is a module which updates a PDS directory entries TTR but it can
be used as a model to change any field. I can't remember where the length
field is (probably it is in DIRFLAG in the sample) but I know it is in half
words. The program has a DSECT for the SPF statistics. You will need to
change the length and layout of the directory to match your needs.
Dave
UTL45 CSECT
00010000R0 EQU 0
00020000R1 EQU 1
00030000R2 EQU 2
00040000R3 EQU 3
00050000R4 EQU 4
00060000R5 EQU 5
00070000R6
EQU 6
00080000R7 EQU 7
00090000R8 EQU 8
00100000R9 EQU 9
00110000R10 EQU 10
00120000R11 EQU 11
00130000R12 EQU 12
00140000R13
EQU 13
00150000R14 EQU 14
00160000R15 EQU 15
00170000 SAVE (14,12)
00180000 USING UTL45,R15
00190000 B BGN
00200000 DC
AL1(L'PGMID) 00210000PGMID
DC C'UTL45 RECOVER DELETED MEMBER &SYSDATE &SYSTIME'
00220000 DC 0H'+0'
00230000BGN EQU *
00240000 DROP R15
00250000 USING UTL45,R12
00260000 LR R12,R15
00270000 LA
R14,SAVEAREA 00280000
ST R13,4(,R14)
00290000 ST R14,8(,R13)
00300000 LR R13,R14
00310000 EJECT
00320000 L R11,0(,R1)
00330000 USING PARM,R11
00340000 OPEN
(STOWDCB,(OUTPUT)) 00350000
TM STOWDCB+48,16
00360000 BZ ERR04
00370000 CLI PARMLEN+1,14
00380000 BNE ERR08
00390000 LA R1,PARMTTR
00400000 LA R2,6
00410000 SLR
R3,R3 00420000
LA R4,15
00430000 BALR R5,0
00440000 LA R6,9
00450000 CLI 0(R1),C'A'
00460000 BL ERR12
00470000 CLI 0(R1),C'F'
00480000 BNH
ITSOK 00490000
CLI 0(R1),C'0'
00500000 BL ERR12
00510000 CLI 0(R1),C'9'
00520000 BH ERR12
00530000 SLR R6,R6
00540000ITSOK EQU *
00550000 IC
R7,0(,R1) 00560000
NR R7,R4
00570000 ALR R7,R6
00580000 SLL R3,4
00590000 ALR R3,R7
00600000 LA R1,1(,R1)
00610000 BCTR R2,R5
00620000 EJECT
00630000
MVC DIRNAME,PARMMEM
00640000 BLDL STOWDCB,BLDLLIST
00650000 MVC DIRFLAG(DIREND-DIRFLAG),DIRFLAG+2
00660000 B *+4(R15)
00670000 SPACE 2
00680000 B STOWIT
00-SUCESSFUL 00690000 B
ERR16 04-MEMBER NOT FOUND 00700000
B ERR20 08-I/O ERROR
00710000STOWIT EQU *
00720000 ST R3,DWORD
00730000 MVC DIRTTR,DWORD+1
00740000 MVC
(DCBRELAD-IHADCB)+STOWDCB,DIRTTR 00750000
MVI DCBRELAD-IHADCB+STOWDCB+3,0
00760000 STOW STOWDCB,DIRNAME,R
00770000 B *+4(R15) PROCESS RETURN CODE
00780000 B STOWED 00-SUCESSFUL
00790000 EX 0,*
04-SHOULD NOT OCCUR 00800000 EX 0,*
08-SHOULD NOT OCCUR 00810000 EX
0,* 12-DIRECTORY FULL 00820000
B ERR20 16-I/O ERROR
00830000 B ERR24 20-DCB OPEN BAD
00840000 B ERR24 24-GETMAIN ERROR
00850000STOWED EQU *
00860000 CLOSE STOWDCB
00870000 SLR R15,R15
00880000 EJECT
00890000EXIT
EQU *
00900000 L R13,4(,R13)
00910000 RETURN (14,12),RC=(15)
00920000ERR24 EQU *
00930000 LA R15,24
00940000 B EXIT
00950000ERR20 EQU *
00960000
LA R15,20
00970000 B EXIT
00980000ERR16 EQU *
00990000 LA R15,16
01000000 B EXIT
01010000ERR12 EQU *
01020000 LA
R15,12 01030000
B EXIT
01040000ERR08 EQU *
01050000 LA R15,08
01060000 B EXIT
01070000ERR04 EQU *
01080000 LA R15,04
01090000 B
EXIT 01100000
EJECT
01110000STOWDCB DCB DSORG=PO,MACRF=(R,W),DDNAME=X
01120000SAVEAREA DC 18A(0)
01130000DWORD DC D'+0'
01140000 DS 0F
01150000BLDLLIST DC
AL2(1,DIREND-DIRNAME)
01160000MEMNAME DS 0CL8
01170000DIRNAME DC CL8' '
01180000DIRTTR DC XL3'0'
01190000DIRFLAG DC X'0'
01200000DIRUSER DC XL62'0'
01210000 ORG
DIRUSER 01220000*
THE FOLLOWING FIELDS APPLY TO LOAD MODULES
01230000DIRSTART DS XL4 TTR OF FIRST TEXT BLOCK
01240000DIRNOTE DS XL3 TTR OF NOTE LIST
01250000DIRNOTE# DS X
01260000DIRATTR DS XL2
01270000DIRCORE DS XL3
SIZE OF LOAD MODULE 01280000DIRTEXTL DS
XL2 LENGTH OF 1ST TEXT RECORD
01290000DIRENTRY DS XL3 ENTRY POINT ADDRESS
01300000DIRORIGN DS XL3
01310000 ORG *+1
01320000DIRSSI DS 0XL4 SSI
INFORMATION FOR LOAD LIB MEMBER 01330000 ORG *-1
01340000DIREP DS
XL3 ENTRY POINT (REAL MEMBER)
01350000DIRREAL DS CL8 REAL NAME OF MEMBER
01360000DIRRRAND EQU *
01370000 ORG DIRUSER
01380001DIRLV DS X SPF
VERSION 01390001DIRLM DS X
SPF LEVEL 01400001 DS
X FILLER
01410001DIRLCHGS DS X SPF CHANGED TIME SECONDS
01420001DIRLCRED DS PL4 SPF CREATE DATE
01430001DIRLCHGD DS PL4 SPF CHANGED
DATE 01440001DIRLCHGT DS XL2
SPF CHANGED TIME HOURS/MINUTES 01450001DIRLSIZE DS XL2
SPF CURRENT SIZE 01460001DIRLINIT DS
XL2 SPF INITIAL SIZE
01470001DIRLMOD DS XL2 SPF CHANGED LINES
01480001DIRLUID DS CL8 SPF LAST CHANGING USER
ID 01490001 DS CL2 FILLER
01500001 ORG
01510000DIREND EQU *
01520000 SPACE 3
01530000
LTORG
01540000 EJECT
01550000PARM DSECT
01560000PARMLEN DS H LENGTH OF PARM
FIELD 01570000PARMMEM DS CL8
MEMBER NAME TO WHICH TTR IS TO BE CHANGED 01580000PARMTTR DS CL6
TTR IN CHARACTER IE 010B02 01590000
SPACE 3
01600000 DCBD DSORG=PO
01610000 END
01620000
On Mon, Oct 28, 2013 at 2:14 PM, don isenstadt <[email protected]>wrote:
> hello,
>
> It has come down to this .. I have a product that is requiring me to
> "save" several hundred members in order to populate the pds directory entry
> with a 30 byte title .. so since the vendor can't provide me with a way to
> do it batch they suggested that I use the stow macro w/replace to "simply"
> update the directory entry .. I've looked all over the place ie.
> cbttape.org, ibm infocenter..
> but could not find any sample programs that do this type of manipulation
> .. any help or examples would be greatly appreciated.
>
> thanks,
> -don isenstadt
>
> ----------------------------------------------------------------------
> For IBM-MAIN subscribe / signoff / archive access instructions,
> send email to [email protected] with the message: INFO IBM-MAIN
>
----------------------------------------------------------------------
For IBM-MAIN subscribe / signoff / archive access instructions,
send email to [email protected] with the message: INFO IBM-MAIN
