|
midrange.com
> -----Original Message-----
> Is there a way to copy an existing Job Schedule Entry to a
> new one? It
> seems it would be much easier to set up some submissions if
> you could copy
> and edit one that already exists.
Here is a Command and Command processing program that will do it for you:
/* ***************************************************************** */
/* */
/* COMMAND - CRTDUPSCDE - CREATE DUPLICATE JOB SCHEDULE ENTRY */
/* */
/* CPP - CRTDUPSCDE */
/* */
/* ***************************************************************** */
CMD PROMPT('Create dupl job schedule entry')
PARM KWD(FROMJOB) +
TYPE(*NAME) +
LEN(10) +
MIN(1) +
PROMPT('From job name')
PARM KWD(NEWNAME) +
TYPE(*NAME) +
LEN(10) +
DFT(*FROMJOB) +
SPCVAL((*FROMJOB)) +
PROMPT('New job name')
/* ***************************************************************** */
/* */
/* PROGRAM - CRTDUPSCDE - CREATE DUPLICATE JOB SCHEDULE ENTRY */
/* */
/* ***************************************************************** */
CRTDUPSCDE: PGM PARM(&fromjob &newname)
DCL &fromjob *CHAR 10
DCL &newname *CHAR 10
DCL &cmd *CHAR 512
DCL &cmdstr *CHAR 3000
DCL &continue *CHAR 16
DCL &entlen *CHAR 4
DCL &entry *CHAR 1156
DCL &frq *CHAR 10
DCL &header *CHAR 140
DCL &jobd *CHAR 20
DCL &jobq *CHAR 20
DCL &msgq *CHAR 20
DCL &nbrent *CHAR 4
DCL &offset *CHAR 4
DCL &rcyacn *CHAR 10
DCL &reldaymon *CHAR 50
DCL &save *CHAR 10
DCL &scddate *CHAR 10
DCL &scdday *CHAR 70
DCL &scdtime *CHAR 6
DCL &strpos *CHAR 4
DCL &text *CHAR 50
DCL &user *CHAR 10
DCL &usrspc *CHAR 20 'ZZSCDL0200QTEMP '
MONMSG CPF9999 EXEC(GOTO ERROR)
/* If duplicate entry is to be named the same as the from entry, */
/* create the name for the duplicate entry. */
IF (&newname = '*FROMJOB') DO
CHGVAR &newname &fromjob
ENDDO
/* Create user space to hold schedule entry list. */
DLTUSRSPC USRSPC(QTEMP/ZZSCDL0200)
MONMSG CPF0000
CALL QUSCRTUS PARM(&usrspc +
'CRTDUPSCDE' +
X'00000100' +
' ' +
'*ALL ' +
' ')
/* Retrieve schedule entry list into user space, get header info. */
CALL QWCLSCDE PARM(&usrspc +
'SCDL0200' +
&fromjob +
&continue +
0)
CALL QUSRTVUS PARM(&usrspc +
X'00000001' +
X'0000008C' +
&header)
/* If list is incomplete, leave. */
IF (%SST(&header 104 1) *EQ 'I') DO
SNDPGMMSG MSG('Error: CRTDUPSCDE retrieved an +
incomplete list of schedule entries.')
RETURN
ENDDO
/* If number of entries in list is zero, escape. */
CHGVAR &nbrent (%SST(&header 133 4))
IF (%BIN(&nbrent) *EQ 0) DO
SNDPGMMSG MSG('Error: CRTDUPSCDE did not retrieve +
any schedule entries.')
RETURN
ENDDO
/* Get entry length, offset, and start position from header. *
CHGVAR &entlen (%SST(&header 137 4))
CHGVAR &offset (%SST(&header 125 4))
CHGVAR (%BIN(&strpos)) (%BIN(&offset) + 1)
/* Retrieve the first entry in the list */
CALL QUSRTVUS PARM(&usrspc +
&strpos +
&entlen +
&entry)
/* Get the individual parameters from the list entry */
CHGVAR &cmd (%SST(&entry 645 512))
CHGVAR &frq (%SST(&entry 108 10))
CHGVAR &scddate (%SST(&entry 22 10))
If Cond(%SST(&entry 22 1) *eq '0') Then(DO)
CvtDat Date(&SCDDATE) ToVar(&SCDDATE) +
FromFmt(*CYMD) ToFmt(*JOB) ToSep(*NONE)
Enddo
CHGVAR &scdday (%SST(&entry 32 70))
CHGVAR &scdtime (%SST(&entry 102 6))
CHGVAR &reldaymon (%SST(&entry 118 50))
CHGVAR &save (%SST(&entry 577 10))
CHGVAR &rcyacn (%SST(&entry 168 10))
IF (%SST(&entry 537 10) *NE ' ') +
CHGVAR &jobd (%SST(&entry 537 10) *TCAT '/' +
*TCAT %SST(&entry 527 10))
ELSE +
CHGVAR &jobd (%SST(&entry 527 10))
IF (%SST(&entry 208 10) *NE ' ') +
CHGVAR &jobq (%SST(&entry 208 10) *TCAT '/' +
*TCAT %SST(&entry 198 10))
ELSE +
CHGVAR &jobq (%SST(&entry 198 10))
CHGVAR &user (%SST(&entry 547 10))
IF (%SST(&entry 567 10) *NE ' ') +
CHGVAR &msgq (%SST(&entry 567 10) *TCAT '/' +
*TCAT %SST(&entry 557 10))
ELSE +
CHGVAR &msgq (%SST(&entry 557 10))
CHGVAR &text ('Copy of' *BCAT &fromjob)
/* Build command string to add a new job schedule entry */
CHGVAR &cmdstr
+
('ADDJOBSCDE JOB(' *TCAT &newname +
*TCAT ') CMD(' *TCAT &cmd +
*TCAT ') FRQ(' *TCAT &frq +
*TCAT ') SCDDATE(' *TCAT &scddate +
*TCAT ') SCDDAY(' *TCAT &scdday +
*TCAT ') SCDTIME(' *TCAT &scdtime +
*TCAT ') RELDAYMON(' *TCAT &reldaymon +
*TCAT ') SAVE(' *TCAT &save +
*TCAT ') RCYACN(' *TCAT &rcyacn +
*TCAT ') JOBD(' *TCAT &jobd +
*TCAT ') JOBQ(' *TCAT &jobq +
*TCAT ') USER(' *TCAT &user +
*TCAT ') MSGQ(' *TCAT &msgq +
*TCAT ') TEXT(''' *TCAT &text +
*TCAT ''')')
/* Add a new job schedule entry */
CALL QCMDEXC PARM(&cmdstr 3000)
/* Job cleanup */
DLTUSRSPC USRSPC(QTEMP/ZZSCDL0200)
MONMSG CPF0000
RETURN
/* Error message */
ERROR: SNDPGMMSG MSG('Error occurred during CRTDUPSCDE +
command. See job log for details.')
ENDPGM
____________________________________________________________________
Get free email and a permanent address at http://www.amexmail.com/?A=1
+---
| This is the Midrange System Mailing List!
| To submit a new message, send your mail to MIDRANGE-L@midrange.com.
| To subscribe to this list send email to MIDRANGE-L-SUB@midrange.com.
| To unsubscribe from this list send email to MIDRANGE-L-UNSUB@midrange.com.
| Questions should be directed to the list owner/operator: david@midrange.com
+---
As an Amazon Associate we earn from qualifying purchases.
This mailing list archive is Copyright 1997-2025 by midrange.com and David Gibbs as a compilation work. Use of the archive is restricted to research of a business or technical nature. Any other uses are prohibited. Full details are available on our policy page. If you have questions about this, please contact [javascript protected email address].
Operating expenses for this site are earned using the Amazon Associate program and Google Adsense.
