Try this routine:
SUBROUTINE RPT_DATES(OUT.DATES, IN.DATES, IN.DATE.TYPE, FLAG)
* DAG_DATES - By David A. Green -- 1Jun05
* www.dagconsulting.com
*
* Calculate dates and date ranges
*
** Inputs:
* IN.DATES - Single or Multivalued List of Dates as reference
dates
* IN.DATE.TYPE - Type of Date to Calculate, Supported Types are:
* FIRST.DAY.OF.MONTH
* LAST.DAY.OF.MONTH
* LAST.DAY.OF.PREVIOUS.MONTH
* LAST.DAY.OF.NEXT.MONTH
* FIRST.DAY.OF.YEAR
* LAST.DAY.OF.YEAR
* CALC.NUMBER.OF.MONTHS
* YEAR.ARRAY.OF.MONTHS
* YEAR.ARRAY.OF.QUARTERS
* TODAY
* FIRST.DAY.OF.PREVIOUS.MONTH
* FIRST.DAY.OF.NEXT.MONTH
* YEAR
* FLAG - Flag can be used to Fudge a date or Exact dates
* FUDGE - Will subtract 7 days from the IN.DATES
and return
* a First or Last Date based on the fudged
IN.DATES.
* EXACT - Will use IN.DATES as passed to
subroutine. (default)
*
** Outputs:
* OUT.DATES - Calculated Dates based on Input Parameters
* FLAG - Set with error messages if any
*
EQUATE TRUE TO 1, FALSE TO 0
*
GOSUB INIT.SUB
*
IN.DATES = IN.DATES ;* Reset Remove Pointer (Necessary because
variable gets set in another program)
MORE.DATES = (IN.DATES # "")
LOOP WHILE MORE.DATES AND NOT(ABORT.FLAG) DO
IN.DATE = REMOVE(IN.DATES, MORE.DATES) - FUDGE.DAYS
GOSUB INIT.DATE
IF NOT(ABORT.FLAG) THEN
BEGIN CASE
CASE IN.DATE.TYPE = "FIRST.DAY.OF.MONTH" ; GOSUB
DO.FIRST.DAY.OF.MONTH
CASE IN.DATE.TYPE = "LAST.DAY.OF.MONTH" ; GOSUB
DO.LAST.DAY.OF.MONTH
CASE IN.DATE.TYPE = "LAST.DAY.OF.PREVIOUS.MONTH" ; GOSUB
DO.LAST.DAY.OF.PREVIOUS.MONTH
CASE IN.DATE.TYPE = "LAST.DAY.OF.NEXT.MONTH" ; GOSUB
DO.LAST.DAY.OF.NEXT.MONTH
CASE IN.DATE.TYPE = "FIRST.DAY.OF.YEAR" ; GOSUB
DO.FIRST.DAY.OF.YEAR
CASE IN.DATE.TYPE = "LAST.DAY.OF.YEAR" ; GOSUB
DO.LAST.DAY.OF.YEAR
CASE IN.DATE.TYPE = "CALC.NUMBER.OF.MONTHS" ; GOSUB
DO.CALC.NUMBER.OF.MONTHS
CASE IN.DATE.TYPE = "YEAR.ARRAY.OF.MONTHS" ; GOSUB
DO.YEAR.ARRAY.OF.MONTHS
CASE IN.DATE.TYPE = "YEAR.ARRAY.OF.QUARTERS" ; GOSUB
DO.YEAR.ARRAY.OF.QUARTERS
CASE IN.DATE.TYPE = "TODAY" ; GOSUB
DO.TODAY
CASE IN.DATE.TYPE = "FIRST.DAY.OF.PREVIOUS.MONTH" ; GOSUB
DO.FIRST.DAY.OF.PREVIOUS.MONTH
CASE IN.DATE.TYPE = "FIRST.DAY.OF.NEXT.MONTH" ; GOSUB
DO.FIRST.DAY.OF.NEXT.MONTH
CASE IN.DATE.TYPE = "YEAR" ; GOSUB
DO.YEAR
CASE 1 ; GOSUB
INVALID.TYPE
END CASE
BEGIN CASE
CASE IN.DATE.TYPE = "YEAR.ARRAY.OF.MONTHS"
CASE IN.DATE.TYPE = "YEAR.ARRAY.OF.QUARTERS"
CASE 1 ; OUT.DATES<1, OUT.DATE.PTR> = OUT.DATE
END CASE
END
REPEAT
*
RETURN
!
DO.FIRST.DAY.OF.MONTH:
BEGIN CASE
CASE DATE.FORMAT = "MD" ; THE.DATE = IN.MONTH:"/01/":IN.YEAR
CASE DATE.FORMAT = "DM" ; THE.DATE = "01/":IN.MONTH:"/":IN.YEAR
END CASE
OUT.DATE = ICONV(THE.DATE, "D")
RETURN
!
DO.FIRST.DAY.OF.PREVIOUS.MONTH:
GOSUB DEC.IN.MONTH
BEGIN CASE
CASE DATE.FORMAT = "MD" ; THE.DATE = IN.MONTH:"/01/":IN.YEAR
CASE DATE.FORMAT = "DM" ; THE.DATE = "01/":IN.MONTH:"/":IN.YEAR
END CASE
OUT.DATE = ICONV(THE.DATE, "D")
RETURN
!
DO.FIRST.DAY.OF.NEXT.MONTH:
GOSUB INC.IN.MONTH
BEGIN CASE
CASE DATE.FORMAT = "MD" ; THE.DATE = IN.MONTH:"/01/":IN.YEAR
CASE DATE.FORMAT = "DM" ; THE.DATE = "01/":IN.MONTH:"/":IN.YEAR
END CASE
OUT.DATE = ICONV(THE.DATE, "D")
RETURN
!
DO.LAST.DAY.OF.MONTH:
GOSUB INC.IN.MONTH
GOSUB DO.FIRST.DAY.OF.MONTH
OUT.DATE -= 1
RETURN
!
DO.LAST.DAY.OF.PREVIOUS.MONTH:
GOSUB DO.FIRST.DAY.OF.MONTH
OUT.DATE -= 1
RETURN
!
DO.LAST.DAY.OF.NEXT.MONTH:
GOSUB INC.IN.MONTH
GOSUB DO.LAST.DAY.OF.MONTH
RETURN
!
INC.IN.MONTH:
IN.MONTH += 1
IF IN.MONTH > 12 THEN IN.MONTH = 1 ; IN.YEAR += 1
RETURN
!
DEC.IN.MONTH:
IN.MONTH -= 1
IF IN.MONTH < 1 THEN IN.MONTH = 12 ; IN.YEAR -= 1
RETURN
!
DO.FIRST.DAY.OF.YEAR:
OUT.DATE = ICONV("01 JAN ":IN.YEAR, "D")
RETURN
!
DO.LAST.DAY.OF.YEAR:
OUT.DATE = ICONV("31 DEC ":IN.YEAR, "D")
RETURN
!
DO.CALC.NUMBER.OF.MONTHS:
BEGIN CASE
CASE IN.DATE.PTR = 1 ; GOSUB CALC.NUMBER.OF.MONTHS.FIRST.PASS
CASE IN.DATE.PTR = 2 ; GOSUB CALC.NUMBER.OF.MONTHS.SECOND.PASS
CASE 1 ; MSG = "Too many dates given" ; GOSUB
ABORT.MSG
END CASE
OUT.DATE.PTR = 1
RETURN
!
CALC.NUMBER.OF.MONTHS.FIRST.PASS:
FIRST.DATE = IN.DATE
FIRST.MONTH = IN.MONTH
FIRST.YEAR = IN.YEAR
RETURN
!
CALC.NUMBER.OF.MONTHS.SECOND.PASS:
SECOND.DATE = IN.DATE
IF SECOND.DATE < FIRST.DATE THEN ;* In case dates are flipped flopped.
SECOND.MONTH = FIRST.MONTH
SECOND.YEAR = FIRST.YEAR
FIRST.MONTH = IN.MONTH
FIRST.YEAR = IN.YEAR
IN.MONTH = SECOND.MONTH
IN.YEAR = SECOND.YEAR
END
OUT.DATE = 1
LOOP UNTIL IN.MONTH:IN.YEAR = FIRST.MONTH:FIRST.YEAR DO
OUT.DATE += 1
GOSUB DEC.IN.MONTH
REPEAT
RETURN
!
DO.YEAR.ARRAY.OF.MONTHS:
GOSUB DO.FIRST.DAY.OF.YEAR
IN.MONTH = OCONV(OUT.DATE, "DM")
IN.YEAR = OCONV(OUT.DATE, "DY")
IN.DAY = OCONV(OUT.DATE, "DD")
OUT.DATES<1, 1> = OUT.DATE
FOR DATE.PTR = 2 TO 12
GOSUB INC.IN.MONTH
GOSUB DO.FIRST.DAY.OF.MONTH
OUT.DATES<1, DATE.PTR> = OUT.DATE
NEXT DATE.PTR
RETURN
!
DO.YEAR.ARRAY.OF.QUARTERS:
GOSUB DO.FIRST.DAY.OF.YEAR
IN.MONTH = OCONV(OUT.DATE, "DM")
IN.YEAR = OCONV(OUT.DATE, "DY")
IN.DAY = OCONV(OUT.DATE, "DD")
OUT.DATES<1, 1> = OUT.DATE
FOR DATE.PTR = 2 TO 12
GOSUB INC.IN.MONTH
GOSUB DO.FIRST.DAY.OF.MONTH
BEGIN CASE
CASE DATE.PTR = 4; OUT.DATES<1, -1> = OUT.DATE
CASE DATE.PTR = 7; OUT.DATES<1, -1> = OUT.DATE
CASE DATE.PTR = 10; OUT.DATES<1, -1> = OUT.DATE
END CASE
NEXT DATE.PTR
RETURN
!
DO.TODAY:
OUT.DATE = @DATE
RETURN
!
DO.YEAR:
OUT.DATE = IN.YEAR
RETURN
!
INIT.DATE:
IN.DATE.PTR += 1
OUT.DATE.PTR = IN.DATE.PTR
IN.DAY = OCONV(IN.DATE, "DD")
IF STATUS() THEN
MSG = "Invalid Input Date #":IN.DATE.PTR:" ":DQUOTE(IN.DATE)
GOSUB ABORT.MSG
END ELSE
IN.MONTH = OCONV(IN.DATE, "DM")
IN.YEAR = OCONV(IN.DATE, "DY")
END
RETURN
!
INIT.SUB:
ABORT.FLAG = FALSE
IF UNASSIGNED(FLAG) THEN FLAG = ""
FUDGE.DAYS = (UPCASE(FLAG) EQ "FUDGE") * 7
FLAG = ""
OUT.DATES = ""
OUT.DATE = ""
OUT.DATE.PTR = 0
IN.DATE.PTR = 0
*
** Validate/Set Date Format - Month/Day/Year or Day/Month/Year
*
INT.DATE.FORMAT = SYSTEM(36)
BEGIN CASE
CASE INT.DATE.FORMAT = 0 ; DATE.FORMAT = "MD"
CASE INT.DATE.FORMAT = 1 ; DATE.FORMAT = "DM"
CASE 1 ; GOSUB UNSUPPORTED.DATE.FORMAT
END CASE
RETURN
!
UNSUPPORTED.DATE.FORMAT:
MSG = "Unsupported Date Format ":DQUOTE(SYSTEM(36))
GOSUB ABORT.MSG
RETURN
!
INVALID.TYPE:
MSG = "Invalid Date Type ":DQUOTE(IN.DATE.TYPE)
GOSUB ABORT.MSG
RETURN
!
ABORT.MSG:
FLAG<-1> = MSG
ABORT.FLAG = TRUE
OUT.DATE = ""
RETURN
!
END
David A. Green
(480) 813-1725
DAG Consulting
-----Original Message-----
From: u2-users-boun...@listserver.u2ug.org
[mailto:u2-users-boun...@listserver.u2ug.org] On Behalf Of Wjhonson
Sent: Monday, December 05, 2011 12:03 PM
To: u2-users@listserver.u2ug.org
Subject: [U2] End of Month date routine
Does someone have a routine that, no matter what day you run it, returns the
End of Month Date ?
(Assume the end of month date, is the calendar end of month date not some
screwy business date) _______________________________________________
U2-Users mailing list
U2-Users@listserver.u2ug.org
http://listserver.u2ug.org/mailman/listinfo/u2-users
_______________________________________________
U2-Users mailing list
U2-Users@listserver.u2ug.org
http://listserver.u2ug.org/mailman/listinfo/u2-users
