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