News Stay informed about the latest enterprise technology news and product updates.

ISeries Warning -- Code

code

 
 
    100 /* ************************************************************** */

    200 /* PROGRAM DESCRIPTION : CLEAR ALL INCOMING MAIL, BY USERID       */

    300 /*                                                                */

    400 /*                                                                */

    500 /* SPECIAL COMPILE OPTIONS:                                       */

    600 /*                                                                */

    700 /*           WRITTEN BY: KEN GRAAP 01/30/98                       */

    800 /*           UPDATED BY:                                          */

    900 /*                                                                */

   1000 /* ************************************************************** */

   1100              PGM        PARM(&DATE)

   1200 /* ************************************************************** */

   1300 /*                                                                */

   1400 /* DECLARE PROGRAM VARIABLES                                      */

   1500 /*                                                                */

   1600 /* ************************************************************** */

   1700              DCL        VAR(&DATE) TYPE(*CHAR) LEN(6)

   1800              DCL        VAR(&MM) TYPE(*CHAR) LEN(2)

   1900              DCL        VAR(&DD) TYPE(*CHAR) LEN(2)

   2000              DCL        VAR(&YY) TYPE(*CHAR) LEN(2)

   2100              DCL        VAR(&DLTDATE) TYPE(*CHAR) LEN(6)

   2200              DCL        VAR(&MAILDATE) TYPE(*CHAR) LEN(6)

   2300              DCLF       FILE(QSYS/QAOSILIN) RCDFMT(OSLIN)

   2400              DCL        &ERRORSW *LGL                     /* Std err
*/
   2500              DCL        &MSGID *CHAR LEN(7)               /* Std err
*/
   2600              DCL        &MSGDTA *CHAR LEN(100)            /* Std err
*/
   2700              DCL        &MSGF *CHAR LEN(10)               /* Std err
*/
   2800              DCL        &MSGFLIB *CHAR LEN(10)            /* Std err
*/
   2900 /* ************************************************************** */

   3000 /*                                                                */

   3100 /* GLOBAL MESSAGE MONITOR                                         */

   3200 /*                                                                */

   3300 /* ************************************************************** */

   3400              MONMSG     MSGID(CPF0000) EXEC(GOTO CMDLBL(STDERR1))

   3500 /* ************************************************************** */

   3600 /*                                                                */

   3700 /* CHECK FOR INCOMING MAIL. DELETE IF OLDER THAN DATE SPECIFIED.  */

   3800 /*                                                                */

   3900 /* ************************************************************** */

   4000

   4100              IF         COND(&DATE *EQ TODAY) THEN(CVTDAYN +

   4200                           DATE(*TODAY) CVTDAT(&DATE))

   4300

   4400              CHKDAT     DATE(&DATE) DAYHIRNG(0)

   4500

   4600              SNDPGMMSG  MSG('All IN distributions equal to or older
+ 
   4700                           than' *BCAT &DATE *BCAT 'Will be
deleted.') 
   4800

   4900              QRYDST     OUTFILE(QTEMP/IN)

   5000              OVRDBF     FILE(QAOSILIN) TOFILE(QTEMP/IN) MBR(*FIRST)

   5100  LOOP:       RCVF       RCDFMT(OSLIN)

   5200              MONMSG     MSGID(CPF0864) EXEC(GOTO CMDLBL(END))

   5300              CHGVAR     VAR(&MM) VALUE(%SST(&DATE 1 2))

   5400              CHGVAR     VAR(&DD) VALUE(%SST(&DATE 3 2))             
   5500              CHGVAR     VAR(&YY) VALUE(%SST(&DATE 5 2))

   5600              CHGVAR     VAR(&DLTDATE) VALUE(&YY *CAT &MM *CAT &DD)

   5700              CHGVAR     VAR(&MAILDATE) VALUE(%SST(&LINSDT 3 6))

   5800

   5900              IF         COND(&MAILDATE *LE &DLTDATE) THEN(DO)

   6000              DLTDST     DSTID(&LINDID) OPTION(*IN) USRID(*CURRENT) +

   6100                           DSTIDEXN(&LINDEX)

   6200              MONMSG     MSGID(CPF0000)

   6300              ENDDO

   6400              GOTO       CMDLBL(LOOP)

   6500

   6600 /* ************************************************************** */

   6700 /*                                                                */

   6800 /* NORMAL END OF PROGRAM                                          */

   6900 /*                                                                */

   7000 /* ************************************************************** */

   7100  END:        RETURN

   7200 /* ************************************************************** */

   7300 /*                                                                */

   7400 /* STANDARD ERROR PROCESSING                                      */

   7500 /*                                                                */

   7600 /* ************************************************************** */

   7700  STDERR1:               /* Standard error handling routine */
   7800              IF         &ERRORSW SNDPGMMSG MSGID(CPF9999) +
   7900                           MSGF(QCPFMSG) MSGTYPE(*ESCAPE) /* Func chk
*/
   8000              CHGVAR     &ERRORSW '1' /* Set to fail ir error occurs
*/
   8100  STDERR2:    RCVMSG     MSGTYPE(*DIAG) MSGDTA(&MSGDTA) MSGID(&MSGID)
+
   8200                           MSGF(&MSGF) MSGFLIB(&MSGFLIB)
   8300              IF         (&MSGID *EQ '       ') GOTO STDERR3
   8400              SNDPGMMSG  MSGID(&MSGID) MSGF(&MSGFLIB/&MSGF) +
   8500                           MSGDTA(&MSGDTA) MSGTYPE(*DIAG)
   8600              GOTO       STDERR2 /* Loop back for addl diagnostics */
   8700  STDERR3:    RCVMSG     MSGTYPE(*EXCP) MSGDTA(&MSGDTA) MSGID(&MSGID)
+
   8800                           MSGF(&MSGF) MSGFLIB(&MSGFLIB)
   8900              SNDPGMMSG  MSGID(&MSGID) MSGF(&MSGFLIB/&MSGF) +
   9000                           MSGDTA(&MSGDTA) MSGTYPE(*ESCAPE)
   9100              ENDPGM 

Dig Deeper on iSeries programming commands

Start the conversation

Send me notifications when other members comment.

Please create a username to comment.

-ADS BY GOOGLE

SearchDataCenter

Close