The following sample IDD user-exit program can be used to enforce naming conventions for elements. The source code for this program can be found in the installation source library under member name IDDSUXIT.
********************************************************************
IDDUXIT TITLE ' NAMING CONVENTION CHECKER'
********************************************************************
*
*
* PROGRAM NAME : IDDUXIT
*
* DATE : mm/dd/yy
*
*
* DESCRIPTION : THIS IS AN EXAMPLE OF AN IDD USER EXIT. THIS
*
* PROGRAM SHOWS HOW A SHOP COULD CHECK THE ENTITY
*
* NAMES FOR A SHOP STANDARD. ANY VIOLATIONS OF
*
* THE NAMING CONVENTION ARE TREATED AS AN IDD ERROR
*
* AND THE ACTION (ADD, MOD, DEL) IS NOT ALLOWED.
*
********************************************************************
*
IDDUXIT CSECT
#REGEQU
ENTRY IDDEXITO
IDDEXITO DS 0H Online DDDL compiler entry
ENTRY IDDEXITB
IDDEXITB DS 0H Batch DDDL compiler entry
********************************************************************
*
* SET UP ADDRESSABILITY
*
********************************************************************
*
STM R14,R12,12(R13) SAVE CALLERS REGISTERS
LR R12,R15
USING IDDUXIT,R12
L R4,12(R1) GET THE
L R3,8(R1) CORRECT
L R2,4(R1) PARAMETER
L R1,0(R1) ADDRESSES
*
IDDUXITR DS 0H BASE THE CONTROL BLOCKS
*
USING UXITCB,R1 USER EXIT CONTROL BLOCK
MVC UXITRCDE,F0 ZERO OUT THE RETURN CODE
MVC UXITMID(8),BLANKS BLANK OUT THE MESSAGE ID
MVC UXITMTXT(80),BLANKS BLANK OUT THE MESSAGE
*
********************************************************************
*
* INTERROGATE THE IDD COMMAND
*
********************************************************************
*
SPACE
UXIENTY EQU *
USING UXITECB,R3 ENTITY CONTROL BLOCK
*
CLC UXITEVRB,UXICSON IS IT AN SIGNON?
BE USIGNON YES, CHECK THE USER NAME
*
CLC UXITEVRB,UXICARD IS IT AN CARD IMAGE EXIT?
BE UCARD YES, CHECK THE CARD
*
CLC UXITEVRB,UXICADD IS IT AN ADD?
BE UXIECHK YES, CHECK THE ENTITY-NAME
*
CLC UXITEVRB,UXICMOD IS IT A MODIFY?
BE UXIECHK YES, CHECK THE ENTITY-NAME
*
CLC UXITEVRB,UXICREP IS IT A DELETE?
BE UXIECHK YES, CHECK THE ENTITY-NAME
* NO
MVC UXITMID(8),ELSEID MOVE IN 'ELSE' MESSAGE ID
MVC UXITMTXT(80),ELSEMSG MOVE IN 'ELSE' MESSAGE
BNE UXIEBYE
* YES, CHECK THE ENTITY-NAME
********************************************************************
*
* CHECK THE CARD IMAGE
*
********************************************************************
*
SPACE
UCARD EQU *
*
MVC UXITMID(8),CARDID FILL IN THE MESSAGE ID
MVC UXITMTXT(80),CARDMSG FILL IN THE MESSAGE TEXT
B UXIEBYE BACK TO THE LAND OF IDD
*
********************************************************************
*
* CHECK THE USER NAME FOR ME
*
********************************************************************
*
SPACE
USIGNON EQU *
*
USING UXITSEB,R2 SIGNON ELEMENT BLOCK
USING UXITSB,R3 SIGNON BLOCK
*
CLC UXITUSER(3),WHOME IS IT ME
BE UXIEDC YES GO CHECK FOR DC NAME
* NO, GO TO JAIL, GO DIRECTLY TO
* JAIL, DO NOT PASS GO DO NOT
USNAME EQU * COLLECT $200.
MVC UXITRCDE,F8 FILL IN THE RETURN CODE
MVC UXITMID(8),NOSNID FILL IN THE MESSAGE ID
MVC UXITMTXT(80),NOSNMSG FILL IN THE MESSAGE TEXT
B UXIEBYE BACK TO THE LAND OF IDD
*
UXIEDC EQU *
TM UXITFLG1,UXIT1DC ARE WE RUNNING DC
BZ UXIEBYE NO, SKIP DC ID CHECK
*
CLC UXITUSER,UXITIUSR IS THE IDD USER THE SAME AS DC
BE UXIEBYE YES, OK LET IT PASS
* NO, DON'T LET THEM SIGNON
MVC UXITRCDE,F8 FILL IN THE RETURN CODE
MVC UXITMID(8),NODCID FILL IN THE MESSAGE ID
MVC UXITMTXT(80),NODCMSG FILL IN THE MESSAGE TEXT
B UXIEBYE BACK TO THE LAND OF IDD
*
********************************************************************
*
* CHECK THE ENTITY-NAME FOR VALID NAMING CONVENTION
*
********************************************************************
*
SPACE
UXIECHK EQU *
USING UXITECB,R3 ENTITY CONTROL BLOCK
*
CLC UXITENME(3),NAMECHK DOES THE NAME FOLLOW THE RULES?
BE UXIEBYE YES, LET THIS ONE PASS.
* NO, RETURN AN ERROR
*
MVC UXITRCDE,F8 FILL IN THE RETURN CODE
MVC UXITMID(8),NONOID FILL IN THE MESSAGE ID
MVC UXITMTXT(80),NONOMSG FILL IN THE MESSAGE TEXT
*
********************************************************************
*
* RETURN BACK TO IDD
*
********************************************************************
*
SPACE
UXIEBYE EQU *
LM R14,R12,12(R13) RELOAD CALLER'S REGISTERS
BR R14 RETURN TO CALLER
EJECT
********************************************************************
* CONSTANTS AND LITERALS *
********************************************************************
UXICADD DC CL16'ADD '
UXICMOD DC CL16'MODIFY '
UXICREP DC CL16'REPLACE '
UXICSON DC CL16'SIGNON '
UXICARD DC CL16'CARD IMAGE '
NAMECHK DC CL3'XYZ'
WHOME DC CL3'XYZ'
WKLEN DC F'100'
NONOID DC CL8'DC999001'
NONOMSG DC CL80'NAMING CONVENTION VIOLATED - ACTION NOT ALLOWED'
NOSNID DC CL8'DC999002'
NOSNMSG DC CL80'SIGNON ERROR - USER NOT ALLOWED ACCESS TO IDD'
NODCID DC CL8'DC999003'
NODCMSG DC CL80'SIGNON ERROR - IDD USER NAME NOT DC USER NAME'
CARDID DC CL8'DC999004'
CARDMSG DC CL80'MESSAGE PRODUCED BY CARD IMAGE EXIT '
ELSEID DC CL8'DC999005'
ELSEMSG DC CL80'MESSAGE PRODUCED BY CARD IMAGE EXIT '
BLANKS DC CL80' '
F0 DC F'0' NORMAL RETURN CODE - NO ERRORS
F2 DC F'1' INFORMATION MESSAGE
F4 DC F'4' WARNING MESSAGE
F8 DC F'8' ERROR MESSAGE
********************************************************************
* USER EXIT CONTROL BLOCK *
********************************************************************
UXITCB DSECT
UXITCPLR DS CL8 COMPILER NAME 'IDMSDDDL'
UXITDATE DS CL8 COMPILER START DATE MM/DD/YY
UXITTIME DS CL8 COMPILER START TIME HHMMSSMM
UXITWORK DS F USER FULLWORD INITIALIZED TO 0
UXITRCDE DS 0F RETURN CODE RETURNED BY USER
DS XL3 UNUSED
UXITRC DS X
UXITRC00 EQU X'00' NORMAL RETURN CODE - NO ERRORS
UXITRC01 EQU X'01' INFORMATION MESSAGE
UXITRC04 EQU X'04' WARNING MESSAGE
UXITRC08 EQU X'08' ERROR MESSAGE
UXITMID DS CL8 USER MESSAGE ID RETURNED BY USER
UXITMTXT DS CL80 USER MESSAGE TEXT RETURNED BY USER
UXITCBLN EQU *-UXITCB USER EXIT CONTROL BLOCK LENGTH
********************************************************************
* USER EXIT SIGNON ELEMENT BLOCK *
********************************************************************
UXITSEB DSECT
UXITIDLN DS X LENGTH OF USERID FOR #WTL'S
UXITUSER DS CL32 USER ID
DS 0A ROUND UP TO FULLWORD
UXITSNLN EQU *-UXITSEB LENGTH OF IDD SIGNON ELEMENT
********************************************************************
* USER EXIT SIGNON BLOCK *
********************************************************************
UXITSB DSECT
UXITTYPE DS CL16 IDD VERB
UXITDICT DS CL8 DICTIONARY NAME
UXITNODE DS CL8 NODE NAME
UXITIUSR DS CL32 IDD USER ID
UXITIPSW DS CL8 IDD USER'S PASSWORD
UXITFLG0 DS CL1 ENVIRONMENT FLAG
UXIT0DOS EQU X'80' COMPILER RUNNING UNDER VSE/ESA
UXIT0MEN EQU X'40' RUNNING UNDER 'IDD MENU' MODE
UXITFLG1 DS CL1 ENVIRONMENT FLAG
UXIT1LCL EQU X'80' COMPILER RUNNING IN INTERNAL SUBROUTINE MO
UXIT1DC EQU X'40' COMPILER RUNNING UNDER DC
DS CL2 RESERVED FOR FUTURE FLAGS
DS CL20 RESERVED
UXITDMLM DS H DDLDML USAGE MODE
* 36=UPDATE
* 37=PROTECTED UPDATE
* 38=RETRIEVAL
UXITLODM DS H DDLDCLOD USAGE MODE
UXITMSGM DS H DDLDCMSG USAGE MODE
DS CL10 RESERVED
UXITSLEN EQU *-UXITSB LENGTH OF USER EXIT SIGNON BLOCK
********************************************************************
* USER EXIT ENTITY CONTROL BLOCK *
********************************************************************
UXITECB DSECT
UXITEVRB DS CL16 IDD VERB
UXITENTY DS CL32 IDD ENTITY-TYPE
UXITENME DS CL40 ENTITY NAME
UXITEVER DS H VERSION
UXITEADQ DS CL64 ADDITIONAL QUALIFIER
* CL40 LANGUAGE (ENTITY TYPE = MODULE)
* CL20 CLASS (ENTITY TYPE = ATTRIBUTE)
UXITPREP DS CL32 PREPARED BY USER NAME
UXITREV DS CL32 REVISED BY USER NAME
UXITELEN EQU *-UXITECB LENGTH OF USER EXIT ENTITY CONTROL BLK
********************************************************************
* END OF EXIT *
********************************************************************
END
|
Copyright © 2014 CA.
All rights reserved.
|
|