home *** CD-ROM | disk | FTP | other *** search
/ Media Share 9 / MEDIASHARE_09.ISO / progmisc / nfsrc21.zip / DATECNFG.PRG < prev    next >
Text File  |  1992-09-28  |  12KB  |  336 lines
  1. /*
  2.  * File......: DATECNFG.PRG
  3.  * Author....: Jo W. French dba Practical Computing
  4.  * CIS ID....: 74730,1751
  5.  * Date......: $Date:   28 Sep 1992 00:34:08  $
  6.  * Revision..: $Revision:   1.3  $
  7.  * Log file..: $Logfile:   C:/nanfor/src/datecnfg.prv  $
  8.  * 
  9.  * The functions contained herein are the original work of Jo W. French
  10.  * and are placed in the public domain.
  11.  *
  12.  * Modification history:
  13.  * ---------------------
  14.  *
  15.  * $Log:   C:/nanfor/src/datecnfg.prv  $
  16.  * 
  17.  *    Rev 1.3   28 Sep 1992 00:34:08   GLENN
  18.  * Jo French clean up.
  19.  * 
  20.  *    Rev 1.2   15 Aug 1991 23:05:10   GLENN
  21.  * Forest Belt proofread/edited/cleaned up doc
  22.  * 
  23.  *    Rev 1.1   14 Jun 1991 19:51:26   GLENN
  24.  * Minor edit to file header
  25.  * 
  26.  *    Rev 1.0   01 Apr 1991 01:01:00   GLENN
  27.  * Nanforum Toolkit
  28.  *
  29.  */
  30.  
  31.  
  32. #ifdef FT_TEST
  33.   ********************************************************************
  34.   *
  35.   * NOTES: 1) The date functions are 'international'; i.e., the
  36.   *           system date format is maintained, although ANSI is
  37.   *           temporarily used within certain functions.
  38.   *
  39.   *        2) The date functions fall into two categories:
  40.   *
  41.   *           a) Calendar or fiscal periods.
  42.   *              A calendar or fiscal year is identified by the year()
  43.   *              of the last date in the year.
  44.   *
  45.   *           b) Accounting Periods. An accounting period has the
  46.   *              following characteristics:
  47.   *              If the first week of the period contains 4 or
  48.   *              more 'work' days, it is included in the period;
  49.   *              otherwise, the first week was included in the
  50.   *              prior period.
  51.   *
  52.   *              If the last week of the period contains 4 or more
  53.   *              'work' days it is included in the period; otherwise,
  54.   *              the last week is included in the next period.
  55.   *              This results in 13 week 'quarters' and 4 or 5 week
  56.   *              'months'. Every 5 or 6 years, a 'quarter' will contain
  57.   *              14 weeks and the year will contain 53 weeks.
  58.   *
  59.   *        3) The date functions require the presence of two variables:
  60.   *
  61.   *           a) cFY_Start is a character string used to define the
  62.   *              first day of a calendar or fiscal year. It's format
  63.   *              is ANSI; e.g., "1980.01.01" defines a calendar year,
  64.   *              "1980.10.01" defines a fiscal year, starting October 1.
  65.   *
  66.   *              The year may be any valid year. It's value has no
  67.   *              effect on the date functions. The day is assumed to be
  68.   *              less than 29. See function: FT_DATECNFG().
  69.   *
  70.   *           B) nDow_Start is a number from 1 to 7 which defines the
  71.   *              starting day, DOW(), of a work week; e.g., 1 == Sunday.
  72.   *
  73.   *              See function: FT_DATECNFG()
  74.   *
  75.   * COMPILE ALL PROGRAMS WITH /N /W /A
  76.   *
  77.   ********************************************************************
  78.  
  79.   FUNCTION DEMO()
  80.      LOCAL nNum, dDate, aTestData := {}, aTemp, cFY_Start, nDOW_Start
  81.  
  82. *    SET DATE American                         // User's normal date format
  83.      aTemp      := FT_DATECNFG()               // Get/Set cFY_Start & nDOW_Start.
  84. *    aTemp      := FT_DATECNFG("03/01/80", 1)  // Date string in user's format.
  85.      cFY_Start  := aTemp[1]                    // See FT_DATECNFG() in FT_DATE0.PRG
  86.      NDOW_START := ATEMP[2]                    // FOR PARAMETERS.
  87.      DDATE      := DATE()
  88. *    dDate      := CTOD("02/29/88")            // Test date, in user's normal date format
  89.  
  90.      cls
  91.      ?    "Given       Date:  "
  92.      ??   dDate
  93.      ??   " cFY_Start: "+ cFY_Start
  94.      ??   " nDOW_Start:" + STR(nDOW_Start,2)
  95.      ?    "---- Fiscal Year Data -----------"
  96.  
  97.      aTestData := FT_YEAR(dDate)
  98.      ? "FYYear     ", aTestData[1]+"  ", aTestData[2], aTestData[3]
  99.  
  100.      aTestData := FT_QTR(dDate)
  101.      ? "FYQtr      ", aTestData[1], aTestData[2], aTestData[3]
  102.  
  103.      nNum      := VAL(SUBSTR(aTestData[1],5,2))
  104.      aTestData := FT_QTR(dDate,nNum)
  105.      ? "FYQtr    "+STR(nNum,2), aTestData[1], aTestData[2], aTestData[3]
  106.  
  107.      aTestData := FT_MONTH(dDate)
  108.      ? "FYMonth    ", aTestData[1], aTestData[2], aTestData[3]
  109.  
  110.      nNum := VAL(SUBSTR(aTestData[1],5,2))
  111.      aTestData := FT_MONTH(dDate,nNum)
  112.      ? "FYMonth  "+STR(nNum,2), aTestData[1], aTestData[2], aTestData[3]
  113.  
  114.      aTestData := FT_WEEK(dDate)
  115.      ? "FYWeek     ", aTestData[1], aTestData[2], aTestData[3]
  116.  
  117.      nNum      := VAL(SUBSTR(aTestData[1],5,2))
  118.      aTestData := FT_WEEK(dDate,nNum)
  119.      ? "FYWeek   "+STR(nNum,2), aTestData[1], aTestData[2], aTestData[3]
  120.  
  121.      aTestData := FT_DAYOFYR(dDate)
  122.      ? "FYDay     ", aTestData[1], aTestData[2], aTestData[3]
  123.  
  124.      nNum      := VAL(SUBSTR(aTestData[1],5,3))
  125.      aTestData := FT_DAYOFYR(dDate,nNum)
  126.      ? "FYDAY   "+STR(nNum,3), aTestData[1], aTestData[2], aTestData[3]
  127.  
  128.      ?
  129.      ? "---- Accounting Year Data -------"
  130.  
  131.      aTestData := FT_ACCTYEAR(dDate)
  132.      ? "ACCTYear   ", aTestData[1]+"  ", aTestData[2], aTestData[3],;
  133.            STR( (aTestData[3] - aTestData[2] + 1) /7, 3 ) + " Weeks"
  134.  
  135.      aTestData := FT_ACCTQTR(dDate)
  136.      ? "ACCTQtr    ", aTestData[1], aTestData[2], aTestData[3],;
  137.         STR( (aTestData[3] - aTestData[2] + 1) /7, 3 ) + " Weeks"
  138.  
  139.      nNum      := VAL(SUBSTR(aTestData[1],5,2))
  140.      aTestData := FT_ACCTQTR(dDate,nNum)
  141.      ? "ACCTQtr  "+STR(nNum,2), aTestData[1], aTestData[2], aTestData[3]
  142.  
  143.      aTestData := FT_ACCTMONTH(dDate)
  144.      ? "ACCTMonth  ", aTestData[1], aTestData[2], aTestData[3],;
  145.         STR( (aTestData[3] - aTestData[2] + 1) /7, 3 ) + " Weeks"
  146.  
  147.      nNum      := VAL(SUBSTR(aTestData[1],5,2))
  148.      aTestData := FT_ACCTMONTH(dDate,nNum)
  149.      ? "ACCTMonth"+STR(nNum,2), aTestData[1], aTestData[2], aTestData[3]
  150.  
  151.      aTestData := FT_ACCTWEEK(dDate)
  152.      ? "ACCTWeek   ", aTestData[1], aTestData[2], aTestData[3]
  153.  
  154.      nNum      := VAL(SUBSTR(aTestData[1],5,2))
  155.      aTestData := FT_ACCTWEEK(dDate,nNum)
  156.      ? "ACCTWeek "+STR(nNum,2), aTestData[1], aTestData[2], aTestData[3]
  157.  
  158.      aTestData := FT_DAYOFYR(dDate,,.T.)
  159.      ? "ACCTDay   ", aTestData[1], aTestData[2], aTestData[3]
  160.  
  161.      nNum      := VAL(SUBSTR(aTestData[1],5,3))
  162.      aTestData := FT_DAYOFYR(dDate,nNum,.T.)
  163.      ? "ACCTDay "+STR(nNum,3), aTestData[1], aTestData[2], aTestData[3]
  164.  
  165.      WAIT
  166.  
  167.      FT_CAL(dDate)
  168.      FT_CAL(dDate,1)
  169.  
  170.   RETURN NIL
  171.  
  172.  
  173.   * DEMO Monthly Calendar function.
  174.   * nType : 0 = FT_MONTH, 1 = FT_ACCTMONTH
  175.   *
  176.  
  177.   FUNCTION FT_CAL(dGivenDate,nType)
  178.      LOCAL nTemp, dTemp, aTemp, cFY_Start, dStart, dEnd
  179.  
  180.      aTemp     := FT_DATECNFG()
  181.      cFY_Start := aTemp[1]
  182.  
  183.      IF dGivenDate == NIL .OR. !VALTYPE(dGivenDate) $ 'ND'
  184.         dGivenDate := DATE()
  185.      ELSEIF VALTYPE(dGivenDate) == 'N'
  186.         nType := dGivenDate
  187.         dGivenDate := DATE()
  188.      ENDIF
  189.  
  190.      nType := IF(nType == NIL .OR. VALTYPE(nType) != 'N', 0, nType)
  191.  
  192.      IF nType == 0
  193.         IF SUBSTR(cFY_Start,6,5) == "01.01"
  194.            ? "          Calendar Month Calendar containing " + DTOC(dGivenDate)
  195.         ELSE
  196.            ? "            Fiscal Month Calendar containing " + DTOC(dGivenDate)
  197.         ENDIF
  198.  
  199.         aTemp    := FT_MONTH(dGivenDate)
  200.         dStart   := aTemp[2]
  201.         dEnd     := aTemp[3]
  202.         aTemp[2] -= FT_DAYTOBOW(aTemp[2])
  203.         aTemp[3] += 6 - FT_DAYTOBOW(aTemp[3])
  204.      ELSE
  205.         ? "            Accounting Month Calendar containing " + DTOC(dGivenDate)
  206.         aTemp := FT_ACCTMONTH(dGivenDate)
  207.      ENDIF
  208.  
  209.   ?
  210.   dTemp := aTemp[2]
  211.  
  212.   FOR nTemp := 0 to 6
  213.      ?? PADC( CDOW(dTemp + nTemp),10)
  214.   NEXT
  215.  
  216.   ?
  217.   WHILE dTemp <= aTemp[3]
  218.      FOR nTemp = 1 TO 7
  219.         ?? " "
  220.         IF nType == 0 .AND. (dTemp < dStart .or. dTemp > dEnd)
  221.            ?? SPACE(8)
  222.         ELSE
  223.            ?? dTemp
  224.         ENDIF
  225.         ?? " "
  226.         dTemp ++
  227.      NEXT
  228.      ?
  229.   END
  230.  
  231.   RETURN NIL
  232.  
  233. #endif
  234.  
  235. /*  $DOC$
  236.  *  $FUNCNAME$
  237.  *     FT_DATECNFG()
  238.  *  $CATEGORY$
  239.  *     Date/Time
  240.  *  $ONELINER$
  241.  *     Set beginning of year/week for FT_ date functions
  242.  *  $SYNTAX$
  243.  *     FT_DATECNFG( [ <cFYStart> ], [ <nDow> ] ) -> aDateInfo
  244.  *  $ARGUMENTS$
  245.  *     <cFYStart> is a character date string in the user's system date
  246.  *     format, i.e., the same as the user would enter for CTOD().  If
  247.  *     this argument is NIL, the current value is unchanged.
  248.  *
  249.  *     Note: The year portion of the date string must be present and
  250.  *     be a valid year; however, it has no real meaning.
  251.  *
  252.  *     <nDow> is a number from 1 to 7 (1 = Sunday) indicating the
  253.  *     desired start of a work week.  If this argument is NIL,
  254.  *     the current value is unchanged.
  255.  *
  256.  *  $RETURNS$
  257.  *     A 2-element array containing the following information:
  258.  *
  259.  *        aDateInfo[1] - an ANSI date string indicating the beginning
  260.  *                       date of the year.  Only the month and day are
  261.  *                       meaningful.
  262.  *
  263.  *        aDateInfo[2] - the number of the first day of the week
  264.  *                       (1 = Sunday)
  265.  *
  266.  *  $DESCRIPTION$
  267.  *     FT_DATECNFG() is called internally by many of the date functions
  268.  *     in the library to determine the beginning of year date and
  269.  *     beginning of week day.
  270.  *
  271.  *     The default beginning of the year is January 1st and the default
  272.  *     beginning of the week is Sunday (day 1).  Either or both of these
  273.  *     settings may be changed by calling FT_DATECNFG() with the proper
  274.  *     arguments.  They will retain their values for the duration of the
  275.  *     program or until they are changed again by a subsequent call to
  276.  *     FT_DATECNFG().
  277.  *
  278.  *     It is not necessary to call FT_DATECNFG() unless you need to
  279.  *     change the defaults.
  280.  *
  281.  *     FT_DATECNFG() affects the following library functions:
  282.  *
  283.  *       FT_WEEK()       FT_ACCTWEEK()       FT_DAYTOBOW()
  284.  *       FT_MONTH()      FT_ACCTMONTH()      FT_DAYOFYR()
  285.  *       FT_QTR()        FT_ACCTQTR()        FT_ACCTADJ()
  286.  *       FT_YEAR()       FT_ACCTYEAR()
  287.  *  $EXAMPLES$
  288.  *       // Configure library date functions to begin year on
  289.  *       //  July 1st.
  290.  *
  291.  *       FT_DATECNFG("07/01/80")    // year is insignificant
  292.  *
  293.  *       // Examples of return values:
  294.  *
  295.  *       //  System date format: American           aArray[1]    aArray[2]
  296.  *
  297.  *       aArray := FT_DATECNFG()              //  '1980.01.01'     1 (Sun.)
  298.  *       aArray := FT_DATECNFG('07/01/80')    //  '1980.07.01'     1 (Sun.)
  299.  *       aArray := FT_DATECNFG('07/01/80', 2) //  '1980.07.01'     2 (Mon.)
  300.  *       aArray := FT_DATECNFG( , 2 )         //  '1980.01.01'     2 (Mon.)
  301.  *
  302.  *       //  System date format: British
  303.  *
  304.  *       aArray := FT_DATECNFG('01/07/80', 2) //  '1980.07.01'     2 (Mon.)
  305.  *  $SEEALSO$
  306.  *     FT_ACCTADJ()
  307.  *  $END$
  308. */
  309.  
  310. FUNCTION FT_DATECNFG( cFYStart ,nDow )
  311.  
  312.   STATIC aDatePar := { "1980.01.01", 1 }
  313.  
  314.   LOCAL dCheck, cDateFormat := SET(_SET_DATEFORMAT)
  315.  
  316.   IF VALTYPE( cFYStart ) == 'C'
  317.      dCheck := CTOD( cFYStart )
  318.      IF DTOC( dCheck ) != " "
  319.  
  320.         /* No one starts a Fiscal Year on 2/29 */
  321.         IF MONTH(dCheck) == 2 .and. DAY(dcheck) == 29
  322.            dCheck --
  323.         ENDIF
  324.  
  325.         SET(_SET_DATEFORMAT, "yyyy.mm.dd")
  326.         aDatePar[1] := DTOC(dCheck)
  327.         SET(_SET_DATEFORMAT, cDateFormat)
  328.      ENDIF
  329.   ENDIF
  330.  
  331.   IF VALTYPE( nDow ) == 'N' .AND. nDow > 0 .AND. nDow < 8
  332.      aDatePar[2] := nDow
  333.   ENDIF
  334.  
  335. RETURN ACLONE( aDatePar )
  336.