home *** CD-ROM | disk | FTP | other *** search
/ Shareware Overload / ShartewareOverload.cdr / busi / vac_sc.zip / VAC1.BAS < prev    next >
BASIC Source File  |  1986-11-24  |  3KB  |  82 lines
  1. 6000 OPTION BASE 0:DIM CAL$(486):DIM DAY$(485):DIM WK$(70)
  2. 6001 PRINT"This Routine Will Program The Calendar For 16 Months and 15 Holidays            Beginning at The First Week of The Vacation Year -- PRESS ANY KEY --"
  3. 6005 N=1
  4. 6010 I=1:B=0:M=1
  5. 6015 A$="1440250361462"
  6. 6025 PRINT:INPUT"ENTER LAST 2 DIGITS  OF VACATION YEAR (xx)";Y
  7. 6030 COLOR 31,0:PRINT "LOADING ARRAYS---WAIT!":COLOR 7,0
  8. 6035 IF Y=4*INT(Y/4) THEN A$="0340250361462"
  9. 6037 IF N=367 THEN Y=Y+1
  10. 6040 Z=VAL(MID$(A$,M,1)):ZZ=VAL(MID$(A$,M+1,1))
  11. 6045 A=4*Y+Y+(4*Z)
  12. 6050 W=1+INT((A-28*INT(A/28))/4)
  13. 6055 M$=STR$(M):I$=STR$(I):Y$="-"+MID$(STR$(Y),2,2)
  14. 6060 IF M<10 THEN M$="00"+MID$(M$,2,1)
  15. 6065 IF I<10 THEN I$="00"+MID$(I$,2,1)
  16. 6070 AA$=M$+"-":CAL$(N)=MID$(AA$,2,3)+MID$(I$,2,2)+Y$
  17. 6075 ON ERROR GOTO 6150
  18. 6080 IF W=1 THEN DAY$(N)="SU"
  19. 6085 IF W=2 THEN DAY$(N)="MO"
  20. 6090 IF W=3 THEN DAY$(N)="TU"
  21. 6095 IF W=4 THEN DAY$(N)="WE"
  22. 6100 IF W=5 THEN DAY$(N)="TH"
  23. 6105 IF W=6 THEN DAY$(N)="FR"
  24. 6110 IF W=7 THEN DAY$(N)="SA"
  25. 6115 I=I+1:W=W+1:IF W=8 THEN W=1
  26. 6120 IF ZZ<Z THEN B=7
  27. 6125 N=N+1:IF A$="1440250361462" AND N=366 THEN Y=Y+1:I=1:B=0:M=1:GOTO 6035
  28. 6130 IF N=367 AND A$="0340250361462" THEN A$="1440250361462":I=1:B=0:M=1:            GOTO 6037
  29. 6135 IF N=486 THEN 6146
  30. 6140 IF I<=28+ZZ-Z+B THEN 6055
  31. 6145 I=1:B=0:M=M+1:GOTO 6035
  32. 6146 FOR Z=1 TO 485:CAL$(Z)=DAY$(Z)+MID$(CAL$(Z),1,8)
  33. 6148 NEXT Z
  34. 6149 IF LEFT$(CAL$(1),2)<>"M0" THEN GOSUB 6300
  35. 6150 X=1:FOR Z=1 TO 486 STEP 7
  36. 6155 WK$(X)=RIGHT$(CAL$(Z),8):X=X+1
  37. 6160 IF X=70 THEN 6190
  38. 6165 NEXT Z
  39. 6190 CLS:LOCATE 4,1:PRINT "ENTER 15 HOLIDAYS IN SEQUENCE ORDER:"
  40. 6195 FOR X=1 TO 15:PRINT X;"-";
  41. 6200 INPUT "ENTER DATE OF HOLIDAY (mm-dd-yy):";HOL$
  42. 6205 FOR Z=1 TO 485
  43. 6210 IF MID$(CAL$(Z),3,8)=HOL$ THEN CAL$(Z)=CAL$(Z)+"HL"
  44. 6215 IF MID$(CAL$(Z),3,8)=HOL$ THEN 6225
  45. 6220 NEXT Z
  46. 6225 IF X=15 THEN 6235
  47. 6230 NEXT X
  48. 6235 OPEN "VACCAL" FOR OUTPUT AS #1
  49. 6240 FOR Z=1 TO 485:WRITE #1,CAL$(Z):NEXT Z
  50. 6245 FOR Z=1 TO 69:WRITE #1,WK$(Z):NEXT Z
  51. 6250 CLOSE #1
  52. 6255 GOTO 5140
  53. 6300 IF LEFT$(CAL$(1),2)="TU" THEN ZZ=1
  54. 6305 IF LEFT$(CAL$(1),2)="WE" THEN ZZ=2
  55. 6310 IF LEFT$(CAL$(1),2)="TH" THEN ZZ=3
  56. 6315 IF LEFT$(CAL$(1),2)="FR" THEN ZZ=4
  57. 6320 IF LEFT$(CAL$(1),2)="SA" THEN ZZ=5
  58. 6325 IF LEFT$(CAL$(1),2)="SU" THEN ZZ=6
  59. 6330 FOR Z=485 TO ZZ+1 STEP -1
  60. 6335 CAL$(Z)=CAL$(Z-ZZ):NEXT Z
  61. 6337 XX=VAL(MID$(CAL$(Z+1),9,2))-1
  62. 6340 YR$=STR$(XX):YR$=RIGHT$(YR$,2)
  63. 6345 CAL$(Z)="XX12-31-"+YR$:GOSUB 6400
  64. 6350 Z=Z-1:IF Z=0 THEN RETURN
  65. 6355 CAL$(Z)="XX12-30-"+YR$:GOSUB 6400
  66. 6360 Z=Z-1:IF Z=0 THEN RETURN
  67. 6365 CAL$(Z)="XX12-29-"+YR$:GOSUB 6400
  68. 6370 Z=Z-1:IF Z=0 THEN RETURN
  69. 6375 CAL$(Z)="XX12-28-"+YR$:GOSUB 6400
  70. 6380 Z=Z-1:IF Z=0 THEN RETURN
  71. 6382 CAL$(Z)="XX12-27-"+YR$:GOSUB 6400
  72. 6384 Z=Z-1:IF Z=0 THEN RETURN
  73. 6386 CAL$(Z)="XX12-26-"+YR$:GOSUB 6400
  74. 6390 RETURN
  75. 6400 IF LEFT$(CAL$(Z+1),2)="TU" THEN CAL$(Z)="MO"+RIGHT$(CAL$(Z),8)
  76. 6405 IF LEFT$(CAL$(Z+1),2)="WE" THEN CAL$(Z)="TU"+RIGHT$(CAL$(Z),8)
  77. 6410 IF LEFT$(CAL$(Z+1),2)="TH" THEN CAL$(Z)="WE"+RIGHT$(CAL$(Z),8)
  78. 6415 IF LEFT$(CAL$(Z+1),2)="FR" THEN CAL$(Z)="TH"+RIGHT$(CAL$(Z),8)
  79. 6420 IF LEFT$(CAL$(Z+1),2)="SA" THEN CAL$(Z)="FR"+RIGHT$(CAL$(Z),8)
  80. 6425 IF LEFT$(CAL$(Z+1),2)="SU" THEN CAL$(Z)="SA"+RIGHT$(CAL$(Z),8)
  81. 6430 RETURN
  82.