home *** CD-ROM | disk | FTP | other *** search
/ Power-Programmierung / CD1.mdf / xbase / library / clipper / datetime / addmon / jbaddmon.prg < prev   
Encoding:
Text File  |  1988-01-22  |  3.6 KB  |  89 lines
  1. ********************************************************************************
  2. * JBADDMON.PRG Copyright (C) 1986,1987,1988. Released to Public Domain thru
  3. *       THE BOSS BBS CLIPPER CONFERENCE - 201-568-7293, 1/22/88
  4. *       I rights are released except for those of authorship. No warranties:
  5. *       expressed, written, or implied.
  6. *
  7. * Author : John A. Bristor  (904) 474-8846
  8. *
  9. * Program Purpose :  Subtract or Add a number of months to a date
  10. *
  11. * PARAMETERS
  12. *           JBDATE  -  date passed in CHARCATER form - mm/dd/yy or mm/dd/ccyy
  13. *                      Length is 8 charcaters if 'SET CENTURY OFF'
  14. *                      Length is 10 characters if 'SET CENTURY ON'
  15. *
  16. *           JBDIFF  -  + or - the number of months to move date; CHARACTER
  17. *
  18. *           JBDOS   -  Whether Program is being called by DOS (Y or N)
  19. *
  20. *           The reason a pass JBDIFF as a charcter field is so this routine
  21. *           can have parameters passed to it directly from DOS.
  22. *
  23. * USAGE     From DOS -  JBADDMON 01/01/87 15 Y
  24. *                       JBADDMON 11/23/2003 -49 Y
  25. *
  26. *           From CLIPPER - DO JBADDMON WITH "01/01/87","15","N"
  27. *                          DO JBADDMON WITH DTOC(DATE()),"-37","N"
  28. *
  29. ********************************************************************************
  30. PARAMETERS JBDATE,JBDIFF,JBDOS
  31. STORE VAL(JBDIFF) TO JBDIFF
  32. STORE SUBSTR(JBDATE,4,2) TO JBCURR       && Initialize Current Day Parameter
  33. STORE SUBSTR(JBDATE,1,2) TO JBM          && Initialize Current Month Parameter
  34. IF LEN(JBDATE) = 8                       && If length is only eight then 'SET
  35.      STORE "19" TO JBCEN                 && CENTURY' is OFF. Initialize Century
  36.      STORE SUBSTR(JBDATE,7,2) TO JBCYR   && Initialize Current Year Variable
  37.      STORE 0 TO JBLONG                   && Set Century flag
  38. ELSE
  39.      STORE SUBSTR(JBDATE,7,2) TO JBCEN   && 'SET CENTURY' must be ON
  40.      STORE SUBSTR(JBDATE,9,2) TO JBCYR   && Same as above.
  41.      STORE 99 TO JBLONG
  42. ENDIF
  43. SET CENTURY ON                           && Force 'CENTURY' to ON
  44. STORE INT(JBDIFF/12) TO JBYRDIFF         && How Many Years to  move
  45. STORE JBDIFF%12 TO JBMOD                 && How many months are leftover to move
  46. DO CASE
  47.      CASE VAL(JBCYR) + JBYRDIFF < 0 .AND. JBDIFF < 0
  48.           STORE STR(VAL(JBCEN)-1,2) TO JBCEN
  49.           STORE STR(100+VAL(JBCYR)+JBYRDIFF,2) TO JBCYR
  50.      CASE VAL(JBCYR) + JBYRDIFF > 99 .AND. JBDIFF > 0
  51.           STORE STR(VAL(JBCEN)+1,2) TO JBCEN
  52.           STORE STR((VAL(JBCYR)+JBYRDIFF) - 100,2) TO JBCYR
  53.      OTHERWISE
  54.           STORE STR((VAL(JBCYR)+JBYRDIFF),2) TO JBCYR
  55. ENDCASE
  56. STORE VAL(JBM)+JBMOD TO JBADD
  57. DO CASE
  58.      CASE JBADD <= 0
  59.           IF val(JBCYR) = 0
  60.                 STORE "99" TO JBCYR
  61.                 STORE STR(VAL(JBCEN) - 1,2) TO JBCEN
  62.           ELSE
  63.                 STORE STR(VAL(JBCYR) - 1,2) TO JBCYR
  64.           ENDIF
  65.           STORE IF(JBADD=0,"12",STR(12+JBADD,2)) TO JBM
  66.      CASE JBADD > 12
  67.           IF val(JBCYR) = 99
  68.                 STORE "00" TO JBCYR
  69.                 STORE STR(VAL(JBCEN) + 1,2) TO JBCEN
  70.           ELSE
  71.                 STORE STR(VAL(JBCYR) + 1,2) TO JBCYR
  72.           ENDIF
  73.           STORE STR(JBADD-12,2) TO JBM
  74.      OTHERWISE
  75.           STORE STR(JBADD,2) TO JBM
  76. ENDCASE
  77. STORE IF(VAL(JBM) < 10,"0"+STR(VAL(JBM),1),JBM) TO JBM
  78. STORE IF(VAL(JBCYR) < 10,"0"+STR(VAL(JBCYR),1),JBCYR) TO JBCYR
  79. IF JBLONG <> 99                          && Check flags to set Environment
  80.      SET CENTURY OFF                     &&    back to the way it was.
  81.      STORE JBM+'/'+JBCURR+'/'+JBCYR TO JBDATE
  82. ELSE
  83.      STORE JBM+'/'+JBCURR+'/'+ JBCEN +JBCYR TO JBDATE
  84. ENDIF
  85. IF UPPER(JBDOS)$'Y'
  86.      ? JBDATE
  87. ENDIF
  88. RETURN
  89.