<-- Generated by ISPFHTML -->
Panel ISREDDE2
   File  Edit  Edit_Settings  Menu  Utilities  Compilers  Test  Help            
 -------------------------------------------------------------------------------
 VIEW       TSOUSER.ISPF.EXEC(MG) - 01.08                             MG active
 Command ===>                                                  Scroll ===> CSR 
 ****** ***************************** Top of Data ******************************
 000100 /* REXX ***************************************************************/
 000200 /*                                                                    */
 000300 /* MG  Member Generations                                             */
 000400 /*                                                                    */
 000500 /* Purpose: automatic backup for every version of a member            */
 000600 /*          (without z/OS PDS Member Generation Feature, since        */
 000700 /*           MAXGENS_LIMIT=0)                                         */
 000800 /*                                                                    */
 000900 /* This feature can be switch on/off like an initial macro for an     */
 001000 /* entire PDS while editing. But it takes effect in the following     */
 001100 /* edit session.                                                      */
 001200 /*                                                                    */
 001300 /* Switch on:  IMACRO MG                                              */
 001400 /* Switch off: IMACRO NONE                                            */
 001500 /*                                                                    */
 001600 /* All backups will be stored in the same PDS under Z9* descending.   */
 001700 /*                                                                    */
 001800 /* Date      Change                                             Name  */
 001900 /* 20160601  implementation                                     UWi   */
 002000 /* 20160613  only for ISPF standard EDIT sessions               UWi   */
 002100 /* 20160614  avoid duplicates via ISRSUPC checksums             UWi   */
 002200 /* 20161208  use VIO datasets                                   UWi   */
 002300 /* 20161212  switch from keylist to initial macro               UWi   */
 002400 /* 20170209  ignore empty members                               UWi   */
 002500 /* 20170216  save the old version instead of the current one    UWi   */
 002600 /*                                                                    */
 002700 /**********************************************************************/
 002800 address isredit
 002900 "MACRO" ; if RC>0 then exit 0
 003000 address ispexec "VGET (ZEDTMCMD)"; ZEDTMCMD=translate(ZEDTMCMD)
 003100 "(DSN,V2,V3) = DATASET"; "(MBR) = MEMBER"; DSN="'"!!DSN!!"'"
 003200 "(TYP,SCLM)=SESSION"; "(CHANGED)=DATA_CHANGED"
 003300 "(LASTLINE)=LINENUM .ZLAST"
 003400 if wordpos(ZEDTMCMD,"MG SAVE END")>0 then do
 003500    if CHANGED="YES" & ZEDSAVE="SAVE" & LASTLINE>0 then ,
 003600       TMP=MBR_ARCHIVE(DSN,MBR)
 003700    if ZEDTMCMD<>"MG" then "BUILTIN "!!ZEDTMCMD
 003800    else if TYP="EDIT" & length(MBR)>0 then do
 003900       "DEFINE SAVE ALIAS MG"
 004000       "DEFINE END  ALIAS MG"
 004100       ZERRSM="MG active"
 004200       ZERRLM="Member Generations has been activated."
 004300       ZERRALRM='YES'; ZERRHM='*'
 004400       address ispexec "SETMSG MSG(ISRZ002)"
 004500    end /*<IF TYP="EDIT" & length(MBR)>0                              >*/
 004600 end /*<IF wordpos(ZEDTMCMD,"MG SAVE END")>0                          >*/
 004700 exit 0
 004800 
 004900 MBR_ARCHIVE: procedure
 005000 DSN=arg(1); MBR=arg(2); DS=SETDSNMBR(DSN,MBR)
 005100 if sysdsn(DS)<>'OK' then return 0
 005200 MGHEAD="~@"!!MBR!!"@"!!MBR_HASH(DSN,MBR)
 005300 SYSIN.0=1; SYSIN.1="SRCHFOR '"!!MGHEAD!!"'"
 005400 address tso
 005500 "ALLOC F(SYSIN) NEW CATALOG DSO(PS) UNIT(VIO)",
 005600  "SP(15,5) TRACK RECFM(F B) LRECL(80) REUSE"
 005700 "EXECIO * DISKW SYSIN (STEM SYSIN. FINIS)"
 005800 "ALLOC F(NEWDD) DA("!!DSN!!") SHR REUSE"
 005900 "ALLOC F(OUTDD) DUMMY"
 006000 address ispexec "SELECT PGM(ISRSUPC) PARM(SRCHCMP,ANYC)"
 006100 EXISTS=RC; "FREE F(NEWDD OUTDD SYSIN)"
 006200 if EXISTS<>1 then do /* 0=does not exist, EXISTS>1 is a failure       */
 006300    address ispexec
 006400    MGMBRSTART="Z9000000"; MGMBR=MGMBRSTART
 006500    "LMINIT DATAID(DID1) DATASET("!!DSN!!") ENQ(SHR)"
 006600    "LMOPEN DATAID("!!DID1!!") OPTION(INPUT)"
 006700    "LMMLIST DATAID("!!DID1!!") OPTION(LIST) MEMBER(MGMBR)"
 006800    XRC=RC
 006900    "LMCLOSE DATAID("DID1")"
 007000    if XRC=0 & MGMBR=MGMBRSTART then MSG_EXIT(8,,
 007100     "Maximum amount of backups reached.","MG")
 007200    if XRC>8 then MSG_EXIT(12,"MG-Member was not generated.","MG")
 007300    CNT=IIF((RC=8 ! verify(right(MGMBR,6),'0123456789','N')>0 !,
 007400     right(MGMBR,6)=0),999999,right(right(MGMBR,6)-1,6,'0'))
 007500    MGMBR="Z9"!!CNT
 007600    address tso
 007700    "MAKEBUF"; BUFFER=RC
 007800    push MGHEAD
 007900    "ALLOC F("!!DID1!!") DA("!!DS!!") SHR REUSE"
 008000    "EXECIO * DISKR "!!DID1!!" (FIFO FINIS)"
 008100    "FREE F("!!DID1!!")"
 008200    queue '' /* EOF Marker                                             */
 008300    "ALLOC F("!!DID1!!") DA("!!SETDSNMBR(DSN,MGMBR)!!") OLD"
 008400    "EXECIO * DISKW "!!DID1!!" (FINIS)"
 008500    "FREE F("!!DID1!!")"
 008600    "DROPBUF "!!BUFFER
 008700    address ispexec
 008800    "LMINIT DATAID(DID1) DATASET("!!DSN!!") ENQ(SHR)"
 008900    "LMOPEN DATAID("!!DID1!!") OPTION(INPUT)"
 009000    /* save history of MBR                                             */
 009100    "LMMLIST DATAID("DID1") OPTION(LIST) STATS(YES) MEMBER("!!MBR!!")"
 009200    STATS="CREATED4("!!ZLC4DATE!!") MODDATE4("!!ZLM4DATE!!")",
 009300     "USER("!!ZLUSER!!") VERSION("!!ZLVERS!!") MODLEVEL("!!ZLMOD!!")",
 009400     "MODTIME("!!ZLMTIME!!":"!!ZLMSEC!!") "
 009500    STATS=STATS!!IIF(ZLEXT="YES","EXT(YES) CURSIZE("!!ZLCNORCE!!")",
 009600     "INITSIZE("!!ZLINORCE!!") MODRECS("!!ZLMNORCE!!")",,
 009700     "CURSIZE("!!ZLCNORC!!") INITSIZE("!!ZLINORC!!")",
 009800     "MODRECS("!!ZLMNORC!!")")
 009900    "LMMLIST DATAID("!!DID1!!") OPTION(FREE)"
 010000    /* restore history to MGMBR                                        */
 010100    "LMMSTATS DATAID("!!DID1!!") MEMBER("!!MGMBR!!") "!!STATS
 010200    "LMCLOSE DATAID("!!DID1!!")"
 010300 end /*<IF EXISTS<>1                                                  >*/
 010400 address isredit
 010500 return 0
 010600 
 010700 SETDSNMBR:
 010800 /* combine DS and MBR to a complete DSNAME and keep quotes            */
 010900 return IIF(verify(reverse(arg(1)),'"'!!"'",'M')=1,, /* if / then      */
 011000  left(arg(1),length(arg(1))-1)!!'('!!arg(2)!!')'!!right(arg(1),1),,
 011100  arg(1)!!'('!!arg(2)!!')') /* else                                    */
 011200 
 011300 IIF:
 011400 /* RESULT=IIF(condition,true,false)                                   */
 011500 if arg(1)='1' then return arg(2)
 011600 return arg(3)
 011700 
 011800 MBR_HASH: procedure
 011900 TRACE_SAVED=trace(); trace N
 012000 DSN=arg(1); MBR=arg(2)
 012100 DS=SETDSNMBR(DSN,MBR)
 012200 address tso
 012300 "ALLOC F(SYSUT1) DA("!!DS!!") SHR REUSE"
 012400 "ALLOC F(SYSUT2) DUMMY"
 012500 "ALLOC F(SYSPRINT) SYSOUT(A) REUSE"
 012600 "ALLOC F(SYSIN) UNIT(VIO) NEW DSO(PS) SP(1,1)",
 012700  "TRACK RECFM(F B) LRECL(80) REUSE"
 012800 SYSIN.0=1; SYSIN.1=" PRINT TYPORG=PS"
 012900 "EXECIO * DISKW SYSIN (STEM SYSIN. FINIS)"
 013000 address ATTCHMVS "IEBPTPCH"
 013100 XRC=RC /* RC=4 means empty member                                     */
 013200 "FREE F(SYSUT1 SYSUT2 SYSIN)"
 013300 if XRC>4 then MSG_EXIT(XRC,"Fehler IEBPTPCH","MBR_HASH",,
 013400  "SYSUT1 SYSUT2 SYSIN")
 013500 if XRC=4 then ISRSUPCHASH="00000000" /* bypass RC=28 ISRSUPC          */
 013600 else do
 013700    "ALLOC F(NEWDD) DA("!!DS!!") SHR REUSE"
 013800    "ALLOC F(OLDDD) DA("!!DS!!") SHR REUSE"
 013900    "ALLOC F(OUTDD) UNIT(VIO) NEW DSO(PS) SP(15,5)",
 014000     "TRACK RECFM(F B A) LRECL(133) REUSE"
 014100    "ALLOC F(SYSIN) DUMMY REUSE"
 014200    PARM="OVSUML,FILECMP"
 014300    address ATTCHMVS "ISRSUPC" "PARM"
 014400    if RC>0 then MSG_EXIT(RC,"Error while calculating hash value.",,
 014500     "MBR_HASH","NEWDD OLDDD OUTDD")
 014600    "FREE F(NEWDD OLDDD)" ; REPORT.0=0; ISRSUPCHASH=""
 014700    "EXECIO * DISKR OUTDD (STEM REPORT. FINIS)"
 014800    do I=1 to REPORT.0 while length(ISRSUPCHASH)=0
 014900       if word(REPORT.I,1)="**" then ,
 015000        ISRSUPCHASH=word(REPORT.I,words(REPORT.I))
 015100    end /*<DO I=1 to REPORT.0 while length(ISRSUPCHASH)=0             >*/
 015200    "FREE F(OUTDD)"
 015300 end /*<ELSE                                                          >*/
 015400 trace value TRACE_SAVED
 015500 return ISRSUPCHASH
 015600 
 015700 MSG_EXIT: procedure
 015800 TRACE_SAVED=trace(); trace N
 015900 /* MSG_EXIT(RC,ERROR,MODUL,ddnames_to_free)                           */
 016000 if listdsi("ISPMLIB FILE")=0 then do /* ISPF-Environment ?            */
 016100    ZERRSM='RC='!!abs(arg(1))
 016200    ZERRLM=IIF(length(arg(3))>0,arg(3)!!": "!!arg(2),arg(2))
 016300    ZERRALRM = 'YES'; ZERRHM = '*'
 016400    address ispexec "SETMSG MSG(ISRZ002)"
 016500 end /*<IF listdsi("ISPMLIB FILE")=0                                  >*/
 016600 else do
 016700    if length(arg(3))=0 then say "RC="!!abs(arg(1))!!" - "!!arg(2)
 016800    else say arg(3)!!": RC="!!abs(arg(1))!!" "!!arg(2)
 016900 end /*<ELSE                                                          >*/
 017000 trace value TRACE_SAVED
 017100 if abs(arg(1))<>arg(1) then return 0 /* back to caller                */
 017200 address tso "ALTLIB RESET"
 017300 if arg()>3 then address tso "FREE F("!!arg(4)!!")"
 017400 TMP=isfcalls('OFF') /* switch off the SDSF-interface, if active       */
 017500 exit arg(1)
 ****** **************************** Bottom of Data ****************************