diff --git a/endevor/Field-Developed-Programs/PackageBuilder.moveout b/endevor/Field-Developed-Programs/PackageBuilder.moveout new file mode 100644 index 0000000..44fa3ee --- /dev/null +++ b/endevor/Field-Developed-Programs/PackageBuilder.moveout @@ -0,0 +1,1262 @@ +./ ADD NAME=@README +These are rex/CSIQCLS0 : Moveout Package PKGELES PkgMaint +These are pnl/CSIQPENU : PACKAGEP PKGESEL2 PKGESELS PMAINTPN +These are asm : LOADTABL +These are ispfmsg/CSIQMENU : CIUU02 +./ ADD NAME=Moveout +/* REXX */ +/* */ + "ISREDIT MACRO" + /* WRITTEN BY DAN WALTHER */ +/* TRACE R ; */ +/* ADDRESS ISREXEC " CONTROL RETURN ERRORS " ; */ + ADDRESS ISREDIT "CHANGE 'CE'X '4A'X ALL " ; + ADDRESS ISREDIT "CHANGE '6A'X '4F'X ALL " ; + ADDRESS ISREDIT "CHANGE 'B7'X '5F'X ALL " ; + ADDRESS ISREDIT "CHANGE 'FA'X '4F'X ALL " ; + ADDRESS ISREDIT "CHANGE '9A'X '5F'X ALL " ; + ADDRESS ISREDIT " CURSOR = 1 1 " ; + RETCODE = 0 ; + ADDRESS ISREDIT " (LPOS1,CPOS1) = CURSOR " ; + DO WHILE RETCODE = 0 + ADDRESS ISREDIT " (DLINE) = LINE "LPOS1 + MYMBR = STRIP(SUBSTR(DLINE,15,22),T) ; + ADDRESS ISREDIT " FIND './ ADD NAME=' 1 " + RETCODE = RC + IF RETCODE > 0 THEN , + DO + ADDRESS ISREDIT " CURSOR = .ZLAST " ; + ADDRESS ISREDIT " (LPOS2,CPOS2) = CURSOR " ; + IF LPOS2 > LPOS1 THEN, + ADDRESS ISREDIT " REPLACE "MYMBR LPOS1+1 LPOS2 + REPRC = RC ; + END ; /* IF RETCODE > 0 THEN */ + ELSE, + DO + ADDRESS ISREDIT " (LPOS2,CPOS2) = CURSOR " ; + LPOS2 = LPOS2 - 1 ; + IF LPOS1 < LPOS2 THEN, + ADDRESS ISREDIT " REPLACE "MYMBR LPOS1+1 LPOS2 + REPRC = RC + LPOS1 = 1 + END; /* ELSE (RETCODE ...) */ + IF REPRC = 0 THEN , + ADDRESS ISREDIT " DELETE "LPOS1 LPOS2 ; + END; /* DO WHILE RETCODE = 0 */ + IF SYSVAR(SYSENV) = BACK THEN , + DO + ADDRESS ISREDIT " SAVE " + ADDRESS ISREDIT " CANCEL " + END + ADDRESS ISREDIT " EXCLUDE ALL "; + ADDRESS ISREDIT " FIND './ ADD NAME=' 1 ALL" ; + EXIT 0 + +./ ADD NAME=Package + /* REXX */ +/* THESE ROUTINES ARE DISTRIBUTED BY THE CA TECHNOLOGIES STAFF + "AS IS". NO WARRANTY, EITHER EXPRESSED OR IMPLIED, IS MADE + FOR THEM. CA TECHNOLOGIES CANNOT GUARANTEE THAT THE ROUTINES + ARE ERROR FREE, OR THAT IF ERRORS ARE FOUND, THEY WILL BE + CORRECTED. +*/ + TRACE o ; +/* Is PACKAGE is allocated? If yes, then turn on Trace */ + isItThere = , + BPXWDYN("INFO FI(PACKAGE) INRTDSN(DSNVAR) INRDSNT(myDSNT)") + If isItThere = 0 then Trace ?r + +/* Variable settings for each site ---> */ + VCAPRN= '0' + VCAPYN = 'N' + + WhereIam = Strip(Left("@"MVSVAR(SYSNAME),8)) ; + /* Site-based logic was obsolete here, and was removed */ + + /* Decide on Temporary Dataset name prefix... */ + ADDRESS ISPEXEC "VGET (ZSCREEN zUSER zSYSID zPREFIX)" + if zSYSID = SPECIAL then do /* is this a special system? */ + /* insert system specific logic if required here */ + PkgsDsPrefix = left(zUSER,3)||'.'||zUser'.'|| , + STRIP(LEFT('E'||ZSYSID,8))||'.PKGE'||ZSCREEN + end + else /* otherwise we use some sensible defautls */ + if zPrefix \= '', /* is Prefix set? and NOT.. */ + & zPrefix \= zUSER then do /* the same as userid? */ + PkgsDsPrefix = zPrefix ||'.'|| zUser'.' || , + STRIP(LEFT('E'||ZSYSID,8)) || '.PKGE'||ZSCREEN + end + else do /* otherwise use user name */ + PkgsDsPrefix = zUser ||'.'|| , + STRIP(LEFT('E'||ZSYSID,8)) || '.PKGE' || ZSCREEN + end + +/* No additional changes are required. */ +/* However, if you wish to modify the */ +/* structure of package names, find below */ +/* "Examples for building the package name" */ +/* <---- Variable settings for each site */ +/* Initialize vars for WideScreen Support */ + LONGPANL = "PKGESELS" /* Default to pri scrn */ + + ADDRESS ISPEXEC, + "VGET (C1BJC1 C1BJC2 C1BJC3 C1BJC4) PROFILE " + ADDRESS ISPEXEC "VGET (EEVCCID) PROFILE" + UseCCID = Strip(EEVCCID); + ADDRESS ISPEXEC "VGET (EEVCOMM) PROFILE" + + VARWKCMD = "" ; + Element_List = " " ; + System_List = " " ; + + INPPKGE = ' ' +/* + Call Check_For_Package_Execution ; + ADDRESS ISPEXEC, + "VPUT (INPPKGE) SHARED" + + If INPPKGE /= ' ' then, /* Package Processing */ + Do + Mode = 'package' + Call Build_Package_Suffix ; + Call Calculate_Date_Fields ; + Call Process_Input_Package ; + Call Build_Package ; + If CASTPKGE = "Y" then Call CAST_Package; + Exit + End /* Package Processing */ + */ + + Mode = 'element' +/* Variable settings for each site ---> */ +/* <---- Variable settings for each site */ +/* */ +/* Use Table Status to work out which interface we're in... */ +/* */ +/* for table status... */ +/* 1 = table exists in the table input library chain */ +/* 2 = table does not exist in the table input library chain */ +/* 3 = table input library is not allocated. */ +/* */ +/* 1 = table is not open in this logical screen */ +/* 2 = table is open in NOWRITE mode in this logical screen */ +/* 3 = table is open in WRITE mode in this logical screen */ +/* 4 = table is open in SHARED NOWRITE mode in this logical screen*/ +/* 5 = table is open in SHARED WRITE mode in this logical screen. */ +/* */ +/* In Quick Edit ? */ + + UseTable = "EN"ZSCREEN"IE250" + ADDRESS ISPEXEC + "TBSTATS" UseTable "STATUS1(STATUS1) STATUS2(STATUS2)" + + IF STATUS2 /= 2 & STATUS2 /= 3 & STATUS2 /= 4 then, + do +/* no, so try LongName ??? */ + UseTable = "LN"ZSCREEN"IE250" + ADDRESS ISPEXEC + "TBSTATS" UseTable "STATUS1(STATUS1) STATUS2(STATUS2)" + IF STATUS2 /= 2 & STATUS2 /= 3 & STATUS2 /= 4 then, + do +/* finally, try In Endevor ??? */ + UseTable = "CIELMSL"ZSCREEN + ADDRESS ISPEXEC + "TBSTATS" UseTable "STATUS1(STATUS1) STATUS2(STATUS2)" + IF STATUS2 /= 2 & STATUS2 /= 3 & STATUS2 /= 4 then, + do + say "Must invoke Package from an", + "Element list " + exit ; + end; + END + END + + "TBQUERY "UseTable " KEYS(KEYLIST) NAMES(VARLIST) ROWNUM(ROWNUM)" + IF RC > 0 THEN EXIT + + "TBTOP "UseTable + + + If Substr(UseTable,1,7) = 'CIELMSL' then, + Call Build_Entries_Endevor + Else, + Call Build_Entries_QuickEdit ; + + COUNT = Words(Element_List) ; + Call Build_Package_Suffix ; + Call Calculate_Date_Fields ; + System_List = Strip(System_List) ; + + ACTION = 'MOVE' + Call SHOW_PANEL; + Call Build_Package ; + If CASTPKGE = "Y" then Call CAST_Package; + + exit + +Build_Entries_Endevor: + + Do row = 1 to rownum + "TBSKIP "UseTable + entry = element"/"environ"/"stage"/"system"/"subsys"/"type + entry = EMKNAME"/"EMKENV"/"EMKSTGI"/" ||, + EMKSYS"/"EMKSBS"/"EMKTYPE + If row=1 then, + Do + Environment = EMKENV ; + Stage = EMKSTGI ; + If Environment = 'ADMIN' then, + PKGPRFIX = EMKSBS ; + Else, + PKGPRFIX = EMKSYS ; + Call Get_Next_StgID ; + End; + Element_List = Element_List entry + if Wordpos(EMKSYS,System_List) = 0 then, + System_List = System_List EMKSYS ; + + End; /* do row = 1 to rownum */ + + Return ; + +Build_Entries_QuickEdit: + + Do row = 1 to rownum + "TBSKIP "UseTable + entry = element"/"environ"/"stage"/"system"/"subsys"/"type + entry = EEVETKEL"/"EEVETKEN"/"EEVETKSI"/" ||, + EEVETKSY"/"EEVETKSB"/"EEVETKTY + If row=1 then, + Do + Environment = EEVETKEN ; + Stage = EEVETKSI ; + PKGPRFIX = EEVETKSY ; + UseCCID = Strip(EEVETCCI) + If Environment = 'ADMIN' then, + PKGPRFIX = EEVETKSB ; + Else, + PKGPRFIX = EEVETKSY ; + Call Get_Next_StgID ; + End; + Element_List = Element_List entry + if Wordpos(EEVETKSY,System_List) = 0 then, + System_List = System_List EEVETKSY ; + + End; /* do row = 1 to rownum */ + + Return ; + +Build_Package_Suffix: + + PKGSTAGE = Stage /* Package Prefix */ + + NUMBERS = '123456789' ; + CHARACTERS = 'ABCDEFGHIJKLMNOPQRSTUVWXYZ' ; + TODAY = DATE(O) ; + YEAR = SUBSTR(TODAY,1,2) + 1; + YEAR = SUBSTR(CHARACTERS||CHARACTERS||CHARACTERS||CHARACTERS,YEAR,1) + MONTH = SUBSTR(TODAY,4,2) ; + MONTH = SUBSTR(CHARACTERS,MONTH,1) ; + DAY = SUBSTR(TODAY,7,2) ; + DAY = SUBSTR(CHARACTERS || NUMBERS,DAY,1) ; + NOW = TIME(L); + HOUR = SUBSTR(NOW,1,2) ; + IF HOUR = '00' THEN HOUR = '0' + ELSE + HOUR = SUBSTR(CHARACTERS,HOUR,1) ; + + MINUTE = SUBSTR(NOW,4,2) ; + SECOND = SUBSTR(NOW,7,2) ; + Fractn = SUBSTR(NOW,10,6) ; + PKGUNIQ = YEAR || MONTH || DAY || HOUR ||, + MINUTE || SECOND || Fractn ; + + Return ; + +Get_Next_StgID: +/* */ + NEXT_STG = Stage ; + RETURN + SA= "CALLING LOADTABLE" +/* IF USING MULTIPLE DEFAULTS TABLES... */ +/* SET THE VALUE OF THE DEFAULTS TABLE NAME: */ +/* + C1DEFLTS = 'C1DEFLTS' + ADDRESS LINKMVS 'LOADTBLE' C1DEFLTS ; +*/ +/* IF NOT USING MULTIPLE DEFAULTS TABLES... */ + ADDRESS LINKMVS 'LOADTABL' 'C1DEFLTS' ; + C1DEFLTS_ADDR = C2X(TBLADDR) ; + POINTER_ADDR = D2X( X2D(C1DEFLTS_ADDR) + X2D(055) ) + NUMBER_OF_ENVIRONMENTS = C2D(STORAGE(POINTER_ADDR,01)); + POINTER_ADDR = D2X( X2D(C1DEFLTS_ADDR) + X2D(22E) ) + SITE_SYMBOLICS_TABLE_NAME = STORAGE(POINTER_ADDR,08) ; +/* */ + POINTER_ADDR = D2X( X2D(C1DEFLTS_ADDR) + X2D(400) ) +/* */ + DO CNT = 1 TO NUMBER_OF_ENVIRONMENTS + ENV_NAME_ADDR = D2X( X2D(POINTER_ADDR) + X2D(074) ) + NEXT_ENV_ADDR = D2X( X2D(POINTER_ADDR) + X2D(07C) ) + NEXT_STG_ADDR = D2X( X2D(POINTER_ADDR) + X2D(073) ) + C1STAGE1_ADDR = POINTER_ADDR + C1STAGE2_ADDR = D2X( X2D(POINTER_ADDR) + X2D(08A) ) + C1STGID1_ADDR = D2X( X2D(POINTER_ADDR) + X2D(0BE) ) + C1STGID2_ADDR = D2X( X2D(POINTER_ADDR) + X2D(0D3) ) + STAGE_1_ENTRY_ADDR = D2X( X2D(POINTER_ADDR)+ X2D(0F0)) + STAGE_2_ENTRY_ADDR = D2X( X2D(POINTER_ADDR)+ X2D(0F1)) + ENV_NAME = STORAGE(ENV_NAME_ADDR,08) ; + NEXT_ENV = STORAGE(NEXT_ENV_ADDR,08) ; + NEXT_STG = STORAGE(NEXT_STG_ADDR,01) ; + C1STAGE1 = STORAGE(POINTER_ADDR,08) ; + C1STAGE2 = STORAGE(C1STAGE2_ADDR,08) ; + C1STGID1 = STORAGE(C1STGID1_ADDR,01) ; + C1STGID2 = STORAGE(C1STGID2_ADDR,01) ; + STAGE_1_ENTRY_INDICATOR = STORAGE(STAGE_1_ENTRY_ADDR,01) ; + STAGE_2_ENTRY_INDICATOR = STORAGE(STAGE_2_ENTRY_ADDR,01) ; + + IF ENV_NAME = Environment then, + DO + If Stage = C1STGID1 then NEXT_STG = C1STGID2 ; + /* Otherwise user the value already in NEXT_STG */ + Leave ; + End; /* IF NEXT_ENV /= " " */ + + POINTER_ADDR = D2X( X2D(POINTER_ADDR) + X2D(100) ) + END /* DO CNT = 1 TO NUMBER_OF_ENVIRONMENTS */ + + Return ; + +Calculate_Date_Fields: + + GENERATE = "Y" ; + + + TEMP = DATE('N') + DAY = WORD(TEMP,1) + IF LENGTH(DAY) < 2 THEN DAY = "0"DAY ; + MON = WORD(TEMP,2) + YEAR = SUBSTR(WORD(TEMP,3),3,2) ; + IF LENGTH(YEAR) < 2 THEN YEAR = "0"YEAR ; + BTSTDATE = DAY || MON || YEAR; + ONSTDATE = DAY || MON || YEAR; + + TEMP = TIME('N') + BTSTTIME = SUBSTR(TEMP,1,5) + BTSTTIME = "00:00" + + BTENDATE = "31DEC79" + BTENTIME = "00:00" + + Return ; + +SHOW_PANEL: + + /* These are valid if we are in Quick Edit */ + CCID = EEVCCID + COMMENT = EEVCOMM + + If Substr(UseTable,1,7) = 'CIELMSL' then, + Do + CCID = ECTL# + COMMENT = EMCCOM + End +/* + Examples for building the package name...... + PACKAGE = PKGSTAGE||"#" ||Substr(PKGPRFIX,1,4)||PKGUNIQ ; + PACKAGE = STAGE ||"#" || PKGUNIQ ; + PACKAGE = PKGSTAGE ||"#" || PKGUNIQ ; + COMMENT = Left(UseCCID||':' COMMENT,50) +*/ + PACKAGE = UseCCID || PKGUNIQ + PKGPRFIX = Left(PKGPRFIX,4,'#') + PACKAGE = Substr(PKGPRFIX,1,4)|| '#' || PKGUNIQ + + PACKAGE = Left(PACKAGE,16,'#') + + ADDRESS ISPEXEC, + "DISPLAY PANEL(PACKAGEP) " + if rc > 0 then exit + DESCRIPT = TRANSLATE(DESCRIPT,"'",'"'); + + DATE = BTSTDATE ; + CALL VALIDATE_DATE ; + IF DATE_RC > 0 THEN SIGNAL SHOW_PANEL; + BATCH_START_DATE = NUMERIC_DATE ; + sa= "BATCH_START_DATE =" BATCH_START_DATE ; + + DATE = BTENDATE ; + CALL VALIDATE_DATE ; + IF DATE_RC > 0 THEN SIGNAL SHOW_PANEL; + + ADDRESS ISPEXEC, + "VPUT (C1BJC1 C1BJC2 C1BJC3 C1BJC4) PROFILE " + + IF Mode /= 'element' |, + PICKLIST /= 'Y' THEN RETURN ; + + PickLstTable = "EN"ZSCREEN"PKLST"; /* Use Pick List table */ + "ISPEXEC CONTROL DISPLAY SAVE" + Call Create_PickList_Table ; + "ISPEXEC CONTROL DISPLAY RESTORE" + If Selection = 0 then exit ; + + Return + +VALIDATE_DATE: + + DATE_RC = 0 ; + + /* BTENDATE = "31DEC79" */ + DAY = SUBSTR(DATE,1,2) ; + MON = SUBSTR(DATE,3,3) ; + YEAR = SUBSTR(DATE,6,2) ; + LIST_OF_MONTHS = "JAN FEB MAR APR MAY JUN JUL AUG SEP OCT NOV DEC" ; + NUMERIC_MON = WORDPOS(MON,LIST_OF_MONTHS) ; + IF LENGTH(NUMERIC_MON) < 2 THEN NUMERIC_MON = "0"NUMERIC_MON ; + + NUMERIC_DATE = YEAR || NUMERIC_MON || DAY ; + + IF DAY < "01" | DAY > "31" THEN DATE_RC = 8 ; + IF NUMERIC_MON = 0 THEN DATE_RC = 8 ; + IF YEAR < "01" | YEAR > "99" THEN DATE_RC = 8 ; + + IF DATE_RC > 0 THEN, + ADDRESS ISPEXEC "SETMSG MSG(CIUU026E)" ; + + return; + +Build_Package: + + ADDRESS TSO, + "ALLOC F(PKGESCL)", + "LRECL(80) BLKSIZE(800) SPACE(5,5)", + "RECFM(F B) TRACKS ", + "NEW UNCATALOG REUSE " ; + + Queue "SET OPTIONS CCID '"CCID"'" + Queue " COMMENT '"COMMENT"' " + ADDRESS ISPEXEC "VGET (EEVOOSGN) SHARED " + IF EEVOOSGN = "Y" THEN, + Queue " OVERRIDE SIGNOUT." + ELSE, + Queue " . " + + Do cnt = 1 to Words(Element_List) ; + entry = WORD(Element_List,cnt) ; + entry = Translate(entry," ","/"); + Queue ACTION "ELEMENT" + Queue "'"WORD(entry,1)"'" + Queue " FROM ENVIRONMENT" WORD(entry,2) + Queue " SYSTEM" WORD(entry,4) "SUBSYSTEM" WORD(entry,5) + Queue " TYPE" WORD(entry,6) "STAGE" WORD(entry,3) "." + End; + + ADDRESS TSO, + "EXECIO" QUEUED() "DISKW PKGESCL (FINIS " ; + + ADDRESS TSO, + "ALLOC F(C1MSGS1)", + "LRECL(133) BLKSIZE(13300) SPACE(5,5)", + "RECFM(V B) TRACKS ", + "NEW UNCATALOG REUSE " ; + + ADDRESS TSO, + "ALLOC F(ENPSCLIN)", + "LRECL(80) BLKSIZE(800) SPACE(5,5)", + "RECFM(F B) TRACKS ", + "NEW UNCATALOG REUSE " ; + + QUEUE " DEFINE PACKAGE '"PACKAGE"'" + QUEUE " IMPORT SCL FROM DDNAME 'PKGESCL'" + If APPEND = "Y" then, + QUEUE " APPEND " + QUEUE " DESCRIPTION '"DESCRIPT"'" + QUEUE " OPTIONS STANDARD SHARABLE BACKOUT ENABLED " + QUEUE " EXECUTION WINDOW FROM " BTSTDATE BTSTTIME + QUEUE " TO " BTENDATE BTENTIME + If PROMOTE = "Y" & ACTION = 'MOVE' then, + QUEUE " PROMOTION PACKAGE " + QUEUE " NOTES=('"VPHNOTE1"'," + QUEUE " '"VPHNOTE2"'," + QUEUE " '"VPHNOTE3"'," + QUEUE " '"VPHNOTE4"'," + QUEUE " '"VPHNOTE5"'," + QUEUE " '"VPHNOTE6"'," + QUEUE " '"VPHNOTE7"'," + QUEUE " '"VPHNOTE8"') . " + ADDRESS TSO, + "EXECIO" QUEUED() "DISKW ENPSCLIN (FINIS " ; + + ADDRESS LINK "ENBP1000" ; + IF RC > 4 THEN, + Do + Say "Could not build the package "PACKAGE + ADDRESS ISPEXEC "LMINIT DATAID(DDID) DDNAME(C1MSGS1)" + ADDRESS ISPEXEC "VIEW DATAID(&DDID)" + ADDRESS ISPEXEC "LMFREE DATAID(&DDID)" + EXIT(8) + End + + ADDRESS TSO "FREE F(C1MSGS1)" + ADDRESS TSO "FREE F(PKGESCL)" + ADDRESS TSO "FREE F(ENPSCLIN)" + + ADDRESS ISPEXEC "SETMSG MSG(CIUU020I)" ; + + return; + +CAST_Package: + + ADDRESS ISPEXEC "SETMSG MSG(CIUU021I)" ; + ADDRESS ISPEXEC "DISPLAY PANEL(ENDIE700) " + if rc > 0 then exit + + SCL_DSN = PkgsDsPrefix || "." || SUBSTR(PKGUNIQ,1,8) + + ADDRESS TSO, + "ALLOC F(CASTSCL) DA('"SCL_DSN"')", + "LRECL(80) BLKSIZE(800) SPACE(5,5)", + "RECFM(F B) TRACKS ", + "NEW CATALOG REUSE " ; + + If VALIDATE /= "Y" then, + Do + QUEUE " CAST PACKAGE '"PACKAGE"' " + QUEUE " OPTION DO NOT VALIDATE COMPONENT ." + End + Else, + QUEUE " CAST PACKAGE '"PACKAGE"' ." + /* + */ + pkg = Overlay('*',PACKAGE,Length(PACKAGE)) + If EXECUTE = "Y" then, + Do + QUEUE " EXECUTE PACKAGE '"pkg"' " + QUEUE " OPTIONS WHERE PACKAGE STATUS IS APPROVED . " + End + ADDRESS TSO, + "EXECIO" QUEUED() "DISKW CASTSCL (FINIS " ; + ADDRESS TSO "FREE F(CASTSCL)" + + ADDRESS ISPEXEC "VGET (VCAPRN) ASIS " + If VCAPRN > '1' then VCAPYN = 'Y' + + PDVINCJC = "Y" /* for ENSP1000 */ + PDVSCLDS = SCL_DSN ; /* for ENSP1000 */ + PDVDD01 = "//DELETEME DD DSN="SCL_DSN",DISP=(OLD,DELETE)" + + ADDRESS ISPEXEC "FTOPEN TEMP" + + ADDRESS ISPEXEC "FTINCL ENSP1000" + + ADDRESS ISPEXEC "FTCLOSE " + + ADDRESS ISPEXEC "VGET (ZUSER ZTEMPF ZTEMPN) ASIS" ; + DEBUG = 'YES' ; + DEBUG = 'NAW' ; + X = OUTTRAP("OFF") + IF DEBUG = 'YES' THEN, + DO + ADDRESS ISPEXEC "LMINIT DATAID(DDID) DDNAME(&ZTEMPN)" + ADDRESS ISPEXEC "EDIT DATAID(&DDID)" + ADDRESS ISPEXEC "LMFREE DATAID(&DDID)" + END; + ELSE, + DO + ADDRESS TSO "SUBMIT '"ZTEMPF"'" ; + END; + + return; + +Create_PickList_Table: + + /* Allow user to select from original list of elements */ + ADDRESS ISPEXEC "VGET (ZSCREEN) SHARED" + SA= "CREATE_SummaryLevels_Table SUM"ZSCREEN"LVL" + ADDRESS ISPEXEC, + "TBCREATE" PickLstTable, + 'NAMES(EEVETSEL EEVETKEL EEVETDMS EEVETKTY EEVETKEN EEVETKSI ', + ' EEVETPRC EEVETNRC EEVETUID EEVETCCI ', + ' EEVETKSY EEVETKSB EEVETDVL) WRITE ' ; + + ADDRESS ISPEXEC "TBTOP "UseTable ; + + Do row = 1 to ROWNUM + ADDRESS ISPEXEC "TBSKIP "UseTable + If Substr(UseTable,1,7) = 'CIELMSL' then, + Do + /* We are using an Endevor table - not a QE table */ + EEVETKEL = EMKNAME + EEVETKTY = EMKTYPE + EEVETKEN = EMKENV + EEVETKSI = EMKSTGI + EEVETKSY = EMKSYS + EEVETKSB = EMKSBS + EEVETDVL = ECVL + EEVETPRC = EPRC + EEVETNRC = EMRC + EEVETUID = EMLUID + EEVETCCI = ECTL# + End; + + IF TOSUBSYS = EEVETKSB THEN ITERATE ; + EEVETSEL = ' ' + EEVETDMS = ' ' + ADDRESS ISPEXEC "TBADD" PickLstTable "ORDER "; + End; /* do row = 1 to rownum */ + + ADDRESS ISPEXEC "TBSORT" PickLstTable, + "FIELDS(EEVETKEL,C,A) "; + SA= 'COMPLETED TBSORT ' ; + ADDRESS ISPEXEC "TBTOP" PickLstTable ; + + ADDRESS ISPEXEC "SETMSG MSG(CIUU025I)" ; + Selection = 0 ; + + VARC1LR = PASSTHRU /* enable Left/Right commands */ + DO FOREVER /* Till user presses END or CANCEL */ + ADDRESS ISPEXEC "TBDISPL" PickLstTable "PANEL("LONGPANL")" + TBDRC = RC + IF TBDRC >= 8 THEN, /* user want's out */ + DO + address ispexec "vget (zverb)" /* Cancel, End or Return? */ + if ZVERB == 'CANCEL' then Selection = 0 /* clear selection */ + VARC1LR = '' /* Allow standard Left/Right */ + If Selection = 0 then + Do + ADDRESS ISPEXEC "TBEND" PickLstTable ; + Return + End + Leave + end; + THISTOPR = ZTDTOP /* save the top row so we can restore it */ + DO WHILE ZTDSELS > 0 /* process any modified rows */ + SA= 'ZTDSELS=' ZTDSELS 'ZTDTOP=' ZTDTOP + sa= "PROCESSING ELEMENT " EEVETKEL C1ELTYPE + IF Strip(EEVETSEL) = "S" then, + Do + EEVETSEL = ' ' + If EEVETDMS /= '*SELECTED*' then Selection = Selection + 1 ; + EEVETDMS = '*SELECTED*' + ADDRESS ISPEXEC "TBPUT" PickLstTable ; + End; + IF Strip(EEVETSEL) = "U" then, + Do + EEVETSEL = ' ' + If EEVETDMS /= ' ' then Selection = Selection - 1 ; + EEVETDMS = ' ' + ADDRESS ISPEXEC "TBPUT" PickLstTable ; + End; + IF ZTDSELS = 1 then leave /* we got em all get out now */ + ADDRESS ISPEXEC "TBDISPL" PickLstTable ; /* get next */ + sa= 'ZTDSELS=' ZTDSELS 'RC=' rc + end + /* now process any primary commands */ + THISCMD = VARWKCMD; /* get any command */ + VARWKCMD = ""; /* reset the command */ + parse upper var THISCMD THISCMDW THISCMDP + + select + when THISCMDW == '' then NOP; + when THISCMDW == 'LEFT' then call Toggle_Screen; + when THISCMDW == 'RIGHT' then call Toggle_Screen; + otherwise + do + VARWKCMD = THISCMD /* restore command so it can be corrected */ + ADDRESS ISPEXEC "SETMSG MSG(LONG013E)" ; /* Cmd Not Recognized */ + end + End /* Do Forever */ + + /* re-position table */ + ADDRESS ISPEXEC "TBTOP "PickLstTable ; + ADDRESS ISPEXEC "TBSKIP "PickLstTable" NUMBER("THISTOPR")" + END; /* DO until user presses End or cancel */ + VARC1LR = '' /* Allow standard Left/Right */ + + If Selection = 0 then, + Do + ADDRESS ISPEXEC "TBEND" PickLstTable ; + Return ; + End + + ADDRESS ISPEXEC "TBTOP" PickLstTable ; + + Element_List = " " ; + COUNT = 0 + Do row = 1 to ROWNUM + ADDRESS ISPEXEC "TBSKIP" PickLstTable ; + If EEVETDMS /= '*SELECTED*' then iterate ; + entry = EEVETKEL"/"EEVETKEN"/"EEVETKSI"/" ||, + EEVETKSY"/"EEVETKSB"/"EEVETKTY + Element_List = Element_List entry; + + COUNT = COUNT + 1; + Sa= 'Adding 'EEVETKEL COUNT + End; /* do row = 1 to rownum */ + + ADDRESS ISPEXEC "TBEND" PickLstTable ; + if Count = 0 then + Selection = 0 /* nothing to do */ + else + UseTable = PickLstTable ; /* Use Pick List table now */ + Return ; + +Toggle_Screen: + + IF LONGPANL == PKGESELS THEN LONGPANL = "PKGESEL2" + ELSE LONGPANL = "PKGESELS" + + Return; + +Check_For_Package_Execution: + + ADDRESS ISPEXEC, + "VGET (ZSCREEN ZSCREENC ZSCREENI) SHARED" + + position = zscreenc; + Do forever + If position < 2 then exit(8) + If substr(zscreeni,(position-1),1) < '$' then leave; + position = position - 1; + End ; + + pkg = Strip(substr(zscreeni,position,16)) ; + SA= "Package =" pkg + if Length(pkg) < 16 then Return ; + INPPKGE = pkg + + Return + +Process_Input_Package: + SAY "GETTING CURRENT LOCATIONS FROM ENDEVOR" ; + ADDRESS TSO "ALLOC FI(C1MSGS1) DUMMY SHR REUSE" + ADDRESS TSO; + + "ALLOC FI(C1MSGS1) DUMMY SHR REUSE" + "ALLOC FI(C1MSGS2) DUMMY SHR REUSE" +/*'ALLOC F(BSTERR) DUMMY SHR REUSE ' */ +/*'ALLOC F(BSTAPI) DUMMY SHR REUSE ' */ + + 'ALLOC F(APILIST) LRECL(2048) BLKSIZE(22800) SPACE(5,5) ', + 'RECFM(V B) TRACKS NEW UNCATALOG REUSE ' ; + + 'ALLOC F(APIMSGS) LRECL(133) BLKSIZE(13300) SPACE(5,5) ', + 'RECFM(F B) TRACKS NEW UNCATALOG REUSE ' ; + + ADDRESS LINKMVS 'APIALPKG' INPPKGE ; /* Get pkg header */ + ADDRESS TSO "EXECIO * DISKR APILIST (STEM pkghdr. finis" + InpPackageStatus = Substr(pkghdr.1,116,12) ; + InpPackageDescription = Substr(pkghdr.1,30,50) ; + + 'ALLOC F(APILIST) LRECL(2048) BLKSIZE(22800) SPACE(5,5) ', + 'RECFM(V B) TRACKS NEW UNCATALOG REUSE ' ; + ADDRESS LINKMVS 'APIALSUM' INPPKGE ; /* Get pkg Actions*/ + + ADDRESS TSO "EXECIO * DISKR APILIST (STEM pkglst. finis" + IF pkglst.0 = 0 then, + Do + Say 'Package' INPPKGE ' is not-found or not-CAST ' + Exit (8) + End; + + ADDRESS ISPEXEC "VGET (ZSCREEN) SHARED" + PickLstTable = "EN"ZSCREEN"PKLST"; /* Use Pick List table */ + + ADDRESS ISPEXEC, + "TBCREATE" PickLstTable, + 'NAMES(EEVETSEL EEVETKEL EEVETDMS EEVETKTY EEVETKEN EEVETKSI ', + ' EEVETKSY EEVETKSB EEVETDVL) WRITE ' ; + plc = 191 ; /* Assume Source fields */ + If STRIP(InpPackageStatus) = 'EXECUTED' then plc = 304 ; + If STRIP(InpPackageStatus) = 'COMMITTED' then plc = 304 ; + If Substr(InpPackageDescription,47,4) = 'XFER' then plc = 191; + If Substr(pkglst.ROWNUM,304,1) < '$' then plc = 191; + Do ROWNUM = 1 to pkglst.0 + EEVETKEL = Substr(pkglst.ROWNUM,415,8) ; + EEVETKEN = Substr(pkglst.ROWNUM,plc,8) ; + EEVETKSY = Substr(pkglst.ROWNUM,(plc+8),8) ; + EEVETKSB = Substr(pkglst.ROWNUM,(plc+16),8) ; + EEVETKTY = Substr(pkglst.ROWNUM,(plc+26),8) ; + EEVETKSI = Substr(pkglst.ROWNUM,(plc+43),1) ; + EEVETSEL = ' ' + EEVETDMS = ' ' + If ROWNUM = 1 then, + Do + Environment = EEVETKEN ; + Stage = EEVETKSI ; + PKGPRFIX = EEVETKSY ; + If Environment = 'ADMIN' then, + PKGPRFIX = EEVETKSB ; + Else, + PKGPRFIX = EEVETKSY ; + Call Get_Next_StgID ; + End; + ADDRESS ISPEXEC "TBADD" PickLstTable "ORDER "; + End; /* Do ROWNUM = 1 to pkglst.0 */ + COUNT = pkglst.0 + + ADDRESS ISPEXEC "TBSORT" PickLstTable, + "FIELDS(EEVETKEL,C,A) "; + SA= 'COMPLETED TBSORT ' ; + ADDRESS ISPEXEC "TBTOP" PickLstTable ; + + Call SHOW_PANEL ; + + If PICKLIST = 'Y' THEN, + Do + VARC1LR = PASSTHRU /* enable Left/Right commands */ + ADDRESS ISPEXEC "SETMSG MSG(CIUU025I)" ; + ADDRESS ISPEXEC "TBDISPL" PickLstTable "PANEL("LONGPANL")"; + IF RC > 4 THEN, + DO + VARC1LR = '' /* Allow standard Left/Right */ + ADDRESS ISPEXEC "TBEND" PickLstTable ; + EXIT + end; + TBDISPL_RC = RC ; + DO FOREVER + ADDRESS ISPEXEC "SETMSG MSG(CIUU025I)" ; + SA= 'ZTDSELS=' ZTDSELS + sa= "PROCESSING ELEMENT " EEVETKEL C1ELTYPE + IF Strip(EEVETSEL) = "S" then, + Do + EEVETSEL = ' ' + EEVETDMS = '*SELECTED*' + ADDRESS ISPEXEC "TBPUT" PickLstTable ; + End; + IF Strip(EEVETSEL) = "U" then, + Do + EEVETSEL = ' ' + EEVETDMS = ' ' + ADDRESS ISPEXEC "TBPUT" PickLstTable ; + End; + If ZTDSELS > 0 then do + ADDRESS ISPEXEC "TBDISPL" PickLstTable ; + if RC > 4 then leave; + end + If ZTDSELS < 1 then leave ; + END; /* DO FOREVER */ + END; /* If PICKLIST = 'Y' */ + VARC1LR = '' /* Allow standard Left/Right */ + + ADDRESS ISPEXEC "TBTOP" PickLstTable ; + + Element_List = " " ; + COUNT = 0 + Do row = 1 to ROWNUM + ADDRESS ISPEXEC "TBSKIP" PickLstTable ; + If PICKLIST = 'Y' &, + EEVETDMS /= '*SELECTED*' then iterate ; + entry = EEVETKEL"/"EEVETKEN"/"EEVETKSI"/" ||, + EEVETKSY"/"EEVETKSB"/"EEVETKTY + Element_List = Element_List entry; + + COUNT = COUNT + 1; + End; /* do row = 1 to rownum */ + + ADDRESS ISPEXEC "TBEND" PickLstTable ; + UseTable = PickLstTable ; /* Use Pick List table now */ + + Return ; + + +./ ADD NAME=PKGELES + +./ ADD NAME=PACKAGEP +)ATTR DEFAULT(%+_) +/*---------------------------------------------------------------------- +/* (C) 2002 Computer Associates International, Inc. +/*---------------------------------------------------------------------- + ^ TYPE(OUTPUT) INTENS(HIGH) JUST(RIGHT) + | TYPE(OUTPUT) INTENS(LOW) + _ TYPE(INPUT) INTENS(HIGH) PADC(_) CAPS(ON) + { TYPE(INPUT) CAPS(&VARCACCI) FORMAT(&VARFMCCI) PADC(_) + ` TYPE(INPUT) CAPS(&VARCACOM) FORMAT(&VARFMCOM) PADC(_) + ~ TYPE(INPUT) CAPS(&VARCADES) FORMAT(&VARFMDES) PADC(_) +)BODY +%------------------------ ENDEVOR Package(s) Builds --------------------------- +%Command ===>_VARWKCMD ++ ++ Action :_ACTION + <- MOVE/GENERATE/DELETE for ^COUNT+Elements ++ CCID :_CCID +<- CCID _Z+_PACKAGE + _Z+<-Append Y/N ++ %Concur Act =====>_Z+ ++ Promote:_Z+ <- Y/N Cast:_Z+ <- Y/N Validate:_Z+ <- Y/N Execute:_Z+ <- Y/N ++ Description:_DESCRIPT + ++ EXECUTION WINDOW FROM%===>_Z _Z + TO%===>_Z _Z + ++ ----------------------%Package Note Text+------------------------------- ++ .........1.........2.........3.........4.........5.........6 ++ 1. `VPHNOTE1 + ++ 2. `VPHNOTE2 + ++ 3. `VPHNOTE3 + ++ 4. `VPHNOTE4 + ++ 5. `VPHNOTE5 + ++ 6. `VPHNOTE6 + ++ 7. `VPHNOTE7 + ++ 8. `VPHNOTE8 + +)INIT + VGET (VCAPRN) ASIS + &APPEND = 'N' + &CASTPKGE = 'Y' + &VALIDATE = 'Y' + &EXECUTE = 'N' + &ACTION = 'MOVE' + &DESCRIPT = &COMMENT + &PICKLIST = 'N' + .ZVARS = '( PICKLIST APPEND VCAPRN PROMOTE CASTPKGE VALIDATE + + EXECUTE BTSTDATE BTSTTIME BTENDATE BTENTIME)' +)PROC + VER (&ACTION,LIST,MOVE,GENERATE,DELETE) + VER (&VCAPRN,NUM) + &VARSPPKG = &PACKAGE + VPUT (VCAPRN) ASIS + VPUT (VARSPPKG) SHARED +)END +./ ADD NAME=PKGESEL2 +)ATTR +/*---------------------------------------------------------------------- +/* Copyright (C) 2007 CA. All Rights Reserved. +/*---------------------------------------------------------------------- + ^ TYPE(OUTPUT) INTENS(HIGH) + @ TYPE(OUTPUT) INTENS(LOW) + _ TYPE(INPUT) INTENS(HIGH) PADC(_) CAPS(ON) + ` TYPE(INPUT) CAPS(&VARCACOM) FORMAT(&VARFMCOM) PADC(_) + ~ TYPE(INPUT) CAPS(&VARCADES) FORMAT(&VARFMDES) PADC(_) +)BODY +%-------------------------- PACKAGE Selection List --------------------- ++Command ===>_VARWKCMD %Scroll == ++ ++ Element Options: ++ %S+Select Element(s) ++ % ++ S Element Message Type CCID User PRRC NDRC ++ -- ---------- ---------- -------- ----------- ------- --- --- +)MODEL ++_Z @Z ^Z @Z @Z + @Z + @Z + @Z + +)INIT + .ZVARS = '(EEVETSEL EEVETKEL EEVETDMS EEVETKTY EEVETCCI + + EEVETUID EEVETPRC EEVETNRC)' + .HELP = ENDHE250 + VGET (AMT) + IF (&AMT = '') + &AMT = PAGE +)PROC + VPUT (AMT) PROFILE + &VARWKSEL = &EEVETSEL + &EEVSELCH = &EEVETSEL +)END +./ ADD NAME=PKGESELS +)ATTR +/*---------------------------------------------------------------------- +/* Copyright (C) 2007 CA. All Rights Reserved. +/*---------------------------------------------------------------------- + ^ TYPE(OUTPUT) INTENS(HIGH) + @ TYPE(OUTPUT) INTENS(LOW) + _ TYPE(INPUT) INTENS(HIGH) PADC(_) CAPS(ON) + ` TYPE(INPUT) CAPS(&VARCACOM) FORMAT(&VARFMCOM) PADC(_) + ~ TYPE(INPUT) CAPS(&VARCADES) FORMAT(&VARFMDES) PADC(_) +)BODY +%-------------------------- PACKAGE Selection List --------------------- ++Command ===>_VARWKCMD %Scroll == ++ ++ Element Options: ++ %S+Select Element(s) ++ % ++ S Element Message Type Environment Stage System Subsystem ++ -- ---------- ---------- -------- ----------- ----- -------- --------- +)MODEL ++_Z @Z ^Z @Z @Z + @Z+ @Z @Z +@Z +)INIT + .ZVARS = '(EEVETSEL EEVETKEL EEVETDMS EEVETKTY EEVETKEN EEVETKSI + + EEVETKSY EEVETKSB EEVETDVL)' + .HELP = ENDHE250 + VGET (AMT) + IF (&AMT = '') + &AMT = PAGE +)PROC + VPUT (AMT) PROFILE + &VARWKSEL = &EEVETSEL + &EEVSELCH = &EEVETSEL +)END + +./ ADD NAME=LOADTABL +LOADTABL CSECT +* THESE ROUTINES ARE DISTRIBUTED BY THE BROADCOM STAFF +* "AS IS". NO WARRANTY, EITHER EXPRESSED OR IMPLIED, IS MADE +* FOR THEM. CA TECHNOLOGIES CANNOT GUARANTEE THAT THE ROUTINES +* ARE ERROR FREE, OR THAT IF ERRORS ARE FOUND, THEY WILL BE +* CORRECTED. +* +*********************************************************************** +* SEE IBM TSO EXTENSIONS FOR MVS * +* PROGRAMMING SERVICES * +* VERSION 2 RELEASE 5 * +* DOCUMENT NUMBER SC28-1875-08 * +* 24.8 EXAMPLES USING IKJCT441 * +*********************************************************************** +CVTPTR EQU 16 +CVTTVT EQU X'9C' +R15 EQU 15 +R14 EQU 14 +R13 EQU 13 +R12 EQU 12 +R11 EQU 11 +R07 EQU 7 +R01 EQU 1 +R00 EQU 0 + IKJTSVT +LOADTABL CSECT + STM R14,R12,12(R13) SAVE CALLER'S REGISTERS + BALR R12,0 ESTABLISH ADDRESSABILITY + USING *,R12 BASE REGISTER OF EXECUTING PROGRAM + ST R13,SAVEAREA+4 CALLER'S SAVEAREA ADDRESS + LA R15,SAVEAREA EXECUTING PROGRAM'S SAVEAREA ADDRESS + ST R15,8(,R13) EXECUTING PROGRAM'S SAVEAREA ADDRESS + LA R13,SAVEAREA EXECUTING PROGRAM'S SAVEAREA ADDRESS +* +*---------------------------------------------------------------------- +*- LOAD THE TABLE NAMED IN PARM STRING +*---------------------------------------------------------------------- +* + L R07,0(R01) GET TABLENAME IN PARAMETER S + MVC TABLELEN(10),0(R07) SAVE TABLE LEN AND NAME +* LENGTH (0 => NOT CALLED BY REXX) +* +* MVC SWTO+19(08),=C'LOADING ' +* MVC SWTO+27(10),0(R07) *DAN* +* BAL R14,SWTO *DAN* +* +* WTO 'LOADTABL - CALLING LOAD ',* +* ROUTCDE=(11) +* + LOAD EPLOC=TABLENAM + LTR R15,R15 VERIFY LOAD WAS SUCCESSFUL + BZ CONTINU1 + ST R15,VALUE SAVE ADDRESS INTO REXX VAR VALUE +* +* WTO 'LOADTABL - CALLED LOAD. RESULT FAILED. ',* +* ROUTCDE=(11) + B CONTINU2 +* +SWTO WTO 'SHOWME - ', * + ROUTCDE=(11) + MVC SWTO+19(40),SPACES *DAN* + BR R14 +* +* +CONTINU1 DS 0H CONTINUE + ST R00,VALUE SAVE ADDRESS INTO REXX VAR VALUE +* WTO 'LOADTABL - CALLED LOAD. RESULT OK. ',* +* ROUTCDE=(11) +* + LA R07,0 + LH R07,TABLELEN + C R07,=X'0000' + BE NOTREXX NOT CALLED BY REXX, JUST RETURN +* +* WTO 'LOADTABL - CALLED FROM REXX ',* +* ROUTCDE=(11) +* +CONTINU2 L R15,CVTPTR ACCESS THE CVT + L R15,CVTTVT(,R15) ACCESS THE TSVT + L R15,TSVTVACC-TSVT(,R15) ACCESS THE VARIABLE ACCESS RTN + +* INVOKE THE VARIABLE ACCESS SERVICE +* + LTR R15,R15 VERIFY TSVT ADDRESS PRESENT + BNZ CALL441 IF PRESENT, CALL IKJCT441 + +LINK441 LINK EP=IKJCT441, * + PARAM=(ECODE, ENTRY CODE * + NAMEPTR, POINTER TO VARIABLE NAME * + NAMELEN, LENGTH OF VARIABLE NAME * + VALUEPTR, POINTER TO VARIABLE VALUE * + VALUELEN, LENGTH OF VARIABLE VALUE * + TOKEN), TOKEN TO VARIABLE ACCESS SERVICE * + VL=1 CAUSES HI BIT ON IN THE PARM LIST + B RET441 +CALL441 CALL (15), * + (ECODE, ENTRY CODE * + NAMEPTR, POINTER TO VARIABLE NAME * + NAMELEN, LENGTH OF VARIABLE NAME * + VALUEPTR, POINTER TO VARIABLE VALUE * + VALUELEN, LENGTH OF VARIABLE VALUE * + TOKEN), TOKEN TO VARIABLE ACCESS SERVICE * + VL CAUSES HI BIT ON IN THE PARM LIST +* +RET441 LTR R15,R15 CHECK RETURN CODE + BNZ NOTREXX + L R13,4(,R13) CALLER'S SAVEAREA + L R14,12(,R13) RESTORE REGISTER 14 + LM R00,R12,20(R13) RESTORE REMAINING REGISTERS + BR R14 RETURN TO CALLER, REGISTER 15 CONTAINS +* THE RETURN CODE FROM IKJCT441 +NOTREXX DS 0H +* +* WTO 'LOADTABL - CALLED FROM OTHER THAN REXX ',* +* ROUTCDE=(11) +* + L R13,4(,R13) CALLER'S SAVEAREA + L R14,12(,R13) RESTORE REGISTER 14 + LM R00,R12,20(R13) RESTORE REMAINING REGISTERS + L R15,VALUE PROVIDE LOADED ADDRESS IN RETURNCODE + BR R14 RETURN TO CALLER, REGISTER 15 CONTAINS +* THE RETURN CODE FROM IKJCT441 +* +SPACES DC C' ' +TABLELEN DC CL02' ' LENGTH (0 => NOT CALLED BY REXX) +TABLENAM DC CL08' ' NAME OF THE TABLE TO BE LOADED +* 1234567890 +NAME DC CL07'TBLADDR' NAME OF THE REXX VARIABLE +NAMELEN DC F'07' LENGTH OF THE VARIABLE NAME +VALUE DC F'0' VARIABLE VALUE +VALUELEN DC F'4' LENGTH OF THE VARIABLE VALUE +NAMEPTR DC A(NAME) POINTER TO THE VARIABLE NAME +VALUEPTR DC A(VALUE) POINTER TO THE VARIABLE VALUE +TOKEN DC F'0' TOKEN (UNUSED HERE) +ECODE DC A(TSVEUPDT) ENTRY CODE FOR SETTING VALUES +SAVEAREA DS 18F + END + +./ ADD NAME=PkgMaint + /* REXX */ +/* THESE ROUTINES ARE DISTRIBUTED BY THE CA TECHNOLOGIES STAFF + "AS IS". NO WARRANTY, EITHER EXPRESSED OR IMPLIED, IS MADE + FOR THEM. CA TECHNOLOGIES CANNOT GUARANTEE THAT THE ROUTINES + ARE ERROR FREE, OR THAT IF ERRORS ARE FOUND, THEY WILL BE + CORRECTED. +*/ + TRACE O ; + + ADDRESS ISPEXEC + "VGET (ZSCREEN) SHARED" + ADDRESS ISPEXEC + "TBSTATS C1"ZSCREEN"P0200 STATUS1(STATUS1) STATUS2(STATUS2)" + +/* for table status... */ +/* 1 = table exists in the table input library chain */ +/* 2 = table does not exist in the table input library chain */ +/* 3 = table input library is not allocated. */ +/* */ +/* 1 = table is not open in this logical screen */ +/* 2 = table is open in NOWRITE mode in this logical screen */ +/* 3 = table is open in WRITE mode in this logical screen */ +/* 4 = table is open in SHARED NOWRITE mode in this logical screen*/ +/* 5 = table is open in SHARED WRITE mode in this logical screen. */ +/* */ + IF STATUS2 /= 2 & STATUS2 /= 3 & STATUS2 /= 4 then, + do + say "Must invoke PMAINT from a ", + "Package list Screen (C1SP0200)" ; + exit ; + end; + + "TBQUERY C1"ZSCREEN"P0200 KEYS(KEYLIST) NAMES(VARLIST) ROWNUM(ROWNUM)" + IF RC > 0 THEN EXIT + + ROWNUM = Strip(ROWNUM,'L','0') + + VARWKCMD = "" ; + "VGET (C1BJC1 C1BJC2 C1BJC3 C1BJC4) PROFILE " + + "DISPLAY PANEL(PMAINTPN) " + if rc > 0 then exit + "VPUT (C1BJC1 C1BJC2 C1BJC3 C1BJC4) PROFILE " + + SCL_DSN = USERID()".TEMPSCL.PKGMAINT" + PDVINCJC = "Y" + PDVSCLDS = SCL_DSN ; + PDVDD01 = "//DELETEME DD DSN="SCL_DSN",DISP=(OLD,DELETE)" + + ADDRESS TSO, + "ALLOC F(PKGESCL) DA('"SCL_DSN"')", + "LRECL(80) BLKSIZE(8000) SPACE(5,5)", + "RECFM(F B) TRACKS ", + "MOD CATALOG REUSE " ; + + "TBTOP C1"ZSCREEN"P0200 " + Do row = 1 to ROWNUM + "TBSKIP C1"ZSCREEN"P0200 " + cmd = " "ACTION "PACKAGE '"VPHPKGID"' ." + queue cmd + End; /* do row = 1 to ROWNUM */ + + ADDRESS TSO "EXECIO" QUEUED() "DISKW PKGESCL ( FINIS" + ADDRESS TSO "FREE F(PKGESCL)" + + "FTOPEN TEMP" + "FTINCL ENSP1000" + + "FTCLOSE " + + "VGET (ZUSER ZTEMPF ZTEMPN) ASIS" ; + DEBUG = 'YES' ; + DEBUG = 'NAW' ; + X = OUTTRAP("OFF") + IF DEBUG = 'YES' THEN, + DO + ADDRESS ISPEXEC "LMINIT DATAID(DDID) DDNAME(&ZTEMPN)" + ADDRESS ISPEXEC "EDIT DATAID(&DDID)" + ADDRESS ISPEXEC "LMFREE DATAID(&DDID)" + END; + ELSE, + DO + ADDRESS TSO "SUBMIT '"ZTEMPF"'" ; + END; + + exit + + +./ ADD NAME=PMAINTPN +)ATTR DEFAULT(%+_) +/*---------------------------------------------------------------------- +/* (C) 2002 Computer Associates International, Inc. +/*---------------------------------------------------------------------- + › TYPE(OUTPUT) INTENS(HIGH) JUST(RIGHT) + | TYPE(OUTPUT) INTENS(LOW) + _ TYPE(INPUT) INTENS(HIGH) PADC(_) CAPS(ON) + ¬ TYPE(INPUT) CAPS(&VARCACCI) FORMAT(&VARFMCCI) PADC(_) + ` TYPE(INPUT) CAPS(&VARCACOM) FORMAT(&VARFMCOM) PADC(_) + ~ TYPE(INPUT) CAPS(&VARCADES) FORMAT(&VARFMDES) PADC(_) +)BODY +%------------------------ ENDEVOR Package(s) Maintenance ---------------------- +%Command ===>_VARWKCMD ++ ++ Action :_ACTION + <- COMMIT,RESET,DELETE for ›ROWNUM+Packages ++ ++ Complete the JCL JOB card and press%ENTER+to submit the jobstream. ++ Enter the%END+command to terminate the submit. ++ ++ ++ _C1BJC1 + ++ _C1BJC2 + ++ _C1BJC3 + ++ _C1BJC4 + ++ +% ++ (PRESS%ENTER+ or%PF3+TO CANCEL OR END) ++ +)INIT + &ACTION = 'COMMIT' +)PROC + VER (&ACTION,LIST,COMMIT,RESET,DELETE) +)END + +./ ADD NAME=CIUU02 +CIUU020I '&PACKAGE CREATED' .ALARM=NO +'** Package &PACKAGE has been created*** ' +CIUU021I 'CAST &PACKAGE ' .ALARM=NO +'** &PACKAGE will be CAST by submitted batch job*** ' +CIUU024E 'PACKAGE RESET IS RESTRICTED' .ALARM=NO +'** An APPROVED Package cannot be RESET *** ' +CIUU025I '*Select Elems for Packageing' .ALARM=YES +'**Use this screen to select elements for Package processing**' +CIUU026E 'Incorrect Date field' .ALARM=NO +'** A date field is in an incorrect format*** ' +CIUU027E 'Incorrect Prod Date ' .ALARM=NO +'** Production date field is in an incorrect format*** ' +CIUU029E 'Must use PACKAGE Tool' .ALARM=NO +'** You must use the PACKAGE tool to create new packages ** ' + diff --git a/endevor/Field-Developed-Programs/Processor-Tools-and-Processor-Snippets/Native Stored Procedures/DB2MASK2 Rexx- builds more of the DB2 commands for the SP.txt b/endevor/Field-Developed-Programs/Processor-Tools-and-Processor-Snippets/Native Stored Procedures/DB2MASK2 Rexx- builds more of the DB2 commands for the SP.txt new file mode 100644 index 0000000..6aab188 --- /dev/null +++ b/endevor/Field-Developed-Programs/Processor-Tools-and-Processor-Snippets/Native Stored Procedures/DB2MASK2 Rexx- builds more of the DB2 commands for the SP.txt @@ -0,0 +1,146 @@ +/* REXX */ + + TRACE Off + +/* Performs masking on DB2 DDL statements */ +/* Variable names in mask may use an underscore to */ +/* replace values preceeded by multiple words. */ +/* Masking characters: */ +/* */ +/* ? Copies a corresponding single character from source */ +/* field to target field */ +/* */ +/* * Copies 0 or more corresponding source characters */ +/* to target field */ +/* */ +/* - Removes the single character */ +/* */ + + WhatDDName = 'DB2MASK2' +/* If DB2MASK# is allocated? If yes, then turn on Trace */ + isItThere = , + BPXWDYN("INFO FI(EDCHKDD) INRTDSN(DSNVAR) INRDSNT(myDSNT)") + If isItThere = 0 then Trace r + MY_RC = 0 + + /* DB2 Masking routine for named output */ + /* and possible output appending */ + Arg MYOUTDD + + Mask. = '' + /* Cature Mask names ane values */ + /* Read Endevor's Masking rules in the MASKING data */ + "EXECIO * DISKR MASKING (STEM mask. FINIS " + + ListMaskWords = '' + Do m# = 1 to mask.0 + msk = Strip(mask.m#) + posEqual = Pos('=',msk) + if posEqual = 0 then iterate ; + msk = overlay(' ',msk,posEqual) + text = Substr(msk,1,(posEqual-1)) + if Words(text)/= 1 then iterate + MaskWord = Word(msk,1) + Upper MaskWord + ListMaskWords = ListMaskWords MaskWord + posValue = Wordindex(msk,2) + MaskValue = Strip(Substr(msk,posValue)) + Say 'Found Mask for' MaskWord '=' MaskValue + MaskValue = Strip(MaskValue,"B",'"') + MaskValue = Strip(MaskValue,"B","'") + Mask.MaskWord = MaskValue + End ; /* Do m# = 1 to mask.0 */ + + Say Copies('-',70) + + /* Apply mask values to Bind statement */ + /* Read the DB2#STMT */ + "EXECIO * DISKR DB2#STMT (Stem db2. Finis " + /* Scan each line of the Bind Statement */ + Do b# = 1 to db2.0 + DB2Statement = db2.b# + If Words(DB2Statement) = 0 then Iterate ; + + /* Scan each Word of the Bind Statement */ + Do m# = 1 to Words(ListMaskWords) + MaskWord = Word(ListMaskWords,m#) + SrchWord = Translate(MaskWord,' ','_') || ' ' + WhereMaskString = Pos(SrchWord,DB2Statement) + If WhereMaskString < 1 then Iterate + OrigMask = Mask.MaskWord + Mask = OrigMask + If Mask = '' then iterate + Call DoSubstitution + Leave + End; /* Do m# = 1 to Words(ListMaskWords) */ + + End /* Do b# = 1 to db2.0 */ + + /* Write masked output to MYOUTDD */ + /* (Do not close output to allow appending of data */ + "EXECIO * DISKW" MYOUTDD "(Stem db2. " + + EXIT (MY_RC) ; + +DoSubstitution : + + Say 'Before:' DB2Statement + Sa= DB2Statement + Sa= WhereMaskString + Sa= MaskWord + + /* Find Starting and Ending positions of the clause */ + /* to be masked */ + maskEnd = WhereMaskString + length(MaskWord) - 1 + ValueStarts = , + maskEnd + WordIndex(Substr(DB2Statement, maskEnd+1),1) + BeforeChange = Word(Substr(DB2Statement, ValueStarts),1) + valueEnd = ValueStarts + Length(BeforeChange) - 1 + + /* Apply Mask to clause within the DB2 bind */ + /* This routine applies values in 'Mask' */ + /* to the value in 'BeforeChange' */ + SupportedWildCards = '?*-' + AfterChange = BeforeChange + + If Mask = ' ' then Mask ='*' ; + Howlong = Length(Mask) + Length(AfterChange) + Do char# = 1 to Howlong + Maskchar = Substr(Mask,char#,1) ; + If maskchar = " " then Leave ; + If maskchar = "?" then iterate ; + If maskchar = "*" then, + Do + tail = Substr(Mask,char# + 1) + Mask = AfterChange || tail; + char# = Max(char#,length(AfterChange) ) + Iterate ; + End; + If maskchar = "-" then, + Do + tail = Substr(AfterChange,char# + 1) + if char# > 1 then, + head = Substr(AfterChange,1,char# - 1) + else, + head = '' + AfterChange = head || tail; + Iterate ; + End; + Maskchar = Substr(Mask,char#,1) ; + AfterChange = Overlay(Maskchar,AfterChange,char#) + If char# = Length(Mask) then, + AfterChange = Substr(AfterChange,1,char#) + End /* Do char# = 1 to Length(Mask) */ + + say 'Mask:' OrigMask + If ValueStarts > 1 then, + head = Substr(DB2Statement,1,ValueStarts -1) + Else head = '' + DB2Statement = head || AfterChange || , + Strip(Substr(DB2Statement,valueEnd + 1 )); + Say 'After: ' DB2Statement + Say Copies('-',70) + + db2.b# = DB2Statement + + Return diff --git a/endevor/Field-Developed-Programs/Processor-Tools-and-Processor-Snippets/Native Stored Procedures/DB2SNAME Rexx- finds the create procedure line in the SP element.TXT b/endevor/Field-Developed-Programs/Processor-Tools-and-Processor-Snippets/Native Stored Procedures/DB2SNAME Rexx- finds the create procedure line in the SP element.TXT new file mode 100644 index 0000000..01fb02d --- /dev/null +++ b/endevor/Field-Developed-Programs/Processor-Tools-and-Processor-Snippets/Native Stored Procedures/DB2SNAME Rexx- finds the create procedure line in the SP element.TXT @@ -0,0 +1,18 @@ +/* REXX */ +/* Find Native Stored Procedure qualifier & name */ + Arg WhatDD + + "EXECIO * DISKR" WhatDD "( Stem Table. finis" + do # = 1 to Table.0 + A = Table.# + B = pos('CREATE PROCEDURE ',A) + if B > 0 then do + C = pos('.',A) + C = C + 1 + Value = substr(A,C,32) + Value = 'SPName ="' || Value || '"' + Say 'DB2SNAME:' Value + queue Value + exit + end + end diff --git a/endevor/Field-Developed-Programs/Processor-Tools-and-Processor-Snippets/Native Stored Procedures/DB2SPCHK Rexx- reads a SPUFI report to see if SP exists or is new.TXT b/endevor/Field-Developed-Programs/Processor-Tools-and-Processor-Snippets/Native Stored Procedures/DB2SPCHK Rexx- reads a SPUFI report to see if SP exists or is new.TXT new file mode 100644 index 0000000..1206437 --- /dev/null +++ b/endevor/Field-Developed-Programs/Processor-Tools-and-Processor-Snippets/Native Stored Procedures/DB2SPCHK Rexx- reads a SPUFI report to see if SP exists or is new.TXT @@ -0,0 +1,13 @@ +/* REXX */ +/*********************************************************************/ +/* THIS UTILITY READS A SUPFI BATCH REPORT TO DETERMINE IF A */ +/* STORED PROCEDURE EXISTS. */ +/* RC=0 MEANS THE STORED PROCEDURE IS NEW. RC=1 MEANS IT EXISTS */ +/*********************************************************************/ + 'EXECIO * DISKR FILEIN (STEM TABLE.' + DO # = 1 TO TABLE.0 + IF POS('| 0 |',TABLE.#) > 0 THEN EXIT(0) + IF POS('| 1 |',TABLE.#) > 0 THEN EXIT(1) + END + SAY 'DB2SPCHK REXX ERROR: DID NOT FIND REPORT LINE' + EXIT(12) diff --git a/endevor/Field-Developed-Programs/Processor-Tools-and-Processor-Snippets/Native Stored Procedures/ELEMENT Native SP sample element type SQL.txt b/endevor/Field-Developed-Programs/Processor-Tools-and-Processor-Snippets/Native Stored Procedures/ELEMENT Native SP sample element type SQL.txt new file mode 100644 index 0000000..425fd2c --- /dev/null +++ b/endevor/Field-Developed-Programs/Processor-Tools-and-Processor-Snippets/Native Stored Procedures/ELEMENT Native SP sample element type SQL.txt @@ -0,0 +1,42 @@ + CREATE PROCEDURE ????????.YIPPIE_KAY_YAY + ( + OUT X CHAR(1) CCSID EBCDIC FOR SBCS DATA + ) + VERSION V1 + LANGUAGE SQL + DETERMINISTIC + MODIFIES SQL DATA + CALLED ON NULL INPUT + DYNAMIC RESULT SETS 0 + DISABLE DEBUG MODE + PARAMETER CCSID EBCDIC + QUALIFIER YourQualifier + PACKAGE OWNER YourOwner + ASUTIME LIMIT 1000 + COMMIT ON RETURN NO + INHERIT SPECIAL REGISTERS + WLM ENVIRONMENT FOR DEBUG MODE YourDb2WLM + CURRENT DATA NO + DEGREE 1 + DYNAMICRULES RUN + APPLICATION ENCODING SCHEME EBCDIC + WITHOUT EXPLAIN + WITHOUT IMMEDIATE WRITE + WITHOUT KEEP DYNAMIC + ISOLATION LEVEL CS + OPTHINT '' + RELEASE AT COMMIT + REOPT NONE + VALIDATE RUN + ROUNDING DEC_ROUND_HALF_EVEN + DATE FORMAT ISO + DECIMAL( 15 ) + FOR UPDATE CLAUSE REQUIRED + TIME FORMAT ISO + BUSINESS_TIME SENSITIVE YES + SYSTEM_TIME SENSITIVE YES + ARCHIVE SENSITIVE YES + APPLCOMPAT V12R1 + CONCENTRATE STATEMENTS OFF +RETURN X; + diff --git a/endevor/Field-Developed-Programs/Processor-Tools-and-Processor-Snippets/Native Stored Procedures/ENBPIU00 TableTool- comes with Endevor in CSIQCLS0.TXT b/endevor/Field-Developed-Programs/Processor-Tools-and-Processor-Snippets/Native Stored Procedures/ENBPIU00 TableTool- comes with Endevor in CSIQCLS0.TXT new file mode 100644 index 0000000..6522df8 --- /dev/null +++ b/endevor/Field-Developed-Programs/Processor-Tools-and-Processor-Snippets/Native Stored Procedures/ENBPIU00 TableTool- comes with Endevor in CSIQCLS0.TXT @@ -0,0 +1,2 @@ +See your site's CSIQCLS(ENBPIU00) member for the latest TableTool + diff --git a/endevor/Field-Developed-Programs/Processor-Tools-and-Processor-Snippets/Native Stored Procedures/ESYMBOLS symbolics used by MOVESQL processor.TXT b/endevor/Field-Developed-Programs/Processor-Tools-and-Processor-Snippets/Native Stored Procedures/ESYMBOLS symbolics used by MOVESQL processor.TXT new file mode 100644 index 0000000..03bee2f --- /dev/null +++ b/endevor/Field-Developed-Programs/Processor-Tools-and-Processor-Snippets/Native Stored Procedures/ESYMBOLS symbolics used by MOVESQL processor.TXT @@ -0,0 +1,57 @@ +ESYMBOLS TITLE 'SITE-WIDE SYMBOLICS TABLE' +*********************************************************************** +* COPYRIGHT (C) 2022 BROADCOM. ALL RIGHTS RESERVED. * +* NAME: ESYMBOLS * +* DESCRIPTION: Site-Wide Symbolics Definition Table * +* FUNCTION: Define symbolics for use in element type definitions * +* and processors. * +*********************************************************************** +* DEPLOY FOR TEST (D4T) MAPPING * +*********************************************************************** +* ATST (DEV) + $ESYMBOL SYMNAME=#ATSTD4T, X + SYMDATA='Y' + $ESYMBOL SYMNAME=#ATSTLDB, X + SYMDATA='Your.Team.DEV.ATST.LOADLIB' + $ESYMBOL SYMNAME=#ATSTLDC, X + SYMDATA='Your.Team.DEV.ATST.CICSLOAD' + $ESYMBOL SYMNAME=#ATSTLST, X + SYMDATA='Your.Team.DEV.ATST.LISTLIB' + $ESYMBOL SYMNAME=#ATSTDBR, X + SYMDATA='Your.Team.DEV.ATST.DBRM' +* BTST (DEV) + $ESYMBOL SYMNAME=#BTSTD4T, X + SYMDATA='Y' + $ESYMBOL SYMNAME=#BTSTLDB, X + SYMDATA='Your.Team.DEV.BTST.LOADLIB' + $ESYMBOL SYMNAME=#BTSTLDC, X + SYMDATA='Your.Team.DEV.BTST.CICSLOAD' + $ESYMBOL SYMNAME=#BTSTLST, X + SYMDATA='Your.Team.DEV.BTST.LISTLIB' + $ESYMBOL SYMNAME=#BTSTDBR, X + SYMDATA='Your.Team.DEV.BTST.DBRM' +* CTST (DEV) + $ESYMBOL SYMNAME=#CTSTD4T, X + SYMDATA='Y' + $ESYMBOL SYMNAME=#CTSTLDB, X + SYMDATA='Your.Team.DEV.CTST.LOADLIB' + $ESYMBOL SYMNAME=#CTSTLDC, X + SYMDATA='Your.Team.DEV.CTST.CICSLOAD' + $ESYMBOL SYMNAME=#CTSTLST, X + SYMDATA='Your.Team.DEV.CTST.LISTLIB' + $ESYMBOL SYMNAME=#CTSTDBR, X + SYMDATA='Your.Team.DEV.CTST.DBRM' +* +* +* +*Symbol Definition Examples: * +* +* Example DSN High Level Qualifier: + $ESYMBOL SYMNAME=#HLQ,SYMDATA='Your.Application.HLQ' +* +* +*********************************************************************** +* LAST INVOCATION - END THE TABLE GENERATION +*---------------------------------------------------------------------* + $ESYMBOL CALL=END + END diff --git a/endevor/Field-Developed-Programs/Processor-Tools-and-Processor-Snippets/Native Stored Procedures/MOVESQL Move Processor for type SQL.TXT b/endevor/Field-Developed-Programs/Processor-Tools-and-Processor-Snippets/Native Stored Procedures/MOVESQL Move Processor for type SQL.TXT new file mode 100644 index 0000000..740298c --- /dev/null +++ b/endevor/Field-Developed-Programs/Processor-Tools-and-Processor-Snippets/Native Stored Procedures/MOVESQL Move Processor for type SQL.TXT @@ -0,0 +1,234 @@ +//******************************************************************** +//MOVESQL PROC AAA=, +// CSIQCLS0='Your.Endevor.CSIQCLS0', +// HLQ='Your.Team', +// PFXS='&HLQ..&C1SSTAGE..&C1SSUBSYS.', +// PFXT='&HLQ..&C1STAGE..&C1SU.', +// REXXLIB='Your.Team.$REXX', +// SHOWME='Y', +// SITEDBR='&#&C1SUBSYS.DBR', DBRM +// SITESQL='&#&C1SUBSYS.SQL', Deploy for Test Target Dsn +// SITETRG='&#&C1SUBSYS.D4T', Deploy for Test Target Y/N +// SQL#SRC='&PFXS..SQL', Sending SQL library +// SQL#TRG='&PFXT..SQL', Target SQL library +// TUNIT='VIO', UNIT FOR TEMP DSNS +// ZZZ= +//* +//**=================================================================** +// IF (&SITETRG = 'Y') THEN +//********************************************************************** +//* Going to do "masking" of the SQL. +//* Get The YAML controls for this System +//********************************************************************** +//GETYAML EXEC PGM=CONWRITE,PARM='EXPINCL(Y)',MAXRC=0 MOVESQL +//YAMLDB2 DD DSN=&&YAMLDB2,DISP=(,PASS), +// SPACE=(TRK,(1,5)),UNIT=SYSDA, +// DCB=(RECFM=FB,LRECL=180,BLKSIZE=7200) +//CONWIN DD * +WRITE ELEMENT &C1SY + FROM ENV &C1EN SYS &C1SY SUB &C1SSUBSYS + TYPE YAML STAGE &C1STGID + TO DDN YAMLDB2 + OPTION SEARCH . +/* +//**=================================================================** +//BILDMASK EXEC PGM=IRXJCL, +// PARM='ENBPIU00 PARMLIST',MAXRC=4,COND=(4,LE) +//SYSEXEC DD DISP=SHR,DSN=&CSIQCLS0 +// DD DISP=SHR,DSN=&REXXLIB +//SYSTSPRT DD SYSOUT=* +//PARMLIST DD * + NOTHING NOTHING OPTIONS 0 + MASKMODL MASKING OPTIONS1 A + BPIOPIN BPIOPOUT OPTIONS1 A + CONNECTI CONNECTO OPTIONS1 A + DROPIN DROPOUT OPTIONS1 A + SPUFIIN SPUFIOUT OPTIONS1 A +//TABLE DD * +* Do + * +//YAMLDB2 DD DSN=&&YAMLDB2,DISP=(OLD,DELETE) +//YAML2REX DD DUMMY <- Turn on/off Trace +//SQLSRC DD DISP=SHR,DSN=&SQL#SRC(&C1ELEMENT) +//OPTIONS DD * <- Convert YAML to REXX +* Convert YAML to REXX ** + Call YAML2REX 'YAMLDB2' + HowManyYamls = QUEUED(); + If HowManyYamls < 1 then, + + Do; Say 'YAML2REX: Not finding any Rexx converted from YAML'; + + Exit(8); + + End; + Say 'HowManyYamls=' HowManyYamls + Do yaml# =1 to HowManyYamls; + + Parse pull yaml2rexx; + + Interpret yaml2rexx ; + + End + Call DB2SNAME 'SQLSRC' + Lines = QUEUED(); + Do Loop# =1 to Lines; + + Parse pull SPName; + + Interpret SPName ; + + End +//OPTIONS1 DD * +* Now build Outputs from Rexx created from YAML + thisDB2_Subsytem_ID = Value('&C1SY..&C1SU..DB2_Subsytem_ID') + thisSQLID = USERID() + thisOWNER = Value('&C1SY..&C1SU..Bind_Owner_Target_Pattern') + thisQUALIFIER = Value('&C1SY..&C1SU..Bind_Qualifier_Target_Pat') + thisSchema = Value('&C1SY..&C1SU..Schema_Target_Pattern') + thisSPName = Value('SPName') + VERSION = '&VERSION' + NAME = '&ELEMENT' +//****** MASKING ************************************************ +//MASKMODL DD * <-Build 'MASK' for DB2 + CONNECT = '&thisDB2_Subsytem_ID' + PACKAGE_OWNER = '&thisOWNER' + QUALIFIER = '&thisQUALIFIER' + CREATE_PROCEDURE = '&thisSchema.&thisSPName ' +//MASKING DD DSN=&&MASKING,DISP=(,PASS), <-Output Mask +// SPACE=(TRK,(1,1)),UNIT=SYSDA, +// LRECL=080,RECFM=FB,BLKSIZE=0 +//****** BPIOPT ************************************************* +//BPIOPIN DD * <-BPIOPT input +.CONTROL BPID(PTIDEVL.VIRTUEL.DB2-JPMCSP) + + LOGID(&thisDB2_Subsytem_ID) UNIT(SYSDA) +.LIST SYSOUT(A) +.OPTION ERRORS NOSQLERRORS RETRY(04) NOBINDERRORS + + SQLFORMAT(SQL) +.RESTART SYNC +.CONNECT &thisDB2_Subsytem_ID +//BPIOPOUT DD DSN=&&BPIOPT,DISP=(,PASS), <-DBTool cntlcard +// SPACE=(TRK,(1,1)),UNIT=SYSDA, +// LRECL=080,RECFM=FB,BLKSIZE=0 +//****** CONNECT command ************************************** +//CONNECTI DD * +.CONNECT &thisDB2_Subsytem_ID +//CONNECTO DD DSN=&&CONNECT(CONNECT),DISP=(,PASS), <-CONNECT +// SPACE=(TRK,(1,1,5)),UNIT=SYSDA, +// DCB=(LRECL=080,RECFM=FB,BLKSIZE=0,DSORG=PO) +//****** DROP & COMMIT used by existing Stored Procedures **** +//DROPIN DD * <-Build DROP & COMMIT + DROP PROCEDURE &thisSchema.&thisSPName ; + COMMIT ; +//DROPOUT DD DSN=&&DROP(DROP),DISP=(,PASS), <-DROP & COMMIT +// SPACE=(TRK,(1,1,5)),UNIT=SYSDA, +// DCB=(LRECL=080,RECFM=FB,BLKSIZE=0,DSORG=PO) +//****** SPUFI- used to check status of a Stored Procedure **** +//SPUFIIN DD * <-Build DROP & COMMIT + SELECT COUNT(*) + FROM SYSIBM.SYSROUTINES A + WHERE A.SCHEMA = '&thisSchema' + AND A.NAME = '&thisSPName' +//SPUFIOUT DD DSN=&&SPUFI,DISP=(,PASS), <-SPUFI check command +// SPACE=(TRK,(1,1)),UNIT=SYSDA, +// DCB=(LRECL=080,RECFM=FB,BLKSIZE=0) +//*-------------------------------------------------------------------* +//* SHOWME: DISPLAY the MASK values +//*-------------------------------------------------------------------* +//SHOWME EXEC PGM=IEBGENER,COND=(4,LE) MOVESQL +//SYSPRINT DD DUMMY +//SYSUT1 DD * + ************ Mask **************** +// DD DSN=&&MASKING,DISP=(OLD,PASS) +// DD * + ************ BPIOPT ************** +// DD DSN=&&BPIOPT,DISP=(OLD,PASS) +// DD * + ************ DROP **************** +// DD DSN=&&DROP(DROP),DISP=(OLD,PASS) +// DD * + ************ CONNECT ************* +// DD DSN=&&CONNECT(CONNECT),DISP=(OLD,PASS) +// DD * + ************ SPUFI ************* +// DD DSN=&&SPUFI,DISP=(OLD,PASS) +//SYSUT2 DD SYSOUT=* +//SYSIN DD DUMMY +//*-------------------------------------------------------------------* +//* Apply DB2 Masking (if necessary) +//*-------------------------------------------------------------------* +//DB2MASK EXEC PGM=IRXJCL,PARM='DB2MASK2 DB2#NEW', MOVESQL +// MAXRC=4,COND=(4,LE) +//MASKING DD DSN=&&MASKING,DISP=(OLD,DELETE) +//SYSEXEC DD DISP=SHR,DSN=&REXXLIB +//SYSTSPRT DD SYSOUT=* +//DB2MASK2 DD DUMMY +//SHOWME DD SYSOUT=* +//DB2#STMT DD DISP=SHR,DSN=&SQL#SRC(&C1ELEMENT) <-In +//DB2#NEW DD DISP=SHR,DSN=&SQL#TRG(&C1ELEMENT), <-Out +// MONITOR=COMPONENTS,FOOTPRNT=CREATE +//*-------------------------------------------------------------------* +//* SPUFI batch to check status of the Stored Procedure +//*-------------------------------------------------------------------* +//SPUFI EXEC PGM=IKJEFT01,COND=(4,LE) +//STEPLIB DD DISP=SHR,DSN=Your.Db2.SNSNLOAD +//SYSTSPRT DD DUMMY +//SYSPRINT DD DSN=&&SPUFIRPT,DISP=(,PASS),SPACE=(TRK,(1,1)), +// UNIT=VIO,DCB=(RECFM=FB,LRECL=133,BLKSIZE=0) +//SYSUDUMP DD SYSOUT=* +//SYSTSIN DD * + DSN 'SYSTEM(YourDb2SubSys) + RUN PROGRAM(DSNTEP2) PLAN(DSNTEP12) LIB('Your.Db2.SPUFI.RUNLIB') + + PARMS('/ALIGN(MID)') + END +//SYSIN DD DSN=&&SPUFI,DISP=(OLD,DELETE) +//* +//**************************************************************** +//* THIS UTILITY READS A SUPFI BATCH REPORT TO DETERMINE IF A * +//* STORED PROCEDURE EXISTS. * +//* RC=0 MEANS THE STORED PROCEDURE IS NEW. RC=1 MEANS IT EXISTS * +//**************************************************************** +//SPCHECK EXEC PGM=IKJEFT1B,PARM='%DB2SPCHK',COND=(4,LE),MAXRC=1 +//SYSEXEC DD DISP=SHR,DSN=Your.Team.$REXX +//SYSTSPRT DD DUMMY +//SYSPRINT DD DUMMY +//SYSTSIN DD DUMMY +//SYSIN DD DUMMY +//FILEIN DD DSN=&&SPUFIRPT,DISP=(OLD,DELETE) +//* +//*-------------------------------------------------------------------* +//* Broadcom's DB Tools to refresh/create the Stored Procedure +//*-------------------------------------------------------------------* +//DBTOOLS EXEC PGM=PTLDRIVM,PARM='EP=BPLBCTL', +// MAXRC=4,COND=(4,LE) +//****** This is for brand new Stored Procedures +// IF (SPCHECK.RC EQ 0) THEN +//BPIIPT DD DSN=&&CONNECT(CONNECT),DISP=(OLD,DELETE) +// DD DISP=SHR,DSN=&SQL#TRG(&C1ELEMENT) +//***ELSE this SP exists / active +// ELSE +//BPIIPT DD DSN=&&CONNECT(CONNECT),DISP=(OLD,DELETE) +// DD DSN=&DROP(DROP),DISP=(OLD,DELETE) +// DD DISP=SHR,DSN=&SQL#TRG(&C1ELEMENT) +// ENDIF +//BPIOPT DD DSN=&&BPIOPT,DISP=(OLD,DELETE) <- DBTOOLs cntlcard +//STEPLIB DD DISP=SHR,DSN=Your.DBTools.CDBALOAD +// DD DISP=SHR,DSN=Your.Db2.SNSNEXIT +// DD DISP=SHR,DSN=Your.Db2.SNSNLOAD +//PTILIB DD DISP=SHR,DSN=Your.DBTools.CDBALOAD +// DD DISP=SHR,DSN=Your.Db2.SNSNEXIT +// DD DISP=SHR,DSN=Your.Db2.SNSNLOAD +//PTIPARM DD DISP=SHR,DSN=Your.DBTools.CDBAPARM +//PTIXMSG DD DISP=SHR,DSN=Your.DBTools.CDBAXMSG +//SYSOUT DD SYSOUT=* +//PTIIMSG DD SYSOUT=* +//UTPRINT DD SYSOUT=* +//ABNLIGNR DD DUMMY SUPPRESS ABENDAID DUMPS +//SYSUT1 DD UNIT=SYSDA,SPACE=(CYL,(30,30)) +//SYSREC DD UNIT=SYSDA,SPACE=(TRK,(1,1)) +//* +//******************************************************************* +// ELSE +//********************************************************************* +//* READ SOURCE AND EXPAND INCLUDES +//********************************************************************* +//CONWRITE EXEC PGM=CONWRITE,MAXRC=0, <- Write to D4T/stage library +// PARM='EXPINCL(Y)' +//ELMOUT DD DSN=&SQL#TRG, (&C1ELEMENT) +// MONITOR=COMPONENTS,DISP=SHR, +// FOOTPRNT=CREATE +//SYSUT3 DD UNIT=&TUNIT,SPACE=(TRK,(1,1)) +//SYSUT4 DD UNIT=&TUNIT,SPACE=(TRK,(1,1)) +//SYSPRINT DD SYSOUT=* +// ENDIF +//**=================================================================** diff --git a/endevor/Field-Developed-Programs/Processor-Tools-and-Processor-Snippets/Native Stored Procedures/Native SQL YAML control card.txt b/endevor/Field-Developed-Programs/Processor-Tools-and-Processor-Snippets/Native Stored Procedures/Native SQL YAML control card.txt new file mode 100644 index 0000000..507efcc --- /dev/null +++ b/endevor/Field-Developed-Programs/Processor-Tools-and-Processor-Snippets/Native Stored Procedures/Native SQL YAML control card.txt @@ -0,0 +1,56 @@ +# DB2 for system FINANCE at Endevor Deploy4Test locations + FINANCE: + ATST : + DB2_Subsytem_ID : 'D12A' + Bind_Owner_Target_Pattern : '*' + Plan_Name_Target_Pattern : '*A' + Bind_Qualifier_Target_Pat : '*_0A' + Schema_Target_Pattern : 'DH892841' + BTST : + DB2_Subsytem_ID : 'D12A' + Bind_Owner_Target_Pattern : 'BBADBA' + Plan_Name_Target_Pattern : '*B' + Bind_Qualifier_Target_Pat : '*_0B' + Schema_Target_Pattern : 'DH892841' + CTST : + DB2_Subsytem_ID : 'D12A' + Bind_Owner_Target_Pattern : '*' + Plan_Name_Target_Pattern : '*C' + Bind_Qualifier_Target_Pat : '*_0C' + Schema_Target_Pattern : 'DH892841' + CICSAL01: + DB2_Subsytem_ID : 'D01G' + Bind_Owner_Target_Pattern : 'ACEDBA' + Plan_Name_Target_Pattern : '*1' + Bind_Qualifier_Target_Pat : '*_01' + Schema_Target_Pattern : 'SCHM11' + CICSAL02: + DB2_Subsytem_ID : 'D01G' + Bind_Owner_Target_Pattern : 'ACEDBA' + Plan_Name_Target_Pattern : '*2' + Bind_Qualifier_Target_Pat : '*_02' + Schema_Target_Pattern : 'SCHM11' + CICSAL03: + DB2_Subsytem_ID : 'D03G' + Bind_Owner_Target_Pattern : 'ACEDBA' + Plan_Name_Target_Pattern : '*5' + Bind_Qualifier_Target_Pat : '*_05' + Schema_Target_Pattern : 'SCHM11' + CICSAL06: + DB2_Subsytem_ID : 'D01G' + Bind_Owner_Target_Pattern : 'ACEDBA' + Plan_Name_Target_Pattern : '*3' + Bind_Qualifier_Target_Pat : '*_03' + Schema_Target_Pattern : 'SCHM11' + CICSAL07: + DB2_Subsytem_ID : 'D01G' + Bind_Owner_Target_Pattern : 'ACEDBA' + Plan_Name_Target_Pattern : '*4' + Bind_Qualifier_Target_Pat : '*_04' + Schema_Target_Pattern : 'SCHM11' + CICSAL51: + DB2_Subsytem_ID : 'D03G' + Bind_Owner_Target_Pattern : 'ACEDBA' + Plan_Name_Target_Pattern : '*6' + Bind_Qualifier_Target_Pat : '*_06' + Schema_Target_Pattern : 'SCHM11' diff --git a/endevor/Field-Developed-Programs/Processor-Tools-and-Processor-Snippets/Native Stored Procedures/README.MD b/endevor/Field-Developed-Programs/Processor-Tools-and-Processor-Snippets/Native Stored Procedures/README.MD new file mode 100644 index 0000000..b1c017c --- /dev/null +++ b/endevor/Field-Developed-Programs/Processor-Tools-and-Processor-Snippets/Native Stored Procedures/README.MD @@ -0,0 +1,28 @@ +# Native Stored Procedures + +These are examples for Native Stored Procedures (SP) under Endevor + +These samples are provided as is and are not officially supported (see [license](https://github.com/BroadcomMFD/broadcom-product-scripts/blob/main/LICENSE +) for more information). + + + +**Member** Description + +**ELEMENT** Native SP sample element / type SQL + +**YAML** Native SP control table sample element / type YAML + +**MOVESQL** Move Processor (Deploy for Test) for type SQL + +**ESYMBOLS** ESYMBOLS- symbolics used by MOVESQL processor + +**YAML2REX** Rexx- main driver for building DB2 commands for the SP - [here](https://github.com/BroadcomMFD/broadcom-product-scripts/blob/main/endevor/Field-Developed-Programs/Processor-Tools-and-Processor-Snippets/YAML2REX.rex) + +**DB2MASK2** Rexx- builds more of the DB2 commands for the SP + +**DB2SNAME** Rexx- finds the 'create procedure' line in the SP element + +**DB2SPCHK** Rexx- reads a SPUFI report to see if SP exists or is new + +**ENBPIU00** TableTool- comes with Endevor in CSIQCLS0 \ No newline at end of file diff --git a/endevor/Field-Developed-Programs/Processor-Tools-and-Processor-Snippets/Native Stored Procedures/YAML Native SP control table sample element type YAML.txt b/endevor/Field-Developed-Programs/Processor-Tools-and-Processor-Snippets/Native Stored Procedures/YAML Native SP control table sample element type YAML.txt new file mode 100644 index 0000000..d8438c1 --- /dev/null +++ b/endevor/Field-Developed-Programs/Processor-Tools-and-Processor-Snippets/Native Stored Procedures/YAML Native SP control table sample element type YAML.txt @@ -0,0 +1,56 @@ +# DB2 for system FINANCE at Endevor's Deploy For Test locations (ATST, BTST, etc.) + FINANCE: + ATST : + DB2_Subsytem_ID : 'D12A' + Bind_Owner_Target_Pattern : '*' + Plan_Name_Target_Pattern : '*A' + Bind_Qualifier_Target_Pat : '*_0A' + Schema_Target_Pattern : 'IBMUSER' + BTST : + DB2_Subsytem_ID : 'D12A' + Bind_Owner_Target_Pattern : 'BBADBA' + Plan_Name_Target_Pattern : '*B' + Bind_Qualifier_Target_Pat : '*_0B' + Schema_Target_Pattern : 'IBMUSER' + CTST : + DB2_Subsytem_ID : 'D12A' + Bind_Owner_Target_Pattern : '*' + Plan_Name_Target_Pattern : '*C' + Bind_Qualifier_Target_Pat : '*_0C' + Schema_Target_Pattern : 'IBMUSER' + CICSAL01: + DB2_Subsytem_ID : 'D01G' + Bind_Owner_Target_Pattern : 'ACEDBA' + Plan_Name_Target_Pattern : '*1' + Bind_Qualifier_Target_Pat : '*_01' + Schema_Target_Pattern : 'IBMUSER' + CICSAL02: + DB2_Subsytem_ID : 'D01G' + Bind_Owner_Target_Pattern : 'ACEDBA' + Plan_Name_Target_Pattern : '*2' + Bind_Qualifier_Target_Pat : '*_02' + Schema_Target_Pattern : 'IBMUSER' + CICSAL03: + DB2_Subsytem_ID : 'D03G' + Bind_Owner_Target_Pattern : 'ACEDBA' + Plan_Name_Target_Pattern : '*5' + Bind_Qualifier_Target_Pat : '*_05' + Schema_Target_Pattern : 'IBMUSER' + CICSAL06: + DB2_Subsytem_ID : 'D01G' + Bind_Owner_Target_Pattern : 'ACEDBA' + Plan_Name_Target_Pattern : '*3' + Bind_Qualifier_Target_Pat : '*_03' + Schema_Target_Pattern : 'IBMUSER' + CICSAL07: + DB2_Subsytem_ID : 'D01G' + Bind_Owner_Target_Pattern : 'ACEDBA' + Plan_Name_Target_Pattern : '*4' + Bind_Qualifier_Target_Pat : '*_04' + Schema_Target_Pattern : 'IBMUSER' + CICSAL51: + DB2_Subsytem_ID : 'D03G' + Bind_Owner_Target_Pattern : 'ACEDBA' + Plan_Name_Target_Pattern : '*6' + Bind_Qualifier_Target_Pat : '*_06' + Schema_Target_Pattern : 'IBMUSER'