home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
ftp.barnyard.co.uk
/
2015.02.ftp.barnyard.co.uk.tar
/
ftp.barnyard.co.uk
/
cpm
/
walnut-creek-CDROM
/
SIMTEL
/
CPMUG
/
CPMUG021.ARK
/
BIO.ASC
< prev
next >
Wrap
Text File
|
1984-04-29
|
4KB
|
159 lines
1 LET R1=(360/33)/57.2958
2 LET R2=(360/28)/57.2958
3 LET R3=(360/23)/57.2958
50 DATA 0,31,59,90,120,151,181,212,243,273,304,334
51 DATA 365
60 DIM L$(50)
75 RESTORE
100 PRINT"ENTER BIRTHDAY,CURRENT DATE (YYMMDD)"
125 LET P1=0
150 LET J6=1
200 INPUT D1,D2
205 LET D9=D2
206 PRINT"ENTER DURATION "
207 INPUT J5
210 PRINT"ENTER NAME OF SUBJECT "
220 INPUT A$
230 GOSUB 12000
300 IF D1>D2 THEN PRINT" INVALID DATES "
400 LET X1=D1
500 GOSUB 1000
550 LET Y1=X2:LETM1=X3:LET D1=X4
600 LET X1=D2
625 GOSUB 1000
650 LET Y2=X2:LETM2=X3:LETD2=X4
800 GOSUB 4000
1000 LET X2=INT(X1/10000)
1100 LET X3=INT(X1/100)-(X2*100)
1200 LET X4=X1-((X3*100)+(X2*10000))
1300 RETURN
4000 LET D4=(INT((Y2-1)*365.25)-INT((Y1-1)*365.25))
4100 FOR I=1 TO M1
4200 READ J1
4300 NEXT I
4400 RESTORE
4500 FOR I =1 TO M2
4600 READ J2
4700 NEXT I
4800 LET J1=J1+D1
4900 LET J2=J2+D2
5000 LET L1=(Y1/4)-(INT(Y1/4))
5100 IF L1=0 THEN LET L1=1:GOTO 5300
5200 LET L1=0
5300 LET L2=(Y2/4)-(INT(Y2/4))
5400 IF L2=0 THEN LET L2=1:GOTO 5600
5500 LET L2=0
5600 IF M1>2 THEN LET J1=J1+L1
5700 IF M2>2 THEN LET J2=J2+L2
5800 LET D4=D4+J2-J1
6000 LET D1=(D4-(INT(D4/33)*33))
6100 LET D2=(D4-(INT(D4/28)*28))
6200 LET D3=(D4-(INT(D4/23)*23))
6300 FOR L3=1 TO 50
6350 FOR I= 1 TO 50
6360 LET L$(I)=" "
6370 NEXT I
6400 LET X=SIN(R1*D1)
6500 LET Y=SIN(R2*D2)
6600 LET Z=SIN(R3*D3)
6700 LET L$(X*20+25)="M"
6800 LET L$(Y*20+25)="E"
6900 LET L$(Z*20+25)="P"
6950 PRINT": ";
7000 FOR I=1 TO 50
7050 LET L$(25)="I"
7100 PRINT L$(I);
7200 NEXT I
7205 PRINT": ";
7207 GOSUB 10000:PRINT D5;" : ";
7210 IF D1=0 THEN LET C=1:PRINT"M ";
7215 IF D1=16 THEN LET C=1:PRINT"M ";
7220 IF D2=0 THEN LET C=1:PRINT"E ";
7225 IF D2=14 THEN LET C=1:PRINT"E ";
7230 IF D3=0 THEN LET C=1:PRINT"P ";
7235 IF D3=12 THEN LET C=1:PRINT"P ";
7240 IF C=1 THEN LET C=0
7250 PRINT
7300 LET D1=D1+1
7400 LET D2=D2+1
7500 LET D3=D3+1
7600 IF D1=33 THEN LET D1=0
7700 IF D2=28 THEN LET D2=0
7800 IF D3=23 THEN LET D3=0
7900 LET J2=J2+1
7920 LET J6=J6+1
7950 IF J5<J6 GOTO 8300
8000 NEXT L3
8050 LET P1=P1+1
8100 GOSUB 14500
8125 PRINT:PRINT
8150 GOSUB 12000
8200 GOTO 6300
8300 LET P1=P1+1
8350 GOSUB 14500
8400 PRINT:PRINT
8500 GOTO 75
10000 RESTORE
10100 FOR I =1 TO 13
10150 LET J4=J3
10200 READ J3
10250 IF J2>59 THEN LET J3=J3+L2
10300 IF J2<=J3 GOTO 11000
10400 NEXT I
10500 LET Y2=Y2+1
10510 LET L2=(Y2/4)-(INT(Y2/4))
10520 IF L2=0 THEN LET L2=1:GOTO 10600
10530 LET L2=0
10600 LET J2=J2-365
10700 GOTO 10000
11000 LET M2=I-1
11100 LET D6=J2-J4
11150 IF J2=60 THEN LET D6=D6+L2
11200 LET D5=Y2*10000+(M2*100)+D6
11300 RETURN
12000 FOR I=1 TO 70
12100 PRINT"-";
12200 NEXT I
12250 PRINT
12300 PRINT": COMPUTERIZED STUDY OF BIORHYTHMIC CURVES BY ELMER ";
12310 PRINT"(PHONE 528-4438)";
12400 GOSUB 13600
12500 PRINT": SUBJECT, ";A$;
12600 GOSUB 13600
12700 PRINT ": DATE OF STUDY- ";D9;"- DURATION ";J5;"DAYS ";
12800 GOSUB 13600
12810 FOR I=1 TO 70:PRINT"-";:NEXT I:PRINT
12820 PRINT": P=PHYSICAL E=EMOTIONAL M=MENTAL ";
12830 PRINT TAB(70)":"
13200 FOR I=1 TO 70:PRINT"-";:NEXT I
13210 PRINT
13250 PRINT": LOW : HIGH :";
13260 PRINT" DATE :CRITICAL";
13400 PRINT":"
13500 FOR I=1 TO 70
13510 PRINT"-";
13520 NEXT I
13530 PRINT
13540 RETURN
13600 LET J=70-POS(X)
13700 FOR I=1 TO J-1
13800 PRINT" ";
13900 NEXT I
14000 PRINT":"
14100 RETURN
14500 FOR I=1 TO 70:PRINT"-";:NEXT I:PRINT
14600 PRINT": HIGH DAYS OF FULL VITALITY, EFFICIENCY, ";
14610 PRINT"AND HIGH ENDURANCE";
14700 GOSUB 13600
14800 PRINT": LOW DAYS OF REDUCED EFFICIENCY, RECUPERATION, ";
14810 PRINT"TIRE EASILY";
14900 GOSUB 13600
15000 PRINT": CRITICAL DAYS TO AVOID SITUATIONS THAT MIGHT ";
15010 PRINT"LEAD TO TROUBLE";
15100 GOSUB 13600
15150 FOR I=1 TO 70:PRINT"-";:NEXT I:PRINT
15200 PRINT TAB(31);"PAGE ";P1
15400 RETURN