1 'Club 100 Library - 415/939-1246 BBS 937-5039 NEWSLETTER, 932-8856 VOICE 2 'DATE CONVERSION AND MANAGER PROGRAM 3 ' 5 CLEAR 1000 10 KEYOFF:FORX=1TO8:KEYX,CHR$(X+247):NEXTX 20 DIMMN$(12),DY$(6),HL$(20,5),EA(19):FORX=1TO12:READMN$(X):NEXTX:FORX=0TO6:READDY$(X):NEXTX:FORX=1TO18:FORY=1TO5:READ HL$(X,Y):NEXTY,X:FORX=1TO19:READ EA(X):NEXTX 99 GOTO 1000 100 CLS:PRINT@0,CHR$(27);"p TRS-80 MODEL 100 DATES ";CHR$(27);"q"; 110 PRINT@53,"1. Conversions";:PRINT@93,"2. Holidays";:PRINT@133,"3. Weekdays";:PRINT@173,"8. Menu";:PRINT@280," Press Function Keys "; 120 LINE(0,0)-(0,63):LINE(0,63)-(239,63):LINE(239,63)-(239,0):LINE(0,55)-(239,55):RETURN 200 FORZ9=1TO5:PRINT@(Z9*40)+1," ";:NEXTZ9:RETURN 210 FORZ9=1TO2:PRINT@(Z9*40)+201," ";:NEXTZ9:RETURN 250 K=K+INT((40-LEN(K$))/2):PRINT@K,K$;:RETURN 260 PRINT@280," Press ENTER to return ";:GOSUB120 270 K$=INKEY$:IFK$=""THEN270 280 IFK$=CHR$(13)THENRETURNELSE270 310 BEEP:PRINT@280," Ready Lineprinter, Then press 'ENTER' ";:R$=INPUT$(1):IFR$=CHR$(27)ORR$=CHR$(13)THENRETURNELSE310 350 CLS:PRINT@0," Date Time Dur. Description ";:LINE(0,7)-(239,7) 360 PRINT@280,"Add Edit Rem Prnt Calendar";:GOSUB120:RETURN 500 DATA January,February,March,April,May,June,July,August,September,October,November,December 510 DATA Sunday,Monday,Tuesday,Wednesday,Thursday,Friday,Saturday 520 DATA President,1,2.212,Presidents' Day,1,Mother's,1,5.14,Mother's Day,0,Memorial,1,5.312,Memorial Day,1,Father's,1,6.213,Father's Day,0 525 DATA Labor,1,9.073,Labor Day,1,Columbus,1,10.145,Columbus Day,1,Election,1,11.081,Election Day,2,Thanksgv,1,11.285,Thanksgiving Day,4 530 DATA Ash Wed,0,-46,Ash Wednesday,3,1st Sun,0,-42,First Sunday in Lent,0,Passion,0,-14,Passion Sunday,0,Palm Sun,0,-7,Palm Sunday,0,Good Fri,0,-2,Good Friday,5 535 DATA Easter,0,0,Easter Sunday,0,Ascensn,0,39,Ascension Day,4,Pentecst,0,49,Pentecost,0,Trinity,0,56,Trinity Sunday,0,List All,0,0,0,0 540 DATA 5.14,5.03,4.23,5.11,4.31,5.18,5.08,4.28,5.16,5.05,4.25,5.13,5.02,4.22,5.10,4.30,5.17,5.07,4.27 1000 GOSUB100 1010 K$=INKEY$:IFK$=""THEN1010 1020 K=ASC(K$):IFK>247THENONK-247GOSUB15000,12000,13000,1050,1050,1050,1050,1100 1030 IFK8=2THENMENU 1040 IFK8=1THENK8=0:GOTO1000 1050 GOTO 1010 1100 CALL 23164,0,23366:CALL 27795:K8=2:RETURN 1200 CLS:PRINT@0,CHR$(27);"p Holidays ";CHR$(27);"q";:GOSUB1210:GOSUB1220:RETURN 1210 S1=0:FORS2=1TO18STEP4:S1=S1+1:S3=0:FORS4=S2TOS2+3:PRINT@(S1*40)+1+(S3*10),HL$(S4,1);:S3=S3+1:NEXTS4,S2:RETURN 1220 PRINT@280,"This Year Any Year Find Date Menu";:GOSUB120:LINE(57,55)-(57,63):LINE(117,55)-(117,63):LINE(177,55)-(177,63):RETURN 1300 CLS:PRINT@0,CHR$(27);"p Weekdays ";CHR$(27);"q";:PRINT:PRINT@82,"1. Days between 5. Year given Day";:PRINT@122,"2. Wkdays between 6. Date given Day" 1310 PRINT@162,"3. # of times 8. Date Menu";:PRINT@202,"4. Nth Occurrence";:PRINT@280," Press function keys ";:GOSUB120:RETURN 1500 CLS:PRINT@0,CHR$(27);"p Conversions ";CHR$(27);"q";:PRINT@280,"Gregorian Julian Day of Yr Date Menu";:GOSUB120:LINE(58,55)-(58,63):LINE(115,55)-(115,63):LINE(178,55)-(178,63):RETURN 12000 N1=0:GOSUB1200:P1=1:P2=1:N=1:P3=(P1*40)+1+((P2-1)*10) 12005 PRINT@P3,CHR$(27);"p";HL$(N,1);CHR$(27);"q";:IFK8=1THENRETURN 12010 K$=INKEY$:IFK$=""THEN12010 12020 K=ASC(K$):IFK=255ORK=254THENK8=1:RETURN 12022 IFK>247THENONK-247GOTO12300,12300,12400,12400,12500,12500 12028 IFK=29ORK=28ORK=30ORK=31ORK=1ORK=6ORK=20ORK=2ORK=23ORK=26THEN12030ELSE12010 12030 PRINT@P3,HL$(N,1);:IFK=29THENP2=P2-1:N=N-1 12040 IFK=28THENP2=P2+1:N=N+1 12050 IFK=30THENP1=P1-1:N=N-4 12060 IFK=31THENP1=P1+1:N=N+4 12070 IFK=1THENN=N-(P2-1):P2=1 12080 IFK=6THENN=N+(4-P2):P2=4 12090 IFK=20THENN=N-((P1-1)*4):P1=1 12100 IFK=2 THENN=N+((5-P1)*4):P1=5 12110 IFK=23THENP1=1:P2=1:N=1 12120 IFK=26THENP1=5:P2=2:N=18 12130 IFP1<1THENP1=1:N=N+4 12140 IFP2<1THENP2=1:N=N+1 12150 IF(P1>4ANDP2>2)ORP1>5THENP1=P1-1:N=N-4 12160 IFP2>4THENP2=4:N=N-1 12170 P3=(P1*40)+1+((P2-1)*10):PRINT@P3,CHR$(27);"p";HL$(N,1);CHR$(27);"q";:GOTO12010 12300 N2=0:Y=VAL(RIGHT$(DATE$,2)):IFY>80THENY=Y+1900ELSEY=Y+2000 12310 IFN=18THENN1=18:N=1 12312 F=0:A=VAL(HL$(N,2)):E=VAL(HL$(N,3)):IFE<3THENF=-1 12315 ON A+1 GOSUB 12600,12700:IFN2=1THENGOTO12520ELSEGOSUB12800:GOSUB12900 12320 IFN1=18THENN=N+1:IFN<18ANDK$=CHR$(13)THEN12312 12330 IFN1=18THENN=18 12380 GOSUB200:GOSUB1220:GOSUB1210:GOTO12005 12400 N2=0:PRINT@280," ";:PRINT@290,"Which ";:Q1=296:GOSUB24000:IFN=18THENN1=18:N=1 12410 GOTO12310 12500 N2=1:GOSUB200:K=80:K$="Find "+HL$(N,4)+" ("+HL$(N,1)+")":GOSUB250:Q1=177:PRINT@171,"Date : ":GOSUB20000:M1=M:D1=D:Y1=Y:GOTO12312 12520 Y$=STR$(Y):Y$=RIGHT$(Y$,LEN(Y$)-1):PRINT@184,Y$;:IF(Y-Y1)>200THEN12590 12530 IFD<>D1ORC<>M1THENY=Y+1:GOTO12312 12580 GOSUB12800:GOSUB12900:GOTO12380 12590 GOSUB200:K=80:K$=HL$(N,4)+" does not fall on":GOSUB250:BEEP:D=D1:M=M1:Y=Y1:GOSUB27000:K=160:K$=LEFT$(S1$,5):GOSUB250:GOSUB12900:GOTO12380 12600 A=EA(Y-19*INT(Y/19)+1):C=INT(A):D=INT(100*(A-C)) 12610 A=INT(365.25*Y)+INT(30.6001*C)+D+1720983:F=A-7*INT(A/7) 12620 A=A+6-F:A=A+E:F=A+68569:E=INT(4*F/146097):F=-INT((146097*E+3)/4)+F 12630 Y=INT(4000*(F+1)/1461001):F=-INT(1461*Y/4)+31+F:C=INT(80*F/2447) 12640 D=-INT(2447*C/80)+F:F=INT(C/11):C=-12*F+2+C:Y=100*(E-49)+Y+F:RETURN 12700 C=INT(E):E=100*(E-C):D=INT(E):E=INT(10*(E-D)):F=F+Y 12710 E=E+INT(1.25*F)-INT(.75*(1+INT(F/100))):D=D-E+7*INT(E/7):RETURN 12800 GOSUB200:BEEP:K=80:K$=HL$(N,4)+" ("+HL$(N,1)+")":GOSUB250:K=120:Z=D:GOSUB27100:K$=DY$(VAL(HL$(N,5)))+", "+MN$(C)+" "+R$+","+STR$(Y):GOSUB250:RETURN 12900 K=200:K$="Press ENTER to return.":GOSUB250 12910 K$=INKEY$:IFK$=""THEN12910 12920 IFK$=CHR$(13)ORK$=CHR$(27)THENRETURN 12925 IFK$=CHR$(254)ORK$=CHR$(255)THENK8=1:RETURN 12930 GOTO12910 13000 GOSUB1300 13010 K$=INKEY$:IFK$=""THEN13010 13020 K=ASC(K$):IFK=255ORK=254THENK8=1:RETURN 13030 IFK>247THENONK-247GOSUB13100,13200,13300,13400,13500,13600 13040 GOTO13010 13100 GOSUB200:GOSUB210:K=40:K$="# of Days between two dates":GOSUB250:Q1=139:PRINT@127,"Start Date : "; 13110 GOSUB20000:M1=M:D1=D:Y1=Y:GOSUB25000:W=I:PRINT@167,"End Date : ";:Q1=179:GOSUB20000:M1=M:D1=D:Y1=Y:GOSUB25000:W=I-W:K=200:K$=STR$(W)+" days":GOSUB250:BEEP:GOSUB260 13120 GOSUB1300:RETURN 13200 GOSUB200:GOSUB210:K=40:K$="# of Weekdays between two dates":GOSUB250:B=2:C$="Weekdays":GOSUB13250:GOSUB1300:RETURN 13250 Q1=141:PRINT@129,"Start Date : ";:GOSUB20000:M1=M:I=D-2:Y1=Y:GOSUB13270:ONBGOSUB13290,13295 13260 A=N:Q1=181:PRINT@169,"End Date : ";:GOSUB20000:M1=M:I=D:Y1=Y:GOSUB13270:ONBGOSUB13290,13295:N=N-A:K=200: 13262 IFB<>1THENK$=STR$(N-1)+" "+C$ELSEK$=STR$(N)+" "+C$ 13264 GOSUB250:GOSUB260:RETURN 13270 IFM1<3THENM1=M1+12:Y1=Y1-1 13275 M1=M1+1:I=I-INT(.75*(INT(.01*Y1)-7))+INT(365.25*Y)+INT(30.6*M1):RETURN 13290 I=I-W:N=INT(I/7)+INT(.055*(I-7*INT(I/7))+1.4):RETURN 13295 N=5*INT(I/7)+INT(.9005*(I-7*INT(I/7))+.5):RETURN 13300 GOSUB200:GOSUB210:K=40:K$="# of times Given day occurs":GOSUB250:B=1:C$="times":Q1=89:GOSUB24500:GOSUB13250:GOSUB1300:RETURN 13400 GOSUB200:GOSUB210:K=40:K$="Nth Occurence of Day in month":GOSUB250:Q1=91:GOSUB24500:Q1=133:GOSUB22000: 13410 K=160:K$="Which "+DY$(W)+" in "+MN$(M)+","+STR$(Y)+" : ":GOSUB250:LINEINPUTN$:N=VAL(N$):IFN<1ORN>5THEN13410 13420 A=M:B=Y:IFA<3THENA=A+12:B=B-1 13430 A=A+1:H=W-INT(2.6*A)-INT(1.25*B)+INT(.75*INT(.01*B-7)) 13440 H=H-7*INT(H/7):H=H+(H=0)*-7:D=H+7*N-7: 13445 IFD<29THEN13490 13450 IF(M=4ORM=9ORM=6ORM=11)ANDD<31THEN13490 13455 IF(M=1ORM=3ORM=5ORM=7ORM=8ORM=10ORM=12)ANDD<32THEN13490 13460 IFM<>2THEN13480ELSEIFD>29THEN13480 13465 Y$=STR$(Y):M1=VAL(RIGHT$(Y$,2)):IFM1=0THENM3=Y/400-INT(Y/400):IFM3=0THEN13480 13470 M3=M1/4-INT(M1/4):IFM3=0THEN13490 13480 K=200:BEEP:BEEP:K$="There aren't"+STR$(N)+" "+DY$(W)+"s in "+MN$(M):GOSUB250:GOTO13495 13490 Z=D:GOSUB27100:K=200:K$="It's on the "+R$:GOSUB250 13495 GOSUB260:GOSUB1300:RETURN 13500 GOSUB200:GOSUB210:K=40:K$="Given Date occurs on given day":GOSUB250:Q1=91:GOSUB24500:Q1=139:PRINT@127,"Start date :";:GOSUB20000:A=M:F=0:F1=1:GOSUB13510:GOSUB260:GOSUB1300:RETURN 13510 IF3>MTHENF=1:M=M+12 13520 Z=INT((M+11)*2.6)+D:Z=(Z-W-INT((Z-W)/7)*7)/2:X=INT(Z):IFX<>ZTHENX=X+4 13530 X=INT((Y-1-(4*X))/28)*28+(4*X)+F:F=1:GOSUB200:Z=D:GOSUB27100:K=40:K$=DY$(W)+" will be on "+MN$(A)+" "+R$+" in":GOSUB250: 13540 GOSUB13570:X=X+6:IFF=>13THENRETURN 13542 GOSUB13570:X=X+11:IFF=>13THENRETURN 13544 GOSUB13570:X=X+6:IFF>=13THENRETURN 13546 GOSUB13570:X=X+5:IFF<12THEN13540 13550 RETURN 13570 IF X>=Y THEN IF(A*D<>58)OR(X/4=INT(X/4))THENGOSUB13580:F=F+1 13572 RETURN 13580 IFF<4THENF1=(F*40)+86 13582 IFF>3ANDF<7THENF1=((F-3)*40)+93 13584 IFF>6ANDF<10THENF1=((F-6)*40)+100 13586 IFF>9THENF1=((F-9)*40)+107 13590 BEEP:PRINT@F1,STR$(X);:RETURN 13600 GOSUB200:K=40:K$="Dates of given day of the week":GOSUB250:Q1=89:GOSUB24500:Q1=138:PRINT@128,"Start Date : ";:GOSUB20000:GOSUB200:K=40:K$=DY$(W)+" falls on ":GOSUB250:GOSUB13602:GOSUB260:GOSUB1300:RETURN 13602 IFM<3THENM=M+12:Y=Y-1 13604 M=M+1:J=INT(365.25*Y)+INT(30.6001*M)+D+1720982 13610 Z=J+1-7*INT((J+1)/7):IFZ>WTHENW=W+7 13620 J=J+W-Z:A=0 13630 R=J+68569:P=INT(4*R/146097):R=-INT(((146097*P)+3)/4)+R:Y=INT(4000*(R+1)/1461001) 13640 R=-INT((1461*Y)/4)+31+R:M=INT(80*R/2447):S=-INT(2447*M/80)+R:R=INT(M/11):M=(-12*R)+2+M 13650 Y=100*(P-49)+Y+R 13660 A=A+1:D=S:GOSUB27000 13662 IFA<4THENA1=(A*40)+82 13664 IFA>3ANDA<7THENA1=((A-3)*40)+95 13666 IFA>6THENA1=((A-6)*40)+107 13668 PRINT@A1,S1$;:BEEP:J=J+7:IFA<9THEN13630ELSERETURN 15000 GOSUB1500 15010 K$=INKEY$:IFK$=""THEN15010 15020 K=ASC(K$):IFK=255ORK=254THENGOTO15070 15030 IFK=248ORK=249THENGOTO15100 15040 IFK=250ORK=251THENGOTO15200 15050 IFK=252ORK=253THENGOTO15300 15060 GOTO 15010 15070 K8=1:RETURN 15100 GOSUB200:Q1=137:PRINT@131,"Date :";:GOSUB20000:M1=M:D1=D:Y1=Y:GOSUB25000:J=I:GOTO15400 15200 GOSUB200:PRINT@131,"Date :";:LINEINPUTJ$:J=VAL(J$):GOSUB26000:GOTO15400 15300 GOSUB200::Q1=131:GOSUB21000:J=INT(365.25*Y)+D+1721045:GOSUB26000 15400 M1=12:D1=31:Y1=Y-1:GOSUB25000:Z=J-I:M1=12:D1=31:Y1=Y:GOSUB25000:W=I-J:D2=J+1-7*INT((J+1)/7) 15500 GOSUB200:GOSUB27000:K=80:K$=DY$(D2)+", "+S1$:GOSUB250:GOSUB27200:K=120:K$=J$+" Julian Days":GOSUB250:GOSUB27100:K=159:K$=R$+" day of the year":GOSUB250:K=200:K$=STR$(W)+" remain in the year":GOSUB250:GOTO15010 20000 PRINT@Q1," MM/DD/YYYY";:BEEP:PRINT@Q1," ";:LINEINPUTY$ 20010 IFLEN(Y$)<>10THEN20000 20020 IFMID$(Y$,3,1)<>"/"ORMID$(Y$,6,1)<>"/"THEN20000 20030 M=VAL(LEFT$(Y$,2)):D=VAL(MID$(Y$,4,2)):Y=VAL(RIGHT$(Y$,4)) 20040 IFM<1ORM>12ORD<1THEN20000 20050 IFM=2ANDD>29THEN20000 20060 IF(M=4ORM=6ORM=9ORM=11)ANDD>30THEN20000 20070 IFD>31THEN20000 20080 IFM=2ANDD=29THEN20100ELSERETURN 20100 M1=VAL(RIGHT$(Y$,2)):IFM1=0THENM3=Y/400-INT(Y/400):IFM3<>0THEN20000 20110 M3=M1/4-INT(M1/4):IFM3=0THENRETURNELSE20000 21000 PRINT@Q1,"Date : DDD/YYYY";:BEEP:Q1=Q1+6 21005 PRINT@Q1," ";:LINEINPUTY$ 21010 IFLEN(Y$)<>8THEN21005 21020 IFMID$(Y$,4,1)<>"/"THEN21005 21030 D=VAL(LEFT$(Y$,3)):Y=VAL(RIGHT$(Y$,4)) 21040 IFD<1ORY<1ORD>366THEN21005 21050 IFD<>366THENRETURN 21060 M1=VAL(RIGHT$(Y$,2)):IFM1=0THENM3=Y/400-INT(Y/400):IFM3=0THEN21005 21070 M3=M1/4-INT(M1/4):IFM3=0THENRETURNELSE21005 22000 BEEP:PRINT@Q1,"Date : MM/YYYY";:PRINT@Q1+6," ";:LINEINPUTY$:IFLEN(Y$)<>7THEN22000 22200 M=VAL(LEFT$(Y$,2)):Y=VAL(RIGHT$(Y$,4)):IFM<1ORM>12ORY<1THEN22000ELSERETURN 24000 PRINT@Q1,"Year : YYYY";:BEEP:PRINT@302," ";:Y$=" ":Y1$="":Y1=1 24010 Y1$=INKEY$:IFY1$=""THEN24010 24020 IF(Y1$=CHR$(8)ORY1$=CHR$(29))ANDY1<>1THENY$=LEFT$(Y$,LEN(Y$)-1):Y1=Y1-1:GOTO24060 24050 IFINSTR("0123456789"+CHR$(13),Y1$)=0THEN24010 24056 IFY1$=CHR$(13)THENPRINT@302,Y$;" ";:GOTO24070 24058 Y$=Y$+Y1$:Y1=Y1+1 24060 PRINT@302,Y$;:IFY1<5THEN24010ELSEY=VAL(Y$) 24070 Y=VAL(Y$):RETURN 24500 BEEP:PRINT@Q1,"Which Day (1-7) :";:LINEINPUTW$:W=VAL(W$):W=W-1:IFW<0ORW>6THEN24500ELSERETURN 25000 REM gregorian to julian M,D,Y to I 25010 IF M1<3 THEN M1=M1+12:Y1=Y1-1 25020 M1=M1+1:I=INT(365.25*Y1)+INT(30.6001*M1)+D1+1720982:RETURN 26000 REM julian to gregorian conversion 26010 U=J+68569:V=INT(4*U/146097):U=-INT((146097*V+3)/4)+U:Y=INT(4000*(U+1)/1461001):U=-INT(1461*Y/4)+31+U:M=INT(80*U/2447):D=-INT(2447*M/80)+U:U=INT(M/11):M=-12*U+2+M:Y=100*(V-49)+Y+U:RETURN 27000 M$=STR$(M):M$=RIGHT$(M$,LEN(M$)-1):IFM<10THENM$="0"+M$ 27010 D$=STR$(D):D$=RIGHT$(D$,LEN(D$)-1):IFD<10THEND$="0"+D$ 27020 Y$=STR$(Y):Y$=RIGHT$(Y$,LEN(Y$)-1):IFY<0THENY$=Y$+"BC" 27030 S1$=M$+"/"+D$+"/"+Y$:RETURN 27100 Z$=STR$(Z):G$=RIGHT$(Z$,1):IF INSTR("0456789",G$)>0 THEN R$=Z$+"th":RETURN 27102 G1=0:IF Z>9 AND MID$(Z$,LEN(Z$)-1,1)="1" THEN G1=1 27110 IFG$="1"ANDG1=0THENR$=Z$+"st":RETURN 27120 IFG$="2"ANDG1=0THENR$=Z$+"nd":RETURN 27130 IFG$="3"ANDG1=0THENR$=Z$+"rd":RETURN 27140 R$=Z$+"th":RETURN 27200 J$=STR$(J):J$=RIGHT$(J$,LEN(J$)-1) 27210 IFLEN(J$)>6THENJ1=LEN(J$)-6:J$=LEFT$(J$,J1)+","+MID$(J$,J1+1,3)+","+RIGHT$(J$,3):RETURN 27220 IFLEN(J$)>3THENJ1=LEN(J$)-3:J$=LEFT$(J$,J1)+","+RIGHT$(J$,3):RETURN 27230 RETURN