home *** CD-ROM | disk | FTP | other *** search
/ Programmer 7500 / MAX_PROGRAMMERS.iso / INFO / CLIPPER / NFSRC.ZIP / WOY.PRG < prev    next >
Encoding:
Text File  |  1991-08-16  |  5.8 KB  |  228 lines
  1. /*
  2.  * File......: WOY.PRG
  3.  * Author....: Forest Belt, Computer Diagnostic Services, Inc.
  4.  * Date......: $Date:   15 Aug 1991 23:03:18  $
  5.  * Revision..: $Revision:   1.2  $
  6.  * Log file..: $Logfile:   E:/nanfor/src/woy.prv  $
  7.  *
  8.  * This is an original work by Forest Belt and is placed in the
  9.  * public domain.
  10.  *
  11.  * Modification history:
  12.  * ---------------------
  13.  *
  14.  * $Log:   E:/nanfor/src/woy.prv  $
  15.  * 
  16.  *    Rev 1.2   15 Aug 1991 23:03:18   GLENN
  17.  * Forest Belt proofread/edited/cleaned up doc
  18.  * 
  19.  *    Rev 1.1   11 May 1991 00:01:00   GLENN
  20.  * Documentation correction on ft_doy() oneliner.  Was identical to ft_woy(),
  21.  * now it's right.
  22.  * 
  23.  *    Rev 1.0   01 Apr 1991 01:02:32   GLENN
  24.  * Nanforum Toolkit
  25.  *
  26.  */
  27.  
  28.  
  29. #ifdef FT_TEST
  30.  
  31.   // ADD PARAMETER "CENTURY" ON COMMAND LINES TO TEST 4-DIGIT YEARS
  32.  
  33.   FUNCTION MAIN( cCent )
  34.      LOCAL  lCentOn := .F., cDate
  35.      MEMVAR getlist
  36.    
  37.      IF VALTYPE( cCent) == "C" .AND. "CENT" $ UPPER( cCent)
  38.      SET CENTURY ON
  39.      lCentOn := .T.
  40.      END
  41.   
  42.      DO WHILE .T.
  43.      CLEAR
  44.      @ 2,10 SAY "Date to Test"
  45.     
  46.      IF lCentOn
  47.         cDate := SPACE(10)
  48.         @ 2,24 GET cDate PICTURE "##/##/####"
  49.      ELSE
  50.         cDate := SPACE(8)
  51.         @ 2,24 GET cDate PICTURE "##/##/##"
  52.      END
  53.      READ
  54.  
  55.      IF EMPTY(cDate)
  56.         EXIT
  57.      END
  58.     
  59.      IF DTOC( CTOD( cDate) ) = " "
  60.         QQOUT( CHR( 7) )
  61.         @ 4,24 SAY "INVALID DATE"
  62.         INKEY(2)
  63.         LOOP
  64.      END
  65.     
  66.      @ 4,10 SAY "Is Day Number " + STR( FT_DOY( CTOD( cDate)) ,3)
  67.     
  68.      @ 6,10 SAY "Is in Week Number " + STR( FT_WOY( CTOD( cDate)) ,2)
  69.      @ 7,0
  70.      WAIT
  71.      END
  72.   
  73.      CLEAR
  74.   RETURN nil
  75.   
  76. #endif
  77.   
  78. /* $DOC$
  79.  *  $FUNCNAME$
  80.  *     FT_WOY()
  81.  *  $CATEGORY$
  82.  *     Date/Time
  83.  *  $ONELINER$
  84.  *     Find number of week within year
  85.  *  $SYNTAX$
  86.  *     FT_WOY( <dDate> ) -> <nResult>
  87.  *  $ARGUMENTS$
  88.  *     <dDate> is a date in the form "mm/dd/yy" or "mm/dd/yyyy"
  89.  *  $RETURNS$
  90.  *     Return numeric position of week within the year or NIL if
  91.  *     parameter does not conform.
  92.  *  $DESCRIPTION$
  93.  *     Considers a full week as starting on Sunday, ending on Saturday.
  94.  *     First week of year (week 1) may start on any day, and thus
  95.  *       contain any number of days.
  96.  *     Final week of year (week 53) may contain any number of days.
  97.  *     Handles dates with CENTURY ON|OFF, to allow for 21st century.
  98.  *     Date validation must be external to this function.
  99.  *  $EXAMPLES$
  100.  *     These code fragments find the week number, given a date.
  101.  *
  102.  *     // literal character date
  103.  *     dDate  := CTOD("01/01/91")
  104.  *     nWkNum := FT_WOY(dDate)              // result:  1
  105.  *
  106.  *     // presume DOS date to be 01/06/91
  107.  *     nWkNum := FT_WOY(DATE())             // result:  2
  108.  *
  109.  *     // date input
  110.  *     cDate  := SPACE(8)
  111.  *     @ 4,10 get cDate PICT "##/##/##"     // input 07/04/91
  112.  *     READ
  113.  *     nWkNum := FT_WOY(CTOD(cDate))        // result: 27
  114.  *
  115.  *     // last day of year
  116.  *     nWkNum := FT_WOY(CTOD("12/31/91"))    // result: 53
  117.  *
  118.  *     For a demonstration of this function, compile and link the
  119.  *     program WOY.PRG in the Nanforum Toolkit source code.
  120.  *  $END$
  121.  */
  122.  
  123. FUNCTION FT_WOY(dInDate)
  124.  
  125.   LOCAL nFirstDays, nDayOffset, nWkNumber, cCentury
  126.  
  127.   IF VALTYPE( dInDate) != "D"
  128.      nWkNumber := NIL
  129.   
  130.   ELSE
  131.  
  132.      // resolve century issue
  133.      IF LEN( DTOC( dInDate) ) > 8                  // CENTURY is on
  134.      cCentury := SUBSTR( DTOC( dInDate) ,7 ,4)
  135.      ELSE
  136.      cCentury := SUBSTR( DTOC( dInDate) ,7 ,2)
  137.      END
  138.   
  139.  
  140.      // find number of days in first week of year
  141.  
  142.      nFirstDays := 8 - (DOW (CTOD ("01/01/" + cCentury) ) )
  143.   
  144.      nWkNumber  := 1
  145.  
  146.  
  147.      // find how many days after first week till dInDate
  148.  
  149.      nDayOffset := (dInDate - ;
  150.                  CTOD ("01/01/" + cCentury) ) - nFirstDays + 1
  151.  
  152.  
  153.      // count weeks in offset period
  154.  
  155.      DO WHILE nDayOffset > 0
  156.      ++nWkNumber
  157.      nDayOffset -= 7
  158.      END
  159.   
  160.   END
  161.  
  162. RETURN (nWkNumber)
  163.  
  164.  
  165. /* $DOC$
  166.  *  $FUNCNAME$
  167.  *     FT_DOY()
  168.  *  $CATEGORY$
  169.  *     Date/Time
  170.  *  $ONELINER$
  171.  *     Find number of day within year
  172.  *  $SYNTAX$
  173.  *     FT_DOY( <dDate> ) -> <nResult>
  174.  *  $ARGUMENTS$
  175.  *     <dDate> is a date in the form "mm/dd/yy" or "mm/dd/yyyy"
  176.  *  $RETURNS$
  177.  *     Return numeric position of day within the year.
  178.  *     Return NIL if parameter does not conform.
  179.  *  $DESCRIPTION$
  180.  *     Finds the day number, considering 01/01 as day 1
  181.  *     Handles dates with CENTURY ON|OFF, to allow for 21st century.
  182.  *     Date validation must be external to this function.
  183.  *  $EXAMPLES$
  184.  *     These code fragments find the day number, given a date.
  185.  *
  186.  *     // literal character date
  187.  *     dDate  := CTOD("01/01/91")
  188.  *     nDayNum := FT_DOY(dDate)              // result:  1
  189.  *
  190.  *     // presume DOS date to be 01/06/91
  191.  *     nDayNum := FT_DOY(DATE())             // result:  6
  192.  *
  193.  *     // date input
  194.  *     cDate  := SPACE(8)
  195.  *     @ 4,10 get cDate PICT "##/##/##"      // input 07/04/91
  196.  *     READ
  197.  *     nDayNum := FT_DOY(CTOD(cDate))        // result: 185
  198.  *
  199.  *     // last day of year
  200.  *     nDayNum := FT_DOY(CTOD("12/31/91"))    // result: 365
  201.  *
  202.  *     For a demonstration of this function, compile and link the
  203.  *     program WOY.PRG in the Nanforum Toolkit source code.
  204.  *  $END$
  205.  */
  206.  
  207. FUNCTION FT_DOY(dInDate)
  208.  
  209.   LOCAL nDayNum, cCentury
  210.  
  211.   IF VALTYPE(dInDate) != "D"
  212.      nDayNum := NIL
  213.   ELSE
  214.  
  215.      // resolve century issue
  216.      IF LEN( DTOC( dInDate) ) > 8                  // CENTURY is on
  217.      cCentury := SUBSTR( DTOC( dInDate) ,7 ,4)
  218.      ELSE
  219.      cCentury := SUBSTR( DTOC( dInDate) ,7 ,2)
  220.      END
  221.   
  222.      // calculate
  223.      nDayNum := (dInDate - CTOD ("01/01/" + cCentury)) + 1
  224.  
  225.   END
  226.  
  227. RETURN (nDayNum)
  228.