Error Handling of constraints, triggers, etc Was: Some database discussions...

I've even seen processing where a message was thrown before the operation
was attempted, just to be a starting point. Then the operation was
attempted. If there was a failure it was handled and all messages up to
the starting point were cleansed from the joblog.

Notice &LOWKEY and &HIKEY below.

PGM
DCL &MSGKEY *CHAR 4
DCL &MSGID *CHAR 7
DCL &LOWKEY *CHAR 4
DCL &HIKEY *CHAR 4
DCL &MSGDTA *CHAR 80


SNDPGMMSG MSG(TEST) TOPGMQ(*SAME) KEYVAR(&LOWKEY)
RMVMSG MSGKEY(&LOWKEY)

STRTCPSVR SERVER(*MGTC)

MONMSG TCP1A77 EXEC(DO) /* STRTCPSVR errors occurred */
SNDPGMMSG MSG(TEST) TOPGMQ(*SAME) KEYVAR(&HIKEY)
RMVMSG MSGKEY(&HIKEY)

/* Get the diagnostic message */
CHGVAR %BIN(&MSGKEY 1 4) (%BIN(&LOWKEY 1 4) + 1)
DoWhile ((%BIN(&msgkey 1 4)) < (%BIN(&hikey 1 4)))
RCVMSG PGMQ(*SAME (*)) MSGKEY(&MSGKEY) MSGID(&MSGID) RMV(*NO) +
MSGDTA(&MSGDTA)
MONMSG CPF2410 EXEC(DO) /* msgkey not found */
RCVMSG MSGTYPE(*EXCP) RMV(*YES) /* Remove unwanted exception */
GOTO SKIP
EndDo
select
when (&msgid=' ') /* Strange blank message */
when (&msgid='CPC2206') /* Ignore job list user space msg *
when (&msgid='CPFB921') then(do)
/* Management Central Server job was not submitted. */
select
when (%sst(&msgdta 1 2)='01') then(do)
/* Reason code 01 */
/* Already running. 'Normal' */
leave
EndDo
otherwise (do) /* Unknown reason code */
SNDPGMMSG MSGID(CPF9898) MSGF(QCPFMSG) +
MSGTYPE(*ESCAPE) MSGDTA('Check joblog for TCP1A77')
EndDo
EndSelect /* CPFB921 */
EndDo /* CPFB921 */
otherwise (do) /* not CPFB921 */
SNDPGMMSG MSGID(CPF9898) MSGF(QCPFMSG) +
MSGTYPE(*ESCAPE) MSGDTA('Check joblog for TCP1A77')
EndDo
EndSelect
SKIP:
chgvar %bin(&msgkey 1 4) (%bin(&msgkey 1 4) + 1)
EndDo
EndDo /* TCP1A77 */
END:
ENDPGM





Rob Berendt