Title : Type 2 AO Exit - various functions Submitter : Paul Wells TNT Express Worldwide Abeles Way Atherstone Warwickshire CV9 2RY Phone : 01827 710642 Release Submitter Details - Y Text :- IMS V5 type 2 AO exit (DFSAOE00). Restarts PSBs & DB2 connections at IMS startup and after failures. Also prompts operator for /ERE OVERRIDE. * 00001000 * Name: DFSAOE00 00002000 * 00003000 * Abstract: IMS automated operator exit 00004000 * 00005000 * Author: Paul Wells (ECSOFT) 21/08/96 for TNT Express Worldwide 00006000 * 00007000 * Processing: The purpose of the exit is to perform IMS message 00010200 * automation. 00010300 * It is designed to work in a DBCTL environment at IMS V5 00010400 * level or later. 00010400 * 00010500 * At IMS start, message DFS994I is trapped and a 00010600 * /STA PROG ALL is issued to ensure we have no unhappy 00010700 * legacy from a previous IMS start. (You could use 00010800 * the /LOC command if you really want to disable a 00010900 * program.) A /STA SUBSYS ALL is also issued. 00010900 * 00011000 * When an IMS application (BMP or CICS thread) abends, 00010600 * message DFS554A is issued. If the message text contains 00010700 * ' PSB ' then IMS has stopped the program. In which 00010800 * case we start it again. 00010900 * 00011000 * The DB2 external external subsystems are restarted 00010300 * when a DFS3611I RC C (DB2 stopped) or RC D (DB2 abended) 00010300 * is issued. 00010300 * 00011000 * DFS0618A is trapped to send a message to operators 00010300 * to say that an /ERE OVERRIDE is required. 00010300 * 00011000 * Commands issued by this program do not use the CRC. 00011300 * Instead they use the alternative method of prefixing 00011400 * the command with the IMS subsystem. e.g. IMSASTA PROG xxx 00011400 * 00011500 * 00012100 * Mods: 00012200 * 00012300 * 00012400 * * * REGISTERS AT ENTRY: * * * * R1 = ADDRESS OF IMS STANDARD USER EXIT PARAMETER LIST * * R13 = SAVEAREA ADDRESS * * R14 = RETURN ADDRESS * * R15 = DFSAOE00 ENTRY POINT ADDRESS * * * * ³-----------------³ * * IMS STANDARD USER ³---->³CALLABLE SERVICES³ * * EXIT PARAMETER ³ ³ TOKEN ³ * * LIST (SXPL) ³ ³-----------------³ * * R1 -----> ³----------------³ ³ * * ³ A (PL VERSION) ³ ³ * * ³----------------³ ³ ³-----------------³ * * ³ A (TOKEN) -----³ ³STATIC 256 BYTE ³ * * ³----------------³ ³-->³WORK AREA ³ * * ³ A (256B WA) -------³ ³-----------------³ * * ³----------------³ * * ³ A (FUNC PL) -------³ (DFSAOE0) * * ³----------------³ ³ ³-----------------³ * * ³ F (0) ³ ³-->³AUTOMATED ³ * * ³----------------³ ³OPERATOR EXIT ³ * * ³PARM LIST ³ * * ³³-³--------------³ * * ³ ³ * * ³ ³ (DNYWRK) * * ³ ³ ³-----------------³ * * ³ ³---->³256 BYTE WORK ³ * * ³ ³AREA--EXISTS FOR ³ * * ³ ³LIFE OF MSG OR ³ * * ³ ³COMMAND. ³ * * ³ ³-----------------³ * * ³ * * ³ (SEGMIN) * * ³ ³-----------------³ * * ³------>³COPY OF MESSAGE, ³ * * ³COMMAND OR ³ * * ³COMMAND RESPONSE ³ * * ³-----------------³ * * * * * * REGISTERS AT EXIT: * * * * R14 = RETURN ADDRESS * * THERE IS NO REQUIREMENT FOR EXIT REGISTERS OTHER THAN R14. * * DFSAOE00 COMMUNICATES REPLY INFORMATION IN THE REPLY WORD * * PROVIDED IN THE PARAMETER LIST (DFSAOE0) WHICH IS PASSED * * ON ENTRY TO DFSAOE00. * * * * ATTRIBUTES: REENTRANT, RMODE ANY, AMODE 31 * * * DFSAOE00 CSECT DFSAOE00 AMODE 31 DFSAOE00 RMODE ANY * * INITIALISATION CODE * USING SAVEAREA,R13 SAVE (14,12),,DFSAOE00+&SYSDATE LR R12,R15 USING DFSAOE00,R12 LR R11,R1 STANDARD USER EXIT PARMS USING SXPL,R11 L R9,SXPLFSPL DFSAOE00 PARAMETER LIST USING DFSAOE0,R9 L R8,AOE0WRKA DYNAMIC WORK AREA USING DYNWRK,R8 LR R1,R13 A(SAVE AREA ON ENTRY) LA R13,DYNSAVE A(DYNAMIC SAVE AREA) ST R1,SAVELAST SET A(PREVIOUS SAVE AREA) * * MAINLINE CODE * TM AOE0SSTY,AOE0DBC DBCTL SYSTEM ? BNO RETURN EXIT IF NO A0010 DS 0H CLC AOE0FUNC,=A(AOE0MSEG) CMD/MSG CALL ? BNE RETURN EXIT IF NO TM AOE0FLG2,AOE0MSGS SYSTEM MESSAGE ? BNO RETURN EXIT IF NO TM AOE0FLG1,AOE0FRST FIRST SEGMENT ? BNO RETURN EXIT IF NO ICM R7,15,AOE0SEG MSG SEGMENT EXIST ? BZ RETURN EXIT IF NO USING SEGMIN,R7 * * SEARCH INPUT SEGMENT FOR MESSAGES WE ARE INTERESTED IN * LA R1,5 SEARCH 5 BYTES LA R3,SEGTEXT A0020 DS 0H CLC =C'DFS554A',0(R3) ABEND MSG ? BE A0090 CLC =C'DFS3611I',0(R3) SUBSYS GONE ? BE A0070 CLC =C'DFS0618A',0(R3) ERE OVERRIDE needed ? BE A0060 CLC =C'DFS994I',0(R3) READY MSG ? BE A0030 LA R3,1(,R3) BCT R1,A0020 B RETURN * * BUILD THE 'STA PROG ALL' COMMAND WHEN IMS/DBCTL STARTS (DFS994I) * A0030 DS 0H LA R1,15 SEARCH 15 BYTES LA R3,8(,R3) SKIP MSG ID A0040 DS 0H CLC =C'START COMPLETED',0(R3) STARTED MSG ? BE A0050 LA R3,1(,R3) BCT R1,A0040 B RETURN A0050 DS 0H BAL R10,CMDIMSID MVC 0(13,R2),=CL13'STA PROG ALL.' BAL R10,ISSUMGCR MVC 0(15,R2),=CL15'STA SUBSYS ALL.' BAL R10,ISSUMGCR B RETURN * * ISSUE A HIGHLIGHTED WTO TO INDICATE THAT IMS REQUIRES * THE 'ERE OVERRIDE' COMMAND TO BE ISSUED * A0060 DS 0H BAL R10,WTO0618A B RETURN * * BUILD THE 'STA SUBSYS XXXXXXXX' COMMAND IF THE DB2 SUBSYS HAS * GONE AWAY * A0070 DS 0H CLC =C'RC = D',60(R3) DB2 abended ? BE A0075 CLC =C'RC = C',60(R3) DB2 stopped ? BNE RETURN A0075 DS 0H BAL R10,CMDIMSID BAL R10,CMDSSUBS BAL R10,ISSUMGCR B RETURN * * BUILD THE 'STA PROG XXXXXXXX' COMMAND IF IMS HAS STOPPED THE PSB * (DFS554A CONTAINING ' PSB ') * A0090 DS 0H CLC =C' PSB ',61(R3) BNE RETURN BAL R10,CMDIMSID BAL R10,CMDSPROG BAL R10,ISSUMGCR * * RETURN TO IMS - NO COMMAND/MESSAGE MODS HAVE BEEN MADE * RETURN DS 0H XC AOE0RPLY,AOE0RPLY NO CMD/MSG MODS MADE L R13,SAVELAST A(PREVIOUS SAVE AREA) L R14,SAVER14 RESTORE RETURN ADDRESS BR R14 RETURN TO CALLER * * PUT THE IMSID IN THE COMMAND STRING * CMDIMSID DS 0H MVC CMDLEN,=AL2(CMDL) SET CMD LENGTH MVI CMDTXT,C' ' MVC CMDTXT+1(L'CMDTXT-1),CMDTXT CLEAR FIELD MVC CMDTXT(L'AOE0IMSI),AOE0IMSI LA R1,L'AOE0IMSI LA R2,CMDTXT CMDIM010 DS 0H CLI 0(R2),C' ' SEARCH FOR A BLANK BE CMDIM020 LA R2,1(,R2) BCT R1,CMDIM010 CMDIM020 DS 0H BR R10 * * PUT THE PROGRAM IN THE COMMAND STRING * CMDSPROG DS 0H MVC 0(9,R2),=CL9'STA PROG ' LA R2,9(,R2) MVC 0(8,R2),32(R3) PSB FROM DFS554A MSG LA R2,8(,R2) MVI 0(R2),C'.' COMMAND DELIMITER BR R10 * * PUT THE SUBSYS IN THE COMMAND STRING * CMDSSUBS DS 0H MVC 0(11,R2),=CL11'STA SUBSYS ' LA R2,11(,R2) MVC 0(8,R2),28(R3) SUBSYS FROM DFS3611I MSG LA R2,8(,R2) MVI 0(R2),C'.' COMMAND DELIMITER BR R10 * * ISSUE WTO TO WARN OF DFS0618A ACTION * WTO0618A DS 0H MVC M1MSG(M1LEN),M1MASK MVC M1IMSID1,AOE0IMSI MVC M1IMSID2,AOE0IMSI MVI M1CMD,C' ' MVC M1CMD+1(L'M1CMD-1),M1CMD LA R1,L'AOE0IMSI LA R2,M1IMSID2 WTO0618B DS 0H CLI 0(R2),C' ' SEARCH FOR A BLANK BE WTO0618C LA R2,1(,R2) BCT R1,WTO0618B WTO0618C DS 0H MVC 0(12,R2),=CL12'ERE OVERRIDE' MVC WTOL(WTOML),WTOM WTO mask LA R3,M1MSG SR R0,R0 WTO TEXT=(R3),MF=(E,WTOL) BR R10 * * ISSUE THE OPERATOR COMMAND VIA SVC 34 * ISSUMGCR DS 0H XC MGCRE(MGCREL),MGCRE CLEAR PARM AREA MVC MGEYE,=C'MGCRE' MVI MGVER,1 MVC CMDEYE,CEYE LA R4,CMD MGCRE TEXT=(R4),CONSID==XL4'0',MF=(E,MGCRE) SVC 34 BR R10 * LTORG , CEYE DC C'Issued by DFSAOE00' WTOM WTO TEXT=0,ROUTCDE=(1),DESC=(2),MF=L WTOML EQU *-WTOM * M1MASK DC AL2(M1LEN-2) DC C'DFSAOE00-01A ' DS CL4 DC C' requires an ' DS CL4 DC C'ERE OVERRIDE' DC C' command, see Ops doc' M1LEN EQU *-M1MASK * * * DYNAMIC WORK AREA PASSED BY IMS (256 BYTES) - USED TO MAINTAIN * REENTRANCY * DYNWRK DSECT DS 0CL256 DYNSAVE DS 18F 18 WORD STANDARD SAVE AREA DYNSTART EQU * WTO TO BE ISSUED CMD EQU * OPERATOR COMMAND TO BE ISSUED CMDLEN DS XL2 CMDTXT DS CL30 CMDEYE DS CL(L'CEYE) CMDL EQU *-CMD-L'CMDLEN OPERATOR COMMAND TO BE ISSUED MGCRE MGCRE MF=L SVC 34 PARM LIST MGCREL EQU *-MGCRE SVC 34 PARM LENGTH ORG MGCRE DC AL1(0) FLAG FIELD '00' DC AL1(0) RESERVED DC B'00000000' FLAG FIELD DC B'00000000' FLAG FIELD 2 MGEYE DC CL5'MGCRE' CONTROL BLOCK ACRONYM 'MGCRE' MGVER DC AL1(1) VERSION LEVEL DC AL2(0) RESERVED DC AL4(0) ADDRESS OF THE COMMAND TEXT DC AL4(0) TOKEN DC CL8' ' CONSOLE NAME DC AL4(0) CONSOLE ID DC XL1'0' COMMAND DISPOSITION DC XL2'0' COMMAND AUTHORITY LEVEL DC XL1'0' RESERVED DC XL8'00' COMMAND AND RESPOSE TOKEN DC XL8'00' SYSTEM NAME DC AL4(0) UTOKEN ADDRESS DC XL4'00' RESERVED ORG * ORG DYNSTART Reuse storage WTOL WTO TEXT=0,ROUTCDE=(1),DESC=(2),MF=L M1MSG DS AL2 DC C'DFSAOE00-01A ' M1IMSID1 DS CL4 DC C' requires an ' M1IMSID2 DS CL4 M1CMD DC C'ERE OVERRIDE' DC C' command, see Ops doc' ORG * DYNUSED EQU *-DYNWRK LENGTH OF SPACE USED DYNRSVD DS CL(256-DYNUSED) RESERVED SPACE DYNLNG EQU *-DYNWRK * * INPUT SEGMENT LAYOUT * SEGMIN DSECT DS 0CL256 SEGLENG DS H SEGZZ DS H SEGTEXT DS CL252 * REQUATE SAVE=YES DFSAOE0 , DFSSXPL , DROP R13,R12,R11,R9,R8,R7 END