Problem solve Get help with specific problems with your technologies, process and projects.

Sample LE/date functions from CLPLE

Here you'll find a sample LE/date functions from CLPLE chart.

Calculate functions:

A- Give between two date differences
B- Compute day of week
C- Date accumulator from beginning date

You can call this routine from any of your applications.

SAYDAYS.CLPLE

 

/**************************************/
/* SAYDAYS CLP/LE MAB13               */
/* USAGE:                             */
/*                                    */
/*  FORMAT 1: Between two date diff.  */
/*      SAYDAYS DATE1 DATE2 1         */
/*                                    */
/*  FORMAT 2: Compute day of week     */
/*      SAYDAYS DATE 2                */
/*                                    */
/*  FORMAT 3: Date accum. from spec. date */
/*      SAYDAYS DATE NUM 3            */
/*                                    */
/**************************************/

  PGM PARM(&FIRSTDATE &LASTDATE &RTNVAL)
  DCL  &BLANK     *CHAR  LEN(6)
  DCL  &FIRSTDATE *CHAR  LEN(6)
  DCL  &LASTDATE  *CHAR  LEN(6)
  DCL  &RTNVAL1   *CHAR  LEN(4)
  DCL  &RTNVAL2   *CHAR  LEN(4)
  DCL  &RTNVAL3   *DEC   LEN(10)
  DCL  &PICSTR    *CHAR  LEN(6)  VALUE(DDMMYY)
  DCL  &RTNVAL    *CHAR  LEN(10)

  IF (&RTNVAL *EQ '0000000001') GOTO CMDLBL(DATEDIFF)
  IF (&RTNVAL *EQ '0000000002') GOTO CMDLBL(DAYOFWEEK)
  IF (&RTNVAL *EQ '0000000003') GOTO CMDLBL(DATEACCUM)
  CHGVAR VAR(&RTNVAL) VALUE(-1)
  GOTO CMDLBL(EXIT)

/**************************************/
/* TWO DATE DIFFERENCES                          */
/*************************************/
  DATEDIFF:
  CHGVAR VAR(&RTNVAL) VALUE(-1)
  IF (&FIRSTDATE *EQ &BLANK) GOTO CMDLBL(EXIT)
  IF (&LASTDATE  *EQ &BLANK) GOTO CMDLBL(EXIT)

  CALLPRC  PRC(CEEDAYS) PARM(&FIRSTDATE &PICSTR &RTNVAL1 *OMIT)
  CALLPRC  PRC(CEEDAYS) PARM(&LASTDATE &PICSTR &RTNVAL2 *OMIT)
  CHGVAR VAR(&RTNVAL3) VALUE(%BIN(&RTNVAL1) - %BIN(&RTNVAL2) + 1)
  IF (&RTNVAL3 *LT 0) CHGVAR &RTNVAL3 VALUE(&RTNVAL3 * -1)
  CHGVAR VAR(&RTNVAL) VALUE(&RTNVAL3)

  GOTO CMDLBL(EXIT)

/**************************************/
/* DAY OF WEEK SUBROUTINE                           */
/**************************************/
  DAYOFWEEK:
  CALLPRC  PRC(CEEDAYS) PARM(&FIRSTDATE &PICSTR &RTNVAL1 *OMIT)
  CALLPRC  PRC(CEEDYWK) PARM(&RTNVAL1 &RTNVAL2 *OMIT)
  CHGVAR VAR(%BIN(&RTNVAL2)) VALUE(%BIN(&RTNVAL2) - 1)
  IF (%BIN(&RTNVAL2) *LE 0) CHGVAR VAR(%BIN(&RTNVAL2)) VALUE(7)
  CHGVAR VAR(&RTNVAL) VALUE(%BIN(&RTNVAL2))

  GOTO CMDLBL(EXIT)

/**************************************/
/* DATE ACCUMULATOR                      */
/**************************************/
  DATEACCUM:
  CHGVAR VAR(&RTNVAL) VALUE(-1)
  IF (&FIRSTDATE *EQ &BLANK) GOTO CMDLBL(EXIT)
  IF (&LASTDATE *EQ &BLANK) GOTO CMDLBL(EXIT)
  CALLPRC  PRC(CEEDAYS) PARM(&FIRSTDATE &PICSTR &RTNVAL1 *OMIT)
  CHGVAR %BIN(&RTNVAL2) VALUE(&LASTDATE)
  CHGVAR VAR(%BIN(&RTNVAL1)) VALUE(%BIN(&RTNVAL1) + %BIN(&RTNVAL2))
  CALLPRC  PRC(CEEDATE) PARM(&RTNVAL1 &PICSTR &RTNVAL *OMIT)

  GOTO CMDLBL(EXIT)

  EXIT:
  RETURN
ENDPGM
----------------------------------------
SAYDAYS.CMD

SAYDAYS:   CMD
           PARM  KWD(FIRSTDATE) +
                   TYPE(*CHAR) LEN(6) +
                   PROMPT('FIRST DATE')
           PARM  KWD(LASTDATE) +
                   TYPE(*CHAR) LEN(6) +
                   PROMPT('LAST DATE')
           PARM  KWD(RTNVALUE) +
                   TYPE(*CHAR) LEN(6) +
                   PROMPT('RETURN VALUE') +
                   RTNVAL(*YES)


-----------------------------------

Usage Sample-1: CLP Sample

PGM
DCL &RTNVALUE *CHAR 10
CHGVAR &RTNVALUE 1
SAYDAYS '280601' '250561' &RTNVALUE
SNDMSG MSG(&RTNVALUE) TOUSR(.....)
ENDPGM
----------------------------------
Usage Sample-2: Cobol Sample

       WORKING-STORAGE SECTION.
       01  MISC.
           05  FIRSTDATE       PIC X(6).
           05  LASTDATE        PIC X(6).
           05  RTNVAL          PIC S9(10).
       PROCEDURE DIVISION.
       MAIN-LINE.
      *
      *************************************************************
      * IKI TARIH ARASINDA GECEN GUN SAYISINI BULUR               *
      *************************************************************
           MOVE '1' TO RTNVAL.
           MOVE '180601' TO FIRSTDATE.
           MOVE '140601' TO LASTDATE.
           CALL 'SAYDAYS' USING FIRSTDATE OF MISC,
                                LASTDATE OF MISC,
                                RTNVAL OF MISC.
           DISPLAY 'DATE DIFF:', RTNVAL.
      *************************************************************
      * VERILEN TARIHTEKI HAFTANIN GUNUNU BULUR                   *
      *************************************************************
           MOVE '030601' TO FIRSTDATE.
           MOVE '2' TO RTNVAL.
           CALL 'SAYDAYS' USING FIRSTDATE OF MISC,
                                LASTDATE OF MISC,
                                RTNVAL OF MISC.
           DISPLAY 'DAY OF WEEK:', RTNVAL.
      *
      *************************************************************
      * VERILEN TARIHIN UZERINE GECEN GUN SAYISINI TOPLAR         *
      * YENI GUN DEGERINI BULUR                                   *
      *************************************************************
           MOVE '010601' TO FIRSTDATE.
           MOVE '15' TO LASTDATE.
           MOVE '3' TO RTNVAL.
           CALL 'SAYDAYS' USING FIRSTDATE OF MISC,
                                LASTDATE OF MISC,
                                RTNVAL OF MISC.
           DISPLAY 'DATE ACCUM:', RTNVAL.  

Dig Deeper on iSeries CL programming

Start the conversation

Send me notifications when other members comment.

Please create a username to comment.

-ADS BY GOOGLE

SearchDataCenter

Close