If it helps, this thing updates a PDS directory using STOW. It will need
some tweaking to update the USERDATA (check the PDS directory map).
Cheers, CP
MEMBER NAME ALIAS
*
* THIS PROGRAM ALIASES ENTRIES IN A PARTITIONED DATASET.
* MEMBERS MAY HAVE FIXED OR VARIABLE LOGICAL RECORD LENGTH (FB OR VB).
* MEMBER NAME AND ALIAS MUST BE SUPPLIED VIA SYSIN CARD.
*
*
* FORMAT OF SYSIN CARD IS
* 'MEMBER=@@...@,ALIAS=@@...@ '
* WHERE '@@...@' REPRESENTS A 1 TO 8 CHAR VALID MEMBER/ALIAS NAME
* AND WHERE ANYTHING (INCLUDING COMMENTS) (EXCEPT MEMBER= // /*) MAY
* PRECEDE THE 'MEMBER=' START OF CARD DATA
* AND WHERE THE END OF CARD DATA (AFTER ALIAS NAME) MUST BE A BLANK.
* NOTE THAT THE COMMA, AFTER THE MEMBER NAME, IS MANDATORY,
* EACH SEPARATE ALIAS REQUEST MUST BE ON A SEPARATE CARD
* AND THE CARDS ARE FIXED RECL=80 WITH DATA IN COLS 1 TO 72 INCLUSIVE,
* DECLARED VIA DDNAME SYSIN.
*
* MEMBER NAMES MUST BE IN ASCENDING ALPHABETICAL ORDER.
*
* INVALID SYSIN CARDS ARE IGNORED.
*
* ALIASES SUCCESSFULLY ADDED ARE LISTED UNDER DDNAME=REPORTS OUTPUT.
*
* CREATED: CHRIS PONCELET 12/10/88
*
***********************************************************************
*
PRINT NOGEN
ALIASPDS CSECT START CONTROL SECTION
*
* PASSING THE 'NEXT' LABEL AS A PARAMETER TO THE 'READREC' MACRO
*
R0 EQU 0 REDEFINE REGISTERS
R1 EQU 1
R2 EQU 2
R3 EQU 3
R4 EQU 4
R5 EQU 5
R6 EQU 6
R7 EQU 7
R8 EQU 8
R9 EQU 9
R10 EQU 10
R11 EQU 11
R12 EQU 12
R13 EQU 13
R14 EQU 14
R15 EQU 15
*
***********************************************************************
********************** MACROS *****************************************
*
MACRO
&L READREC &FILE
&L GET &FILE READREC MACRO
MVC INPUT(80),0(R1) MOVE FROM BUFFER TO INPUT AREA
MEND
*
MACRO
&L WRITEREC
&L PUT REPORTS,OUTPUT WRITEREC MACRO
MEND
*
*********************** END OF MACROS *********************************
***********************************************************************
*
**********************************************************************
******* INITIAL PROCESSING *******************************************
**********************************************************************
*
* NOTE: SAVE ALL REGISTERS ON ENTRY, AT 18 FULLWORDS STARTING AT
* ADDRESS GIVEN IN R13 - USING STORE MULTIPLE.
* THEN USE R14 (SAVED, THAT IS) TO RETURN CONTROL AFTER EXECUTION
* OF THIS PROGRAM (AFTER RELOADING USING LOAD MULTIPLE.)
*
BEGIN STM R14,R12,12(R13) SAVE REGISTERS 14->12 TO OFFSET 12
BALR R11,R0 LOAD CURRENT LOCATION INTO R11
USING *,R11,R3 DEFINE R11 + R3 AS BASE REGISTERS
NAMEOFT EQU NAME-*
TTROFT EQU TTR-*
ALIASOFT EQU ALIAS-*
KOFT EQU K-*
COFT EQU C-*
INPUTOFT EQU INPUT-*
LA R3,*-4+4096
ST R13,SAVER13 FREE REGISTER 13 BY SAVING
LA R13,SAVEBLK LOAD MY SAVEAREA'S ADDRESS INTO R13
*
***********************************************************************
******** START OF PROGRAM CODE PROPER *********************************
***********************************************************************
*
OPEN (SYSIN,(INPUT))
L R4,=F'64' FOR COUNTING ¬> 64 CARDS
LR R9,R11 FOR INDEXING MEMBER NAMES + BASE
LA R9,0(,R9) CLEAR TOP 8 BITS
S R9,=F'14'
LR R10,R11 FOR INDEXING ALIAS NAMES + BASE
LA R10,0(,R10) CLEAR TOP 8 BITS
S R10,=F'8'
*
* DO UNTIL THERE ARE NO MORE SYSIN RECORDS
*
NEXT READREC SYSIN
LR R5,R11 USE R5 AS PSEUDO BASE REG
LA R5,0(,R5) CLEAR TOP 8 BITS
SR R6,R6 USE R6 AS INDEX INCREMENT
LA R6,1(,R6)
LR R7,R11 USE R7 AS INDEX UPPER LIMIT
*
* 'MEMBER=' = 7
* ',' = 1
* 'ALIAS=' = 6
* <MEMBERNAME> = 1 MIN
* <ALIASNAME> = 1 MIN
* OFFSET = POSITION - 1
* 72-7-1-6-1-1-1=55
*
LA R7,55(,R7) SYSIN CARD UP TO COL 72 MAX.
*
* FIND 'MEMBER=' STRING IN CURRENT SYSIN CARD.
*
FINDM CLI INPUTOFT(R5),C'M' LOOK FOR CHAR 'M' AT CURRENT POS.
BE CHK1A
BXLE R5,R6,FINDM IF NOT FOUND TRY NEXT POSITION UP
B NOTFND
CHK1A CLC INPUTOFT(7,R5),=C'MEMBER=' IS IT 'MEMBER='?
BE OK1
BXLE R5,R6,FINDM NO: START AGAIN FROM NEXT POS. UP
B NOTFND
OK1 LA R5,7(,R5) YES: SHIFT UP TO READ NAME
ST R5,STRTMEM SAVE START POSITION OF NAME
LR R8,R5 AND IN REG8 FOR EX R12,MOVEMEM
FINDC CLI INPUTOFT(R5),C',' LOOK FOR COMMA
BE CHK1B
BXLE R5,R6,FINDC NOT FOUND? SHIFT UP & TRY AGAIN
B NOTFND
CHK1B ST R5,ENDMEM FOUND: NOW CHECK MEMBER NAME
LR R12,R5
S R12,STRTMEM ENDMEM - STRTMEM = MEMNAME LENGTH
BE NOTFND 0 LENGTH NOT ALLOWED
C R12,=F'9'
BNL NOTFND LENGTH > 8 NOT ALLOWED
STH R12,LENMEM MEMNAME LENGTH IS OK: SAVE IT
MVC MEMNAME(8),BLANKS
BCTR R12,0
EX R12,MOVEMEM STORE MEMBER NAME FROM SYSIN CARD
LA R5,1(,R5) POINT TO CHAR AFTER COMMA
FINDA CLC INPUTOFT(6,R5),=C'ALIAS=' IS THIS 'ALIAS='?
BE OK2
B NOTFND
OK2 LA R5,6(,R5) YES: POINT TO ALIAS NAME
ST R5,STRTALS SAVE START OF ALIAS NAME OFFSET
LR R8,R5 AND IN REG8 FOR EX R12,MOVEALS
FINDB CLI INPUTOFT(R5),C' ' LOOK FOR BLANK CHAR AFTER ALIAS=
BE CHK2
BXLE R5,R6,FINDB NOT FOUND? SHIFT UP & TRY AGAIN
B NOTFND
CHK2 ST R5,ENDALS FOUND: NOW CHECK ALIASNAME LENGTH
LR R12,R5
S R12,STRTALS ENDALS - STRTALS = ALSNAME LENGTH
BE NOTFND 0 LENGTH NOT ALLOWED
C R12,=F'9'
BNL NOTFND LENGTH > 8 NOT ALLOWED
STH R12,LENALS OK: SAVE ALIAS NAME LENGTH
MVC ALSNAME(8),BLANKS
BCTR R12,0
EX R12,MOVEALS STORE ALIAS NAME FROM SYSIN CARD
*
LA R9,14(,R9) UPDATE OFFSET
MVC NAMEOFT(8,R9),MEMNAME
LA R10,8(,R10) UPDATE OFFSET
MVC ALIASOFT(8,R10),ALSNAME
DONEXT BCT R4,NEXT ALL OK: READ NEXT CARD
NOTFND B NEXT ¬OK: SCRAP THIS CARD: READ NEXT CARD
*
EOJ1 CLOSE (SYSIN,)
*
* UPDATE COUNT OF MEMBERS TO BE FETCHED, FOR BLDL MACRO
*
S R4,=F'64' HOW MANY VALID SYSN CARDS WERE READ?
LPR R4,R4
BE FINISH
STH R4,FF -> NO OF MEMBER ENTRIES FOR BLDL
*
* PREPARE TO READ PDS DIRECTORY
*
OPEN (PDS,(INPUT))
*
START NOP *
BLDL PDS,LISTMEM
CLOSE (PDS,)
*
* BLDL SHOULD NOW HAVE PULLED OUT THE TTR & OTHER INFO FOR EACH MEMBER.
* NOW ADD THE ALIASES.
*
* PREPARE TO ADD ALIASES TO PDS (PDSUPDAT) DIRECTORY
*
OPEN (PDSUPDAT,(OUTPUT),REPORTS,(OUTPUT))
SR R5,R5 USE R5 AS COUNTER
LA R5,1(,R5)
SR R6,R6 USE R6 AS INCREMENT TO R7
LA R6,1(,R6)
LR R7,R4 USE R7 AS BXLE UPPER LIMIT
LR R9,R11 FOR INDEXING MEMBER NAMES + BASE
LA R9,0(,R9) CLEAR TOP 8 BITS
S R9,=F'14'
LR R10,R11 FOR INDEXING ALIAS NAMES + BASE
LA R10,0(,R10) CLEAR TOP 8 BITS
S R10,=F'8'
*
* ADD ALIAS ENTRIES FROM ACCEPTED SYSIN CARDS
*
ADDALIAS NOP * DO UNTIL ALL ALIASES HAVE BEEN ADDED
LA R9,14(,R9) UPDATE INDEX
LA R10,8(,R10) UPDATE INDEX
CLI TTROFT+2(R9),X'00' WAS THE MEMBER FOUND?
BE SKIP NO: SKIP TO PROCESS NEXT ALIAS
MVC MEMNAMOK(8),NAMEOFT(R9) YES: SET UP REPORT LINE
MVC ALSNAMOK(8),ALIASOFT(R10)
MVC NAMEOFT(8,R9),ALIASOFT(R10) SET UP FIELDS FOR STOW MACRO
OI COFT(R9),B'10000000' FLAG AS ALIAS
NI COFT(R9),B'11100000' NO USERDATA BECAUSE ONLY 12 BYTES
MVC KOFT(1,R9),COFT(R9) UPDATE STOW 'C' FIELD
STOW PDSUPDAT,NAMEOFT(,R9),A
LTR R15,R15 ALIAS ADDED OK?
BNE SKIP NO: SKIP TO PROCESS NEXT ALIAS
WRITEREC YES: OUTPUT LINE OF REPORT
SKIP BXLE R5,R6,ADDALIAS PROCESS NEXT ALIAS
*
EOJ CLOSE (PDSUPDAT,,REPORTS)
*
FINISH L R13,SAVER13 RESTORE R13 FROM SAVE ADDRESS AREA
LM R14,R12,12(R13) RESTORE REGISTERS
SR R15,R15 CLEAR RETURN CODE
BR R14 RETURN CONTROL TO OPERATING SYSTEM
*
**********************************************************************
******** END OF PROGRAM CODE PROPER **********************************
**********************************************************************
*
**********************************************************************
******** FILES *******************************************************
**********************************************************************
*
* DEFINE PDS (BPAM)
* N.B. SEE 'DATA ADMINISTRATION : MACRO REF' FOR DETAILS
*
SYSIN DCB BLKSIZE=80, *
DDNAME=SYSIN, *
DSORG=PS, *
EODAD=EOJ1, ADDRESS FOR BRANCHING, AT EOF *
RECFM=FB, *
MACRF=(GL) USING 'GET' AND 'LOCATE' MODE
*
REPORTS DCB BLKSIZE=132, *
DDNAME=REPORTS, *
DSORG=PS, *
MACRF=(PM) USING 'PUT' AND 'MOVE TRANSMITTAL'
*
PDS DCB BLKSIZE=256, *
DDNAME=PDS, *
DSORG=PO, *
EODAD=EOJ, ADDRESS FOR BRANCHING, AT EOF *
RECFM=VB, DIRECTORY ENTRIES ARE VARIABLE *
MACRF=(R) READ
*
PDSUPDAT DCB DDNAME=PDS, *
DSORG=PO, *
EODAD=EOJ, ADDRESS FOR BRANCHING, AT EOF *
MACRF=(R,W) READ + WRITE
*
**********************************************************************
******** DEFINE STORAGE **********************************************
**********************************************************************
*
* INPUT RECORDS
*
INPUT DS CL80
*
LISTMEM DS 0D
FF DC H'64' UP TO 64 SYSIN CARDS MAX
LL DC H'14' 14 BYTES PER FOLLOWING ENTRY
NAME DS CL8
TTR DS CL3
K DS CL1
Z DS CL1
C DS CL1
DS CL882
ALIAS DS CL8
DS CL504
OUTPUT DS 0C
DC CL5' '
ALSMSG DC C'ALIAS='
ALSNAMOK DS CL8
DC C' : '
REPMSG DC C'SUCCESSFULLY PROCESSED FOR MEMBER = '
MEMNAMOK DS CL8
DC CL(132+OUTPUT-*)' '
LENMEM DS H
STRTMEM DS F
ENDMEM DS F
LENALS DS H
STRTALS DS F
ENDALS DS F
MEMNAME DS CL8
ALSNAME DS CL8
*
**********************************************************************
******** DEFINE CONSTANTS FOR THIS PROGRAM ***************************
**********************************************************************
*
LTORG
*
BLANKS DC CL8' '
*
**********************************************************************
******** 'EXECUTE' INSTRUCTIONS **************************************
**********************************************************************
*
MOVEMEM MVC MEMNAME(0),INPUTOFT(R8)
MOVEALS MVC ALSNAME(0),INPUTOFT(R8)
*
**********************************************************************
******** DEFINE SAVE AREA FOR THIS PROGRAM ***************************
**********************************************************************
*
SAVEBLK DC 18F'0' 18 FULLWORDS INITIALISED TO 0
SAVER13 DC F'0' 1 FULLWORD FOR SAVING REG 13 CONTS
*
**********************************************************************
******** LOOK-UP TABLES **********************************************
**********************************************************************
*
SRCH1ST DS 0D
S0 DC XL16'000102030405060708090A0B0C0D0E0F'
S1 DC XL16'101112131415161718191A1B1C1D1E1F'
S2 DC XL16'202122232425262728292A2B2C2D2E2F'
S3 DC XL16'303132333435363738393A3B3C3D3E3F'
S4 DC XL16'404142434445464748494A4B4C4D4E4F'
S5 DC XL16'505152535455565758595A005C5D5E5F'
S6 DC XL16'606162636465666768696A6B6C6D6E6F'
S7 DC XL16'707172737475767778797A00007D7E7F'
S8 DC XL16'808182838485868788898A8B8C8D8E8F'
S9 DC XL16'909192939495969798999A9B9C9D9E9F'
SA DC XL16'A0A1A2A3A4A5A6A7A8A9AAABACADAEAF'
SB DC XL16'B0B1B2B3B4B5B6B7B8B9BABBBCBDBEBF'
SC DC XL16'C0000000000000000000CACBCCCDCECF'
SD DC XL16'D0000000000000000000DADBDCDDDEDF'
SE DC XL16'E0E10000000000000000EAEBECEDEEEF'
SF DC XL16'F0F1F2F3F4F5F6F7F8F9FAFBFCFDFEFF'
*
**********************************************************************
******** THAT'S IT ***************************************************
**********************************************************************
*
END BEGIN START EXECUTION FROM BEGIN ONWARDS
On 07/07/2017 18:31, Walt Farrell wrote:
> On Fri, 7 Jul 2017 16:56:09 +0200, R.S. <r.skoru...@bremultibank.com.pl>
> wrote:
>
>> W dniu 2017-07-07 o 15:29, Lizette Koehler pisze:
>>> As far as I know, the statistics have always worked that way. That as long
>>> as you had the ability to edit (change/alter/del/create) the PDS you could
>>> use 3.5 to change the ID field to anything you like.
>> ...except the dates.
>> Sometimes I want to change the date (just to prepare "installation
>> package", no cheating).
>> Is there any method to change the dates?
>> I mean set the date to something like 1999-09-09, not just reset.
> That may require a program of your own that uses STOW.
>
----------------------------------------------------------------------
For IBM-MAIN subscribe / signoff / archive access instructions,
send email to lists...@listserv.ua.edu with the message: INFO IBM-MAIN
