home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Shareware Overload
/
ShartewareOverload.cdr
/
busi
/
vacsc.zip
/
VAC1.BAS
< prev
next >
Wrap
BASIC Source File
|
1986-02-22
|
3KB
|
83 lines
6000 OPTION BASE 0:DIM CAL$(486):DIM DAY$(485):DIM WK$(70)
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 --"
6005 N=1
6010 I=1:B=0:M=1
6015 A$="1440250361462"
6025 PRINT:INPUT"ENTER LAST 2 DIGITS OF VACATION YEAR (xx)";Y
6030 COLOR 31,0:PRINT "LOADING ARRAYS---WAIT!":COLOR 7,0
6035 IF Y=4*INT(Y/4) THEN A$="0340250361462"
6037 IF N=367 THEN Y=Y+1
6040 Z=VAL(MID$(A$,M,1)):ZZ=VAL(MID$(A$,M+1,1))
6045 A=4*Y+Y+(4*Z)
6050 W=1+INT((A-28*INT(A/28))/4)
6055 M$=STR$(M):I$=STR$(I):Y$="-"+MID$(STR$(Y),2,2)
6060 IF M<10 THEN M$="00"+MID$(M$,2,1)
6065 IF I<10 THEN I$="00"+MID$(I$,2,1)
6070 AA$=M$+"-":CAL$(N)=MID$(AA$,2,3)+MID$(I$,2,2)+Y$
6075 ON ERROR GOTO 6150
6080 IF W=1 THEN DAY$(N)="SU"
6085 IF W=2 THEN DAY$(N)="MO"
6090 IF W=3 THEN DAY$(N)="TU"
6095 IF W=4 THEN DAY$(N)="WE"
6100 IF W=5 THEN DAY$(N)="TH"
6105 IF W=6 THEN DAY$(N)="FR"
6110 IF W=7 THEN DAY$(N)="SA"
6115 I=I+1:W=W+1:IF W=8 THEN W=1
6120 IF ZZ<Z THEN B=7
6125 N=N+1:IF A$="1440250361462" AND N=366 THEN Y=Y+1:I=1:B=0:M=1:GOTO 6035
6130 IF N=367 AND A$="0340250361462" THEN A$="1440250361462":I=1:B=0:M=1: GOTO 6037
6135 IF N=486 THEN 6146
6140 IF I<=28+ZZ-Z+B THEN 6055
6145 I=1:B=0:M=M+1:GOTO 6035
6146 FOR Z=1 TO 485:CAL$(Z)=DAY$(Z)+MID$(CAL$(Z),1,8)
6148 NEXT Z
6149 IF LEFT$(CAL$(1),2)<>"M0" THEN GOSUB 6300
6150 X=1:FOR Z=1 TO 486 STEP 7
6155 WK$(X)=RIGHT$(CAL$(Z),8):X=X+1
6160 IF X=70 THEN 6190
6165 NEXT Z
6190 CLS:LOCATE 4,1:PRINT "ENTER 15 HOLIDAYS IN SEQUENCE ORDER:"
6195 FOR X=1 TO 15:PRINT X;"-";
6200 INPUT "ENTER DATE OF HOLIDAY (mm-dd-yy):";HOL$
6205 FOR Z=1 TO 485
6210 IF MID$(CAL$(Z),3,8)=HOL$ THEN CAL$(Z)=CAL$(Z)+"HL"
6215 IF MID$(CAL$(Z),3,8)=HOL$ THEN 6225
6220 NEXT Z
6225 IF X=15 THEN 6235
6230 NEXT X
6235 OPEN "VACCAL" FOR OUTPUT AS #1
6240 FOR Z=1 TO 485:WRITE #1,CAL$(Z):NEXT Z
6245 FOR Z=1 TO 69:WRITE #1,WK$(Z):NEXT Z
6250 CLOSE #1
6255 GOTO 5140
6300 IF LEFT$(CAL$(1),2)="TU" THEN ZZ=1
6305 IF LEFT$(CAL$(1),2)="WE" THEN ZZ=2
6310 IF LEFT$(CAL$(1),2)="TH" THEN ZZ=3
6315 IF LEFT$(CAL$(1),2)="FR" THEN ZZ=4
6320 IF LEFT$(CAL$(1),2)="SA" THEN ZZ=5
6325 IF LEFT$(CAL$(1),2)="SU" THEN ZZ=6
6330 FOR Z=485 TO ZZ+1 STEP -1
6335 CAL$(Z)=CAL$(Z-ZZ):NEXT Z
6337 XX=VAL(MID$(CAL$(Z+1),9,2))-1
6340 YR$=STR$(XX):YR$=RIGHT$(YR$,2)
6345 CAL$(Z)="XX12-31-"+YR$:GOSUB 6400
6350 Z=Z-1:IF Z=0 THEN RETURN
6355 CAL$(Z)="XX12-30-"+YR$:GOSUB 6400
6360 Z=Z-1:IF Z=0 THEN RETURN
6365 CAL$(Z)="XX12-29-"+YR$:GOSUB 6400
6370 Z=Z-1:IF Z=0 THEN RETURN
6375 CAL$(Z)="XX12-28-"+YR$:GOSUB 6400
6380 Z=Z-1:IF Z=0 THEN RETURN
6382 CAL$(Z)="XX12-27-"+YR$:GOSUB 6400
6384 Z=Z-1:IF Z=0 THEN RETURN
6386 CAL$(Z)="XX12-26-"+YR$:GOSUB 6400
6390 RETURN
6400 IF LEFT$(CAL$(Z+1),2)="TU" THEN CAL$(Z)="MO"+RIGHT$(CAL$(Z),8)
6405 IF LEFT$(CAL$(Z+1),2)="WE" THEN CAL$(Z)="TU"+RIGHT$(CAL$(Z),8)
6410 IF LEFT$(CAL$(Z+1),2)="TH" THEN CAL$(Z)="WE"+RIGHT$(CAL$(Z),8)
6415 IF LEFT$(CAL$(Z+1),2)="FR" THEN CAL$(Z)="TH"+RIGHT$(CAL$(Z),8)
6420 IF LEFT$(CAL$(Z+1),2)="SA" THEN CAL$(Z)="FR"+RIGHT$(CAL$(Z),8)
6425 IF LEFT$(CAL$(Z+1),2)="SU" THEN CAL$(Z)="SA"+RIGHT$(CAL$(Z),8)
6430 RETURN
2)="SA" THEN CAL$(Z)="FR"+RIGHT$(CAL$(Z),8)
6425 IF LEFT$(CAL$(Z+1),2)="SU" THEN CAL$(Z)