Booth Martin; Contract 
Programming, Inc.
28 Delmont Avenue
Barre, Vermont 05641
802-476-7942
boothm@ibm.net

An RPGLE program to validate and/or convert date fields



To validate & convert date fields

      * ::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
      * : PURPOSE OF PROGRAM: Provide a "black box" for dates in and :
      * : out, error checking, and date conversions for OPM RPG.     :
      * : DATE:  PROGRAMMER ACTION:                                  :
      * :                   PROGRAM WRITTEN.                         :
      * :  9/97             Use RPGLE for date conversions           :
     :*______________________________________________________________:
     :*..   Here is sample OPM code that provides the validation   ..:
     :*..   process for any supported date format and returns a    ..:
     :*..   properly formatted date for your OPM program.          ..:
     C****************************************************************
     C**                  Start of OPM code.                        **
     C****************************************************************
     C** In-line code for Date Checking and Conversion process      **
     C** (Fills the PARMS before exercising the Sub-Routine)        **
     C*                     MOVE DATE?     DATEN
     C*                     MOVE '*MDY'    FMTIN
     C*                     MOVE '*ISO'    FMTOUT
     C*                     EXSR CHKMDY
     C*           ERROR     IFEQ '0'
     C*                     MOVE DATEN     DATE?
     C*                 (or whatever)
     C*                     ELSE
     C*                 (Do the Error-handling chores)
     C*                     END
     C****************************************************************
     C** Sub Routine  -  Date Checking and Conversion process       **
     C****************************************************************
     C** Date Validity Checker: It verifys any 6/0 or 8/0 number
     C** as a valid or invalid date.  It is also useful for changing
     C** the format of any valid date.  The 6-digit dates use the
     C** window technique of 1940 through 2039.
     C*
     C*           CHKMDY    BEGSR
     C*                     CALL 'DATEBOX'
     C*                     PARM           DATEA  10
     C*                     PARM           DATEN   80
     C*                     PARM           FMTIN   4
     C*                     PARM           FMTOUT  4
     C*                     PARM           ERROR   1
     C*                     ENDSR
     C****************************************************************
      ** (if copied & pasted, then remove the column of asterisks   **
      ** to restore spacing.)                                       **
     C**               End of OPM code.                             **
     C****************************************************************
      * Parms are:
      *  # 1 =  10 char. field for date, (formatted)
      *  # 2 =  8 digit field for date, (numbers)
      *  # 3 =  Format of date coming in:
      *  # 4 =  Format of date to go out for Parm DateA & DateN.
      *  # 5 =  a field for error code(s).
      *         Error Codes:
      *         '0' = no error found
      *         '1' = error found; not a valid *MDY date.
      *         '2' = error found; not a valid *DMY date.
      *         '3' = error found; not a valid *YMD date.
      *         '4' = error found; not a valid *ISO date.
      *         '5' = error found; not a valid *USA DATE.
      *         '6' = error found; FmtIn not supported.
      * Formats handled are:  *MDY
      *                       *DMY
      *                       *YMD
      *                       *ISO (out, only)
      *                       *USA
      *
      * Please note: DateN is the field that is used for the input.
     Hdatfmt(*USA)
     D DateISO         s               d   DATFMT(*ISO)
     C     *entry        plist
     C                   parm                    DateA            10
     C                   parm                    DateN             8 0
     C                   parm                    FmtIn             4
     C                   parm                    FmtOut            4
     C                   parm                    Error             1
      ** If FmtIn is blank, move *USA into field:
     C     FmtIn         Ifeq      *blanks
     C                   move      '*USA'        FmtIn
     C                   end
      ** If DateN is zeros then today's date is being requested:
     C     DateN         Ifle      *zeros
     C                   move      *date         DateN
     C                   move      '*USA'        FmtIn
     C                   end
      * ---------------------------------------------------------
     C                   move      '0'           Error
     C                   select
     C     FmtIn         WhenEq    '*MDY'
     C     *mdy          test(d)                 DateN                  99      
     C  N99*mdy          move      DateN         DateISO
     C   99              move      '1'           Error
      *
     C     FmtIn         WhenEq    '*DMY'
     C     *dmy          test(d)                 DateN                  99
     C  N99*dmy          move      DateN         DateISO
     C   99              move      '2'           Error
      *
     C     FmtIn         WhenEq    '*YMD'
     C     *ymd          test(d)                 DateN                  99
     C  N99*ymd          move      DateN         DateISO
     C   99              move      '3'           Error
      *
     C*    FmtIn         WhenEq    '*ISO'
     C*    *iso          test(d)                 Date_                  99
     C* N99*iso          move      Date_         DateISO
     C*  99              move      '4'           Error
      *
     C     FmtIn         WhenEq    '*USA'
     C     *usa          test(d)                 DateN                  99
     C  N99*usa          move      DateN         DateISO
     C   99              move      '5'           Error
      *
     C                   Other
     C                   move      '6'           Error
      *
     C                   endsl
      * ---------------------------------------------------------
     C     Error         Ifgt      '0'
     C                   return
     C                   end
      * -----------------------------------------------------------
      *  DateISO now holds validated date field, for reformatting :
      * -----------------------------------------------------------
     C                   select
     C     FmtOut        WhenEq    '*MDY'
     C     *usa          move      DateISO       DateA
     C     *MDY          move      DateISO       DateN
     C*
     C     FmtOut        WhenEq    '*DMY'
     C     *eur          move      DateISO       DateA
     C     *dmy          move      DateISO       DateN
     C*
     C     FmtOut        WhenEq    '*YMD'
     C     *iso          move      DateISO       DateA
     C     *ymd          move      DateISO       DateN
     C*
     C     FmtOut        WhenEq    '*ISO'
     C     *iso          move      DateISO       DateA
     C     *iso          move      DateISO       DateN
     C*
     C     FmtOut        WhenEq    '*USA'
     C     *usa          move      DateISO       DateA
     C     *usa          move      DateISO       DateN
     C*
     C                   endsl
      * ---------------------------------------------------------
     C                   return
      ***

For comments or questions leave e-mail
A series of code for FTP of AS/400 files.
Review a sample of my coding work
Return to my home page
Top of page