#!/usr/local/bin/rxx
/* Rexx function for date conversion and arithmetic, range 0001-9999.
|           Not Sign: ^    Vertical bar: |
|  03/16/90 Rework add/subtract to add days first or subtract them last.
|  12/21/89 Define K as week of the year, Q as quarter of the year.
|  10/14/88 Correct UNBASE internal function, support R6 DATE 'N' option.
|  06/01/88 V3.0 - Add ISO dates and type 'B' dates, redefine type 'C'.
 
   EDATE is an extension of the REXX builtin DATE function.
   It allows specification of an optional date parameter (within 0001-
   9999) as well as date computation by addition or subtraction.
   There is no correction for the switchover to Gregorian calendar.
 
   Normally, '2-digit year' format dates are returned.  However, in lieu
   of future standards, year 2000-2099 and above is returned in 4 digits.
   All the parameters of DATE are supported by default.
 
   x =  EDATE( <option <, <date> <, <operand> <, <flavor>>> )
 
   where:
    option ===> one or more of the options supported by the built in
                DATE function, (see the Rexx Reference) plus weeK and
                Quarter of the year (K and Q), and I, the ISO format
                date 'yyyy-mm-dd'.
                The options are applied one after another and the
                result of each forms one token of the final result.
                Thus, 'wc' returns both the weekday and the day of
                the century.  (The 'null' option, of course, cannot
                be used in combination with any of the others.
 
    date   ===> a date (this century) in either U.S. format mm/dd/yyyy,
                ISO format yyyy-mm-dd, or day of year (so-called
                'Julian') format yyyyddd, or 'base date' in the form
                of the letter 'B' followed immediately by an integer.
                Base date 0 is defined to be Jan 1, 0001 ('B0').
                If not specified, today's date will be used.
 
    operand ==> A signed number of days or a m/d/y date operand, or
                a 'year-month-day' (ISO format) date operand
                preceded by a '+' or '-' and a blank.
                Specifies the number of months, days, and years to
                be added to or subtracted from the date.
                The m/d/y operand may contain 0 or null fields.
                For example, '/10/' is the same as '0/10/0' or
                even the numeric format '10', which means '10 days'
 
                Remember that the m/d/y form must be entered as a
                single argument enclosed in quotes.  For example,
                '+ /10/'.  The separating blank MUST be coded.
                ISO format examples would be '--10' for adding 10
                days or '- -1-1' for subtracting 1 month 1 day.
                (Equivalently '+ 0-0-10' and '- 0-1-1').
 
     flavor ==> null or 'Long', denotes whether years from 1900 to
                1999 are to be output with the leading '19'.  Years
                outside 1900 are ALWAYS output that way.  ISO dates
                are always 'Long'.
 
  Examples:
          x = edate()            /* returns todays date with format */
                                 /* (dd Mmm yyyy). Same as date().    */
          x = edate(j,'08/07/85')/* returns the julian equivalent of  */
                                 /* 08/07/85 which is 85219           */
          x = edate(w,00001,1)   /* returns the name of the day of    */
                                 /* week which is one day past Jan 1  */
                                 /* 1900 which is Tuesday.            */
          x = edate(s,,'- //1',l)/* returns one year before today's   */
                                 /* date in sorted (long) format which*/
                                 /* is (for example) 1985/09/25.      */
 
   Returns -1 if date format problems or -2 if option not understood.
*/
/*                       */  Signal on Syntax
/* Obtain input arguments*/  Parse upper arg option, date , ,
/*                       */     operator operand, flavor
/*|Convert option N to ''*/  If option = '' then option = 'N'
/* Behave like builtin   */  If date operator flavor = '' & ,
/* DATE if no added args */    length(option) <= 1 & ,
/* or IKQ not used.      */    find('I K Q',option) = 0 then
/*                       */     Do
/* - If bad TYPE         */     Signal on syntax
/* - Run REXX function   */     Return DATE(option)
/*                       */     End
/*                       */
/* When no input date... */  If date = '' then date = date('u')
/* Set LONG mode flag    */  LongDate = abbrev('LONG',flavor,1)
/*                       */
/* Normalize input format*/  date = validate(date)
/* to mm/dd/yyyy format. */  If date = 'BAD' then return -1
/*                       */
/* Check for date math   */  If operator <> '' then
/* needed.               */     date = Calculate(date, operand, operator)
/*         Stop if fails.*/  If date = 'BAD' then return -1
/*                       */
/* Produce output in     */  Results = ''
/* multiple formats      */  If option = '' then option = 'L'
/* requested.            */
/* Here loop thru all    */  Do iopts = 1 to length(option)
/* result types desired. */     opts = substr(option,iopts,1)
/*                       */
/*                       */     Select
/*                       */        When opts = 'L' | opts = 'N' then
/*                       */           ans = local(date)
/*                       */        When opts = 'C' then
/*                       */           ans = century(date)
/*                       */        When opts = 'B' then
/*                       */           ans = base(date)
/*                       */        When opts = 'D' then
/*                       */           ans = right(julian(date),3)
/*                       */        When opts = 'E' then
/*                       */           ans = tail(european(date))
/*                       */        When opts = 'J' then
/*                       */           ans = head(julian(date))
/*                       */        When opts = 'M' then
/*                       */           ans = month(date)
/*                       */        When opts = 'O' then
/*                       */           ans = head(ordered(date))
/*                       */        When opts = 'S' then
/*                       */           ans = sorted(date)
/*                       */        When opts = 'U' then
/*                       */           ans = tail(date)
/*                       */        When opts = 'W' then
/*                       */           ans = weekday(date)
/*                       */        When opts = 'I' then
/*                       */           ans = translate( ,
/*                       */              ordered(date),'-','/')
/*                       */        When opts = 'K' then
/*                       */           ans = WofY(date)
/*                       */        When opts = 'Q' then
/*                       */           ans = ((WofY(date)-1)%13)+1
/*                       */        Otherwise ans = -2
/*                       */        End
/*                       */
/*                       */     Results = Results ans
/*                       */     End
/*                       */
/*                       */  Return strip(Results,'L')
/*                       */
/*                       */ Syntax:
/*                       */    say "Syntax Error in Edate"
/*                       */    return 255
/*-----------------------*/
/* Supporting Subroutines*/
/*-----------------------*/
/* Remove '19' from dates*/  Head:
/* in 'short' format     */     arg input
/* for dates with year in*/     If LongDate | left(input,2) = '20' then
/* front.                */        Return input
/*                       */     Return substr(input,3)
/*                       */
/* Remove '19' from dates*/  Tail:
/* in 'short' format     */     arg input
/* for dates with year on*/     If LongDate | right(input,4)> '1999' then
/* end.                  */        Return input
/*                       */     Return left(input,length(input)-4) || ,
/*                       */        right(input,2)
/************************************************/
/* Convert    to a format (dd Mmm yyyy), ie.    */
/*   27 Aug 1983. (no leading zero on dd)       */
/************************************************/
/*                       */ Local: Procedure
/*                       */  arg date
/*                       */  parse var date mm '/' dd '/' yy
/*                       */  return dd+0 left(month(date,'U'),3) yy
/************************************************/
/* Weekday will return the name of the weekday  */
/* that corresponds input date.                 */
/************************************************/
/*                       */ Weekday: Procedure
/*                       */  arg date
/* Jan 1, 0001 was Monday*/  index = base(date) // 7
/*                       */  Return word('Monday Tuesday Wednesday' ,
/*                       */    'Thursday Friday Saturday Sunday',index+1)
/************************************************/
/* Month will return the name of the month that */
/* corresponds to the input date.               */
/************************************************/
/*                       */ Month: Procedure
/*                       */  arg date
/*                       */  Return word( ,
/*                       */     'January February March April May June' ,
/*                       */     'July August September October November',
/*                       */     'December',left(date,2))
/************************************************/
/* Ordered  will convert                        */
/*            to a format yyyy/mm/dd            */
/************************************************/
/*                       */ Ordered: Procedure
/*                       */  arg date
/*                       */  Return ,
/*                       */     translate('7890312645',date,'1234567890')
/************************************************/
/* Sorted will convert                          */
/*            to a format (yyyymmdd)            */
/************************************************/
/*                       */ Sorted: Procedure
/*                       */  arg date
/*                       */  Return ,
/*                       */     translate('78901245',date,'1234567890')
/***********************************************/
/* European will convert                       */
/* to a European date (dd/mm/yyyy).            */
/***********************************************/
/*                       */ European: Procedure
/*                       */  arg date
/*                       */  Return ,
/*                       */     translate('4561237890',date,'1234567890')
/****************************************************/
/* Century will calculate the number of days from   */
/* the beginning of xx00        up to and including */
/* the std date mm/dd/yyyy                          */
/****************************************************/
/*                       */ Century: Procedure
/*                       */  arg date
/* We work in day-of-year*/  date = julian(date)
/* format.               */  yy = left(date,4) - 1
/* Base date of given    */  base = yy*365 + yy%4 - yy%100 + yy%400 + ,
/* date.                 */     right(date,3)-1
/* Year of 'century' strt*/  yy = ((yy+1) % 100 * 100) - 1
/* Base date of Jan 1    */  Jan1 = yy*365 + yy%4 - yy%100 + yy%400
/*                       */  Return base - Jan1 + 1
/****************************************************/
/* Base    will calculate the number of days from   */
/* the beginning of 0001        up to and including */
/* the std date mm/dd/yyyy.                         */
/****************************************************/
/*                       */ Base: Procedure
/*                       */  arg date
/* We work in day-of-year*/  date = julian(date)
/* format.               */  yy = left(date,4) - 1
/* Days in years passed  */  Return yy*365 + yy%4 - yy%100 + yy%400 + ,
/* plus day of year.     */     right(date,3) - 1
/**********************************************/
/* Julian will convert a std. date  mm/dd/yyyy*/
/* to a julian date yyyyddd.                  */
/**********************************************/
/*                       */ Julian: Procedure
/*                       */  arg date
/*                       */  Parse value date with mm '/' dd '/' yy
/* Is this a leap year?  */  LeapYear = yy // 400 = 0 | ,
/*                       */     ( yy // 4 = 0 & yy // 100 <> 0)
/* From Almanac for      */  Return ,
/* Computing, tableless  */     yy||right(275*mm%9 + dd -  ,
/* date conversion.      */     (((mm+9)%12)*(1+(1&&LeapYear)))-30,3,0)
/*                       */
/**********************************************/
/* WofY   will convert a std. date  mm/dd/yyyy*/
/* to the week-of-the-year, 1-52.  A week     */
/* starts with Monday, ends with Sunday.      */
/**********************************************/
/*                       */ WofY: Procedure
/*                       */  arg date
/*                       */  Parse value date with mm '/' dd '/' yy
/* Is this a leap year?  */  LeapYear = yy // 400 = 0 | ,
/*                       */     ( yy // 4 = 0 & yy // 100 <> 0)
/*                       */
/* Get day of year for   */  DoY = 275*mm%9 + dd -  ,
/* this date.            */     (((mm+9)%12)*(1+(1&&LeapYear)))-30
/* Get last year number  */  yp = yy - 1
/* Get base date for Jan */  Base = yp*365 + yp%4 - yp%100 + yp%400
/* 1 of input year and   */
/* the day-of-week code  */  DoWJ1 = (Base//7)+1
/* (1=Monday).           */
/* Get day of year for   */  DoY1stM = (9 - DoWJ1) // 7
/* 1st Monday of year.   */  If DoY1stM = 0 then DoY1stM = 7
/* Get # of Mondays (wks)*/  Weeks = ((DoY - DoY1stM) % 7) + 1
/* passed to input date. */
/* Determine if 52nd week*/  If DoY <= DoY1stM then
/* of previous yr or 1st */     If DoWJ1 <= 4 then Weeks = 1
/* week of this year.    */     Else Weeks = 52
/* Otherwise see if      */  Else
/* enough days in first  */     If DoWJ1 <= 4 & DoY1stM <> 1 then
/*                       */        Weeks = Weeks + 1
/* week to count as a wk.*/  If Weeks = 53 then Weeks = 1
/*                       */  Return Weeks
/*********************************************/
/* USdate will convert a day-of-year yyyyddd */
/* to a standard date mm/dd/yyyy.            */
/*********************************************/
/*                       */ USdate: Procedure
/* Input MUST be yyyyddd!*/  Parse arg yy 5 ddd .
/* Is this a leap year?  */  LeapYear = yy // 400 = 0 | ,
/*                       */     ( yy // 4 = 0 & yy // 100 <> 0)
/*                       */  If ddd > 59 + LeapYear then y = 2 - LeapYear
/*                       */  Else y = 0
/*                       */  z = ddd + y + 91
/* Compute month number  */  m = (z * 100 ) % 3055
/* Compute day in month  */  d = z - ( m * 3055 ) % 100
/* Place results in stan-*/  Return ,
/* dard format.          */     right(m-2,2,0)'/'right(d,2,0)'/'yy
/**********************************************/
/* Validate the input date.  Accepts day of   */
/* year yy<yy>ddd, ISO yyyy-mm-dd, Bnnnnnnn   */
/* (base date where nnnnnn = 1 to 3652058) or */
/* mm/dd/yy format dates.  Returns a standard */
/* format date mm/dd/yyyy.  Returns 'BAD' if  */
/* problems with input.                       */
/* This routine also accepts sorted format    */
/* dates.  It normalizes them back into       */
/* USA format.  In NO CASE will an xx field   */
/* <= 12 be interpreted to be anything other  */
/* than a USA date.                           */
/**********************************************/
/*                       */ Validate: Procedure
/*                       */  arg date
/* Check for base date.  */  If left(date,1) = 'B' then
/* If so convert it.     */     Return UnBase(substr(date,2))
/*                       */
/* Days until 1st of each*/  MList = '0 31 59 90 120 151 181 212 243' ,
/* month table.          */    '273 304 334'
/* yyddd or yyyyddd form.*/  If datatype(date,'w') then
/* This will be converted*/     Do
/* to 4-digit year format*/     Parse var date yy 3 ddd
/*                       */     If length(date) = 7 then
/*                       */        Parse var date yy 5 ddd
/* 20th century assumed  */     Else yy = '19'yy
/* Is this a leap year?  */     LeapYear = yy // 400 = 0 | ,
/*                       */        ( yy // 4 = 0 & yy // 100 <> 0)
/* Make sure day range ok*/     If ddd < 1 | ddd>365+LeapYear then
/* either 365 or 366.    */        Return 'BAD'
/* Convert to yyyydddd & */     date = right(yy,4) || right(ddd,3,0)
/* then to mm/dd/yyyy.   */     Return usdate(date)
/*                       */     End
/*                       */
/*---Trans ISO to USA----*/  If substr(date,5,1) = '-' then
/*   YYYY-MM-DD to       */     date = translate('67/90/1234',date, ,
/*   MM/DD/YYYY          */       '1234567890')
/*                       */
/*---Handle m/d/y format-*/
/* Get candidate m/d/y   */  parse var date mm '/' dd '/' yy
/* Length to signif chars*/  yy = strip(yy)
/* and make sure digits  */  If ^datatype('0'mm||dd||yy,'w') then
/* are used.             */     Return 'BAD'
/* Assumed USA date      */     If mm > 12 then
/* unless month field >12*/         parse var date yy'/' mm '/' dd
/* General range check   */  If mm < 1 | mm > 12 | dd < 1 then
/*                       */     Return 'BAD'
/* Assume 20th century   */  If length(yy) = 2 then yy = '19'yy
/* but note year 0001 is */
/* note the same as 1901.*/
/*                       */  If yy < 1 | yy > 9999 then Return 'BAD'
/* Is this a leap year?  */     LeapYear = yy // 400 = 0 | ,
/*                       */        ( yy // 4 = 0 & yy // 100 <> 0)
/* Make sure last day of */  If word(MList,mm) + dd + ,
/* month isn't exceeded. */     ( LeapYear & mm>2 ) >= ,
/*                       */      word(MList 365,mm+1)+ 1 + ,
/*                       */     ( LeapYear & mm>1 ) then Return 'BAD'
/* Normalize date format */  date = ,
/*                       */  right(mm,2,0)'/'right(dd,2,0)'/'yy
/*                       */  Return date
/*                       */
/**********************************************/
/* Perform date arithmetic on DATE using      */
/* OPERATOR and OPERAND putting back a new    */
/* value for DATE.  Accepts operators +,-   . */
/* Operand is a whole number (implies DAYS)   */
/* or a string in form mm/dd/yy which adds    */
/* fieldwise the given values (which may be   */
/* zero or null).                             */
/**********************************************/
/*                       */ Calculate: Procedure
/*                       */  arg date, operand, operator
/* Normalize days-only   */  If operand = '' then
/* arg to m/d/y form     */     Do
/* and split off any     */     operand = operator
/* attached sign as an op*/     operator = '+'
/*                       */     If datatype(operand,'w') & operand<0 then
/*                       */        Do
/*                       */        operator = '-'
/*                       */        operand = abs(operand)
/*                       */        End
/*                       */     End
/*                       */
/* Acceptable operator?  */  If find('+ -',operator) = 0 then
/*                       */     Return 'BAD'
/* Chk for days operand  */  If datatype(operand,'w') then
/* and set up variables  */     parse value operand 0 0 with opd opm opy
/* Else handle m/d/y form*/  Else
/*                       */     Do
/* Check for USA         */     If pos('/',operand) <> 0 then
/*                       */        Parse var operand opm '/' opd '/' opy
/* Check for ISO         */     If pos('-',operand) <> 0 then
/*                       */        Parse var operand opy '-' opm '-' opd
/*                       */
/*                       */     If ^datatype('0'opm||opd||opy,'w') then
/*                       */        Return 'BAD'
/* - Make sure not null  */     Parse value '0'opm '0'opd '0'opy with ,
/*                       */        opm opd opy
/*                       */     End
/*                       */
/* ADDITION              */  If operator = '+' then
/*                       */     Do
/* Add days first.       */     If opd <> 0 then
/*      by doing so to   */        Do
/* the 'base' form of the*/        x = base(date)
/* date.                 */        x = x + opd
/* Back to standard form */        date = unbase(x)
/*                       */        End
/*                       */
/* If months or years are*/     If opm + opy <> 0 then
/* used we do that here. */        Do
/* Extract date's mm & yy*/        parse var date imm '/' idd '/' iyy
/* - Add months          */        imm = imm + opm
/* - Carry to years      */        iyy = iyy + imm % 12
/*                       */        imm = imm // 12
/*                       */        If imm = 0 then
/*                       */           Parse value 12 iyy-1 with imm iyy
/* - Add years           */        iyy = iyy + opy
/* - Reform intermediate */        date = ,
/*   result into standard*/          right(imm,2,0)'/'idd'/'right(iyy,4)
/*   format mm/dd/yyyy.  */        End
/*                       */     End
/*                       */
/* SUBTRACTION           */  Else Do
/* If months or years are*/     If opm + opy <> 0 then
/* used we do that here. */        Do
/* Extract date's mm & yy*/        parse var date imm '/' idd '/' iyy
/* - Subtract months     */        imm = imm - opm
/* - Borrow years        */        If imm <= 0 then
/*                       */           Do
/*                       */           iyy = iyy - 1 + imm % 12
/*                       */           imm = 12 + imm // 12
/*                       */           End
/*                       */
/* - Subtract years      */        iyy = iyy - opy
/* - Reform intermediate */        date = ,
/*   result into standard*/          right(imm,2,0)'/'idd'/'right(iyy,4)
/*   format mm/dd/yyyy.  */        End
/*                       */
/* Subtract days         */     If opd <> 0 then
/*      by doing so to   */        Do
/* the 'base' form of the*/        x = base(date)
/*                       */        x = x - opd
/* Back to standard form */        date = unbase(x)
/*                       */        End
/*                       */     End
/*                       */
/*                       */  Return date
/**********************************************/
/* Convert a number, assumed to be a base date*/
/* to standard format mm/dd/yyyy.             */
/**********************************************/
/*                       */  UnBase: Procedure
/* Get base date argument*/     arg x
/* Limited to year 9999. */     If x > 3652058 then Return 'BAD'
/*|(Roughly, the)        */ /*  Numeric digits 14 */
/*|number of years passed*/     opy = 400  * (x+1) % 146097
/*|Day of the year is the*/     ddd = x + 1 - ( opy*365 + opy%4 - ,
/*|base date minus base  */         opy%100 + opy%400 )
/*|for Jan 0 of the year.*/
/*|                      */
/*|If Day 366 chk that it*/     If ddd = 366 then
/*|is actually a leap    */        Do
/*|year.  If not, it's   */        NLeapYear = (opy+1) // 4 <> 0
/*|Jan 1 of the next year*/        opy = opy + NLeapYear
/*|                      */        If NLeapYear then ddd = 1
/*|                      */        End
/*|                      */
/*|Day 0 is actually     */     If ddd = 0 then
/*|Dec 31 of previous yr.*/        Do
/*|- Is this a leap year?*/        LeapYear = opy // 400 = 0 | ,
/*|                      */           ( opy // 4 = 0 & opy // 100 <> 0)
/*|- Set Dec 31          */        ddd = 365 + LeapYear
/*|- Set previous year   */        opy = opy - 1
/*|                      */        End
/*|                      */
/* Convert to standard   */     Return usdate(right(opy+1,4,0) || ,
/* format.               */        right(ddd,3,0))
/*                       */
/*-----------------------*/
/* Syntax errors         */  Syntax:
/*-----------------------*/     say 'At line' sigl':' errortext(rc)
/*                       */     Return 'BAD'
 
/** UPDATED 03/16/90 13:09:49 BY ADI/SATHER ***/