home *** CD-ROM | disk | FTP | other *** search
/ CP/M / CPM_CDROM.iso / simtel / sigm / vols200 / vol217 / datelib.cmd < prev    next >
OS/2 REXX Batch file  |  1986-02-12  |  8KB  |  240 lines

  1. * <<<=======================================================================>>>
  2. *     This program is Copyrighted and the Sole Property of Keith R. Plossl
  3. *            Program Name    : DATELIB.CMD
  4. *            Author        : Keith R. Plossl
  5. *            Date Written    : February 1984
  6. *
  7. *  <++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++>
  8. *  <           C O P Y R I G H T E D   S O F T W A R E   N O T I C E        >
  9. *  <           =====================================================        >
  10. *  <  This software is copyrighted under the laws of the United States of   >
  11. *  <  America and all rights are reserved by Keith R. Plossl.  This program >
  12. *  <  may be freely copied for non-commercial use provided the title block, >
  13. *  <  modification history and this notice remain intact.  Copying this     >
  14. *  <  program for Resale or for any other commercial purpose is STRICTLY    >
  15. *  <  FORBIDDEN and subject to federal prosecution.       KRP 2/5/84        >
  16. *  <++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++>
  17. *
  18. *                 M O D I F I C A T I O N    H I S T O R Y
  19. *
  20. *      Date            What                Who
  21. *
  22. * <<<=======================================================================>>>
  23. *
  24. *
  25. *                  >>>> ----- W A R N I N G ----- <<<<
  26. *
  27. *  THE FOLLOWING IS LIST OF VARIABLES USED BY THIS LIBRARY.  CONSIDER THEM
  28. *  TO BE RESERVED WORDS OR YOUR VARIABLES WITH THE SAME NAME WILL BE GONE.
  29. *
  30. *         DATE             SYSD    
  31. *        DAY                    JULDATE   
  32. *        MONTH                BASEDATE 
  33. *        SYSDATE                 LEAP
  34. *               ERRX            MM
  35. *        DD            YY
  36. *               BLNKS1            YEAR
  37. *        OK
  38. *
  39. * <<<=======================================================================>>>
  40. *
  41. *   ------------------------  Date Routines -----------------------
  42. *                                Library
  43. *
  44. *       This program is a date function library for DBASE II.
  45. *
  46. * <<<=======================================================================>>>
  47. *
  48. *
  49. *              ----- Date Validation Routine -----
  50. *     -----------------------------------------------------------
  51. *     | Function Call: VDT             Input Parameters: DATE   |
  52. *     |                    Output Variable: OK     |
  53. *     |                                 Possible Output: ERRX   |
  54. *     -----------------------------------------------------------
  55. *
  56. *
  57. *     Routine to Validate the variable DATE
  58. *
  59. *
  60. if !(FUNCTION) = 'VDT' .and. type(DATE) <> 'U'
  61.     store '                                                  ' to BLNKS1
  62.     store $(BLNKS1,1,42)       to ERRX
  63.     store F to OK
  64. *
  65. *                   Initialize Month, Day and Year Variables
  66. *
  67.     store val($(DATE,1,2))    to MM
  68.     store val($(DATE,4,2))    to DD
  69.     store val($(DATE,7,2))    to YY
  70. *
  71. *                   Date Validation Routine
  72. *
  73.      do case
  74. *
  75. *    If Month or Day exceeds 12 or 31 or is less than 1 or if 
  76. *    Year is less than 1980 then Error Results
  77. *
  78.           case MM<1 .or. MM>12 .or. DD<1 .or. DD>31 .or. YY<80
  79.                store '       Invalid Date - Reenter'   to ERRX
  80. *
  81. *     If the Month is Apr., Jun., Sep. or Nov. Test Number of
  82. *     days for over 30.  If over Set Error Message
  83. *
  84.           case MM=4 .or. MM=6 .or. MM=9 .or. MM=11 
  85.            if DD>30
  86.                store 'Thirty Days hath September, etc. - Reenter'   to ERRX
  87.            else
  88.             store T to OK
  89.            endif
  90. *
  91. *     If the Month is Feb. Check for Number of Days and Leap Year
  92. *     if not leap year and Days = 29 then Set Error Message
  93. *
  94.           case MM=2 .and. DD>28 .and. ((1900 + YY)/4)<>int(((1900 + YY)/4))
  95.                store '     Not a leap year - Try Again'   to ERRX
  96. *
  97. *    If the Month is Feb. and the Days exceed 29 Set Error Message
  98. *
  99.           case MM=2 .and. DD>29
  100.                store 'February has a Maximum of 29 Days - Reenter' to ERRX
  101. *
  102. *    If none of the above apply the date is OK - Set Flag 
  103. *
  104.           otherwise
  105.         store T to OK
  106.     endcase
  107.     release BLNKS1, ERRX, MM, DD, YY
  108. endif (FUNCTION = 'VDT')
  109. * <<------------------------------------------------------------------------->>
  110. *
  111. do case
  112. *
  113. * <<<=======================================================================>>>
  114. *
  115. *        ----- Fundamental Julian Date Calcuator Routine -----
  116. *     -----------------------------------------------------------
  117. *     | Function Call: JDT             Input Parameters: DATE   |
  118. *     |                    Output Variable: JULDATE|
  119. *     -----------------------------------------------------------
  120. *
  121.     case !(FUNCTION) = 'JDT' .and. type(DATE) <> 'U'
  122.         store DATE            to DATE
  123.         store val($(DATE,1,2))        to MONTH
  124.         store val($(DATE,4,2))        to DAY
  125.         store val($(DATE,7,2))+1900    to YEAR
  126.         store int(30.57*MONTH) + int(365.25*YEAR-395.25) + DAY     to JULDATE
  127.         release DATE, MONTH, DAY, YEAR
  128. *
  129. * <<<=======================================================================>>>
  130. *
  131. *
  132. *      ----- Reconstruct Julian Date to Normal Date Routine -----
  133. *     -----------------------------------------------------------
  134. *     | Function Call: SDT             Input Parameters: JULDATE|
  135. *     |                    Output Variable: SYSDATE|
  136. *     -----------------------------------------------------------
  137. *
  138. *
  139.     case !(FUNCTION) = 'SDT' .and. type(JULDATE) <> 'U'
  140.         store INT(JULDATE/365.26) + 1        to YEAR
  141.         store JULDATE + int(395.25-365.25*YEAR)    to DAY
  142.         if int(YEAR/4) * 4 = YEAR
  143.             store 1 to LEAP
  144.         else
  145.             store 2 to LEAP
  146.         endif
  147.         if DAY > (91 - LEAP)
  148.             store DAY + LEAP    to DAY
  149.         endif
  150.         store int(DAY/30.57)    to MONTH
  151.         store DAY - int(30.57*MONTH) to DAY
  152.         if MONTH > 12
  153.             store 1     to MONTH
  154.             store YEAR + 1    to YEAR
  155.         endif
  156.         store YEAR - 1900    to YEAR
  157.         store str(MONTH,2) + '/' + str(DAY,2) + '/' + str(YEAR,2) to SYSDATE
  158.         release JULDATE, YEAR, MONTH, DAY, LEAP
  159. *
  160. * <<<=======================================================================>>>
  161. *
  162. *
  163. *      ----- Generate Base Year Julian Format Date Routine -----
  164. *     -----------------------------------------------------------
  165. *     | Function Call: BDT             Input Parameters: DATE   |
  166. *     |                    Output Variable: BASDATE|
  167. *     -----------------------------------------------------------
  168. *
  169. * Routine uses Jan 1, 1980 as Base (722830)
  170. *
  171.     case !(FUNCTION) = 'BDT' .and. type(DATE) <> 'U'
  172.         store 722830        to BASEDATE
  173.         store DATE        to SYSD
  174.         store val($(SYSD,1,2))    to MONTH
  175.         store val($(SYSD,4,2))    to DAY
  176.         store val($(SYSD,7,2))+1900    to YEAR
  177.         store int(30.57*MONTH) + int(365.25*YEAR-395.25) + DAY     to JD
  178.         store JD - BASEDATE    to BASDATE
  179.         release BASEDATE, SYSD, MONTH, DAY, YEAR
  180. *
  181. * <<<=======================================================================>>>
  182. *
  183. *       Reconstruct Base Year Julian Date to Normal Date Routine 
  184. *     -----------------------------------------------------------
  185. *     | Function Call: SBT             Input Parameters: BASDATE|
  186. *     |                    Output Variable: SYSDATE|
  187. *     -----------------------------------------------------------
  188. *
  189. * Routine uses Jan 1, 1980 as Base (722830)
  190. *
  191. *       
  192.     case !(FUNCTION) = 'SBT' .AND. type(BASDATE) <> 'U'
  193.         store 722830        to BASEDATE
  194.         store BASDATE + BASEDATE        to JD
  195.         store INT(JD/365.26) + 1        to YEAR
  196.         store JD + int(395.25-365.25*YEAR)    to DAY
  197.         if int(YEAR/4) * 4 = YEAR
  198.             store 1 to LEAP
  199.         else
  200.             store 2 to LEAP
  201.         endif
  202.         if DAY > (91 - LEAP)
  203.             store DAY + LEAP    to DAY
  204.         endif
  205.         store int(DAY/30.57)    to MONTH
  206.         store DAY - int(30.57*MONTH) to DAY
  207.         if MONTH > 12
  208.             store 1     to MONTH
  209.             store YEAR + 1    to YEAR
  210.         endif
  211.         store YEAR - 1900    to YEAR
  212.         store str(MONTH,2) + '/' + str(DAY,2) + '/' + str(YEAR,2)  to SYSDATE
  213.         release BASDATE, BASEDATE, JD, YEAR, MONTH, DAY, LEAP
  214. *
  215. * <<<=======================================================================>>>
  216. *
  217. *        ----- >>>  Otherwise Undefined <<< -----
  218. *
  219.     case !(FUNCTION) = 'VDT'
  220. *        do nothing further
  221.     otherwise
  222.         store 'UNKNOWN' to FUNCTION
  223.     endcase
  224. if FUNCTION <> 'UNKNOWN'
  225.     release FUNCTION
  226. endif
  227. return
  228. *
  229. *
  230. * <<<=======================================================================>>>
  231. *
  232. *                      End of Date Routines Library 
  233. *
  234. * <<<=======================================================================>>>
  235. *     This program is Copyrighted and the Sole Property of Keith R. Plossl
  236. * <<<=======================================================================>>>
  237. *
  238.  
  239.