|
mancini wrote: > Does anyone have any sample code on the two following APIs. > > CEEDYWK - calculate Day of Week from Lilian Date. > > CEEDAYS - convert Date to Lilian Format. > > I need to find the day of the week for a certain date. > The attached ILE RPG source file will convert, check, return weekdays etc using CEEDYWK and CEEDAYS. You create the module and then into a service program if you wish or attach it directly to the program as a module. Have fun. -- Thank You. Regards Dave Mahadevan.. mailto:mahadevan@fuse.net
midrange.com
*****************************************************************
**********************************************************************************************
* Program DATE_CHG - Insert Century in a date, check date, return
various forms of date
**********************************************************************************************
**********************************************************************************************
* Input parameters are DATE_IN and DATE_FMT, rest is all output fields
* DATERR=N date is less than 010101, DATE_ERR=E invalid date
DINPUT_DATE DS 128
DDATE_IN 8 0
Input date
DDATE_FMT 4
*MDY,*YMD,*ISO,*USA
DDATE_ERR 1
N or E or Blank
DDATE_CY 2 0
Century
DDATE_YR 2 0
Year
DDATE_MO 2 0
Month
DDATE_DY 2 0
Day
DDATE_YMD D DATFMT(*YMD)
out date yrmody
DDATE_ISO D DATFMT(*ISO)
out date cyyrmody
DDATE_MDY D DATFMT(*MDY)
out date modyyr
DDATE_USA D DATFMT(*USA)
out date modycyyr
DDATE_JUL D DATFMT(*JUL)
out date yyddd
DWEEK_DAY_# 1 0
Week Day #
DWEEK_DAY 9
Week Day
DDATE_WRD 18
Date in words
DDATE_WMY 15
Month Year in words
**********************************************************************************************
DWEEK_DAYS S 9 DIM(7) CTDATA PERRCD(1)
Week Days
DMONTH_NAME S 12 DIM(12) CTDATA PERRCD(1)
Month Names
DWORK_DATES DS
DCENT_DATE 8 0
Date into cyyrmody
DDATE_TODAY 8 0
Incoming Date
D DT1 2 0 OVERLAY(DATE_TODAY:1)
D DT2 2 0 OVERLAY(DATE_TODAY:3)
D DT3 2 0 OVERLAY(DATE_TODAY:5)
D DT4 2 0 OVERLAY(DATE_TODAY:7)
DDATE_WORK 8 0
Incoming Date
D D1 2 0 OVERLAY(DATE_WORK:1)
D D2 2 0 OVERLAY(DATE_WORK:3)
D D3 2 0 OVERLAY(DATE_WORK:5)
D D4 2 0 OVERLAY(DATE_WORK:7)
DDATE_SAVE 8 0
Incoming Date Saved
DDATE_6 6 0
six digit date
******CEE procedure
feedback******************************************************************
D FC DS INZ
D FC_SEV 1 2B 0
severity
D FC_MSGNO 3 4B 0
message number
D FC_FLAGS 5 5
flags
D FC_FACID 6 8
facility ID
D FC_ISI 9 12B 0
isi
**********************************************************************************************
D DATETIME DS
DTIME_LILI 9B 0 INZ
Lillian
DTIME_SECS 9B 0 INZ
seconds
DTIME_GREGO Z INZ
Gregorian time
D DAY_NO 9B 0 INZ
Day number
D DATE_S_F1 S 30
Date String
D PICT_S_F1 S 30
Picture string
D TEMP S 30
Temporary field
C *ENTRY PLIST
C PARM INPUT_DATE
**********************************************************************************************
C CLEAR DATE_YMD
C CLEAR DATE_MDY
C CLEAR DATE_ISO
C CLEAR DATE_USA
C CLEAR DATE_JUL
C CLEAR DATE_CY
C CLEAR DATE_YR
C CLEAR DATE_MO
C CLEAR DATE_DY
C CLEAR DATE_ERR
C CLEAR WEEK_DAY_#
C CLEAR WEEK_DAY
C MOVE DATE_IN DATE_SAVE
* No date given - return
C IF (DATE_IN <= 010101 AND (DATE_FMT = '*MDY' OR
C DATE_FMT = '*YMD' OR DATE_FMT = '*ISO' OR
C DATE_FMT = '*USA')) OR
C (DATE_IN <= *ZEROS AND DATE_FMT = '*JUL') OR
C (DATE_IN <= 100 AND (DATE_FMT = '*MCY' OR
C DATE_FMT = '*CYM' ))
C MOVE 'N' DATE_ERR
C RETURN
C ENDIF
IF DATE_IN LT 010101
* Check DATE_FMT - return
C IF NOT (DATE_FMT = '*MDY' OR
C DATE_FMT = '*YMD' OR
C DATE_FMT = '*ISO' OR
C DATE_FMT = '*USA' OR
C DATE_FMT = '*JUL' OR
C DATE_FMT = '*MCY' OR
C DATE_FMT = '*CYM' )
C MOVE '*MDY' DATE_FMT
C ENDIF
IF NOT (DATE_FMT=*MD
C MOVE DATE_IN DATE_WORK
C MOVE *OFF *IN41
Error Indicator
C SELECT
C WHEN DATE_FMT = '*MDY' AND D1 = *ZEROS
C EVAL CENT_DATE = DT3*10**6+D4*10**4+D2*100+D3
C WHEN DATE_FMT = '*MDY' AND D1 > *ZEROS
C EVAL CENT_DATE = D3*10**6+D4*10**4+D1*100+D2
C WHEN DATE_FMT = '*YMD' AND D1 = *ZEROS
C EVAL CENT_DATE = DT3*10**6+D2*10**4+D3*100+D4
C WHEN DATE_FMT = '*YMD' AND D1 > *ZEROS
C EVAL CENT_DATE = D1*10**6+D2*10**4+D3*100+D4
C WHEN DATE_FMT = '*ISO' AND D1 = *ZEROS
C EVAL CENT_DATE = DT3*10**6+D2*10**4+D3*100+D4
C WHEN DATE_FMT = '*ISO' AND D1 > *ZEROS
C EVAL CENT_DATE = D1*10**6+D2*10**4+D3*100+D4
C WHEN DATE_FMT = '*USA' AND D1 = *ZEROS
C EVAL CENT_DATE = DT3*10**6+D4*10**4+D2*100+D3
C WHEN DATE_FMT = '*USA' AND D1 > *ZEROS
C EVAL CENT_DATE = D3*10**6+D4*10**4+D1*100+D2
C WHEN DATE_FMT = '*JUL'
C *JUL MOVE DATE_IN DATE_JUL
C MOVE DATE_JUL DATE_ISO
C MOVE DATE_ISO CENT_DATE
C WHEN DATE_FMT = '*MCY' AND D2 = *ZEROS
month year
C EVAL CENT_DATE = DT3*10**6+D4*10**4+D3*100+01
C EVAL DATE_IN = D3*10**4+DT3*100+D4
change to mo cy yr
C WHEN DATE_FMT = '*MCY' AND D2 > *ZEROS
month century year
C EVAL CENT_DATE = D3*10**6+D4*10**4+D2*100+01
C WHEN DATE_FMT = '*CYM' AND D2 = *ZEROS
year month
C EVAL CENT_DATE = DT3*10**6+D3*10**4+D4*100+01
C EVAL DATE_IN = DT3*10**4+D3*100+D4
change to cy yr mo
C WHEN DATE_FMT = '*CYM' AND D2 > *ZEROS
century year month
C EVAL CENT_DATE = D2*10**6+D3*10**4+D4*100+01
C ENDSL
C N41*ISO TEST(D) CENT_DATE 41
C IF *IN41 = *ON
C MOVE '1' DATE_ERR
bad date
C MOVE DATE_SAVE DATE_IN
C ELSE
C MOVE CENT_DATE DATE_WORK
C MOVE D1 DATE_CY
C MOVE D2 DATE_YR
C MOVE D3 DATE_MO
C MOVE D4 DATE_DY
C IF CENT_DATE > 19400101 AND CENT_DATE < 20391231
C *ISO MOVE CENT_DATE DATE_YMD
C *ISO MOVE CENT_DATE DATE_MDY
C *ISO MOVE CENT_DATE DATE_JUL
C ELSE
C EVAL DATE_6 = DATE_YR*10000 +DATE_MO*100 + DATE_DY
C *YMD MOVE DATE_6 DATE_YMD
C EVAL DATE_6 = DATE_MO*10000 +DATE_DY*100 + DATE_YR
C *MDY MOVE DATE_6 DATE_MDY
C ENDIF
CENT_DATE > 01011940
C *ISO MOVE CENT_DATE DATE_ISO
C *ISO MOVE CENT_DATE DATE_USA
C SELECT
C WHEN DATE_FMT = '*MDY' AND D1 = *ZEROS AND
C CENT_DATE > 19400101 AND CENT_DATE < 20391231
C *MDY MOVE DATE_ISO DATE_IN
C WHEN DATE_FMT = '*MDY' AND D1 = *ZEROS AND
C (CENT_DATE < 19400101 OR CENT_DATE> 20391231)
C EVAL DATE_IN = DATE_MO*10000 +DATE_DY*100 +DATE_YR
C WHEN DATE_FMT = '*YMD' AND D1 = *ZEROS AND
C CENT_DATE > 19400101 AND CENT_DATE < 20391231
C *YMD MOVE DATE_ISO DATE_IN
C WHEN DATE_FMT = '*YMD' AND D1 = *ZEROS AND
C (CENT_DATE< 19400101 OR CENT_DATE > 20391231)
C EVAL DATE_IN = DATE_YR*10000 +DATE_MO*100 +DATE_DY
C WHEN DATE_FMT = '*ISO' AND D1 = *ZEROS
C *ISO MOVE DATE_ISO DATE_IN
C WHEN DATE_FMT = '*USA' AND D1 = *ZEROS
C *USA MOVE DATE_ISO DATE_IN
C ENDSL
C MOVEL 'YYYY-MM-DD' PICT_S_F1
C MOVEL DATE_ISO DATE_S_F1
C CALLB(D) 'CEEDAYS'
C PARM DATE_S_F1
C PARM PICT_S_F1
C PARM TIME_LILI
C PARM FC
C CALLB 'CEEDYWK'
C PARM TIME_LILI
C PARM DAY_NO
C PARM FC
C IF DAY_NO > *ZERO
C MOVE DAY_NO WEEK_DAY_#
C EVAL WEEK_DAY=WEEK_DAYS(WEEK_DAY_#)
* move words for the date
C MOVEL(P) D4 TEMP
C IF D4 < 10
C MOVEL ' ' TEMP
C ENDIF
D4 < 10
C EVAL DATE_WRD = %TRIM(MONTH_NAME(D3)) + ' ' +
C %TRIM(TEMP) + ', ' + %SUBST(DATE_S_F1:1:4)
C EVAL DATE_WMY = %TRIM(MONTH_NAME(D3)) + ', ' +
C %SUBST(DATE_S_F1:1:4)
C ENDIF
IF DAY_NO > *ZERO
C ENDIF
*IN41 = *ON
C RETURN
***********************************************************************
* INITIALIZATION
***********************************************************************
C *INZSR BEGSR
C CLEAR WORK_DATES
C MOVE *DATE DATE_TODAY
C ENDSR
***********************************************************************
* PROGRAM ERROR
***********************************************************************
C *PSSR BEGSR
C MOVE 'U' DATE_ERR
C RETURN
C ENDSR
** Days of the Week
Sunday
Monday
Tuesday
Wednesday
Thursday
Friday
Saturday
** Month Names
January
February
March
April
May
June
July
August
September
October
November
December
As an Amazon Associate we earn from qualifying purchases.
This mailing list archive is Copyright 1997-2024 by midrange.com and David Gibbs as a compilation work. Use of the archive is restricted to research of a business or technical nature. Any other uses are prohibited. Full details are available on our policy page. If you have questions about this, please contact [javascript protected email address].
Operating expenses for this site are earned using the Amazon Associate program and Google Adsense.
