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
***
|
