This can be implemented using the user exit16, the write printer exit. The exit16 source in the solution will produce this result:
Assemble and link JCL:
//IDMSDMLA EXEC PGM=IDMSDMLA,REGION=4000K //STEPLIB DD DSN=... //CDMSLIB DD DSN=... //SYSCTL DD DSN=... //SYSLST DD SYSOUT=* //SYS001 DD DSN=&&WRK1,DISP=(NEW,DELETE),UNIT=SYSDA, // DCB=(RECFM=VB,LRECL=133,BLKSIZE=1334,DSORG=PS), // SPACE=(TRK,(10,10)) //SYS002 DD DSN=&&WRK2,DISP=(NEW,DELETE),UNIT=SYSDA, // DCB=(RECFM=VB,LRECL=133,BLKSIZE=1334,DSORG=PS), // SPACE=(TRK,(10,10)) //SYS003 DD DSN=&&WRK3,DISP=(NEW,DELETE),UNIT=SYSDA, // DCB=(RECFM=VB,LRECL=133,BLKSIZE=1334,DSORG=PS), // SPACE=(TRK,(10,10)) //SYSJRNL DD DUMMY //SYSIDMS DD * DICTNAME=SYSDICT DMCL=YOURDMCL /* //SYSIPT DD * TITLE 'EXIT 16 - LOG PRINT REQUESTS.' *---------------------------------------------------------------------* * * * PDGLXT16 - "WRITE TO PRINTER" EXIT. * * ----------------------------------- * * * * PROCESS: * * -------- * * THIS EXIT IS INVOKED WHEN AN APPLICATION PROGRAM ISSUES A "WRITE * * TO PRINTER API". * * THE EXIT WILL LOCATE, EDIT AND PRINT A MESSAGE INCLUDING DEST-ID, * * UID AND THE PROGRAM NAME WHO ISSUED THIS WRITE REQEST. * * (FOR ANOVEX USAGE). * * * * * * AT ENTRY: * * --------- * * R9 -> TCE * * R10-> CSA * * * * REGISTERS USAGE: * * ---------------- * * * * SYSGEN DEFINITION: * * ------------------ * * PROGRAM PDGLXT16 LANG ASSEM NOPROTECT REENTRANT ISA 0. * * * *---------------------------------------------------------------------* * #MOPT CSECT=PRGXT16,ENV=SYS * PRGXT16 CSECT USING TCE,R9 BASE THE TCE USING CSA,R10 BASE THE CSA *********************************************************************** * EXIT LOGIC, LOCATE AND EDIT: DEST, UID, PROGRAM. * ********************************************************************* EXIT16 #START MPMODE=CALLER #GETSTK =50 GET STORAGE FROM STACK USING WORKAREA,R11 AND MAKE IT ADDRESSABLE * STM R2,R8,RSAVE SAVE REGS 2-8 * XC MSG#TEXT,MSG#TEXT PREPARE MESSAGE AREA. LA R7,L'MSG#TEXT STORE MSG LENGTH. BCTR R7,0 STCM R7,1,MSG#L * LOCATE USERID. L R3,4(R1) GET THE PARM ADDR USING RRB,R3 BASE RRB MVC DEST#PRE,=C' D=' DESTINATION MVC DEST#ID(8),RRBDEST STORE PRINT DEST ID. L R4,TCELTEA GET THE LTE ADDR USING LTE,R4 BASE LTE L R6,LTESONRC GET THE SON RCE USING RCE,R6 BASE RCE L R6,RCESONA GET THE SON ADDRESS DROP R6 FREE R6 USING SON,R6 BASE SON MVC USER#PRE,=C' U=' USER ID MVC USER#ID(8),SONUSRID USER ID REQUESTED THE WRITE... DROP R6 * LOCATE CURRENT PROG NAME. L R7,TCECPRGM POINT TO RCE ADDRESS. USING RCE,R7 CURRENT RCE ADDR. L R6,RCEPDEA PDE OF CURRENT PROGRAM. CLC 0(8,R6),=CL8'ADSOMAIN' BE ADSOMAIN MVC PROG#PRE,=C' P=' PROGRAM MVC PROG#NAM(8),0(R6) CURRENT PROGRAM NAME. B RETURN DROP R4 * ADSOMAIN DS 0H **************************************************** DROP R3 USING RLE,R4 L R4,TCEPRLEA+4 LOAD RLE ADDRESS TO R4 NXTRCE L R7,RLERCEA L R3,RCERADDR CLC 0(4,R3),=CL4'ADB*' IS THIS AN APPLICATION? BNE DIALOG NO, GET NEXT RLE MVC PROG#PRE,=C' A=' ADSA APPLICATION MVC PROG#NAM(8),4(R3) CURRENT PROGRAM NAME. B NXTRLE DIALOG CLC 0(4,R3),=CL4'FDB*' IS THIS A DIALOG? BNE NXTRLE NO, GET NEXT RLE MVC DLG#PRE,=C' D=' ADS DIALOG MVC DLG#NAM(8),4(R3) CURRENT PROGRAM NAME. B RETURN ******************************************************** NXTRLE L R4,RLEPRIA GET NEXT RLE TM 0(R4),X'80' LAST RLE? BO RETURN YES, EXIT B NXTRCE ************************************************************ RETURN DS 0H #WTL MSGID='9876540',PARMS=(MSG#TEXT), * RGSV=(R2-R8) LM R2,R8,RSAVE RESTORE REGISTERS 2-8 #RTN RETURN TO IDMS. *********************************************************************** * WORKAREA. * *********************************************************************** WORKAREA DSECT MSG#TEXT DS 0CL46 MSG#L DS CL1 DEST#PRE DS CL3 DEST#ID DS CL8 USER#PRE DS CL3 USER#ID DS CL8 PROG#PRE DS CL3 PROG#NAM DS CL8 DLG#PRE DS CL3 DLG#NAM DS CL8 DS CL1 * RSAVE DS 7F SYSPLIST DS 8F * PRINT OFF COPY #TCEDS COPY #LTEDS COPY #PTEDS COPY #PTXDS COPY #RRBDS COPY #SONDS COPY #RCADS COPY #CSADS PRINT ON * END EXIT16 //SYSPCH DD DSN=&&DMLA,UNIT=SYSDA,DISP=(NEW,PASS), // SPACE=(TRK,(5,5)), // DCB=(RECFM=FB,LRECL=80,BLKSIZE=3120) //ASMSTEP EXEC PGM=ASMA90,REGION=0M //SYSLIB DD DSN=IDMS.DISTMAC,DISP=SHR // DD DSN=SYS1.MACLIB,DISP=SHR //SYSUT1 DD DSN=&&SYSUT1,UNIT=SYSDA,SPACE=(CYL,(15,10)) //SYSUT2 DD DSN=&&SYSUT2,UNIT=SYSDA,SPACE=(CYL,(15,10)) //SYSUT3 DD DSN=&&SYSUT3,UNIT=SYSDA,SPACE=(CYL,(15,10)) //SYSPRINT DD SYSOUT=* //SYSLIN DD DSN=&&OBJECT,DISP=(NEW,PASS),UNIT=SYSDA, // SPACE=(CYL,(15,10)) //SYSIN DD DSN=&&DMLA,DISP=(OLD,DELETE) //************************************************************** //LINK EXEC PGM=IEWL,PARM='RENT,LET,LIST,XREF',REGION=512K //SYSLIB DD DSN=IDMS.DISTLOAD,DISP=SHR //SYSLIN DD DSN=&&OBJECT,DISP=(OLD,DELETE) // DD DDNAME=SYSIN //SYSIN DD * INCLUDE SYSLIB(IDMS) INCLUDE SYSLIB(IDMSBALI) MODE AMODE(31),RMODE(ANY) ENTRY EXIT16 NAME RHDCUX16(R) /* //SYSLMOD DD DSN=IDMS.TARGET.LOADLIB,DISP=SHR //SYSPRINT DD SYSOUT=* //SYSUT1 DD DSN=&&SYSUT1,UNIT=SYSDA,SPACE=(6400,(80)), // DISP=(NEW,DELETE) //SYSUT2 DD DSN=&&SYSUT1,UNIT=SYSDA,SPACE=(6400,(80)), // DISP=(NEW,DELETE) //SYSUT3 DD DSN=&&SYSUT1,UNIT=SYSDA,SPACE=(6400,(80)), // DISP=(NEW,DELETE)
This is the change to the RHDCUXIT source:
#DEFXIT MODE=SYSTEM,CALL=DC,NAME=RHDCUX16
Sysgen definition:
ADD PROGRAM RHDCUX16 CONCURRENT NODYNAMIC DUMP THRESHOLD IS 0 ENABLED ERROR THRESHOLD IS 5 ISA SIZE IS 0 LANGUAGE IS ASSEMBLER MPMODE IS SYSTEM NOMAINLINE MULTIPLE ENCLAVE IS ON NEW COPY IS ENABLED OVERLAYABLE PROGRAM PROTECT REENTRANT RESIDENT REUSABLE NOSAVEAREA .