Using CA OLQ Efficiently › Controlling Data Retrieval › OLQ DML User Exit › Sample Exit
Sample Exit
OLQDMLX1 TITLE 'SAMPLE USER-WRITTEN DML EXIT FOR OLQ'
*OLQDMLX1 RENT EP=DMLXEP1 XA
***********************************************************************
***********************************************************************
** **
** THIS PROGRAM IS A TEMPLATE TO BE USED AS AN EXAMPLE FOR **
** PROVIDING ENTRY INTO AND EXIT FROM AN OLQ USER-WRITTEN **
** DBMS EDIT MODULE FOR RELEASE 14.0 AND LATER. **
** **
***********************************************************************
***********************************************************************
** **
** THIS IS A SAMPLE ONLY AND NO GUARANTEE IS GIVEN AS TO **
** FUNCTIONALITY, ACCURACY, COMPLETENESS, OR PERFORMANCE. **
** **
***********************************************************************
***********************************************************************
EJECT
*----------------------------------------------------------------------
*
* USERDMLX1 - USER-WRITTEN EXIT FOR DML COMMANDS IN OLQ
*
*----------------------------------------------------------------------
*
* OLQDMLX1 allows user-defined editing of DML commands before they
* are issued by OLQ. The edit routine can be used for things such
* as validating security, keeping statistics, looking for special
* data values, etc.
*
* If certain records, DML commands, or AREAs are to be selected
* for editing, an IDMS database procedure should be used.
*
* If many records or many subschemas are to be edited during OLQ
* processing, this exit should be used.
*
* OLQDMLX1 will be automatically called by OLQ before every
* DML command if program OLQSDMLE is LINK/EDITed with this
* module and with IDMSBALI and command 'DCMT VARY PROGRAM
* OLQSDMLE NEW COPY' is issued.
* //SYSLIB DD DISP=SHR,DSN=IDMS.LOADLIB
* //OBJLIB DD DISP=SHR,DSN=USER.LOADLIB
* //SYSLIN DD *
* INCLUDE SYSLIB(OLQSDMLE)
* INCLUDE OBJLIB(OLQDMLX1)
* INCLUDE SYSLIB(IDMSBALI)
* MODE AMODE(31),RMODE(ANY)
* ENTRY ENTRY
* NAME OLQSDMLE(R)
*
* REGISTER USAGE -
* R12 - BASE REGISTER
* R13 -
* R14 - RETURN ADDRESS FOR SUBROUTINES
* R15 - A(DB/DC INTERFACE)
* R0 -
* R1 - A(PARAMETER LIST) AT ENTRY AND DURING CALLS
* R2 - A(SECURITY REQUEST BLOCK)
* R3 -
* R4 -
* R5 - WORK REGISTER
* R6 -
* R7 -
* R8 - A(OLQ GLOBAL WORK AREA)
* R9 -
* R10 -
* R11 -
*
*----------------------------------------------------------------------
EJECT
DMLXSTG DSECT
*----------------------------------------------------------------------
* Any user-required storage is defined here
*----------------------------------------------------------------------
WORKAREA DC CL80' '
DMLXSTGL EQU *-DMLXSTG
SSCTRLDS DSECT
@SSCTRL
EJECT
*----------------------------------------------------------------------
* Entry code is defined here
*----------------------------------------------------------------------
#MOPT CSECT=OLQDMLX1,ENV=USER
@MODE MODE=IDMSDC,WORKREG=R0,QUOTES=YES,DEBUG=YES
USING DMLXEP1,R12
ENTRY DMLXEP1
DC 0F'0',CL8'DMLXEP1'
DMLXEP1 DS 0F
STM R0,R15,0(R13) SAVE OLQ'S REGISTERS
LA R13,16*4(,R13) ADJUST STACK POINTER
LR R12,R15 ADDRESSIBILITY
#GETSTG TYPE=(USER,SHORT),LEN=DMLXSTGL,ADDR=(R11), X
PLIST=*,STGID='USER',INIT=X'00'
USING DMLXSTG,R11
LR R5,R13 STACK POINTER
SH R5,=AL2(16*4) A(OLQ'S REGISTERS)
L R14,56(,R5) OLQ'S RETURN REGISTER
CLC =AL2(28),0(R14) IF NOT A DML COMMAND
BNE DMLXEXIT CONTINUE DC PROCESSING
L R1,4(,R5) RESTORE A(OLQ'S PARM LIST)
L R5,4(,R1) A(SSCIDBCM+4)
LA R5,5(,R5)
SR R5,R1 IDBMSCOM SUBSCRIPT
EJECT
*----------------------------------------------------------------------
* Edit code is defined here
*----------------------------------------------------------------------
*----------------------------------------------------------------------
* 'Bind Run Unit' edit code is defined here
*----------------------------------------------------------------------
DMLX1000 DS 0H
CH R5,=H'59' IF NOT 'BIND RUN UNIT'
BNE DMLX2000 SEE IF THIS IS 'OBTAIN'
* Code 'BIND RUN UNIT' pre-processing here
B DMLXEXIT PERFORM THE 'BIND'
EJECT
*----------------------------------------------------------------------
* DML edit code is defined here
*----------------------------------------------------------------------
DMLX2000 DS 0H
CH R5,=H'32' IF NOT 'OBTAIN CALC'
BNE DMLX3000 SEE IF THIS IS 'FINISH'
L R5,8(,R1) A(RECORD NAME)
CLC =CL16'EMPLOYEE',0(R5) IF NOT 'OBTAIN CALC EMPLOYEE'
BNE DMLXEXIT PERFORM THE 'OBTAIN CALC'
* Code 'OBTAIN CALC EMPLOYEE' processing here
L R5,160(,R8) A(RECORD IO BUFFER)
CLC =C'0048',0(R5) IF EMP-ID-0415 NOT = 0048
BNE DMLXEXIT PERFORM THE 'OBTAIN CALC'
ABND2000 L R5,0(,R1) A(SSCTRL)
USING SSCTRLDS,R5
MVC ERRSTAT,=C'0399' 'OBTAIN CALC EMPLOYEE' is
MVC ERRORREC,=C'SECURITY ERROR ' not allowed
B DMLXRETN RETURN TO OLQ
DROP R5
EJECT
*----------------------------------------------------------------------
* FINISH edit code is defined here
*----------------------------------------------------------------------
DMLX3000 DS 0H
CH R5,=H'2' IF NOT 'FINISH RUN UNIT'
BNE DMLXEXIT PERFORM DML
* Code 'FINISH RUN UNIT' processing here
B DMLXEXIT PERFORM THE 'FINISH RUN UNIT'
EJECT
*----------------------------------------------------------------------
* Exit code is defined here
*----------------------------------------------------------------------
DMLXEXIT L R15,=V(IDCSACON) A(CSA)
SH R13,=H'64' POINT TO OLQ'S STACK
LM R0,R14,0(R13) RESTORE OLQ'S REGISTERS
BR R15 EXECUTE REQUESTED COMMAND
DMLXRETN SH R13,=H'64' POINT TO OLQ'S STACK
LM R0,R15,0(R13) RESTORE OLQ'S REGISTERS
LA R14,2(,R14) A(NEXT INSTRUCTION)
BR R14 RETURN TO OLQ
DROP R11
LTORG
END DMLXEP1 x
Copyright © 2013 CA.
All rights reserved.
|
|