diff --git a/endevor/Field-Developed-Programs/Exit-Examples/C1UEXT02 Reuse CCID and Comment.cob b/endevor/Field-Developed-Programs/Exit-Examples/C1UEXT02 Reuse CCID and Comment.cob index 3844d90..9ff1b64 100644 --- a/endevor/Field-Developed-Programs/Exit-Examples/C1UEXT02 Reuse CCID and Comment.cob +++ b/endevor/Field-Developed-Programs/Exit-Examples/C1UEXT02 Reuse CCID and Comment.cob @@ -1,748 +1,308 @@ - PROCESS DYNAM OUTDD(DISPLAYS) - ***************************************************************** - * https://github.com/BroadcomMFD/broadcom-product-scripts - * DESCRIPTION: C1UEXT02 is called before Element processing. * - * It gathers Endevor info from the exit blocks * - * then calls REXX program C1UEXTR2. * - * * - * SETUP: The REXX C1UEXTR2 gets called from DD REXFILE2. * - * Change the DSN to a secure dataset.(2 places) * - * * - * STRING 'ALLOC DD(REXFILE2) ', <--look for REXFILE2/SYSEXEC * - * 'DA(ESS.ENDEVOR.EXIT.REXX)' <----- here * - * DELIMITED BY SIZE * - * ' SHR REUSE' * - * DELIMITED BY SIZE * - * INTO ALLOC-TEXT * - * END-STRING. * - * * - * Change the .REXX dataset name to the name of your dataset * - * that contains your C1UEXTR2 Rexx program. * - ***************************************************************** - ** see also EAGGXCOB for Calling IRXEXEC - the IBM example * - ** for calling IRXEXEC from a Cobol program * - ***************************************************************** - IDENTIFICATION DIVISION. - PROGRAM-ID. C1UEXT02. - DATE-COMPILED. - DATE-WRITTEN. + PROCESS DYNAM RENT OUTDD(DISPLAYS) APOST LIB LIST OFFSET + * + * Miscelaneous "Before element Action" exit. + * + * Reuse the CCID and COMMENT values for the Element when * + * left blank. * + * + * Save the name of the Entry environment in the USERData field * + * so that it remains available in the merged section of the * + * Endevor map. * + * + ID DIVISION. + PROGRAM-ID. C1UEXT02. + AUTHOR. Person. + ****************************************************************** + * * + * EXIT TO REUSE CCID AND COMMENT AND PROVIDE COLLISION MSGS . * + * * + ****************************************************************** ENVIRONMENT DIVISION. - CONFIGURATION SECTION. - SOURCE-COMPUTER. IBM-370. - OBJECT-COMPUTER. IBM-370. - * * - ***************************************************************** INPUT-OUTPUT SECTION. FILE-CONTROL. + * * DATA DIVISION. FILE SECTION. - - ***************************************************************** - * W O R K I N G S T O R A G E * - ***************************************************************** - WORKING-STORAGE SECTION. - - 77 WS-TRACE PIC X VALUE 'N'. - 77 FLAGS PIC S9(8) BINARY. - 77 REXX-RETURN-CODE PIC S9(8) BINARY. - 77 DUMMY-ZERO PIC S9(8) BINARY VALUE 0. - 77 ARGUMENT-PTR POINTER. - 77 EXECBLK-PTR POINTER. - 77 ARGTABLE-PTR POINTER. - 77 EVALBLK-PTR POINTER. - - 01 IRXJCL PIC X(6) VALUE 'IRXJCL'. - 01 IRXEXEC-PGM PIC X(08) VALUE 'IRXEXEC'. - - 01 WS-VARIABLES. - 03 WS-POINTER PIC 9(8) COMP. - 03 WS-WORK-ADDRESS-ADR PIC S9(8) COMP SYNC . - 03 WS-WORK-ADDRESS-PTR REDEFINES WS-WORK-ADDRESS-ADR - USAGE IS POINTER . - 03 ADDRESS-ECB-RETURN-CODE PIC 9(10) . - 03 ADDRESS-ECB-MESSAGE-CODE PIC 9(10) . - 03 ADDRESS-ECB-MESSAGE-LENGTH PIC 9(10) . - 03 ADDRESS-ECB-MESSAGE-TEXT PIC 9(10) . - 03 ADDRESS-REQ-SISO-INDICATOR PIC 9(10) . - 03 ADDRESS-REQ-CCID PIC 9(10) . - 03 ADDRESS-REQ-COMMENT PIC 9(10) . - 03 ADDRESS-REQ-USER-DATA PIC 9(10) . - 03 ADDRESS-REQ-ALTER-WITH-UPDATE PIC 9(10) . - 03 WS-INSPECT-CCID PIC X(12) . - 03 WS-INSPECT-COMMENT PIC X(40) . - - - 01 BPXWDYN PIC X(8) VALUE 'BPXWDYN'. - 01 ALLOC-STRING. - 05 ALLOC-LENGTH PIC S9(4) BINARY VALUE 100. - 05 ALLOC-TEXT PIC X(100). - - * The block of data below is passed to the REXX program C1UEXTR2 - * to ensure new elements are Registered. - * The bulk of the logic is found in C1UEXTR2 - 01 ELM-C1UEXTR2-PARMS-IRXJCL. - 02 ELM-EXECUTE-PARMS-IRXJCL-TOP. - 03 PARM-LENGTH PIC X(02) VALUE X'0F89'. 00004500 - 03 REXX-NAME PIC X(08) VALUE 'C1UEXTR2'. - 03 FILLER PIC X(01) VALUE SPACE . - 02 ELM-EXECUTE-PARMS-IRXEXEC. 00004800 - 03 WS-REXX-STATEMENTS PIC X(4000). - - 01 EXECBLK. - 05 EXECBLK-ACRYN PIC X(08) VALUE 'IRXEXECB'. - 05 EXECBLK-LENGTH PIC S9(8) BINARY - VALUE 48. - 05 EXECBLK-RESERVED PIC S9(8) BINARY - VALUE 0. - 05 EXECBLK-MEMBER PIC X(08) VALUE 'C1UEXTR2'. - 05 EXECBLK-DDNAME PIC X(08) VALUE 'REXFILE2'. - 05 EXECBLK-SUBCOM PIC X(08) VALUE SPACES. - 05 EXECBLK-DSNPTR POINTER VALUE NULL. - 05 EXECBLK-DSNLEN PIC 9(04) COMP - VALUE 0. - - 01 EVALBLK. - 05 EVALBLK-EVPAD1 PIC S9(8) BINARY - VALUE 0. - 05 EVALBLK-EVSIZE PIC S9(8) BINARY - VALUE 34. - 05 EVALBLK-EVLEN PIC S9(8) BINARY - VALUE 0. - 05 EVALBLK-EVPAD2 PIC S9(8) BINARY - VALUE 0. - 05 EVALBLK-EVDATA PIC X(256). - - 01 ARGUMENT. - 02 ARGUMENT-1 OCCURS 1 TIMES. - 05 ARGSTRING-PTR POINTER. - 05 ARGSTRING-LENGTH PIC S9(8) BINARY. - 02 ARGSTRING-LAST1 PIC S9(8) BINARY - VALUE -1. - 02 ARGSTRING-LAST2 PIC S9(8) BINARY - VALUE -1. - - - *----------------------------------------------------------------- - LINKAGE SECTION. - *----------------------------------------------------------------- - COPY EXITBLKS. - - PROCEDURE DIVISION USING - EXIT-CONTROL-BLOCK - REQUEST-INFO-BLOCK - SRC-ENVIRONMENT-BLOCK - SRC-ELEMENT-MASTER-INFO-BLOCK - SRC-FILE-CONTROL-BLOCK - TGT-ENVIRONMENT-BLOCK - TGT-ELEMENT-MASTER-INFO-BLOCK - TGT-FILE-CONTROL-BLOCK. - - IF WS-TRACE = 'Y' THEN - DISPLAY 'C1UEXT02: RETURN-CODE =' RETURN-CODE . - - IF WS-TRACE = 'Y' THEN - DISPLAY 'C1UEXT02: Entered' - ' SRC-ENV-TYPE-OF-BLOCK=' SRC-ENV-TYPE-OF-BLOCK - ' TGT-ENV-TYPE-OF-BLOCK=' TGT-ENV-TYPE-OF-BLOCK - DISPLAY 'C1UEXT02: ' - ' SRC-ENV-IO-TYPE=' SRC-ENV-IO-TYPE - ' TGT-ENV-IO-TYPE=' TGT-ENV-IO-TYPE + WORKING-STORAGE SECTION. + 01 WS-WORK-FIELDS. + 05 WS-TALLY PIC 9(04). + 01 WS-VARIABLES. + 05 WS-FILE-STATUS PIC X(02) VALUE ' '. + 05 WS-END-OF-FILE PIC X(01) VALUE ' '. + 88 END-OF-FILE VALUE 'Y'. + 05 WS-END-SEARCH PIC X(01) VALUE SPACES. + 05 WS-WORKING-KEYWORD PIC X(12) VALUE SPACES. + 05 WS-WORKING-COMMENT PIC X(40) VALUE SPACES. + 88 FOUND-VALID-SYSTEM VALUE 'Y'. + 88 NOT-FOUND-VALID-SYSTEM VALUE 'N'. + LINKAGE SECTION. + * SEE CAI.ENDEVOR.SOURCE(EXITBLKS) + COPY EXITBLKS. + EJECT + PROCEDURE DIVISION USING EXIT-CONTROL-BLOCK + REQUEST-INFO-BLOCK + SRC-ENVIRONMENT-BLOCK + SRC-ELEMENT-MASTER-INFO-BLOCK + SRC-FILE-CONTROL-BLOCK + TGT-ENVIRONMENT-BLOCK + TGT-ELEMENT-MASTER-INFO-BLOCK + TGT-FILE-CONTROL-BLOCK. + 0000-START. + IF ECB-USER-ID(1:7) NOT = 'IbmUser' + GOBACK. +******* DISPLAY 'REQ-DELETE-AFTER=' REQ-DELETE-AFTER. +******* DISPLAY 'REQ-BYPASS-DEL-PROC= ' REQ-BYPASS-DEL-PROC. +******* IF ECB-USER-ID(1:7) = 'Ibmuser' +******* DISPLAY 'C1UEXT02: ENTERING EXIT 2 -' +******* 'ECB-USER-ID = ' ECB-USER-ID +******* ' ECB-ACTION-NAME ' ECB-ACTION-NAME +******* ' REQ-GEN-COPYBACK ' REQ-GEN-COPYBACK +******* ' ECB-CALLER-ORIGIN IS ' +******* ECB-CALLER-ORIGIN . + MOVE ZERO TO ECB-RETURN-CODE. + *** If doing an ADD or UPDATE then replicate the + *** Environment and Subsystem fields into the 'User Data' + *** to keep the element's entry location for the life of + *** its trip thru the life cycle. + *** Default to the source block USER data field. + IF SRC-EXTERNAL-ENV-BLOCK + MOVE SRC-ELM-USER-DATA TO REQ-USER-DATA + MOVE 4 TO ECB-RETURN-CODE END-IF. - - IF PACKAGE-INSPECT THEN GOBACK. - - MOVE SPACES TO WS-REXX-STATEMENTS . - - IF WS-TRACE = 'Y' THEN - DISPLAY 'C1UEXT02: Setting up addresses ' . - - SET WS-WORK-ADDRESS-PTR TO - ADDRESS OF ECB-RETURN-CODE . - MOVE WS-WORK-ADDRESS-ADR - TO ADDRESS-ECB-RETURN-CODE . - - SET WS-WORK-ADDRESS-PTR TO - ADDRESS OF ECB-MESSAGE-CODE. - MOVE WS-WORK-ADDRESS-ADR - TO ADDRESS-ECB-MESSAGE-CODE. - - SET WS-WORK-ADDRESS-PTR TO - ADDRESS OF ECB-MESSAGE-LENGTH. - MOVE WS-WORK-ADDRESS-ADR - TO ADDRESS-ECB-MESSAGE-LENGTH . - - SET WS-WORK-ADDRESS-PTR TO - ADDRESS OF ECB-MESSAGE-TEXT . - MOVE WS-WORK-ADDRESS-ADR - TO ADDRESS-ECB-MESSAGE-TEXT . - - SET WS-WORK-ADDRESS-PTR TO - ADDRESS OF REQ-CCID . - MOVE WS-WORK-ADDRESS-ADR - TO ADDRESS-REQ-CCID . - - SET WS-WORK-ADDRESS-PTR TO - ADDRESS OF REQ-COMMENT . - MOVE WS-WORK-ADDRESS-ADR - TO ADDRESS-REQ-COMMENT . - - SET WS-WORK-ADDRESS-PTR TO - ADDRESS OF REQ-USER-DATA . - MOVE WS-WORK-ADDRESS-ADR - TO ADDRESS-REQ-USER-DATA . - - SET WS-WORK-ADDRESS-PTR TO - ADDRESS OF REQ-ALTER-WITH-UPDATE . - MOVE WS-WORK-ADDRESS-ADR - TO ADDRESS-REQ-ALTER-WITH-UPDATE . - - ***** - ***** / Convert COBOL exit block Datanames into Rexx \ - ***** - ***** - IF WS-TRACE = 'Y' THEN - DISPLAY 'C1UEXT02: removing quote chars ' . - - MOVE 1 TO WS-POINTER. - - INSPECT REQ-CCID REPLACING ALL '"' BY X'7D'. - INSPECT REQ-COMMENT REPLACING ALL '"' BY X'7D'. - - IF WS-TRACE = 'Y' THEN - DISPLAY 'C1UEXT02: Stringing ECB vars ' . - - STRING - 'ECB_TSO_BATCH_MODE = "' - DELIMITED BY SIZE - ECB-TSO-BATCH-MODE - DELIMITED BY SIZE - '";' - DELIMITED BY SIZE - 'ECB_USER_ID = "' - DELIMITED BY SIZE - ECB-USER-ID - DELIMITED BY SIZE - '";' - DELIMITED BY SIZE - 'ECB_ACTION_NAME = "' - DELIMITED BY SIZE - ECB-ACTION-NAME - DELIMITED BY SIZE - '";' - DELIMITED BY SIZE - 'REQ_CCID = "' - DELIMITED BY SIZE - REQ-CCID - DELIMITED BY SIZE - '";' - DELIMITED BY SIZE - 'Address_REQ_CCID = ' - DELIMITED BY SIZE - ADDRESS-REQ-CCID - DELIMITED BY SIZE - ';' - DELIMITED BY SIZE - 'Address_REQ_USER_DATA = ' - DELIMITED BY SIZE - ADDRESS-REQ-USER-DATA - DELIMITED BY SIZE - ';' - DELIMITED BY SIZE - 'Address_REQ_ALTER_WITH_UPDATE = ' - DELIMITED BY SIZE - ADDRESS-REQ-ALTER-WITH-UPDATE - DELIMITED BY SIZE - ';' - DELIMITED BY SIZE - 'REQ_COMMENT = "' - DELIMITED BY SIZE - REQ-COMMENT - DELIMITED BY SIZE - '";' - DELIMITED BY SIZE - 'Address_REQ_COMMENT = ' - DELIMITED BY SIZE - ADDRESS-REQ-COMMENT - DELIMITED BY SIZE - ';' - DELIMITED BY SIZE - 'REQ_SISO_INDICATOR = "' - DELIMITED BY SIZE - REQ-SISO-INDICATOR - DELIMITED BY SIZE - '";' - DELIMITED BY SIZE - 'REQ_DELETE_AFTER = "' - DELIMITED BY SIZE - REQ-DELETE-AFTER - DELIMITED BY SIZE - '";' - DELIMITED BY SIZE - 'REQ_SYNCHRONIZE = "' - DELIMITED BY SIZE - REQ-SYNCHRONIZE - DELIMITED BY SIZE - '";' - DELIMITED BY SIZE - 'REQ_IGNGEN_FAIL = "' - DELIMITED BY SIZE - REQ-IGNGEN-FAIL - DELIMITED BY SIZE - '";' - DELIMITED BY SIZE - 'REQ_PROCESSOR_GROUP = "' - DELIMITED BY SIZE - REQ-PROCESSOR-GROUP - DELIMITED BY SIZE - '";' - DELIMITED BY SIZE - 'REQ_OVERWRITE_INDICATOR = "' - DELIMITED BY SIZE - REQ-OVERWRITE-INDICATOR - DELIMITED BY SIZE - '";' - DELIMITED BY SIZE - 'REQ_GEN_COPYBACK = "' - DELIMITED BY SIZE - REQ-GEN-COPYBACK - DELIMITED BY SIZE - '";' - DELIMITED BY SIZE - 'REQ_BENE = "' - DELIMITED BY SIZE - REQ-BENE - DELIMITED BY SIZE - '";' - DELIMITED BY SIZE - 'REQ_AUTOGEN = "' - DELIMITED BY SIZE - REQ-AUTOGEN - DELIMITED BY SIZE - '";' - DELIMITED BY SIZE - 'Address_ECB_RETURN_CODE = ' ADDRESS-ECB-RETURN-CODE - DELIMITED BY SIZE - '; ' - DELIMITED BY SIZE - 'Address_ECB_MESSAGE_CODE = ' ADDRESS-ECB-MESSAGE-CODE - DELIMITED BY SIZE - '; ' - DELIMITED BY SIZE - 'Address_ECB_MESSAGE_LENGTH = ' - ADDRESS-ECB-MESSAGE-LENGTH - DELIMITED BY SIZE - '; ' - DELIMITED BY SIZE - 'Address_ECB_MESSAGE_TEXT = ' - ADDRESS-ECB-MESSAGE-TEXT - DELIMITED BY SIZE - '; ' - DELIMITED BY SIZE - INTO WS-REXX-STATEMENTS - WITH POINTER WS-POINTER - END-STRING. - - IF WS-TRACE = 'Y' THEN - DISPLAY 'C1UEXT02: Stringing SRC vars ' - 'SRC-ENV-IO-TYPE=' SRC-ENV-IO-TYPE . - - IF SRC-ENV-LENGTH GREATER THAN ZERO - MOVE SRC-ELM-ACTION-CCID TO WS-INSPECT-CCID - INSPECT WS-INSPECT-CCID - REPLACING ALL '"' BY X'7D' - MOVE SRC-ELM-LEVEL-COMMENT TO - WS-INSPECT-COMMENT - INSPECT WS-INSPECT-COMMENT - REPLACING ALL '"' BY X'7D' - - INSPECT WS-INSPECT-CCID REPLACING ALL '"' BY X'7D' - INSPECT WS-INSPECT-COMMENT REPLACING ALL '"' BY X'7D' - STRING - 'SRC_ELM_ACTION_CCID = "' - DELIMITED BY SIZE - WS-INSPECT-CCID - DELIMITED BY SIZE - '";' - DELIMITED BY SIZE - 'SRC_ELM_LEVEL_COMMENT= "' - DELIMITED BY SIZE - WS-INSPECT-COMMENT - DELIMITED BY SIZE - '";' - DELIMITED BY SIZE - 'SRC_ELM_LAST_PROC_PACKAGE = "' - DELIMITED BY SIZE - SRC-ELM-LAST-PROC-PACKAGE - DELIMITED BY SIZE - '";' - DELIMITED BY SIZE - 'SRC_ELM_PROCESSOR_GROUP = "' - DELIMITED BY SIZE - SRC-ELM-PROCESSOR-GROUP - DELIMITED BY SIZE - '";' - DELIMITED BY SIZE - INTO WS-REXX-STATEMENTS - WITH POINTER WS-POINTER - END-STRING - - STRING - 'SRC_ENV_ENVIRONMENT_NAME = "' - DELIMITED BY SIZE - SRC-ENV-ENVIRONMENT-NAME - DELIMITED BY SIZE - '";' - DELIMITED BY SIZE - 'SRC_ENV_STAGE_NAME = "' - DELIMITED BY SIZE - SRC-ENV-STAGE-NAME - DELIMITED BY SIZE - '";' - DELIMITED BY SIZE - 'SRC_ENV_SYSTEM_NAME = "' - DELIMITED BY SIZE - SRC-ENV-SYSTEM-NAME - DELIMITED BY SIZE - '";' - DELIMITED BY SIZE - 'SRC_ENV_SUBSYSTEM_NAME = "' - DELIMITED BY SIZE - SRC-ENV-SUBSYSTEM-NAME - DELIMITED BY SIZE - '";' - DELIMITED BY SIZE - 'SRC_ENV_TYPE_NAME = "' - DELIMITED BY SIZE - SRC-ENV-TYPE-NAME - DELIMITED BY SIZE - '";' - DELIMITED BY SIZE - 'SRC_ENV_ELEMENT_NAME = "' - DELIMITED BY SIZE - SRC-ENV-ELEMENT-NAME - DELIMITED BY SIZE - '";' - DELIMITED BY SIZE - 'SRC_ENV_TYPE_OF_BLOCK = "' - DELIMITED BY SIZE - SRC-ENV-TYPE-OF-BLOCK - DELIMITED BY SIZE - '";' - DELIMITED BY SIZE - 'SRC_ENV_IO_TYPE = "' - DELIMITED BY SIZE - SRC-ENV-IO-TYPE - DELIMITED BY SIZE - '";' - DELIMITED BY SIZE - INTO WS-REXX-STATEMENTS - WITH POINTER WS-POINTER - END-STRING - END-IF . - - IF WS-TRACE = 'Y' THEN - DISPLAY 'C1UEXT02: Stringing TGT vars ' - END-IF . - - IF TGT-ENV-LENGTH GREATER THAN ZERO - STRING - 'TGT_ENV_ENVIRONMENT_NAME = "' - DELIMITED BY SIZE - TGT-ENV-ENVIRONMENT-NAME - DELIMITED BY SIZE - '";' - DELIMITED BY SIZE - 'TGT_ENV_STAGE_NAME = "' - DELIMITED BY SIZE - TGT-ENV-STAGE-NAME - DELIMITED BY SIZE - '";' - DELIMITED BY SIZE - 'TGT_ENV_SYSTEM_NAME = "' - DELIMITED BY SIZE - TGT-ENV-SYSTEM-NAME - DELIMITED BY SIZE - '";' - DELIMITED BY SIZE - 'TGT_ENV_SUBSYSTEM_NAME = "' - DELIMITED BY SIZE - TGT-ENV-SUBSYSTEM-NAME - DELIMITED BY SIZE - '";' - DELIMITED BY SIZE - 'TGT_ENV_TYPE_NAME = "' - DELIMITED BY SIZE - TGT-ENV-TYPE-NAME - DELIMITED BY SIZE - '";' - DELIMITED BY SIZE - 'TGT_ENV_ELEMENT_NAME = "' - DELIMITED BY SIZE - TGT-ENV-ELEMENT-NAME - DELIMITED BY SIZE - '";' - DELIMITED BY SIZE - 'TGT_ENV_TYPE_OF_BLOCK = "' - DELIMITED BY SIZE - TGT-ENV-TYPE-OF-BLOCK - DELIMITED BY SIZE - '";' - DELIMITED BY SIZE - 'TGT_ENV_IO_TYPE = "' - DELIMITED BY SIZE - TGT-ENV-IO-TYPE - DELIMITED BY SIZE - '";' - DELIMITED BY SIZE - 'TGT_ELM_LAST_PROC_PACKAGE = "' - DELIMITED BY SIZE - TGT-ELM-LAST-PROC-PACKAGE - DELIMITED BY SIZE - '";' - DELIMITED BY SIZE - 'TGT_ELM_PROCESSOR_GROUP = "' - DELIMITED BY SIZE - TGT-ELM-PROCESSOR-GROUP - DELIMITED BY SIZE - '";' - DELIMITED BY SIZE - INTO WS-REXX-STATEMENTS - WITH POINTER WS-POINTER - END-STRING - - IF TGT-ENV-TYPE-OF-BLOCK = 'C' - MOVE TGT-ELM-ACTION-CCID TO WS-INSPECT-CCID - INSPECT WS-INSPECT-CCID - REPLACING ALL '"' BY X'7D' - MOVE TGT-ELM-LEVEL-COMMENT TO - WS-INSPECT-COMMENT - INSPECT WS-INSPECT-COMMENT - REPLACING ALL '"' BY X'7D' - - STRING - 'TGT_ELM_ACTION_CCID = "' - DELIMITED BY SIZE - WS-INSPECT-CCID - DELIMITED BY SIZE - '";' - DELIMITED BY SIZE - 'TGT_ELM_LEVEL_COMMENT= "' - DELIMITED BY SIZE - WS-INSPECT-COMMENT - DELIMITED BY SIZE - '";' - DELIMITED BY SIZE - INTO WS-REXX-STATEMENTS - WITH POINTER WS-POINTER - END-STRING - END-IF + *** Under these conditions, force an update of the USER data fiel + IF (ADD-ACTION OR UPDATE-ACTION OR + GENERATE-ACTION OR TRANSFER-ACTION) + AND (TGT-ENV-ENVIRONMENT-NAME(5:4) NOT = 'PROD' ) + MOVE SPACES TO REQ-USER-DATA + STRING + TGT-ENV-ENVIRONMENT-NAME DELIMITED BY SIZE + ' ' DELIMITED BY SIZE + TGT-ENV-SUBSYSTEM-NAME DELIMITED BY SIZE + INTO REQ-USER-DATA(1:20) + END-STRING + MOVE 4 TO ECB-RETURN-CODE +*********** DISPLAY 'C1UEXT02: Userdata='REQ-USER-DATA(1:20) END-IF. - ***** \ Convert COBOL exit block Datanames into Rexx / - ***** - - IF WS-TRACE = 'Y' THEN - DISPLAY 'C1UEXT02: Calling Rexx' + *** If doing a GENERATE in a non-prod environment, then place + *** Environment and Subsystem fields into the 'User Data' + IF GENERATE-ACTION + AND (SRC-ENV-ENVIRONMENT-NAME(5:4) NOT = 'PROD' ) + AND (TGT-ENV-ENVIRONMENT-NAME < 'A') + MOVE SPACES TO REQ-USER-DATA + STRING + SRC-ENV-ENVIRONMENT-NAME DELIMITED BY SIZE + ' ' DELIMITED BY SIZE + SRC-ENV-SUBSYSTEM-NAME DELIMITED BY SIZE + INTO REQ-USER-DATA(1:20) + END-STRING + MOVE 4 TO ECB-RETURN-CODE + **** DISPLAY 'C1UEXT02: Userdata='REQ-USER-DATA(1:20) END-IF. - - *****IF TSO - MOVE 'C1UEXTR2' TO EXECBLK-MEMBER - MOVE 4000 TO ARGSTRING-LENGTH(1) - MOVE SPACES TO ALLOC-TEXT - PERFORM 2100-ALLOCATE-REXFILE - CALL 'SET-ARG1-POINTER' USING ARGUMENT-PTR - ELM-EXECUTE-PARMS-IRXEXEC - PERFORM 1800-REXX-CALL-VIA-IRXEXEC - PERFORM 2200-FREE-REXFILES - *****ELSE - ***** PERFORM 2101-ALLOCATE-SYSEXEC - ***** CALL IRXJCL USING ELM-C1UEXTR2-PARMS-IRXJCL - ***** IF RETURN-CODE NOT = 0 - ***** DISPLAY 'C1UEXT02: BAD CALL TO IRXJCL - RC = ' - ***** RETURN-CODE - ***** END-IF - ***** PERFORM 2201-FREE-SYSEXEC - *****END-IF . - - MOVE 0 TO RETURN-CODE . - - GOBACK. - - 1800-REXX-CALL-VIA-IRXEXEC. - SET ARGSTRING-PTR (1) TO ARGUMENT-PTR . - CALL 'SET-ARGUMENT-POINTER' USING ARGTABLE-PTR - ARGUMENT . - CALL 'SET-EXECBLK-POINTER' USING EXECBLK-PTR - EXECBLK . - CALL 'SET-EVALBLK-POINTER' USING EVALBLK-PTR - EVALBLK . - MOVE 536870912 TO FLAGS - MOVE 0 TO REXX-RETURN-CODE . - - *--- CALL THE REXX EXEC --- - CALL IRXEXEC-PGM USING EXECBLK-PTR - ARGTABLE-PTR - FLAGS - DUMMY-ZERO - DUMMY-ZERO - EVALBLK-PTR - DUMMY-ZERO - DUMMY-ZERO - DUMMY-ZERO - REXX-RETURN-CODE. - - IF REXX-RETURN-CODE NOT = 0 - DISPLAY 'C1UEXT02: IRXEXEC RETURN CODE = ' - REXX-RETURN-CODE - END-IF - - CANCEL IRXEXEC-PGM - . - - ***************************************************************** - ** Allocate DD REXFILE for TSO processing - ***************************************************************** - 2100-ALLOCATE-REXFILE. - - MOVE SPACES TO ALLOC-TEXT . - STRING 'ALLOC DD(REXFILE2) ', - 'DA(YOURSITE.NDVR.REXX)' - DELIMITED BY SIZE - ' SHR REUSE' - DELIMITED BY SIZE - INTO ALLOC-TEXT - END-STRING. - PERFORM 9000-DYNAMIC-ALLOC-DEALLOC . - - ***************************************************************** - ** Allocate DD SYSEXEC for batch processing - ***************************************************************** - 2101-ALLOCATE-SYSEXEC. - - MOVE SPACES TO ALLOC-TEXT . - STRING 'ALLOC DD(SYSEXEC) ', - 'DA(YOURSITE.NDVR.REXX)' - DELIMITED BY SIZE - ' SHR REUSE' - DELIMITED BY SIZE - INTO ALLOC-TEXT - END-STRING. - PERFORM 9000-DYNAMIC-ALLOC-DEALLOC . - - ***************************************************************** - ** DYNAMICALLY DE-ALLOCATE UNNEEDED REXX FILES - ***************************************************************** - 2200-FREE-REXFILES. - - MOVE 'FREE DD(REXFILE2)' TO ALLOC-TEXT - PERFORM 9000-DYNAMIC-ALLOC-DEALLOC . - - ***************************************************************** - ** CALL BPXWDYN TO PREFORM REQUIRED REXX FUNCTIONS - 2201-FREE-SYSEXEC. - - MOVE 'FREE DD(SYSEXEC)' TO ALLOC-TEXT - PERFORM 9000-DYNAMIC-ALLOC-DEALLOC . - - ***************************************************************** - ** CALL BPXWDYN TO PREFORM REQUIRED REXX FUNCTIONS - 9000-DYNAMIC-ALLOC-DEALLOC. - - CALL BPXWDYN USING ALLOC-STRING - - IF RETURN-CODE NOT = ZERO OR - WS-TRACE = 'Y' THEN - DISPLAY 'C1UEXT02: ALLOCATION result: RETURN CODE = ' - RETURN-CODE - DISPLAY ALLOC-TEXT - END-IF - - MOVE SPACES TO ALLOC-TEXT - . - - - ****************************************************************** - * BEGIN NESTED PROGRAMS USED TO SET THE POINTERS OF DATA AREAS - * THAT ARE BEING PASSED TO IRXEXEC SO THAT A REXX ROUTINE CAN - * PASS DATA (OTHER THAN A RETURN CODE) BACK TO A COBOL PROGRAM. - ****************************************************************** - - ******** SET-ARG1-POINTER ******** - IDENTIFICATION DIVISION. - PROGRAM-ID. SET-ARG1-POINTER. - ENVIRONMENT DIVISION. - DATA DIVISION. - WORKING-STORAGE SECTION. - LINKAGE SECTION. - 77 ARG-PTR POINTER. - 77 ARG1 PIC X(16). - - PROCEDURE DIVISION USING ARG-PTR - ARG1. - SET ARG-PTR TO ADDRESS OF ARG1 - GOBACK. - END PROGRAM SET-ARG1-POINTER. - - ******** SET-ARGUMENT-POINTER ******** - IDENTIFICATION DIVISION. - PROGRAM-ID. SET-ARGUMENT-POINTER. - ENVIRONMENT DIVISION. - DATA DIVISION. - WORKING-STORAGE SECTION. - LINKAGE SECTION. - 77 ARGTABLE-PTR POINTER. - 01 ARGUMENT. - 02 ARGUMENT-1 OCCURS 1 TIMES. - 05 ARGSTRING-PTR POINTER. - 05 ARGSTRING-LENGTH PIC S9(8) BINARY. - 02 ARGSTRING-LAST1 PIC S9(8) BINARY. - 02 ARGSTRING-LAST2 PIC S9(8) BINARY. - PROCEDURE DIVISION USING ARGTABLE-PTR - ARGUMENT. - SET ARGTABLE-PTR TO ADDRESS OF ARGUMENT - GOBACK. - END PROGRAM SET-ARGUMENT-POINTER. - - ******** SET-EXECBLK-POINTER ******** - IDENTIFICATION DIVISION. - PROGRAM-ID. SET-EXECBLK-POINTER. - ENVIRONMENT DIVISION. - DATA DIVISION. - WORKING-STORAGE SECTION. - LINKAGE SECTION. - 77 EXECBLK-PTR POINTER. - 01 EXECBLK. - 03 EXECBLK-ACRYN PIC X(8). - 03 EXECBLK-LENGTH PIC 9(4) COMP. - 03 EXECBLK-RESERVED PIC 9(4) COMP. - 03 EXECBLK-MEMBER PIC X(8). - 03 EXECBLK-DDNAME PIC X(8). - 03 EXECBLK-SUBCOM PIC X(8). - 03 EXECBLK-DSNPTR POINTER. - 03 EXECBLK-DSNLEN PIC 9(4) COMP. - PROCEDURE DIVISION USING EXECBLK-PTR - EXECBLK. - SET EXECBLK-PTR TO ADDRESS OF EXECBLK - GOBACK. - END PROGRAM SET-EXECBLK-POINTER. - - ******** SET-EVALBLK-POINTER ******** - IDENTIFICATION DIVISION. - PROGRAM-ID. SET-EVALBLK-POINTER. - ENVIRONMENT DIVISION. - DATA DIVISION. - WORKING-STORAGE SECTION. - LINKAGE SECTION. - 77 EVALBLK-PTR POINTER. - 01 EVALBLK. - 03 EVALBLK-EVPAD1 PIC 9(4) COMP. - 03 EVALBLK-EVSIZE PIC 9(4) COMP. - 03 EVALBLK-EVLEN PIC 9(4) COMP. - 03 EVALBLK-EVPAD2 PIC 9(4) COMP. - 03 EVALBLK-EVDATA PIC X(256). - PROCEDURE DIVISION USING EVALBLK-PTR - EVALBLK. - SET EVALBLK-PTR TO ADDRESS OF EVALBLK +****************************************************************** +******* IF MOVE, BUT NOT TO PROD, THEN RETAIN SIGNOUT * +******* ALSO, CHECK FOR COLLISION: * +******* - ONE SIGNOUT TO OVERLAY ANOTHER * +****************************************************************** + MOVE 1 TO WS-TALLY. + IF MOVE-ACTION AND + TGT-ENV-ENVIRONMENT-NAME NOT = 'SMPLPROD' + MOVE 'Y' TO REQ-RETAIN-SIGNOUT-OPT + MOVE 4 TO ECB-RETURN-CODE +****** IF ECB-USER-ID(1:7) = 'ibmuser' +****** DISPLAY 'Collision checking' +****** DISPLAY 'TGT-ENV-ENVIRONMENT-NAME=' +****** TGT-ENV-ENVIRONMENT-NAME +****** DISPLAY 'SRC-ELM-SIGNOUT-ID=' +****** SRC-ELM-SIGNOUT-ID +****** DISPLAY 'TGT-ELM-SIGNOUT-ID=' +****** TGT-ELM-SIGNOUT-ID +****** END-IF + IF TGT-INTERNAL-C1-BLOCK + MOVE TGT-ELM-SIGNOUT-ID TO WS-WORKING-KEYWORD(1:8) + PERFORM VARYING WS-TALLY FROM 1 BY 1 + UNTIL WS-TALLY > 7 + IF WS-WORKING-KEYWORD(WS-TALLY:1) < ' ' + MOVE SPACES TO WS-WORKING-KEYWORD + MOVE 8 TO WS-TALLY + END-IF + END-PERFORM +****** IF ECB-USER-ID(1:7) = 'Ibmuser' +****** DISPLAY 'SRC-ELM-SIGNOUT-ID=' +****** SRC-ELM-SIGNOUT-ID +****** DISPLAY 'WS-WORKING-KEYWORD=' +****** WS-WORKING-KEYWORD +****** END-IF + IF WS-WORKING-KEYWORD NOT = SPACES AND + (SRC-ELM-SIGNOUT-ID NOT = TGT-ELM-SIGNOUT-ID) + MOVE 8 TO ECB-RETURN-CODE + MOVE '0011' TO ECB-MESSAGE-CODE + MOVE 132 TO ECB-MESSAGE-LENGTH + MOVE '***COLLISION - ATTEMPTING TO OVERLAY ELM***' + TO ECB-MESSAGE-TEXT + GOBACK + END-IF + END-IF + END-IF. +****************************************************************** +******* IF CCID OR COMMENT IS BLANK, REUSE LAST ONE * +******* * +******* COMMENT/CCID MAY BE PULLED FROM THE LAST ONE SPECIFIED * +******* WITH ENDEVOR. * +******* * +******* COMMENT/CCID ARE REQUIRED ON AN ADD. * +****************************************************************** +******* +******* MOVE 'ASSIGNED DATA BY C1UEXT02' TO +******* REQ-USER-DATA . + IF NOT (RETRIEVE-ACTION AND RETRIEVE-COPY-ONLY) + PERFORM 0200-REUSE-CCID-AND-COMMENT. +******* DISPLAY 'C1UEXT02: EXITING PROGRAM ' . GOBACK. - END PROGRAM SET-EVALBLK-POINTER. - *--- END OF MAIN PROGRAM - END PROGRAM C1UEXT02. + 0200-REUSE-CCID-AND-COMMENT. + ******* If the user leaves blank the CCID and/or COMMENT + ******* then we can use a previously stated value +****** IF ECB-USER-ID(1:7) = 'Ibmuser' +****** DISPLAY 'C1UEXT02: ' +****** 'REQ-CCID = ' REQ-CCID . + IF REQ-CCID = ALL SPACES + IF NOT ADD-ACTION AND + NOT GEN-COPYBACK AND + SRC-INTERNAL-C1-BLOCK + ****** If any chars of the CCID are hex, space fill + MOVE SRC-ELM-ACTION-CCID TO WS-WORKING-KEYWORD + INSPECT WS-WORKING-KEYWORD REPLACING + ALL LOW-VALUES BY SPACES + PERFORM VARYING WS-TALLY FROM 1 BY 1 + UNTIL WS-TALLY > 11 + IF WS-WORKING-KEYWORD(WS-TALLY:1) < ' ' + MOVE SPACES TO WS-WORKING-KEYWORD + MOVE 12 TO WS-TALLY + END-IF + END-PERFORM +****** IF ECB-USER-ID(1:7) = 'Ibmuser' +****** DISPLAY 'C1UEXT02: Examining SRC CCID ' +****** DISPLAY 'C1UEXT02: ' +****** 'SRC-ELM-ACTION-CCID=' SRC-ELM-ACTION-CCID +****** 'WS-WORKING-KEYWORD=' WS-WORKING-KEYWORD +****** END-IF + ****** If the CCID is good, we can re-use it + IF WS-WORKING-KEYWORD NOT = ALL SPACES + MOVE SRC-ELM-ACTION-CCID TO REQ-CCID + MOVE 4 TO ECB-RETURN-CODE +****** IF ECB-USER-ID(1:7) = 'Ibmuser' +****** DISPLAY 'C1UEXT02: ' +****** 'REQ-CCID COPIED FROM SRC-ELM-ACTION-CCID' +****** DISPLAY 'C1UEXT02: REQ-CCID NOW ' REQ-CCID +****** END-IF + END-IF + END-IF. + ****** If the CCID is still blank, consider the TGT...CCID + IF REQ-CCID = ALL SPACES AND + TGT-INTERNAL-C1-BLOCK AND + NOT GEN-COPYBACK AND + (TGT-ENV-ELEMENT-LEVEL > 0 OR NOT ADD-ACTION) + MOVE TGT-ELM-ACTION-CCID TO WS-WORKING-KEYWORD + INSPECT WS-WORKING-KEYWORD REPLACING + ALL LOW-VALUES BY SPACES + PERFORM VARYING WS-TALLY FROM 1 BY 1 + UNTIL WS-TALLY > 11 + IF WS-WORKING-KEYWORD(WS-TALLY:1) < ' ' + MOVE SPACES TO WS-WORKING-KEYWORD + MOVE 12 TO WS-TALLY + END-IF + END-PERFORM +****** IF ECB-USER-ID(1:7) = 'Ibmuser' +****** DISPLAY 'C1UEXT02: Examining TGT CCID ' +****** DISPLAY 'C1UEXT02: ' +****** 'TGT-ELM-ACTION-CCID=' TGT-ELM-ACTION-CCID +****** 'WS-WORKING-KEYWORD=' WS-WORKING-KEYWORD +****** END-IF + ****** If the CCID is good, we can re-use it + IF WS-WORKING-KEYWORD NOT = ALL SPACES + MOVE TGT-ELM-ACTION-CCID TO REQ-CCID + MOVE 4 TO ECB-RETURN-CODE +****** IF ECB-USER-ID(1:7) = 'Ibmuser' +****** DISPLAY 'C1UEXT02: ' +****** 'REQ-CCID COPIED FROM TGT-ELM-ACTION-CCID' +****** DISPLAY 'C1UEXT02: REQ-CCID NOW ' REQ-CCID +****** END-IF + END-IF. + ****** If the CCID is still blank, we have an error + IF REQ-CCID = ALL SPACES +****** IF ECB-USER-ID(1:7) = 'Ibmuser' +****** DISPLAY 'C1UEXT02: ' +****** 'CAUSING FAILURE ' +****** END-IF + MOVE 8 TO ECB-RETURN-CODE + MOVE '0011' TO ECB-MESSAGE-CODE + MOVE 132 TO ECB-MESSAGE-LENGTH + MOVE '***CCID AND COMMENT ARE REQUIRED***' + TO ECB-MESSAGE-TEXT + GOBACK + . + **** Now reuse COMMENT if appropriatae + IF REQ-COMMENT = ALL SPACES AND + SRC-INTERNAL-C1-BLOCK AND + NOT ADD-ACTION AND + NOT UPDATE-ACTION AND + NOT GEN-COPYBACK AND + ECB-RETURN-CODE < 8 + ****** If any chars of the COMMENT are hex, space fill +****** IF ECB-USER-ID(1:7) = 'Ibmuser' +****** DISPLAY 'C1UEXT02: Examining SRC COMMENT ' +****** END-IF + MOVE SRC-ELM-PROCESSOR-LAST-COMMENT + TO WS-WORKING-COMMENT + INSPECT WS-WORKING-COMMENT REPLACING + ALL LOW-VALUES BY SPACES + PERFORM VARYING WS-TALLY FROM 1 BY 1 + UNTIL WS-TALLY > 39 + IF WS-WORKING-COMMENT(WS-TALLY:1) < ' ' + MOVE SPACES TO WS-WORKING-COMMENT + MOVE 40 TO WS-TALLY + END-IF + END-PERFORM + IF WS-WORKING-COMMENT NOT = ALL SPACES + MOVE SRC-ELM-PROCESSOR-LAST-COMMENT TO REQ-COMMENT + MOVE 4 TO ECB-RETURN-CODE +******* DISPLAY 'C1UEXT02: ' +******* 'REQ-COMMENT COPIED FROM SRC-ELM-PROCESSOR-LAST-COMMENT' +******* DISPLAY 'C1UEXT02: REQ-COMMENT NOW ' REQ-COMMENT + END-IF. + ****** If COMMENT is still blank, consider the TGT...COMMENT + IF REQ-COMMENT = ALL SPACES AND + TGT-INTERNAL-C1-BLOCK AND + NOT GEN-COPYBACK AND + (TGT-ENV-ELEMENT-LEVEL > 0 OR NOT ADD-ACTION) +****** IF ECB-USER-ID(1:7) = 'Ibmuser' +****** DISPLAY 'C1UEXT02: Examining TGT COMMENT ' +****** END-IF + MOVE TGT-ELM-PROCESSOR-LAST-COMMENT + TO WS-WORKING-COMMENT + INSPECT WS-WORKING-COMMENT REPLACING + ALL LOW-VALUES BY SPACES + PERFORM VARYING WS-TALLY FROM 1 BY 1 + UNTIL WS-TALLY > 39 + IF WS-WORKING-COMMENT(WS-TALLY:1) < ' ' + MOVE SPACES TO WS-WORKING-COMMENT + MOVE 40 TO WS-TALLY + END-IF + END-PERFORM + IF WS-WORKING-COMMENT NOT = ALL SPACES + MOVE TGT-ELM-PROCESSOR-LAST-COMMENT TO REQ-COMMENT + MOVE 4 TO ECB-RETURN-CODE +******* DISPLAY 'C1UEXT02: ' +******* 'REQ-COMMENT COPIED FROM TGT-ELM-PROCESSOR-LAST-COMMENT' +******* DISPLAY 'C1UEXT02: REQ-COMMENT NOW ' REQ-COMMENT + END-IF. + ****** If COMMENT is still blank, consider the TGT...COMMENT + IF REQ-COMMENT = ALL SPACES + MOVE 8 TO ECB-RETURN-CODE + MOVE '0011' TO ECB-MESSAGE-CODE + MOVE 132 TO ECB-MESSAGE-LENGTH + MOVE '***CCID AND COMMENT ARE REQUIRED***' + TO ECB-MESSAGE-TEXT + . + 0699-EXIT. + EXIT. + 999-EXIT . diff --git a/endevor/Field-Developed-Programs/Exit-Examples/C1UEXT03 Processor Reporting via Exit3.cob b/endevor/Field-Developed-Programs/Exit-Examples/C1UEXT02 With RexDriver.cob similarity index 75% rename from endevor/Field-Developed-Programs/Exit-Examples/C1UEXT03 Processor Reporting via Exit3.cob rename to endevor/Field-Developed-Programs/Exit-Examples/C1UEXT02 With RexDriver.cob index e85215e..fe8cf0e 100644 --- a/endevor/Field-Developed-Programs/Exit-Examples/C1UEXT03 Processor Reporting via Exit3.cob +++ b/endevor/Field-Developed-Programs/Exit-Examples/C1UEXT02 With RexDriver.cob @@ -1,21 +1,14 @@ PROCESS DYNAM OUTDD(DISPLAYS) - IDENTIFICATION DIVISION. - PROGRAM-ID. C1UEXT03. - DATE-COMPILED. - DATE-WRITTEN. - ENVIRONMENT DIVISION. - CONFIGURATION SECTION. - SOURCE-COMPUTER. IBM-370. - OBJECT-COMPUTER. IBM-370. ***************************************************************** - * DESCRIPTION: THIS PGM IS CALLED after Element processing * + * https://github.com/BroadcomMFD/broadcom-product-scripts + * DESCRIPTION: C1UEXT02 is called before Element processing. * * It gathers Endevor info from the exit blocks * - * then calls REXX program C1UEXTR3. * + * then calls REXX program C1UEXTR2. * * * - * SETUP: The REXX C1UEXTR3 gets called from DD REXFILE. * + * SETUP: The REXX C1UEXTR2 gets called from DD REXFILE2. * * Change the DSN to a secure dataset.(2 places) * * * - * STRING 'ALLOC DD(REXFILE) ', <--look for REXFILE/SYSEXEC * + * STRING 'ALLOC DD(REXFILE2) ', <--look for REXFILE2/SYSEXEC * * 'DA(ESS.ENDEVOR.EXIT.REXX)' <----- here * * DELIMITED BY SIZE * * ' SHR REUSE' * @@ -23,74 +16,82 @@ * INTO ALLOC-TEXT * * END-STRING. * * * - * * + * Change the .REXX dataset name to the name of your dataset * + * that contains your C1UEXTR2 Rexx program. * + ***************************************************************** + ** see also EAGGXCOB for Calling IRXEXEC - the IBM example * + ** for calling IRXEXEC from a Cobol program * + ***************************************************************** + IDENTIFICATION DIVISION. + PROGRAM-ID. C1UEXT02. + DATE-COMPILED. + DATE-WRITTEN. + ENVIRONMENT DIVISION. + CONFIGURATION SECTION. + SOURCE-COMPUTER. IBM-370. + OBJECT-COMPUTER. IBM-370. * * ***************************************************************** INPUT-OUTPUT SECTION. FILE-CONTROL. DATA DIVISION. FILE SECTION. - ***************************************************************** * W O R K I N G S T O R A G E * ***************************************************************** WORKING-STORAGE SECTION. - + 77 WS-TRACE PIC X VALUE 'N'. 77 FLAGS PIC S9(8) BINARY. 77 REXX-RETURN-CODE PIC S9(8) BINARY. - 77 RETURN-CODE-FOR-DISPLAY PIC 9(10). 77 DUMMY-ZERO PIC S9(8) BINARY VALUE 0. 77 ARGUMENT-PTR POINTER. 77 EXECBLK-PTR POINTER. 77 ARGTABLE-PTR POINTER. 77 EVALBLK-PTR POINTER. - 01 IRXJCL PIC X(6) VALUE 'IRXJCL'. 01 IRXEXEC-PGM PIC X(08) VALUE 'IRXEXEC'. - 01 WS-VARIABLES. - 03 WS-POINTER PIC 9(8) COMP. - 03 WS-WORK-ADDRESS-ADR PIC S9(8) COMP SYNC . - 03 WS-WORK-ADDRESS-PTR REDEFINES WS-WORK-ADDRESS-ADR + 03 WS-POINTER PIC 9(8) COMP. + 03 WS-WORK-ADDRESS-ADR PIC S9(8) COMP SYNC . + 03 WS-WORK-ADDRESS-PTR REDEFINES WS-WORK-ADDRESS-ADR USAGE IS POINTER . - 03 ADDRESS-ECB-RETURN-CODE PIC 9(10) . - 03 ADDRESS-ECB-MESSAGE-CODE PIC 9(10) . - 03 ADDRESS-ECB-MESSAGE-LENGTH PIC 9(10) . - 03 ADDRESS-ECB-MESSAGE-TEXT PIC 9(10) . - 03 ADDRESS-REQ-SISO-INDICATOR PIC 9(10) . - - 03 WS-INSPECT-CCID PIC X(12) . - 03 WS-INSPECT-COMMENT PIC X(40) . - + 03 ADDRESS-ECB-RETURN-CODE PIC 9(10) . + 03 ADDRESS-ECB-MESSAGE-CODE PIC 9(10) . + 03 ADDRESS-ECB-MESSAGE-LENGTH PIC 9(10) . + 03 ADDRESS-ECB-MESSAGE-TEXT PIC 9(10) . + 03 ADDRESS-REQ-SISO-INDICATOR PIC 9(10) . + 03 ADDRESS-REQ-CCID PIC 9(10) . + 03 ADDRESS-REQ-COMMENT PIC 9(10) . + 03 ADDRESS-REQ-USER-DATA PIC 9(10) . + 03 ADDRESS-REQ-ALTER-WITH-UPDATE PIC 9(10) . + 03 WS-INSPECT-CCID PIC X(12) . + 03 WS-INSPECT-COMMENT PIC X(40) . 01 BPXWDYN PIC X(8) VALUE 'BPXWDYN'. 01 ALLOC-STRING. 05 ALLOC-LENGTH PIC S9(4) BINARY VALUE 100. 05 ALLOC-TEXT PIC X(100). - - * The block of data below is passed to the REXX program C1UEXTR3 + * The block of data below is passed to the REXX program C1UEXTR2 * to ensure new elements are Registered. - * The bulk of the logic is found in C1UEXTR3 - 01 ELM-C1UEXTR3-PARMS-IRXJCL. + * The bulk of the logic is found in C1UEXTR2 + 01 ELM-C1UEXTR2-PARMS-IRXJCL. 02 ELM-EXECUTE-PARMS-IRXJCL-TOP. - 03 PARM-LENGTH PIC X(02) VALUE X'0711'. - 03 REXX-NAME PIC X(08) VALUE 'C1UEXTR3'. + 03 PARM-LENGTH PIC X(02) VALUE X'0FA9'. 00004500 + 03 REXX-NAME PIC X(08) VALUE 'C1UEXTR2'. 03 FILLER PIC X(01) VALUE SPACE . - 02 ELM-EXECUTE-PARMS-IRXEXEC. - 03 WS-REXX-STATEMENTS PIC X(2000). - + 02 ELM-EXECUTE-PARMS-IRXEXEC. 00004800 + 03 WS-REXX-STATEMENTS PIC X(4000). 01 EXECBLK. 05 EXECBLK-ACRYN PIC X(08) VALUE 'IRXEXECB'. 05 EXECBLK-LENGTH PIC S9(8) BINARY VALUE 48. 05 EXECBLK-RESERVED PIC S9(8) BINARY VALUE 0. - 05 EXECBLK-MEMBER PIC X(08) VALUE 'C1UEXTR3'. - 05 EXECBLK-DDNAME PIC X(08) VALUE 'REXFILE '. + 05 EXECBLK-MEMBER PIC X(08) VALUE 'C1UEXTR2'. + 05 EXECBLK-DDNAME PIC X(08) VALUE 'REXFILE2'. 05 EXECBLK-SUBCOM PIC X(08) VALUE SPACES. 05 EXECBLK-DSNPTR POINTER VALUE NULL. 05 EXECBLK-DSNLEN PIC 9(04) COMP VALUE 0. - 01 EVALBLK. 05 EVALBLK-EVPAD1 PIC S9(8) BINARY VALUE 0. @@ -101,7 +102,6 @@ 05 EVALBLK-EVPAD2 PIC S9(8) BINARY VALUE 0. 05 EVALBLK-EVDATA PIC X(256). - 01 ARGUMENT. 02 ARGUMENT-1 OCCURS 1 TIMES. 05 ARGSTRING-PTR POINTER. @@ -110,13 +110,10 @@ VALUE -1. 02 ARGSTRING-LAST2 PIC S9(8) BINARY VALUE -1. - - *----------------------------------------------------------------- LINKAGE SECTION. *----------------------------------------------------------------- COPY EXITBLKS. - PROCEDURE DIVISION USING EXIT-CONTROL-BLOCK REQUEST-INFO-BLOCK @@ -126,38 +123,63 @@ TGT-ENVIRONMENT-BLOCK TGT-ELEMENT-MASTER-INFO-BLOCK TGT-FILE-CONTROL-BLOCK. - + IF WS-TRACE = 'Y' THEN + DISPLAY 'C1UEXT02: RETURN-CODE =' RETURN-CODE . + IF WS-TRACE = 'Y' THEN + DISPLAY 'C1UEXT02: Entered' + ' SRC-ENV-TYPE-OF-BLOCK=' SRC-ENV-TYPE-OF-BLOCK + ' TGT-ENV-TYPE-OF-BLOCK=' TGT-ENV-TYPE-OF-BLOCK + DISPLAY 'C1UEXT02: ' + ' SRC-ENV-IO-TYPE=' SRC-ENV-IO-TYPE + ' TGT-ENV-IO-TYPE=' TGT-ENV-IO-TYPE + END-IF. + IF PACKAGE-INSPECT THEN GOBACK. MOVE SPACES TO WS-REXX-STATEMENTS . - + IF WS-TRACE = 'Y' THEN + DISPLAY 'C1UEXT02: Setting up addresses ' . SET WS-WORK-ADDRESS-PTR TO ADDRESS OF ECB-RETURN-CODE . MOVE WS-WORK-ADDRESS-ADR TO ADDRESS-ECB-RETURN-CODE . - SET WS-WORK-ADDRESS-PTR TO ADDRESS OF ECB-MESSAGE-CODE. MOVE WS-WORK-ADDRESS-ADR TO ADDRESS-ECB-MESSAGE-CODE. - SET WS-WORK-ADDRESS-PTR TO ADDRESS OF ECB-MESSAGE-LENGTH. MOVE WS-WORK-ADDRESS-ADR TO ADDRESS-ECB-MESSAGE-LENGTH . - SET WS-WORK-ADDRESS-PTR TO ADDRESS OF ECB-MESSAGE-TEXT . MOVE WS-WORK-ADDRESS-ADR TO ADDRESS-ECB-MESSAGE-TEXT . - + SET WS-WORK-ADDRESS-PTR TO + ADDRESS OF REQ-CCID . + MOVE WS-WORK-ADDRESS-ADR + TO ADDRESS-REQ-CCID . + SET WS-WORK-ADDRESS-PTR TO + ADDRESS OF REQ-COMMENT . + MOVE WS-WORK-ADDRESS-ADR + TO ADDRESS-REQ-COMMENT . + SET WS-WORK-ADDRESS-PTR TO + ADDRESS OF REQ-USER-DATA . + MOVE WS-WORK-ADDRESS-ADR + TO ADDRESS-REQ-USER-DATA . + SET WS-WORK-ADDRESS-PTR TO + ADDRESS OF REQ-ALTER-WITH-UPDATE . + MOVE WS-WORK-ADDRESS-ADR + TO ADDRESS-REQ-ALTER-WITH-UPDATE . ***** ***** / Convert COBOL exit block Datanames into Rexx \ ***** ***** + IF WS-TRACE = 'Y' THEN + DISPLAY 'C1UEXT02: removing quote chars ' . MOVE 1 TO WS-POINTER. - INSPECT REQ-CCID REPLACING ALL '"' BY X'7D'. INSPECT REQ-COMMENT REPLACING ALL '"' BY X'7D'. - + IF WS-TRACE = 'Y' THEN + DISPLAY 'C1UEXT02: Stringing ECB vars ' . STRING 'ECB_TSO_BATCH_MODE = "' DELIMITED BY SIZE @@ -183,17 +205,35 @@ DELIMITED BY SIZE '";' DELIMITED BY SIZE + 'Address_REQ_CCID = ' + DELIMITED BY SIZE + ADDRESS-REQ-CCID + DELIMITED BY SIZE + ';' + DELIMITED BY SIZE + 'Address_REQ_USER_DATA = ' + DELIMITED BY SIZE + ADDRESS-REQ-USER-DATA + DELIMITED BY SIZE + ';' + DELIMITED BY SIZE + 'Address_REQ_ALTER_WITH_UPDATE = ' + DELIMITED BY SIZE + ADDRESS-REQ-ALTER-WITH-UPDATE + DELIMITED BY SIZE + ';' + DELIMITED BY SIZE 'REQ_COMMENT = "' DELIMITED BY SIZE REQ-COMMENT DELIMITED BY SIZE '";' DELIMITED BY SIZE - 'REQ_USER_DATA = "' + 'Address_REQ_COMMENT = ' DELIMITED BY SIZE - REQ-USER-DATA + ADDRESS-REQ-COMMENT DELIMITED BY SIZE - '";' + ';' DELIMITED BY SIZE 'REQ_SISO_INDICATOR = "' DELIMITED BY SIZE @@ -249,90 +289,31 @@ DELIMITED BY SIZE '";' DELIMITED BY SIZE - 'TGT_ELM_LAST_PROC_PACKAGE = "' - DELIMITED BY SIZE - TGT-ELM-LAST-PROC-PACKAGE - DELIMITED BY SIZE - '";' - DELIMITED BY SIZE - 'TGT_ELM_PROCESSOR_GROUP = "' - DELIMITED BY SIZE - TGT-ELM-PROCESSOR-GROUP - DELIMITED BY SIZE - '";' - DELIMITED BY SIZE - 'SRC_ELM_LAST_PROC_PACKAGE = "' - DELIMITED BY SIZE - SRC-ELM-LAST-PROC-PACKAGE - DELIMITED BY SIZE - '";' - DELIMITED BY SIZE - 'SRC_ELM_PROCESSOR_GROUP = "' - DELIMITED BY SIZE - SRC-ELM-PROCESSOR-GROUP - DELIMITED BY SIZE - '";' - DELIMITED BY SIZE - 'SRC_ELM_PROCESSOR_NAME = "' - DELIMITED BY SIZE - SRC-ELM-PROCESSOR-NAME - DELIMITED BY SIZE - '";' - DELIMITED BY SIZE - 'SRC_ELM_PROCESSOR_LAST_DATE = "' - DELIMITED BY SIZE - SRC-ELM-PROCESSOR-LAST-DATE - DELIMITED BY SIZE - '";' - DELIMITED BY SIZE - 'TGT_ELM_PROCESSOR_NAME = "' - DELIMITED BY SIZE - TGT-ELM-PROCESSOR-NAME - DELIMITED BY SIZE - '";' - DELIMITED BY SIZE - 'TGT_ELM_PROCESSOR_LAST_DATE = "' - DELIMITED BY SIZE - TGT-ELM-PROCESSOR-LAST-DATE - DELIMITED BY SIZE - '";' - DELIMITED BY SIZE - INTO WS-REXX-STATEMENTS - WITH POINTER WS-POINTER . - - MOVE REQ-ACTION-RC TO RETURN-CODE-FOR-DISPLAY. - STRING - 'REQ_ACTION_RC = ' - DELIMITED BY SIZE - RETURN-CODE-FOR-DISPLAY + 'Address_ECB_RETURN_CODE = ' ADDRESS-ECB-RETURN-CODE DELIMITED BY SIZE - ';' + '; ' DELIMITED BY SIZE - INTO WS-REXX-STATEMENTS - WITH POINTER WS-POINTER . - MOVE ECB-HIGH-RC TO RETURN-CODE-FOR-DISPLAY. - STRING - 'ECB_HIGH_RC = ' + 'Address_ECB_MESSAGE_CODE = ' ADDRESS-ECB-MESSAGE-CODE DELIMITED BY SIZE - RETURN-CODE-FOR-DISPLAY + '; ' DELIMITED BY SIZE - ';' + 'Address_ECB_MESSAGE_LENGTH = ' + ADDRESS-ECB-MESSAGE-LENGTH DELIMITED BY SIZE - INTO WS-REXX-STATEMENTS - WITH POINTER WS-POINTER . - - IF SRC-ENV-TYPE-OF-BLOCK = 'E' - MOVE SRC-ELM-PROCESSOR-RC TO RETURN-CODE-FOR-DISPLAY - STRING - 'SRC_ELM_PROCESSOR_RC = ' + '; ' DELIMITED BY SIZE - RETURN-CODE-FOR-DISPLAY + 'Address_ECB_MESSAGE_TEXT = ' + ADDRESS-ECB-MESSAGE-TEXT DELIMITED BY SIZE - ';' + '; ' DELIMITED BY SIZE INTO WS-REXX-STATEMENTS WITH POINTER WS-POINTER - END-STRING + END-STRING. + IF WS-TRACE = 'Y' THEN + DISPLAY 'C1UEXT02: Stringing SRC vars ' + 'SRC-ENV-IO-TYPE=' SRC-ENV-IO-TYPE . + IF SRC-ENV-LENGTH GREATER THAN ZERO MOVE SRC-ELM-ACTION-CCID TO WS-INSPECT-CCID INSPECT WS-INSPECT-CCID REPLACING ALL '"' BY X'7D' @@ -340,7 +321,8 @@ WS-INSPECT-COMMENT INSPECT WS-INSPECT-COMMENT REPLACING ALL '"' BY X'7D' - + INSPECT WS-INSPECT-CCID REPLACING ALL '"' BY X'7D' + INSPECT WS-INSPECT-COMMENT REPLACING ALL '"' BY X'7D' STRING 'SRC_ELM_ACTION_CCID = "' DELIMITED BY SIZE @@ -354,9 +336,21 @@ DELIMITED BY SIZE '";' DELIMITED BY SIZE + 'SRC_ELM_LAST_PROC_PACKAGE = "' + DELIMITED BY SIZE + SRC-ELM-LAST-PROC-PACKAGE + DELIMITED BY SIZE + '";' + DELIMITED BY SIZE + 'SRC_ELM_PROCESSOR_GROUP = "' + DELIMITED BY SIZE + SRC-ELM-PROCESSOR-GROUP + DELIMITED BY SIZE + '";' + DELIMITED BY SIZE INTO WS-REXX-STATEMENTS WITH POINTER WS-POINTER - END-STRING . + END-STRING STRING 'SRC_ENV_ENVIRONMENT_NAME = "' DELIMITED BY SIZE @@ -394,6 +388,12 @@ DELIMITED BY SIZE '";' DELIMITED BY SIZE + 'SRC_ENV_USER_DATA = "' + DELIMITED BY SIZE + SRC-ELM-USER-DATA + DELIMITED BY SIZE + '";' + DELIMITED BY SIZE 'SRC_ENV_TYPE_OF_BLOCK = "' DELIMITED BY SIZE SRC-ENV-TYPE-OF-BLOCK @@ -408,7 +408,12 @@ DELIMITED BY SIZE INTO WS-REXX-STATEMENTS WITH POINTER WS-POINTER - END-STRING . + END-STRING + END-IF . + IF WS-TRACE = 'Y' THEN + DISPLAY 'C1UEXT02: Stringing TGT vars ' + END-IF . + IF TGT-ENV-LENGTH GREATER THAN ZERO STRING 'TGT_ENV_ENVIRONMENT_NAME = "' DELIMITED BY SIZE @@ -446,6 +451,12 @@ DELIMITED BY SIZE '";' DELIMITED BY SIZE + 'TGT_ENV_USER_DATA = "' + DELIMITED BY SIZE + TGT-ELM-USER-DATA + DELIMITED BY SIZE + '";' + DELIMITED BY SIZE 'TGT_ENV_TYPE_OF_BLOCK = "' DELIMITED BY SIZE TGT-ENV-TYPE-OF-BLOCK @@ -458,71 +469,72 @@ DELIMITED BY SIZE '";' DELIMITED BY SIZE - INTO WS-REXX-STATEMENTS - WITH POINTER WS-POINTER - END-STRING . - IF TGT-ENV-TYPE-OF-BLOCK = 'E' - MOVE TGT-ELM-PROCESSOR-RC TO RETURN-CODE-FOR-DISPLAY - STRING - 'TGT_ELM_PROCESSOR_RC = ' + 'TGT_ELM_LAST_PROC_PACKAGE = "' DELIMITED BY SIZE - RETURN-CODE-FOR-DISPLAY + TGT-ELM-LAST-PROC-PACKAGE DELIMITED BY SIZE - ';' + '";' + DELIMITED BY SIZE + 'TGT_ELM_PROCESSOR_GROUP = "' + DELIMITED BY SIZE + TGT-ELM-PROCESSOR-GROUP + DELIMITED BY SIZE + '";' DELIMITED BY SIZE INTO WS-REXX-STATEMENTS WITH POINTER WS-POINTER END-STRING - MOVE TGT-ELM-ACTION-CCID TO WS-INSPECT-CCID - INSPECT WS-INSPECT-CCID - REPLACING ALL '"' BY X'7D' - MOVE TGT-ELM-LEVEL-COMMENT TO - WS-INSPECT-COMMENT - INSPECT WS-INSPECT-COMMENT - REPLACING ALL '"' BY X'7D' - - STRING - 'TGT_ELM_ACTION_CCID = "' - DELIMITED BY SIZE - WS-INSPECT-CCID - DELIMITED BY SIZE - '";' - DELIMITED BY SIZE - 'TGT_ELM_LEVEL_COMMENT= "' - DELIMITED BY SIZE - WS-INSPECT-COMMENT - DELIMITED BY SIZE - '";' - DELIMITED BY SIZE - INTO WS-REXX-STATEMENTS - WITH POINTER WS-POINTER - END-STRING . + IF TGT-ENV-TYPE-OF-BLOCK = 'C' + MOVE TGT-ELM-ACTION-CCID TO WS-INSPECT-CCID + INSPECT WS-INSPECT-CCID + REPLACING ALL '"' BY X'7D' + MOVE TGT-ELM-LEVEL-COMMENT TO + WS-INSPECT-COMMENT + INSPECT WS-INSPECT-COMMENT + REPLACING ALL '"' BY X'7D' + STRING + 'TGT_ELM_ACTION_CCID = "' + DELIMITED BY SIZE + WS-INSPECT-CCID + DELIMITED BY SIZE + '";' + DELIMITED BY SIZE + 'TGT_ELM_LEVEL_COMMENT= "' + DELIMITED BY SIZE + WS-INSPECT-COMMENT + DELIMITED BY SIZE + '";' + DELIMITED BY SIZE + INTO WS-REXX-STATEMENTS + WITH POINTER WS-POINTER + END-STRING + END-IF + END-IF. ***** \ Convert COBOL exit block Datanames into Rexx / ***** - - IF TSO - MOVE 'C1UEXTR3' TO EXECBLK-MEMBER - MOVE 1800 TO ARGSTRING-LENGTH(1) + IF WS-TRACE = 'Y' THEN + DISPLAY 'C1UEXT02: Calling Rexx' + END-IF. + *****IF TSO + MOVE 'C1UEXTR2' TO EXECBLK-MEMBER + MOVE 4000 TO ARGSTRING-LENGTH(1) MOVE SPACES TO ALLOC-TEXT PERFORM 2100-ALLOCATE-REXFILE CALL 'SET-ARG1-POINTER' USING ARGUMENT-PTR ELM-EXECUTE-PARMS-IRXEXEC PERFORM 1800-REXX-CALL-VIA-IRXEXEC PERFORM 2200-FREE-REXFILES - ELSE - PERFORM 2101-ALLOCATE-SYSEXEC - CALL IRXJCL USING ELM-C1UEXTR3-PARMS-IRXJCL - IF RETURN-CODE NOT = 0 - DISPLAY 'C1UEXT03: BAD CALL TO IRXJCL - RC = ' - RETURN-CODE - END-IF - PERFORM 2201-FREE-SYSEXEC - END-IF . - + *****ELSE + ***** PERFORM 2101-ALLOCATE-SYSEXEC + ***** CALL IRXJCL USING ELM-C1UEXTR2-PARMS-IRXJCL + ***** IF RETURN-CODE NOT = 0 + ***** DISPLAY 'C1UEXT02: BAD CALL TO IRXJCL - RC = ' + ***** RETURN-CODE + ***** END-IF + ***** PERFORM 2201-FREE-SYSEXEC + *****END-IF . MOVE 0 TO RETURN-CODE . - GOBACK. - 1800-REXX-CALL-VIA-IRXEXEC. SET ARGSTRING-PTR (1) TO ARGUMENT-PTR . CALL 'SET-ARGUMENT-POINTER' USING ARGTABLE-PTR @@ -533,7 +545,6 @@ EVALBLK . MOVE 536870912 TO FLAGS MOVE 0 TO REXX-RETURN-CODE . - *--- CALL THE REXX EXEC --- CALL IRXEXEC-PGM USING EXECBLK-PTR ARGTABLE-PTR @@ -545,82 +556,66 @@ DUMMY-ZERO DUMMY-ZERO REXX-RETURN-CODE. - IF REXX-RETURN-CODE NOT = 0 - DISPLAY 'C1UEXT03: IRXEXEC RETURN CODE = ' + DISPLAY 'C1UEXT02: IRXEXEC RETURN CODE = ' REXX-RETURN-CODE END-IF - CANCEL IRXEXEC-PGM . - ***************************************************************** ** Allocate DD REXFILE for TSO processing ***************************************************************** 2100-ALLOCATE-REXFILE. - MOVE SPACES TO ALLOC-TEXT . - STRING 'ALLOC DD(REXFILE) ', - 'DA(YOURSITE.NDVR.REXX)' 00051710 + STRING 'ALLOC DD(REXFILE2) ', + 'DA(YOURSITE.NDVR.REXX)' DELIMITED BY SIZE ' SHR REUSE' DELIMITED BY SIZE INTO ALLOC-TEXT END-STRING. PERFORM 9000-DYNAMIC-ALLOC-DEALLOC . - ***************************************************************** ** Allocate DD SYSEXEC for batch processing ***************************************************************** 2101-ALLOCATE-SYSEXEC. - MOVE SPACES TO ALLOC-TEXT . STRING 'ALLOC DD(SYSEXEC) ', - 'DA(YOURSITE.NDVR.REXX)' 00053210 + 'DA(YOURSITE.NDVR.REXX)' DELIMITED BY SIZE ' SHR REUSE' DELIMITED BY SIZE INTO ALLOC-TEXT END-STRING. PERFORM 9000-DYNAMIC-ALLOC-DEALLOC . - ***************************************************************** ** DYNAMICALLY DE-ALLOCATE UNNEEDED REXX FILES ***************************************************************** 2200-FREE-REXFILES. - - MOVE 'FREE DD(REXFILE)' TO ALLOC-TEXT + MOVE 'FREE DD(REXFILE2)' TO ALLOC-TEXT PERFORM 9000-DYNAMIC-ALLOC-DEALLOC . - ***************************************************************** ** CALL BPXWDYN TO PREFORM REQUIRED REXX FUNCTIONS 2201-FREE-SYSEXEC. - MOVE 'FREE DD(SYSEXEC)' TO ALLOC-TEXT PERFORM 9000-DYNAMIC-ALLOC-DEALLOC . - ***************************************************************** ** CALL BPXWDYN TO PREFORM REQUIRED REXX FUNCTIONS 9000-DYNAMIC-ALLOC-DEALLOC. - CALL BPXWDYN USING ALLOC-STRING - - IF RETURN-CODE NOT = ZERO - DISPLAY 'C1UEXT03: ALLOCATION result: RETURN CODE = ' + IF RETURN-CODE NOT = ZERO OR + WS-TRACE = 'Y' THEN + DISPLAY 'C1UEXT02: ALLOCATION result: RETURN CODE = ' RETURN-CODE DISPLAY ALLOC-TEXT END-IF - MOVE SPACES TO ALLOC-TEXT . - - ****************************************************************** * BEGIN NESTED PROGRAMS USED TO SET THE POINTERS OF DATA AREAS * THAT ARE BEING PASSED TO IRXEXEC SO THAT A REXX ROUTINE CAN * PASS DATA (OTHER THAN A RETURN CODE) BACK TO A COBOL PROGRAM. ****************************************************************** - ******** SET-ARG1-POINTER ******** IDENTIFICATION DIVISION. PROGRAM-ID. SET-ARG1-POINTER. @@ -635,7 +630,6 @@ SET ARG-PTR TO ADDRESS OF ARG1 GOBACK. END PROGRAM SET-ARG1-POINTER. - ******** SET-ARGUMENT-POINTER ******** IDENTIFICATION DIVISION. PROGRAM-ID. SET-ARGUMENT-POINTER. @@ -655,7 +649,6 @@ SET ARGTABLE-PTR TO ADDRESS OF ARGUMENT GOBACK. END PROGRAM SET-ARGUMENT-POINTER. - ******** SET-EXECBLK-POINTER ******** IDENTIFICATION DIVISION. PROGRAM-ID. SET-EXECBLK-POINTER. @@ -678,7 +671,6 @@ SET EXECBLK-PTR TO ADDRESS OF EXECBLK GOBACK. END PROGRAM SET-EXECBLK-POINTER. - ******** SET-EVALBLK-POINTER ******** IDENTIFICATION DIVISION. PROGRAM-ID. SET-EVALBLK-POINTER. @@ -699,4 +691,4 @@ GOBACK. END PROGRAM SET-EVALBLK-POINTER. *--- END OF MAIN PROGRAM - END PROGRAM C1UEXT03. + END PROGRAM C1UEXT02. diff --git a/endevor/Field-Developed-Programs/Exit-Examples/C1UEXT02.Example#2-With RexAPI.cob b/endevor/Field-Developed-Programs/Exit-Examples/C1UEXT02.Example#2-With RexAPI.cob deleted file mode 100644 index a0f5ab0..0000000 --- a/endevor/Field-Developed-Programs/Exit-Examples/C1UEXT02.Example#2-With RexAPI.cob +++ /dev/null @@ -1,650 +0,0 @@ -000100 PROCESS DYNAM OUTDD(DISPLAYS) -000200 IDENTIFICATION DIVISION. -000300 PROGRAM-ID. C1UEXT02. -000400 DATE-COMPILED. -000500 DATE-WRITTEN. -000600 ENVIRONMENT DIVISION. -000700 CONFIGURATION SECTION. -000800 SOURCE-COMPUTER. IBM-370. -000900 OBJECT-COMPUTER. IBM-370. -001000***************************************************************** -001100* DESCRIPTION: THIS PGM IS CALLED before Element processing * -001200* It gathers Endevor info from the exit blocks * -001300* then calls REXX program C1UEXTR2. * -001400* * -001500* SETUP: The REXX C1UEXTR2 gets called from DD REXFILE. * -001600* Change the DSN to a secure dataset.(2 places) * -001700* * -001910* STRING 'ALLOC DD(REXFILE) ', <--look for REXFILE/SYSEXEC * -001920* 'DA(ESS.ENDEVOR.EXIT.REXX)' <----- here * -001930* DELIMITED BY SIZE * -001940* ' SHR REUSE' * -001950* DELIMITED BY SIZE * -001960* INTO ALLOC-TEXT * -001970* END-STRING. * -002000* * -002200* * -002300* * -002400***************************************************************** -002500 INPUT-OUTPUT SECTION. -002600 FILE-CONTROL. -002700 DATA DIVISION. -002800 FILE SECTION. -002900 -003000***************************************************************** -003100* W O R K I N G S T O R A G E * -003200***************************************************************** -003300 WORKING-STORAGE SECTION. -003400 -003500 77 FLAGS PIC S9(8) BINARY. -003600 77 REXX-RETURN-CODE PIC S9(8) BINARY. -003700 77 DUMMY-ZERO PIC S9(8) BINARY VALUE 0. -003800 77 ARGUMENT-PTR POINTER. -003900 77 EXECBLK-PTR POINTER. -004000 77 ARGTABLE-PTR POINTER. -004100 77 EVALBLK-PTR POINTER. -004200 -004300 01 IRXJCL PIC X(6) VALUE 'IRXJCL'. -004400 01 IRXEXEC-PGM PIC X(08) VALUE 'IRXEXEC'. -004500 -004600 01 WS-VARIABLES. -004700 03 WS-POINTER PIC 9(8) COMP. -004800 03 WS-WORK-ADDRESS-ADR PIC S9(8) COMP SYNC . -004900 03 WS-WORK-ADDRESS-PTR REDEFINES WS-WORK-ADDRESS-ADR -005000 USAGE IS POINTER . -005100 03 ADDRESS-ECB-RETURN-CODE PIC 9(10) . -005200 03 ADDRESS-ECB-MESSAGE-CODE PIC 9(10) . -005300 03 ADDRESS-ECB-MESSAGE-LENGTH PIC 9(10) . -005400 03 ADDRESS-ECB-MESSAGE-TEXT PIC 9(10) . -005500 03 ADDRESS-REQ-SISO-INDICATOR PIC 9(10) . -005600 03 ADDRESS-REQ-CCID PIC 9(10) . -005700 03 ADDRESS-REQ-COMMENT PIC 9(10) . -005800 -005900 -006000 01 BPXWDYN PIC X(8) VALUE 'BPXWDYN'. -006100 01 ALLOC-STRING. -006200 05 ALLOC-LENGTH PIC S9(4) BINARY VALUE 100. -006300 05 ALLOC-TEXT PIC X(100). -006400 -006500* The block of data below is passed to the REXX program C1UEXTR2 -006600* to ensure new elements are Registered. -006700* The bulk of the logic is found in C1UEXTR2 -006800 01 ELM-C1UEXTR2-PARMS-IRXJCL. -006900 02 ELM-EXECUTE-PARMS-IRXJCL-TOP. -007000 03 PARM-LENGTH PIC X(02) VALUE X'0711'. 00004500 -007100 03 REXX-NAME PIC X(08) VALUE 'C1UEXTR2'. -007200 03 FILLER PIC X(01) VALUE SPACE . -007300 02 ELM-EXECUTE-PARMS-IRXEXEC. 00004800 -007400 03 WS-REXX-STATEMENTS PIC X(1800). -007500 -007600 01 EXECBLK. -007700 05 EXECBLK-ACRYN PIC X(08) VALUE 'IRXEXECB'. -007800 05 EXECBLK-LENGTH PIC S9(8) BINARY -007900 VALUE 48. -008000 05 EXECBLK-RESERVED PIC S9(8) BINARY -008100 VALUE 0. -008200 05 EXECBLK-MEMBER PIC X(08) VALUE 'C1UEXTR2'. -008300 05 EXECBLK-DDNAME PIC X(08) VALUE 'REXFILE '. -008400 05 EXECBLK-SUBCOM PIC X(08) VALUE SPACES. -008500 05 EXECBLK-DSNPTR POINTER VALUE NULL. -008600 05 EXECBLK-DSNLEN PIC 9(04) COMP -008700 VALUE 0. -008800 -008900 01 EVALBLK. -009000 05 EVALBLK-EVPAD1 PIC S9(8) BINARY -009100 VALUE 0. -009200 05 EVALBLK-EVSIZE PIC S9(8) BINARY -009300 VALUE 34. -009400 05 EVALBLK-EVLEN PIC S9(8) BINARY -009500 VALUE 0. -009600 05 EVALBLK-EVPAD2 PIC S9(8) BINARY -009700 VALUE 0. -009800 05 EVALBLK-EVDATA PIC X(256). -009900 -010000 01 ARGUMENT. -010100 02 ARGUMENT-1 OCCURS 1 TIMES. -010200 05 ARGSTRING-PTR POINTER. -010300 05 ARGSTRING-LENGTH PIC S9(8) BINARY. -010400 02 ARGSTRING-LAST1 PIC S9(8) BINARY -010500 VALUE -1. -010600 02 ARGSTRING-LAST2 PIC S9(8) BINARY -010700 VALUE -1. -010800 -010900 -011000*----------------------------------------------------------------- -011100 LINKAGE SECTION. -011200*----------------------------------------------------------------- -011300 COPY EXITBLKS. -011400 -011500 PROCEDURE DIVISION USING -011600 EXIT-CONTROL-BLOCK -011700 REQUEST-INFO-BLOCK -011800 SRC-ENVIRONMENT-BLOCK -011900 SRC-ELEMENT-MASTER-INFO-BLOCK -012000 SRC-FILE-CONTROL-BLOCK -012100 TGT-ENVIRONMENT-BLOCK -012200 TGT-ELEMENT-MASTER-INFO-BLOCK -012300 TGT-FILE-CONTROL-BLOCK. -013400 -013500 MOVE SPACES TO WS-REXX-STATEMENTS . -013600 -013700 SET WS-WORK-ADDRESS-PTR TO -013800 ADDRESS OF ECB-RETURN-CODE . -013900 MOVE WS-WORK-ADDRESS-ADR -014000 TO ADDRESS-ECB-RETURN-CODE . -014100 -014200 SET WS-WORK-ADDRESS-PTR TO -014300 ADDRESS OF ECB-MESSAGE-CODE. -014400 MOVE WS-WORK-ADDRESS-ADR -014500 TO ADDRESS-ECB-MESSAGE-CODE. -014600 -014700 SET WS-WORK-ADDRESS-PTR TO -014800 ADDRESS OF ECB-MESSAGE-LENGTH. -014900 MOVE WS-WORK-ADDRESS-ADR -015000 TO ADDRESS-ECB-MESSAGE-LENGTH . -015100 -015200 SET WS-WORK-ADDRESS-PTR TO -015300 ADDRESS OF ECB-MESSAGE-TEXT . -015400 MOVE WS-WORK-ADDRESS-ADR -015500 TO ADDRESS-ECB-MESSAGE-TEXT . -015600 -015700 SET WS-WORK-ADDRESS-PTR TO -015800 ADDRESS OF REQ-CCID . -015900 MOVE WS-WORK-ADDRESS-ADR -016000 TO ADDRESS-REQ-CCID . -016100 -016200 SET WS-WORK-ADDRESS-PTR TO -016300 ADDRESS OF REQ-COMMENT . -016400 MOVE WS-WORK-ADDRESS-ADR -016500 TO ADDRESS-REQ-COMMENT . -016600 -016700***** -016800***** / Convert COBOL exit block Datanames into Rexx \ -016900***** -017000***** -017100 MOVE 1 TO WS-POINTER. -017200 -017210 -017300 STRING -017400 'ECB_TSO_BATCH_MODE = "' -017500 DELIMITED BY SIZE -017600 ECB-TSO-BATCH-MODE -017700 DELIMITED BY SIZE -017800 '";' -017900 DELIMITED BY SIZE -018000 'ECB_USER_ID = "' -018100 DELIMITED BY SIZE -018200 ECB-USER-ID -018300 DELIMITED BY SIZE -018400 '";' -018500 DELIMITED BY SIZE -018600 'ECB_ACTION_NAME = "' -018700 DELIMITED BY SIZE -018800 ECB-ACTION-NAME -018900 DELIMITED BY SIZE -019000 '";' -019100 DELIMITED BY SIZE -019200 'REQ_CCID = "' -019300 DELIMITED BY SIZE -019400 REQ-CCID -019500 DELIMITED BY SIZE -019600 '";' -019700 DELIMITED BY SIZE -019800 'Address_REQ_CCID = ' -019900 DELIMITED BY SIZE -020000 ADDRESS-REQ-CCID -020100 DELIMITED BY SIZE -020200 ';' -020300 DELIMITED BY SIZE -020400 'REQ_COMMENT = "' -020500 DELIMITED BY SIZE -020600 REQ-COMMENT -020700 DELIMITED BY SIZE -020800 '";' -020900 DELIMITED BY SIZE -021000 'Address_REQ_COMMENT = ' -021100 DELIMITED BY SIZE -021200 ADDRESS-REQ-COMMENT -021300 DELIMITED BY SIZE -021400 ';' -021500 DELIMITED BY SIZE -021600 'REQ_SISO_INDICATOR = "' -021700 DELIMITED BY SIZE -021800 REQ-SISO-INDICATOR -021900 DELIMITED BY SIZE -022000 '";' -022100 DELIMITED BY SIZE -022200 'REQ_DELETE_AFTER = "' -022300 DELIMITED BY SIZE -022400 REQ-DELETE-AFTER -022500 DELIMITED BY SIZE -022600 '";' -022700 DELIMITED BY SIZE -022800 'REQ_SYNCHRONIZE = "' -022900 DELIMITED BY SIZE -023000 REQ-SYNCHRONIZE -023100 DELIMITED BY SIZE -023200 '";' -023300 DELIMITED BY SIZE -023400 'REQ_IGNGEN_FAIL = "' -023500 DELIMITED BY SIZE -023600 REQ-IGNGEN-FAIL -023700 DELIMITED BY SIZE -023800 '";' -023900 DELIMITED BY SIZE -024000 'REQ_PROCESSOR_GROUP = "' -024100 DELIMITED BY SIZE -024200 REQ-PROCESSOR-GROUP -024300 DELIMITED BY SIZE -024400 '";' -024500 DELIMITED BY SIZE -024600 'REQ_OVERWRITE_INDICATOR = "' -024700 DELIMITED BY SIZE -024800 REQ-OVERWRITE-INDICATOR -024900 DELIMITED BY SIZE -025000 '";' -025100 DELIMITED BY SIZE -025200 'REQ_GEN_COPYBACK = "' -025300 DELIMITED BY SIZE -025400 REQ-GEN-COPYBACK -025500 DELIMITED BY SIZE -025600 '";' -025700 DELIMITED BY SIZE -025800 'REQ_BENE = "' -025900 DELIMITED BY SIZE -026000 REQ-BENE -026100 DELIMITED BY SIZE -026200 '";' -026300 DELIMITED BY SIZE -026400 'REQ_AUTOGEN = "' -026500 DELIMITED BY SIZE -026600 REQ-AUTOGEN -026700 DELIMITED BY SIZE -026800 '";' -026900 DELIMITED BY SIZE -031800 'TGT_ELM_LAST_PROC_PACKAGE = "' -031900 DELIMITED BY SIZE -032000 TGT-ELM-LAST-PROC-PACKAGE -032100 DELIMITED BY SIZE -032200 '";' -032300 DELIMITED BY SIZE -032400 'TGT_ELM_PROCESSOR_GROUP = "' -032500 DELIMITED BY SIZE -032600 TGT-ELM-PROCESSOR-GROUP -032700 DELIMITED BY SIZE -032800 '";' -032900 DELIMITED BY SIZE -037800 'SRC_ELM_LAST_PROC_PACKAGE = "' -037900 DELIMITED BY SIZE -038000 SRC-ELM-LAST-PROC-PACKAGE -038100 DELIMITED BY SIZE -038200 '";' -038300 DELIMITED BY SIZE -038400 'SRC_ELM_PROCESSOR_GROUP = "' -038500 DELIMITED BY SIZE -038600 SRC-ELM-PROCESSOR-GROUP -038700 DELIMITED BY SIZE -038800 '";' -038900 DELIMITED BY SIZE -039000 'Address_ECB_RETURN_CODE = ' ADDRESS-ECB-RETURN-CODE -039100 DELIMITED BY SIZE -039200 '; ' -039300 DELIMITED BY SIZE -039400 'Address_ECB_MESSAGE_CODE = ' ADDRESS-ECB-MESSAGE-CODE -039500 DELIMITED BY SIZE -039600 '; ' -039700 DELIMITED BY SIZE -039800 'Address_ECB_MESSAGE_LENGTH = ' -039900 ADDRESS-ECB-MESSAGE-LENGTH -040000 DELIMITED BY SIZE -040100 '; ' -040200 DELIMITED BY SIZE -040300 'Address_ECB_MESSAGE_TEXT = ' -040400 ADDRESS-ECB-MESSAGE-TEXT -040500 DELIMITED BY SIZE -040600 '; ' -040700 DELIMITED BY SIZE -040800 INTO WS-REXX-STATEMENTS -040900 WITH POINTER WS-POINTER . -041000 IF SRC-ENV-IO-TYPE = 'I' -041100 STRING -041200 'SRC_ELM_ACTION_CCID = "' -041300 DELIMITED BY SIZE -041400 SRC-ELM-ACTION-CCID -041500 DELIMITED BY SIZE -041600 '";' -041700 DELIMITED BY SIZE -041800 'SRC_ELM_LEVEL_COMMENT= "' -041900 DELIMITED BY SIZE -042000 SRC-ELM-LEVEL-COMMENT -042100 DELIMITED BY SIZE -042200 '";' -042300 DELIMITED BY SIZE -042400 INTO WS-REXX-STATEMENTS -042500 WITH POINTER WS-POINTER -042600 END-STRING . -042612 STRING -042613 'SRC_ENV_ENVIRONMENT_NAME = "' -042614 DELIMITED BY SIZE -042615 SRC-ENV-ENVIRONMENT-NAME -042616 DELIMITED BY SIZE -042617 '";' -042618 DELIMITED BY SIZE -042619 'SRC_ENV_STAGE_NAME = "' -042620 DELIMITED BY SIZE -042621 SRC-ENV-STAGE-NAME -042622 DELIMITED BY SIZE -042623 '";' -042624 DELIMITED BY SIZE -042625 'SRC_ENV_SYSTEM_NAME = "' -042626 DELIMITED BY SIZE -042627 SRC-ENV-SYSTEM-NAME -042628 DELIMITED BY SIZE -042629 '";' -042630 DELIMITED BY SIZE -042631 'SRC_ENV_SUBSYSTEM_NAME = "' -042632 DELIMITED BY SIZE -042633 SRC-ENV-SUBSYSTEM-NAME -042634 DELIMITED BY SIZE -042635 '";' -042636 DELIMITED BY SIZE -042637 'SRC_ENV_TYPE_NAME = "' -042638 DELIMITED BY SIZE -042639 SRC-ENV-TYPE-NAME -042640 DELIMITED BY SIZE -042641 '";' -042642 DELIMITED BY SIZE -042643 'SRC_ENV_ELEMENT_NAME = "' -042644 DELIMITED BY SIZE -042645 SRC-ENV-ELEMENT-NAME -042646 DELIMITED BY SIZE -042647 '";' -042648 DELIMITED BY SIZE -042649 'SRC_ENV_TYPE_OF_BLOCK = "' -042650 DELIMITED BY SIZE -042651 SRC-ENV-TYPE-OF-BLOCK -042652 DELIMITED BY SIZE -042653 '";' -042654 DELIMITED BY SIZE -042655 'SRC_ENV_IO_TYPE = "' -042656 DELIMITED BY SIZE -042657 SRC-ENV-IO-TYPE -042658 DELIMITED BY SIZE -042659 '";' -042660 DELIMITED BY SIZE -042661 INTO WS-REXX-STATEMENTS -042662 WITH POINTER WS-POINTER -042663 END-STRING . -042703 STRING -042704 'TGT_ENV_ENVIRONMENT_NAME = "' -042705 DELIMITED BY SIZE -042706 TGT-ENV-ENVIRONMENT-NAME -042707 DELIMITED BY SIZE -042708 '";' -042709 DELIMITED BY SIZE -042710 'TGT_ENV_STAGE_NAME = "' -042711 DELIMITED BY SIZE -042712 TGT-ENV-STAGE-NAME -042713 DELIMITED BY SIZE -042714 '";' -042715 DELIMITED BY SIZE -042716 'TGT_ENV_SYSTEM_NAME = "' -042717 DELIMITED BY SIZE -042718 TGT-ENV-SYSTEM-NAME -042719 DELIMITED BY SIZE -042720 '";' -042721 DELIMITED BY SIZE -042722 'TGT_ENV_SUBSYSTEM_NAME = "' -042723 DELIMITED BY SIZE -042724 TGT-ENV-SUBSYSTEM-NAME -042725 DELIMITED BY SIZE -042726 '";' -042727 DELIMITED BY SIZE -042728 'TGT_ENV_TYPE_NAME = "' -042729 DELIMITED BY SIZE -042730 TGT-ENV-TYPE-NAME -042731 DELIMITED BY SIZE -042732 '";' -042733 DELIMITED BY SIZE -042734 'TGT_ENV_ELEMENT_NAME = "' -042735 DELIMITED BY SIZE -042736 TGT-ENV-ELEMENT-NAME -042737 DELIMITED BY SIZE -042738 '";' -042739 DELIMITED BY SIZE -042740 'TGT_ENV_TYPE_OF_BLOCK = "' -042741 DELIMITED BY SIZE -042742 TGT-ENV-TYPE-OF-BLOCK -042743 DELIMITED BY SIZE -042744 '";' -042745 DELIMITED BY SIZE -042746 'TGT_ENV_IO_TYPE = "' -042747 DELIMITED BY SIZE -042748 TGT-ENV-IO-TYPE -042749 DELIMITED BY SIZE -042750 '";' -042751 DELIMITED BY SIZE -042752 INTO WS-REXX-STATEMENTS -042753 WITH POINTER WS-POINTER -042760 END-STRING . -042800 IF SRC-ENV-IO-TYPE NOT = 'I' AND -042900 TGT-ENV-IO-TYPE = 'O' -043000 STRING -043100 'TGT_ELM_ACTION_CCID = "' -043200 DELIMITED BY SIZE -043300 TGT-ELM-ACTION-CCID -043400 DELIMITED BY SIZE -043500 '";' -043600 DELIMITED BY SIZE -043700 'TGT_ELM_LEVEL_COMMENT= "' -043800 DELIMITED BY SIZE -043900 TGT-ELM-LEVEL-COMMENT -044000 DELIMITED BY SIZE -044100 '";' -044200 DELIMITED BY SIZE -044300 INTO WS-REXX-STATEMENTS -044400 WITH POINTER WS-POINTER -044500 END-STRING . -044600***** \ Convert COBOL exit block Datanames into Rexx / -044700***** -044900 -045000 IF TSO -045200 MOVE 'C1UEXTR2' TO EXECBLK-MEMBER -045300 MOVE 1800 TO ARGSTRING-LENGTH(1) -045400 MOVE SPACES TO ALLOC-TEXT -045500 PERFORM 2100-ALLOCATE-REXFILE -045600 CALL 'SET-ARG1-POINTER' USING ARGUMENT-PTR -045700 ELM-EXECUTE-PARMS-IRXEXEC -045800 PERFORM 1800-REXX-CALL-VIA-IRXEXEC -045900 PERFORM 2200-FREE-REXFILES -046000 ELSE -046200 PERFORM 2101-ALLOCATE-SYSEXEC -046300 CALL IRXJCL USING ELM-C1UEXTR2-PARMS-IRXJCL -046400 IF RETURN-CODE NOT = 0 -046500 DISPLAY 'C1UEXT02: BAD CALL TO IRXJCL - RC = ' -046600 RETURN-CODE -046700 END-IF -046800 PERFORM 2201-FREE-SYSEXEC -046900 END-IF . -047000 -047100 MOVE 0 TO RETURN-CODE . -047200 -047300 GOBACK. -047400 -047500 1800-REXX-CALL-VIA-IRXEXEC. -048100 SET ARGSTRING-PTR (1) TO ARGUMENT-PTR . -048200 CALL 'SET-ARGUMENT-POINTER' USING ARGTABLE-PTR -048300 ARGUMENT . -048400 CALL 'SET-EXECBLK-POINTER' USING EXECBLK-PTR -048500 EXECBLK . -048600 CALL 'SET-EVALBLK-POINTER' USING EVALBLK-PTR -048700 EVALBLK . -049000 MOVE 536870912 TO FLAGS -049100 MOVE 0 TO REXX-RETURN-CODE . -049200 -049600*--- CALL THE REXX EXEC --- -049700 CALL IRXEXEC-PGM USING EXECBLK-PTR -049800 ARGTABLE-PTR -049900 FLAGS -050000 DUMMY-ZERO -050100 DUMMY-ZERO -050200 EVALBLK-PTR -050300 DUMMY-ZERO -050400 DUMMY-ZERO -050500 DUMMY-ZERO -050510 REXX-RETURN-CODE. -050600 -050700 IF REXX-RETURN-CODE NOT = 0 -050800 DISPLAY 'C1UEXT02: IRXEXEC RETURN CODE = ' -050900 REXX-RETURN-CODE -051000 END-IF -051100 -051200 CANCEL IRXEXEC-PGM -051300 . -051400 -051410***************************************************************** -051420** Allocate DD REXFILE for TSO processing -051430***************************************************************** -051500 2100-ALLOCATE-REXFILE. -051600 -051900 MOVE SPACES TO ALLOC-TEXT . -052000 STRING 'ALLOC DD(REXFILE) ', -052100 'DA(ESS.ENDEVOR.EXIT.REXX)' -052200 DELIMITED BY SIZE -052300 ' SHR REUSE' -052400 DELIMITED BY SIZE -052500 INTO ALLOC-TEXT -052600 END-STRING. -052700 PERFORM 9000-DYNAMIC-ALLOC-DEALLOC . -052800 -052900***************************************************************** -053000** Allocate DD SYSEXEC for batch processing -053100***************************************************************** -053200 2101-ALLOCATE-SYSEXEC. -053300 -053400 MOVE SPACES TO ALLOC-TEXT . -053500 STRING 'ALLOC DD(SYSEXEC) ', -053600 'DA(ESS.ENDEVOR.EXIT.REXX)' -053700 DELIMITED BY SIZE -053800 ' SHR REUSE' -053900 DELIMITED BY SIZE -054000 INTO ALLOC-TEXT -054100 END-STRING. -054200 PERFORM 9000-DYNAMIC-ALLOC-DEALLOC . -054300 -054400***************************************************************** -054500** DYNAMICALLY DE-ALLOCATE UNNEEDED REXX FILES -054600***************************************************************** -054700 2200-FREE-REXFILES. -054800 -054900 MOVE 'FREE DD(REXFILE)' TO ALLOC-TEXT -055000 PERFORM 9000-DYNAMIC-ALLOC-DEALLOC . -055100 -055400***************************************************************** -055500** CALL BPXWDYN TO PREFORM REQUIRED REXX FUNCTIONS -055600 2201-FREE-SYSEXEC. -055700 -055800 MOVE 'FREE DD(SYSEXEC)' TO ALLOC-TEXT -055900 PERFORM 9000-DYNAMIC-ALLOC-DEALLOC . -056000 -056300***************************************************************** -056400** CALL BPXWDYN TO PREFORM REQUIRED REXX FUNCTIONS -056500 9000-DYNAMIC-ALLOC-DEALLOC. -056600 -056700 CALL BPXWDYN USING ALLOC-STRING -056800 -056900 IF RETURN-CODE NOT = ZERO -057000 DISPLAY 'C1UEXT02: ALLOCATION result: RETURN CODE = ' -057100 RETURN-CODE -057200 DISPLAY ALLOC-TEXT -057300 END-IF -057400 -057500 MOVE SPACES TO ALLOC-TEXT -057600 . -057700 -057800 -057900****************************************************************** -058000* BEGIN NESTED PROGRAMS USED TO SET THE POINTERS OF DATA AREAS -058100* THAT ARE BEING PASSED TO IRXEXEC SO THAT A REXX ROUTINE CAN -058200* PASS DATA (OTHER THAN A RETURN CODE) BACK TO A COBOL PROGRAM. -058300****************************************************************** -058400 -058500******** SET-ARG1-POINTER ******** -058600 IDENTIFICATION DIVISION. -058700 PROGRAM-ID. SET-ARG1-POINTER. -058800 ENVIRONMENT DIVISION. -058900 DATA DIVISION. -059000 WORKING-STORAGE SECTION. -059100 LINKAGE SECTION. -059200 77 ARG-PTR POINTER. -059300 77 ARG1 PIC X(16). -059400 PROCEDURE DIVISION USING ARG-PTR -059500 ARG1. -059600 SET ARG-PTR TO ADDRESS OF ARG1 -059700 GOBACK. -059800 END PROGRAM SET-ARG1-POINTER. -059900 -060000******** SET-ARGUMENT-POINTER ******** -060100 IDENTIFICATION DIVISION. -060200 PROGRAM-ID. SET-ARGUMENT-POINTER. -060300 ENVIRONMENT DIVISION. -060400 DATA DIVISION. -060500 WORKING-STORAGE SECTION. -060600 LINKAGE SECTION. -060700 77 ARGTABLE-PTR POINTER. -060800 01 ARGUMENT. -060900 02 ARGUMENT-1 OCCURS 1 TIMES. -061000 05 ARGSTRING-PTR POINTER. -061100 05 ARGSTRING-LENGTH PIC S9(8) BINARY. -061200 02 ARGSTRING-LAST1 PIC S9(8) BINARY. -061300 02 ARGSTRING-LAST2 PIC S9(8) BINARY. -061400 PROCEDURE DIVISION USING ARGTABLE-PTR -061500 ARGUMENT. -061600 SET ARGTABLE-PTR TO ADDRESS OF ARGUMENT -061700 GOBACK. -061800 END PROGRAM SET-ARGUMENT-POINTER. -061900 -062000******** SET-EXECBLK-POINTER ******** -062100 IDENTIFICATION DIVISION. -062200 PROGRAM-ID. SET-EXECBLK-POINTER. -062300 ENVIRONMENT DIVISION. -062400 DATA DIVISION. -062500 WORKING-STORAGE SECTION. -062600 LINKAGE SECTION. -062700 77 EXECBLK-PTR POINTER. -062800 01 EXECBLK. -062900 03 EXECBLK-ACRYN PIC X(8). -063000 03 EXECBLK-LENGTH PIC 9(4) COMP. -063100 03 EXECBLK-RESERVED PIC 9(4) COMP. -063200 03 EXECBLK-MEMBER PIC X(8). -063300 03 EXECBLK-DDNAME PIC X(8). -063400 03 EXECBLK-SUBCOM PIC X(8). -063500 03 EXECBLK-DSNPTR POINTER. -063600 03 EXECBLK-DSNLEN PIC 9(4) COMP. -063700 PROCEDURE DIVISION USING EXECBLK-PTR -063800 EXECBLK. -063900 SET EXECBLK-PTR TO ADDRESS OF EXECBLK -064000 GOBACK. -064100 END PROGRAM SET-EXECBLK-POINTER. -064200 -064300******** SET-EVALBLK-POINTER ******** -064400 IDENTIFICATION DIVISION. -064500 PROGRAM-ID. SET-EVALBLK-POINTER. -064600 ENVIRONMENT DIVISION. -064700 DATA DIVISION. -064800 WORKING-STORAGE SECTION. -064900 LINKAGE SECTION. -065000 77 EVALBLK-PTR POINTER. -065100 01 EVALBLK. -065200 03 EVALBLK-EVPAD1 PIC 9(4) COMP. -065300 03 EVALBLK-EVSIZE PIC 9(4) COMP. -065400 03 EVALBLK-EVLEN PIC 9(4) COMP. -065500 03 EVALBLK-EVPAD2 PIC 9(4) COMP. -065600 03 EVALBLK-EVDATA PIC X(256). -065700 PROCEDURE DIVISION USING EVALBLK-PTR -065800 EVALBLK. -065900 SET EVALBLK-PTR TO ADDRESS OF EVALBLK -066000 GOBACK. -066100 END PROGRAM SET-EVALBLK-POINTER. -066200*--- END OF MAIN PROGRAM -066300 END PROGRAM C1UEXT02. diff --git a/endevor/Field-Developed-Programs/Package-Automation/C1UEXT07.cob b/endevor/Field-Developed-Programs/Exit-Examples/C1UEXT07 WithRexDriver.cob similarity index 96% rename from endevor/Field-Developed-Programs/Package-Automation/C1UEXT07.cob rename to endevor/Field-Developed-Programs/Exit-Examples/C1UEXT07 WithRexDriver.cob index 46b280b..48c0b8c 100644 --- a/endevor/Field-Developed-Programs/Package-Automation/C1UEXT07.cob +++ b/endevor/Field-Developed-Programs/Exit-Examples/C1UEXT07 WithRexDriver.cob @@ -3,15 +3,10 @@ PROGRAM-ID. C1UEXT07. ***************************************************************** * DESCRIPTION: THIS PGM IS CALLED for misc Package actions. - * It gathers Endevor info from the exit blocks - * then calls REXX program C1UEXTR7. - ************************************************************ - * https://github.com/BroadcomMFD/broadcom-product-scripts - ************************************************************ - * Change the Dataset references within this program: * - * 1) Find all "DA(" * - * 2) Change each dataset name to your REXX library * - ************************************************************ + * It gathers Endevor info from the exit blocks * + * then calls REXX program C1UEXTR7. * + * Together they can force CAST actions to be in Batch. * + ***************************************************************** ENVIRONMENT DIVISION. INPUT-OUTPUT SECTION. FILE-CONTROL. @@ -30,7 +25,6 @@ 03 WS-PECB-NDVR-HIGH-RC PIC 9999 . 03 WS-DISPLAY-NUMBER-FOR4 PIC 9(04) . 03 WS-DISPLAY-NUMBER-FOR9 PIC 9(09) . - 00490200 01 PGM PIC X(8). 01 MYSMTP-MESSAGE PIC X(80). 01 MYSMTP-USERID PIC X(8). @@ -54,7 +48,6 @@ 03 ADDRESS-MYSMTP-TEXT PIC 9(09) . 03 ADDRESS-MYSMTP-URL PIC 9(09) . 03 ADDRESS-MYSMTP-EMAIL-IDS PIC 9(09) . - 00510000 03 ADDRESS-PECB-NDVR-EXIT-RC PIC 9(09) . 03 ADDRESS-PECB-MESSAGE-ID PIC 9(09) . 03 ADDRESS-PECB-MESSAGE PIC 9(09) . @@ -142,7 +135,7 @@ **** PECB-USER-BATCH-JOBNAME(1:7) NOT = 'PL05958' **** GOBACK. **** -********* DISPLAY 'C1UEXTT7: GOT INTO C1UEXTT7'. +********* DISPLAY 'C1UEXT07: GOT INTO C1UEXTT7'. ********* MOVE PECB-FUNCTION-CODE TO WS-DISPLAY-NUMBER-FOR9. ********* DISPLAY 'PECB-FUNCTION-CODE=' WS-DISPLAY-NUMBER-FOR9. IF SETUP-EXIT-OPTIONS @@ -165,8 +158,6 @@ ********* to support automated package shipping MOVE 'Y' TO PECB-AFTER-EXEC MOVE 'Y' TO PECB-REQ-ELEMENT-ACTION-BIBO - MOVE 'Y' TO PECB-BEFORE-BACKOUT - MOVE 'Y' TO PECB-BEFORE-BACKIN MOVE 'Y' TO PECB-AFTER-BACKOUT MOVE 'Y' TO PECB-AFTER-BACKIN ********* to support submission of package Execute jobs @@ -319,7 +310,8 @@ 'PECB_ACT_REC_EXIST_FLAG="' PECB-ACT-REC-EXIST-FLAG '";' 'PECB_APP_REC_EXIST_FLAG="' PECB-APP-REC-EXIST-FLAG '";' 'PECB_BAC_REC_EXIST_FLAG="' PECB-BAC-REC-EXIST-FLAG '";' - 'PECB_REQUEST_RETURNCODE=' WS-PECB-REQUEST-RETURNCODE ';' + 'PECB_REQUEST_RETURNCODE=' + WS-PECB-REQUEST-RETURNCODE ';' 'PECB_NDVR_HIGH_RC = ' WS-PECB-NDVR-HIGH-RC ';' 'PREQ_BACKOUT_ENABLED="' PREQ-BACKOUT-ENABLED '";' 'Address_PREQ_BACKOUT_ENABLED=' @@ -350,10 +342,9 @@ WITH POINTER WS-POINTER . ********* For these text fields, make sure none use a double quote ********* character. This ensures the integrity of the REXX - IF (REVIEW-PACKAGE OR CAST-PACKAGE) AND - PECB-AFTER AND - PECB-SUCCESSFUL-RECORD-SENT AND - PAPP-GROUP-NAME(1:1) IS ALPHABETIC + IF PAPP-QUORUM-COUNT > 0 AND + (REVIEW-PACKAGE OR + (CAST-PACKAGE AND PECB-AFTER) ) MOVE PAPP-QUORUM-COUNT TO WS-DISPLAY-NUMBER-FOR4 STRING 'CALL_REASON="' WS-CALLING-REASON '";' @@ -398,7 +389,7 @@ END-STRING END-IF. ******* Replace any double quote characters in data to be passed - IF CAST-PACKAGE OR REVIEW-PACKAGE + IF CAST-PACKAGE OR REVIEW-PACKAGE OR EXECUTE-PACKAGE INSPECT PREQ-PACKAGE-COMMENT REPLACING ALL '"' BY X'7D' INSPECT PHDR-PKG-NOTE1 REPLACING ALL '"' BY X'7D' INSPECT PHDR-PKG-NOTE2 REPLACING ALL '"' BY X'7D' @@ -445,6 +436,11 @@ IF RETURN-CODE NOT = 0 DISPLAY 'C1UEXT07: BAD CALL TO IRXJCL - RC = ' RETURN-CODE + MOVE 'C1UEXT07: Unable to connect to REXX (500)' + TO PECB-MESSAGE + MOVE 132 TO PECB-ERROR-MESS-LENGTH + MOVE 8 TO PECB-NDVR-EXIT-RC + GOBACK END-IF MOVE 0 TO RETURN-CODE . @@ -481,6 +477,10 @@ IF REXX-RETURN-CODE NOT = 0 DISPLAY 'C1UEXT07: IRXEXEC RETURN CODE = ' REXX-RETURN-CODE + MOVE 'C1UEXT07: Unable to connect to REXX (800)' + TO PECB-MESSAGE + MOVE 132 TO PECB-ERROR-MESS-LENGTH + MOVE 8 TO PECB-NDVR-EXIT-RC END-IF CANCEL IRXEXEC-PGM . @@ -524,7 +524,7 @@ MOVE SPACES TO ALLOC-TEXT. IF PECB-BATCH-MODE STRING 'ALLOC DD(SYSEXEC) ', - 'DA(YOURSITE.NDVR.REXX)' + 'DA(YOUR.NDVR.REXX)' DELIMITED BY SIZE ' SHR REUSE' DELIMITED BY SIZE @@ -532,7 +532,7 @@ END-STRING ELSE STRING 'ALLOC DD(REXFILE7) ', - 'DA(YOURSITE.NDVR.REXX)' + 'DA(YOUR.NDVR.REXX)' DELIMITED BY SIZE ' SHR REUSE' DELIMITED BY SIZE diff --git a/endevor/Field-Developed-Programs/Exit-Examples/C1UEXT07-Example#1 Cast in Batch.cob b/endevor/Field-Developed-Programs/Exit-Examples/C1UEXT07-Example#1 Cast in Batch.cob deleted file mode 100644 index 060580d..0000000 --- a/endevor/Field-Developed-Programs/Exit-Examples/C1UEXT07-Example#1 Cast in Batch.cob +++ /dev/null @@ -1,534 +0,0 @@ - PROCESS DYNAM OUTDD(DISPLAYS) - IDENTIFICATION DIVISION. - PROGRAM-ID. C1UEXT07. - ***************************************************************** - * DESCRIPTION: THIS PGM IS CALLED for misc Package actions. - * It gathers Endevor info from the exit blocks * - * then calls REXX program C1UEXTR7. * - * Together they can force CAST actions to be in Batch. * - ***************************************************************** - ENVIRONMENT DIVISION. - INPUT-OUTPUT SECTION. - FILE-CONTROL. - ** - DATA DIVISION. - FILE SECTION. - - WORKING-STORAGE SECTION. - - COPY NOTIFYDS. - - 01 WS-VGET PIC X(8) VALUE 'VGET '. - 01 WS-PROFILE PIC X(8) VALUE 'PROFILE '. - 01 WS-ISPLINK PIC X(8) VALUE 'ISPLINK ' . - - 01 WS-C1BJC1-JOBCARD PIC X(80) . - 01 WS-C1BJC1 PIC X(08) VALUE '(C1BJC1)'. - - 01 WS-C1PJC1-JOBCARD PIC X(80) . - 01 WS-C1PJC1 PIC X(08) VALUE '(C1PJC1)'. - - 01 WS-VARIABLES. - 03 WS-POINTER PIC 9(09) COMP. - 03 WS-WORK-ADDRESS-ADR PIC 9(09) COMP SYNC . - 03 WS-WORK-ADDRESS-PTR REDEFINES WS-WORK-ADDRESS-ADR - USAGE IS POINTER . - - 03 WS-PECB-REQUEST-RETURNCODE PIC 9999 . - 03 WS-PECB-NDVR-HIGH-RC PIC 9999 . - - 03 ADDRESS-NOTI-USER PIC 9(09) . - - 03 ADDRESS-PECB-NDVR-EXIT-RC PIC 9(09) . - 03 ADDRESS-PECB-MESSAGE-ID PIC 9(09) . - 03 ADDRESS-PECB-MESSAGE PIC 9(09) . - 03 ADDRESS-PECB-ERROR-MESS-LENGTH PIC 9(09) . - 03 ADDRESS-PECB-MODS-MADE-TO-PREQ PIC 9(09) . - 03 ADDRESS-PREQ-SHARE-ENABLED PIC 9(09) . - 03 ADDRESS-PREQ-BACKOUT-ENABLED PIC 9(09) . - - 01 BPXWDYN PIC X(8) VALUE 'BPXWDYN'. - 01 ALLOC-STRING. - 05 ALLOC-LENGTH PIC S9(4) BINARY VALUE 100. - 05 ALLOC-TEXT PIC X(100). - - 01 IRXJCL PIC X(6) VALUE 'IRXJCL'. - 01 IRXEXEC-PGM PIC X(08) VALUE 'IRXEXEC'. - - * - * DEFINE THE IRXEXEC DATA AREAS AND ARG BLOCKS - * - 77 FLAGS PIC S9(8) BINARY. - 77 REXX-RETURN-CODE PIC S9(8) BINARY. - 77 DUMMY-ZERO PIC S9(8) BINARY. - 77 LPAR-ID PIC X(04). - 88 DO-NOT-PROCESS-LPAR VALUE 'SKIP'. - 77 ARG1 PIC X(16). - 77 UPDPRINT-FILE-STATUS PIC X(02). - 77 ARGUMENT-PTR POINTER. - 77 EXECBLK-PTR POINTER. - 77 ARGTABLE-PTR POINTER. - 77 EVALBLK-PTR POINTER. - 77 TEMP-PTR POINTER. - - 01 EXECBLK. - 05 EXECBLK-ACRYN PIC X(08) VALUE 'IRXEXECB'. - 05 EXECBLK-LENGTH PIC S9(8) BINARY - VALUE 48. - 05 EXECBLK-RESERVED PIC S9(8) BINARY - VALUE 0. - 05 EXECBLK-MEMBER PIC X(08) VALUE 'C1UEXTR7'. - 05 EXECBLK-DDNAME PIC X(08) VALUE 'REXFILE7'. - 05 EXECBLK-SUBCOM PIC X(08) VALUE SPACES. - 05 EXECBLK-DSNPTR POINTER VALUE NULL. - 05 EXECBLK-DSNLEN PIC 9(04) COMP - VALUE 0. - - 01 EVALBLK. - 05 EVALBLK-EVPAD1 PIC S9(8) BINARY - VALUE 0. - 05 EVALBLK-EVSIZE PIC S9(8) BINARY - VALUE 34. - 05 EVALBLK-EVLEN PIC S9(8) BINARY - VALUE 0. - 05 EVALBLK-EVPAD2 PIC S9(8) BINARY - VALUE 0. - 05 EVALBLK-EVDATA PIC X(256). - - 01 ARGUMENT. - 02 ARGUMENT-1 OCCURS 1 TIMES. - 05 ARGSTRING-PTR POINTER. - 05 ARGSTRING-LENGTH PIC S9(8) BINARY. - 02 ARGSTRING-LAST1 PIC S9(8) BINARY - VALUE -1. - 02 ARGSTRING-LAST2 PIC S9(8) BINARY - VALUE -1. - - * The block of data below can be used with either an - * IRXJCL or IRXEXEC call to the rexx program C1UEXTR7. - * IRXJCL is used when running in batch (batch CAST) . - * IRXEXEC is used when running in foreground (CAST or APPROVE). - 01 PKG-C1UEXTR7-PARMS-IRXJCL. - 02 PKG-C1UEXTR7-PARMS-IRXJCL-TOP. - 03 PARM-LENGTH PIC X(2) VALUE X'0BC1'. - 03 REXX-NAME PIC X(8) VALUE 'C1UEXTR7'. - 03 FILLER PIC X(1) VALUE SPACE . - 02 PKG-C1UEXTR7-PARMS-IRXEXEC. - 03 WS-REXX-STATEMENTS PIC X(3000). - - LINKAGE SECTION. - COPY PKGXBLKS. - - PROCEDURE DIVISION USING - PACKAGE-EXIT-BLOCK - PACKAGE-REQUEST-BLOCK - PACKAGE-EXIT-HEADER-BLOCK - PACKAGE-EXIT-FILE-BLOCK - PACKAGE-EXIT-ACTION-BLOCK - PACKAGE-EXIT-APPROVER-MAP - PACKAGE-EXIT-BACKOUT-BLOCK - PACKAGE-EXIT-SHIPMENT-BLOCK - PACKAGE-EXIT-SCL-BLOCK. - **** - IF PECB-USER-BATCH-JOBNAME(1:7) NOT = 'IBMUSER' AND - PECB-USER-BATCH-JOBNAME(1:7) NOT = 'PL05958' - GOBACK. - **** - -********* DISPLAY 'C1UEXT07: GOT INTO EXIT 7' . - - IF SETUP-EXIT-OPTIONS - MOVE ZERO TO PECB-UEXIT-HOLD-FIELD -********* to enforce package create rules -********* MOVE 'Y' TO PECB-BEFORE-CREATE-BLD -********* MOVE 'Y' TO PECB-BEFORE-CREATE-COPY -********* MOVE 'Y' TO PECB-BEFORE-CREATE-EDIT -********* MOVE 'Y' TO PECB-BEFORE-CREATE-IMPT -********* to enforce package backout = Y - MOVE 'Y' TO PECB-BEFORE-CAST -********* MOVE 'Y' TO PECB-MID-CAST -********* MOVE 'Y' TO PECB-BEFORE-MOD-IMPT -********* MOVE 'Y' TO PECB-AFTER-RESET -********* MOVE 'Y' TO PECB-AFTER-DELETE - MOVE ZEROS TO RETURN-CODE - GO TO 0100-MAIN-EXIT. - - MOVE 0 TO PECB-NDVR-EXIT-RC. - - MOVE SPACES TO WS-REXX-STATEMENTS . - - PERFORM 1000-ALLOCATE-REXFILE . - PERFORM 1500-CALL-C1UEXTR7-REXX . - MOVE ZERO TO PECB-UEXIT-HOLD-FIELD . - PERFORM 2000-FREE-REXFILES . - - 0100-MAIN-EXIT. -********* DISPLAY 'C1UEXT07: GOING BACK ' - - GOBACK. - - 1500-CALL-C1UEXTR7-REXX. - - * Give addresses of updatable fields to the REXX. - * MAKES A CALL TO THE REXX ROUTINE C1UEXTR7. - - SET WS-WORK-ADDRESS-PTR TO - ADDRESS OF PECB-NDVR-EXIT-RC . - MOVE WS-WORK-ADDRESS-ADR - TO ADDRESS-PECB-NDVR-EXIT-RC. - - SET WS-WORK-ADDRESS-PTR TO - ADDRESS OF PECB-MESSAGE . - MOVE WS-WORK-ADDRESS-ADR - TO ADDRESS-PECB-MESSAGE . - - SET WS-WORK-ADDRESS-PTR TO - ADDRESS OF PECB-ERROR-MESS-LENGTH . - MOVE WS-WORK-ADDRESS-ADR - TO ADDRESS-PECB-ERROR-MESS-LENGTH. - - SET WS-WORK-ADDRESS-PTR TO - ADDRESS OF PECB-MODS-MADE-TO-PREQ . - MOVE WS-WORK-ADDRESS-ADR - TO ADDRESS-PECB-MODS-MADE-TO-PREQ. - - SET WS-WORK-ADDRESS-PTR TO - ADDRESS OF PECB-MESSAGE-ID. - MOVE WS-WORK-ADDRESS-ADR - TO ADDRESS-PECB-MESSAGE-ID . - - SET WS-WORK-ADDRESS-PTR TO - ADDRESS OF PREQ-SHARE-ENABLED. - MOVE WS-WORK-ADDRESS-ADR - TO ADDRESS-PREQ-SHARE-ENABLED . - - SET WS-WORK-ADDRESS-PTR TO - ADDRESS OF PREQ-BACKOUT-ENABLED. - MOVE WS-WORK-ADDRESS-ADR - TO ADDRESS-PREQ-BACKOUT-ENABLED . - - MOVE PECB-REQUEST-RETURNCODE TO - WS-PECB-REQUEST-RETURNCODE. - - MOVE PECB-NDVR-HIGH-RC TO - WS-PECB-NDVR-HIGH-RC . - - ***** - ***** / Convert COBOL exit block Datanames into Rexx \ - ***** - ***** - MOVE 1 TO WS-POINTER. - - STRING - 'PECB_PACKAGE_ID = "' PECB-PACKAGE-ID '";' - DELIMITED BY SIZE - 'PECB_FUNCTION_LITERAL="' PECB-FUNCTION-LITERAL '";' - DELIMITED BY SIZE - 'PECB_SUBFUNC_LITERAL="' PECB-SUBFUNC-LITERAL '";' - DELIMITED BY SIZE - 'PECB_BEF_AFTER_LITERAL="' PECB-BEF-AFTER-LITERAL '";' - DELIMITED BY SIZE - 'PECB_USER_BATCH_JOBNAME="' PECB-USER-BATCH-JOBNAME '";' - DELIMITED BY SIZE - 'PREQ_PKG_CAST_COMPVAL="' PREQ-PKG-CAST-COMPVAL '";' - DELIMITED BY SIZE - 'PHDR_PKG_SHR_OPTION ="' PHDR-PKG-SHR-OPTION '";' - DELIMITED BY SIZE - 'PHDR_PKG_ENV ="' PHDR-PKG-ENV '";' - DELIMITED BY SIZE - 'PHDR_PKG_STGID ="' PHDR-PKG-STGID '";' - DELIMITED BY SIZE - 'PECB_MODE = "' PECB-MODE '";' - DELIMITED BY SIZE - 'PECB_AUTOCAST ="' PECB-AUTOCAST '";' - DELIMITED BY SIZE - 'PECB_REQUEST_RETURNCODE=' WS-PECB-REQUEST-RETURNCODE ';' - DELIMITED BY SIZE - 'PECB_NDVR_HIGH_RC = ' WS-PECB-NDVR-HIGH-RC ';' - DELIMITED BY SIZE - 'PREQ_BACKOUT_ENABLED="' PREQ-BACKOUT-ENABLED '";' - DELIMITED BY SIZE - 'Address_PREQ_BACKOUT_ENABLED=' - ADDRESS-PREQ-BACKOUT-ENABLED ';' - DELIMITED BY SIZE - 'PREQ_SHARE_ENABLED="' PREQ-SHARE-ENABLED '";' - DELIMITED BY SIZE - 'Address_PREQ_SHARE_ENABLED=' - ADDRESS-PREQ-SHARE-ENABLED ';' - DELIMITED BY SIZE - 'Address_PECB_MODS_MADE_TO_PREQ=' - ADDRESS-PECB-MODS-MADE-TO-PREQ ';' - DELIMITED BY SIZE - 'Address_PECB_NDVR_EXIT_RC=' - ADDRESS-PECB-NDVR-EXIT-RC ';' - DELIMITED BY SIZE - 'Address_PECB_MESSAGE_ID=' ADDRESS-PECB-MESSAGE-ID ';' - DELIMITED BY SIZE - 'Address_PECB_ERROR_MESS_LENGTH = ' - ADDRESS-PECB-ERROR-MESS-LENGTH ';' - DELIMITED BY SIZE - 'Address_PECB_MESSAGE = ' ADDRESS-PECB-MESSAGE ';' - DELIMITED BY SIZE - INTO WS-REXX-STATEMENTS - WITH POINTER WS-POINTER . - -********* For these text fields, make sure none use a double quote -********* character. This ensures the integrity of the REXX - -******* Replace any double quote characters in data to be passed - IF CAST-PACKAGE - INSPECT PREQ-PACKAGE-COMMENT REPLACING ALL '"' BY X'7D' - INSPECT PHDR-PKG-NOTE1 REPLACING ALL '"' BY X'7D' - INSPECT PHDR-PKG-NOTE2 REPLACING ALL '"' BY X'7D' - INSPECT PHDR-PKG-NOTE3 REPLACING ALL '"' BY X'7D' - INSPECT PHDR-PKG-NOTE4 REPLACING ALL '"' BY X'7D' - INSPECT PHDR-PKG-NOTE5 REPLACING ALL '"' BY X'7D' - INSPECT PHDR-PKG-NOTE6 REPLACING ALL '"' BY X'7D' - INSPECT PHDR-PKG-NOTE7 REPLACING ALL '"' BY X'7D' - INSPECT PHDR-PKG-NOTE8 REPLACING ALL '"' BY X'7D' - STRING - 'PREQ_PACKAGE_COMMENT = "' PREQ-PACKAGE-COMMENT '";' - DELIMITED BY SIZE - 'PHDR_PACKAGE_TYPE = "' PHDR-PACKAGE-TYPE '";' - DELIMITED BY SIZE - 'PHDR_PACKAGE_STATUS = "' PHDR-PACKAGE-STATUS '";' - DELIMITED BY SIZE - 'PHDR_PKG_BACKOUT_STATUS="' PHDR-PKG-BACKOUT-STATUS '";' - DELIMITED BY SIZE - 'PHDR_PKG_CREATE_USER = "' PHDR-PKG-CREATE-USER '";' - DELIMITED BY SIZE - 'PHDR_PKG_CAST_USER = "' PHDR-PKG-CAST-USER '";' - DELIMITED BY SIZE - 'PHDR_PKG_NOTE1 = "' PHDR-PKG-NOTE1 '";' - DELIMITED BY SIZE - 'PHDR_PKG_NOTE2 = "' PHDR-PKG-NOTE2 '";' - DELIMITED BY SIZE - 'PHDR_PKG_NOTE3 = "' PHDR-PKG-NOTE3 '";' - DELIMITED BY SIZE - 'PHDR_PKG_NOTE4 = "' PHDR-PKG-NOTE4 '";' - DELIMITED BY SIZE - 'PHDR_PKG_NOTE5 = "' PHDR-PKG-NOTE5 '";' - DELIMITED BY SIZE - 'PHDR_PKG_NOTE6 = "' PHDR-PKG-NOTE6 '";' - DELIMITED BY SIZE - 'PHDR_PKG_NOTE7 = "' PHDR-PKG-NOTE7 '";' - DELIMITED BY SIZE - 'PHDR_PKG_NOTE8 = "' PHDR-PKG-NOTE8 '";' - DELIMITED BY SIZE - 'PHDR_PKG_CAST_COMPVAL = "' PHDR-PKG-CAST-COMPVAL '";' - DELIMITED BY SIZE - INTO WS-REXX-STATEMENTS - WITH POINTER WS-POINTER - END-STRING - END-IF. - - ***** \ Convert COBOL exit block Datanames into Rexx / - ***** - - MOVE 'C1UEXTR7' TO EXECBLK-MEMBER . - MOVE 3000 TO ARGSTRING-LENGTH(1) - - IF PECB-TSO-MODE - CALL 'SET-ARG1-POINTER' USING ARGUMENT-PTR - PKG-C1UEXTR7-PARMS-IRXEXEC - PERFORM 1800-REXX-CALL-VIA-IRXEXEC - MOVE 0 TO PECB-NDVR-HIGH-RC - ELSE -********* DISPLAY 'C1UEXT07: Running in Batch ' - CALL IRXJCL USING PKG-C1UEXTR7-PARMS-IRXJCL . - - IF RETURN-CODE NOT = 0 - DISPLAY 'C1UEXT07: BAD CALL TO IRXJCL - RC = ' - RETURN-CODE - END-IF - - MOVE 0 TO RETURN-CODE - . - 1800-REXX-CALL-VIA-IRXEXEC. - *--- GET THE ADDRESS OF THE ARGUMENT(S) TO BE PASSED TO IXREXEC - *--- AND LOAD INTO THE ARGUMENT TABLES -******* IF PECB-USER-BATCH-JOBNAME(1:7) = 'PL05958' -******* DISPLAY 'C1UEXT07: SETTING UP REXX EXECUTION' -******* ' FOR PACKAGE 'PECB-PACKAGE-ID -******* END-IF . - SET ARGSTRING-PTR (1) TO ARGUMENT-PTR . - CALL 'SET-ARGUMENT-POINTER' USING ARGTABLE-PTR - ARGUMENT . - CALL 'SET-EXECBLK-POINTER' USING EXECBLK-PTR - EXECBLK . - CALL 'SET-EVALBLK-POINTER' USING EVALBLK-PTR - EVALBLK . - *--- SET FLAGS TO HEX 20000000 - * I.E. EXEC INVOKED AS SUBROUTINE - MOVE 536870912 TO FLAGS - MOVE 0 TO REXX-RETURN-CODE . - -********* DISPLAY 'C1UEXT07: CALLING IRXEXC ' -********* PECB-PACKAGE-ID . - *--- CALL THE REXX EXEC --- - CALL IRXEXEC-PGM USING EXECBLK-PTR - ARGTABLE-PTR - FLAGS - DUMMY-ZERO - DUMMY-ZERO - EVALBLK-PTR - DUMMY-ZERO - DUMMY-ZERO - DUMMY-ZERO . - - IF REXX-RETURN-CODE NOT = 0 - DISPLAY 'C1UEXT07: IRXEXEC RETURN CODE = ' - REXX-RETURN-CODE - END-IF - - CANCEL IRXEXEC-PGM - . - - 1000-ALLOCATE-REXFILE. - - MOVE SPACES TO ALLOC-TEXT. - - IF PECB-BATCH-MODE - STRING 'ALLOC DD(SYSEXEC) ', - 'DA(SHARE.ENDV.SHARABLE.REXX)' - DELIMITED BY SIZE - ' SHR REUSE' - DELIMITED BY SIZE - INTO ALLOC-TEXT - END-STRING - ELSE - STRING 'ALLOC DD(REXFILE7) ', - 'DA(SHARE.ENDV.SHARABLE.REXX)' - DELIMITED BY SIZE - ' SHR REUSE' - DELIMITED BY SIZE - INTO ALLOC-TEXT - END-STRING - END-IF. - - PERFORM 9000-DYNAMIC-ALLOC-DEALLOC . - -********** MOVE 'CONCAT DDLIST(REXFILE,REXFILE2)' -********** TO ALLOC-TEXT . -********** -********** PERFORM 9000-DYNAMIC-ALLOC-DEALLOC . - - ***************************************************************** - ** DYNAMICALLY DE-ALLOCATE UNNEEDED REXX FILES - ***************************************************************** - 2000-FREE-REXFILES. - - MOVE SPACES TO ALLOC-TEXT. - - IF PECB-BATCH-MODE - MOVE 'FREE DD(SYSEXEC)' TO ALLOC-TEXT - ELSE - MOVE 'FREE DD(REXFILE7)' TO ALLOC-TEXT - END-IF. - - - PERFORM 9000-DYNAMIC-ALLOC-DEALLOC - . - ***************************************************************** - ** CALL BPXWDYN TO PREFORM REQUIRED REXX FUNCTIONS - ***************************************************************** - 9000-DYNAMIC-ALLOC-DEALLOC. - - CALL BPXWDYN USING ALLOC-STRING - - IF RETURN-CODE NOT = ZERO - DISPLAY 'C1UEXT07: ALLOCATION FAILED: RETURN CODE = ' - RETURN-CODE - DISPLAY ALLOC-TEXT - END-IF - -********* DISPLAY ALLOC-TEXT . - MOVE SPACES TO ALLOC-TEXT - . - - - ****************************************************************** - * BEGIN NESTED PROGRAMS USED TO SET THE POINTERS OF DATA AREAS - * THAT ARE BEING PASSED TO IRXEXEC SO THAT A REXX ROUTINE CAN - * PASS DATA (OTHER THAN A RETURN CODE) BACK TO A COBOL PROGRAM. - ****************************************************************** - - ******** SET-ARG1-POINTER ******** - IDENTIFICATION DIVISION. - PROGRAM-ID. SET-ARG1-POINTER. - ENVIRONMENT DIVISION. - DATA DIVISION. - WORKING-STORAGE SECTION. - LINKAGE SECTION. - 77 ARG-PTR POINTER. - 77 ARG1 PIC X(16). - PROCEDURE DIVISION USING ARG-PTR - ARG1. - SET ARG-PTR TO ADDRESS OF ARG1 - GOBACK. - END PROGRAM SET-ARG1-POINTER. - - ******** SET-ARGUMENT-POINTER ******** - IDENTIFICATION DIVISION. - PROGRAM-ID. SET-ARGUMENT-POINTER. - ENVIRONMENT DIVISION. - DATA DIVISION. - WORKING-STORAGE SECTION. - LINKAGE SECTION. - 77 ARGTABLE-PTR POINTER. - 01 ARGUMENT. - 02 ARGUMENT-1 OCCURS 1 TIMES. - 05 ARGSTRING-PTR POINTER. - 05 ARGSTRING-LENGTH PIC S9(8) BINARY. - 02 ARGSTRING-LAST1 PIC S9(8) BINARY. - 02 ARGSTRING-LAST2 PIC S9(8) BINARY. - PROCEDURE DIVISION USING ARGTABLE-PTR - ARGUMENT. - SET ARGTABLE-PTR TO ADDRESS OF ARGUMENT - GOBACK. - END PROGRAM SET-ARGUMENT-POINTER. - - ******** SET-EXECBLK-POINTER ******** - IDENTIFICATION DIVISION. - PROGRAM-ID. SET-EXECBLK-POINTER. - ENVIRONMENT DIVISION. - DATA DIVISION. - WORKING-STORAGE SECTION. - LINKAGE SECTION. - 77 EXECBLK-PTR POINTER. - 01 EXECBLK. - 03 EXECBLK-ACRYN PIC X(8). - 03 EXECBLK-LENGTH PIC 9(4) COMP. - 03 EXECBLK-RESERVED PIC 9(4) COMP. - 03 EXECBLK-MEMBER PIC X(8). - 03 EXECBLK-DDNAME PIC X(8). - 03 EXECBLK-SUBCOM PIC X(8). - 03 EXECBLK-DSNPTR POINTER. - 03 EXECBLK-DSNLEN PIC 9(4) COMP. - PROCEDURE DIVISION USING EXECBLK-PTR - EXECBLK. - SET EXECBLK-PTR TO ADDRESS OF EXECBLK - GOBACK. - END PROGRAM SET-EXECBLK-POINTER. - - ******** SET-EVALBLK-POINTER ******** - IDENTIFICATION DIVISION. - PROGRAM-ID. SET-EVALBLK-POINTER. - ENVIRONMENT DIVISION. - DATA DIVISION. - WORKING-STORAGE SECTION. - LINKAGE SECTION. - 77 EVALBLK-PTR POINTER. - 01 EVALBLK. - 03 EVALBLK-EVPAD1 PIC 9(4) COMP. - 03 EVALBLK-EVSIZE PIC 9(4) COMP. - 03 EVALBLK-EVLEN PIC 9(4) COMP. - 03 EVALBLK-EVPAD2 PIC 9(4) COMP. - 03 EVALBLK-EVDATA PIC X(256). - PROCEDURE DIVISION USING EVALBLK-PTR - EVALBLK. - SET EVALBLK-PTR TO ADDRESS OF EVALBLK - GOBACK. - END PROGRAM SET-EVALBLK-POINTER. - *--- END OF MAIN PROGRAM - END PROGRAM C1UEXT07. diff --git a/endevor/Field-Developed-Programs/Exit-Examples/C1UEXT07-stub-calling-C1UEXTR7.cob b/endevor/Field-Developed-Programs/Exit-Examples/C1UEXT07-stub-calling-C1UEXTR7.cob deleted file mode 100644 index 8052ac9..0000000 --- a/endevor/Field-Developed-Programs/Exit-Examples/C1UEXT07-stub-calling-C1UEXTR7.cob +++ /dev/null @@ -1,78 +0,0 @@ - PROCESS OUTDD(DISPLAYS) DYNAM - IDENTIFICATION DIVISION. - PROGRAM-ID. C1UEXT07. - ENVIRONMENT DIVISION. - CONFIGURATION SECTION. - SOURCE-COMPUTER. IBM-390 WITH DEBUGGING MODE. - INPUT-OUTPUT SECTION. - FILE-CONTROL. - - DATA DIVISION. - FILE SECTION. - * * - - WORKING-STORAGE SECTION. - - LINKAGE SECTION. - COPY PKGXBLKS. - - PROCEDURE DIVISION USING - PACKAGE-EXIT-BLOCK - PACKAGE-REQUEST-BLOCK - PACKAGE-EXIT-HEADER-BLOCK - PACKAGE-EXIT-FILE-BLOCK - PACKAGE-EXIT-ACTION-BLOCK - PACKAGE-EXIT-APPROVER-MAP - PACKAGE-EXIT-BACKOUT-BLOCK - PACKAGE-EXIT-SHIPMENT-BLOCK - PACKAGE-EXIT-SCL-BLOCK. - - MOVE 0 TO PECB-NDVR-EXIT-RC. - IF SETUP-EXIT-OPTIONS -******* DISPLAY 'C1UEXT07: INTO SETUP-EXIT-OPTIONS' - MOVE 'Y' TO PECB-BEFORE-CAST -******* MOVE 'Y' TO PECB-MID-CAST - MOVE 'Y' TO PECB-AFTER-CAST -******* MOVE 'Y' TO PECB-AFTER-EXEC - MOVE ZEROS TO RETURN-CODE - MOVE 0000 TO PECB-UEXIT-HOLD-FIELD - GO TO 1100-EXIT . - - IF CAST-PACKAGE AND PECB-BEFORE AND - PECB-UEXIT-HOLD-FIELD = 0000 AND - PHDR-PACKAGE-STATUS = 'IN-EDIT' - MOVE 0001 TO PECB-UEXIT-HOLD-FIELD - PERFORM 500-ADD-APPROVER-GROUPS - ELSE - IF CAST-PACKAGE AND PECB-AFTER - MOVE 0000 TO PECB-UEXIT-HOLD-FIELD - END-IF. - - GO TO 1100-EXIT . - - 500-ADD-APPROVER-GROUPS. - - IF PECB-PACKAGE-ID(1:2) = 'FI' - MOVE 'Y' TO PECB-USENDING-APP-GRPS - MOVE 'PRD' TO PAPP-ENVIRONMENT - MOVE 1 TO PAPP-QUORUM-COUNT - MOVE 1 TO PAPP-CURRENT-VERSION - MOVE 'PAPP' TO PAPP-BLOCK-ID - MOVE 56 TO PAPP-LENGTH - MOVE 1 TO PAPP-SEQUENCE-NUMBER - MOVE SPACES TO PAPP-APPROVAL-DATA(16) - MOVE 'IBMUSER' TO PAPP-APPROVAL-ID(1) - MOVE 'IBMUSE2' TO PAPP-APPROVAL-ID(2) - MOVE 2 TO PAPP-APPROVER-NUMBER - MOVE 1 TO PECB-NBR-APPR-GRPS-SENT - MOVE 'NDVRTEAM' TO PAPP-GROUP-NAME -******** DISPLAY 'ADDING APPROVER GROUP ' PAPP-GROUP-NAME - END-IF . - - 1100-EXIT. - -******* DISPLAY WS-TIME ': 1100-EXIT ' -******* ' PECB-REQ-SCL-RECORDS=' PECB-REQ-SCL-RECORDS -******* ' PECB-NDVR-EXIT-RC=' PECB-NDVR-EXIT-RC. - GOBACK. - diff --git a/endevor/Field-Developed-Programs/Exit-Examples/C1UEXTR2 Reuse CCID and Comment.rex b/endevor/Field-Developed-Programs/Exit-Examples/C1UEXTR2 With RexDriver.rex similarity index 53% rename from endevor/Field-Developed-Programs/Exit-Examples/C1UEXTR2 Reuse CCID and Comment.rex rename to endevor/Field-Developed-Programs/Exit-Examples/C1UEXTR2 With RexDriver.rex index ce6cd2a..87e57a8 100644 --- a/endevor/Field-Developed-Programs/Exit-Examples/C1UEXTR2 Reuse CCID and Comment.rex +++ b/endevor/Field-Developed-Programs/Exit-Examples/C1UEXTR2 With RexDriver.rex @@ -6,20 +6,20 @@ /* o Reuses a comment value from element if comment is blank */ /* o Gives a friendly reminder if the SIGNOUT OVERRIDE is on */ /* -------------------------------------------------------------- */ - STRING = "ALLOC DD(SYSTSPRT) SYSOUT(A) " CALL BPXWDYN STRING; STRING = "ALLOC DD(SYSTSIN) DUMMY" CALL BPXWDYN STRING; - - /* If C1UEXTR2 is allocated to anything, turn on Trace */ - WhatDDName = 'C1UEXTR2' - CALL BPXWDYN "INFO FI("WhatDDName")", - "INRTDSN(DSNVAR) INRDSNT(myDSNT)" - if Substr(DSNVAR,1,1) /= = ' ' then Trace ?r - + UsersAllowedToTrace = 'IBMUSER IBMothr' + If Wordpos(USERID(),UsersAllowedToTrace) > 0 then, + Do + /* If C1UEXTR2 is allocated to anything, turn on Trace */ + WhatDDName = 'C1UEXTR2' + CALL BPXWDYN "INFO FI("WhatDDName")", + "INRTDSN(DSNVAR) INRDSNT(myDSNT)" + if Substr(DSNVAR,1,1) /= ' ' then TraceRQ = 'Y' + End Sa= 'You called ....CLSTREXX(C1UEXTR2) ' - /* In case these are not provided by the Exit */ SRC_ELM_ACTION_CCID = ' ' SRC_ELM_LEVEL_COMMENT = ' ' @@ -27,53 +27,52 @@ TGT_ELM_LEVEL_COMMENT = ' ' /* These Element Actions determine whehter to */ /* use SRC or TGT variables */ - ActionsThatUse_SRC = 'RETRIEVE MOVE DELETE GENERATE' + ActionsThatUse_SRC = 'RETRIEVE MOVE DELETE GENERATE TRANSFER' ActionsThatUse_TGT = 'UPDATE ' - Arg Parms Parms = Strip(Parms) sa= 'Parms len=' Length(Parms) - /* Parms from C1UEXT02 is a string of REXX statements */ - Interpret Parms + /* Validate and interpret if validation is OK */ + myRC = EvaluateParms() + If myRC > 4 then Exit(12) + /* Interpret Parms */ + If TraceRQ = 'Y' then Trace ?R MyRc = 0 Message ='' MessageCode = ' ' - + /* Find already used/validated CCID value from Element block */ + If Wordpos(ECB_ACTION_NAME,ActionsThatUse_SRC) > 0 then, + Former_CCID = SRC_ELM_ACTION_CCID + Else, + If Wordpos(ECB_ACTION_NAME,ActionsThatUse_TGT) > 0 then, + Former_CCID = TGT_ELM_ACTION_CCID /* If CCID is left blank, then apply last used CCID */ /* otherwise if it appears to be a ServiceNow - validate */ If REQ_CCID = COPIES(' ',12) then Call Update_CCID; Else, If Substr(REQ_CCID,1,3) = 'PRB' |, - Substr(REQ_CCID,1,3) = 'CHG' then Call Validate_CCID; - + Substr(REQ_CCID,1,3) = 'CHG' &, + REQ_CCID /= Former_CCID Then, + Do + Message = SERVINOW('C1UEXTR2' REQ_CCID ECB_TSO_BATCH_MODE) + If POS('**NOT**', Message) > 0 then, + Do + MessageCode = 'U012' + MyRc = 8 + End; /* If POS('**NOT**', Message) > 0 */ + End; /* If Substr(REQ_CCID,1,3) = 'PRB' ... 'CHG' */ /* If COMMENT is left blank, then apply last used COMMENT */ If MyRc < 8 &, REQ_COMMENT = COPIES(' ',40) then Call Update_COMMENT; - sa= 'MyRc =' MyRc - - If SRC_ENV_SYSTEM_NAME = 'ADMINSYS' |, - TGT_ENV_SYSTEM_NAME = 'ADMINSYS' then, - Do - hexAddress = D2X(ADDRESS_REQ_USER_DATA) - storrep = STORAGE(hexAddress,,'Endevor Admin Work') - hexAddress = D2X(ADDRESS_REQ_ALTER_WITH_UPDATE) - storrep = STORAGE(hexAddress,,'00000004'X) - hexAddress = D2X(Address_ECB_RETURN_CODE) - storrep = STORAGE(hexAddress,,'00000004'X) - Exit - End - /* Did user specify OVERRIDE SIGNOUT ? */ If MyRc = 0 & REQ_SISO_INDICATOR = 'Y' then Do Message = 'Remember that you have set OVERRIDE SIGNOUT' MyRc = 4 End - If MyRc = 0 then Exit - If Message /= '' then, Do hexAddress = D2X(Address_ECB_MESSAGE_TEXT) @@ -81,109 +80,85 @@ hexAddress = D2X(Address_ECB_MESSAGE_LENGTH) storrep = STORAGE(hexAddress,,'0084'X) End - If MessageCode /= ' ' then, Do hexAddress = D2X(Address_ECB_MESSAGE_CODE) storrep = STORAGE(hexAddress,,MessageCode) End - /* Tell Endevor something changed or something failed */ hexAddress = D2X(Address_ECB_RETURN_CODE) If MyRc = 4 then, storrep = STORAGE(hexAddress,,'00000004'X) Else, storrep = STORAGE(hexAddress,,'00000008'X) - Exit - +EvaluateParms: + $numbers = '0123456789.' /* chars for numeric values */ + RemainingParms = Strip(Parms) + Do Until Words(Remainingparms) < 1 + Parse Var RemainingParms $keyword '=' RemainingParms + $keyword = Strip($keyword) + RemainingParms = Strip(RemainingParms,'L') + $firstchar = Substr(RemainingParms,1,1) + If $firstchar = '"' then $NumericValue = 0 + Else, + Do + $firstNonNumeric =, + VERIFY(RemainingParms,$numbers || ' ') + $NumericValue =, + Substr(RemainingParms,$firstNonNumeric,1) = ';' + End + /* Value must be numeric, or be double quoted */ + If words($keyword) /= 1 |, + DATATYPE($keyword,SYMBOL) /= 1 |, + ($NumericValue = 0 & $firstchar /= '"') then, + Do + Parse var RemainingParms dropit ';' RemainingParms + Say "Invalid syntax-" $keyword '=' dropit + myAcct = GETACCTC() + myJobnr = GETJOBNR() + parm="Invalid syntax-" command '=' dropit + parm='Usr=' || USERID() 'Acct='myAcct dropit + parm= parm || ' jobnumber=' myJobnr + parm=Left(parm,70) + Address LINKMVS "WTO#MSG parm" + Return 12 + End + Else /* double quoted value */ + If VERIFY($firstchar,$numbers) > 0 then, + Do + Parse var RemainingParms '"' $value '"' blanks ";" RemainingParms + command = $keyword '=' '"' || Strip($value) || '"' + End + Else /* numeric value */ + Do + Parse var RemainingParms $value ';' RemainingParms + command = $keyword '=' Strip($value) + End + RemainingParms = strip(RemainingParms) + If TraceRQ = 'Y' then say command + interpret command + End; /* Do rexx# = 1 to Words(RemainingParms) */ + Return 0 Update_CCID: - - If Wordpos(ECB_ACTION_NAME,ActionsThatUse_SRC) > 0 then, - Replace_CCID = SRC_ELM_ACTION_CCID - Else, - If Wordpos(ECB_ACTION_NAME,ActionsThatUse_TGT) > 0 then, - Replace_CCID = TGT_ELM_ACTION_CCID - /* Still missing a CCID? */ - If Substr(Replace_CCID,1,1) < 'a' then, + If Substr(Former_CCID,1,1) < 'a' then, Do MyRc = 8 Message = '** A CCID value is required **' MessageCode = 'U012' Return; End - hexAddress = D2X(Address_REQ_CCID) - storrep = STORAGE(hexAddress,,Replace_CCID) + storrep = STORAGE(hexAddress,,Former_CCID) MyRc = 4 - - Return; - -Validate_CCID: - - /* build STDENV input */ - CALL BPXWDYN , - "ALLOC DD(STDENV) LRECL(080) BLKSIZE(24000) SPACE(1,1) ", - " RECFM(F,B) TRACKS ", - " NEW UNCATALOG REUSE "; - Queue "EXPORT PATH=$PATH:" ||, - "'/usr/IBM/python/lib/python#.##/'" - Queue "EXPORT VIRTUAL_ENV=" ||, - "'u/your/venv/lib/python#.##/site-packages/'" - "EXECIO 2 DISKW STDENV (finis" - - /* build BPXBATCH inputs and outputs */ - /* build STDPARM input */ - CALL BPXWDYN , - "ALLOC DD(STDPARM) LRECL(080) BLKSIZE(24000) SPACE(1,1) ", - " RECFM(F,B) TRACKS ", - " NEW UNCATALOG REUSE "; - Queue "sh cd " ||, - "u/your/venv/lib/python#.##/site-packages;" - Queue "python ServiceNow.py" REQ_CCID - "EXECIO 2 DISKW STDPARM (finis" - - CALL BPXWDYN , - "ALLOC DD(STDOUT) LRECL(200) BLKSIZE(20000) SPACE(5,5) ", - " RECFM(F,B) TRACKS ", - " NEW UNCATALOG REUSE "; - Notnow =, - "ALLOC DD(STDOUT) DA('IBMUSER.STDOUT') OLD REUSE " - - CALL BPXWDYN "ALLOC DD(STDIN) DUMMY SHR REUSE" - CALL BPXWDYN "ALLOC DD(STDERR) DA(*) SHR REUSE" - - ADDRESS LINK 'BPXBATCH' - - "EXECIO * DISKR STDOUT (Stem stdout. finis" - lastrec# = stdout.0 - lastrecord = Substr(stdout.lastrec#,1,40) - - If Pos("Exists",lastrecord) = 0 then, - Do - Message = 'C1UEXTR2 - CCID ' REQ_CCID ||, - ' is not defined to Service-Now' - MessageCode = 'U012' - MyRc = 8 - End - - CALL BPXWDYN "FREE DD(STDENV) " - CALL BPXWDYN "FREE DD(STDPARM)" - CALL BPXWDYN "FREE DD(STDOUT) " - CALL BPXWDYN "FREE DD(STDIN) " - CALL BPXWDYN "FREE DD(STDERR) " - Return; - Update_COMMENT: - If Wordpos(ECB_ACTION_NAME,ActionsThatUse_SRC) > 0 then, Replace_COMMENT = SRC_ELM_LEVEL_COMMENT Else, If Wordpos(ECB_ACTION_NAME,ActionsThatUse_TGT) > 0 then, Replace_COMMENT = TGT_ELM_LEVEL_COMMENT - If Substr(Replace_COMMENT,1,1) < 'a' then, Do MyRc = 8 @@ -191,10 +166,7 @@ Update_COMMENT: MessageCode = 'U011' Return; End - hexAddress = D2X(Address_REQ_COMMENT) storrep = STORAGE(hexAddress,,Replace_COMMENT) MyRc = 4 - Return; - diff --git a/endevor/Field-Developed-Programs/Exit-Examples/C1UEXTR2-Example#1.rex b/endevor/Field-Developed-Programs/Exit-Examples/C1UEXTR2-Example#1.rex deleted file mode 100644 index 9a25804..0000000 --- a/endevor/Field-Developed-Programs/Exit-Examples/C1UEXTR2-Example#1.rex +++ /dev/null @@ -1,100 +0,0 @@ -/* rexx */ - - STRING = "ALLOC DD(SYSTSPRT) SYSOUT(A) " - CALL BPXWDYN STRING; - STRING = "ALLOC DD(SYSTSIN) DUMMY" - CALL BPXWDYN STRING; - - /* If C1UEXTR2 is allocated to anything, turn on Trace */ - WhatDDName = 'C1UEXTR2' - CALL BPXWDYN "INFO FI("WhatDDName")", - "INRTDSN(DSNVAR) INRDSNT(myDSNT)" - if Substr(DSNVAR,1,1) /= = ' ' then Trace ?r - - Sa= 'You called ....CLSTREXX(C1UEXTR2) ' - - Arg Parms - Parms = Strip(Parms) - sa= 'Parms len=' Length(Parms) - - /* Parms from C1UEXT02 is a string of REXX statements */ - Interpret Parms - MyRc = 0 - Message ='' - MessageCode = ' ' - - /* If CCID is left blank, then apply last used CCID */ - If REQ_CCID = COPIES(' ',12) then Call Update_CCID; - - /* If COMMENT is left blank, then apply last used COMMENT */ - If REQ_COMMENT = COPIES(' ',40) then Call Update_COMMENT; - - sa= 'MyRc =' MyRc - - If REQ_SISO_INDICATOR = 'Y' then - Do - Message = 'Remember that you have set OVERRIDE SIGNOUT' - MyRc = 4 - End - - If ECB_USER_ID = '???JO11' then, - Do - Message = 'Hello There. You have a msg' - MessageCode = '0920' - MyRc = 4 - End - - If MyRc = 0 then Exit - - If Message /= '' then, - Do - hexAddress = D2X(Address_ECB_MESSAGE_TEXT) - storrep = STORAGE(hexAddress,,Message) - hexAddress = D2X(Address_ECB_MESSAGE_LENGTH) - storrep = STORAGE(hexAddress,,'0084'X) - End - - If MessageCode /= ' ' then, - Do - hexAddress = D2X(Address_ECB_MESSAGE_CODE) - storrep = STORAGE(hexAddress,,MessageCode) - End - - /* Tell Endevor something changed or something failed */ - hexAddress = D2X(Address_ECB_RETURN_CODE) - If MyRc = 4 then, - storrep = STORAGE(hexAddress,,'00000004'X) - Else, - storrep = STORAGE(hexAddress,,'00000008'X) - - Exit - -Update_CCID: - - IF SRC_ENV_TYPE_OF_BLOCK = 'C' then, - Replace_CCID = SRC_ELM_ACTION_CCID - Else, - Replace_CCID = TGT_ELM_ACTION_CCID - - If Substr(Replace_CCID,1,1) < 'A' then Return; - - hexAddress = D2X(Address_REQ_CCID) - storrep = STORAGE(hexAddress,,Replace_CCID) - MyRc = 4 - - Return; - -Update_COMMENT: - - IF SRC_ENV_TYPE_OF_BLOCK = 'C' then, - Replace_COMMENT = SRC_ELM_LEVEL_COMMENT - Else, - Replace_COMMENT = TGT_ELM_LEVEL_COMMENT - - If Substr(Replace_COMMENT,1,1) < 'A' then Return; - - hexAddress = D2X(Address_REQ_COMMENT) - storrep = STORAGE(hexAddress,,Replace_COMMENT) - MyRc = 4 - - Return; \ No newline at end of file diff --git a/endevor/Field-Developed-Programs/Exit-Examples/C1UEXTR2-Example#2-With RexAPI.rex b/endevor/Field-Developed-Programs/Exit-Examples/C1UEXTR2-Example#2-With RexAPI.rex deleted file mode 100644 index b7ec0c6..0000000 --- a/endevor/Field-Developed-Programs/Exit-Examples/C1UEXTR2-Example#2-With RexAPI.rex +++ /dev/null @@ -1,394 +0,0 @@ -/* -The REXX C1UEXTR2 is intended to be run from the Endevor EXIT 2 -program C1UEXT02. All the Endevor variables required will be passed -by a parm and interpreted into variables. Values that are to be passed -back to the exit(C1UEXT02) will be changed using the storage command. - -Sample Routines: - FIND_ELEMENT - This routine runs ndevor List API. It will scan the - entire map for all occurrences or the Element being added or - updated. The Element name will be searched for the same System, - Subsystem and Type. The current logic checks if the Element exists - in a specific Environment(ENV2) and Stage(STG4). If it exists, the - signout userid will be checked. If it does not match a specific - id (ROZRIA1) a warning message is produced. - - Update_CCID - If CCID is left blank, then apply last used CCID - - Update_COMMENT - If COMMENT is left blank, then apply last used COMMENT - -*/ - Trace Off - - /*allocate files that may be required for rexx processing*/ - STRING = "ALLOC DD(SYSTSPRT) SYSOUT(A) " - CALL BPXWDYN STRING; - - STRING = "ALLOC DD(SYSTSIN) DUMMY " - CALL BPXWDYN STRING; - - /* If DD C1UEXTR2 is allocated turn on Trace */ - WhatDDName = 'C1UEXTR2' - CALL BPXWDYN "INFO FI("WhatDDName")", - "INRTDSN(DSNVAR) INRDSNT(myDSNT)" - rexx_trace=N /*set the trace (display file) */ - if Substr(DSNVAR,1,1) /= = ' ' then - do - rexx_trace=Y - trace ?R - end - /* If EN$TREXT is allocated to anything, turn on Trace */ - WhatDDName = 'EN$TREXT' - CALL BPXWDYN "INFO FI("WhatDDName")", - "INRTDSN(DSNVAR) INRDSNT(myDSNT)" - if Substr(DSNVAR,1,1) /= = ' ' then - do - /*rexx_trace=Y */ - trace ?R - end - - /*get the parms that are passed from the exit C1UEXT02*/ - Arg Parms - Parms = Strip(Parms) /*trim the spaces*/ - sa= 'Parms len=' Length(Parms) - - /* Parms from C1UEXT02 is a string of REXX statements */ - Interpret Parms - MyRc = 0 /*return code that will be passed back to Endevor*/ - Message ='' /*Message that is passed back to Endevor*/ - /*message code is a 4 diget number. First diget is truncated. - the message text can be found in CSIQMENU in the members - starting with CIUU*/ - MessageCode = ' ' - - /* select processing if the current action is Add or Update*/ - IF (SPACE(ECB_ACTION_NAME) = 'UPDATE') | , - (SPACE(ECB_ACTION_NAME) = 'ADD') THEN - CALL FIND_ELEMENT /*call procedure find_element*/ - -/* If CCID is left blank, then apply last used CCID */ -/* If REQ_CCID = COPIES(' ',12) then Call Update_CCID; */ - - /* If COMMENT is left blank, then apply last used COMMENT */ - /*If REQ_COMMENT = COPIES(' ',40) then Call Update_COMMENT; */ - - /*If REQ_SISO_INDICATOR = 'Y' then - Do - Message = 'Remember that you have set OVERRIDE SIGNOUT' - MyRc = 4 - End - - If ECB_USER_ID = '???JO11' then, - Do - Message = 'Hello Dan. You have a msg' - MessageCode = '0920' - MyRc = 4 - End */ - -/* wrap up Rexx exec. will check return code and messages before exit*/ - - /*clean exi return code 0*/ - If MyRc = 0 then Exit - - /*if a message test is found write it back to - ECB_MESSAGE_TEXT*/ - If Message /= '' then, - Do - hexAddress = D2X(Address_ECB_MESSAGE_TEXT) - storrep = STORAGE(hexAddress,,Message) - hexAddress = D2X(Address_ECB_MESSAGE_LENGTH) - storrep = STORAGE(hexAddress,,'0084'X) - End - - /*if a message code is found write it back to - ECB_MESSAGE_code*/ - If MessageCode /= ' ' then, - Do - hexAddress = D2X(Address_ECB_MESSAGE_CODE) - storrep = STORAGE(hexAddress,,MessageCode) - End - - /*if the return code is 4 or 8 write it back to - ECB_RETURN_CODE */ - hexAddress = D2X(Address_ECB_RETURN_CODE) - If MyRc = 4 then, - storrep = STORAGE(hexAddress,,'00000004'X) - Else, - storrep = STORAGE(hexAddress,,'00000008'X) - - Exit - -/***************************************** -this routine will change the ccid -******************************************/ -Update_CCID: - - IF SRC_ENV_TYPE_OF_BLOCK = 'C' then, - Replace_CCID = SRC_ELM_ACTION_CCID - Else, - Replace_CCID = TGT_ELM_ACTION_CCID - - If Replace_CCID = Copies(' ',12) then Return; - - hexAddress = D2X(Address_REQ_CCID) - storrep = STORAGE(hexAddress,,Replace_CCID) - MyRc = 4 - - Return; - -/***************************************** -this routine will change the comment -******************************************/ -Update_COMMENT: - - IF SRC_ENV_TYPE_OF_BLOCK = 'C' then, - Replace_COMMENT = SRC_ELM_LEVEL_COMMENT - Else, - Replace_COMMENT = TGT_ELM_LEVEL_COMMENT - - If Replace_COMMENT = Copies(' ',40) then Return; - - hexAddress = D2X(Address_REQ_COMMENT) - storrep = STORAGE(hexAddress,,Replace_COMMENT) - MyRc = 4 - - Return; -/****************************************************************** - FIND_ELEMENT in the map (all over) - *****************************************************************/ -FIND_ELEMENT: - - /*free up any file that are used in the procedure*/ - CALL BPXWDYN "FREE DD(BSTAPI) MSG(MSG.)" - CALL BPXWDYN "FREE DD(BSTERR) MSG(MSG.)" - CALL BPXWDYN "FREE DD(SYSPRINT MSG(MSG.)" - CALL BPXWDYN "FREE DD(SYSOUT) MSG(MSG.)" - CALL BPXWDYN "FREE DD(SYSIN) MSG(MSG.)" - CALL BPXWDYN "FREE DD(DDMSG) MSG(MSG.)" - CALL BPXWDYN "FREE DD(DDOUT) MSG(MSG.)" - /************************************************************/ - /* based on csiqcls0(ENTBRAPI) REXX exec. */ - /* Call the API utility program, ENTBJAPI, to build */ - /* a response file containing a list of all occurrences of */ - /* a element in the entire map. */ - /************************************************************/ - /************************************************************/ - - /************************************************************/ - /* Allocate datasets */ - /************************************************************/ - /* - Work Datasets */ - CALL BPXWDYN "ALLOC DD(BSTAPI) DUMMY MSG(MSG.)" - if rc > 0 then say '***ERROR in Alloc of BSTAPI' - if msg.0 > 0 then - do i=1 to msg.0 - say msg.i - end - CALL BPXWDYN "ALLOC DD(BSTERR) DUMMY MSG(MSG.)" - if rc > 0 then say '***ERROR in Alloc of BSTERR' - if msg.0 > 0 then - do i=1 to msg.0 - say msg.i - end - CALL BPXWDYN "ALLOC DD(SYSPRINT) DUMMY MSG(MSG.)" - if rc > 0 then say '***ERROR in Alloc of SYSPRINT' - if msg.0 > 0 then - do i=1 to msg.0 - say msg.i - end - CALL BPXWDYN "ALLOC DD(SYSOUT) DUMMY MSG(MSG.)" - if rc > 0 then say '***ERROR in Alloc of SYSOUT' - if msg.0 > 0 then - do i=1 to msg.0 - say msg.i - end - - /* - Input for ENTBJAPI utility */ - CALL BPXWDYN "ALLOC DD(SYSIN) ", - "SPACE(1,1) CYL DSORG(PS) ", - "LRECL(80) RECFM(FB) " - if rc > 0 then say '***ERROR in Alloc of SYSIN' - - /* - API Message Dataset */ - CALL BPXWDYN "ALLOC DD(DDMSG) ", - "SPACE(1,1) CYL UNIT(SYSDA) DSORG(PS) ", - "LRECL(133) RECFM(FB) " - if rc > 0 then say '***ERROR in Alloc of DDMSG' - - CALL BPXWDYN "ALLOC DD(DDOUT) ", - "SPACE(1,1) CYL DSORG(PS) ", - "LRECL(2048) RECFM(VB) " - if rc > 0 then say '***ERROR in Alloc of DDOUT' - - /************************************************************/ - /* Build AACTL Structure Control Record */ - /************************************************************/ - /* - AACTL Structure Layout */ - /* Keyword CHAR 5 */ - /* Shutdown flag CHAR 1 */ - /* MSG DDN CHAR 8 */ - /* LIST DDN CHAR 8 */ - newstack - queue "AACTLYDDMSG DDOUT " - - /************************************************************/ - /* Build Request Structure Control Record */ - /* Note: Refer to the "Sample Inventory List Function Call */ - /* - ENTBJAPI" section of the API Guide for the */ - /* layout of the request structures */ - /************************************************************/ - /* - ALSYS_RQ Request Structure Layout */ - /* Keyword CHAR 6 */ - /* PATH CHAR 1 */ - /* RETURN CHAR 1 */ - /* SEARCH CHAR 1 */ - /* ENV CHAR 8 */ - /* STAGE ID CHAR 1 */ - /* SYSTEM CHAR 8 - queue "ALSYS", Keyword - || "LAN ", Options - || left(p_envir,8), Environment name - || "*", Stage id - || "*" System */ - /* - ALELM_RQ Request Structure Layout - Keyword CHAR 5 (ALEM) - PATH CHAR 1 L - Logical P - Physical - RETURN CHAR 1 F - Return only the first record that satisfies - the request. - A - Return all records that satisfy the request. - Only choice when the environment is - not explicit - SEARCH CHAR 1 A - Search All the way up the map. - B - Search Between the two specified environments - and stages. - N - No Search. Only choice when the environment - is not explicit. - E - Search next specified environment/stage then - up the map. - R - Search the Range, between and including the - specified environments and stages. - BDATA CHAR 1 B or Y - Return only the basic data. If this - option If this option is enabled, use the - ALELB_RS structure that is defined in - ENHALELM to map the response data fields. - N or blank - Return all element master data. - If this option is enabled, use the ALELM_RS - structure that is defined in ENHALELM to map - the response data fields. - S - Return element change level summary data. - If this option is selected, use the ALELS_RS - structure that is defined in ENHALELM - to map the response data fields. - C - Return component change level summary data. - If this option is selected, use the ALELS_RS - structure that is defined in ENHALELM to map - the response data fields. - For types B and N, you can optionally code - ALELM_RS_FDSN, ALELM_RS_TDSN, or both. You do so - to obtain extension records in addition to the ba - or full master data. - FDSN CHAR 1 Return the 'from' dataset-member/path-file data a - a response record (ALELM_RS_RECTYP=F). - Y - Return this data. - N - Do not return this data. - TDSN CHAR 1 Field length is one character. Return the 'target - dataset-member/path-file data as a response recor - (ALELM_RS_RECTYP=T). - Y - Return this data. - N - Do not return this data. - ENV CHAR 8 - STAGE ID CHAR 1 (Stage ID or Stage Number) - STAGE NUMBER CHAR 1 (1 or 2) - SYSTEM CHAR 8 - SUBSYSTEM CHAR 8 - ELM CHAR 10 - TYPE CHAR 8 - TOENV CHAR 8 Ending Environment name. Used with the "B"etween - or "R"ange SEARCH options. A wildcard character - is not allowed. - TOSTG ID CHAR 1 Field length is one character. Ending Stage ID. - Used with the "B"etween or "R"ange SEARCH options - A wildcard character is not allowed. - (Optional) TOELM CHAR 10 To Element name. If specified, this field can - contain a wildcard. - ELM_THRU CHAR 10 Through Element name. - */ - - - queue "ALELM", /* Keyword */ - || "LAAB", /* Options */ - || left(TGT_ENV_ENVIRONMENT_NAME,8), /* Environment name */ - || "1", /* STAGE NUMBER (as long as it's valid)*/ - || left(TGT_ENV_SYSTEM_NAME,8), /* SYSTEM */ - || left(TGT_ENV_SUBSYSTEM_NAME,8), /* SUBSYSTEM */ - || left(TGT_ENV_ELEMENT_NAME,10), /* ELM */ - || left(TGT_ENV_TYPE_NAME,8), /* TYPE */ - || " ", /* TOENV */ - || " ", /* To Stage id */ - || " ", /* TOELM */ - || " " /* ELM THRU */ - - /************************************************************/ - /* Build ENTBJAPI RUN and quit Control Records */ - /************************************************************/ - queue "RUN" - queue "QUIT" - - /************************************************************/ - /* Write all the Control Records to the SYSIN file */ - /************************************************************/ - "EXECIO 4 DISKW SYSIN (FINIS)" - - /************************************************************/ - /* Execute the API utility program */ - /************************************************************/ - "ENTBJAPI" - - "EXECIO * DISKR DDMSG (STEM DDMSG. FINIS" - /* display messages */ - if rexx_trace=Y then - do - say '---DD DDMSG:'DDMSG.0 - Do I= 1 to DDMSG.0 - say DDMSG.i - end - end - - "EXECIO * DISKR DDOUT (STEM DDOUT. FINIS" - - /*go through the API output file*/ - Do I= 1 to DDOUT.0 - PARSE VAR DDOUT.I 15 TENV 23 TSYS 31 TSUBSYS 39 TELM 49 , - TTYPE 57 TSTAGE 65 95 SIGNOUT_ID 103 REST - if rexx_trace=Y then - do - say DDOUT.i - SAY '---Element 'I' of 'DDout.0 TELM - SAY ' Env:'TENV 'Stage:'TSTAGE 'SIGNOU ID:' SIGNOUT_ID - end - IF (SPACE(TENV) = 'ENV2') & (SPACE(TSTAGE) = 'STG4') THEN - IF SPACE(SIGNOUT_ID) = 'ROZRIA1' THEN - nop - else - do - /*the message variable will be passed back to Endevor - in this case it will be show in the file as per the long - message*/ - Message = 'Not Signed out to ROZRIA1' - /*passing back return code 8 so the add/update stops*/ - /*a rc of 4 will process request. A warming messahe will - appear in the Endevor messages*/ - MyRc = 4 - end - end - /************************************************************/ - /* Free allocations */ - /************************************************************/ - CALL BPXWDYN "FREE DD(BSTAPI)" - CALL BPXWDYN "FREE DD(BSTERR)" - CALL BPXWDYN "FREE DD(SYSPRINT)" - CALL BPXWDYN "FREE DD(SYSOUT)" - CALL BPXWDYN "FREE DD(SYSIN)" - CALL BPXWDYN "FREE DD(DDMSG)" - CALL BPXWDYN "FREE DD(DDOUT)" - RETURN diff --git a/endevor/Field-Developed-Programs/Exit-Examples/C1UEXTR3 Processor Reporting via Exit3.rex b/endevor/Field-Developed-Programs/Exit-Examples/C1UEXTR3 Processor Reporting via Exit3.rex deleted file mode 100644 index 73e555b..0000000 --- a/endevor/Field-Developed-Programs/Exit-Examples/C1UEXTR3 Processor Reporting via Exit3.rex +++ /dev/null @@ -1,113 +0,0 @@ -/* REXX */ -/* -------------------------------------------------------------- */ -/* This is a simple version that: */ -/* o Collects activity by processor and by user */ -/* -------------------------------------------------------------- */ - - STRING = "ALLOC DD(SYSTSPRT) SYSOUT(A) " - CALL BPXWDYN STRING; - STRING = "ALLOC DD(SYSTSIN) DUMMY" - CALL BPXWDYN STRING; - -/* Indicate your choices here..... */ - LoggingPrefix = 'YOURSITE.NDVR.LOGGING' - HowManyEntries= 20 - - /* If C1UEXTR3 is allocated to anything, turn on Trace */ - WhatDDName = 'C1UEXTR3' - CALL BPXWDYN "INFO FI("WhatDDName")", - "INRTDSN(DSNVAR) INRDSNT(myDSNT)" - if Substr(DSNVAR,1,1) /= = ' ' then Trace ?r - - Sa= 'You called ....CLSTREXX(C1UEXTR3) ' - - /* In case these are not provided by the Exit */ - SRC_ELM_ACTION_CCID = ' ' - SRC_ELM_LEVEL_COMMENT = ' ' - TGT_ELM_ACTION_CCID = ' ' - TGT_ELM_LEVEL_COMMENT = ' ' - /* These Element Actions determine whehter to */ - /* use SRC or TGT variables */ - ActionsThatUse_SRC = 'RETRIEVE MOVE DELETE GENERATE' - ActionsThatUse_TGT = 'UPDATE ' - - Arg Parms - Parms = Strip(Parms) - sa= 'Parms len=' Length(Parms) - - /* Parms from C1UEXT02 is a string of REXX statements */ - Interpret Parms - MyRc = 0 - Message ='' - MessageCode = ' ' -/* -*/ - If SRC_ENV_SYSTEM_NAME = 'ADMINSYS' |, - TGT_ENV_SYSTEM_NAME = 'ADMINSYS' then, - Say REQ_USER_DATA - - sa= SRC_ENV_TYPE_OF_BLOCK - sa= TGT_ENV_TYPE_OF_BLOCK - sa= SRC_ENV_IO_TYPE - sa= TGT_ENV_IO_TYPE - - If WordPos(ECB_ACTION_NAME,ActionsThatUse_TGT) > 0 then, - thisElement = TGT_ENV_ELEMENT_NAME - Else, - thisElement = SRC_ENV_ELEMENT_NAME - - If Substr(SRC_ELM_PROCESSOR_NAME,1,1) >= 'A' &, - Substr(SRC_ELM_PROCESSOR_NAME,1,1) <= 'Z' then, - Do - thisProcessor = Strip(SRC_ELM_PROCESSOR_NAME) - If Length(thisProcessor) = 0 then - thisProcessor = Strip(TGT_ELM_PROCESSOR_NAME) - End - Else, - thisProcessor = Strip(TGT_ELM_PROCESSOR_NAME) - - If Length(thisProcessor) = 0 |, - Substr(thisProcessor,1,1) < 'A' |, - Substr(thisProcessor,1,1) > 'Z' then Exit - If Substr(thisElement,1,1) < '$' |, - Substr(thisElement,1,1) > 'Z' then Exit - -/* X = OUTTRAP(LINE.); */ - Call EnterLOGForUSers - Call EnterLOGForProcessors - - Exit - -EnterLOGForUsers: - - UsersLog = LoggingPrefix'.'USERS'('USERID()')' - CALL BPXWDYN "ALLOC DD(USERLOG) DA("UsersLog") SHR" - usr.0 = 0 - "Execio * DISKR USERLOG (Stem usr. Finis" - WriteThismany = Min(HowManyEntries, usr.0) - sa= 'Have' WriteThismany - Push thisElement "@"DATE('S') TIME(), - "Processor="thisProcessor REQ_ACTION_RC - "Execio 1 DISKW USERLOG " - "Execio" WriteThismany, - "DISKW USERLOG (Stem usr. Finis" - CALL BPXWDYN "FREE DD(USERLOG)" - Return - -EnterLOGForProcessors: - - ProcessorLog = LoggingPrefix'.'PROCESS'('Strip(thisProcessor)')' - CALL BPXWDYN "ALLOC DD(PROCLOG) DA("ProcessorLog") SHR" - prc.0 = 0 - "Execio * DISKR PROCLOG (Stem prc. Finis" - WriteThismany = Min(HowManyEntries, prc.0) - sa= 'Have' WriteThismany - Push Userid() "@"DATE('S') TIME(), - "Element="thisElement REQ_ACTION_RC - "Execio 1 DISKW PROCLOG " - "Execio" WriteThismany, - "DISKW PROCLOG (Stem prc. Finis" - CALL BPXWDYN "FREE DD(PROCLOG)" - - Return - diff --git a/endevor/Field-Developed-Programs/Exit-Examples/C1UEXTR7 WithRexDriver.rex b/endevor/Field-Developed-Programs/Exit-Examples/C1UEXTR7 WithRexDriver.rex new file mode 100644 index 0000000..4e3d077 --- /dev/null +++ b/endevor/Field-Developed-Programs/Exit-Examples/C1UEXTR7 WithRexDriver.rex @@ -0,0 +1,1297 @@ +/* rexx */ +/* Perform various Package actions in REXX */ +/* */ +/* A COBOL exit CALLS this REXX and provides values for */ +/* REXX variables, including these. */ +/* Find documentation on these in the TechDocs documentation */ +/* where each underscore appears as a dash in the documentation. */ +/* For example, PECB_PACKAGE_ID is documented as */ +/* PECB-PACKAGE-ID */ +/* */ +/* PECB_PACKAGE_ID PAPP_GROUP_NAME */ +/* PECB_FUNCTION_LITERAL PAPP_ENVIRONMENT */ +/* PECB_SUBFUNC_LITERAL PAPP_QUORUM_COUNT */ +/* PECB_BEF_AFTER_LITERAL PAPP_APPROVER_FLAG */ +/* PECB_USER_BATCH_JOBNAME PAPP_APPR_GRP_TYPE */ +/* PREQ_PKG_CAST_COMPVAL PAPP_APPR_GRP_DISQ */ +/* PHDR_PKG_SHR_OPTION PAPP_SEQUENCE_NUMBER */ +/* PHDR_PKG_ENV */ +/* PHDR_PKG_STGID */ +/* Address fields are provided for fields that may be */ +/* modified by the REXX. */ +/* Address_PECB_MESSAGE Address_MYSMTP_SUBJECT */ +/* Address_MYSMTP_MESSAGE Address_MYSMTP_TEXT */ +/* Address_MYSMTP_USERID Address_MYSMTP_URL */ +/* Address_MYSMTP_FROM Address_MYSMTP_EMAIL_IDS */ +/* MYSMTP_EMAIL_IDS MYSMTP_EMAIL_ID_SIZE */ +/* */ + /* If wanting to limit the use of this exit, uncomment... */ +/* + If USERID() /= 'IBMUSER' &, + USERID() /= 'JW61868' &, + USERID() /= 'JW618685' then Say USERID() +*/ + /* In case these are not already allocated, these are attempted */ + STRING = "ALLOC DD(SYSTSPRT) SYSOUT(A) " + CALL BPXWDYN STRING; + STRING = "ALLOC DD(SYSTSIN) DUMMY" + CALL BPXWDYN STRING; + /* If C1UEXTR7 is allocated to anything, turn on Trace */ + WhatDDName = 'C1UEXTR7' + CALL BPXWDYN "INFO FI("WhatDDName")", + "INRTDSN(DSNVAR) INRDSNT(myDSNT)" + if RESULT = 0 then TraceRQ = 'Y' + /* Initialize variables.... */ + Message = '' + MessageCode = ' ' + MyRc = 0 + /* Parms are REXX statements passed from COBOL exit */ + Arg Parms + Parms = Strip(Parms) + sa= 'Parms len=' Length(Parms) + If TraceRQ = 'Y' then, + Say 'C1UEXTR7 is called again:' + /* Parms from C1UEXT07 is a string of REXX statements */ + /* Validate and interpret if validation is OK */ + myRC = EvaluateParms() + If myRC > 4 then Exit(12) + /* Interpret Parms */ + If Substr(PHDR_PKG_NOTE5,1,5) = 'TRACE' then TraceRQ = 'Y' + If TraceRQ = 'Y' then, + If PECB_MODE = 'B' then Trace r + Else Trace ?r + where = 'C1UEXTR7' + what = 'C1UEXTR7-' PECB_FUNCTION_LITERAL, + PECB_BEF_AFTER_LITERAL, + PHDR_PACKAGE_STATUS + /* Find GTUNIQUE on GitHub in the folder- */ + /* endevor/Field-Developed-Programs/Miscellaneous-items */ + Unique_Name = GTUNIQUE() + /* Validate Package prefix with ServiceNow */ + If PECB_FUNCTION_LITERAL ='CREATE' &, + PECB_BEF_AFTER_LITERAL ='BEFORE' &, + (Substr(PECB_PACKAGE_ID,1,3) = 'PRB' |, + Substr(PECB_PACKAGE_ID,1,3) = 'CHG' ) then, + Do + PackageSnowRef = Substr(PECB_PACKAGE_ID,1,10) + /* Find SERVINOW on GitHub in the folder- */ + /* \ServiceNow-Interface\COBOL+REXX+PythonOrGoLang-Example*/ + Message = SERVINOW('C1UEXTR7' PackageSnowRef ECB_TSO_BATCH_MODE) + If POS('**NOT**', Message) > 0 then, + Do + MyRc = 8 + Call SetExitReturnInfo + Exit + End; /* If POS('**NOT**', Message) > 0 */ + End; /* If PECB_FUNCTION_LITERAL ='CREATE' ... */ + /* If the package status just became IN-APPROVAL, send emails */ + /* to request approval(s). */ + IF PHDR_PACKAGE_STATUS = 'IN-APPROVAL' &, + PECB_BEF_AFTER_LITERAL = 'AFTER' &, + PECB_FUNCTION_LITERAL = 'CAST' &, + Substr(CALL_REASON,1,16) = 'APPROVER GROUP #' then, + Do + /* Find SENDMAIL on GitHub in the folder- */ + /* endevor/Field-Developed-Programs/... */ + /* Email-For-External-Approver-Groups */ + Call SENDMAIL PAPP_GROUP_NAME PECB_PACKAGE_ID, + 'Needs-Approval' PAPP_APPROVAL_IDS + Exit + End + IF PHDR_PACKAGE_STATUS = 'APPROVED' &, + PECB_BEF_AFTER_LITERAL = 'AFTER' &, + (PECB_FUNCTION_LITERAL = 'CAST' |, + PECB_FUNCTION_LITERAL = 'REVIEW') Then, + Do + GoExecute = 'Y' + Call CheckExecutionWindow + If GoExecute = 'Y' then, + DO + Call Get_Site_Shipping_Variables + PKGEXECT_Parm = Copies(' ',055) + PKGEXECT_Parm = Overlay(PECB_PACKAGE_ID ,PKGEXECT_Parm,001) + PKGEXECT_Parm = Overlay(PHDR_PKG_ENV ,PKGEXECT_Parm,018) + PKGEXECT_Parm = Overlay(PHDR_PKG_STGID ,PKGEXECT_Parm,026) + PKGEXECT_Parm = Overlay(REXX_EXEC_MODE ,PKGEXECT_Parm,028) + PKGEXECT_Parm = Overlay(PHDR_PKG_CREATE_USER,PKGEXECT_Parm,029) + PKGEXECT_Parm = Overlay(PHDR_PKG_UPDATE_USER,PKGEXECT_Parm,037) + PKGEXECT_Parm = Overlay(PHDR_PKG_CAST_USER ,PKGEXECT_Parm,045) + /* Find PKGEXECT on GitHub in the folder- */ + /* endevor/Field-Developed-Programs/Package-Automation */ + Call PKGEXECT PKGEXECT_Parm + End /* If GoExecute = 'Y' */ + Exit + End + /* If a package is being Backed out/in in batch */ + If Substr(PECB_FUNCTION_LITERAL,1,4) = 'BACK' &, + PECB_MODE = 'B' then, + Do + message = 'C1UEXTR7 -', + 'Package Backout/Backin unAuthorized for Batch' + MyRc = 8 + Call SetExitReturnInfo + If TraceRQ = 'Y' then Say 'C1UEXTR7 is exiting @123 ' + Exit + End + /* Before a package is being Backed out/in .... */ + IF PECB_BEF_AFTER_LITERAL = 'BEFORE' & PECB_MODE = 'T' &, + Substr(PECB_FUNCTION_LITERAL,1,4) = 'BACK' then, + Do + what = 'C1UEXTR7 before Backout/Backin' + ADDRESS TSO "EXECIO 1 DISKR AUTHORIZ (Finis" + pull BakoutCCID + BakoutCCID = Strip(BakoutCCID) + /* Find BKOUTLOG on GitHub in the folder- */ + /* endevor/Field-Developed-Programs/... */ + /* Package-Backout-Logging */ + Call BKOUTLOG PECB_PACKAGE_ID 'Before', + BakoutCCID USERID() + End + /* If a package is being Backed out/in .... */ + IF PECB_BEF_AFTER_LITERAL = 'AFTER' & PECB_MODE = 'T' &, + Substr(PECB_FUNCTION_LITERAL,1,4) = 'BACK' then, + Do + what = 'C1UEXTR7 after Backout/Backin' + ADDRESS TSO "EXECIO 1 DISKR AUTHORIZ (Finis" + pull BakoutCCID + CALL BPXWDYN "FREE DD(AUTHORIZ)" + BakoutCCID = Strip(BakoutCCID) + Call BKOUTLOG PECB_PACKAGE_ID 'After', + BakoutCCID USERID() + ModelMember = 'SHIPRUNS' + Call SubmitBatchJCL + Exit + End + /* If a package is executed, examine for package shipments */ + /* Examine NOTES to determine whether the Package NOTES */ + /* contain Shipping instructions... */ + /* You can limit this action to packages with Approvals */ + /* by including the next line.... */ + /* PECB_ACT_REC_EXIST_FLAG = 'Y' &, */ + IF PECB_BEF_AFTER_LITERAL = 'AFTER' &, + (Substr(PECB_FUNCTION_LITERAL,1,4) = 'EXEC' |, + Substr(PECB_FUNCTION_LITERAL,1,4) = 'BACK') then, + Do + TodaysDate = DATE('S') ; + NOW = TIME(L); + HOUR = SUBSTR(NOW,1,2) ; + IF HOUR = '00' THEN HOUR = '0' + MINUTE = SUBSTR(NOW,4,2) ; + CurrentTime= HOUR || MINUTE ; + TriggerFileName = '?' + /* Pulling shipment data from package notes */ + /* Examine Package notes to find Destination and schedule info */ + /* - Submit Package Shipments for those that can be submitted */ + /* immeditely. */ + /* (future submissions are not supported ) */ + Do n# = 8 to 1 by -1 + noteline = VALUE('PHDR_PKG_NOTE' || n#) + sa = noteline + if Substr(noteline,1,3) /= "TO " then Iterate ; + if Substr(noteline,12,2) /= ": " then Iterate ; + If Words(noteline) < 6 then Iterate ; + noteline = Substr(Overlay(" ",noteline,12),3) ; + Destination = Word(noteline,1) ; + /* Default to first model */ + /* Get info for Destination */ + Call GetDestinationInfoViaCSV + If Hostprefix = "?" then, + Do + Say 'PKGESHIP - Destination not found' Destination + Iterate; + End + ShipSchedulingMethod = 'Notes' + Call UpdateTriggerFromNotes + End; /* Do n# = 8 to 1 by -1 */ + If TriggerFileName /= '?' then, + Do + "EXECIO 0 DISKW TRIGGER (Finis " + Call FreeTriggerFile + interpret 'Call' WhereIam "'MySEN2Library'" + MySEN2Library = Result + PULLTGGRParms = USERID()'.PULLTGGR' MySEN2Library + Call PULLTGGR PULLTGGRParms ; + End /* If After EXEC | BACK */ + Exit + End /* If After EXEC | BACK ... for Ship by NOTES */ + /* If a package is executed, examine for package shipments */ + /* You can limit this action to packages with Approvals */ + /* by including the next line.... */ + /* PECB_ACT_REC_EXIST_FLAG = 'Y' &, */ + IF PECB_BEF_AFTER_LITERAL = 'AFTER' &, + (Substr(PECB_FUNCTION_LITERAL,1,4) = 'EXEC' |, + Substr(PECB_FUNCTION_LITERAL,1,4) = 'BACK') then, + Do + If TraceRQ = 'Y' then Say 'C1UEXTR7 is exiting @160 ' + /* Find PKGESHIP on GitHub in the folder- */ + /* endevor/Field-Developed-Programs/Package-Automation */ + PKGESHIP_Parm = Copies(' ',055) + PKGESHIP_Parm = Overlay(PECB_PACKAGE_ID ,PKGESHIP_Parm,001) + PKGESHIP_Parm = Overlay(PHDR_PKG_ENV ,PKGESHIP_Parm,018) + PKGESHIP_Parm = Overlay(PHDR_PKG_STGID ,PKGESHIP_Parm,027) + PKGESHIP_Parm = Overlay(REXX_EXEC_MODE ,PKGESHIP_Parm,028) + PKGESHIP_Parm = Overlay(PHDR_PKG_CREATE_USER,PKGESHIP_Parm,029) + PKGESHIP_Parm = Overlay(PHDR_PKG_UPDATE_USER,PKGESHIP_Parm,037) + PKGESHIP_Parm = Overlay(PHDR_PKG_CAST_USER ,PKGESHIP_Parm,045) + PKGESHIP_Parm = Overlay(PHDR_PKG_NOTE1 ,PKGESHIP_Parm,054) + PKGESHIP_Parm = Overlay(PHDR_PKG_NOTE2 ,PKGESHIP_Parm,114) + PKGESHIP_Parm = Overlay(PHDR_PKG_NOTE3 ,PKGESHIP_Parm,174) + PKGESHIP_Parm = Overlay(PHDR_PKG_NOTE4 ,PKGESHIP_Parm,234) + PKGESHIP_Parm = Overlay(PHDR_PKG_NOTE5 ,PKGESHIP_Parm,294) + PKGESHIP_Parm = Overlay(PHDR_PKG_NOTE6 ,PKGESHIP_Parm,354) + PKGESHIP_Parm = Overlay(PHDR_PKG_NOTE7 ,PKGESHIP_Parm,414) + PKGESHIP_Parm = Overlay(PHDR_PKG_NOTE8 ,PKGESHIP_Parm,474) + If Substr(PECB_FUNCTION_LITERAL,1,4) = 'BACK' then, + PKGESHIP_Parm = Overlay('BAK' ,PKGESHIP_Parm,584) + Else, + PKGESHIP_Parm = Overlay('OUT' ,PKGESHIP_Parm,584) + /* Find PKGESHIP on GitHub in the folder- */ + /* endevor/Field-Developed-Programs/Package-Automation */ + Call PKGESHIP PKGESHIP_Parm + If TraceRQ = 'Y' then Say 'C1UEXTR7 is exiting @183 ' + Exit + End + If MyRc > 0 then Call SetExitReturnInfo + /* Another way to Determine if Trace is wanted... */ + If Substr(PHDR_PKG_NOTE5,1,5) = 'TRACE' then TraceRQ = 'Y' + If TraceRQ = 'Y' then, + Do + Sa= 'CALL_REASON = ' CALL_REASON + Sa= 'PECB_FUNCTION_LITERAL = ' PECB_FUNCTION_LITERAL + Sa= 'PECB_SUBFUNC_LITERAL = ' PECB_SUBFUNC_LITERAL + Sa= 'PECB_BEF_AFTER_LITERAL= ' PECB_BEF_AFTER_LITERAL + Sa= 'PECB_PACKAGE_ID = ' PECB_PACKAGE_ID + Sa= 'MYSMTP_EMAIL_ID_SIZE = ' MYSMTP_EMAIL_ID_SIZE + End + /* Early outs .... */ + If PECB_FUNCTION_LITERAL = 'SETUP' then Exit + /* Execute a SonarQube analysis? */ + /* Look at Notes to see if SonarQube processing or */ + /* Package Shipment via Notes are given. */ + /* Set to values indicating unassigned */ + If PECB_FUNCTION_LITERAL ='CAST' &, + PECB_SUBFUNC_LITERAL ='CAST' &, + PECB_BEF_AFTER_LITERAL ='BEFORE' then, + Do + /* Set these to un-initialized values */ + Cast_Location_for_Sonarqube = '' + Wait_for_SonarQube = '' + SonarQube_Element_Types = '' + /* Package notes may make or override SonarQube requests */ + Call CheckPackageNotesBeforeCast; + If Cast_Location_for_Sonarqube /= 'none' then, + Do + SonarDSNPrefix = USERID()'.SONRQUBE.' || Unique_Name + Call SonarQubeAnalysisAndKickoff + End + End; /* If PECB_FUNCTION_LITERAL ='CAST' ... BEFORE */ + /* Enforce packages to be Backout Enabled */ + IF PREQ_BACKOUT_ENABLED /= 'Y' then, + Do + Message = 'C1UEXTR7 - Package made to be Backout enabled' + MyRc = 4 + hexAddress = D2X(Address_PREQ_BACKOUT_ENABLED) + storrep = STORAGE(hexAddress,,'Y') + Call SetExitReturnInfo + Exit + End; + If TraceRQ = 'Y' then Say 'C1UEXTR7 is exiting @280 ' + EXIT + If PECB_FUNCTION_LITERAL ='CAST' &, + PECB_SUBFUNC_LITERAL ='CAST' &, + PECB_APP_REC_EXIST_FLAG="Y" &, + PECB_BEF_AFTER_LITERAL ='AFTER' then, + Call ManageEmails ; + Exit +EvaluateParms: + $numbers = '0123456789.' /* chars for numeric values */ + RemainingParms = Strip(Parms) + Do Until Words(Remainingparms) < 1 + Parse Var RemainingParms $keyword '=' RemainingParms + $keyword = Strip($keyword) + RemainingParms = Strip(RemainingParms,'L') + $firstchar = Substr(RemainingParms,1,1) + If $firstchar = '"' then $NumericValue = 0 + Else, + Do + $firstNonNumeric =, + VERIFY(RemainingParms,$numbers || ' ') + $NumericValue =, + Substr(RemainingParms,$firstNonNumeric,1) = ';' + End + /* Value must be numeric, or be double quoted */ + If words($keyword) /= 1 |, + DATATYPE($keyword,SYMBOL) /= 1 |, + ($NumericValue = 0 & $firstchar /= '"') then, + Do + Parse var RemainingParms dropit ';' RemainingParms + Say "Invalid syntax-" $keyword '=' dropit + myAcct = GETACCTC() + myJobnr = GETJOBNR() + parm="Invalid syntax-" command '=' dropit + parm='Usr=' || USERID() 'Acct='myAcct dropit + parm= parm || ' jobnumber=' myJobnr + parm=Left(parm,70) + Address LINKMVS "WTO#MSG parm" + Return 12 + End + Else /* double quoted value */ + If VERIFY($firstchar,$numbers) > 0 then, + Do + Parse var RemainingParms '"' $value '"' blanks ";" RemainingParms + command = $keyword '=' '"' || Strip($value) || '"' + End + Else /* numeric value */ + Do + Parse var RemainingParms $value ';' RemainingParms + command = $keyword '=' Strip($value) + End + RemainingParms = strip(RemainingParms) + If TraceRQ = 'Y' then say command + interpret command + End; /* Do rexx# = 1 to Words(RemainingParms) */ + Return 0 +CheckPackageNotesBeforeCast: + sa = Force_CAST_in_Batch + /* Package notes may make or override SonarQube requests */ + AllNotes = PHDR_PKG_NOTE1 PHDR_PKG_NOTE2, + PHDR_PKG_NOTE3 PHDR_PKG_NOTE4, + PHDR_PKG_NOTE5 PHDR_PKG_NOTE6, + PHDR_PKG_NOTE7 PHDR_PKG_NOTE8 + AllNotes = Translate(AllNotes,' ','="_') + AllNotes = Translate(AllNotes,' ',"'-") + /* To match any case, we are forcing upper case here */ + Upper AllNotes + wheretext = Pos('RUN SONARQUBE', AllNotes) + If wheretext > 0 then, + Do + Cast_Location_for_Sonarqube = 'notes' + Force_CAST_in_Batch = 'Y' ; + Say 'C1UEXTR7 - user notes request', + 'a SonarQube Analysis ' + End + wheretext = Pos('BYPASS SONARQUBE WAIT', AllNotes) + If wheretext > 0 then, + Do + Wait_for_SonarQube = 'N' + Say 'C1UEXTR7 - user notes request', + 'to Bypass the wait for the SonarQube Analysis' + End + wheretext = Pos('BYPASS SONARQUBE ANALYSIS', AllNotes) + If wheretext > 0 then, + Do + Cast_Location_for_Sonarqube = 'none' + Say 'C1UEXTR7 - user notes request', + 'SonarQube Analysis be bypassed' + End + Return +Get_Site_Shipping_Variables: + /* Get the related site-level options */ + WhereIam = Strip(Left("@"MVSVAR(SYSNAME),8)) ; + /* ShipSchedulingMethod can be set by C1System */ + interpret 'Call' WhereIam, + "'ShipSchedulingMethod_"PackageSystem"'" + ShipSchedulingMethod = Result + If Wordpos(ShipSchedulingMethod,'Rules Notes One None') = 0 then, + Do + interpret 'Call' WhereIam "'ShipSchedulingMethod'" + ShipSchedulingMethod = Result + End + Return +Get_SonarQube_variables: + /* If unassigned.... */ + /* identify Choices for SonarQube Scanning */ + /* Cast_Location_for_Sonarqube can be set by C1System */ + WhereIam = Strip(Left("@"MVSVAR(SYSNAME),8)) ; + If Force_CAST_in_Batch /= 'Y' then, + Do + interpret 'Call' WhereIam, + "'Force_CAST_in_Batch_"PackageSystem"'" + Force_CAST_in_Batch = Result + End + If Wordpos(Force_CAST_in_Batch,'Y N') = 0 then, + Do + interpret 'Call' WhereIam "'Force_CAST_in_Batch'" + Force_CAST_in_Batch = Result + End + If Cast_Location_for_Sonarqube = '' then, + Do + interpret 'Call' WhereIam, + "'Cast_Location_for_Sonarqube_"PackageSystem"'" + Cast_Location_for_Sonarqube = Result + If Words(Cast_Location_for_Sonarqube) /= 2 then, + Do + interpret 'Call' WhereIam "'Cast_Location_for_Sonarqube'" + Cast_Location_for_Sonarqube = Result + End + End ; /* If Words(Cast_Location_for_Sonarqube) */ + If Cast_Location_for_Sonarqube = 'notes' |, + Words(Cast_Location_for_Sonarqube) = 2 then, + Do + If Wait_for_SonarQube = '' then, + Do + /* If unassigned.... */ + interpret 'Call' WhereIam, + "'Wait_for_SonarQube_"PackageSystem"'" + Wait_for_SonarQube = Result + If Length(Wait_for_SonarQube) /= 1 then, + Do + interpret 'Call' WhereIam "'Wait_for_SonarQube'" + Wait_for_SonarQube = Result + End + End; /* If Wait_for_SonarQube = '' */ + interpret 'Call' WhereIam, + "'SonarQube_Element_Types_"PackageSystem"'" + SonarQube_Element_Types = Result + If SonarQube_Element_Types = 'Not-valid' then, + Do + interpret 'Call' WhereIam "'SonarQube_Element_Types'" + SonarQube_Element_Types = Result + End + End /* If Cast_Location_for_Sonarqube ..... */ + Return ; +SonarQubeAnalysisAndKickoff: + /* Do an EXPORT to Capture the Package SCL */ + Call CapturePackageSCL + /* Convert exported SCL into a Table format */ + STRING = "ALLOC DD(RESULTS) LRECL(80) BLKSIZE(24000) ", + " DSORG(PS) ", + " SPACE(5,5) RECFM(F,B) TRACKS ", + " NEW UNCATALOG REUSE "; + CALL BPXWDYN STRING; + /* Use SCAN#SCL to create a TABLE from the SCL content */ + /* Find SCAN#SCL on GitHub in the folder- */ + /* endevor/Field-Developed-Programs/Miscellaneous-items */ + Call SCAN#SCL 'TABLE' + /* Does this package require SonarQube analysis? */ + "EXECIO * DISKR RESULTS (Stem tblscl. Finis" + whereSystem = Pos('System ',tblscl.1) + whereCommand= Pos('Command ',tblscl.1) + whereEnvmnt = Pos('Envmnt ',tblscl.1) + whereStg = Pos(' S ',tblscl.1) + 1 + If whereSystem = 0 |, + whereCommand = 0 |, + whereEnvmnt = 0 |, + whereStg = 0 then + Do + message = 'C1UEXTR7 -', + 'RESULTS Table format error or SCAN#SCL error ' + MyRc = 8 + Call SetExitReturnInfo + Exit + End / * If whereSystem = 0 ..... */ + PackageSystem = word(Substr(tblscl.2,whereSystem),1) + Call Get_SonarQube_variables + /* If this site indicates all CASTS are to run in Batch */ + If PECB_MODE = "T" &, /* TSO foreground */ + Force_CAST_in_Batch= 'Y' then, , + Do + ModelMember = 'CAST#JCL' + Call SubmitBatchJCL + Message = JobData + MyRc = 8 + PACKAGE = PECB_PACKAGE_ID + MessageCode = 'U033' + Call SetExitReturnInfo + Exit + End + sa = Cast_Location_for_Sonarqube + sa = SonarQube_Element_Types + PackageCommand= word(Substr(tblscl.2,whereCommand),1) + PackageEnvmnt = word(Substr(tblscl.2,whereEnvmnt),1) + PackageStg = word(Substr(tblscl.2,whereStg),1) + /* Adjust the Environment and StageID if a MOVE action */ + If Cast_Location_for_Sonarqube /= 'notes' &, + PackageCommand = 'MOVE' then, + Do + /* Find GTUNIQUE on GitHub in the folder- */ + /* endevor/Field-Developed-Programs/Miscellaneous-items */ + NextLocation = GTNXTSTG(PackageEnvmnt PackageStg) + PackageEnvmnt = Word(NextLocation,1) + PackageStg = Word(NextLocation,2) + sa = Cast_Location_for_Sonarqube '|' PackageEnvmnt PackageStg + End /* If PackageCommand = 'MOVE' */ + /* Based on just looking at Site variables, including those */ + /* for the c1System, we can */ + /* Exit if a SonarQube run is not expected for this package */ + If Cast_Location_for_Sonarqube /= 'notes' &, + Cast_Location_for_Sonarqube /= PackageEnvmnt PackageStg then, + Do + Call FREE_Files_For_ProcessingPackageSCL + Return + End + /* Either Notes or Cast_Location_for_Sonarqube says */ + /* we should continue. */ + /* See if types are designated for SonarQube Scanning */ + If Cast_Location_for_Sonarqube = 'notes' then foundmatch = 1 + Else, + Do + foundmatch = 0 + /* Examine Element Types in package */ + /* Search packaged types for list of SonarQube Types */ + whereType = Pos('Type ',tblscl.1) + Do typ# = 2 to tblscl.0 + C1ElType = word(Substr(tblscl.typ#,whereType),1) + Do s# = 1 to Words(SonarQube_Element_Types) + typemask = Word(SonarQube_Element_Types,s#) + /* Find QMATCH on GitHub in the folder- */ + /* endevor/Field-Developed-Programs/Miscellaneous-items*/ + foundmatch = QMATCH(C1ElType typemask) + If foundmatch then Leave; + End /* Do s# = 1 to Words(SonarQube_Element_Types) */ + If foundmatch then Leave; + End; /* Do typ# = 2 to tblscl.0 */ + End /* Else.. If Cast_Location_for_Sonarqube = 'notes' */ + /* Based on the types in this package, no SonarQube analysis*/ + /* is expected. */ + If foundmatch = 0 then, + Do + Call FREE_Files_For_ProcessingPackageSCL + Return + End + /* A SonarQube run is expected */ + /* Are we running in TSO foreground? */ + If PECB_MODE = "T" then, /* TSO foreground */ + Do + Call FREE_Files_For_ProcessingPackageSCL + ModelMember = 'CAST#JCL' + Call SubmitBatchJCL + Message = JobData + MyRc = 8 + PACKAGE = PECB_PACKAGE_ID + MessageCode = 'U033' + Call SetExitReturnInfo + Exit + End + /* Running in Batch.. */ + /* Preparing the SonarQube run. Create the Work file */ + SonarWorkfile = SonarDSNPrefix || '.SONARWRK' + SonarElmDSN = SonarDSNPrefix || '.SONARELM' + STRING = "ALLOC DD(WRKFILE) LRECL(080) BLKSIZE(24000) ", + " DA("SonarWorkfile") ", + " DSORG(PO) DSNTYPE(LIBRARY) DIR(9) ", + " SPACE(5,5) RECFM(F,B) CYL ", + " NEW CATALOG REUSE "; + CALL BPXWDYN STRING; + CALL BPXWDYN "FREE DD(WRKFILE)" + /* Save exported tblscl */ + CALL BPXWDYN "FREE DD(RESULTS)" + STRING =, + "ALLOC DD(RESULTS) DA("SonarWorkfile"(PKGTBL)) SHR REUSE" + CALL BPXWDYN STRING; + "EXECIO" tblscl.0 "DISKW RESULTS (Stem tblscl. Finis" + /* Save exported SCL */ + "EXECIO * DISKR SCL (Stem scl. Finis" + CALL BPXWDYN "FREE DD(SCL)" ; + STRING = "ALLOC DD(SCL) DA("SonarWorkfile"(SCL)) SHR REUSE" + CALL BPXWDYN STRING; + "EXECIO * DISKW SCL (Stem scl. Finis" + STRING = "ALLOC DD(SONARELM) LRECL(080) BLKSIZE(24000) ", + " DA("SonarElmDSN") ", + " DSORG(PO) DSNTYPE(LIBRARY) DIR(9) ", + " SPACE(5,5) RECFM(F,B) CYL ", + " NEW CATALOG REUSE "; + CALL BPXWDYN STRING; + CALL BPXWDYN "FREE DD(SONARELM) " + /* Create TimeStamp member in the SonarWorkfile */ + TimeStamp = DATE('S') TIME() + STRING="ALLOC DD(TIMESTMP) DA("SonarWorkfile"(@TIME)) SHR REUSE" + CALL BPXWDYN STRING; + Queue "TimeStamp = '"TimeStamp"'" + Queue "Package = '"PECB_PACKAGE_ID"'" + Queue "WaitOption= '"Wait_for_SonarQube"'" + "EXECIO 3 DISKW TIMESTMP (FINIS "; /* count queued */ + CALL BPXWDYN "FREE DD(TIMESTMP)" ; + /* Find SONRQUBE on GitHub in the folder- */ + /* Field-Developed-Programs\SonarQube-interface-to-Endevor */ + Message =, + SONRQUBE(PackageSystem, + Wait_for_SonarQube, + Unique_Name, + PECB_PACKAGE_ID) + Call FREE_Files_For_ProcessingPackageSCL + If Message /= '' then, + Do + MyRc = 8 + Call SetExitReturnInfo + End + Return ; +CapturePackageSCL: + STRING = "ALLOC DD(C1MSGS1) SYSOUT(A)" + CALL BPXWDYN STRING; + STRING = "ALLOC DD(BSTERR) SYSOUT(A)" + CALL BPXWDYN STRING; + STRING = "ALLOC DD(BSTAPI) SYSOUT(A)" + CALL BPXWDYN STRING; + /* Export the Package content into SCL e */ + STRING = "ALLOC DD(SCL) LRECL(080) BLKSIZE(24000) ", + " DSORG(PS) ", + " SPACE(5,5) RECFM(F,B) TRACKS ", + " NEW UNCATALOG REUSE "; + CALL BPXWDYN STRING; + STRING = "ALLOC DD(ENPSCLIN) LRECL(80) BLKSIZE(24000) ", + " DSORG(PS) ", + " SPACE(5,5) RECFM(F,B) TRACKS ", + " NEW UNCATALOG REUSE "; + CALL BPXWDYN STRING; + QUEUE "EXPORT PACKAGE '"PECB_PACKAGE_ID"'" + QUEUE " TO DDN 'SCL' ." + "EXECIO 2 DISKW ENPSCLIN (FINIS "; /* count queued */ + ADDRESS LINK 'ENBP1000' ; /* run from CSIQAUTH*/ + call_rc = rc ; + CALL BPXWDYN "FREE DD(BSTAPI) " ; + CALL BPXWDYN "FREE DD(BSTERR) " ; + CALL BPXWDYN "FREE DD(C1MSGS1) " ; + CALL BPXWDYN "FREE DD(ENPSCLIN)" ; + /* Caller is responsible for freeing SCL */ + Return ; +CheckExecutionWindow: + /* Check the Execution window for immediate package Execution */ + curntTimestamp = Substr(DATE('S'),3) || '@'|| Substr(TIME(),1,5) + startTimestamp = ConvertDate(PREQ_EXEC_START_DATE) ||'@'||, + PREQ_EXEC_START_TIME + sa= curntTimestamp startTimestamp PREQ_EXEC_START_DATE + If curntTimestamp < startTimestamp then, + Do + GoExecute = 'N' + Return + End + ENDTimestamp = ConvertDate(PREQ_EXEC_END_DATE) ||'@'||, + PREQ_EXEC_END_TIME + sa= curntTimestamp ENDTimestamp PREQ_EXEC_END_DATE + If curntTimestamp > ENDTimestamp then GoExecute = 'N' + Return +ConvertDate: + alphaMonths = 'JAN FEB MAR APR MAY JUN JUL AUG SEP OCT NOV DEC' + /* convert date from 24FEB26 format to a 260224 format */ + Arg dateToConvert + ConvertedDay = Substr(dateToConvert,1,2) + ConvertedMon = Substr(dateToConvert,3,3) + ConvertedMon = WordPos(ConvertedMon,alphaMonths) + ConvertedMon = Right(ConvertedMon,2,'0') + ConvertedYear= Substr(dateToConvert,6,2) + sa= thisYear ConvertedYear + Converted_Date = Convertedyear || ConvertedMon || ConvertedDay + return Converted_Date +ManageEmails: + If TraceRQ = 'Y' then Trace ?R + whereami = 'ManageEmails' + /* Only run if the exit is giving us an Approver Group */ + If Substr(CALL_REASON,1,16) = 'APPROVER GROUP #' then, + Do + Call SaveOffApproverGrpInfo + Return + End + /*****************************************************************/ + /* Initializaztion and Example statements */ + /*****************************************************************/ + MySMTP_Message =, + 'From REXX(C1UEXTR7)' + MySMTP_Subject = 'Please Approve Package' PECB_PACKAGE_ID + MySMTP_From = Left('YOURSITE your testing Endevor',50) + MySMTP_textline.1 = 'Package' PECB_PACKAGE_ID, + ' has been CAST and is ready for APPROVAL.' + MySMTP_textline.2 = 'Your Review and approval of package', + PECB_PACKAGE_ID 'is reqested.' + MySMTP_textline.3 = ' ' + MySMTP_textline.4 = ' ' + MySMTP_textline.0 = 4 + MYSMTP_EMAIL_IDS = '' + /* Only run if the exit says all Approver Grps are done */ + If Substr(CALL_REASON,1,22) = 'NO MORE APPROVER GRPS ' then, + Do + Call CheckApproverGroupSequence + Return + End + Return +SaveOffApproverGrpInfo: + If TraceRQ = 'Y' then Trace ?R + PAPP_SEQUENCE_NUMBER = Substr(CALL_REASON,17,4) + numberQueued = QUEUED() + If PAPP_SEQUENCE_NUMBER = "0001" & numberQueued > 0 then, + Do numberQueued /* Clear out whatever is queued */ + pull leftovers + End + If PAPP_SEQUENCE_NUMBER = "0001" then, + CALL BPXWDYN , /* save Approver group data */ + "ALLOC DD(C1UEXTD7) LRECL(180) BLKSIZE(18000) SPACE(1,1) ", + " RECFM(F,B) TRACKS ", + " MOD UNCATALOG REUSE "; + pkgGrp# = Strip(PAPP_SEQUENCE_NUMBER,'L','0') + PAPP_GROUP_NAME = Strip(PAPP_GROUP_NAME) + Queue 'pkgGrp# = 'pkgGrp# + Queue 'GROUP_NAME.pkgGrp# ="'PAPP_GROUP_NAME'"' + Queue 'ENVIRONMENT.pkgGrp# ="'Strip(PAPP_ENVIRONMENT)'"' + Queue 'APPR_GRP_TYPE.pkgGrp# ="'Strip(PAPP_APPR_GRP_TYPE)'"' + Queue 'APPR_GRP_DISQ.pkgGrp# ="'Strip(PAPP_APPR_GRP_DISQ)'"' + Queue 'APPROVAL_FLAGS.pkgGrp# ="'Strip(PAPP_APPROVAL_FLAGS)'"' + Queue 'STATUS.'PAPP_GROUP_NAME '="'Strip(PAPP_APPROVER_FLAG)'"' + Queue 'QUORUM.'PAPP_GROUP_NAME '='Strip(PAPP_QUORUM_COUNT,'L','0') + Queue 'USRLST.'PAPP_GROUP_NAME '="'Strip(PAPP_APPROVAL_IDS)'"' + numberQueued = QUEUED() + "EXECIO" numberQueued " DISKW C1UEXTD7 " + Return; +CheckApproverGroupSequence: + If TraceRQ = 'Y' then Trace ?R + whereami = 'CheckApproverGroupSequence' + /* If C1UEXTD7 is allocated to anything, we have approvers */ + WhatDDName = 'C1UEXTD7' + CALL BPXWDYN "INFO FI("WhatDDName")", + "INRTDSN(DSNVAR) INRDSNT(myDSNT)" + If Substr(DSNVAR,1,1) = ' ' then Return + "EXECIO 0 DISKW C1UEXTD7 (Finis" + "EXECIO * DISKR C1UEXTD7 (Finis" + CALL BPXWDYN "FREE DD(C1UEXTD7)" + numberQueued = QUEUED() + /* Analyze Exit-provided Approver Group info */ + pkgGrp# = 0 + /* By default, ordered Approver Groups are not related */ + STATUS. = 'NotRelated' + QUORUM. = 0 + /* Return Approver Group info for this package */ + Do q# = 1 to numberQueued + Parse Pull something + If TraceRQ = 'Y' then say "@187" something + interpret something + End; + ThisEnvironment = ENVIRONMENT.pkgGrp# + /* Read the site's required Approver Group sequencing */ + CALL BPXWDYN, + "ALLOC DD(APPROVER) DA('"ApproverGroupSequence"') SHR REUSE" + "EXECIO * DISKR APPROVER (Stem ordered. Finis" + CALL BPXWDYN "FREE DD(APPROVER)" + /* Build a sequenced list of all named Approver Groups */ + OrderedApproverGroups = '' + /* Set a default value to be 1 greater than number of groups */ + NotOrdered = ordered.0 + 1 + Sequence. = NotOrdered + Do ord# = 1 to ordered.0 + orderedEntry = ordered.ord# + orderedEnv = Word(orderedEntry,1) + If orderedEnv /= thisEnvironment then iterate + orderedApproverGroup = Word(orderedEntry,2) + If orderedApproverGroup = 'AllOthers' then, + DefaultOrder = ord# + SEQUENCE.orderedApproverGroup = ord# + If TraceRQ = 'Y' then, + say "@201 Sequence for" orderedApproverGroup "is" ord# + End; /* Do ord# = 1 to ordered.0 */ + Sequence.NotOrdered = DefaultOrder + unsorted_list = "" + /* Build a list of Approver Groups for this package */ + PackageApproverGroups = '' + Do p# = 1 to pkgGrp# + PackageApproverGroup = GROUP_NAME.p# + thisSequence = SEQUENCE.PackageApproverGroup + entry = Right(thisSequence,4,'0') || '.' ||, + PackageApproverGroup + unsorted_list = unsorted_list entry + If TraceRQ = 'Y' then, + Say "unsorted_list=" unsorted_list + End; + Call SortApproverGroupList; + If TraceRQ = 'Y' then say "@220 PackageApproverGroups =", + sorted_list, + ' ThisEnvironment =' ThisEnvironment + /* Go through the Sorted list to identify the status */ + /* of the next group(s) to be approved */ + /* Find the 1st Approver group this user belongs to.... */ + thisApprover = USERID() + lastSequence = NotOrdered + Do seq# = 1 to Words(sorted_list) + entry = Word(sorted_list,seq#) + Parse Var entry thisSequence '.' orderedApproverGroup + orderedGroupStatus = STATUS.orderedApproverGroup + If orderedGroupStatus = 'APPROVED' then Iterate; + orderedGroupQuorum = QUORUM.orderedApproverGroup + If orderedGroupQuorum = 0 then Iterate; + If thisSequence > lastSequence then, + Do + Sa= 'We need to wait' + Leave; + End; + lastSequence = thisSequence + ListApprovers = USRLST.orderedApproverGroup + whereApprover = Wordpos(thisApprover,ListApprovers) + thisApproversFlag = " " + If whereApprover > 0 then, + Do + thisApproverGroup = orderedApproverGroup + thisApproversFlag = Word(APPROVAL_FLAGS.grp#,whereApprover) + End + If TraceRQ = 'Y' then, + Say orderedApproverGroup 'has status of' orderedGroupStatus, + " Quorum" orderedGroupQuorum + IF whereApprover > 0 &, + orderedGroupStatus /= 'NotRelated' then, + sa= 'You must wait for the' orderedApproverGroup, + " group's approval" + If Words(ListApprovers) > 0 then, + Do w# = 1 to Words(ListApprovers) + Approver = Word(ListApprovers,w#) + If Wordpos(Approver,MYSMTP_EMAIL_IDS) = 0 &, + Substr(Approver,1,1) > '00'X then, + MYSMTP_EMAIL_IDS = MYSMTP_EMAIL_IDS Approver + End; /* Do w# = 1 to Words(ListApprovers) */ + End; /* Do seq# = 1 to Words(sorted_list) */ + /* Prepare email to the usrids in MYSMTP_EMAIL_IDS */ + Call PrepareEmail + Return; +SortApproverGroupList: + If TraceRQ = 'Y' then Trace ?R + whereami = 'SortApproverGroupList' + sa= words(unsorted_list) unsorted_list; + drop sorted_list; + sorted_list = ""; + do forever ; + if words(unsorted_list) = 0 then leave; + lowest_entry = 1; + do entry = 1 to words(unsorted_list) + if word(unsorted_list,entry) <, + word(unsorted_list,lowest_entry) then, + lowest_entry = entry; + end; /* do entry = 1 .... */ + sorted_list = sorted_list word(unsorted_list,lowest_entry); + sa= "sorted_list=" sorted_list ; + position = wordindex(unsorted_list,lowest_entry) ; + len = length(word(unsorted_list,lowest_entry)); + unsorted_list =, + overlay(copies(" ",len),unsorted_list,position) ; + sa= "unsorted_list=" unsorted_list ; + end; /* do forever */ + drop unsorted_list; + sa= words(sorted_list) sorted_list; + Return; +PrepareEmail: + If TraceRQ = 'Y' then Trace ?R + whereami = 'PrepareEmail' +/* Here you can make last-moment adjustments to the email */ + shortlist = Substr(MYSMTP_EMAIL_IDS,1,100) + If Substr(MYSMTP_EMAIL_IDS,100,1) /= ' ' &, + Substr(MYSMTP_EMAIL_IDS,101,1) /= ' ' then, + Do + whereEnd = WordIndex(shortlist,Words(shortlist)) + shortlist = DELWORD(shortlist,whereEnd) + End + MySMTP_textline.4 = 'Sent to Group:' shortlist +/* Code in the section below should not be changed */ +/* Code in the section below should not be changed */ +/* Code in the section below should not be changed */ + MySMTP_Message = Left(MySMTP_Message,80) + hexAddress = D2X(Address_MYSMTP_MESSAGE) + storrep = STORAGE(hexAddress,,Message) + MySMTP_From = Left(MySMTP_From,50) + hexAddress = D2X(Address_MYSMTP_FROM) + storrep = STORAGE(hexAddress,,MySMTP_From) + MySMTP_Subject = Left(MySMTP_Subject,50) + hexAddress = D2X(Address_MySMTP_Subject) + storrep = STORAGE(hexAddress,,MySMTP_Subject) +/* If TraceRQ = 'Y' then Trace ?r */ + MYSMTP_COUNTER = '' + numberLines = Right(MySMTP_textline.0,2,'0') + Do l# = 1 to Length(numberLines) + MYSMTP_COUNTER = MYSMTP_COUNTER ||, + 'F' || Substr(numberLines,l#,1) + End + If TraceRQ = 'Y' then say 'MYSMTP_COUNTER=' MYSMTP_COUNTER + MYSMTP_TEXT = X2C(MYSMTP_COUNTER) + Do line# = 1 to numberLines + MYSMTP_TEXT = MYSMTP_TEXT || Left(MySMTP_textline.line#,133) + End; /* Do line# = 1 to MySMTP_textline.0 */ + hexAddress = D2X(Address_MYSMTP_TEXT) + storrep = STORAGE(hexAddress,,MYSMTP_TEXT) + MySMTP_URL = 'N' + hexAddress = D2X(Address_MYSMTP_URL) + storrep = STORAGE(hexAddress,,MySMTP_URL) + /* Provide distribution list ( list of userids ) to Exit */ + MYSMTP_EMAIL_IDS =, + Space(Strip(Translate(MYSMTP_EMAIL_IDS,' ','00'x))) + MYSMTP_EMAIL_IDS = MYSMTP_EMAIL_IDS '0000'x + MYSMTP_EMAIL_IDS = Left(MYSMTP_EMAIL_IDS,MYSMTP_EMAIL_ID_SIZE) + hexAddress = D2X(Address_MYSMTP_EMAIL_IDS) + storrep = STORAGE(hexAddress,,MYSMTP_EMAIL_IDS) + Return; +SubmitBatchJCL: + If TraceRQ = 'Y' then Trace ?R + whereami = 'SubmitBatchJCL' + /* Variable settings for each site ---> */ + WhereIam = Strip(Left("@"MVSVAR(SYSNAME),8)) ; + interpret 'Call' WhereIam "'MySENULibrary'" + MySENULibrary = Result + interpret 'Call' WhereIam "'MySEN2Library'" + MySEN2Library = Result + interpret 'Call' WhereIam "'MyCLS0Library'" + MyCLS0Library = Result + interpret 'Call' WhereIam "'MyCLS2Library'" + MyCLS2Library = Result + /* Get job-related information from low address locations */ + /* Find GETACCTC on GitHub in the folder- */ + /* endevor/Field-Developed-Programs/Miscellaneous-items */ + MyAccountingCode = GETACCTC() + job_name = MVSVAR('SYMDEF',JOBNAME ) /*Returns JOBNAME */ + /* Find BUMPJOB on GitHub in the folder- */ + /* endevor/Field-Developed-Programs/Miscellaneous-items */ + Jobname= BUMPJOB(job_name) + /* Prepare and run a Table Tool to build CAST jcl....... */ + CALL BPXWDYN , + "ALLOC DD(TABLE) LRECL(80) BLKSIZE(27920) SPACE(1,1) ", + " RECFM(F,B) TRACKS ", + " NEW UNCATALOG REUSE "; + Queue "* Do" + Queue " * " + "EXECIO 2 DISKW TABLE (FINIS "; /* count queued */ + CALL BPXWDYN "ALLOC DD(NOTHING) DUMMY" + CALL BPXWDYN , + "ALLOC DD(OPTIONS) LRECL(80) BLKSIZE(27920) SPACE(1,1) ", + " RECFM(F,B) TRACKS ", + " NEW UNCATALOG REUSE "; + QUEUE "$nomessages ='Y'" + QUEUE "MyAccountingCode='"MyAccountingCode"'" + QUEUE "MySEN2Library ='"MySEN2Library"'" + QUEUE "MySENULibrary ='"MySENULibrary"'" + QUEUE "MyCLS0Library ='"MyCLS0Library"'" + QUEUE "MyCLS2Library ='"MyCLS2Library"'" + QUEUE "Unique_Name ='"Unique_Name"'" + QUEUE "PECB_PACKAGE_ID ='"PECB_PACKAGE_ID"'" + QUEUE "Jobname= '"Jobname"'" + QUEUE "TBLOUT = 'SUBMTJCL'" + "EXECIO 10 DISKW OPTIONS (FINIS "; /* count queued */ + /* For CASTing a package in Batch */ + /* Build a JCL model, and name its location here.... */ + /* Name a work dataset to be created then deleted... */ + Jcl2SumbitModel = MySEN2Library || '(' || ModelMember || ')' + "ALLOC F(MODEL) DA('"Jcl2SumbitModel"') SHR REUSE" + /* Build the JCL for a Batch Cast */ + CastPackageJCL = USERID()".C1UEXTR7.SUBMIT."Unique_Name + "ALLOC F(SUBMTJCL) DA('"CastPackageJCL"') ", + "LRECL(80) BLKSIZE(16800) SPACE(5,5)", + "RECFM(F B) TRACKS ", + "NEW CATALOG REUSE " ; + myRC = ENBPIU00("A") + "EXECIO 0 DISKW SUBMTJCL (Finis" + "FREE DD(TABLE) " + "FREE DD(NOTHING) " + "FREE DD(OPTIONS) " + "FREE DD(MODEL) " + Call Submit_n_save_jobInfo ; + "FREE F(SUBMTJCL) DELETE " + Return; +Submit_n_save_jobInfo: /* submit Jcl2SumbitModel job and save job info */ + If TraceRQ = 'Y' then Trace ?R + whereami = 'Submit_n_save_jobInfo' + If TraceRQ = 'Y' then Say 'Submit_n_save_jobInfo:' + Address TSO "PROFILE NOINTERCOM" /* turn off msg notific */ + CALL MSG "ON" + CALL OUTTRAP "out." + ADDRESS TSO "SUBMIT '"CastPackageJCL"'" ; + If RC > 4 then, + Do + MyRC = 8 + Message = 'Cannot find Element member to submit.' + Call SetExitReturnInfo + Exit(12) + End + CALL OUTTRAP "OFF" + Address TSO "PROFILE INTERCOM" /* turn on msg notific */ + JobData = Strip(out.1); + jobinfo = Word(JobData,2) ; + If jobinfo = 'JOB' then, + jobinfo = Word(JobData,3) ; + SelectJobName = Word(Translate(jobinfo,' ',')('),1) ; + SelectJobNumber = Word(Translate(jobinfo,' ',')('),2) ; + Return; +FREE_Files_For_ProcessingPackageSCL: + CALL BPXWDYN "FREE DD (SCL) " + CALL BPXWDYN "FREE DD (RESULTS)" + Return; +CSV_to_List_Package_Actions: + /* Get Package Action information for SonarQube preparations */ + STRING = "ALLOC DD(EXTRACTM) LRECL(4000) BLKSIZE(32000) ", + " DSORG(PS) ", + " SPACE(1,5) RECFM(F,B) TRACKS ", + " NEW UNCATALOG REUSE "; + CALL BPXWDYN STRING; + STRING = "ALLOC DD(BSTIPT01) LRECL(80) BLKSIZE(800) ", + " DSORG(PS) ", + " SPACE(1,5) RECFM(F,B) TRACKS ", + " NEW UNCATALOG REUSE "; + CALL BPXWDYN STRING; + QUEUE "LIST PACKAGE ACTION FROM PACKAGE '"PECB_PACKAGE_ID"'" + QUEUE " TO DDNAME 'EXTRACTM' " + QUEUE " ." + "EXECIO" QUEUED() "DISKW BSTIPT01 (FINIS "; + ADDRESS LINK 'BC1PCSV0' ; /* load from authlib */ + call_rc = rc ; + "EXECIO * DISKR EXTRACTM (STEM CSV. finis" + STRING = "FREE DD(EXTRACTM)" ; + CALL BPXWDYN STRING; + STRING = "FREE DD(BSTIPT01)" ; + /* To Search the package action data in CSV format. */ + /* Identify matches with Rules file, determining Ship Dests */ + IF CSV.0 < 2 THEN RETURN; + /* CSV data heading - showing CSV variables */ + $table_variables= Strip(CSV.1,'T') + $table_variables = translate($table_variables,"_"," ") ; + $table_variables = translate($table_variables," ",',"') ; + $table_variables = translate($table_variables,"@","/") ; + $table_variables = translate($table_variables,"@",")") ; + $table_variables = translate($table_variables,"@","(") ; + WantedCSVVariables= , + "ELM_@S@ ENV_NAME_@S@ STG_ID_@S@ ", + "SYS_NAME_@S@ SBS_NAME_@S@ TYPE_NAME_@S@ " + Do rec# = 2 to CSV.0 + $detail = CSV.rec# + Drop SBS_NAME_@T@ + /* Parse CSV fields in the Detail record until done */ + Do $column = 1 to Words($table_variables) + Call ParseDetailCSVline + End + If TraceRQ = 'Y' then Trace r + IF Substr(ENV_NAME_@S@,1,1) = '00'x |, + Substr(ENV_NAME_@S@,1,1) = ' ' then Iterate; + elm# = Elements.0 + 1 + Elements.elm# = ELM_@S@ ENV_NAME_@S@ STG_ID_@S@, + SYS_NAME_@S@ SBS_NAME_@S@ TYPE_NAME_@S@ + Elements.0 = elm# + Sa= 'Messages from C1UEXTR7:' Elements.elm# + End; /* Do rec# = 1 to CSV.0 */ + RETURN ; +ParseDetailCSVline: + /* Find the data for the current $column */ + $dlmchar = Substr($detail,1,1); + If $dlmchar = "'" then, + Do + SA= 'parsing with single quote ' + PARSE VAR $detail "'" $temp_value "'" $detail ; + If Substr($detail,1,1) = ',' then, + $detail = Strip(Substr($detail,2),'L') + End + Else, + If $dlmchar = '"' then, + Do + SA= 'parsing with double quote ' + PARSE VAR $detail '"' $temp_value '"' $detail ; + If Substr($detail,1,1) = ',' then, + $detail = Strip(Substr($detail,2),'L') + End + Else, + If $dlmchar = ',' then, + Do + SA= 'parsing with comma ' + PARSE VAR $detail ',' $temp_value ',' $detail ; + If Substr($detail,1,1)/= ',' then, + $detail = "," || $detail + $detail = Strip(Substr($detail,2),'L') */ + End + Else, + If Words($detail) = 0 then, + $temp_value = ' ' + Else, + Do + SA= 'parsing with comma ' + PARSE VAR $detail $temp_value ',' $detail ; + Sa= '$temp_value=>' $temp_value '<' + End + $temp_value = STRIP($temp_value) ; + $rslt = $temp_value + $rslt = Strip($rslt,'B','"') ; + $rslt = Strip($rslt,'B',"'") ; + if Length($rslt) < 1 then $rslt = ' ' + thisVariable = WORD($table_variables,$column) + If Wordpos(thisVariable,WantedCSVVariables) = 0 then Return + if Length($rslt) < 250 then, + $temp = WORD($table_variables,$column) '= "'$rslt'"'; + Else, + $temp = WORD($table_variables,$column) "=$rslt" + INTERPRET $temp; + If rec# < 3 then Say $temp + RETURN ; +/* //// Routines to support Package Shipments from NOTES \\\\ */ +UpdateTriggerFromNotes: + If TriggerFileName = '?' then, + Do + Call AllocateTriggerForMod + Call Process_Trigger_Heading + End + Date = Word(noteline,2) ; + Time = Word(noteline,3) ; + Jobname = Word(noteline,4) ; + Notify = " " + TYPRUN = ' ' + If Words(noteline) > 4 then, + If Word(noteline,5) = "HOLD" |, + Word(noteline,5) = "SCAN" then, + TYPRUN = Word(noteline,5) + Call CreateNewTriggerEntry + /* endevor/Field-Developed-Programs/Package-Automation */ + BildRC = RESULT ; + Return ; +GetDestinationInfoViaCSV: + if TraceRQ = 'Y' then Say "GetDestinationInfoViaCSV: " + Hostprefix = "?" + /* Set values for Hostprefix and Rmteprefix */ + /* From the site definition */ + /* Call CSV to Get Destination information */ + SiteNodes = GTDESTIN(Destination) + If Words(SiteNodes) < 2 then Return + Hostprefix = Word(SiteNodes,1) + Rmteprefix = Word(SiteNodes,2) + Return +SubmitPackageShipmentFromNotes: +/* */ +/* This subroutine is modified from the TBL#TOOL */ +/* */ + "EXECIO * DISKR "MODEL "(STEM $Model. FINIS" ; + $delimiter = "|" ; + DO $LINE = 1 TO $Model.0 + $PLACE_VARIABLE = 1; + CALL EVALUATE_SYMBOLICS ; + END; /* DO $LINE = 1 TO $Model.0 */ + STRING = "ALLOC DD(SHIPJCL) LRECL(80) BLKSIZE(27920) ", + " DA("USERID()".SHIPJCL."Destination")", + " DSORG(PS) ", + " SPACE(1,1) RECFM(F,B) TRACKS ", + " NEW CATALOG REUSE "; + CALL BPXWDYN STRING; + "EXECIO * DISKW SHIPJCL (STEM $Model. FINIS" ; + If RunUnderAltid = 'Y' then CALL SWAP2ALT + Call Submit_Job ; + If RunUnderAltid = 'Y' then CALL SWAP2USR + Drop $Model. ; + STRING = "FREE DD(SHIPJCL) DELETE" + CALL BPXWDYN STRING; + RETURN; + /* From BILDTGGR */ +AllocateTriggerForMod: + /* Get the related site-level options */ + WhereIam = Strip(Left("@"MVSVAR(SYSNAME),8)) ; + interpret 'Call' WhereIam "'TriggerFileName'" + TriggerFileName = Result + STRING = "ALLOC DD(TRIGGER)", + " DA('"TriggerFileName"') MOD REUSE" + seconds = '000005' /* Number of Seconds to wait if needed */ + Do Forever /* or at least until the file is available */ + CALL BPXWDYN STRING; + MyResult = RESULT ; + If MyResult = 0 then Leave + Say 'C1UEXTR7 is waiting for' TriggerFileName + Call WaitAwhile + End /* Do Forever */ + Return ; + /* From BILDTGGR */ +CreateNewTriggerEntry: + If TraceRQ = 'Y' then Say 'CreateNewTriggerEntry+ ' + If TraceRQ = 'Y' then Trace r + St = '_' + JOBNUMB = ' ' + Package = PECB_PACKAGE_ID + Trigger = Copies(' ',400) ; + $Heading_TriggerVar_count = WORDS($trigger_variables) ; + Do $pos = 1 to $Heading_TriggerVar_count + $HeadingVariable = Word($trigger_variables,$pos) ; + /* Build ...pos variables and values */ + tmp = "Trigger = Overlay(", + $HeadingVariable",Trigger,"$HeadingVariable"pos)" + Say tmp + Interpret tmp + end; /* DO $pos = 1 to $Heading_TriggerVar_count */ + Sa= Trigger + Push Trigger + "EXECIO 1 DISKW TRIGGER " + Trace Off + Return ; + /* From BILDTGGR */ +FreeTriggerFile: + STRING = "FREE DD(TRIGGER)" + CALL BPXWDYN STRING; + Return ; +/* */ +/* Convert Date formats */ +/* */ +WaitAwhile: + /* */ + /* A resource is unavailable. Wait awhile and try */ + /* accessing the resource again. */ + /* */ + /* The length of the wait is designated in the parameter */ + /* value which specifies a number of seconds. */ + /* A parameter value of '000003' causes a wait for 3 seconds. */ + /* */ + seconds = Abs(seconds) + seconds = Trunc(seconds,0) + Say "Waiting for" seconds "seconds at " DATE(S) TIME() + /* AOPBATCH and BPXWDYN are IBM programs */ + CALL BPXWDYN "ALLOC DD(STDOUT) DUMMY SHR REUSE" + CALL BPXWDYN "ALLOC DD(STDERR) DUMMY SHR REUSE" + CALL BPXWDYN "ALLOC DD(STDIN) DUMMY SHR REUSE" + /* AOPBATCH and BPXWDYN are IBM programs */ + parm = "sleep "seconds + Address LINKMVS "AOPBATCH parm" + Return +Process_Trigger_Heading : + sa= 'Process_Trigger_Heading' + "EXECIO 1 DISKR TRIGGER (Stem $tablerec. FINIS" +/* Get layout of TRIGGER file from heading */ +/* The subroutine below is modified from the TBL#TOOL */ + $tbl = 1 ; + $TableHeadingChar = '*' + $LastWord = Word($tablerec.$tbl,Words($tablerec.$tbl)); + If DATATYPE($LastWord) = 'NUM' then, + Do + Say 'Please remove sequence numbers from the Table' + Exit(12) + End + $tmprec = Substr($tablerec.$tbl,2) ; + $PositionSpclChar = POS('-',$tmprec) ; + If $PositionSpclChar = 0 then, + $PositionSpclChar = POS('*',$tmprec) ; + $tmpreplaces = '-,.'$TableHeadingChar ; + $tmprec = TRANSLATE($tmprec,' ',$tmpreplaces); + $table_variables = strip($tmprec); + $Heading_Variable_count = WORDS($table_variables) ; + If $Heading_Variable_count /=, + Words(Substr($tablerec.$tbl,2)) then, + Do + Say 'Invalid table Heading:' $tablerec.$tbl + exit(12) + End + $heading = Overlay(' ',$tablerec.$tbl,1); /* Space leading * */ + Do $pos = 1 to $Heading_Variable_count + $HeadingVariable = Word($table_variables,$pos) ; + $tmp = Wordindex($Heading,$pos) ; + $Starting_$position.$HeadingVariable = $tmp + $tmp = $tmp + Length(Word($Heading,$pos)) -1 ; + $Ending_$position.$HeadingVariable = $tmp + /* Build ...pos variables and values */ + tmp = ""$HeadingVariable"pos =", + $Starting_$position.$HeadingVariable + Sa= tmp + Interpret tmp + end; /* DO $pos = 1 to $Heading_Variable_count */ + $Heading = Translate($Heading,' ','-*') + $trigger_variables = $Heading + Return ; +/* \\\\ Routines to support Package Shipments from NOTES //// */ +SetExitReturnInfo: + If TraceRQ = 'Y' then Trace ?R + whereami = 'SetExitReturnInfo' + If TraceRQ = 'Y' then Say 'SetExitReturnInfo: ' + hexAddress = D2X(Address_PECB_MESSAGE) + storrep = STORAGE(hexAddress,,Message) + hexAddress = D2X(Address_PECB_ERROR_MESS_LENGTH) + storrep = STORAGE(hexAddress,,'0084'X) + hexAddress = D2X(Address_PECB_MODS_MADE_TO_PREQ) + storrep = STORAGE(hexAddress,,'Y') + If MessageCode /= ' ' then, + Do + hexAddress = D2X(Address_PECB_MESSAGE_ID) + storrep = STORAGE(hexAddress,,MessageCode) + End +/* Set the return code for the exit */ +/* for PECB-NDVR-EXIT-RC */ + hexAddress = D2X(Address_PECB_NDVR_EXIT_RC) + If MyRc = 4 then, + storrep = STORAGE(hexAddress,,'00000004'X) + Else, + storrep = STORAGE(hexAddress,,'00000008'X) + RETURN ; diff --git a/endevor/Field-Developed-Programs/Exit-Examples/C1UEXTR7-Example#1 Cast in Batch.rex b/endevor/Field-Developed-Programs/Exit-Examples/C1UEXTR7-Example#1 Cast in Batch.rex deleted file mode 100644 index 8326ebb..0000000 --- a/endevor/Field-Developed-Programs/Exit-Examples/C1UEXTR7-Example#1 Cast in Batch.rex +++ /dev/null @@ -1,146 +0,0 @@ -/* rexx */ - /* Make CAST actions always be batch... */ - - /* Values to be set for your site...... */ - /* Build a JCL model, and name its location here.... */ - CastPackageModel = 'SYSMD32.NDVR.TEAM.MODELS(CASTPKGE)' - /* Name a work dataset to be created then deleted... */ - CastPackageJCL = USERID()".C1UEXTR7.SUBMIT" - - /* If wanting to limit the use of this exit, uncomment... */ - If USERID() /= 'IBMUSER' then exit - - STRING = "ALLOC DD(SYSTSPRT) SYSOUT(A) " - CALL BPXWDYN STRING; - STRING = "ALLOC DD(SYSTSIN) DUMMY" - CALL BPXWDYN STRING; - - Arg Parms - sa= 'Parms len=' Length(Parms) - MyRc = 0 - - /* If C1UEXTR7 is allocated to anything, turn on Trace */ - WhatDDName = 'C1UEXTR7' - CALL BPXWDYN "INFO FI("WhatDDName")", - "INRTDSN(DSNVAR) INRDSNT(myDSNT)" - If Substr(DSNVAR,1,1) /= ' ' then Trace ?r - - /* Parms from C1UEXT07 is a string of REXX statements */ - Interpret Parms - - /* Only run if a CAST is being done */ - If PECB_FUNCTION_LITERAL /= 'CAST' then Exit - - Message = '' - MessageCode = ' ' - - If Substr(PHDR_PKG_NOTE5,1,5) = 'TRACE' then TraceRc = 1 - - Sa= 'You called C1UEXTR7 ' - - If PECB_MODE = "T" then, /* TSO foreground */ - Do - Call SubmitBatchCAST - Exit - End - - /* Enforce packages to be Backout Enabled */ - IF PREQ_BACKOUT_ENABLED /= 'Y' then, - Do - Message = 'Package made to be Backout enabled' - MyRc = 4 - hexAddress = D2X(Address_PREQ_BACKOUT_ENABLED) - storrep = STORAGE(hexAddress,,'Y') - Call SetExitReturnInfo - End; - - Exit - -SubmitBatchCAST: - - "ALLOC F(CASTPKGE) DA('"CastPackageModel"') SHR REUSE" - "Execio * DISKR CASTPKGE (Stem jcl. Finis" - "FREE F(CASTPKGE)" - jcl.1 = Overlay(USERID(),jcl.1,3) - "ALLOC F(SUBMTJCL) DA('"CastPackageJCL"') ", - "LRECL(80) BLKSIZE(16800) SPACE(5,5)", - "RECFM(F B) TRACKS ", - "MOD CATALOG REUSE " ; - "Execio * DISKW SUBMTJCL (Stem jcl. " - - /* Push Cast command (in reverse order). */ - If PREQ_PKG_CAST_COMPVAL = 'Y' then, - PUSH ' OPTION VALIDATE COMPONENTS .' - Else, - If PREQ_PKG_CAST_COMPVAL = 'W' then, - PUSH ' OPTION VALIDATE COMPONENT WITH WARNING .' - Else, - PUSH ' OPTION DO NOT VALIDATE COMPONENT .' - PUSH " CAST PACKAGE '" || PECB_PACKAGE_ID || "'" - "Execio 2 DISKW SUBMTJCL ( finis" - - Call Submit_n_save_jobInfo ; - "FREE F(SUBMTJCL) DELETE " - Message = JobData - MyRc = 8 - PACKAGE = PECB_PACKAGE_ID - MessageCode = 'U033' - Call SetExitReturnInfo - - Return; - -Submit_n_save_jobInfo: /* submit CastPackageModel job and save job info */ - - If TraceRc = 1 then Say 'Submit_n_save_jobInfo:' - - Address TSO "PROFILE NOINTERCOM" /* turn off msg notific */ - CALL MSG "ON" - CALL OUTTRAP "out." - ADDRESS TSO "SUBMIT '"CastPackageJCL"'" ; - If RC > 4 then, - Do - MyRC = 8 - Message = 'Cannot find Element member to submit.' - Call SetExitReturnInfo - Exit(12) - End - CALL OUTTRAP "OFF" - Address TSO "PROFILE INTERCOM" /* turn on msg notific */ - - JobData = Strip(out.1); - jobinfo = Word(JobData,2) ; - If jobinfo = 'JOB' then, - jobinfo = Word(JobData,3) ; - SelectJobName = Word(Translate(jobinfo,' ',')('),1) ; - SelectJobNumber = Word(Translate(jobinfo,' ',')('),2) ; - - Return; - -SetExitReturnInfo: - - If TraceRc = 1 then Say 'SetExitReturnInfo: ' - - hexAddress = D2X(Address_PECB_MESSAGE) - storrep = STORAGE(hexAddress,,Message) - hexAddress = D2X(Address_PECB_ERROR_MESS_LENGTH) - storrep = STORAGE(hexAddress,,'0084'X) - hexAddress = D2X(ADDRESS_PECB_MODS_MADE_TO_PREQ) - storrep = STORAGE(hexAddress,,'Y') - - If MessageCode /= ' ' then, - Do - hexAddress = D2X(Address_PECB_MESSAGE_ID) - storrep = STORAGE(hexAddress,,MessageCode) - End - - -/* Set the return code for the exit */ -/* for PECB-NDVR-EXIT-RC */ - hexAddress = D2X(Address_PECB_NDVR_EXIT_RC) - If MyRc = 4 then, - storrep = STORAGE(hexAddress,,'00000004'X) - Else, - storrep = STORAGE(hexAddress,,'00000008'X) - - RETURN ; - diff --git a/endevor/Field-Developed-Programs/Exit-Examples/README.md b/endevor/Field-Developed-Programs/Exit-Examples/README.md index 0416042..467d5a4 100644 --- a/endevor/Field-Developed-Programs/Exit-Examples/README.md +++ b/endevor/Field-Developed-Programs/Exit-Examples/README.md @@ -8,6 +8,10 @@ In each case the REXX operates on fields in the exit blocks using variable names References to ispf messages can be removed from the code if you prefer, or to use them find them in the **ISPF-tools-for-Quick-Edit-and-Endevor** folder. -The **C1UEXTx2 Reuse CCID and Comment** members offer an approach for re-using CCID and Comment values, waiving the requirement for them with each software change. Only the first software change requires them, and if left blank on subsequent changes the values entered the first time are used again. If you have users on Quick-Edit and/or Endevor, then include the **CIUU01.ispfmsg** item too. +The **C1UEXT02 Reuse CCID and Comment** member offers an approach for re-using CCID and Comment values, waiving the requirement for them with each software change. Only the first software change requires them, and if left blank on subsequent changes the values entered the first time are used again. Also include the **CIUU01.ispfmsg** item with this exit. -See additional examples of Endevor exits in the **Package-Automation** folder. \ No newline at end of file +The members named **WithRexDriver** show the use of COBOL exit "stubs" that rely on Rexx "driver" routines to perform actions. There are several encoded features you can choose to use. However, watch for comments in the driver programs **C1UEXTR2** and **C1UEXTR7** for references to locations of their subroutines. + +See additional examples of Endevor exits in the **[Package-Automation](https://github.com/BroadcomMFD/broadcom-product-scripts/tree/main/endevor/Field-Developed-Programs/Package-Automation)** folder. + +The exit 3 that was previously here has been removed. It was available to log Endevor actions, and is now depreciated. Watch the [Endevor Community website](https://community.broadcom.com/communities/communityhomeblogs?CommunityKey=592eb6c9-73f7-460f-9aa9-e5194cdafcd2) for announcements. \ No newline at end of file diff --git a/endevor/Field-Developed-Programs/ISPF-tools-for-Quick-Edit-and-Endevor/Package.rex b/endevor/Field-Developed-Programs/ISPF-tools-for-Quick-Edit-and-Endevor/Package.rex index d359319..e64992b 100644 --- a/endevor/Field-Developed-Programs/ISPF-tools-for-Quick-Edit-and-Endevor/Package.rex +++ b/endevor/Field-Developed-Programs/ISPF-tools-for-Quick-Edit-and-Endevor/Package.rex @@ -449,6 +449,7 @@ Build_NOTES_Fields: EnvironWrdPos = Wordpos('Environment',$heading); StageWrdPos = Wordpos('Stage',$heading); SystemWrdPos = Wordpos('System',$heading); + SubSysWrdPos = Wordpos('Subsys',$heading); DestinationWrdPos = Wordpos('Destination',$heading); DateWrdPos = Wordpos('Date',$heading); TimeWrdPos = Wordpos('Time',$heading); @@ -459,9 +460,11 @@ Build_NOTES_Fields: env = Word($tbl.tbl#,EnvironWrdPos) stg = Word($tbl.tbl#,StageWrdPos) sys = Word($tbl.tbl#,SystemWrdPos); + sub = Word($tbl.tbl#,SubSysWrdPos); If (env =elmEnviron | env = '*') &, - (stg =elmStage | stg = '*') &, - (sys = elmSystem | sys = '*') then, + (stg =elmStage | stg = '*') &, + (sys = elmSystem | sys = '*') &, + (sub = elmSubsys | sub = '*') then, Do Destination = Word($tbl.tbl#,DestinationWrdPos) If Wordpos(Destination,List_Destinations) > 0 then, diff --git a/endevor/Field-Developed-Programs/Miscellaneous-items/WTO#MSG.asm b/endevor/Field-Developed-Programs/Miscellaneous-items/WTO#MSG.asm index bfd302e..ffc8aae 100644 --- a/endevor/Field-Developed-Programs/Miscellaneous-items/WTO#MSG.asm +++ b/endevor/Field-Developed-Programs/Miscellaneous-items/WTO#MSG.asm @@ -1,8 +1,7 @@ - TITLE 'WTO#MSG - TO issue a WTO message' - PRINT ON,GEN,NODATA +WTO#MSG CSECT *********************************************************************** * SEND WTO MESSAGE * -* (get the message from input Parameter value) * +* (get the message from input Parameter) * * * * Assemble with the 'NORENT' option * * Link with the 'NORENT,NOREUSE' options * @@ -27,19 +26,20 @@ * CALL 'WTO#MSG' USING WS-MESSAGE. * *********************************************************************** * - EJECT -* -* REGISTER ASSIGNMENTS -* +WTO#MSG AMODE 31 +WTO#MSG RMODE ANY +*---------------------------------------------------------------------* +* Standard Register Equates +*---------------------------------------------------------------------* R0 EQU 0 -R1 EQU 1 ADDRESS OF SEARCH CHARACTER +R1 EQU 1 R2 EQU 2 R3 EQU 3 R4 EQU 4 R5 EQU 5 -R6 EQU 6 POINTS TO INPUT RECORD AREA -R7 EQU 7 CHAR COUNT FOR SCANNED INPUT -R8 EQU 8 CONTAINS SEARCH CHAR +R6 EQU 6 +R7 EQU 7 +R8 EQU 8 R9 EQU 9 R10 EQU 10 R11 EQU 11 @@ -47,41 +47,62 @@ R12 EQU 12 R13 EQU 13 R14 EQU 14 R15 EQU 15 - EJECT -WTO#MSG CSECT -WTO#MSG AMODE 31 -WTO#MSG RMODE ANY - USING *,R12 -*********************************************************************** -* INITIALIZATION * -*********************************************************************** -* -ENTRY DS 0H - STM R14,R12,12(R13) SAVE REGISTERS .... - LR R12,R15 R12 FOR PROGRAM ADDRESSABILITY - ST R13,SAVE+4 - LA R13,SAVE NOW POINTS TO MY SAVE AREA -* - L R3,0(R1) POINT R3 TO PARM DATA - LH R4,0(R3) PARM LENGTH - LA R3,2(R3) ADVANCE TO PARM TEXT -* - LA R15,0 ZERO RETURN CODE - ST R15,RETURN -* - MVC SWTO+17(65),0(R3) Insert message from Parm -* -SWTO WTO 'Endevor- X - ', X - ROUTCDE=(11) -* -* -THATSALL L R13,SAVE+4 - L R15,RETURN - RETURN (14,12),RC=(15) -* -SAVE DS 18F -RETURN DS 4F -* - LTORG - END +R16 EQU 16 +*---------------------------------------------------------------------* +* Standard OS Linkage & Save Area +*---------------------------------------------------------------------* + SAVE (14,12),,'WTO#MSG V1.0' + LR R12,R15 Set up base register + USING WTO#MSG,R12 + ST R13,SAVEAREA+4 Link save areas + LA R11,SAVEAREA + ST R11,8(,R13) + LR R13,R11 +*---------------------------------------------------------------------* +* Process Input Parameter +* R1 points to the parameter list (for standard CALLs) +*---------------------------------------------------------------------* + LR R2,R1 Save R1 (Parm pointer) + LTR R2,R2 Check if parm pointer is null + BZ ERROR Error if no parm passed + L R3,0(,R2) R3 -> Address of string (fullword) + LTR R3,R3 Verify address isn't null + BZ ERROR +*---------------------------------------------------------------------* +* Get Length from Parameter (Standard COBOL/REXX passes a halfword +* length prefix, but JCL PARM does the same. For generic CALLs, +* checking the boundary or simply hardcoding a safe maximum works). +*---------------------------------------------------------------------* + LH R4,0(,R3) Load the halfword length prefix + CH R4,=H'0' Is length zero? + BE ERROR + CH R4,=H'125' WTO text limit is 125 chars + BNH LENGTH_OK Use actual length if <= 125 + LA R4,125 Truncate to max 125 characters +LENGTH_OK EQU * + STH R4,MSG_LEN Store in the WTO message length + BCTR R4,0 Subtract 1 for Execute Form of MVC + EX R4,MOVE_MSG Move input parm to WTO text area + B ISSUE_WTO +MOVE_MSG MVC MSG_TEXT(0),2(R3) (Executed Instruction to move text) +*---------------------------------------------------------------------* +* Issue the WTO +*---------------------------------------------------------------------* +ISSUE_WTO EQU * + WTO TEXT=MSG_AREA,MF=(E,WTO_LIST) + LA R15,0 Set Return Code 0 + B EXIT +ERROR EQU * + LA R15,12 Set Return Code 12 (Error) +EXIT EQU * + L R13,SAVEAREA+4 Restore register R13 + RETURN (14,12),RC=(15) Return to caller +*---------------------------------------------------------------------* +* Constants and Data Areas +*---------------------------------------------------------------------* +SAVEAREA DS 18F +WTO_LIST WTO TEXT=MSG_AREA,MF=L +MSG_AREA DS 0H +MSG_LEN DS H Halfword length required by WTO +MSG_TEXT DS CL125 Buffer for the text + END WTO#MSG diff --git a/endevor/Field-Developed-Programs/Package-Automation/@site.rex b/endevor/Field-Developed-Programs/Package-Automation/@site.rex index 1dc8b9a..b950fac 100644 --- a/endevor/Field-Developed-Programs/Package-Automation/@site.rex +++ b/endevor/Field-Developed-Programs/Package-Automation/@site.rex @@ -12,33 +12,33 @@ IF TraceRc = 1 then Trace R /*--+----1----+----2----+----3----+----4----+----5----+----6----+----7--*/ /* Required for all Bundles : */ /* Enter High Level Qualifiers */ -/* SHLQ='CADEMO.ENDV.RUN' */ - SHLQ='CARSMINI.NDVR.R1801' - AHLQ='SYSMD32.NDVR' /* APPLICATIONS HIGH LEVEL QUALIFIER */ +/* SHLQ='YourhlqENDV.RUN' */ + SHLQ='Yourhlq.NDVR.R1801' + AHLQ='Yourhlq.NDVR' /* APPLICATIONS HIGH LEVEL QUALIFIER */ /* Enter the name of the main Libraries for CA Services tools */ /* Name Endevor's APF Authorized libraries: */ MyAUTULibrary = SHLQ'.CSIQAUTU' -MyAUTULibrary = 'SYSMD32.NDVR.R1801.CSIQAUTU' +MyAUTULibrary = 'Yourhlq.NDVR.R1801.CSIQAUTU' MyAUTHLibrary = SHLQ'.CSIQAUTH' MyLOADLibrary = SHLQ'.CSIQLOAD' /* Non-APF Authorized library: */ - MyUTILLibrary = 'SYSMD32.NDVR.ADMIN.ENDEVOR.ADM1.LOADLIB' + MyUTILLibrary = 'Yourhlq.NDVR.ADMIN.ENDEVOR.LOADLIB' MyCLS0Library = SHLQ'.CSIQCLS0' MyOPTNLibrary = SHLQ'.CSIQOPTN' /* For Rexx items in your bundle, name a MyCLS2Library */ - MyCLS2Library = 'SYSMD32.NDVR.ADMIN.ENDEVOR.ADM1.CLSTREXX' - MyUTILLibrary = 'CAPRD.ENDV.CSIQOPTN.OVERRIDE' - MyOPT2Library = 'SYSMD32.NDVR.ADMIN.ENDEVOR.ADM1.ISPS' + MyCLS2Library = 'Yourhlq.NDVR.ADMIN.ENDEVOR.CLSTREXX' + MyUTILLibrary = 'Yourhlq..CSIQOPTN.OVERRIDE' + MyOPT2Library = 'Yourhlq.NDVR.ADMIN.ENDEVOR.ISPS' MyMENULibrary = SHLQ'.CSIQMENU' /* For Message (ISPMLIB) items in your bundle, name a MyMEN2Library */ - MyMEN2Library = 'SYS2.ISPMLIB' + MyMEN2Library = 'YourISPF.ISPMLIB' MyPENULibrary = SHLQ'.CSIQPENU' /* For Panel (ISPPLIB) items in your bundle, name a MyPEN2Library */ - MyPEN2Library = 'SYS2.ISPPLIB' + MyPEN2Library = 'YourISPF.ISPPLIB' MySENULibrary = SHLQ'.CSIQSENU' /* For Skeleton (ISPSLIB) items in your bundle, name a MySEN2Library */ - MySEN2Library = 'SYSMD32.NDVR.ADMIN.ENDEVOR.ADM1.ISPS' + MySEN2Library = 'Yourhlq.NDVR.ADMIN.ENDEVOR.ISPS' MyTENULibrary = SHLQ'.CSIQSENU' MyTEN2Library = SHLQ'.CSIQSEN2' /* Some bundles use a Table. Name the library in MyDATALibrary */ @@ -46,7 +46,7 @@ MyTEN2Library = SHLQ'.CSIQSEN2' /* If shipping to multiple destinations a table dataset is required */ /* for naming the "Rules" that govern automated package shipments. */ /* Physically the MyDATALibrary should resemble Endevor's CSIQDATA */ - MyDATALibrary = 'SYSMD32.NDVR.ADMIN.ENDEVOR.ADM1.TABLES' + MyDATALibrary = 'Yourhlq.NDVR.ADMIN.ENDEVOR.TABLES' MyJCLLibrary = SHLQ'.CSIQJCL' MyJCL2Library = SHLQ'.CSIQJCL' /* For JCL items in your bundle, name the library in MySRC2Library */ @@ -63,13 +63,14 @@ MySRC2Library = SHLQ'.CSIQJCL' ShipSchedulingMethod = 'None ' ;/* No Shipping */ ShipSchedulingMethod = 'One' ;/* only 1 destinaation */ + ShipSchedulingMethod = 'Notes' ;/* Notes - mult destinations */ ShipSchedulingMethod = 'Rules' ;/* Rules - mult destinations */ - TriggerFileName = 'SYSMD32.NDVR.SHIPMENT.TRIGGER' + TriggerFileName = 'Yourhlq.NDVR.SHIPMENT.TRIGGER' /* Provide details when there is only One shipping destination */ /* Destination = 'MTS32' ; */ /* The oneShipment Destination */ -/* Hostprefix = 'SYSMD32.NDVR';*/ /* Host staging file prefix */ +/* Hostprefix = 'Yourhlq.NDVR';*/ /* Host staging file prefix */ /* Rmteprefix = 'PUBLIC.NDVR' ;*/ /* Remote staging file prefix */ /* ModelMember = 'SHIP#FTP' */ /* Jcl image for shipment job */ @@ -79,6 +80,7 @@ MySRC2Library = SHLQ'.CSIQJCL' /* JOB INFO FOR ALTERNATE ID */ AltIDAcctCode = '0000' +AltIDAcctCode = GETACCTC() /* get the current account code*/ AltIDJobClass = 'A' AltIDMsgClass = 'Z' diff --git a/endevor/Field-Developed-Programs/Package-Automation/C1UEXT07-old-version.cob b/endevor/Field-Developed-Programs/Package-Automation/C1UEXT07-Package-Automation.cob similarity index 100% rename from endevor/Field-Developed-Programs/Package-Automation/C1UEXT07-old-version.cob rename to endevor/Field-Developed-Programs/Package-Automation/C1UEXT07-Package-Automation.cob diff --git a/endevor/Field-Developed-Programs/Package-Automation/C1UEXTR7.rex b/endevor/Field-Developed-Programs/Package-Automation/C1UEXTR7.rex deleted file mode 100644 index 6b30bc8..0000000 --- a/endevor/Field-Developed-Programs/Package-Automation/C1UEXTR7.rex +++ /dev/null @@ -1,747 +0,0 @@ -/* rexx */ -/* Perform various Package actions in REXX */ -/* */ -/* A COBOL exit CALLS this REXX and provides values for */ -/* REXX variables, including these. */ -/* Find documentation on these in the TechDocs documentation */ -/* where each underscore appears as a dash in the documentation. */ -/* For example, PECB_PACKAGE_ID is documented as */ -/* PECB-PACKAGE-ID */ -/* */ -/* PECB_PACKAGE_ID PAPP_GROUP_NAME */ -/* PECB_FUNCTION_LITERAL PAPP_ENVIRONMENT */ -/* PECB_SUBFUNC_LITERAL PAPP_QUORUM_COUNT */ -/* PECB_BEF_AFTER_LITERAL PAPP_APPROVER_FLAG */ -/* PECB_USER_BATCH_JOBNAME PAPP_APPR_GRP_TYPE */ -/* PREQ_PKG_CAST_COMPVAL PAPP_APPR_GRP_DISQ */ -/* PHDR_PKG_SHR_OPTION PAPP_SEQUENCE_NUMBER */ -/* PHDR_PKG_ENV */ -/* PHDR_PKG_STGID */ -/* Address fields are provided for fields that may be */ -/* modified by the REXX. */ -/* Address_PECB_MESSAGE Address_MYSMTP_SUBJECT */ -/* Address_MYSMTP_MESSAGE Address_MYSMTP_TEXT */ -/* Address_MYSMTP_USERID Address_MYSMTP_URL */ -/* Address_MYSMTP_FROM Address_MYSMTP_EMAIL_IDS */ -/* MYSMTP_EMAIL_IDS MYSMTP_EMAIL_ID_SIZE */ -/* */ - /* If wanting to limit the use of this exit, uncomment... */ -/* - If USERID() /= 'IBMUSER' &, - USERID() /= 'JW61868' &, - USERID() /= 'JW618685' then Say USERID() -*/ - /* In case these are not already allocated, these are attempted */ - STRING = "ALLOC DD(SYSTSPRT) SYSOUT(A) " - CALL BPXWDYN STRING; - STRING = "ALLOC DD(SYSTSIN) DUMMY" - CALL BPXWDYN STRING; - /* If C1UEXTR7 is allocated to anything, turn on Trace */ - WhatDDName = 'C1UEXTR7' - CALL BPXWDYN "INFO FI("WhatDDName")", - "INRTDSN(DSNVAR) INRDSNT(myDSNT)" - if RESULT = 0 then Trace ?R - /* Initialize variables.... */ - Message = '' - MessageCode = ' ' - MyRc = 0 - /* Values to be set for your site...... */ - /* For package REVIEW (APPROVE/DENY)..... */ - /* Enter location of Approver Group sequencing ... */ - ApproverGroupSequence= 'YOURSITE.NDVR.PARMLIB(APPROVER)' - ApproverGroupSequence= '' - /* Do you want all CAST actions to be peformed in Batch? */ - Force_CAST_in_Batch = 'N' ; /* Y/N */ - If USERID() = 'IBMUSER' then, - Force_CAST_in_Batch = 'Y' ; /* Y/N */ - Cast_with_SonarQube= 'N' /* Y/N/?=Check Notes */ - If USERID() = 'IBMUSER' then, - Cast_with_SonarQube= 'Y' /* Y/N/?=Check Notes */ - /* Parms are REXX statements passed from COBOL exit */ - Arg Parms - Parms = Strip(Parms) - sa= 'Parms len=' Length(Parms) - If TraceRQ = 'Y' then, - Say 'C1UEXTR7 is called again:' - /* Parms from C1UEXT07 is a string of REXX statements */ - Interpret Parms - If TraceRQ = 'Y' & PECB_MODE = 'B' then Trace r - If Substr(PHDR_PKG_NOTE5,1,5) = 'TRACE' then TraceRc = 1 - where = 'C1UEXTR7' - what = 'C1UEXTR7-' PECB_FUNCTION_LITERAL, - PECB_BEF_AFTER_LITERAL, - PHDR_PACKAGE_STATUS - /* Validate Package prefix with ServiceNow */ - If PECB_FUNCTION_LITERAL ='CREATE' &, - PECB_BEF_AFTER_LITERAL ='BEFORE' &, - (Substr(PECB_PACKAGE_ID,1,3) = 'PRB' |, - Substr(PECB_PACKAGE_ID,1,3) = 'CHG' ) then, - Do - PackageSnowRef = Substr(PECB_PACKAGE_ID,1,10) - Message = SERVINOW('C1UEXTR7' PackageSnowRef ECB_TSO_BATCH_MODE) - If POS('**NOT**', Message) > 0 then, - Do - MyRc = 8 - Call SetExitReturnInfo - Exit - End; /* If POS('**NOT**', Message) > 0 */ - End; /* If PECB_FUNCTION_LITERAL ='CREATE' ... */ - /* If the package status just became IN-APPROVAL, send emails */ - /* to request approval(s). */ - IF PHDR_PACKAGE_STATUS = 'IN-APPROVAL' &, - PECB_BEF_AFTER_LITERAL = 'AFTER' &, - PECB_FUNCTION_LITERAL = 'CAST' &, - Substr(CALL_REASON,1,16) = 'APPROVER GROUP #' then, - Do - Call SENDMAIL PAPP_GROUP_NAME PECB_PACKAGE_ID, - 'Needs-Approval' PAPP_APPROVAL_IDS - Exit - End - /* If the exit says there are no more approver groups, */ - /* FREE the SONAROPT allocation. */ - If Substr(CALL_REASON,1,21) = 'NO MORE APPROVER GRPS' then, - CALL BPXWDYN "FREE DD(SONAROPT) " ; - /* If the package status just became Approved, submit EXECUTE */ - IF PHDR_PACKAGE_STATUS = 'APPROVED' &, - PECB_BEF_AFTER_LITERAL = 'AFTER' &, - (PECB_FUNCTION_LITERAL = 'CAST' |, - PECB_FUNCTION_LITERAL = 'REVIEW') Then, - Do - PKGEXECT_Parm = Copies(' ',055) - PKGEXECT_Parm = Overlay(PECB_PACKAGE_ID ,PKGEXECT_Parm,001) - PKGEXECT_Parm = Overlay(PHDR_PKG_ENV ,PKGEXECT_Parm,018) - PKGEXECT_Parm = Overlay(PHDR_PKG_STGID ,PKGEXECT_Parm,026) - PKGEXECT_Parm = Overlay(REXX_EXEC_MODE ,PKGEXECT_Parm,028) - PKGEXECT_Parm = Overlay(PHDR_PKG_CREATE_USER,PKGEXECT_Parm,029) - PKGEXECT_Parm = Overlay(PHDR_PKG_UPDATE_USER,PKGEXECT_Parm,037) - PKGEXECT_Parm = Overlay(PHDR_PKG_CAST_USER ,PKGEXECT_Parm,045) - Call PKGEXECT PKGEXECT_Parm - Exit - End - /* Prevent a package from Backed out/in in batch */ - If Substr(PECB_FUNCTION_LITERAL,1,4) = 'BACK' &, - PECB_MODE = 'B' then, - Do - message = 'C1UEXTR7 -', - 'Package Backout/Backin unAuthorized for Batch' - MyRc = 8 - Call SetExitReturnInfo - If TraceRQ = 'Y' then Say 'C1UEXTR7 is exiting @123 ' - Exit - End - /* Before a package is being Backed out/in .... */ - IF PECB_BEF_AFTER_LITERAL = 'BEFORE' & PECB_MODE = 'T' &, - Substr(PECB_FUNCTION_LITERAL,1,4) = 'BACK' then, - Do - what = 'C1UEXTR7 before Backout/Backin' - ADDRESS TSO "EXECIO 1 DISKR AUTHORIZ (Finis" - pull BakoutCCID - BakoutCCID = Strip(BakoutCCID) - Call BKOUTLOG PECB_PACKAGE_ID 'Before', - BakoutCCID USERID() - End - /* If a package is being Backed out/in .... */ - IF PECB_BEF_AFTER_LITERAL = 'AFTER' & PECB_MODE = 'T' &, - Substr(PECB_FUNCTION_LITERAL,1,4) = 'BACK' then, - Do - what = 'C1UEXTR7 after Backout/Backin' - ADDRESS TSO "EXECIO 1 DISKR AUTHORIZ (Finis" - pull BakoutCCID - CALL BPXWDYN "FREE DD(AUTHORIZ)" - BakoutCCID = Strip(BakoutCCID) - Call BKOUTLOG PECB_PACKAGE_ID 'After', - BakoutCCID USERID() - ModelMember = 'SHIPRUNS' - Call SubmitBatchJCL - Exit - End - /* If a package is executed, examine for package shipments */ - IF PECB_BEF_AFTER_LITERAL = 'AFTER' &, - (Substr(PECB_FUNCTION_LITERAL,1,4) = 'EXEC' |, - Substr(PECB_FUNCTION_LITERAL,1,4) = 'BACK') then, - Do - If TraceRQ = 'Y' then Say 'C1UEXTR7 is exiting @160 ' - PKGESHIP_Parm = Copies(' ',055) - PKGESHIP_Parm = Overlay(PECB_PACKAGE_ID ,PKGESHIP_Parm,001) - PKGESHIP_Parm = Overlay(PHDR_PKG_ENV ,PKGESHIP_Parm,018) - PKGESHIP_Parm = Overlay(PHDR_PKG_STGID ,PKGESHIP_Parm,027) - PKGESHIP_Parm = Overlay(REXX_EXEC_MODE ,PKGESHIP_Parm,028) - PKGESHIP_Parm = Overlay(PHDR_PKG_CREATE_USER,PKGESHIP_Parm,029) - PKGESHIP_Parm = Overlay(PHDR_PKG_UPDATE_USER,PKGESHIP_Parm,037) - PKGESHIP_Parm = Overlay(PHDR_PKG_CAST_USER ,PKGESHIP_Parm,045) - PKGESHIP_Parm = Overlay(PHDR_PKG_NOTE1 ,PKGESHIP_Parm,054) - PKGESHIP_Parm = Overlay(PHDR_PKG_NOTE2 ,PKGESHIP_Parm,114) - PKGESHIP_Parm = Overlay(PHDR_PKG_NOTE3 ,PKGESHIP_Parm,174) - PKGESHIP_Parm = Overlay(PHDR_PKG_NOTE4 ,PKGESHIP_Parm,234) - PKGESHIP_Parm = Overlay(PHDR_PKG_NOTE5 ,PKGESHIP_Parm,294) - PKGESHIP_Parm = Overlay(PHDR_PKG_NOTE6 ,PKGESHIP_Parm,354) - PKGESHIP_Parm = Overlay(PHDR_PKG_NOTE7 ,PKGESHIP_Parm,414) - PKGESHIP_Parm = Overlay(PHDR_PKG_NOTE8 ,PKGESHIP_Parm,474) - If Substr(PECB_FUNCTION_LITERAL,1,4) = 'BACK' then, - PKGESHIP_Parm = Overlay('BAK' ,PKGESHIP_Parm,584) - Else, - PKGESHIP_Parm = Overlay('OUT' ,PKGESHIP_Parm,584) - Call PKGESHIP PKGESHIP_Parm - If TraceRQ = 'Y' then Say 'C1UEXTR7 is exiting @183 ' - Exit - End - /* This code runs when you want to force CASTs to run in batch */ - If PECB_FUNCTION_LITERAL ='CAST' &, - PECB_SUBFUNC_LITERAL ='CAST' &, - PECB_BEF_AFTER_LITERAL ='BEFORE' &, - PHDR_PACKAGE_STATUS ='IN-EDIT' &, - PECB_MODE = "T" &, /* TSO foreground */ - (Force_CAST_in_Batch= 'Y' | Cast_with_SonarQube= 'Y') then, - Do - ModelMember = 'CAST#JCL' - Call SubmitBatchJCL - Message = JobData - MyRc = 8 - PACKAGE = PECB_PACKAGE_ID - MessageCode = 'U033' - Call SetExitReturnInfo - Exit - End - /* If we have any issues up at this point */ - /* set the Exit's return code and get out */ - If MyRc > 0 then, - Do - Call SetExitReturnInfo - Exit - End - /* Considering a SonarQube scan... ( +COB in description) */ - /* Does PACKAGE builder indicate the package has COBOL ? */ - thisPackageHasCobol = 'N' - If Substr(PREQ_PACKAGE_COMMENT,47,4) = '+COB' then, - thisPackageHasCobol = 'Y' - /* Considering a SonarQube scan... ( +COB in description) */ - /* If running in Batch and ... execute SonarQube Analysis*/ - IF Cast_with_SonarQube= 'Y' &, - thisPackageHasCobol= 'Y' &, - PECB_FUNCTION_LITERAL = 'CAST' &, - PECB_BEF_AFTER_LITERAL = 'MID' &, - PECB_MODE = "B" then, /* running in Batch */ - Do - AllNotes = PHDR_PKG_NOTE1 ||, - PHDR_PKG_NOTE2 ||, - PHDR_PKG_NOTE3 ||, - PHDR_PKG_NOTE4 ||, - PHDR_PKG_NOTE5 ||, - PHDR_PKG_NOTE6 ||, - PHDR_PKG_NOTE7 ||, - PHDR_PKG_NOTE8 - Upper AllNotes - If Pos('BYPASS SONARQUBE', AllNotes) > 0 then, - Say 'C1UEXTR7- A bypass of SonarQube processing', - 'is requested in the package notes' - Else, - Do /*Execute SonarQube*/ - Message = SONRQUBE(PECB_PACKAGE_ID); - If Message /= '' then, - Do - MyRc = 8 - Call SetExitReturnInfo - End - Exit - End /* Else.. If Pos('BYPASS SONARQUBE' */ - End /* IF Cast_with_SonarQube= 'Y' .... */ - /* Enforce packages to be Backout Enabled */ - IF PREQ_BACKOUT_ENABLED /= 'Y' then, - Do - Message = 'C1UEXTR7 - Package made to be Backout enabled' - MyRc = 4 - hexAddress = D2X(Address_PREQ_BACKOUT_ENABLED) - storrep = STORAGE(hexAddress,,'Y') - Call SetExitReturnInfo - Exit - End; - EXIT - /* Early outs .... */ - If PECB_FUNCTION_LITERAL = 'SETUP' then Exit - /* Work in progress .... */ - /* Unspecified about SonarQube? Let NOTES decide.... */ - If Cast_with_SonarQube /= 'N' then, - Do - End /* If Cast_with_SonarQube /= 'N' */ - If PECB_FUNCTION_LITERAL ='CAST' &, - PECB_SUBFUNC_LITERAL ='CAST' &, - PECB_BEF_AFTER_LITERAL ='AFTER' then, - Call ManageEmails ; - Exit -ManageEmails: - If TraceRQ = 'Y' then Trace ?R - whereami = 'ManageEmails' - /* Only run if the exit is giving us an Approver Group */ - If Substr(CALL_REASON,1,16) = 'APPROVER GROUP #' then, - Do - Call SaveOffApproverGrpInfo - Return - End - /*****************************************************************/ - /* Initializaztion and Example statements */ - /*****************************************************************/ - MySMTP_Message =, - 'YOURSITE.NDVR.REXX(C1UEXTR7)' - MySMTP_Message =, - 'SHARE.ENDV.SHARABLE.REXX(C1UEXTR7)' - MySMTP_Subject = 'Please Approve Package' PECB_PACKAGE_ID - MySMTP_From = Left('YOURSITE your testing Endevor',50) - MySMTP_textline.1 = 'Package' PECB_PACKAGE_ID, - ' has been CAST and is ready for APPROVAL.' - MySMTP_textline.2 = 'Your Review and approval of package', - PECB_PACKAGE_ID 'is reqested.' - MySMTP_textline.3 = ' ' - MySMTP_textline.4 = ' ' - MySMTP_textline.0 = 4 - MYSMTP_EMAIL_IDS = '' - /* Only run if the exit says all Approver Grps are done */ - If Substr(CALL_REASON,1,22) = 'NO MORE APPROVER GRPS ' then, - Do - Call CheckApproverGroupSequence - Return - End - Return -SaveOffApproverGrpInfo: - If TraceRQ = 'Y' then Trace ?R - PAPP_SEQUENCE_NUMBER = Substr(CALL_REASON,17,4) - numberQueued = QUEUED() - If PAPP_SEQUENCE_NUMBER = "0001" & numberQueued > 0 then, - Do numberQueued /* Clear out whatever is queued */ - pull leftovers - End - If PAPP_SEQUENCE_NUMBER = "0001" then, - CALL BPXWDYN , /* save Approver group data */ - "ALLOC DD(C1UEXTD7) LRECL(180) BLKSIZE(18000) SPACE(1,1) ", - " RECFM(F,B) TRACKS ", - " MOD UNCATALOG REUSE "; - pkgGrp# = Strip(PAPP_SEQUENCE_NUMBER,'L','0') - PAPP_GROUP_NAME = Strip(PAPP_GROUP_NAME) - Queue 'pkgGrp# = 'pkgGrp# - Queue 'GROUP_NAME.pkgGrp# ="'PAPP_GROUP_NAME'"' - Queue 'ENVIRONMENT.pkgGrp# ="'Strip(PAPP_ENVIRONMENT)'"' - Queue 'APPR_GRP_TYPE.pkgGrp# ="'Strip(PAPP_APPR_GRP_TYPE)'"' - Queue 'APPR_GRP_DISQ.pkgGrp# ="'Strip(PAPP_APPR_GRP_DISQ)'"' - Queue 'APPROVAL_FLAGS.pkgGrp# ="'Strip(PAPP_APPROVAL_FLAGS)'"' - Queue 'STATUS.'PAPP_GROUP_NAME '="'Strip(PAPP_APPROVER_FLAG)'"' - Queue 'QUORUM.'PAPP_GROUP_NAME '='Strip(PAPP_QUORUM_COUNT,'L','0') - Queue 'USRLST.'PAPP_GROUP_NAME '="'Strip(PAPP_APPROVAL_IDS)'"' - numberQueued = QUEUED() - "EXECIO" numberQueued " DISKW C1UEXTD7 " - Return; -CheckApproverGroupSequence: - If TraceRQ = 'Y' then Trace ?R - whereami = 'CheckApproverGroupSequence' - /* If C1UEXTD7 is allocated to anything, we have approvers */ - WhatDDName = 'C1UEXTD7' - CALL BPXWDYN "INFO FI("WhatDDName")", - "INRTDSN(DSNVAR) INRDSNT(myDSNT)" - If Substr(DSNVAR,1,1) = ' ' then Return - "EXECIO 0 DISKW C1UEXTD7 (Finis" - "EXECIO * DISKR C1UEXTD7 (Finis" - CALL BPXWDYN "FREE DD(C1UEXTD7)" - numberQueued = QUEUED() - /* Analyze Exit-provided Approver Group info */ - pkgGrp# = 0 - /* By default, ordered Approver Groups are not related */ - STATUS. = 'NotRelated' - QUORUM. = 0 - /* Return Approver Group info for this package */ - Do q# = 1 to numberQueued - Parse Pull something - If TraceRQ = 'Y' then say "@187" something - interpret something - End; - ThisEnvironment = ENVIRONMENT.pkgGrp# - /* Read the site's required Approver Group sequencing */ - CALL BPXWDYN, - "ALLOC DD(APPROVER) DA('"ApproverGroupSequence"') SHR REUSE" - "EXECIO * DISKR APPROVER (Stem ordered. Finis" - CALL BPXWDYN "FREE DD(APPROVER)" - /* Build a sequenced list of all named Approver Groups */ - OrderedApproverGroups = '' - /* Set a default value to be 1 greater than number of groups */ - NotOrdered = ordered.0 + 1 - Sequence. = NotOrdered - Do ord# = 1 to ordered.0 - orderedEntry = ordered.ord# - orderedEnv = Word(orderedEntry,1) - If orderedEnv /= thisEnvironment then iterate - orderedApproverGroup = Word(orderedEntry,2) - If orderedApproverGroup = 'AllOthers' then, - DefaultOrder = ord# - SEQUENCE.orderedApproverGroup = ord# - If TraceRQ = 'Y' then, - say "@201 Sequence for" orderedApproverGroup "is" ord# - End; /* Do ord# = 1 to ordered.0 */ - Sequence.NotOrdered = DefaultOrder - unsorted_list = "" - /* Build a list of Approver Groups for this package */ - PackageApproverGroups = '' - Do p# = 1 to pkgGrp# - PackageApproverGroup = GROUP_NAME.p# - thisSequence = SEQUENCE.PackageApproverGroup - entry = Right(thisSequence,4,'0') || '.' ||, - PackageApproverGroup - unsorted_list = unsorted_list entry - If TraceRQ = 'Y' then, - Say "unsorted_list=" unsorted_list - End; - Call SortApproverGroupList; - If TraceRQ = 'Y' then say "@220 PackageApproverGroups =", - sorted_list, - ' ThisEnvironment =' ThisEnvironment - /* Go through the Sorted list to identify the status */ - /* of the next group(s) to be approved */ - /* Find the 1st Approver group this user belongs to.... */ - thisApprover = USERID() - lastSequence = NotOrdered - Do seq# = 1 to Words(sorted_list) - entry = Word(sorted_list,seq#) - Parse Var entry thisSequence '.' orderedApproverGroup - orderedGroupStatus = STATUS.orderedApproverGroup - If orderedGroupStatus = 'APPROVED' then Iterate; - orderedGroupQuorum = QUORUM.orderedApproverGroup - If orderedGroupQuorum = 0 then Iterate; - If thisSequence > lastSequence then, - Do - Sa= 'We need to wait' - Leave; - End; - lastSequence = thisSequence - ListApprovers = USRLST.orderedApproverGroup - whereApprover = Wordpos(thisApprover,ListApprovers) - thisApproversFlag = " " - If whereApprover > 0 then, - Do - thisApproverGroup = orderedApproverGroup - thisApproversFlag = Word(APPROVAL_FLAGS.grp#,whereApprover) - End - If TraceRQ = 'Y' then, - Say orderedApproverGroup 'has status of' orderedGroupStatus, - " Quorum" orderedGroupQuorum - IF whereApprover > 0 &, - orderedGroupStatus /= 'NotRelated' then, - sa= 'You must wait for the' orderedApproverGroup, - " group's approval" - If Words(ListApprovers) > 0 then, - Do w# = 1 to Words(ListApprovers) - Approver = Word(ListApprovers,w#) - If Wordpos(Approver,MYSMTP_EMAIL_IDS) = 0 &, - Substr(Approver,1,1) > '00'X then, - MYSMTP_EMAIL_IDS = MYSMTP_EMAIL_IDS Approver - End; /* Do w# = 1 to Words(ListApprovers) */ - End; /* Do seq# = 1 to Words(sorted_list) */ - /* Prepare email to the usrids in MYSMTP_EMAIL_IDS */ - Call PrepareEmail - Return; -SortApproverGroupList: - If TraceRQ = 'Y' then Trace ?R - whereami = 'SortApproverGroupList' - sa= words(unsorted_list) unsorted_list; - drop sorted_list; - sorted_list = ""; - do forever ; - if words(unsorted_list) = 0 then leave; - lowest_entry = 1; - do entry = 1 to words(unsorted_list) - if word(unsorted_list,entry) <, - word(unsorted_list,lowest_entry) then, - lowest_entry = entry; - end; /* do entry = 1 .... */ - sorted_list = sorted_list word(unsorted_list,lowest_entry); - sa= "sorted_list=" sorted_list ; - position = wordindex(unsorted_list,lowest_entry) ; - len = length(word(unsorted_list,lowest_entry)); - unsorted_list =, - overlay(copies(" ",len),unsorted_list,position) ; - sa= "unsorted_list=" unsorted_list ; - end; /* do forever */ - drop unsorted_list; - sa= words(sorted_list) sorted_list; - Return; -PrepareEmail: - If TraceRQ = 'Y' then Trace ?R - whereami = 'PrepareEmail' -/* Here you can make last-moment adjustments to the email */ - shortlist = Substr(MYSMTP_EMAIL_IDS,1,100) - If Substr(MYSMTP_EMAIL_IDS,100,1) /= ' ' &, - Substr(MYSMTP_EMAIL_IDS,101,1) /= ' ' then, - Do - whereEnd = WordIndex(shortlist,Words(shortlist)) - shortlist = DELWORD(shortlist,whereEnd) - End - MySMTP_textline.4 = 'Sent to Group:' shortlist -/* Code in the section below should not be changed */ -/* Code in the section below should not be changed */ -/* Code in the section below should not be changed */ - MySMTP_Message = Left(MySMTP_Message,80) - hexAddress = D2X(Address_MYSMTP_MESSAGE) - storrep = STORAGE(hexAddress,,Message) - MySMTP_From = Left(MySMTP_From,50) - hexAddress = D2X(Address_MYSMTP_FROM) - storrep = STORAGE(hexAddress,,MySMTP_From) - MySMTP_Subject = Left(MySMTP_Subject,50) - hexAddress = D2X(Address_MySMTP_Subject) - storrep = STORAGE(hexAddress,,MySMTP_Subject) -/* If TraceRQ = 'Y' then Trace ?r */ - MYSMTP_COUNTER = '' - numberLines = Right(MySMTP_textline.0,2,'0') - Do l# = 1 to Length(numberLines) - MYSMTP_COUNTER = MYSMTP_COUNTER ||, - 'F' || Substr(numberLines,l#,1) - End - If TraceRQ = 'Y' then say 'MYSMTP_COUNTER=' MYSMTP_COUNTER - MYSMTP_TEXT = X2C(MYSMTP_COUNTER) - Do line# = 1 to numberLines - MYSMTP_TEXT = MYSMTP_TEXT || Left(MySMTP_textline.line#,133) - End; /* Do line# = 1 to MySMTP_textline.0 */ - hexAddress = D2X(Address_MYSMTP_TEXT) - storrep = STORAGE(hexAddress,,MYSMTP_TEXT) - MySMTP_URL = 'N' - hexAddress = D2X(Address_MYSMTP_URL) - storrep = STORAGE(hexAddress,,MySMTP_URL) - /* Provide distribution list ( list of userids ) to Exit */ - MYSMTP_EMAIL_IDS =, - Space(Strip(Translate(MYSMTP_EMAIL_IDS,' ','00'x))) - MYSMTP_EMAIL_IDS = MYSMTP_EMAIL_IDS '0000'x - MYSMTP_EMAIL_IDS = Left(MYSMTP_EMAIL_IDS,MYSMTP_EMAIL_ID_SIZE) - hexAddress = D2X(Address_MYSMTP_EMAIL_IDS) - storrep = STORAGE(hexAddress,,MYSMTP_EMAIL_IDS) - Return; -SubmitBatchJCL: - If TraceRQ = 'Y' then Trace ?R - whereami = 'SubmitBatchJCL' - /* Variable settings for each site ---> */ - WhereIam = WHERE@M1() - interpret 'Call' WhereIam "'MySENULibrary'" - MySENULibrary = Result - interpret 'Call' WhereIam "'MySEN2Library'" - MySEN2Library = Result - interpret 'Call' WhereIam "'MyCLS0Library'" - MyCLS0Library = Result - interpret 'Call' WhereIam "'MyCLS2Library'" - MyCLS2Library = Result - Unique_Name = GTUNIQUE() - /* Get job-related information from low address locations */ - MyAccountingCode = GETACCTC() - job_name = MVSVAR('SYMDEF',JOBNAME ) /*Returns JOBNAME */ - Jobname= BUMPJOB(job_name) - /* Prepare and run a Table Tool to build CAST jcl....... */ - CALL BPXWDYN , - "ALLOC DD(TABLE) LRECL(80) BLKSIZE(27920) SPACE(1,1) ", - " RECFM(F,B) TRACKS ", - " NEW UNCATALOG REUSE "; - Queue "* Do" - Queue " * " - "EXECIO 2 DISKW TABLE (FINIS "; /* count queued */ - CALL BPXWDYN "ALLOC DD(NOTHING) DUMMY" - CALL BPXWDYN , - "ALLOC DD(OPTIONS) LRECL(80) BLKSIZE(27920) SPACE(1,1) ", - " RECFM(F,B) TRACKS ", - " NEW UNCATALOG REUSE "; - QUEUE "$nomessages ='Y'" - QUEUE "MyAccountingCode='"MyAccountingCode"'" - QUEUE "MySEN2Library ='"MySEN2Library"'" - QUEUE "MySENULibrary ='"MySENULibrary"'" - QUEUE "MyCLS0Library ='"MyCLS0Library"'" - QUEUE "MyCLS2Library ='"MyCLS2Library"'" - QUEUE "Unique_Name ='"Unique_Name"'" - QUEUE "PECB_PACKAGE_ID ='"PECB_PACKAGE_ID"'" - QUEUE "Jobname= '"Jobname"'" - QUEUE "TBLOUT = 'SUBMTJCL'" - "EXECIO 10 DISKW OPTIONS (FINIS "; /* count queued */ - /* For CASTing a package in Batch */ - /* Build a JCL model, and name its location here.... */ - /* Name a work dataset to be created then deleted... */ - Jcl2SumbitModel = MySEN2Library || '(' || ModelMember || ')' - "ALLOC F(MODEL) DA('"Jcl2SumbitModel"') SHR REUSE" - /* Build the JCL for a Batch Cast */ - CastPackageJCL = USERID()".C1UEXTR7.SUBMIT."Unique_Name - "ALLOC F(SUBMTJCL) DA('"CastPackageJCL"') ", - "LRECL(80) BLKSIZE(16800) SPACE(5,5)", - "RECFM(F B) TRACKS ", - "NEW CATALOG REUSE " ; - myRC = ENBPIU00("A") - "EXECIO 0 DISKW SUBMTJCL (Finis" - "FREE DD(TABLE) " - "FREE DD(NOTHING) " - "FREE DD(OPTIONS) " - "FREE DD(MODEL) " - Call Submit_n_save_jobInfo ; - "FREE F(SUBMTJCL) DELETE " - Return; -Submit_n_save_jobInfo: /* submit Jcl2SumbitModel job and save job info */ - If TraceRQ = 'Y' then Trace ?R - whereami = 'Submit_n_save_jobInfo' - If TraceRQ = 'Y' then Say 'Submit_n_save_jobInfo:' - Address TSO "PROFILE NOINTERCOM" /* turn off msg notific */ - CALL MSG "ON" - CALL OUTTRAP "out." - ADDRESS TSO "SUBMIT '"CastPackageJCL"'" ; - If RC > 4 then, - Do - MyRC = 8 - Message = 'Cannot find Element member to submit.' - Call SetExitReturnInfo - Exit(12) - End - CALL OUTTRAP "OFF" - Address TSO "PROFILE INTERCOM" /* turn on msg notific */ - JobData = Strip(out.1); - jobinfo = Word(JobData,2) ; - If jobinfo = 'JOB' then, - jobinfo = Word(JobData,3) ; - SelectJobName = Word(Translate(jobinfo,' ',')('),1) ; - SelectJobNumber = Word(Translate(jobinfo,' ',')('),2) ; - Return; -Allocate_Files_For_CSV_and_API: - STRING = "ALLOC DD(C1MSGS1) DUMMY " - CALL BPXWDYN STRING; - STRING = "ALLOC DD(BSTERR) DA(*) " - CALL BPXWDYN STRING; - STRING = "ALLOC DD(BSTAPI) DA(*) " - CALL BPXWDYN STRING; - STRING = "ALLOC DD(MSGFILE) LRECL(133) BLKSIZE(26600) ", - " DSORG(PS) ", - " SPACE(5,5) RECFM(F,B) TRACKS ", - " NEW UNCATALOG REUSE "; - CALL BPXWDYN STRING; - Return; -FREE_Files_For_CSV_and_API: - CALL BPXWDYN STRING; - STRING = "FREE DD(C1MSGS1)" ; - CALL BPXWDYN STRING; - STRING = "FREE DD(BSTERR)" ; - CALL BPXWDYN STRING; - STRING = "FREE DD(BSTAPI)" ; - CALL BPXWDYN STRING; - STRING = "FREE DD(MSGFILE)"; - CALL BPXWDYN STRING; - Return; -CSV_to_List_Package_Actions: - /* Get Package Action information for SonarQube preparations */ - STRING = "ALLOC DD(EXTRACTM) LRECL(4000) BLKSIZE(32000) ", - " DSORG(PS) ", - " SPACE(1,5) RECFM(F,B) TRACKS ", - " NEW UNCATALOG REUSE "; - CALL BPXWDYN STRING; - STRING = "ALLOC DD(BSTIPT01) LRECL(80) BLKSIZE(800) ", - " DSORG(PS) ", - " SPACE(1,5) RECFM(F,B) TRACKS ", - " NEW UNCATALOG REUSE "; - CALL BPXWDYN STRING; - QUEUE "LIST PACKAGE ACTION FROM PACKAGE '"PECB_PACKAGE_ID"'" - QUEUE " TO DDNAME 'EXTRACTM' " - QUEUE " ." - "EXECIO" QUEUED() "DISKW BSTIPT01 (FINIS "; - ADDRESS LINK 'BC1PCSV0' ; /* load from authlib */ - call_rc = rc ; - "EXECIO * DISKR EXTRACTM (STEM CSV. finis" - STRING = "FREE DD(EXTRACTM)" ; - CALL BPXWDYN STRING; - STRING = "FREE DD(BSTIPT01)" ; - /* To Search the package action data in CSV format. */ - /* Identify matches with Rules file, determining Ship Dests */ - IF CSV.0 < 2 THEN RETURN; - /* CSV data heading - showing CSV variables */ - $table_variables= Strip(CSV.1,'T') - $table_variables = translate($table_variables,"_"," ") ; - $table_variables = translate($table_variables," ",',"') ; - $table_variables = translate($table_variables,"@","/") ; - $table_variables = translate($table_variables,"@",")") ; - $table_variables = translate($table_variables,"@","(") ; - WantedCSVVariables= , - "ELM_@S@ ENV_NAME_@S@ STG_ID_@S@ ", - "SYS_NAME_@S@ SBS_NAME_@S@ TYPE_NAME_@S@ " - Do rec# = 2 to CSV.0 - $detail = CSV.rec# - Drop SBS_NAME_@T@ - Trace Off - /* Parse CSV fields in the Detail record until done */ - Do $column = 1 to Words($table_variables) - Call ParseDetailCSVline - End - If TraceRc = 1 then Trace r - IF Substr(ENV_NAME_@S@,1,1) = '00'x |, - Substr(ENV_NAME_@S@,1,1) = ' ' then Iterate; - elm# = Elements.0 + 1 - Elements.elm# = ELM_@S@ ENV_NAME_@S@ STG_ID_@S@, - SYS_NAME_@S@ SBS_NAME_@S@ TYPE_NAME_@S@ - Elements.0 = elm# - Sa= 'Messages from C1UEXTR7:' Elements.elm# - Trace Off - End; /* Do rec# = 1 to CSV.0 */ - RETURN ; -ParseDetailCSVline: - /* Find the data for the current $column */ - $dlmchar = Substr($detail,1,1); - If $dlmchar = "'" then, - Do - SA= 'parsing with single quote ' - PARSE VAR $detail "'" $temp_value "'" $detail ; - If Substr($detail,1,1) = ',' then, - $detail = Strip(Substr($detail,2),'L') - End - Else, - If $dlmchar = '"' then, - Do - SA= 'parsing with double quote ' - PARSE VAR $detail '"' $temp_value '"' $detail ; - If Substr($detail,1,1) = ',' then, - $detail = Strip(Substr($detail,2),'L') - End - Else, - If $dlmchar = ',' then, - Do - SA= 'parsing with comma ' - PARSE VAR $detail ',' $temp_value ',' $detail ; - If Substr($detail,1,1)/= ',' then, - $detail = "," || $detail - $detail = Strip(Substr($detail,2),'L') */ - End - Else, - If Words($detail) = 0 then, - $temp_value = ' ' - Else, - Do - SA= 'parsing with comma ' - PARSE VAR $detail $temp_value ',' $detail ; - Sa= '$temp_value=>' $temp_value '<' - End - $temp_value = STRIP($temp_value) ; - $rslt = $temp_value - $rslt = Strip($rslt,'B','"') ; - $rslt = Strip($rslt,'B',"'") ; - if Length($rslt) < 1 then $rslt = ' ' - thisVariable = WORD($table_variables,$column) - If Wordpos(thisVariable,WantedCSVVariables) = 0 then Return - if Length($rslt) < 250 then, - $temp = WORD($table_variables,$column) '= "'$rslt'"'; - Else, - $temp = WORD($table_variables,$column) "=$rslt" - INTERPRET $temp; - If rec# < 3 then Say $temp - RETURN ; -SetExitReturnInfo: - If TraceRQ = 'Y' then Trace ?R - whereami = 'SetExitReturnInfo' - If TraceRQ = 'Y' then Say 'SetExitReturnInfo: ' - hexAddress = D2X(Address_PECB_MESSAGE) - storrep = STORAGE(hexAddress,,Message) - hexAddress = D2X(Address_PECB_ERROR_MESS_LENGTH) - storrep = STORAGE(hexAddress,,'0084'X) - hexAddress = D2X(Address_PECB_MODS_MADE_TO_PREQ) - storrep = STORAGE(hexAddress,,'Y') - If MessageCode /= ' ' then, - Do - hexAddress = D2X(Address_PECB_MESSAGE_ID) - storrep = STORAGE(hexAddress,,MessageCode) - End -/* Set the return code for the exit */ -/* for PECB-NDVR-EXIT-RC */ - hexAddress = D2X(Address_PECB_NDVR_EXIT_RC) - If MyRc = 4 then, - storrep = STORAGE(hexAddress,,'00000004'X) - Else, - storrep = STORAGE(hexAddress,,'00000008'X) - RETURN ; diff --git a/endevor/Field-Developed-Programs/Package-Automation/GTDESTIN.rex b/endevor/Field-Developed-Programs/Package-Automation/GTDESTIN.rex new file mode 100644 index 0000000..f789481 --- /dev/null +++ b/endevor/Field-Developed-Programs/Package-Automation/GTDESTIN.rex @@ -0,0 +1,119 @@ +/* Rexx */ + Arg Destination + /* Get values for HOST_DSN_PREFIX and REMOTE_DSN_PREFIX */ + /* From the site definition */ + /* Call CSV to Get Destination information */ + HOST_DSN_PREFIX = "?" + REMOTE_DSN_PREFIX = "?" + TRANS_DESC = "?" + TRANS_NODE = "?" + HOST_DSN_DISP = "?" + REMOTE_DSN_DISP = "?" + STRING = "ALLOC DD(C1MSGS1) DUMMY " + STRING = "ALLOC DD(C1MSGS1) SYSOUT(A) " + CALL BPXWDYN STRING; + STRING = "ALLOC DD(BSTERR) SYSOUT(A) " + CALL BPXWDYN STRING; + STRING = "ALLOC DD(BSTAPI) DUMMY " + CALL BPXWDYN STRING; + STRING = "ALLOC DD(DESTINFO) LRECL(4000) BLKSIZE(32000) ", + " DSORG(PS) ", + " SPACE(1,5) RECFM(F,B) TRACKS ", + " NEW UNCATALOG REUSE "; + CALL BPXWDYN STRING; + STRING = "ALLOC DD(BSTIPT01) LRECL(80) BLKSIZE(800) ", + " DSORG(PS) ", + " SPACE(1,5) RECFM(F,B) TRACKS ", + " NEW UNCATALOG REUSE "; + CALL BPXWDYN STRING; + QUEUE "LIST DESTINATION '"Destination"'" + QUEUE " TO DDNAME 'DESTINFO' " + QUEUE " . " + "EXECIO" QUEUED() "DISKW BSTIPT01 (FINIS "; + CALL BPXWDYN "INFO FI(CONLIB) INRTDSN(DSNVAR) INRDSNT(myDSNT)" + if RESULT = 0 then, + Do + CSVParm = 'DDN:CONLIB,BC1PCSV0' + ADDRESS LINKMVS 'CONCALL' "CSVParm" + End + Else, + ADDRESS LINK 'BC1PCSV0' ; /* load from authlib */ + call_rc = rc ; + Drop apiDestinations. + "EXECIO * DISKR DESTINFO (STEM apiDestinations. finis" + IF apiDestinations.0 < 1 then, + Return HOST_DSN_PREFIX REMOTE_DSN_PREFIX TRANS_DESC TRANS_NODE + /* CSV data heading - showing CSV variables */ + $table_variables= Strip(apiDestinations.1,'T') + $table_variables = translate($table_variables,"_"," ") ; + $table_variables = translate($table_variables," ",',"') ; + $table_variables = translate($table_variables,"@","/") ; + $table_variables = translate($table_variables,"@",")") ; + $table_variables = translate($table_variables,"@","(") ; + WantedCSVVariables= "HOST_DSN_PREFIX REMOTE_DSN_PREFIX ", + "TRANS_DESC TRANS_NODE", + "HOST_DSN_DISP REMOTE_DSN_DISP" + $detail = apiDestinations.2 + /* Parse CSV fields in the Detail record until done */ + Do $column = 1 to Words($table_variables) + Call ParseDetailCSVline + End + CALL BPXWDYN "FREE DD(DESTINFO)" ; + CALL BPXWDYN "FREE DD(BSTIPT01)" ; + CALL BPXWDYN "FREE DD(C1MSGS1)" ; + CALL BPXWDYN "FREE DD(BSTERR)" ; + CALL BPXWDYN "FREE DD(BSTAPI)" ; + If TRANS_DESC = 'LOCAL' then, + REMOTE_DSN_PREFIX = HOST_DSN_PREFIX + Return HOST_DSN_PREFIX REMOTE_DSN_PREFIX TRANS_DESC TRANS_NODE, + HOST_DSN_DISP REMOTE_DSN_DISP +ParseDetailCSVline: + /* Find the data for the current $column */ + $dlmchar = Substr($detail,1,1); + If $dlmchar = "'" then, + Do + SA= 'parsing with single quote ' + PARSE VAR $detail "'" $temp_value "'" $detail ; + If Substr($detail,1,1) = ',' then, + $detail = Strip(Substr($detail,2),'L') + End + Else, + If $dlmchar = '"' then, + Do + SA= 'parsing with double quote ' + PARSE VAR $detail '"' $temp_value '"' $detail ; + If Substr($detail,1,1) = ',' then, + $detail = Strip(Substr($detail,2),'L') + End + Else, + If $dlmchar = ',' then, + Do + SA= 'parsing with comma ' + PARSE VAR $detail ',' $temp_value ',' $detail ; + If Substr($detail,1,1)/= ',' then, + $detail = "," || $detail + $detail = Strip(Substr($detail,2),'L') */ + End + Else, + If Words($detail) = 0 then, + $temp_value = ' ' + Else, + Do + SA= 'parsing with comma ' + PARSE VAR $detail $temp_value ',' $detail ; + Sa= '$temp_value=>' $temp_value '<' + End + $temp_value = STRIP($temp_value) ; + $rslt = $temp_value + $rslt = Strip($rslt,'B','"') ; + $rslt = Strip($rslt,'B',"'") ; + if Length($rslt) < 1 then $rslt = ' ' + thisVariable = WORD($table_variables,$column) + If Wordpos(thisVariable,WantedCSVVariables) = 0 then Return + if Length($rslt) < 250 then, + $temp = WORD($table_variables,$column) '= "'$rslt'"'; + Else, + $temp = WORD($table_variables,$column) "=$rslt" + INTERPRET $temp; + If rec# < 3 then Say Destination $temp + RETURN ; diff --git a/endevor/Field-Developed-Programs/Package-Automation/GetApproverGroupInfo.rex b/endevor/Field-Developed-Programs/Package-Automation/GetApproverGroupInfo.rex new file mode 100644 index 0000000..3bcf6b7 --- /dev/null +++ b/endevor/Field-Developed-Programs/Package-Automation/GetApproverGroupInfo.rex @@ -0,0 +1,138 @@ +/* REXX */ + + /* Use the variable and value you have for Package name */ + Arg Package ; + + /* Initially the package has quorum=0 for all Approver Grps */ + Highest_QUORUM_CNT = 0 + + /* Prepare and run a CSV call to fetch Approvals for Package */ + + Call CSV_to_List_Package_Approvals + + Call Parse_CSV_for_Package_Approvals + + Exit + +CSV_to_List_Package_Approvals: + /* Get Package Approver group information */ + STRING = "ALLOC DD(EXTRACTM) LRECL(4000) BLKSIZE(32000) ", + " DSORG(PS) ", + " SPACE(1,5) RECFM(F,B) TRACKS ", + " NEW UNCATALOG REUSE "; + CALL BPXWDYN STRING; + STRING = "ALLOC DD(C1MSGS1) SYSOUT(A)" + CALL BPXWDYN STRING; + STRING = "ALLOC DD(BSTERR) SYSOUT(A)" + CALL BPXWDYN STRING; + STRING = "ALLOC DD(BSTIPT01) LRECL(80) BLKSIZE(800) ", + " DSORG(PS) ", + " SPACE(1,5) RECFM(F,B) TRACKS ", + " NEW UNCATALOG REUSE "; + CALL BPXWDYN STRING; + QUEUE "LIST PACKAGE APPROVER GROUP", + "FROM PACKAGE '"Package"'" + QUEUE " TO DDNAME 'EXTRACTM' " + QUEUE " ." + "EXECIO 3 DISKW BSTIPT01 (FINIS "; + + CALL BPXWDYN "INFO FI(CONLIB) INRTDSN(DSNVAR) INRDSNT(myDSNT)" + if RESULT = 0 then, + Do + CSVParm = 'DDN:CONLIB,BC1PCSV0' + ADDRESS LINKMVS 'CONCALL' "CSVParm" + End + Else, + ADDRESS LINK 'BC1PCSV0' ; /* load from authlib */ + + call_rc = rc ; + + CALL BPXWDYN "FREE DD(BSTIPT01)" ; + CALL BPXWDYN "FREE DD(C1MSGS1)" ; + CALL BPXWDYN "FREE DD(BSTERR)" ; + + If call_rc > 4 then Return + "EXECIO * DISKR EXTRACTM (STEM CSV. finis" + CALL BPXWDYN "FREE DD(EXTRACTM)" ; + + Return + +Parse_CSV_for_Package_Approvals: + /* To Search the package action data in CSV format. */ + /* Identify matches with Rules file, determining Ship Dests */ + IF CSV.0 < 2 THEN RETURN; + /* CSV data heading - showing CSV variables */ + $table_variables= Strip(CSV.1,'T') + $table_variables = translate($table_variables,"_"," ") ; + $table_variables = translate($table_variables," ",',"') ; + $table_variables = translate($table_variables,"@","/") ; + $table_variables = translate($table_variables,"@",")") ; + $table_variables = translate($table_variables,"@","(") ; + /* Indicate which CSV variables you want */ + WantedCSVVariables= , + "PKG_ID APPR_GRP_NAME ", + "OVERALL_APPR_STATUS QUORUM_CNT" + WantedCSVVariables= "QUORUM_CNT" + WantedCSVVariables= "APPR_GRP_NAME OVERALL_APPR_STATUS ", + "QUORUM_CNT SEQ#" + + Do rec# = 2 to CSV.0 + $detail = CSV.rec# + /* Parse CSV fields in the Detail record until done */ + Do $column = 1 to Words($table_variables) + Call ParseDetailCSVline + End + If QUORUM_CNT > Highest_QUORUM_CNT then, + Highest_QUORUM_CNT = QUORUM_CNT + If SEQ# = 1 then, + Say APPR_GRP_NAME OVERALL_APPR_STATUS QUORUM_CNT + End; /* Do rec# = 1 to CSV.0 */ + + say "Highest_QUORUM_CNT=" Highest_QUORUM_CNT + RETURN ; + +ParseDetailCSVline: + /* Find the data for the current $column */ + $dlmchar = Substr($detail,1,1); + If $dlmchar = "'" then, + Do + PARSE VAR $detail "'" $temp_value "'" $detail ; + If Substr($detail,1,1) = ',' then, + $detail = Strip(Substr($detail,2),'L') + End + Else, + If $dlmchar = '"' then, + Do + PARSE VAR $detail '"' $temp_value '"' $detail ; + If Substr($detail,1,1) = ',' then, + $detail = Strip(Substr($detail,2),'L') + End + Else, + If $dlmchar = ',' then, + Do + PARSE VAR $detail ',' $temp_value ',' $detail ; + If Substr($detail,1,1)/= ',' then, + $detail = "," || $detail + $detail = Strip(Substr($detail,2),'L') */ + End + Else, + If Words($detail) = 0 then, + $temp_value = ' ' + Else, + Do + PARSE VAR $detail $temp_value ',' $detail ; + End + $temp_value = STRIP($temp_value) ; + $rslt = $temp_value + $rslt = Strip($rslt,'B','"') ; + $rslt = Strip($rslt,'B',"'") ; + if Length($rslt) < 1 then $rslt = ' ' + thisVariable = WORD($table_variables,$column) + If Wordpos(thisVariable,WantedCSVVariables) = 0 then Return + if Length($rslt) < 250 then, + $temp = WORD($table_variables,$column) '= "'$rslt'"'; + Else, + $temp = WORD($table_variables,$column) "=$rslt" + INTERPRET $temp; + If rec# < 0 then Say $temp + RETURN ; diff --git a/endevor/Field-Developed-Programs/Package-Automation/PULLTGGR.rex b/endevor/Field-Developed-Programs/Package-Automation/PULLTGGR.rex index 951b582..a15dbc7 100644 --- a/endevor/Field-Developed-Programs/Package-Automation/PULLTGGR.rex +++ b/endevor/Field-Developed-Programs/Package-Automation/PULLTGGR.rex @@ -9,80 +9,62 @@ /* From data in SHIPRULE, BILDTGGR updates the Trigger file */ /* for each expected shipment. PULLTGGR submits package ship jobs. */ /* */ - /* If a DDNAME of PULLTGGR is allocated, then Trace */ - WhatDDName = 'PULLTGGR' - CALL BPXWDYN "INFO FI("WhatDDName")", - "INRTDSN(DSNVAR) INRDSNT(myDSNT)" - if Substr(DSNVAR,1,1) /= ' ' then TraceRc = 1; - IF TraceRc = 1 then Trace R - + CALL BPXWDYN "INFO FI(PULLTGGR) INRTDSN(DSNVAR) INRDSNT(myDSNT)" + if RESULT = 0 then TraceRc = 1; + If TraceRc = 1 then Trace r + /* If a DDNAME of ISPPLIB is allocated, we are in foreground */ + CALL BPXWDYN "INFO FI(ISPPLIB) INRTDSN(DSNVAR) INRDSNT(myDSNT)" + if RESULT = 0 then runMode = 'FORE' + Else runMode = 'BACK' /* PkgExecJobname = MVSVAR('SYMDEF',JOBNAME ) Returns JOBNAME */ - /* Variable settings for each site ---> */ WhereIam = WHERE@M1() - interpret 'Call' WhereIam "'MyCLS2Library'" MyCLS2Library = Result Say 'Running PULLTGGR in' MyCLS2Library - + interpret 'Call' WhereIam "'MySHIPLibrary'" + MySHIPLibrary = Result interpret 'Call' WhereIam "'TriggerFileName'" TriggerFileName = Result - interpret 'Call' WhereIam "'MyAUTULibrary'" MyAUTULibrary = Result - interpret 'Call' WhereIam "'MyHomeAddress'" MyHomeAddress = Result - interpret 'Call' WhereIam "'MyAUTHLibrary'" MyAUTHLibrary = Result - interpret 'Call' WhereIam "'MyLOADLibrary'" MyLOADLibrary = Result - interpret 'Call' WhereIam "'MyDATALibrary'" MyDATALibrary = Result ShipRules = MyDATALibrary"(SHIPRULE)" - interpret 'Call' WhereIam "'MyOPT2Library'" MyOPT2Library = Result - interpret 'Call' WhereIam "'MyOPTNLibrary'" MyOPTNLibrary = Result - interpret 'Call' WhereIam "'MySENULibrary'" MySENULibrary = Result - interpret 'Call' WhereIam "'MySEN2Library'" MySEN2Library = Result - + interpret 'Call' WhereIam "'AltIDOrderfile'" + AltIDOrderfile= Result interpret 'Call' WhereIam "'MyCLS0Library'" MyCLS0Library = Result - interpret 'Call' WhereIam "'MyCLS2Library'" MyCLS2Library = Result - interpret 'Call' WhereIam "'AltIDAcctCode'" AltIDAcctCode = Result - interpret 'Call' WhereIam "'AltIDJobClass'" AltIDJobClass = Result - interpret 'Call' WhereIam "'TransmissionMethods'" TransmissionMethods = Result - interpret 'Call' WhereIam "'TransmissionModels'" TransmissionModels = Result - interpret 'Call' WhereIam "'SHLQ'" SHLQ = Result - sa= 'TransmissionMethods =' TransmissionMethods sa= 'TransmissionModels =' TransmissionModels - /* <---- Variable settings for each site */ - Arg DSN_Prefix ModelDSN . ; DSN_Prefix = Strip(DSN_Prefix,'B',',') ; ModelDSN = Strip(ModelDSN,'B',',') ; @@ -90,7 +72,6 @@ Sa= "DSN_Prefix =" DSN_Prefix Sa= "ModelDSN =" ModelDSN Jobnbr = ' ' - /* */ /* This Rexx participates in the submission of Endevor Package */ /* Shipment jobs. It is called by the Endevor sweep job. */ @@ -107,31 +88,28 @@ IF HOUR = '00' THEN HOUR = '0' MINUTE = SUBSTR(NOW,4,2) ; CurrentTime= HOUR || MINUTE ; - SENDNODE = MVSVAR(SYSNAME) HSYSEXEC = MyCLS2Library Userid = USERID() - Call AllocateTriggerForUpdate ; - + Trace off "EXECIO * DISKR TRIGGER (STEM $tablerec. FINIS" ; /* Build all the ...pos variables from heading */ Call ProcessTriggerFileHeading; - /* */ $All_VARIABLES = $table_variables, " PkgExecJobname ParmVal", " Jobname Userid Date8 Date6 Time8 Time6 Destination", - " MyCLS0Library MyCLS2Library MyHomeAddress", + " MySHIPLibrary MyCLS0Library MyCLS2Library MyHomeAddress", " MyAUTULibrary MyAUTHLibrary MyLOADLibrary ", " MyOPT2Library MyOPTNLibrary MySEN2Library MySENULibrary", + " AltIDOrderfile", " HSYSEXEC DB2DSN MODE SHPHLQ STEPLIB", " ShipOutput SHLQ ", " AltIDAcctCode AltIDJobClass ", " Hostprefix Rmteprefix Transmissn ", " HOSTHLQ RMOTHLQ XMITMETH ", " Destin VNBLSDST SENDNODE Typrun Notify TARGnode " - /* */ Do trg# = 1 to $tablerec.0 status = Substr($tablerec.trg#,Stpos,1) ; @@ -147,9 +125,7 @@ Time = Substr($tablerec.trg#,Timepos,04) ; IF Date = TodaysDate &, Time > CurrentTime then iterate ; - Call GetDestinationInfoViaCSV; - Jobname = Strip(Substr($tablerec.trg#,Jobnamepos,08)) ; If Jobname = 'useridX' then Jobname = USERID() || 'X' PkgExecJobname = Jobname ; @@ -165,20 +141,16 @@ TYPRUN = Strip(Substr($tablerec.trg#,TYPRUNpos,6)) ; if Length(Typrun) > 0 then, Typrun = ',TYPRUN='Typrun - /* Notify = Strip(Substr($tablerec.trg#,Notifypos,8)) ; if Length(Notify) < 2 then, Notify = '&SYSUID' */ - seconds = '000001' /* Wait 1 second before submitting next*/ Call WaitAwhile ; - Date8 = DATE('S') Date6 = substr(Date8,3); Temp = TIME('L') - Time8 = Substr(Temp,1,2) ||, Substr(Temp,4,2) ||, Substr(Temp,7,2) ||, @@ -186,7 +158,6 @@ Time6 = Substr(Temp,1,2) ||, Substr(Temp,4,2) ||, Substr(Temp,7,2) ; - ParmVal = Date8 Time8 NewStatus = 's' ; Call UPDATE_MODEL_FROM_VARIABLES ; /* Submits Shipment job */ @@ -205,28 +176,32 @@ Else, $tablerec.trg# = Overlay("?",$tablerec.trg#,Stpos) ; Last_Submit_RC = 0 ; - End ; /* Do trg# = 1 to $tablerec.0 */ - "EXECIO * DISKW TRIGGER (STEM $tablerec. FINIS" ; - Call FreeTriggerFile ; - + if TraceRc = 1 then Say "PULLTGGR- exiting.... " Exit(Submit_RC) ; - /* */ /* The subroutine below is modified from the TBL#TOOL */ /* */ UPDATE_MODEL_FROM_VARIABLES: - + if TraceRc = 1 then Say "UPDATE_MODEL_FROM_VARIABLES: " + Sa= "UPDATE_MODEL_FROM_VARIABLES: " Method# = Wordpos(Transmissn,TransmissionMethods) ; If Method# = 0 then, Do NewStatus = 'R' ; Return ; End; + /* If Destination has its own model, use it */ + /* Otherwise, use the one from TransmissionModels*/ ShipModel = Word(TransmissionModels,Method#); - + interpret 'Call' WhereIam "'UseModel."Destination"'" + OverRideModel = Result + If OverRideModel /= "Not-valid" &, + OverRideModel /= "" &, + Substr(OverRideModel,1,09) /= 'UseModel.' then, + ShipModel = OverRideModel /* Determine Shipment JCL Model */ STRING = "ALLOC DD(MODEL) ", " DA('"ModelDSN"("ShipModel")')", @@ -236,40 +211,31 @@ UPDATE_MODEL_FROM_VARIABLES: MyResult = RESULT ; If MyResult > 0 then, Do - Say 'Cannot find Shipment Model' ShipModel + Say 'PULLTGGR- Cannot find Shipment Model' ShipModel Return ; End; - "EXECIO * DISKR "MODEL "(STEM $Model. FINIS" ; $delimiter = "|" ; STRING = "FREE DD(MODEL) " CALL BPXWDYN STRING; - - Trace off DO $LINE = 1 TO $Model.0 $PLACE_VARIABLE = 1; CALL EVALUATE_SYMBOLICS ; END; /* DO $LINE = 1 TO $Model.0 */ IF TraceRc = 1 then Trace R - CALL BPXWDYN , "ALLOC DD(SYSUT1) LRECL(80) BLKSIZE(27920) SPACE(5,5) ", " RECFM(F,B) TRACKS ", " NEW UNCATALOG REUSE "; - "EXECIO * DISKW SYSUT1 (STEM $Model. FINIS" ; - Call Submit_Job ; - Drop $Model. ; - RETURN; - /* */ /* The subroutine below is borrowed from the TBL#TOOL */ /* */ EVALUATE_SYMBOLICS: - + if TraceRc = 1 then Say "EVALUATE_SYMBOLICS: " DO FOREVER; $PLACE_VARIABLE = POS('&',$Model.$LINE,$PLACE_VARIABLE) IF $PLACE_VARIABLE = 0 THEN LEAVE; @@ -278,13 +244,11 @@ EVALUATE_SYMBOLICS: $table_word = WORD(SUBSTR($temp_$LINE,($PLACE_VARIABLE+1)),1); $table_word = TRANSLATE($table_word,'_','-') ; $varlen = LENGTH($table_word) + 1 ; - if WORDPOS($table_word,$All_VARIABLES) = 0 then, do $PLACE_VARIABLE = $PLACE_VARIABLE + 1 ; iterate; end; - $temp_word = VALUE($table_word) ; IF DATATYPE($temp_word,S) = 9 THEN, $temp = 'SYMBVALUE = ' $temp_word ; @@ -293,7 +257,6 @@ EVALUATE_SYMBOLICS: IF TraceRc = 1 then say $temp INTERPRET $temp; SA= 'SYMBVALUE = ' SYMBVALUE ; - $tail = SUBSTR($Model.$LINE,($PLACE_VARIABLE+$varlen)) ; if Substr($tail,1,1) = $delimiter then, $tail = SUBSTR($tail,2) ; @@ -305,41 +268,25 @@ EVALUATE_SYMBOLICS: $Model.$LINE = , SYMBVALUE || $tail ; END; /* DO FOREVER */ - RETURN; - Submit_Job: - - STRING = "ALLOC DD(SYSIN) DUMMY" - CALL BPXWDYN STRING; -/* - STRING = "ALLOC DD(SYSPRINT) DUMMY" - CALL BPXWDYN STRING; -*/ - - STRING = "ALLOC DD(SYSUT2)", - "SYSOUT(A) WRITER(INTRDR) REUSE " ; - CALL BPXWDYN STRING; - - ADDRESS LINK 'IEBGENER' - - "EXECIO * DISKR SYSUT1 (STEM $SUBS. FINIS" ; - "EXECIO * DISKW SYSPRINT (STEM $SUBS. FINIS" ; - - STRING = "FREE DD(SYSUT1)" - CALL BPXWDYN STRING; - - STRING = "FREE DD(SYSUT2)" - CALL BPXWDYN STRING; - - return; - + if TraceRc = 1 then Say "Submit_Job: " + CALL BPXWDYN "ALLOC DD(SHOWJCL) SYSOUT(A) " + "Execio * DISKR SYSUT1 ( Stem jcl. finis" + "Execio * DISKW SHOWJCL ( Stem jcl. finis" + STRING = "ALLOC DD(SUBMIT)", + "SYSOUT(A) WRITER(INTRDR) REUSE " ; + CALL BPXWDYN STRING; + "Execio * DISKW SUBMIT ( Stem jcl. finis" + CALL BPXWDYN "FREE DD(SHOWJCL)" + CALL BPXWDYN "FREE DD(SUBMIT)" + CALL BPXWDYN "FREE DD(SYSUT1)" + RETURN; AllocateTriggerForUpdate: - + if TraceRc = 1 then Say "AllocateTriggerForUpdate: " STRING = "ALLOC DD(TRIGGER)", " DA('"TriggerFileName"') OLD REUSE" - seconds = '000007' /* Number of Seconds to wait if needed */ - + seconds = '000001' /* Number of Seconds to wait if needed */ Do Forever /* or at least until the file is available */ CALL BPXWDYN STRING; MyRC = RC @@ -347,21 +294,17 @@ AllocateTriggerForUpdate: If MyResult = 0 then Leave Call WaitAwhile End /* Do Forever */ - Return ; - FreeTriggerFile: - + if TraceRc = 1 then Say "AllocateTriggerForUpdate: " STRING = "FREE DD(TRIGGER)" CALL BPXWDYN STRING ; - Return ; - /* */ /* Convert Date formats */ /* */ - WaitAwhile: + if TraceRc = 1 then Say "WaitAwhile: " seconds /* */ /* A resource is unavailable. Wait awhile and try */ /* accessing the resource again. */ @@ -370,35 +313,29 @@ WaitAwhile: /* value which specifies a number of seconds. */ /* A parameter value of '000003' causes a wait for 3 seconds. */ /* */ - seconds = Abs(seconds) seconds = Trunc(seconds,0) - Say "Waiting for" seconds "seconds at " DATE(S) TIME() - + If runMode = 'BACK' | TraceRc = 1 then, + Say "PULLTGGR- Waiting for" seconds "seconds at " DATE(S) TIME() /* AOPBATCH and BPXWDYN are IBM programs */ CALL BPXWDYN "ALLOC DD(STDOUT) DUMMY SHR REUSE" CALL BPXWDYN "ALLOC DD(STDERR) DUMMY SHR REUSE" CALL BPXWDYN "ALLOC DD(STDIN) DUMMY SHR REUSE" - /* AOPBATCH and BPXWDYN are IBM programs */ parm = "sleep "seconds Address LINKMVS "AOPBATCH parm" - Return - ProcessTriggerFileHeading : + if TraceRc = 1 then Say "ProcessTriggerFileHeading : " /* The subroutine below is modified from the TBL#TOOL */ - $tbl = 1 ; $TableHeadingChar = '*' - $LastWord = Word($tablerec.$tbl,Words($tablerec.$tbl)); If DATATYPE($LastWord) = 'NUM' then, Do - Say 'Please remove sequence numbers from the Table' + Say 'PULLTGGR- Please remove sequence numbers from the Table' Exit(12) End - $tmprec = Substr($tablerec.$tbl,2) ; $PositionSpclChar = POS('-',$tmprec) ; If $PositionSpclChar = 0 then, @@ -410,10 +347,9 @@ ProcessTriggerFileHeading : If $Heading_Variable_count /=, Words(Substr($tablerec.$tbl,2)) then, Do - Say 'Invalid table Heading:' $tablerec.$tbl + Say 'PULLTGGR- Invalid table Heading:' $tablerec.$tbl exit(12) End - $heading = Overlay(' ',$tablerec.$tbl,1); /* Space leading * */ Do $pos = 1 to $Heading_Variable_count $HeadingVariable = Word($table_variables,$pos) ; @@ -421,151 +357,27 @@ ProcessTriggerFileHeading : $Starting_$position.$HeadingVariable = $tmp $tmp = $tmp + Length(Word($Heading,$pos)) -1 ; $Ending_$position.$HeadingVariable = $tmp - /* Build ...pos variables and values */ tmp = ""$HeadingVariable"pos =", $Starting_$position.$HeadingVariable Sa= tmp Interpret tmp - end; /* DO $pos = 1 to $Heading_Variable_count */ - $Heading = Translate($Heading,' ','-*') - Return ; - GetDestinationInfoViaCSV: - + if TraceRc = 1 then Say "GetDestinationInfoViaCSV: " + Hostprefix = "?" + Rmteprefix = "?" + Transmissn = "?" + TARGnodeix = "?" /* Set values for Hostprefix and Rmteprefix */ /* From the site definition */ - /* Call CSV to Get Destination information */ - - STRING = "ALLOC DD(C1MSGS1) DUMMY " - CALL BPXWDYN STRING; - STRING = "ALLOC DD(BSTERR) DUMMY " - CALL BPXWDYN STRING; - STRING = "ALLOC DD(BSTAPI) DUMMY " - CALL BPXWDYN STRING; - - STRING = "ALLOC DD(CSVDEST) LRECL(4000) BLKSIZE(32000) ", - " DSORG(PS) ", - " SPACE(1,5) RECFM(F,B) TRACKS ", - " NEW UNCATALOG REUSE "; - CALL BPXWDYN STRING; - - STRING = "ALLOC DD(BSTIPT01) LRECL(80) BLKSIZE(800) ", - " DSORG(PS) ", - " SPACE(1,5) RECFM(F,B) TRACKS ", - " NEW UNCATALOG REUSE "; - CALL BPXWDYN STRING; - - Push "LIST DESTINATION '"Destination"'", - " TO FILE CSVDEST OPTIONS ." - - "EXECIO 1 DISKW BSTIPT01 (FINIS "; - - ADDRESS LINK 'BC1PCSV0' ; /* load from authlib */ - call_rc = rc ; -/* ADDRESS TSO 'ISRDDN' */ - - "EXECIO * DISKR CSVDEST (STEM API. finis" - - STRING = "FREE DD(CSVDEST)" ; - CALL BPXWDYN STRING; - STRING = "FREE DD(BSTIPT01)" ; - CALL BPXWDYN STRING; - STRING = "FREE DD(C1MSGS1)" ; - CALL BPXWDYN STRING; - STRING = "FREE DD(BSTERR)" ; - CALL BPXWDYN STRING; - STRING = "FREE DD(BSTAPI)" ; - CALL BPXWDYN STRING; - - IF API.0 < 2 THEN, - Do - Say 'Cannot find Definition for Destination' Destination - EXIT(12) - End - - $table_variables= Strip(API.1,'T') - - $table_variables = translate($table_variables,"_"," ") ; - $table_variables = translate($table_variables," ",',"') ; - $table_variables = translate($table_variables,"@","/") ; - $table_variables = translate($table_variables,"@",")") ; - $table_variables = translate($table_variables,"@","(") ; - - Do rec# = 2 to API.0 - $detail = API.rec# - - /* Parse the Detail record until done */ - Do $column = 1 to Words($table_variables) - Call ParseDetailCSVline - End - - Sa= 'Messages from PULLTGGR:' - Hostprefix = HOST_DSN_PREFIX - HOSTHLQ = HOST_DSN_PREFIX - Rmteprefix = REMOTE_DSN_PREFIX - RMOTHLQ = REMOTE_DSN_PREFIX - Transmissn = TRANS_DESC - XMITMETH = TRANS_DESC - TARGnode = TRANS_NODE - End; /* Do rec# = 1 to API.0 */ - - RETURN ; - -ParseDetailCSVline: - - /* Find the data for the current $column */ - - $dlmchar = Substr($detail,1,1); - - If $dlmchar = "'" then, - Do - SA= 'parsing with single quote ' - PARSE VAR $detail "'" $temp_value "'" $detail ; - If Substr($detail,1,1) = ',' then, - $detail = Strip(Substr($detail,2),'L') - End - Else, - If $dlmchar = '"' then, - Do - SA= 'parsing with double quote ' - PARSE VAR $detail '"' $temp_value '"' $detail ; - If Substr($detail,1,1) = ',' then, - $detail = Strip(Substr($detail,2),'L') - End - Else, - If $dlmchar = ',' then, - Do - SA= 'parsing with comma ' - PARSE VAR $detail ',' $temp_value ',' $detail ; - If Substr($detail,1,1)/= ',' then, - $detail = "," || $detail - $detail = Strip(Substr($detail,2),'L') */ - End - Else, - If Words($detail) = 0 then, - $temp_value = ' ' - Else, - Do - SA= 'parsing with comma ' - PARSE VAR $detail $temp_value ',' $detail ; - Sa= '$temp_value=>' $temp_value '<' - End - $temp_value = STRIP($temp_value) ; - $rslt = $temp_value - $rslt = Strip($rslt,'B','"') ; - $rslt = Strip($rslt,'B',"'") ; - if Length($rslt) < 1 then $rslt = ' ' - if Length($rslt) < 250 then, - $temp = WORD($table_variables,$column) '= "'$rslt'"'; - Else, - $temp = WORD($table_variables,$column) "=$rslt" - INTERPRET $temp; - If rec# < 3 then Say $temp - - RETURN ; - + SiteVariables = GTDESTIN(Destination) + If Words(SiteVariables) < 3 then Return + Hostprefix = Word(SiteVariables,1) + Rmteprefix = Word(SiteVariables,2) + Transmissn = Word(SiteVariables,3) + TARGnode = Word(SiteVariables,4) + Return diff --git a/endevor/Field-Developed-Programs/Package-Automation/README.md b/endevor/Field-Developed-Programs/Package-Automation/README.md index fdee883..8fa2aa8 100644 --- a/endevor/Field-Developed-Programs/Package-Automation/README.md +++ b/endevor/Field-Developed-Programs/Package-Automation/README.md @@ -1,33 +1,28 @@ # Package-Automation -This collection provides two opportunities to introduce automation for package actions: +Two primary opportunities exist within this collection to introduce automation for package actions: +Package Executions: Automated immediately when the package status updates to "APPROVED" and the execution window is open. +Package Shipments: Automated as soon as the status changes to "EXECUTED" and defined shipment rules indicate the package should be dispatched to one or more destinations. - - Automate Package Executions as soon as the package status changes to "APPROVED", and the Execution window is open. - - Automate Package Shipments as soon as the package status changes to "EXECUTED", and your "Rules" for package shipments indicate that the package should be Shipped to one or more destinations. +When both processes are automated, granting final approval to a package seamlessly triggers execution, which is then immediately followed by shipments to all designated destinations. -If both actions are automated, then (for example) the final approval given to a package would kick off a package execution, and followed immediately by package shipments to multiple destinations. - -Whether a triggering action is performed manually, by a zowe command, a sweep job, the Endevor web interface, or any other means, the Package Automation follow-up actions, based on an Endevor exit, remain consistently the same. +The automated follow-up actions driven by the Endevor exit remain completely consistent, regardless of whether the triggering CAST or APPROVE action is initiated manually, via a zowe command, a sweep job, the Endevor web interface, or through any other method. ## Package Automation on Multiple Endevor images -Some Endevor administrators have responsibility for multiple Endevor images, where details like the life cycle map, job card information and dataaset names differ from one image to the next. -To manage the variations from multiple images, the instructions and members listed below are provided, and allow the majority of remaining items to be left unchanged. +Some Endevor administrators manage multiple Endevor images, each featuring unique lifecycle maps, job card details, and dataset naming conventions. To accommodate these variations while leaving most other configuration elements intact, follow the instructions below regarding the provided members: -On each Lpar where portions of this collection will run: +Perform these setup steps on every LPAR where components of this collection will execute: + - Deploy the REXX components into a designated new or existing library. + - Enter within your chosen Exit program the name of this REXX library: +Use C1UEXT07-Package-Automation for handling both automated executions and shipments. +Use C1UEXSHP if you only require automated shipments. + - Utilize the WHEREIAM.rex utility to establish your site-specific configurations: +Although it is not part of the active operational configuration, this member helps identify the specific naming structure needed for your @site member names. +Run WHEREIAM.rex without modifications to identify the appropriate name for the current @site member, then adjust the contents to align with that LPAR's parameters. - - Place the REXX items into a new or existing library of your choice. - - Enter the name the REXX library into the Exit program you choose to use - - C1UEXT07 for Automated Executions and Shipments - - C1UEXSHP for Automated Shipments only - - The WHEREIAM.rex member is not a part of the configuration, - but is provided to help identify names you should use as @site member names. - Execute the WHEREIAM.rex (as is) to determine the name to give to the member currently named @site. - Then tailor the content to reflect values for the Lpar. +For instance, if running the collection on LPARs named SYS1 and SYS7, the utility will direct you to create members named @SYS1 and @SYS7, where you will specify your Rules, Trigger files, and other localized values. - For example, if you intend to execute the collection on Lpars named SYS1 and SYS7, - then WHEREIAM.rex will instruct you to create members @SYS1 and @SYS7 respectively. - The names you use for the Rules and Trigger files (and other values) must entered into the @SYS1 and @SYS7 members. ## Automate Package Executions @@ -96,6 +91,40 @@ You can find the code for JCLCOMMT.rex in the [ISPF-tools-for-Quick-Edit-and-End The commnenting will allow you to reveiew your package shipping (and other) jobs, and know the element or member name that contains the lines of JCL. +## Designating Package Shipments via Package Notes + +With this option, you can place package shipment expectations into the package notes at the time the package is created. Package reviewers can review expected shipments and make adjustments as needed. After the package executes, only entries remaining in the Notes trigger package shipments. There can be up to 8 destinations entered - one for each Note line - for a package. + +If you use the [Package Builder](https://github.com/BroadcomMFD/broadcom-product-scripts/blob/main/endevor/Field-Developed-Programs/ISPF-tools-for-Quick-Edit-and-Endevor/Package.rex) in the [**ISPF-tools-for-Quick-Edit-and-Endevor**](https://github.com/BroadcomMFD/broadcom-product-scripts/tree/main/endevor/Field-Developed-Programs/ISPF-tools-for-Quick-Edit-and-Endevor) folder, you can further automate this feature. SHIPRULE entries that match the package content are copied into the package Notes automatically. Or, if you prefer, do your automation or formatting of text strings when the package is being created. + +Package notes must be formatted in this manner - as package shipping instructions. + + + .........1.........2.........3.........4.........5.........6 + 1. ____________________________________________________________ + 2. ____________________________________________________________ + 3. ____________________________________________________________ + 4. ____________________________________________________________ + 5. ____________________________________________________________ + 6. TO DESTIN1 : 20260526 0000 PRD#DD01 + 7. TO DESTIN2 : 20260526 0000 PRD#DD02 + 8. NO TESTBOX : 20260526 0000 TEST0022 ELM CNT: 1 + +To omit the shipment to a Destination, then simply change the "TO" at the front of a Note line to "NO". + +If you choose this option do not use the COBOL exit in the **Package Automation** folder. Instead, use these found in the [Exit-Examples](https://github.com/BroadcomMFD/broadcom-product-scripts/tree/main/endevor/Field-Developed-Programs/Exit-Examples) folder: + + - **C1UEXT07 WithRexDriver.cob** - the more generic package exit program + - **C1UEXTR7 WithRexDriver.rex** - the REXX subroutine that handles many conditions beyond Package Automation. You may need to remove or comment out references you do not need in C1UEXTR7, but preserve the calls to the + PKGEXECT and PKGESHIP Rexx items in this folder. + + +## A word about the dependency on Comma Separated Value data + +The use of extracts and parsing of CSV data, increases the longevity of the solution. For product release upgrades, if field lengths are changed, or new fields are added, there is no impact since field lengths and positions are automatically determined by the CSV heading. + + + ## Items outside of this folder, that might be a part of your solution: @@ -109,4 +138,16 @@ The commnenting will allow you to reveiew your package shipping (and other) jobs **ENTBJAPI** - see member BC1JAAPI in your CSIQJCL library. -[**BKOUTLOG**](https://github.com/BroadcomMFD/broadcom-product-scripts/blob/Package-Backout-Logging/endevor/Field-Developed-Programs/Package-Automation/Package-Backout-Logging/BKOUTLOG.rex) - for logging package Backout and BackIn actions. (currently in a branch) \ No newline at end of file +[**BKOUTLOG**](https://github.com/BroadcomMFD/broadcom-product-scripts/blob/Package-Backout-Logging/endevor/Field-Developed-Programs/Package-Automation/Package-Backout-Logging/BKOUTLOG.rex) - for logging package Backout and BackIn actions. (currently in a branch) + +If you are submitting Package Automation jobs under the Endevor Alt id, then find these modules: + + +[**SWAP2ALT**](https://github.com/BroadcomMFD/broadcom-product-scripts/blob/main/endevor/Field-Developed-Programs/Processor-Tools-and-Processor-Snippets/SWAP2ALT.rex +) to execute in your REXX exits and to enforce actions to run under the Endevor Altid + +[**SWAP2USR**](https://github.com/BroadcomMFD/broadcom-product-scripts/blob/main/endevor/Field-Developed-Programs/Processor-Tools-and-Processor-Snippets/SWAP2USR.rex) to return processing back to the users' id. + +Also review the [**USE_Alitd setting on the C1UEXITS**](https://techdocs.broadcom.com/us/en/ca-mainframe-software/devops/ca-endevor-software-change-manager/19-0/securing/data-set-security/alternate-id-and-user-exits.html) setting, and for your exit, set the **USE_ALTID** value is to **+**. + +[**WTO#MSG**](https://github.com/BroadcomMFD/broadcom-product-scripts/blob/main/endevor/Field-Developed-Programs/Miscellaneous-items/WTO%23MSG.asm) - This utility allows you to notify others of specific site events by sending text strings, such as error messages, to the system log. This ensures that critical incidents receive the necessary attention for follow-up. Once these messages are logged, automation tools like OPS/MVS can scan the system log and initiate the appropriate responsive actions automatically. \ No newline at end of file diff --git a/endevor/Field-Developed-Programs/Package-Automation/SHIP4FTP.skl b/endevor/Field-Developed-Programs/Package-Automation/SHIP4FTP.skl new file mode 100644 index 0000000..1b9b762 --- /dev/null +++ b/endevor/Field-Developed-Programs/Package-Automation/SHIP4FTP.skl @@ -0,0 +1,498 @@ +//&PkgExecJobname JOB &AltIDAcctCode, +// &SYSUID,REGION=0M,NOTIFY=&SYSUID,MSGCLASS=X,CLASS=A +//* ROUTE XEQ N41 +//***==============================================================* * +//***=====Remote Package Shipment via FTP==========================* * +//***= This example member is built from a manually submitted ===* * +//***= package shipping job, using IBM's FTP for Transmission. ==* * +//***= Then detailed text strings are replaced with variables ===* * +//***= to create this member. ===* * +//***= This example shipment model includes an auto-Cast option ===* * +//***= as processed by the SHIPCAST included member. ===* * +//***==============================================================* * +// JCLLIB ORDER=(&AltIDOrderfile) +//* ISPSLIB(SHIP4FTP) +//*--------------------------------------------------------SHIP4FTP +//* MY DESTNAME = &Destination +//* MY FROMNODE = &SENDNODE +//* MY PACKAGE = &Package +// SET PACKAGE='&Package' +//* MY VNBCPARM = C1BMX000,&Date8,&Time8 +//* DESTVAR1 = 'DESTVAR1' +//* DESTVAR2 = 'DESTVAR2' +//* Hostprefix = '&Hostprefix' +//* Rmteprefix = '&Rmteprefix' +//* Transmissn = '&Transmissn' +//*--------------------------------------------------------SHIP4FTP +//***==============================================================* * +//***==============================================================* * +//***==============================================================* * +//NDVRSHIP EXEC PGM=NDVRC1,DYNAMNBR=1500,REGION=4096K, SHIP4FTP +// PARM='C1BMX000,&Date8,&Time8 SHIP &Userid ' +//* +//* ****************************************************************** +//* * STEPLIB, CONLIB, MESSAGE LOG AND ABEND DATASETS +//* ****************************************************************** +// INCLUDE MEMBER=STEPLIB +//* +//********************************************************************* +//* ESI TRACE IN BATCH MODE * +//********************************************************************* +//*EN$TRESI DD SYSOUT=* +//*EN$TRALC DD SYSOUT=* +//*C1BMXTRC DD DISP=SHR, +//* DSN=YOUR.ENDV.TRACE.LOCAL +//* +//C1BMXTRC DD SYSOUT=*,LRECL=133,RECFM=FBA ** Shipment trace ** +//* +//SYSUDUMP DD SYSOUT=* *** DUMP TO SYSOUT ************************* +//SYMDUMP DD DUMMY +//C1BMXLOG DD SYSOUT=* *** MESSAGES, ERRORS, RETURN CODES ********* +//* +//* *--------------------------------------------* SHIP4FTP (CONT.) * +//* +//C1BMXDET DD SYSOUT=* ** SHIPMENT DETAIL REPORT **************** +//C1BMXSUM DD SYSOUT=* ** SHIPMENT SUMMARY REPORT **************** +//C1BMXSYN DD SYSOUT=* ** INPUT LISTING AND SYNTAX ERROR REPORT ** +//* +//* ****************************************************************** +//* * LOCAL TRANSFER COPY/RUN COMMAND DATASETS +//* * LOCAL MODEL CONTROL CARD DATASET +//* ****************************************************************** +//* +//C1BMXLCC DD DSN=&&XLCC,DISP=(NEW,PASS),SPACE=(TRK,(2,10)), +// DCB=(RECFM=FB,LRECL=80,BLKSIZE=3120,DSORG=PS), +// UNIT=SYSALLDA +//* +//C1BMXLCM DD DISP=SHR,DSN=&MyOPT2Library +// DD DISP=SHR,DSN=&MyOPTNLibrary +//* +//* ****************************************************************** +//* * NETVIEW FTP "ADD TO TRANSMISSION QUEUE" DATASET AND INTERNAL RDR +//* * NETVIEW FTP MODEL CONTROL CARD DATASET //* +****************************************************************** +//* +//C1BMXFTC DD DSN=&&XFTC,DISP=(NEW,PASS),SPACE=(TRK,(2,10)), +// DCB=(RECFM=FB,LRECL=80,BLKSIZE=3120,DSORG=PS), +// UNIT=SYSALLDA +//C1BMXFTM DD DISP=SHR,DSN=&MyOPT2Library +// DD DISP=SHR,DSN=&MyOPTNLibrary +//* * NETWORK DATA MOVER COPY/RUN COMMAND DATASETS +//* * NETWORK DATA MOVER MODEL CONTROL CARD DATASET +//* ****************************************************************** +//C1BMXNWC DD DSN=&&XNWC,DISP=(NEW,PASS),SPACE=(TRK,(2,10)), +// DCB=(RECFM=FB,LRECL=80,BLKSIZE=3120,DSORG=PS), +// UNIT=SYSALLDA +//C1BMXNWM DD DISP=SHR,DSN=&MyOPT2Library +// DD DISP=SHR,DSN=&MyOPTNLibrary +//* +//C1BMXNWM DD DISP=SHR,DSN=&MyOPT2Library +// DD DISP=SHR,DSN=&MyOPTNLibrary +//C1BMXRJC DD DISP=SHR,DSN=&MySEN2Library +// DD DISP=SHR,DSN=&MySENULibrary +//* +//* ****************************************************************** +//* * SHIPMENT DATE/TIME READ BY INLINE HOST CONFIRMATION STEP +//* ****************************************************************** +//* +//C1BMXDTM DD DSN=&&XDTM,DISP=(NEW,PASS),SPACE=(TRK,(1,0)), +// DCB=(RECFM=FB,LRECL=80,BLKSIZE=3120,DSORG=PS), +// UNIT=SYSALLDA +//* +//* ****************************************************************** +//* * HOST STAGING DATASET DELETION STATEMENTS (IDCAMS) +//* ****************************************************************** +//* +//C1BMXDEL DD DSN=&&HDEL,DISP=(NEW,PASS),SPACE=(TRK,(10,10)), +// DCB=(RECFM=FB,LRECL=80,BLKSIZE=3120,DSORG=PS), +// UNIT=SYSALLDA +//* +//* ****************************************************************** +//* * REMOTE JCL MODEL MEMBERS +//* ****************************************************************** +//* +//**BMXMDL DD DSN=&&OVERRIDE,DISP=(OLD,DELETE) +//C1BMXMDL DD DISP=SHR,DSN=&MyOPT2Library +// DD DISP=SHR,DSN=&MyOPTNLibrary +//* +//* ****************************************************************** +//* * JCL SEGMENTS TO CREATE GROUP SYMBOLICS FOR MODELLING +//* ****************************************************************** +//* +//C1BMXHJC DD DATA,DLM=## +//&Jobname JOB &AltIDAcctCode, +// &SYSUID,REGION=0M,NOTIFY=&SYSUID,MSGCLASS=X,CLASS=A +//* ROUTE XEQ N41 +//*-------------------------------------------------------------------* +// JCLLIB ORDER=(&AltIDOrderfile) +//*-------------------------------------------------------------------* +//* ISPSLIB(SHIP4FTP) +//*--------------------------------------------------------SHIP4FTP +//* MY DESTNAME = &Destination +//* MY FROMNODE = &SENDNODE +//* MY PACKAGE = &Package +// SET PACKAGE='&Package' +//* MY VNBCPARM = C1BMX000,&Date8,&Time8 +//*--------------------------------------------------------SHIP4FTP +## +//* +//* *--------------------------------------------* SHIP4FTP (CONT.) * +//* +//C1BMXHCN DD DATA,DLM=## +//* *--------------------------------------------------------------* * +//* *--------------------------------------------------------------* * +//* SHIP4FTP +//CONFGE12 EXEC PGM=NDVRC1,REGION=4096K, SHIP4FTP +// COND=(12,GT,$XM_STEP), +// PARM='C1BMX000,&Date8,&Time8,CONF,HXMT,GE,0012,$DEST_ID' +//* SHIP4FTP +//C1BMXDTM DD DSN=&&XDTM,DISP=(MOD,PASS),SPACE=(TRK,(1,0)), +// DCB=(RECFM=FB,LRECL=80,BLKSIZE=3120,DSORG=PS), +// UNIT=SYSALLDA +//* SHIP4FTP +//* ****************************************************************** +//* * STEPLIB, CONLIB, MESSAGE LOG AND ABEND DATASETS +//* ****************************************************************** +// INCLUDE MEMBER=STEPLIB +//********************************************************************* +//* ESI TRACE IN BATCH MODE * +//********************************************************************* +//*EN$TRESI DD SYSOUT=* +//*EN$TRALC DD SYSOUT=* +//* +//SYSUDUMP DD SYSOUT=* *** DUMP TO SYSOUT ************************* +//SYMDUMP DD DUMMY +//C1BMXLOG DD SYSOUT=* *** MESSAGES, ERRORS, RETURN CODES ********* +//* *--------------------------------------------* SHIP4FTP(CONT +//* SHIP4FTP +//CONFGE08 EXEC PGM=NDVRC1,REGION=4096K, SHIP4FTP +// COND=(08,NE,$XM_STEP), +// PARM='C1BMX000,&Date8,&Time8,CONF,HXMT,GE,0008,$DEST_ID' +//* SHIP4FTP +//C1BMXDTM DD DSN=&&XDTM,DISP=(MOD,PASS),SPACE=(TRK,(1,0)), +// DCB=(RECFM=FB,LRECL=80,BLKSIZE=3120,DSORG=PS), +// UNIT=SYSALLDA +//* ****************************************************************** +//* * STEPLIB, CONLIB, MESSAGE LOG AND ABEND DATASETS +//* ****************************************************************** +// INCLUDE MEMBER=STEPLIB +//* +//********************************************************************* +//* ESI TRACE IN BATCH MODE * +//********************************************************************* +//*EN$TRESI DD SYSOUT=* +//*EN$TRALC DD SYSOUT=* +//* +//SYSUDUMP DD SYSOUT=* *** DUMP TO SYSOUT ************************* +//SYMDUMP DD DUMMY +//C1BMXLOG DD SYSOUT=* *** MESSAGES, ERRORS, RETURN CODES ********* +//* SHIP4FTP +//* SHIP4FTP +//CONFGE04 EXEC PGM=NDVRC1,REGION=4096K, SHIP4FTP +// COND=(04,NE,$XM_STEP), +// PARM='C1BMX000,&Date8,&Time8,CONF,HXMT,EQ,0004,$DEST_ID' +//* SHIP4FTP +//C1BMXDTM DD DSN=&&XDTM,DISP=(MOD,PASS),SPACE=(TRK,(1,0)), +// DCB=(RECFM=FB,LRECL=80,BLKSIZE=3120,DSORG=PS), +// UNIT=SYSALLDA +//* SHIP4FTP +//* ****************************************************************** +//* * STEPLIB, CONLIB, MESSAGE LOG AND ABEND DATASETS +//* ****************************************************************** +// INCLUDE MEMBER=STEPLIB +//* +//********************************************************************* +//* ESI TRACE IN BATCH MODE * +//********************************************************************* +//*EN$TRESI DD SYSOUT=* +//*EN$TRALC DD SYSOUT=* +//* +//SYSUDUMP DD SYSOUT=* *** DUMP TO SYSOUT ************************* +//SYMDUMP DD DUMMY +//C1BMXLOG DD SYSOUT=* *** MESSAGES, ERRORS, RETURN CODES ********* +//* SHIP4FTP +//* SHIP4FTP +//CONFGE00 EXEC PGM=NDVRC1,REGION=4096K, SHIP4FTP +// COND=(00,NE,$XM_STEP), +// PARM='C1BMX000,&Date8,&Time8,CONF,HXMT,EQ,0000,$DEST_ID' +//* SHIP4FTP +//C1BMXDTM DD DSN=&&XDTM,DISP=(MOD,PASS),SPACE=(TRK,(1,0)), +// DCB=(RECFM=FB,LRECL=80,BLKSIZE=3120,DSORG=PS), +// UNIT=SYSALLDA +//* SHIP4FTP +//* ****************************************************************** +//* * STEPLIB, CONLIB, MESSAGE LOG AND ABEND DATASETS +//* ****************************************************************** +// INCLUDE MEMBER=STEPLIB +//* +//********************************************************************* +//* ESI TRACE IN BATCH MODE * +//********************************************************************* +//*EN$TRESI DD SYSOUT=* +//*EN$TRALC DD SYSOUT=* +//* +//SYSUDUMP DD SYSOUT=* *** DUMP TO SYSOUT ************************* +//SYMDUMP DD DUMMY +//C1BMXLOG DD SYSOUT=* *** MESSAGES, ERRORS, RETURN CODES ********* +//* SHIP4FTP +//* SHIP4FTP +//CONFABND EXEC PGM=NDVRC1,REGION=4096K,COND=ONLY, SHIP4FTP +// PARM='C1BMX000,&Date8,&Time8,CONF,HXMT,AB,****,********' +//* SHIP4FTP +//C1BMXDTM DD DSN=&&XDTM,DISP=(MOD,PASS),SPACE=(TRK,(1,0)), +// DCB=(RECFM=FB,LRECL=80,BLKSIZE=3120,DSORG=PS), +// UNIT=SYSALLDA +//* SHIP4FTP +//* ****************************************************************** +//* * STEPLIB, CONLIB, MESSAGE LOG AND ABEND DATASETS +//* ****************************************************************** +// INCLUDE MEMBER=STEPLIB +//* +//********************************************************************* +//* ESI TRACE IN BATCH MODE * +//********************************************************************* +//*EN$TRESI DD SYSOUT=* +//*EN$TRALC DD SYSOUT=* +//* +//SYSUDUMP DD SYSOUT=* *** DUMP TO SYSOUT ************************* +//SYMDUMP DD DUMMY +//C1BMXLOG DD SYSOUT=* *** MESSAGES, ERRORS, RETURN CODES ********* +//* SHIP4FTP +//* *--------------------------------------------* ISPSLIB(SHIP4FTP) * +## +//* +//* *--------------------------------------------* C1BMXJOB (CONT.) * +//* +//C1BMXRCN DD DATA,DLM=## +//*----PACKAGE SHIPMENT JOB #4 -------------------------- SHIP4FTP +//* *--Package Shipment Confirmation/Notification* ISPSLIB(SHIP4FTP) * +//* +//* *================================================================* +//* * INSTREAM DATASET CONTAINING REMOTE CONFIRMATION JCL +//* *================================================================* +//WHATNTFY IF (RC > 8) THEN +//* +//CONFGT12 EXEC PGM=IEBGENER SHIP4FTP +//SYSUT1 DD DATA,DLM=$$ JOB SHIPPED BACK TO HOST +//&Jobname JOB &AltIDAcctCode, +// &SYSUID,REGION=0M,NOTIFY=&SYSUID,MSGCLASS=X,CLASS=A +//* ROUTE XEQ N41 +// JCLLIB ORDER=(&AltIDOrderfile) +//*--------------------------------------------------------SHIP4FTP +//* *--Package Shipment Confirmation/Notification* ISPSLIB(SHIP4FTP) * +//* ****************************************************************** +//* MY DESTNAME = &Destination +//* MY FROMNODE = &SENDNODE +//* MY PACKAGE = &Package +// SET PACKAGE='&Package' +//* MY VNBCPARM = C1BMX000,&Date8,&Time8 +//*--------------------------------------------------------SHIP4FTP +//CONFCOPY EXEC PGM=NDVRC1, SHIP4FTP +// PARM='C1BMX000,&Date8,&Time8,CONF,RCPY,EQ,0012,$DEST_ID' +//* ****************************************************************** +//* * STEPLIB, CONLIB, MESSAGE LOG AND ABEND DATASETS +//* ****************************************************************** +// INCLUDE MEMBER=STEPLIB +//* +//********************************************************************* +//* ESI TRACE IN BATCH MODE * +//********************************************************************* +//*EN$TRESI DD SYSOUT=* +//*EN$TRALC DD SYSOUT=* +//* +//SYSUDUMP DD SYSOUT=* *** DUMP TO SYSOUT ************************* +//SYMDUMP DD DUMMY +//C1BMXLOG DD SYSOUT=* *** MESSAGES, ERRORS, RETURN CODES ********* +//*--------------------------------------------------------SHIP4FTP +//NTFYTGGR EXEC PGM=IRXJCL, SHIP4FTP +// PARM='UPDTTGGR &Destination 12 &Package' +//SYSEXEC DD DSN=&MyCLS0Library,DISP=SHR +// DD DSN=&MyCLS2Library,DISP=SHR +//SYSTSPRT DD SYSOUT=* +//*------------------------------------------------------- SHIP4FTP +//DELETES EXEC PGM=IDCAMS,COND=(4,LT) SHIP4FTP +//SYSPRINT DD SYSOUT=* +//AMSDUMP DD SYSOUT=* +//SYSIN DD * + DELETE '&Hostprefix.D&Date6.T&Time6.&Destination.*' NONVSAM + SET LASTCC=0 + SET MAXCC=0 +//*------------------------------------------------------- SHIP4FTP +//* *--------------------------------------------* SHIP4FTP (CONT.) * +$$ +//SYSUT2 DD DSN=&Rmteprefix.D&Date6.T&Time6.NOTIFY, +// DISP=(MOD,CATLG,KEEP),SPACE=(TRK,(1,0)), +// DCB=(RECFM=FB,LRECL=80,BLKSIZE=3120,DSORG=PS), +// UNIT=SYSALLDA +//SYSPRINT DD SYSOUT=* +//SYSIN DD DUMMY +//* *--------------------------------------------* SHIP4FTP (CONT.) * +//WHATNTFY ELSE +//* +//CONFGT00 EXEC PGM=IEBGENER SHIP4FTP +//SYSUT1 DD DATA,DLM=$$ JOB SHIPPED BACK TO HOST +//&Jobname JOB &AltIDAcctCode, +// &SYSUID,REGION=0M,NOTIFY=&SYSUID,MSGCLASS=X,CLASS=A +//* ROUTE XEQ N41 +// JCLLIB ORDER=(&AltIDOrderfile) +//*--------------------------------------------------------SHIP4FTP +//* *--Package Shipment Confirmation/Notification* ISPSLIB(SHIP4FTP) * +//* ****************************************************************** +// EXPORT SYMLIST=(*) +// SET PACKAGE='&Package' +// SET LASTENVM='PRD' +// SET LASTSTGE='2' +// SET DSPREFIX='&Hostprefix.D&Date6.T&Time6' +// SET DSPREFIX='&Hostprefix.D&Date6.T&Time6' +//*--------------------------------------------------------SHIP4FTP +//* MY DESTNAME = &Destination +//* MY FROMNODE = &SENDNODE +//* MY PACKAGE = &Package +// SET PACKAGE='&Package' +//* MY VNBCPARM = C1BMX000,&Date8,&Time8 +//*--------------------------------------------------------SHIP4FTP +//CONFCOPY EXEC PGM=NDVRC1, SHIP4FTP +// PARM='C1BMX000,&Date8,&Time8,CONF,RCPY,EQ,0000,$DEST_ID' +//* ****************************************************************** +//* * STEPLIB, CONLIB, MESSAGE LOG AND ABEND DATASETS +//* ****************************************************************** +// INCLUDE MEMBER=STEPLIB +//* +//********************************************************************* +//* ESI TRACE IN BATCH MODE * +//********************************************************************* +//*EN$TRESI DD SYSOUT=* +//*EN$TRALC DD SYSOUT=* +//* +//SYSUDUMP DD SYSOUT=* *** DUMP TO SYSOUT ************************* +//SYMDUMP DD DUMMY +//C1BMXLOG DD SYSOUT=* *** MESSAGES, ERRORS, RETURN CODES ********* +//*--------------------------------------------------------SHIP4FTP +//NTFYTGGR EXEC PGM=IRXJCL, SHIP4FTP +// PARM='UPDTTGGR &Destination / &Package' +//SYSEXEC DD DSN=&MyCLS0Library,DISP=SHR +// DD DSN=&MyCLS2Library,DISP=SHR +//SYSTSPRT DD SYSOUT=* +//*------------------------------------------------------- SHIP4FTP +//DELETES EXEC PGM=IDCAMS,COND=(4,LT) SHIP4FTP +//SYSPRINT DD SYSOUT=* +//AMSDUMP DD SYSOUT=* +//SYSIN DD * + DELETE '&Hostprefix.D&Date6.T&Time6.&Destination.*' NONVSAM + SET LASTCC=0 + SET MAXCC=0 +//*------------------------------------------------------- SHIP4FTP +//* INCLUDE MEMBER=SHIPCAST <- Conditionally CAST (promotion pkg) +//*------------------------------------------------------- SHIP4FTP +$$ +//SYSUT2 DD DSN=&Rmteprefix.D&Date6.T&Time6.NOTIFY, +// DISP=(MOD,CATLG,KEEP),SPACE=(TRK,(1,0)), +// DCB=(RECFM=FB,LRECL=80,BLKSIZE=3120,DSORG=PS), +// UNIT=SYSALLDA +//SYSPRINT DD SYSOUT=* +//SYSIN DD DUMMY +//WHATNTFY ENDIF +//* *--------------------------------------------* SHIP4FTP (CONT.) * +//FTPSUBMT EXEC PGM=FTP,REGION=2048K,TIME=800 SHIP4FTP +//NETRC DD DISP=SHR,DSN=&SYSUID..ENDEVOR.NETRC(SHIPPING) +//SYSTSPRT DD SYSOUT=* +//SYSPRINT DD SYSOUT=* +//SYSUDUMP DD SYSOUT=Q +//OUTPUT DD SYSOUT=* SHIP4FTP +//SYSIN DD * + &MyHomeAddress +MODE B +EBCDIC +SITE FILETYPE=JES +PUT '&Rmteprefix.D&Date6.T&Time6.NOTIFY' +QUIT +//* *--------------------------------------------* C1BMXJOB (CONT.) * +//REMODELT EXEC PGM=IDCAMS,COND=(0,LE) <-Remote Delete SHIP4FTP +//SYSPRINT DD SYSOUT=* +//AMSDUMP DD SYSOUT=* +//DELETEME DD DSN=&Rmteprefix.D&Date6.T&Time6.NOTIFY, +// DISP=(SHR,DELETE) +//SYSIN DD * + DELETE '&Rmteprefix.D&Date6.T&Time6.&Destination.*' NONVSAM + SET LASTCC=0 + SET MAXCC=0 +## +//* +//* *--------------------------------------------* C1BMXJOB (CONT.) * +//* +//C1BMXLIB DD DATA,DLM=## +//* ****************************************************************** +//* * STEPLIB, CONLIB, MESSAGE LOG AND ABEND DATASETS +//* ****************************************************************** +//STEPLIB DD DISP=SHR,DSN=&MyAUTULibrary +// DD DISP=SHR,DSN=&MyAUTHLibrary +//* DD DISP=SHR,DSN=&MyLOADLibrary +//CONLIB DD DISP=SHR,DSN=&MyLOADLibrary +//* +//********************************************************************* +//* ESI TRACE IN BATCH MODE * +//********************************************************************* +//*EN$TRESI DD SYSOUT=* +//*EN$TRALC DD SYSOUT=* +//* +//SYSUDUMP DD SYSOUT=* *** DUMP TO SYSOUT ************************* +//SYMDUMP DD DUMMY +//C1BMXLOG DD SYSOUT=* *** MESSAGES, ERRORS, RETURN CODES ********* +## +//* +//* *--------------------------------------------* C1BMXJOB (CONT.) * +//* +//* ****************************************************************** +//* * SHIP PACKAGE PKG-ID TO DESTINATION DEST-ID ( OPTION BACKOUT ) . +//* ****************************************************************** +//* +//* THE FOLLOWING DD STATEMENT MUST BE THE *LAST* CARD IN THIS MEMBER. +//* ISPSLIB MEMBER C1BMXIN IS INCLUDED AFTER IT AS THE INSTREAM DATA. +//* +//C1BMXIN DD * *-------------------------------* ISPSLIB(SHIP4FTP) * +SHIP PAC '&Package' TO DEST &Destination OPT &ShipOutput . +//* *============================================* ISPSLIB(SHIP4FTP) * +//* *==============================================================* * +//*------------------------------------------------------- SHIP4FTP +//* *==============================================================* * +//* *==============================================================* * +//* *= Tailor and Submit next job ===============* * +//* *= Substitute variables in the Remote JCL ===============* * +//* *==============================================================* * +//TAIL@SUB EXEC PGM=IRXJCL, ** Tailor and Submit ** SHIP4FTP +// PARM='ENBPIU00 A',COND=(4,LT) +//TABLE DD * If necessary, replace these for your xmit method +* MODEL TBLOUT + AHJOB AHJOB + C1BMXFTC SUBMIT +//C1BMXFTC DD DSN=&&XFTC,DISP=(OLD,PASS) +//OPTIONS DD *,SYMBOLS=JCLONLY **These variables are substituted** +* Other values for downstream Shipping jobs + Package = '&Package' + OUTRBAK = 'OUT' + Destin = '&Destination' + HOSTHLQ = '&Hostprefix' + RMOTHLQ = '&Rmteprefix' +* + HOSTLIBS = HOSTHLQ'.D&Date6.T&Time6.&Destination' + RMOTLIBS = RMOTHLQ'.D&Date6.T&Time6.&Destination' + Say 'HOSTLIBS='HOSTLIBS ; Say 'RMOTLIBS='RMOTLIBS +* Allocate AHJOB for input + AHJOB = HOSTHLQ'.D&Date6.T&Time6.&Destination.AHJOB' + CALL BPXWDYN "ALLOC DD(AHJOB) DA("AHJOB") SHR REUSE" + SENDNODE = MVSVAR(SYSNAME) + DATE6 = '&Date6' + TIME6 = '&Time6' + SHIPPER = '&Userid' + NODENAME = '&TARGnode' +//SYSEXEC DD DSN=&MyCLS0Library,DISP=SHR +// DD DSN=&MyCLS2Library,DISP=SHR +//APIMSG DD SYSOUT=* +//BSTAPI DD SYSOUT=* +//BSTERR DD SYSOUT=* +//SHOWME DD SYSOUT=* +//SYSTSPRT DD SYSOUT=* +//SUBMIT DD SYSOUT=(A,INTRDR) +//* *===================================================== C1BMXIN / * +//* *==============================================================* * +//* *==============================================================* *