*TITLEUGVTSO -- SEARCH CATALOG FOR TSO PREFIX 00010000 C*********************************************************************** C COPYRIGHT ATLANTIC RICHFIELD COMPANY 1991 * C*********************************************************************** *A AUTHOR D. W. DAVIS 00020000 *A DESIGNER R. MCMILLAN 00030000 *A LANGUAGE S/370 ASSEMBLER F 00040000 *A WRITTEN 4-10-75 00050000 * REVISED 7-24-85 RSK. 'CAPPED' FOR EXTENDED ADDRESSING USE. 00060000 * REVISED 12-09-92 REM. CHANGE LISTC FROM LVL TO ENT CHECK. 00070000 *A 00080000 *A CALL UGVTSO (CATN, ERR, ERIN) 00090000 *A 00100000 *A 00110000 *A IN/OUT ARGUMENT TYPE DESCRIPTION 00120000 *A 00130000 *A IN CATN 2I4 THE NAME PREFIX TO BE SEARCHED FOR. 00140000 *A 00150000 *A OUT ERR I4 ERROR CODE 00160000 *A 1 = OK 00170000 *A 2 <---4 ) DYNAMIC ALLOCATION FAILED. 00180000 *A 3 <---8 ) RETURN CODE FROM SVC 99. 00190000 *A 4 <--12 ) SEE IBM MANUAL BELOW, P. 27. 00200000 *A 5 = A MATCH WAS NOT FOUND. 00210000 *A 6 = ERROR ALLOCATING DD STATEMENTS FOR 00220000 *A IDCAMS. 00230000 *A 00240000 *A OUT ERIN I4 FOR ERROR CODE 2,3 OR 4: 00250000 *A CODES FROM DYNAMIC ALLOCATION (SVC 99). 00260000 *A BYTES 1 AND 2 = ERROR CODE, 00270000 *A BYTES 3 AND 4 = INFORMATION CODE. 00280000 *A IBM MANUAL GC28-0627-2, OS/VS2 MVS 00290000 *A SYSTEM PROGRAMMING LIBRARY: 00300000 *A JOB MANAGEMENT, PAGES 28 TO 31.0. 00310000 *A 00320000 *A THIS PROGRAM INVOKES IDCAMS DYNAMICALLY TO SEARCH THE TSO 00330000 *A CATALOGUE FOR THE USER PREFIX "CATN". THE PURPOSE IS TO 00340000 *A VERIFY THAT "CATN" IS A GOOD TSO USER I.D. THE TEST ASSUMES 00350000 *A THAT THERE WILL BE AT LEAST ONE TSO DATA SET FOR THE TSO I.D. 00360000 *A IF UGVTSO DETECTS AN ERROR WHEN ALLOCATING THE DD STATEMENTS 00370000 *A USED BY IDCAMS, IT WILL WAIT 5 SECONDS AND TRY ONCE MORE. 00380000 *A IF IT STILL CANNOT ALLOCATE THE DD STATEMENTS NEEDED IT RETURNS 00390000 *A WITH AN ERROR CODE OF 6. UGVTSO USES THE STIMER MACRO TO 00400000 *A WAIT 5 SECONDS. 00410000 *A 00420000 EJECT 00430000 * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 00440000 * * 00450000 * REGISTER EQUATES * 00460000 * * 00470000 * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 00480000 R0 EQU 0 00490000 R1 EQU 1 00500000 R2 EQU 2 WORK REGISTER 00510000 R3 EQU 3 00520000 R4 EQU 4 00530000 R5 EQU 5 00540000 R6 EQU 6 00550000 R7 EQU 7 00560000 R8 EQU 8 ERROR CODE 00570000 R9 EQU 9 PARM1 - ADDRESS OF PREFIX 00580000 R10 EQU 10 PARM2 - ADDRESS OF ERR 00590000 R11 EQU 11 PARM3 - ADDRESS OF ERIN 00600000 R12 EQU 12 BASE REGISTER 00610000 R13 EQU 13 POINTER TO SAVE AREA 00620000 R14 EQU 14 SUBROUTINE CALL REGISTER 00630000 R15 EQU 15 SUBROUTINE ADDRESS 00640000 EJECT 00650000 * PRINT NOGEN 00660000 UGVTSO CSECT 00670000 SAVE (14,12),,* SAVE REGISTERS IN CALLING 00680000 * PROGRAMS SAVE AREA 00690000 LR R12,R15 00700000 USING UGVTSO,R12 ESTABLISH BASE REGISTER 00710000 ST R13,SAVEAREA+4 SAVE ADDRESS OF CALLING 00720000 * PROGRAM SAVE AREA 00730000 LR R2,R13 00740000 LA R13,SAVEAREA SET UP REG 13 TO POINT TO 00750000 * MY SAVE AREA 00760000 ST R13,8(R2) CHAIN CALLING PROGRAM TO MY 00770000 **************** ADDRESSING MODE SWITCH ****************** EXT 00780000 UGVTSO AMODE ANY EXT 00790000 UGVTSO RMODE 24 EXT 00800000 LA R4,UGNEXT EXT 00810000 LA R5,RETURNIT EXT 00820000 BSM R5,R4 EXT 00830000 RETADD DC F'0' EXT 00840000 UGNEXT DS 0H EXT 00850000 ST R5,RETADD EXT 00860000 * SAVE AREA 00870000 LM R9,R11,0(R1) GET CALLING PARAMETERS 00880000 SR R2,R2 00890000 ST R2,ERIN RESET ERROR FLAG 00900000 ST R2,COUNT ZERO LOOP COUNT 00910000 LA R8,6 PRESET ERROR FLAG FOR DD ALLOCATE 00920000 * CALL UGAIDC 00930000 TRYAGAIN EQU * 00940000 L R15,=V(UGAIDC) 00950000 LA R1,AERR 00960000 BALR R14,R15 CALL UGAIDC 00970000 L R2,ERR 00980000 C R2,ONE 00990000 BE DIDIT BRANCH IF SUCCESSFUL ALLOCATION 01000000 L R2,COUNT 01010000 LTR R2,R2 01020000 BNZ RETURN ERROR IF FAILED TWICE 01030000 LA R2,1(R2) 01040000 ST R2,COUNT 01050000 STIMER WAIT,BINTVL=TIMEVAL 01060000 B TRYAGAIN 01070000 DIDIT EQU * 01080000 MVC CATN(6),0(R9) GET NAME TO BE SEARCHED FOR 01090000 LA R3,CATN 01100000 LR R4,R3 01110000 NMLEN1 CLI 0(R3),C' ' 01120000 BE NMLEN2 01130000 LA R3,1(,R3) 01140000 B NMLEN1 01150000 NMLEN2 SR R3,R4 LENGTH OF NAME 01160000 BCTR R3,0 01170000 STC R3,IDCAMMV+1 01180000 * 01190000 * LOAD IDCAMS IF NECESSARY 01200000 * 01210000 NOP IDCAM1 01220000 MVI *-3,X'F0' 01230000 LOAD EP=IDCAMS 01240000 ST R0,AIDCAMS 01250000 * 01260000 * CREATE REQUEST COMMAND FOR IDCAMS 01270000 * 01280000 IDCAM1 MVI WORK,C' ' 01290000 MVC WORK+1(79),WORK 01300000 MVC WORK+1(30),LISTC 01310000 IDCAMMV MVC WORK+31(0),CATN PUT DSN IN LISTCAT COMMAND 01320000 LA R7,WORK+32(R3) 01330000 MVI 0(R7),C'''' ADD A QUOTE TO END 01340000 MVI 1(R7),C')' ADD AN ENDING PARENTHESIS 01350000 OPEN (IDCMIN,(OUTPUT)) 01360000 PUT IDCMIN,WORK WRITE COMMAND TO TEMPORARY FILE 01370000 CLOSE (IDCMIN) 01380000 * 01390000 * NOW GET CATALOG ENTRIES USING IDCAMS 01400000 * 01410000 L R15,AIDCAMS 01420000 CALL (15),(IDCMPRM,IDCMDD),VL 01430000 STM R0,R15,SAVE4 *** TEST 01440000 LTR R15,R15 01450000 LA R8,5 01460000 BNZ RETURN ERROR - COULD NOT FIND PREFIX 01470000 LA R8,1 01480000 * 01490000 RETURN EQU * 01500000 ST R8,0(R10) 01510000 L R2,ERIN 01520000 LTR R2,R2 01530000 BZ EXIT 01540000 ST R2,0(R11) 01550000 EXIT EQU * 01560000 L R15,=V(UGUIDC) UNALLOCATE IDCAMS DD STSTEMENTS 01570000 LA R1,AERR 01580000 BALR R14,R15 01590000 **************** ADDRESSING RETURN ****************** EXT 01600000 L R5,RETADD EXT 01610000 BSM 0,R5 EXT 01620000 RETURNIT DS 0H EXT 01630000 L R13,4(R13) GRAB OLD SAVE AREA 01640000 LM R14,R12,12(R13) RESTORE REGISTERS 01650000 MVI 12(R13),X'FF' TELL FORTRAN ROUTINE I AM DONE 01660000 SR R15,R15 SET GOOD RETURN CODE 01670000 BR R14 RETURN TO CALLER 01680000 * 01690000 CNOP 0,4 01700000 SAVEAREA DS 18F'0' REGISTER SAVE AREA 01710000 SAVE1 DS 18F'0' *** TEST 01720000 SAVE2 DS 18F'0' *** TEST 01730000 SAVE3 DS 18F'0' *** TEST 01740000 SAVE4 DS 18F'0' *** TEST 01750000 AERR DC AL4(ERR) 01760000 AERIN DC X'80' 01770000 DC AL3(ERIN) 01780000 ERR DC F'0' 01790000 ERIN DC F'0' 01800000 TIMEVAL DC F'500' 01810000 COUNT DS F'0' 01820000 ONE DC F'1' 01830000 CATN DC 8C' ' 2 EXTRA BLANKS AT END ARE NEEDED 01840000 DSN DC 44C' ' 01850000 LISTC DC C'LISTCAT OUTFILE(CATLIST) ENT(''' 01860000 WORK DC 80C' ' 01870000 LOCAREA DS 0D 01880000 DS 265C 01890000 AIDCAMS DS F 01900000 IDCMPRM DC A(0) 01910000 IDCMDD DC AL2(48) 01920000 DC CL8'00000000' SYSLIN 01930000 DC CL8'00000000' MEMBER NAME 01940000 DC CL8'00000000' SYSLMOD 01950000 DC CL8'00000000' SYSLIB 01960000 DC CL8'IDCMSIN ' SYSIN 01970000 DC CL8'IDCMPRNT' SYSPRINT 01980000 IDCMIN DCB RECFM=F,MACRF=PM,DDNAME=IDCMSIN,DSORG=PS,LRECL=80, X01990000 BLKSIZE=80 02000000 LTORG 02010000 END 02020000