|
midrange.com
I've found the cl source for my alternate QCMD processor. You will need to
adapt the validation and rejection messages of course.
PGM
/* Work field declarations */
DCL VAR(&CRT) TYPE(*CHAR) LEN(6)
DCL VAR(&IND) TYPE(*CHAR) LEN(1)
DCL VAR(&JOBNAM) TYPE(*CHAR) LEN(10)
DCL VAR(&JOBNBR) TYPE(*CHAR) LEN(6)
DCL VAR(&JOBUSR) TYPE(*CHAR) LEN(10)
DCL VAR(&RQSDTA) TYPE(*CHAR) LEN(256)
/* Retreive the submitted command */
DUMMY: RCVMSG PGMQ(*EXT) MSGTYPE(*RQS) MSG(&RQSDTA)
/* Flag Compilation commands */
CHGVAR VAR(&CRT) VALUE(%SST(&RQSDTA 1 6))
CHGVAR VAR(&IND) VALUE('0')
IF COND(&CRT = 'COMPFI') THEN(CHGVAR VAR(&IND) VALUE('1'))
IF COND(&CRT = 'CRTBND') THEN(CHGVAR VAR(&IND) VALUE('1'))
IF COND(&CRT = 'CRTCBL') THEN(CHGVAR VAR(&IND) VALUE('1'))
IF COND(&CRT = 'CRTCLM') THEN(CHGVAR VAR(&IND) VALUE('1'))
IF COND(&CRT = 'CRTCLP') THEN(CHGVAR VAR(&IND) VALUE('1'))
IF COND(&CRT = 'CRTDSP') THEN(CHGVAR VAR(&IND) VALUE('1'))
IF COND(&CRT = 'CRTPGM') THEN(CHGVAR VAR(&IND) VALUE('1'))
IF COND(&CRT = 'CRTBND') THEN(CHGVAR VAR(&IND) VALUE('1'))
IF COND(&CRT = 'CRTPRT') THEN(CHGVAR VAR(&IND) VALUE('1'))
IF COND(&CRT = 'CRTRPG') THEN(CHGVAR VAR(&IND) VALUE('1'))
IF COND(&CRT = 'CRTSQL') THEN(CHGVAR VAR(&IND) VALUE('1'))
IF COND(&CRT = 'CRTS36') THEN(CHGVAR VAR(&IND) VALUE('1'))
/* Execute non-compilation requests */
IF COND(&IND *EQ '0') THEN(DO)
CALL PGM(*LIBL/QCMDEXC) PARM(&RQSDTA 256)
MONMSG MSGID(CPF0000 MCH0000)
ENDDO
/* Reject compilation requests */
IF COND(&IND *EQ '1') THEN(DO)
RTVJOBA JOB(&JOBNAM) USER(&JOBUSR) NBR(&JOBNBR)
SNDPGMMSG MSGID(CPF9898) MSGF(QCPFMSG) MSGDTA('Job' +
*BCAT &JOBNAM *TCAT '/' *TCAT &JOBUSR +
*TCAT '/' *TCAT &JOBNBR *BCAT 'must be +
submitted to the COMPILE subsystem, job +
queue QBATCHC. Submitted command was +
CMD(' *TCAT &RQSDTA *TCAT ')') +
TOUSR(&JOBUSR) MSGTYPE(*DIAG)
SNDPGMMSG MSGID(CPF9898) MSGF(QCPFMSG) MSGDTA('Job' +
*BCAT &JOBNAM *TCAT '/' *TCAT &JOBUSR +
*TCAT '/' *TCAT &JOBNBR *BCAT 'submitted +
to QBATCHM *SBS in error. Command was +
CMD(' *TCAT &RQSDTA *TCAT ')') +
TOUSR(BULLJ1) MSGTYPE(*INFO)
DSPJOBLOG JOB(*) OUTPUT(*PRINT)
SNDPGMMSG MSGID(CPF0001) MSGF(QCPFMSG) +
MSGDTA('submitted') TOUSR(&JOBUSR) +
MSGTYPE(*ESCAPE)
SNDPGMMSG MSGID(CPC2402) MSGF(QCPFMSG) MSGTYPE(*COMP)
ENDDO
/* Program Exit Procedure */
RETURN
ENDPGM
DISCLAIMER
Any opinions expressed in this email are those of the
individual and not necessarily the Company. This email
and any files transmitted with it, including replies and
forwarded copies (which may contain alterations)
subsequently transmitted from the Company, are
confidential and solely for the use of the intended recipient. If you are not
the intended recipient or the
person responsible for delivering to the intended recipient,
be advised that you have received this email in error and
that any use is strictly prohibited.
If you have received this email in error please notify the IT
manager by telephone on +44 (0)870 871 2233 or via
email to Administrator@itm-group.co.uk, including a copy
of this message. Please then delete this email and
destroy any copies of it.
________________________________________________________________________
This e-mail has been scanned for all viruses by ITM. The
service is powered by MessageLabs. For more information on a proactive
anti-virus service working around the clock, around the globe,
email marketing@itm-group.co.uk
ITM - Managing Communication and Information through technology
________________________________________________________________________
As an Amazon Associate we earn from qualifying purchases.
This mailing list archive is Copyright 1997-2024 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.
