/* REXX */ /* */ /* AUTHOR: MARK ZELDEN */ /* */ /*********************************************************************/ /* TAPESTAK - REXX TAPE STACKING PROGRAM */ /* LAST UPDATE - 08/20/2009 */ /* - Changed check for (non) vault from hexzeros to <= ' ' to */ /* allow for hexzeros or blanks (changed in CA-1 R5.?) */ /* - Added in TMDEN check for 3592 & WORM */ /* - Only add in Inter Block Gaps (IBG) for 38K / 38KC */ /*********************************************************************/ /* NOTE: This program was written to work with CA-1 release 5.0 */ /* CA-1 release 5.1, and CA-1 release 5.2. */ /* */ /* INPUT FILES NEEDED */ /* CA-1 TMC FILE - DD NAME OF TMC */ /* */ /* OUTPUT FILES NEEDED */ /* REPORT FILE - DD NAME OF REPORT (report on stacked tapes) */ /* SYSPRINT FILE - DD NAME OF SYSPRINT (work file needed for IDCAMS)*/ /* SYSIN FILE - DD NAME OF SYSIN (work file needed for IDCAMS) */ /* */ /* COPYCAT FILE - DD NAME OF COPYCAT (copycat stacking jobs) */ /* GENER FILE - DD NAME OF GENER (iebgener stacking jobs) */ /*********************************************************************/ /* OPTIONAL PARMS: */ /* JOBTYPE - Type of jobs to generate - IEBGENER or COPYCAT */ /* The default is COPYCAT */ /* MAXJOBS - Maximum number of jobs to generate (1-99) */ /* The default is 5 */ /* RUNMODE - either "TEST" or "PROD" */ /* The default is PROD */ /* In TEST mode: */ /* 1) Input files are not uncataloged */ /* 2) Input files do not get expired */ /* 3) Output files are not cataloged */ /* 4) Output files are given LABEL=RETPD=1 */ /* 5) The control statements for the COPYCAT option */ /* are changed to perform the above actions. */ /* 6) The TMSUPDTE steps are not generated to expire */ /* input tapes for the IEBGENER option. */ /* 7) The output report indicates *** TEST MODE *** */ /* */ /* *** If you specify MAXJOBS you must also specify JOBTYPE first. */ /* *** If you specify RUNMODE you must also specify JOBTYPE and */ /* MAXJOBS first. *** */ /*********************************************************************/ /* SAMPLE EXECUTION JCL: */ /* */ /* //TAPESTAK JOB (ACCT,INFO),'REXX BATCH',CLASS=M,MSGCLASS=H */ /* //* */ */ /* //STEP1 EXEC PGM=IRXJCL,PARM='TAPESTAK' */ /* //*STEP1 EXEC PGM=IRXJCL,PARM='TAPESTAK IEBGENER' */ */ /* //*STEP1 EXEC PGM=IRXJCL,PARM='TAPESTAK COPYCAT 10' */ */ /* //*STEP1 EXEC PGM=IRXJCL,PARM='TAPESTAK IEBGENER 5 TEST' */ */ /* //*STEP1 EXEC PGM=IRXJCL,PARM='TAPESTAK COPYCAT 5 PROD' DEFLT */ */ /* //* */ */ /* //SYSTSIN DD DUMMY /* STD IRXJCL DD */ */ /* //SYSTSPRT DD SYSOUT=* /* STD IRXJCL DD */ */ /* //SYSEXEC DD DSN=REXX.EXEC.PDSLIB, /* STD IRXJCL DD */ */ /* // DISP=SHR */ /* //* */ */ /* //TMC DD DSN=CA1.TMC,DISP=SHR */ /* //REPORT DD SYSOUT=*,DCB=(LRECL=133,BLKSIZE=3990,RECFM=FBA) */ /* //SYSIN DD UNIT=SYSDA,SPACE=(TRK,(1,1)) /*NEEDED FOR IDCAMS*/*/ /* //SYSPRINT DD UNIT=SYSDA,SPACE=(TRK,(1,1)) /*NEEDED FOR IDCAMS*/*/ /* //*COPYCAT DD DSN=JCL.PDSLIB(COPYCAT),DISP=SHR */ */ /* //COPYCAT DD SYSOUT=(A,INTRDR),DCB=BLKSIZE=80 */ /* //*GENER DD DSN=JCL.PDSLIB(GENER),DISP=SHR */ */ /* //GENER DD SYSOUT=(A,INTRDR),DCB=BLKSIZE=80 */ /*********************************************************************/ /* ERROR MESSAGES: */ /* */ /* STAK001E INVALID JOB TYPE SPECIFIED */ /* STAK002E JOB TYPE MUST BE EITHER "IEBGENER" OR "COPYCAT" */ /* */ /* STAK003E MAXJOBS PARAMETER IS NOT NUMBERIC */ /* STAK004E MAXJOBS PARAMETER MUST BE BETWEEN 1 AND 99 */ /* */ /* STAK005E INVALID RUN MODE SPECIFIED */ /* STAK006E RUN MODE MUST BE EITHER "PROD" OR "TEST" */ /* */ /* STAK007E JOB NAME PREFIX (JOBPRE) MUST BE 6 CHARACTERS OR LESS */ /* */ /* STAK008E UNKNOWN TAPE DENSITY FOUND - TERMINATING */ /* STAK009E RECORD = NN VOLSER = NNNNNN */ /* */ /* STAK010I THE NUMBER OF JOBS GENERATED WAS LESS THAN MAXJOBS */ /*********************************************************************/ /* */ /* A RETURN CODE OF 4 MEANS THAT THE NUMBER OF JOBS GENERATED */ /* WAS LESS THAN THE MAXJOBS PARAMETER THAT WAS SPECIFIED OR */ /* DEFAULTED. THIS IS BECAUSE NO TAPES WERE FOUND THAT COULD BE */ /* STACKED WITH THE TAPE THAT WAS CHOSEN TO BE USED AS THE FIRST */ /* FILE IN A STACKING JOB OR THERE WERE NO MORE TMC RECORDS TO READ. */ /* */ /* IF THIS HAPPENS, THE GENERATED JOBS SHOULD BE RUN BEFORE RUNNING */ /* THIS PROGRAM AGAIN OR THE CUSTOMIZATION PARAMETERS BELOW SHOULD */ /* BE ADJUSTED - WHICH SHOULD PRODUCE DIFFERENT RESULTS. */ /* */ /*********************************************************************/ /* */ /* ALL GENERATED JOBS SHOULD BE RUN BEFORE THIS PROGRAM IS USED */ /* TO GENERATE MORE STACKING JOBS. IF ALL JOBS ARE NOT RUN THE */ /* SAME TAPES CAN BE DUPLICATED IN NEW JOBS. */ /* */ /*********************************************************************/ /* */ /* IF STACKING SPECIFIC EXPIRATION TAPES IS YOUR MAIN OBJECTIVE, */ /* IT MIGHT BE HELPFUL TO SORT THE TMC BY EXPIRATION DATE AND USE */ /* THE SORTED FILE AS INPUT. YOU MIGHT ALSO WANT TO CHANGE THE */ /* "RANGE" VALUE BELOW TO A LARGE NUMBER SUCH AS 9999 TO NULLIFY */ /* IT'S EFFECTS. */ /* */ /* THE FOLLOWING SORT CONTROL CARDS CAN BE USED TO SORT THE TMC */ /* BY EXPIRATION DATE AND VOLSER AND WILL OMIT ALL DSNB RECORDS: */ /* *** YOU MUST USE THE OMIT CONTROL CARD *** */ /* */ /* SORT FIELDS=(51,4,BI,A,1,6,CH,A) */ /* OMIT COND=(1,1,BI,EQ,X'FF') */ /* */ /*********************************************************************/ /* */ /* NOTE: THE ONLY TAPES THAT CAN BE STACKED ARE TAPES THAT HAVE */ /* SPECIFIC EXPIRATION DATES AND CATALOG CONTROL TAPES. */ /* */ /* TAPES UNDER CYCLE, LDATE OR PERMANENT CONTROL CAN NOT BE STACKED */ /* BECAUSE IF THE FIRST FILE REACHES IT'S EXPIRATION, THEN ALL FILES */ /* THAT ARE STACKED WILL ALSO BE EXPIRED. */ /* */ /*********************************************************************/ Arg JOBTYPE MAXJOBS RUNMODE If JOBTYPE = '' then JOBTYPE = COPYCAT Else do If JOBTYPE <> IEBGENER & JOBTYPE<> COPYCAT then do Say 'STAK001E INVALID JOB TYPE SPECIFIED' Say 'STAK002E JOB TYPE MUST BE EITHER "IEBGENER" OR "COPYCAT"' Exit 12 End /* if */ End /* else */ If MAXJOBS <> '' then do If Datatype(MAXJOBS,Number) <> 1 then do Say 'STAK003E MAXJOBS PARAMETER IS NOT NUMBERIC' Exit 12 End If MAXJOBS <1 | MAXJOBS > 99 then do Say 'STAK004E MAXJOBS PARAMETER MUST BE BETWEEN 1 AND 99' Exit 12 End End Else MAXJOBS = 5 /* default of 5 jobs generated */ If RUNMODE = '' then RUNMODE = PROD Else do If RUNMODE <> PROD & RUNMODE <> TEST then do Say 'STAK005E INVALID RUN MODE SPECIFIED' Say 'STAK006E RUN MODE MUST BE EITHER "PROD" OR "TEST"' Exit 12 End /* if */ End /* else */ /*********************************************************************/ NUMERIC DIGITS 12 /*********************************************************************/ /* B E G I N C U S T O M I Z A T I O N S E C T I O N */ /*********************************************************************/ /* The values in the box below can be customized for your */ /* environment. */ /*********************************************************************/ STARTNUM = 000001 /* ignore tapes with volser < 000001 */ ENDNUM = 999999 /* ignore tapes with volser > 999999 */ EXDAYS = 30 /* ignore tapes that will exp in 30 days */ RANGE = 90 /* retpd cntl expdt range o.k. to stack */ CATCDATE = 60 /* ctlg cntl cdate must be 60 days old */ JOBPRE = 'TPSTAK' /* job name prefix - 6 chars. or less */ ACCT = 'SYS,9999' /* acct info for generated jcl jobcards */ EXCLASS = 'A' /* execution class for generated jobs */ MSGCL = 'X' /* message class for generated jobs */ TPUNITI = 'CART' /* tape unit name for jcl - input tapes */ TPUNITO = 'CART' /* tape unit name for jcl - output tapes */ IDRC = 'YES' /* output tapes will use IDRC (yes or no)*/ /********************************************************************/ /* Sample values for 3480/3490 18-track */ /********************************************************************/ /* MAXHOLD = 200000000 */ /* 18 track tape will hold 200M */ /* TAPEFULL = 185000000 */ /* start new tape if at least 185M */ /* SKIPAMT = 75000000 */ /* if tape has 75M or more, skip it */ /* COMPRESS = 50 */ /* assume 50% compression for IDRC tapes */ /********************************************************************/ /* Sample values for 3490E 36-track */ /********************************************************************/ /* MAXHOLD = 400000000 */ /* 36 track tape will hold 400M */ /* TAPEFULL = 375000000 */ /* start new tape if at least 375M */ /* SKIPAMT = 150000000 */ /* if tape has 150M or more, skip it */ /* COMPRESS = 50 */ /* assume 50% compression for IDRC tapes */ /********************************************************************/ /* Sample values for 3490E 36-track extended capacity */ /********************************************************************/ /* MAXHOLD = 800000000 */ /* 3490E 36 track tape will hold 800M */ /* TAPEFULL = 750000000 */ /* start new tape if at least 750M */ /* SKIPAMT = 150000000 */ /* if tape has 150M or more, skip it */ /* COMPRESS = 50 */ /* assume 50% compression for IDRC tapes */ /********************************************************************/ /* Sample values for 3590 128-track */ /********************************************************************/ /* MAXHOLD = 10000000000 */ /* 3590 tape will hold 10,000M (10G) */ /* TAPEFULL = 8000000000 */ /* start new tape if at least 8G */ /* SKIPAMT = 1000000000 */ /* if tape has 1G or more, skip it */ /* COMPRESS = 66 */ /* assume 66% compression for LZ-1 tapes */ /********************************************************************/ /* Sample values for 3590 128-track extended capacity */ /********************************************************************/ /* MAXHOLD = 20000000000 */ /* 3590 tape will hold 20,000M (20G) */ /* TAPEFULL = 15000000000 */ /* start new tape if at least 15G */ /* SKIPAMT = 2000000000 */ /* if tape has 2G or more, skip it */ /* COMPRESS = 66 */ /* assume 66% compression for LZ-1 tapes */ /********************************************************************/ /* Sample values for 3590E 256-track */ /********************************************************************/ /* MAXHOLD = 20000000000 */ /* 3590E tape will hold 20,000M (20G) */ /* TAPEFULL = 15000000000 */ /* start new tape if at least 15G */ /* SKIPAMT = 2000000000 */ /* if tape has 2G or more, skip it */ /* COMPRESS = 66 */ /* assume 66% compression for LZ-1 tapes */ /********************************************************************/ /* Sample values for 3590E 256-track extended capacity */ /********************************************************************/ /* MAXHOLD = 40000000000 */ /* 3590E tape will hold 40,000M (40G) */ /* TAPEFULL = 30000000000 */ /* start new tape if at least 30G */ /* SKIPAMT = 5000000000 */ /* if tape has 5G or more, skip it */ /* COMPRESS = 66 */ /* assume 66% compression for LZ-1 tapes */ /********************************************************************/ /* Sample values for STK 9840A / 9840B */ /********************************************************************/ /* MAXHOLD = 20000000000 */ /* tape will hold 20,000M (20G) */ /* TAPEFULL = 15000000000 */ /* start new tape if at least 15G */ /* SKIPAMT = 2000000000 */ /* if tape has 2G or more, skip it */ /* COMPRESS = 66 */ /* assume 66% compression for LZ-1 tapes */ /********************************************************************/ /* Sample values for STK 9840C */ /********************************************************************/ /* MAXHOLD = 40000000000 */ /* tape will hold 40,000M (40G) */ /* TAPEFULL = 30000000000 */ /* start new tape if at least 30G */ /* SKIPAMT = 5000000000 */ /* if tape has 5G or more, skip it */ /* COMPRESS = 66 */ /* assume 66% compression for LZ-1 tapes */ /********************************************************************/ /* Sample values for STK Timberline */ /********************************************************************/ /* MAXHOLD = 1600000000 */ /* tape will hold 1,600M */ /* TAPEFULL = 1000000000 */ /* start new tape if at least 1,000M */ /* SKIPAMT = 100000000 */ /* if tape has 100M or more, skip it */ /* COMPRESS = 50 */ /* assume 50% compression for IDRC tapes */ /********************************************************************/ /* Sample values for STK Redwood 10G Cartridge */ /********************************************************************/ /* MAXHOLD = 10000000000 */ /* tape will hold 10,000M (10G) */ /* TAPEFULL = 8000000000 */ /* start new tape if at least 8G */ /* SKIPAMT = 1000000000 */ /* if tape has 1G or more, skip it */ /* COMPRESS = 50 */ /* assume 50% compression for IDRC tapes */ /********************************************************************/ /* Sample values for STK Redwood 25G Cartridge */ /********************************************************************/ /* MAXHOLD = 25000000000 */ /* tape will hold 25,000M (25G) */ /* TAPEFULL = 15000000000 */ /* start new tape if at least 15G */ /* SKIPAMT = 2000000000 */ /* if tape has 2G or more, skip it */ /* COMPRESS = 50 */ /* assume 50% compression for IDRC tapes */ /********************************************************************/ /* Sample values for STK Redwood 50G Cartridge */ /********************************************************************/ /* MAXHOLD = 50000000000 */ /* tape will hold 50,000M (50G) */ /* TAPEFULL = 40000000000 */ /* start new tape if at least 40G */ /* SKIPAMT = 5000000000 */ /* if tape has 5G or more, skip it */ /* COMPRESS = 50 */ /* assume 50% compression for IDRC tapes */ /********************************************************************/ MAXHOLD = 400000000 /* 36 track tape will hold 400M */ TAPEFULL = 375000000 /* start new tape if at least 375M */ SKIPAMT = 150000000 /* if tape has 150M or more, skip it */ COMPRESS = 50 /* assume 50% compression for IDRC tapes */ MAXVB = 90 /* assume 90% of vb records are max */ MAXLINES = 55 /* max lines per page on report output */ COMPANY = 'Y O U R C O M P A N Y N A M E' /*rpt heading*/ /*********************************************************************/ /* E N D C U S T O M I Z A T I O N S E C T I O N */ /*********************************************************************/ If Length(JOBPRE) > 6 then do Say 'STAK007E JOB NAME PREFIX (JOBPRE) MUST BE 6 CHARACTERS OR LESS' Exit 12 End /*********************************************************************/ /* Make sure jcl variables are in upper case to prevent jcl errors */ /*********************************************************************/ JOBPRE = Translate(JOBPRE) ACCT = Translate(ACCT) EXCLASS = Translate(EXCLASS) MSGCL = Translate(MSGCL) TPUNITI = Translate(TPUNITI) TPUNITO = Translate(TPUNITO) /*********************************************************************/ /* Initialize counters, flags, and run date. */ /*********************************************************************/ COMPANY = Center(COMPANY,70) /* center company name on report */ RECNUM = 1 /* current input record number */ NEWTAPE = 'YES' /* initialize new stacked tape flag to 'YES' */ PAGENUM = ' 1' /* report page number count */ TOTAL = 0 /* count of stacked tapes in all jobs */ GENJOBS = 0 /* count of generated jobs */ CALL RDATE(TODAY) /* Get number of days */ DATEN = Substr(RESULT,16,5) /* NNNNN date from RDATE */ DATEW = Date('W') /* day of week */ DATEM = Date('M') /* month */ DATEND = Substr(Date('N'),1,2) /* day of month */ DATEND = Strip(DATEND) /* remove blanks for days 1-9 */ DATESY = Substr(Date('S'),1,4) /* year */ DATERUN = DATEW', 'DATEM' 'DATEND', 'DATESY /* rpt date heading */ DATERUN = Translate(DATERUN) /* convert date heading to upper case */ DATERUN = Left(DATERUN,30,' ') /* ensure length is always 30 */ DATEJ = Date('J') /* Julian YYDDD */ DATEJ = DATESY || '/' || Substr(DATEJ,3,3) /* Julian YYYY/DDD */ /*********************************************************************/ /* Begin search for tapes to stack */ /*********************************************************************/ Do I = 1 to MAXJOBS Do forever "EXECIO 1 DISKR TMC" RECNUM /* put input record on data stack */ If rc <> 0 then leave /* no more records - exit */ RECNUM = RECNUM + 1 /* add 1 to record count */ Parse pull INREC /* read input record from data stack */ /* */ /* If the record is a DSNB we are done with the TMC */ /* */ If Substr(INREC,1,1) = X2c('FF') then leave /* DSNBs - done w/TMC */ /* */ /* Check for TMC control records: */ /* */ VOLSER = Substr(INREC,1,6) If VOLSER = 'TMSCTL' then iterate /* TMS control records */ /* */ /* Check flag1 bits : */ /* x'02' = volume in delete status */ /* x'04' = volume in scratch status */ /* x'10' = volume closed by abend */ /* */ /* If any of the above bits are on - then get another record */ /* */ FLAG1 = Substr(INREC,85,1) CHKDEL = C2d(Bitand(FLAG1,'02'x)) /* check for B'0000 0010' */ CHKSCR = C2d(Bitand(FLAG1,'04'x)) /* check for B'0000 0100' */ CHKABN = C2d(Bitand(FLAG1,'10'x)) /* check for B'0001 0000' */ If CHKDEL ^< 2 | CHKSCR ^< 4 | CHKABN ^< 16 then iterate /* */ /* If any of the following conditions are true - get */ /* another record. */ /* */ /* 1) The tape volser < STARTNUM or > ENDNUM */ /* 2) The tape is a 9 track (3420) tape */ /* 3) The tape is a FDRABR tape */ /* 4) The tape is a DFHSM tape */ /* 5) The tape is vaulted */ /* 6) The tape is part of a multi-volume set */ /* 7) The tape is a multi- file tape (tape has DSNBs) */ /* */ If VOLSER < STARTNUM | VOLSER > ENDNUM then iterate If Substr(INREC,89,1) = X2c('80') then iterate /* 9 track (3420) */ If Substr(INREC,7,6) = 'FDRABR' then iterate /* FDR/ABR tapes */ If Substr(INREC,7,5) = 'DFHSM' then iterate /* DFHSM tapes */ /*If Substr(INREC,109,4) <> X2c('00000000') then iterate *//*vaulted*/ If Substr(INREC,109,1) <=' ' then iterate /* vaulted */ If Substr(INREC,57,6) <> X2c('000000000000') then iterate /*mlt-vol*/ If Substr(INREC,75,2) <> X2c('0000') then iterate /* multi file */ /* */ /* Check for standard label tape bit */ /* x'02' = standard label */ /* */ TMLTYPE = Substr(INREC,91,1) CHKLABL = C2d(Bitand(TMLTYPE,'02'x)) /* check for B'0000 0010' */ If CHKLABL < 2 then iterate /* sl bit off - get another tape */ /* */ /* The following code checks expiration dates */ /* If the first byte is x'00' it is in 20th century (19XX) */ /* If the first byte is x'01' it is in 21th century (20XX) */ /* If the first byte is x'99' it is CA-1 special keyword */ /* */ EXDATE = Substr(INREC,51,4) EXDATEA = Substr(INREC,51,1) Select When EXDATEA = X2c('00') then do /* RETPD control year 19XX */ EXDATE = C2d(EXDATE) EXDATE = D2x(EXDATE) EXDATE = Left(EXDATE,5) EXDATE = '19'||Substr(EXDATE,1,2)||'/'||Substr(EXDATE,3,3)' ' /* */ /* If the tape is due to expire in the */ /* next EXDAYS days - get another record. */ /* */ DATEPARM = Substr(EXDATE,1,4)||' '||Substr(EXDATE,6,3) Call RDATE DATEPARM EXPCENT = Substr(RESULT,16,5) /* century date from RDATE */ If DATEN > EXPCENT - EXDAYS then iterate /* */ JCLEXP = Strip(EXDATE) CONTROL = 'RETENTION' End /* when */ When EXDATEA = X2c('01') then do /* RETPD control year 20XX */ EXDATE = Substr(INREC,52,3) EXDATE = C2d(EXDATE) EXDATE = D2x(EXDATE,6) EXDATE = Left(EXDATE,5) EXDATE = '20'||Substr(EXDATE,1,2)||'/'||Substr(EXDATE,3,3)' ' /* */ /* If the tape is due to expire in the */ /* next EXDAYS days - get another record. */ /* */ DATEPARM = Substr(EXDATE,1,4)||' '||Substr(EXDATE,6,3) Call RDATE DATEPARM EXPCENT = Substr(RESULT,16,5) /* century date from RDATE */ If DATEN > EXPCENT - EXDAYS then iterate /* */ JCLEXP = Strip(EXDATE) CONTROL = 'RETENTION' End /* when */ Otherwise EXDATEB = Substr(INREC,51,2) If EXDATEB = X2c('9990') then do /* CATALOG control */ EXDATE = 'CATALOG ' JCLEXP = '99000' CONTROL = 'CATALOG' End Else iterate /* PERMANENT,CYCLE,LDATE, or STATS retention */ End /* select */ /* */ CDATE = Substr(INREC,117,4) CDATEA = Substr(INREC,117,1) If CDATEA = X2c(00) then do CDATE = C2d(CDATE) CDATE = D2x(CDATE) CDATE = Left(CDATE,5) CDATE = '19'||Substr(CDATE,1,2)||'/'||Substr(CDATE,3,3) End /* if */ Else do CDATE = Substr(INREC,118,3) CDATE = C2d(CDATE) CDATE = D2x(CDATE,6) CDATE = Left(CDATE,5) CDATE = '20'||Substr(CDATE,1,2)||'/'||Substr(CDATE,3,3) End /* else */ /* */ /* If stacking tapes under catalog control - make sure the */ /* tape is at least CATCDATE days old */ /* */ If CONTROL = 'CATALOG' then do DATEPARM = Substr(CDATE,1,4)||' '||Substr(CDATE,6,3) Call RDATE DATEPARM CDATCENT = Substr(RESULT,16,5) /* century date from RDATE */ If CDATCENT > DATEN - CATCDATE then iterate End /* if control */ /* */ /* If we are not on a new tape, and the expiration date doesn't */ /* match the previously stacked files and was under catalog */ /* control - get another tape. If the tape was under retention */ /* period control - check if it falls into the default date range */ /* to be stacked. */ /* */ If NEWTAPE <> 'YES' then If EXDATE <> SAVEDATE then If SAVEDATE <> 'CATALOG ' then If CONTROL <> 'CATALOG' then do /* */ DATEPARM = Substr(SAVEDATE,1,4)||' '||Substr(SAVEDATE,6,3) Call RDATE DATEPARM SAVECENT = Substr(RESULT,16,5) /* century date from RDATE */ /* */ If EXPCENT < SAVECENT then If SAVECENT - EXPCENT ^< RANGE then iterate Else nop Else If EXPCENT - SAVECENT ^< RANGE then iterate End /* if control */ Else iterate /* if control */ Else iterate /* if savedate */ Else nop /* if exdate */ Else nop /* if newtape */ /* */ /* We now have an eligable tape. */ /* Calculate how much data is on the tape. */ /* A 3480 tape holds about 200MB when it is not compacted. */ /* */ BLKSIZE = C2d(Substr(INREC,97,4)) If BLKSIZE = 0 then iterate /* can't copy tape with no blksize */ BLKCOUNT = C2d(Substr(INREC,101,4)) RECFM = Substr(INREC,92,1) /* */ /* Check for variable length record file */ /* */ CHKVAR = C2d(Bitand(RECFM,'40'x)) /* check for B'0100 0000' */ If CHKVAR < 64 then VARBIT = 'OFF' /* bit off */ Else VARBIT = 'ON' /* */ /* The following code is to check for 3480 tapes that are */ /* utilizing compaction (IDRC). */ /* */ TMDEN = Substr(INREC,90,1) /* */ /* The only density that should ever be found should */ /* be X'E3', x'E7', x'E8', x'E9' pr x'EA' because */ /* we are already bypassing 9 track tapes in the */ /* beginning of the program. */ Select /* When TMDEN = X2c('03') then */ /* TMDEN = '200 ' */ /* When TMDEN = X2c('43') then */ /* TMDEN = '556 ' */ /* When TMDEN = X2c('83') then */ /* TMDEN = '800 ' */ /* When TMDEN = X2c('C3') then */ /* TMDEN = '1600' */ /* When TMDEN = X2c('D3') then */ /* TMDEN = '6250' */ When TMDEN = X2c('E3') then /* 3480 no idrc */ TMDEN = '38K ' When TMDEN = X2c('E7') then /* 3480 with idrc */ TMDEN = '38KC' When TMDEN = X2c('E8') then /* 3590 */ TMDEN = '3590' When TMDEN = X2c('E9') then /* 3592 */ TMDEN = '3592' When TMDEN = X2c('EA') then /* 3592 WORM */ TMDEN = 'WORM' Otherwise TMDEN = '????' Say 'STAK008E UNKNOWN TAPE DENSITY FOUND - TERMINATING' Say 'STAK009E RECORD = 'RECNUM' VOLSER = 'VOLSER Exit 12 End /* select */ /* */ /* Calculate approximate amount of tape used. */ /* */ TAPEUSED = BLKSIZE * BLKCOUNT /* */ /* */ /* If variable records - assume MAXVB% are the max lrecl */ /* */ If VARBIT = 'ON' then TAPEUSED = TAPEUSED * (MAXVB /100) /* */ /* If compacted tape (IDRC) - assume COMPRESS% compaction - or */ /* if uncompacted tape and the output will be compacted */ /* assume COMPRESS% compaction */ /* */ If TMDEN = '38KC' | IDRC = 'YES' then , TAPEUSED = TAPEUSED * (1-(COMPRESS/100)) /* */ /* Add in the Inter Block Gaps (IBG) */ /* */ /* The density of a 3480 cartrige is: */ /* 1491 characters per millimeter American National Standard */ /* */ /* 1 inch = 2.54 centimeters or 25.4 millimeters */ /* 1 character = 1 byte */ /* 1491 * 25.4 = 37871 bytes per inch (38K BPI) */ /* */ /* The IBG is .08 inches */ /* 37871 * .08 = 3030 bytes */ /* */ If TMDEN = '38K' | TMDEN = '38KC' then , /* add in */ TAPEUSED = TAPEUSED + (BLKCOUNT * 3030) /* 3480 IBGs */ /* */ /* If the tape is more then SKIPAMT full - get another tape */ /* */ If TAPEUSED > SKIPAMT then iterate /* tape too full - skip it */ /* */ If NEWTAPE = 'YES' then do SAVEDATE = EXDATE STAKUSED = TAPEUSED NEWTAPE = 'NO' F = 1 /* file number */ Call SAVE_VARS /* save tape tmc info */ End Else do /* not a new tape */ /* */ /* The following code is to make sure the selected tape to be */ /* stacked will fit on the existing tape. If it won't fit - get */ /* another tape. */ /* */ STAKTEMP = STAKUSED + TAPEUSED If STAKTEMP > MAXHOLD then iterate /* won't fit on this tape */ /* */ Else do /* tape will fit */ STAKUSED = STAKTEMP F = F + 1 /* file number */ Call SAVE_VARS /* save tape tmc info */ If STAKUSED > TAPEFULL then do /* tape is full enough */ NEWTAPE = 'YES' Call CREATE_JOB /* tape is full - create stack job */ Leave /* leave do forever loop */ End /* if stakused */ End /* else do - tape will fit*/ End /* else do - not a new tape*/ End /* Do forever */ End I /* Do */ If GENJOBS < MAXJOBS then If F > 1 then Call CREATE_JOB /* create final stack job */ /******************************************/ /* DONE WITH PROCESSING - WRITE TOTALS */ /******************************************/ RECNUM = Right(RECNUM-1,7,'0') TOTAL = Right(TOTAL,7,'0') GENJOBS = Right(GENJOBS,7,'0') If RUNMODE = 'PROD' then Queue '1'DATERUN||COMPANY||' PAGE 'PAGENUM Else Queue '1'DATERUN||COMPANY||' *** TEST MODE *** PAGE 'PAGENUM Queue '0 ' , ' TAPES TO BE STACKED - TOTALS' Queue ' ' Queue ' ' Queue ' ' Queue ' 'RECNUM' TMC RECORDS WERE READ' Queue ' 'TOTAL' TAPES WERE SELECTED TO BE STACKED' Queue ' 'GENJOBS JOBTYPE' JOBS WERE GENERATED' "EXECIO 8 DISKW REPORT" If GENJOBS < MAXJOBS then do Say 'STAK010I THE NUMBER OF JOBS GENERATED WAS LESS THAN 'MAXJOBS Queue ' ' Queue ' ** THE NUMBER OF JOBS GENERATED WAS LESS THAN 'MAXJOBS "EXECIO 2 DISKW REPORT" If F = 1 then do Queue ' ** BECAUSE NO TAPES WERE FOUND THAT COULD BE STACKED' Queue ' ** WITH VOLSER 'STKVOL.F' - EXPIRATION 'STKEXP.F "EXECIO 2 DISKW REPORT" End Else do Queue ' ** BECAUSE THERE WERE NO MORE TMC RECORDS TO READ' "EXECIO 1 DISKW REPORT" End RETCODE = 4 End Else RETCODE = 0 If JOBTYPE = 'COPYCAT' then do Queue ' ' Queue ' *********************************************************' Queue ' *** NOTE: COPYCAT MAY NOT USE THE SAME FILE STACKING ***' Queue ' *** SEQUENCE THAT IS SHOWN IN THIS REPORT. ***' Queue ' *** ***' Queue ' *** SEE THE COPYCAT DETAIL REPORT FOR THE ***' Queue ' *** ACTUAL ORDER THAT WAS USED. ***' Queue ' *********************************************************' "EXECIO 8 DISKW REPORT" End /* if */ /******************************************/ /* CLOSE FILES AND EXIT */ /******************************************/ "EXECIO 0 DISKR TMC (FINIS" "EXECIO 0 DISKW REPORT (FINIS" If JOBTYPE = 'IEBGENER' then "EXECIO 0 DISKW GENER (FINIS" Else "EXECIO 0 DISKW COPYCAT (FINIS" Exit RETCODE /*********************************************************************/ /* SUBROUTINE TO WRITE REPORT PAGE HEADING */ /*********************************************************************/ PUT_HEADING: If RUNMODE = 'PROD' then Queue '1'DATERUN||COMPANY||' PAGE 'PAGENUM Else Queue '1'DATERUN||COMPANY||' *** TEST MODE *** PAGE 'PAGENUM Queue '0 ' , ' TAPES TO BE STACKED - JOB NUMBER 'GENJOBS COLHDA1 = '0 VOLUME DATASET' COLHDA2 = 'CREATE CREATE EXPIRE CREATING ' COLHDA3 = 'TAPE NEW NEW' Queue Insert(COLHDA2||COLHDA3,COLHDA1,60) COLHDB1 = ' SERIAL NAME ' COLHDB2 = 'DATE TIME DATE JOB ' COLHDB3 = 'DEN SEQ DISP' Queue Insert(COLHDB2||COLHDB3,COLHDB1,60) Queue ' ' "EXECIO 5 DISKW REPORT" LINECNT = 7 PAGENUM = PAGENUM + 1 PAGENUM = Right(PAGENUM,3,' ') Return /*********************************************************************/ /* SUBROUTINE TO SAVE VARIABLES */ /*********************************************************************/ SAVE_VARS: /* */ /* Copy previously determined variables */ /* */ STKVOL.F = VOLSER STKEXP.F = EXDATE STKJEXP.F = JCLEXP STKDEN.F = TMDEN STKCRE.F = CDATE /* */ /* Extract other variables from input record */ /* */ DSN.F = Substr(INREC,7,44) CTIME.F = C2d(Substr(INREC,122,3)) CTIME.F = D2x(CTIME.F,5) CTIME.F = Left(CTIME.F,4) CTIME.F = Substr(CTIME.F,1,2)||':'||Substr(CTIME.F,3,2) CJOB.F = Substr(INREC,125,8) Call CHECK_CAT /* check if tape is cataloged */ Return /*********************************************************************/ /* SUBROUTINE TO CALL IDCAMS TO SEE IF TAPE IS CATALOGED */ /*********************************************************************/ CHECK_CAT: Queue ' LISTC ENT('DSN.F') VOL' "EXECIO 1 DISKW SYSIN (FINIS" Address LINK "IDCAMS" /*********************************************************************/ /* If the dataset is cataloged - we need to make sure the volser */ /* that is in the catalog is the same one we are checking. */ /*********************************************************************/ If RC = 0 then do /* dataset is cataloged */ "EXECIO 1 DISKR SYSPRINT 10 (FINIS" /* put 10th rec on data stack */ Parse pull PRTREC /* read record from data stack */ If Substr(PRTREC,27,6) = STKVOL.F then do /* volser matches catalog*/ INDISP.F = UNCATLG OUTDISP.F = CATLG End Else do /* volser is not the same one that is cataloged */ INDISP.F = KEEP OUTDISP.F = KEEP End End /* if rc = 0 */ Else do /* dataset is not cataloged */ INDISP.F = KEEP OUTDISP.F = KEEP End Return /*********************************************************************/ /* SUBROUTINE TO CREATE STACKING JOB */ /*********************************************************************/ CREATE_JOB: GENJOBS = GENJOBS + 1 JOBNUM = Right(GENJOBS,2,'0') Call PUT_HEADING /* rpt page heading subroutine */ If JOBTYPE = 'IEBGENER' then Call NEW_GENER /* build iebgener jobcard jcl subroutine */ Else Call NEW_CPYCAT /* build copycat jcl subroutine */ Do J = 1 to F Call PUT_REC /* write report record */ If JOBTYPE = 'IEBGENER' then do Call PUT_JCL /* build iebgener jcl copy step subroutine */ Call TMS_UPDATE /* build tms update step subroutine */ End Else Call PUT_VOLSER /* create copycat volser control stmts */ End /* do */ Return /*********************************************************************/ /* SUBROUTINE TO WRITE AN OUTPUT REPORT RECORD */ /*********************************************************************/ PUT_REC: SEQ.J = Right(J,3,'0') If LINECNT = MAXLINES then CALL PUT_HEADING OUT1 = ' 'STKVOL.J' 'DSN.J OUT2 = STKCRE.J' 'CTIME.J' 'STKEXP.J' 'CJOB.J' ' OUT3 = STKDEN.J' 'SEQ.J' 'OUTDISP.J Queue Insert(OUT2||OUT3,OUT1,60) "EXECIO 1 DISKW REPORT" TOTAL = TOTAL + 1 LINECNT = LINECNT + 1 Return /*********************************************************************/ /* SUBROUTINE TO CREATE JOBCARD JCL FOR A NEW IEBGENER JOB */ /*********************************************************************/ NEW_GENER: Queue '//'||JOBPRE||JOBNUM' JOB ('||ACCT||'),''STACK TAPES'',' Queue '// CLASS='||EXCLASS||',MSGCLASS='||MSGCL||',' Queue '// MSGLEVEL=(1,1),TYPRUN=HOLD' "EXECIO 3 DISKW GENER" Return /*********************************************************************/ /* SUBROUTINE TO CREATE JCL STATEMENTS FOR A NEW CA-1 COPYCAT JOB */ /*********************************************************************/ NEW_CPYCAT: Queue '//'||JOBPRE||JOBNUM' JOB ('||ACCT||'),''STACK TAPES'',' Queue '// CLASS='||EXCLASS||',MSGCLASS='||MSGCL||',' Queue '// MSGLEVEL=(1,1),TYPRUN=HOLD' Queue '//COPYCAT EXEC PGM=COPYCAT' Queue '//T3480IN DD UNIT=('||TPUNITI||',,DEFER)' Queue '//TAPEOUT DD UNIT=('||TPUNITO||',,DEFER),' If IDRC = 'YES' then Queue '// DCB=TRTCH=COMP' Else Queue '// DCB=TRTCH=NOCOMP' Queue '//SYSPRINT DD SYSOUT=*' Queue '//SYSOUT DD SYSOUT=*' Queue '//TMSRPT DD SYSOUT=*' Queue '//CCRPT DD SYSOUT=*' Queue '//SORTWK01 DD UNIT=SYSDA,SPACE=(CYL,(1,1))' Queue '//SORTWK02 DD UNIT=SYSDA,SPACE=(CYL,(1,1))' Queue '//SORTWK03 DD UNIT=SYSDA,SPACE=(CYL,(1,1))' Queue '//SYSIN DD *' Queue 'FILECOPY' If RUNMODE = 'PROD' then Queue 'FILES=ALL,SAVEINFO=YES,RECATALOG=PREV,INDISP=RETPD=0' Else Queue 'FILES=ALL,SAVEINFO=YES,RECATALOG=NONE,OUTDISP=RETPD=1' Queue 'INPUT=*' "EXECIO 18 DISKW COPYCAT" Return /*********************************************************************/ /* SUBROUTINE TO CREATE JCL FOR IEBGENER COPY STEP */ /*********************************************************************/ PUT_JCL: DSN.J = Strip(DSN.J) /* remove trailing blanks from dsn */ Queue '//************************************************' Queue '//* 'JOBPRE||JOBNUM' IEBGENER STACK STEP NUMBER '||J Queue '//************************************************' If J = 1 then Queue '//STEP'||J' EXEC PGM=IEBGENER' Else Queue '//STEP'||J' EXEC PGM=IEBGENER,COND=(0,NE)' Queue '//SYSPRINT DD SYSOUT=*' Queue '//SYSIN DD DUMMY' Queue '//SYSUT1 DD DSN='||DSN.J||',' Queue '// UNIT='||TPUNITI||',VOL=SER='||STKVOL.J||',' If RUNMODE = 'PROD' then Queue '// DISP=(SHR,'||INDISP.J||',KEEP)' Else Queue '// DISP=(SHR,KEEP,KEEP)' Queue '//SYSUT2 DD DSN='||DSN.J||',' Queue '// UNIT='||TPUNITO||',' If RUNMODE = 'PROD' then Queue '// LABEL=('||J||',SL,EXPDT='||STKJEXP.J'),' Else Queue '// LABEL=('||J||',SL,RETPD=1),' If RUNMODE = 'PROD' then Queue '// DISP=(NEW,'||OUTDISP.J||',DELETE),' Else Queue '// DISP=(NEW,KEEP,DELETE),' If J = 1 then Queue '// VOL=(,RETAIN),' Else Queue '// VOL=(,RETAIN,REF=*.STEP'||J-1||'.SYSUT2),' If IDRC = 'YES' then Queue '// DCB=TRTCH=COMP' Else Queue '// DCB=TRTCH=NOCOMP' "EXECIO 15 DISKW GENER" Return /*********************************************************************/ /* SUBROUTINE TO CREATE VOLSER CONTROL STATEMENTS FOR COPYCAT JOB */ /*********************************************************************/ PUT_VOLSER: Queue STKVOL.J "EXECIO 1 DISKW COPYCAT" Return /*********************************************************************/ /* SUBROUTINE TO CREATE TMSUPDTE STEP TO EXPIRE COPIED TAPES */ /*********************************************************************/ TMS_UPDATE: If RUNMODE <> 'PROD' then return Queue '//************************************************' Queue '//* 'JOBPRE||JOBNUM' TMSUPDTE STEP TO EXPIRE 'STKVOL.J Queue '//************************************************' Queue '//EXPIRE'||J 'EXEC PGM=TMSUPDTE,PARM='AUDIT',COND=(0,NE)' Queue '//TMSRPT DD SYSOUT=*' Queue '//SYSIN DD *' Queue 'VOL '||STKVOL.J||',NODSN' Queue 'REP EXPDT='||DATEJ "EXECIO 8 DISKW GENER" Return /* rexx */ RDATE: /* */ /* AUTHOR: Mark Zelden */ /* */ /************************************************/ /* Convert MM DD YYYY , YYYY DDD, or NNNNN to */ /* standard date output that includes the day */ /* of the week and the number of days (NNNNN) */ /* from January 1, 1900. This is not the same */ /* as the Century date! Valid input dates range */ /* from 01/01/1900 through 12/31/2172. */ /* */ /* A parm of "TODAY" can also be passed to */ /* the date conversion routine. */ /* MM DD YYYY can also be specifed as */ /* MM/DD/YYYY or MM-DD-YYYY. */ /* */ /* The output format is always as follows: */ /* MM/DD/YYYY.JJJ NNNNN WEEKDAY */ /* */ /* The above value will be put in the special */ /* REXX variable "RESULT" */ /* example: CALL RDATE TODAY */ /* example: CALL RDATE 1996 300 */ /* example: CALL RDATE 10 26 1996 */ /* example: CALL RDATE 10/26/1996 */ /* example: CALL RDATE 10-26-1996 */ /* example: CALL RDATE 35363 */ /* result: 10/26/1996.300 35363 Saturday */ /************************************************/ arg P1 P2 P3 If Pos('/',P1) <> 0 | Pos('-',P1) <> 0 then do PX = Translate(P1,' ','/-') Parse var PX P1 P2 P3 End JULTBL = '000031059090120151181212243273304334' DAY.0 = 'Sunday' DAY.1 = 'Monday' DAY.2 = 'Tuesday' DAY.3 = 'Wednesday' DAY.4 = 'Thursday' DAY.5 = 'Friday' DAY.6 = 'Saturday' Select When P1 = 'TODAY' then do P1 = Substr(date('s'),5,2) P2 = Substr(date('s'),7,2) P3 = Substr(date('s'),1,4) call CONVERT_MDY call THE_END end When P2 = '' & P3 = '' then do call CONVERT_NNNNN call THE_END end When P3 = '' then do call CONVERT_JDATE call DOUBLE_CHECK call THE_END end otherwise do call CONVERT_MDY call DOUBLE_CHECK call THE_END end end /* end select */ /* say RDATE_VAL; exit 0 */ return RDATE_VAL /**********************************************/ /* E N D O F M A I N L I N E C O D E */ /**********************************************/ CONVERT_MDY: if P1<1 | P1>12 then do say 'Invalid month passed to date routine' exit 12 end if P2<1 | P2>31 then do say 'Invalid day passed to date routine' exit 12 end if (P1=4 | P1=6 | P1=9 | P1=11) & P2>30 then do say 'Invalid day passed to date routine' exit 12 end if P3<1900 | P3>2172 then do say 'Invalid year passed to date routine. Must be be 1900-2172' exit 12 end BASE = Substr(JULTBL,((P1-1)*3)+1,3) if (P3//4=0 & P3<>1900 & P3<>2100) then LEAP= 1 else LEAP = 0 if P1 > 2 then BASE = BASE+LEAP JJJ = BASE + P2 MM = P1 DD = P2 YYYY = P3 return CONVERT_NNNNN: if P1<1 | P1>99712 then do say 'Invalid date passed to date routine. NNNNN must be 1-99712' exit 12 end /* Determine YYYY and JJJ */ if P1>365 then P1=P1+1 YEARS_X4=(P1-1)%1461 JJJ=P1-YEARS_X4*1461 if P1 > 73415 then JJJ = JJJ +1 EXTRA_YEARS=(JJJ*3-3)%1096 JJJ=JJJ-(EXTRA_YEARS*1096+2)%3 YYYY=YEARS_X4*4+EXTRA_YEARS+1900 P1 = YYYY ; P2 = JJJ ; call CONVERT_JDATE CONVERT_JDATE: if P1<1900 | P1>2172 then do say 'Invalid year passed to date routine. Must be be 1900-2172' exit 12 end if P2<1 | P2>366 then do say 'Invalid Julian date passed to date routine' exit 12 end if (P1//4=0 & P1<>1900 & P1<>2100) then LEAP= 1 else LEAP = 0 ADJ1 = 0 ADJ2 = 0 Do MM = 1 to 11 VAL1 = Substr(JULTBL,((MM-1)*3)+1,3) VAL2 = Substr(JULTBL,((MM-1)*3)+4,3) if MM >=2 then ADJ2 = LEAP if MM >=3 then ADJ1 = LEAP if P2 > VAL1+ADJ1 & P2 <= VAL2+ADJ2 then do DD = P2-VAL1-ADJ1 MATCH = 'Y' leave end end if MATCH <> 'Y' then do MM = 12 DD = P2-334-LEAP end YYYY = P1 JJJ = P2 return DOUBLE_CHECK: if MM = 2 then do if DD > 28 & LEAP = 0 then do say 'Invalid day passed to date routine' exit 12 end if DD > 29 & LEAP = 1 then do say 'Invalid day passed to date routine' exit 12 end end if LEAP = 0 & JJJ > 365 then do say 'Invalid Julian date passed to date routine' exit 12 end return THE_END: YR_1900 = YYYY-1900 NNNNN = (YR_1900*365) +(YR_1900+3)%4 + JJJ if YYYY > 1900 then NNNNN = NNNNN-1 if YYYY > 2100 then NNNNN = NNNNN-1 INDEX = NNNNN//7 /* index to DAY stem */ WEEKDAY = DAY.INDEX DD = Right(DD,2,'0') MM = Right(MM,2,'0') YYYY = Strip(YYYY) NNNNN = Right(NNNNN,5,'0') JJJ = Right(JJJ,3,'0') RDATE_VAL = MM||'/'||DD||'/'||YYYY||'.'||JJJ||' '||NNNNN||' '||WEEKDAY return