home *** CD-ROM | disk | FTP | other *** search
/ Shareware Overload / ShartewareOverload.cdr / database / trl14db.zip / TRLPRG.EXE / WEEKDAYS.PRG < prev    next >
Text File  |  1990-10-22  |  2KB  |  65 lines

  1. ***********
  2. * WEEKDAYS.PRG
  3. * by Leonard Zerman and Tom Rettig
  4. * Placed in the Public Domain by Tom Rettig Associates, 10/22/1990.
  5. *
  6. * SYNTAX: DO WEEKDAYS WITH <date>, <days> 
  7. * RETURN: <expD> of <date> plus or minus <days> not counting weekends
  8. ***********
  9. PARAMETERS date1, number1
  10. PRIVATE tr_startdt, tr_nbr_days, tr_weeks, tr_cntr
  11. tr_startdt  = date1
  12. tr_nbr_days = number1
  13. IF tr_nbr_days = 0
  14.    tr_retd = tr_startdt
  15.    IF (fox)
  16.       RETURN (tr_retd)
  17.    ELSE
  18.       RETURN
  19.    ENDIF
  20. ENDIF
  21. IF DOW( tr_startdt ) = 1
  22.    IF tr_nbr_days > 0
  23.       tr_startdt  = tr_startdt + 1
  24.       tr_nbr_days = tr_nbr_days - 1
  25.    ELSE
  26.       tr_startdt  = tr_startdt - 2
  27.       tr_nbr_days = tr_nbr_days + 1
  28.    ENDIF
  29. ENDIF
  30. IF DOW( tr_startdt ) = 7
  31.    IF tr_nbr_days > 0
  32.       tr_startdt  = tr_startdt + 2
  33.       tr_nbr_days = tr_nbr_days - 1
  34.    ELSE
  35.       tr_startdt  = tr_startdt - 1
  36.       tr_nbr_days = tr_nbr_days + 1
  37.    ENDIF
  38. ENDIF
  39. IF tr_nbr_days = 0
  40.    tr_retd = tr_startdt
  41.    IF (fox)
  42.       RETURN (tr_retd)
  43.    ELSE
  44.       RETURN
  45.    ENDIF
  46. ENDIF
  47. tr_weeks   = INT( tr_nbr_days / 5 )
  48. tr_startdt = tr_startdt +  ( tr_weeks * 7 )  
  49. tr_cntr = ABS( tr_nbr_days ) - ABS( tr_weeks * 5 ) 
  50. DO WHILE tr_cntr > 0
  51.    IF tr_nbr_days > 0
  52.       tr_startdt = tr_startdt + 1
  53.    ELSE
  54.       tr_startdt = tr_startdt - 1
  55.    ENDIF
  56.    IF .NOT. ( DOW( tr_startdt ) = 1 .OR. DOW( tr_startdt ) = 7 )
  57.       tr_cntr = tr_cntr - 1 
  58.    ENDIF
  59. ENDDO
  60. tr_retd = tr_startdt
  61. IF fox
  62.    RETURN (tr_retd)
  63. ENDIF
  64. * eof weekdays *
  65.