home *** CD-ROM | disk | FTP | other *** search
/ Programmer 7500 / MAX_PROGRAMMERS.iso / PASCAL / DATETP.ZIP / DATE.BAS next >
Encoding:
BASIC Source File  |  1986-08-08  |  4.3 KB  |  60 lines
  1. 10 '*************************************************;
  2. 20 'Date Conversion Subroutine Function Definition   ;
  3. 30 '   Contributed to the public domain by:          ;
  4. 40 '       John L. O'Boyle, ST1950                   ;
  5. 50 '                and                              ;
  6. 60 '     Mike Todd, SysOp IBMISG, SIG003             ;
  7. 70 '         IBMSIG - The Source                     ;
  8. 80 '            7 August 1986                        ;
  9. 90 '*************************************************;
  10. 100 '
  11. 110 DIM JC(12) : FOR I=1 TO 12 : READ JC(I) : NEXT I 'initialize JC()
  12. 120 DATA 0,31,59,90,120,151,181,212,243,273,304,334
  13. 130 DIM JW$(7) : FOR I=1 TO 7 : READ JW$(I) : NEXT I 'initialize day of week
  14. 140 DATA Monday,Tuesday,Wednesday,Thursday,Friday,Saturday,Sunday
  15. 150 DEF FNJ(M,D,Y)=INT(Y*365.25+D+JC(M)+M*.01-.03)   'define julian function
  16. 160 GOTO 320 'routine to demonstrate the function and conversions
  17. 170 'Date Conversion Routine Entry Point  eg:(M=12:D=15:Y=71)
  18. 180 J=FNJ(M,D,Y)                                      'execute julian function
  19. 190 GOSUB 220                                         'convert to mo/da/yr
  20. 200 RETURN
  21. 210 'month, day, year conversion routine  eg:(J=31630)
  22. 220 JW=J-1-INT((J-1)/7)*7+1                           'day of week
  23. 230 JY=INT(J/365.25)                                  'calculate year
  24. 240 IF INT(JY/4)=JY/4 THEN JL=1 ELSE JL=0             'check for leap
  25. 250 JJ=J-INT(JY*365.25-.25)                           'remaining days
  26. 260 FOR JI=1 TO 12                                    'calculate month
  27. 270 IF JI< 3 THEN IF JC(JI)   <JJ THEN JM=JI          'jan-feb months
  28. 280 IF JI>=3 THEN IF JC(JI)+JL<JJ THEN JM=JI          'mar-dec months
  29. 290 NEXT JI:IF JM<3 THEN JD=JJ-JC(JM) ELSE JD=JJ-JC(JM)-JL 'calculate days
  30. 300 RETURN
  31. 310 'Data input routine just for demonstration.  Forces proper date input.
  32. 320 CLS:Y=0:M=0:D=0:PRINT "Press J to enter julian date or D to enter MM/DD/YYYY format.":PRINT:PRINT "Press Q to quit."
  33. 330 A$=INKEY$:IF A$="" THEN GOTO 330
  34. 340 IF A$<>"J" AND A$<>"j" AND A$<>"D" AND A$<>"d" AND A$<>"Q" AND A$<>"q" THEN BEEP:GOTO 330
  35. 350 IF A$="Q" OR A$="q" THEN CLS:PRINT "Type SYSTEM and <CR> to return to DOS or LIST and <CR> to see the program.":PRINT:BEEP:END
  36. 360 IF A$="D" OR A$="d" GOTO 410
  37. 370 'input julian number to convert to month, day, year
  38. 380 PRINT:INPUT "Enter julian number (between -1058859 and +2958524):  ",J:IF J<-1058859! OR J>2958524! THEN PRINT "Date before 1/1/-999 or after 12/31/9999 cannot be calculated. Please re-enter.":BEEP:GOTO 380
  39. 390 GOSUB 220:GOTO 500
  40. 400 'input year, month, day to convert to julian number
  41. 410 PRINT:INPUT "Enter the four-digit year:     " ,Y:Y=Y-1900:IF Y<-2899 OR Y>8099 THEN PRINT "Year cannot be before -999 or after 9999.  Please re-enter.":BEEP:GOTO 410
  42. 420 PRINT:INPUT "Enter the number of the month: ",M:IF M<1 OR M>12 THEN PRINT "Invalid month.  Please re-enter.":BEEP:GOTO 420
  43. 430 PRINT:INPUT "Enter the number of the day:   ",D:IF D<1 THEN PRINT "Cannot have days in month less than 0.  Please re-enter.":BEEP:GOTO 430
  44. 440 IF M=2 AND INT(Y/4)=Y/4 THEN IF D>29 THEN PRINT "Leap year February greater than 29 days. Please re-enter.":BEEP:GOTO 430
  45. 450 IF M=2 AND INT(Y/4)<>Y/4 THEN IF D>28 THEN PRINT "February greater than 28 days. Please re-enter.":BEEP:GOTO 430
  46. 460 IF M=1 OR M=3 OR M=5 OR M=7 OR M=8 OR M=10 OR M=12 THEN IF D>31 THEN PRINT "Cannot have days in month greater than 31.  Please re-enter.":BEEP:GOTO 430
  47. 470 IF M=4 OR M=6 OR M=9 OR M=11 THEN IF D>30 THEN PRINT "Cannot have days in month greater than 30.  Please re-enter.":BEEP:GOTO 430
  48. 480 GOSUB 180
  49. 490 'print output
  50. 500 PRINT:PRINT "Date Entry   Julian #   Date/Calc    Y-Julian  Day of Week"
  51. 501 PRINT "----------   --------   ---------    --------  -----------"
  52. 505 PRINT:PRINT USING "##/##/####";M;D;Y+1900,          'mo/da/year input
  53. 510 PRINT USING " = ########";J,                        'print julain number
  54. 520 PRINT USING " = ##/##/#### = Day ###";JM;JD;JY+1900;JJ; 'pring mo/da/year
  55. 530 PRINT "   (";JW$(JW);")"                            'print day of week
  56. 540 PRINT:PRINT "press any key to try another date..."  'wait for effect
  57. 550 A$=INKEY$:IF A$<>"" THEN GOTO 550                   'clear keyboard buffer
  58. 560 A$=INKEY$:IF A$="" GOTO 560                         'wait for key pressed
  59. 570 GOTO 320                                            'go demo again
  60.