home *** CD-ROM | disk | FTP | other *** search
/ mail.altrad.com / 2015.02.mail.altrad.com.tar / mail.altrad.com / TEST / COMMERC_72_53OLD / commerc / PROGSOLD / date.prg < prev    next >
Text File  |  2014-04-02  |  5KB  |  253 lines
  1. /***
  2. *
  3. *  Date.prg
  4. *
  5. *  Sample user-defined functions for manipulating dates
  6. *
  7. *  Copyright (c) 1993-1995, Computer Associates International Inc.
  8. *  All rights reserved.
  9. *
  10. *  NOTE: compile with /a /m /n /w
  11. *
  12. */
  13.  
  14.  
  15.  
  16. /***
  17. *
  18. *  Mdy( <dDate> ) --> cDate
  19. *
  20. *  Convert a date to a string in the format "month dd, yyyy".
  21. *
  22. *  Parameter:
  23. *     dDate - Date value to convert to a string
  24. *
  25. *  Returns: The date value in "long," string form
  26. *
  27. */
  28. FUNCTION Mdy( dDate )
  29.  
  30.    LOCAL cYear
  31.  
  32.    // Handle SET CENTURY
  33.    IF SUBSTR( SET( _SET_DATEFORMAT ), -4 ) == "YYYY"
  34.       cYear := STR( YEAR( dDate ))
  35.    ELSE
  36.       cYear := " " + SUBSTR( STR( YEAR( dDate )), 4, 2 )
  37.    ENDIF
  38.  
  39.    RETURN ( CMONTH( dDate ) + " " + LTRIM( STR( DAY( dDate ))) + "," + cYear )
  40.  
  41.  
  42.  
  43. /***
  44. *
  45. *  Dmy( <dDate> ) --> cDate
  46. *
  47. *  Convert a date to string formatted as "dd month yyyy".
  48. *
  49. *  Parameter:
  50. *     dDate - Date value to convert
  51. *
  52. *  Returns: The date value in european date format
  53. *
  54. */
  55. FUNCTION Dmy( dDate )
  56.  
  57.    LOCAL cYear
  58.  
  59.    // Handle SET CENTURY
  60.    IF SUBSTR( SET( _SET_DATEFORMAT ), -4 ) == "YYYY"
  61.       cYear := STR( YEAR( dDate ))
  62.    ELSE
  63.       cYear := " " + SUBSTR( STR( YEAR( dDate )), 4, 2 )
  64.    ENDIF
  65.  
  66.    RETURN ( LTRIM( STR( DAY( dDate ))) + " " + CMONTH( dDate ) + cYear )
  67.  
  68.  
  69.  
  70. /***
  71. *
  72. *  DateAsAge( <dDate> ) --> nAge
  73. *
  74. *  Convert a date of birth to an age in years.
  75. *
  76. *  Parameter:
  77. *     dDate - Birthdate for which to calculate the age
  78. *
  79. *  Returns: The number of years elapsed since <dDate>
  80. *
  81. */
  82. FUNCTION DateAsAge( dDate )
  83.  
  84.    LOCAL nAge := 0
  85.  
  86.    IF YEAR( DATE() ) > YEAR( dDate )
  87.  
  88.       nAge := YEAR( DATE() ) - YEAR( dDate )
  89.  
  90.       // Decrease the age by one if the date (month/day) has not yet
  91.       // occurred this year
  92.       IF ( MONTH( DATE() ) < MONTH( dDate )  .OR.  ;
  93.          ( MONTH( DATE() ) == MONTH( dDate ) .AND. ;
  94.            DAY( DATE() ) < DAY( dDate )            ;
  95.          ))
  96.  
  97.          --nAge
  98.  
  99.       ENDIF
  100.    ENDIF
  101.  
  102.    RETURN nAge
  103.  
  104.  
  105.  
  106. /***
  107. *
  108. *  AddMonth( <dDate>, <nMonths> ) --> dNewDate
  109. *
  110. *  Calculate a new date by adding a number of months to a given
  111. *  date.
  112. *
  113. *  Date validation must be done by calling program.
  114. *
  115. *  Parameters:
  116. *     dDate   - Date value to add <nMonths> to
  117. *     nMonths - Number of months to add to <dDate>
  118. *
  119. *  Returns: The date value representing <dDate> + <nMonths>
  120. *
  121. */
  122. FUNCTION AddMonth( dDate, nMonths)
  123.  
  124.    LOCAL nMonth
  125.    LOCAL nDay
  126.    LOCAL nYear
  127.    LOCAL nLimit
  128.    LOCAL nMonthAdd
  129.    LOCAL nYearAdd
  130.    LOCAL dNew
  131.  
  132.    // Break date up into its numeric components
  133.    nMonth := MONTH( dDate )
  134.    nDay   := DAY( dDate )
  135.    nYear  := YEAR( dDate )
  136.  
  137.    // nLimit determines the minimum number of months that will push the
  138.    // date into the next year.  If the number of months added to the date
  139.    // exceeds this limit, the year must be advanced by one
  140.    nLimit := 12 - nMonth + 1
  141.  
  142.    // Compute number of years to add
  143.    nYearAdd := INT( nMonths / 12 )
  144.    nMonths := nMonths % 12
  145.  
  146.    IF nMonths >= nLimit
  147.       nYearAdd++
  148.    ENDIF
  149.  
  150.    nYear += nYearAdd
  151.  
  152.    // Compute number of months to add and normalize month
  153.    nMonthAdd := nMonths % 12
  154.    nMonth    := ( nMonth + nMonthAdd ) % 12
  155.  
  156.    IF nMonth = 0    // December special case
  157.       nMonth := 12
  158.    ENDIF
  159.  
  160.    // Convert numeric portions to new date
  161.    dNew := NtoD( nMonth, nDay, nYear )
  162.  
  163.    IF DTOC(dNew) = '  /  /  '
  164.       nMonth := (nMonth + 1) % 12
  165.       nDay := 1
  166.       nYear := nYear + INT((nMonth + 1) / 12)
  167.       dNew := NtoD(nMonth,nDay,nYear) - 1
  168.    ENDIF
  169.  
  170.    RETURN ( dNew )
  171.  
  172.  
  173.  
  174. /***
  175. *
  176. *  DateAsArray( dDate ) --> aDate
  177. *
  178. *  Convert a date to an array of year, month, and day
  179. *
  180. *  Parameter:
  181. *     dDate - Date value to convert into array form
  182. *
  183. *  Returns: The date in the format { nYear, nMonth, nDay }
  184. *           If the parameter is invalid, an empty array ({}) is returned
  185. *
  186. */
  187. FUNCTION DateAsArray( dDate )
  188.  
  189.    LOCAL aDate := {}
  190.  
  191.    IF VALTYPE( dDate ) == "D"
  192.       aDate := { YEAR( dDate ), MONTH( dDate ), DAY( dDate ) }
  193.    ENDIF
  194.  
  195.    RETURN aDate
  196.  
  197.  
  198.  
  199. /***
  200. *
  201. *  ArrayAsDate( aDate ) --> dDate
  202. *
  203. *  Convert an array of year, month, and day to a date value
  204. *
  205. *  Parameter:
  206. *     aDate - Array holding a date in the form { nYear, nMonth, nDay }
  207. *
  208. *  Returns: aDate in date value form
  209. *
  210. */
  211. FUNCTION ArrayAsDate( aDate )
  212.    RETURN NtoD( aDate[2], aDate[3], aDate[1] )
  213.  
  214.  
  215.  
  216. /***
  217. *
  218. *  DateIsLeap( <dDate> ) --> lLeap
  219. *
  220. *  Determine if the year of a supplied date is a leap year
  221. *
  222. */
  223. FUNCTION DateIsleap( dDate )
  224.    
  225.    LOCAL nYear := YEAR( dDate )
  226.  
  227.    RETURN (( nYear % 4 ) == 0 )    .AND. ;
  228.           ((( nYear % 100 ) != 0 ) .OR.  ;
  229.           (( nYear % 400 ) == 0)   )
  230.  
  231.  
  232.  
  233. /***
  234. *
  235. *  NtoD( nMonth, nDay, nYear ) --> dNew
  236. *
  237. *  Convert a date passed as separate numeric parameters to a date value
  238. *
  239. */
  240. FUNCTION NtoD( nMonth, nDay, nYear )
  241.    
  242.    LOCAL cSavDateFormat := SET( _SET_DATEFORMAT, "MM/DD/YYYY" )
  243.    LOCAL dDate
  244.  
  245.    dDate := CTOD( TRANSFORM( nMonth, "99/" ) + ;
  246.                   TRANSFORM( nDay,   "99/" ) + ;
  247.                   TRANSFORM( nYear,  "9999" )  )
  248.  
  249.    SET( _SET_DATEFORMAT, cSavDateFormat )
  250.  
  251.    RETURN ( dDate )
  252.  
  253.