home *** CD-ROM | disk | FTP | other *** search
/ OS/2 Shareware BBS: 18 REXX / 18-REXX.zip / fdater.zip / FDATER.REX < prev    next >
OS/2 REXX Batch file  |  1995-04-29  |  12KB  |  334 lines
  1. /* to make Fdater an internal routine, uncomment the following line. */
  2. /* FDATER: procedure */
  3.  
  4. signal on  novalue
  5. function = translate(arg(1)) /* put arg(1) in upper case */
  6. invalue  = arg(2)
  7.  
  8. /*===============================================================
  9. FDATER: A REXX implementation of the Truedate date arithmetic routine
  10. Version 4.0                1995 April 29
  11. ======================================================================
  12. AUTHOR:     Stephen Ferg
  13.             608 N. Harrison Street
  14.             Arlington, VA 22203-1416
  15.             USA
  16.  
  17.             telephone (voice, not FAX): (703) 525-2241
  18.             CompuServe ID             : 73377,1157
  19.             Internet                  : 73377.1157@compuserve.com
  20.  
  21.  
  22. REVISION HISTORY
  23. --------------------------
  24. 4.0 (1995 April 29) Stephen Ferg
  25.     Added code to translate to and from TrueDate AbsDate to REXX BaseDate
  26.     Renamed routines to reflect usage of REXX base dates
  27.  
  28. ================================================================*/
  29. MinAbsDate       = 1         /* JANUARY  1, 0001 */
  30. DaysInOrdinaryYr = 365
  31. DaysIn004YrGroup = 1461      /*(DaysInOrdinaryYr *  4) + 1*/
  32. DaysIn100YrGroup = 36524     /*(DaysIn004YrGroup * 25) - 1*/
  33. DaysIn400YrGroup = 146097    /*(DaysIn100YrGroup *  4) + 1*/
  34. MaxAbsDate       = 3652059   /* DECEMBER 31, 9999 */
  35.  
  36. JANdays         = 31
  37. FEBshort        = 28
  38. MARdays         = 31
  39. APRdays         = 30
  40. MAYdays         = 31
  41. JUNdays         = 30
  42. JULdays         = 31
  43. AUGdays         = 31
  44. SEPdays         = 30
  45. OCTdays         = 31
  46. NOVdays         = 30
  47. DECdays         = 31
  48.  
  49.  
  50. constants = "MinAbsDate MaxAbsDate DaysInOrdinaryYr",
  51.    "DaysIn004YrGroup DaysIn100YrGroup DaysIn400YrGroup",
  52.    "JANdays FEBshort MARdays APRdays MAYdays JUNdays",
  53.    "JULdays AUGdays  SEPdays OCTdays NOVdays DECdays "
  54.  
  55. select
  56. when function= "BASE2CAL"    then RETURN BaseDate_To_CalDate(invalue)
  57. when function= "CAL2BASE"    then RETURN CalDate_To_BaseDate(invalue)
  58. when function= "MONTHNAME"   then RETURN MonthName(invalue)
  59. when function= "DOWNAME"     then RETURN DowName(invalue)
  60. when function= "DOWNUM"      then RETURN DowNum(invalue)
  61. when function= "ISLEAPYEAR"  then RETURN IsLeapYear(invalue)
  62. otherwise
  63.     RETURN "ERROR: Invalid function name" function
  64. end
  65. /*--------------[ end FDATER main routine ]----------------*/
  66.  
  67.  
  68. /* */
  69. /*==============================================================*/
  70. IsLeapYear : procedure expose (constants)
  71. /*==============================================================*/
  72. arg CalYear
  73. if \Datatype(CalYear,"W") then
  74.    RETURN "ERROR: Year parm is not a whole number."
  75.  
  76. if CalYear < 1 | CalYear > 9999 then
  77.    RETURN "ERROR: Year parm is not in range 1 - 9999."
  78.  
  79. Mod400 = CalYear // 400
  80. if Mod400  = 0 then RETURN 1
  81.  
  82. Mod100 = Mod400 // 100
  83. if Mod100  = 0 then  RETURN 0
  84.  
  85. Mod004 = Mod100 // 4
  86. if Mod004  = 0 then  RETURN 1
  87.                      RETURN 0
  88.  
  89. /*===============================================================*/
  90. DoWnum      : procedure
  91. /*Calculate the day of the week from the absolute date*/
  92. /*===============================================================*/
  93. BaseDate = arg(1)
  94. AbsDate = BaseDate + 1 /*  REXX BaseDate ==> TrueDate AbsDate */
  95.  
  96. if \Datatype(AbsDate,"W") then
  97.    RETURN "ERROR: parameter is not a whole number."
  98.  
  99.    /*add 1, so that DoWnum is in range 1..7 rather than 0..6*/
  100.    /*DoWnum 1 is Sunday, DoWnum 2 is Monday ... DoWnum 7 is Saturday*/
  101. RETURN  ( AbsDate // 7) + 1
  102.  
  103.  
  104. /*===============================================================*/
  105. BumpMonth:   /* note: CalMonth and CalDay are exposed */
  106. /*===============================================================*/
  107.   CalMonth = CalMonth + 1
  108.   CalDay   = CalDay  - arg(1)  /* arg(1) = Monthdays */
  109. RETURN
  110.  
  111.  
  112. /* */
  113. /*==============================================================*/
  114. MonthName: procedure
  115. /* Calculate English-language name of the month */
  116. /*===============================================================*/
  117. arg CalMonth
  118.     if CalMonth =  1 then RETURN  'January'
  119.     if CalMonth =  2 then RETURN  'February'
  120.     if CalMonth =  3 then RETURN  'March'
  121.     if CalMonth =  4 then RETURN  'April'
  122.     if CalMonth =  5 then RETURN  'May'
  123.     if CalMonth =  6 then RETURN  'June'
  124.     if CalMonth =  7 then RETURN  'July'
  125.     if CalMonth =  8 then RETURN  'August'
  126.     if CalMonth =  9 then RETURN  'September'
  127.     if CalMonth = 10 then RETURN  'October'
  128.     if CalMonth = 11 then RETURN  'November'
  129.     if CalMonth = 12 then RETURN  'December'
  130. RETURN 'ERROR: INVALID MONTH NUMBER'
  131.  
  132. /*===============================================================*/
  133. DOWNAME : procedure
  134. /* Calculate English-language name of the day of the week */
  135. /*===============================================================*/
  136. arg DayOfWeekNum
  137.             if DayOfWeekNum = 1 then RETURN  'Sunday'
  138.             if DayOfWeekNum = 2 then RETURN  'Monday'
  139.             if DayOfWeekNum = 3 then RETURN  'Tuesday'
  140.             if DayOfWeekNum = 4 then RETURN  'Wednesday'
  141.             if DayOfWeekNum = 5 then RETURN  'Thursday'
  142.             if DayOfWeekNum = 6 then RETURN  'Friday'
  143.             if DayOfWeekNum = 7 then RETURN  'Saturday'
  144. RETURN 'ERROR: INVALID DAY OF WEEK NUMBER'
  145.  
  146. /* */
  147. /*==============================================================*/
  148. BaseDate_To_CalDate: procedure expose (constants)
  149. /* Convert an absolute date into a calendar date */
  150. /*===============================================================*/
  151. BaseDate = arg(1)
  152. AbsDate = BaseDate + 1 /*  REXX BaseDate ==> TrueDate AbsDate */
  153.  
  154. if \Datatype(AbsDate,"W") then
  155.    RETURN "ERROR: parameter is not a whole number."
  156.  
  157. Num400YrGroups = AbsDate % DaysIn400YrGroup
  158. Num400YrModYrs = AbsDate // DaysIn400YrGroup
  159.  
  160. if Num400YrModYrs = 0 then
  161.    do    /*absolute date fits exactly into a 400-year group*/
  162.          JulianDate = 366
  163.          CalYear    = (400 * Num400YrGroups)
  164.    end
  165. else
  166.    do
  167.    Num100YrGroups = Num400YrModYrs %  DaysIn100YrGroup
  168.    Num100YrModYrs = Num400YrModYrs // DaysIn100YrGroup
  169.    if Num100YrModYrs = 0 then
  170.       do /*absolute date fits exactly into a 100-year group*/
  171.          JulianDate = 365
  172.          CalYear    = (400 * Num400YrGroups)  ,
  173.                     + (100 * Num100YrGroups)  ;
  174.       end
  175.    else
  176.       do
  177.       Num004YrGroups = Num100YrModYrs %  DaysIn004YrGroup
  178.       Num004YrModYrs = Num100YrModYrs // DaysIn004YrGroup
  179.       if Num004YrModYrs = 0 then
  180.          do
  181.          /*absolute date fits exactly into a  4-year group*/
  182.          JulianDate = 366
  183.          CalYear    = (400 * Num400YrGroups)           ,
  184.                     + (100 * Num100YrGroups)           ,
  185.                     + ( 4  * Num004YrGroups)           ;
  186.          end
  187.       else
  188.          do
  189.          Num001YrGroups = Num004YrModYrs %  DaysInOrdinaryYr
  190.          Num001YrModYrs = Num004YrModYrs // DaysInOrdinaryYr
  191.          if Num001YrModYrs = 0 then
  192.             do
  193.             /*absolute date fits exactly into a  1-year group*/
  194.             JulianDate= 365
  195.             CalYear = (400 * Num400YrGroups)             ,
  196.                     + (100 * Num100YrGroups)             ,
  197.                     + ( 4  * Num004YrGroups)             ,
  198.                     + ( 1  * Num001YrGroups)             ;
  199.             end
  200.          else
  201.             do
  202.             /*absolute date doesn't fit exactly into any group*/
  203.             JulianDate= Num001YrModYrs
  204.  
  205.             /*Add 1 to convert a year count into an ordinal year*/
  206.             /*E.g. Absolute day 5 is Jan. 5 of year 1, not year 0*/
  207.  
  208.             CalYear  = (400 * Num400YrGroups) ,
  209.                      + (100 * Num100YrGroups) ,
  210.                      + ( 4  * Num004YrGroups) ,
  211.                      + ( 1  * Num001YrGroups) ,
  212.                      +   1   ;
  213.             end
  214.          end
  215.       end
  216.    end
  217.  
  218. /* */
  219. /*determine number of days in February in this year*/
  220. LeapYearFlag = IsLeapYear(CalYear)
  221.  
  222. FEBdays      = FEBshort + LeapYearFlag
  223.  
  224. /*Initialize month number to month #1  */
  225. CalMonth = 1
  226.  
  227. /*Initialize day-of-month to Julian date*/
  228. CalDay   = JulianDate
  229.  
  230. /*Subtract days of elapsed months from day-of-month to get final
  231. day-of-month.
  232. At the same time, increment month-number for each elapsed month.*/
  233.  
  234. if CalDay > JANdays then do
  235.   call BumpMonth JANdays
  236.   if CalDay > FEBdays then do
  237.       call BumpMonth FEBdays
  238.       if CalDay > MARdays then do
  239.         call BumpMonth MARdays
  240.         if CalDay > APRdays then do
  241.            call BumpMonth APRdays
  242.            if CalDay > MAYdays then do
  243.               call BumpMonth MAYdays
  244.               if CalDay > JUNdays then do
  245.                  call BumpMonth JUNdays
  246.                  if CalDay > JULdays then do
  247.                     call BumpMonth JULdays
  248.                     if CalDay > AUGdays then do
  249.                        call BumpMonth AUGdays
  250.                        if CalDay > SEPdays then do
  251.                           call BumpMonth SEPdays
  252.                           if CalDay > OCTdays then do
  253.                              call BumpMonth OCTdays
  254.                              if CalDay > NOVdays then do
  255.                                 call BumpMonth NOVdays
  256.                              end
  257.                           end
  258.                        end
  259.                      end
  260.                   end
  261.                end
  262.             end
  263.          end
  264.       end
  265.    end
  266. end
  267. RETURN  CalYear CalMonth CalDay
  268.  
  269. /* */
  270. /*==============================================================*/
  271. CalDate_To_BaseDate: procedure expose (constants)
  272. /* Convert a calendar date into an absolute date */
  273. /*===============================================================*/
  274. arg CalYear CalMonth CalDay .
  275.  
  276. if \Datatype(CalDay ,"W") then
  277.    RETURN "ERROR: CalDay (word 3) is not a whole number."
  278.  
  279. if \Datatype(CalMonth ,"W") then
  280.    RETURN "ERROR: CalMonth (word 2) is not a whole number."
  281.  
  282. if \Datatype(CalYear ,"W") then
  283.    RETURN "ERROR: CalYear (word 1) is not a whole number."
  284.  
  285. /* ===============================================================
  286.  Subtract 1 to convert an ordinal year number into a count of years
  287.  elapsed since "the start of time".      Examples:
  288.  During year ONE, ZERO years have actually elapsed from day one.
  289.  During year TWO,  ONE year  has  actually elapsed from day one.
  290.  =============================================================== */
  291. Num400YrGroups = (CalYear - 1)   %  400
  292. Num400YrModYrs = (CalYear - 1)   // 400
  293.  
  294. Num100YrGroups = Num400YrModYrs %  100
  295. Num100YrModYrs = Num400YrModYrs // 100
  296.  
  297. Num004YrGroups = Num100YrModYrs %    4
  298. Num004YrModYrs = Num100YrModYrs //   4
  299.  
  300. Num001YrGroups = Num004YrModYrs %    1
  301.  
  302. /*Initialize absolute date to number of days elapsed in previous years*/
  303. AbsDate  = ( Num400YrGroups * DaysIn400YrGroup ) ,
  304.          + ( Num100YrGroups * DaysIn100YrGroup ) ,
  305.          + ( Num004YrGroups * DaysIn004YrGroup ) ,
  306.          + ( Num001YrGroups * DaysInOrdinaryYr )
  307.  
  308. /*determine number of days in February in this year*/
  309. LeapYearFlag = IsLeapYear(CalYear)
  310.  
  311. FEBdays      = FEBshort + LeapYearFlag
  312.  
  313. /*Initialize Julian date to days elapsed in this month*/
  314. JulianDate = CalDay
  315.  
  316. /*add days of previous months in this year to get final Julian date*/
  317. if CalMonth > 1  then JulianDate = JulianDate + JANdays
  318. if CalMonth > 2  then JulianDate = JulianDate + FEBdays
  319. if CalMonth > 3  then JulianDate = JulianDate + MARdays
  320. if CalMonth > 4  then JulianDate = JulianDate + APRdays
  321. if CalMonth > 5  then JulianDate = JulianDate + MAYdays
  322. if CalMonth > 6  then JulianDate = JulianDate + JUNdays
  323. if CalMonth > 7  then JulianDate = JulianDate + JULdays
  324. if CalMonth > 8  then JulianDate = JulianDate + AUGdays
  325. if CalMonth > 9  then JulianDate = JulianDate + SEPdays
  326. if CalMonth > 10 then JulianDate = JulianDate + OCTdays
  327. if CalMonth > 11 then JulianDate = JulianDate + NOVdays
  328.  
  329. /*add Julian date to days of previous years to get final absolute date*/
  330. AbsDate    = AbsDate + JulianDate
  331.  
  332. BaseDate = AbsDate - 1 /* TrueDate AbsDate ==> REXX BaseDate */
  333. RETURN BaseDate
  334.