'===========================================================================
' Subject: COMPATIBILITY ANALYSIS PROGRAM     Date: 11-12-97 (05:34)       
'  Author: Andrew S. Gibson                   Code: QB, QBasic, PDS        
'  Origin: zapf_dingbat@juno.com            Packet: AI.ABC
'===========================================================================
' This program was Resurrected from a book called,
' Announcing: Computer Games, for Business, School and Home
' For TSR-80 Level II BASIC by J. Victor Nahigian and William S. Hodges.
' This program will work in plain old Qbasic (or the old GW-BASIC)
' interpreters. When you type in a person's Birthday you must use a comma
' to seperate the Month (MM), Day (DD), Year (YYYY). The year must be four
' digits long !   E-mail me @ this address Zapf_DingBat@JUNO.COM to chat
' or send some of your code (postit encrypted and less than 55k).
1 CLS ' Compatability Analysis program.
2 COLOR 15: LOCATE 2, 28: PRINT " C O M P A T A B I L I T Y"
3 LOCATE 3, 28: PRINT "      A N A L Y S I S     ": COLOR 7
4 LOCATE 5, 28: PRINT "  By using the biorhythmic"
5 LOCATE 6, 28: PRINT "cycle theory, this program"
6 LOCATE 7, 28: PRINT "takes the birthdays of two"
7 LOCATE 8, 28: PRINT "individuals and calculates"
8 LOCATE 9, 28: PRINT "when they  are  compatible"
9 LOCATE 10, 28: PRINT "during   their   lifetime,"
10 LOCATE 11, 28: PRINT "It also gives the  average"
11 LOCATE 12, 28: PRINT "compatability  percentage."
12 LOCATE 14, 28: PRINT "Couples  therefore  should"
13 LOCATE 15, 28: PRINT "not   feel   insulted   if"
14 LOCATE 16, 28: PRINT "their average  is not  one": LOCATE 17, 28: PRINT "hundred percent."
15 LOCATE 19, 11: PRINT "Program written by J. Victor Nahigian and William S. Hodges.": LOCATE 20, 23: PRINT "Resurrected for DOS by Andrew Gibson."
16 LOCATE 22, 17: PRINT "Copyright 1980, 1979 By Winthrop Publishers, Inc.": COLOR 15: LOCATE 24, 28: PRINT "P R E S S  A N Y   K E Y ."; : COLOR 7: LOCATE 1, 1
17 ZZ$ = INKEY$: IF ZZ$ = "" THEN 17
18 DIM A1(30), B1(30): DIM A(12)
19 FOR I = 1 TO 12: READ A(I): NEXT I
20 DATA 0,31,59,90,120,151,181,212,243,273,304,334
21 Y = 0
22 Y = Y + 1
23 CLS : PRINT "What is the name of person one (1)"; : INPUT W$
24 PRINT "What is person one's birthday (MM,DD,YYYY)";
25 INPUT M, D, Y
26 E1 = M: F1 = D: G1 = Y
27 GOSUB 72
28 Z2 = T: K1 = J + 1
29 PRINT
30 PRINT "What is the name of person two (2)"; : INPUT X$
31 PRINT "What is person two's birthday (MM,DD,YYYY)";
32 INPUT M, D, Y
33 E2 = M: D2 = D: G2 = Y
34 GOSUB 72
35 P2 = ABS(Z2 - T)
36 K2 = J + 1
38 CLS
39 PRINT "COMPATABILITY ANALYSIS"
40 PRINT "----------------------"
41 PRINT
42 PRINT "COMPATABILITY ANALYSIS OF "; W$; " AND "; X$; "."
43 PRINT
44 PRINT W$; " was born on "; : M = E1: GOSUB 90
45 PRINT STR$(F1); ","; STR$(G1); ". On a "; : J = K1
46 GOSUB 102
47 PRINT ".": PRINT
49 PRINT X$; " was born on "; : M = E2: GOSUB 90
50 PRINT STR$(D2); ","; STR$(G2); ". On a "; : J = K2
51 GOSUB 102
52 PRINT ".": PRINT
54 Z = P2
55 P3 = ABS(INT(((Z / 23) - INT(Z / 23)) * 23))
56 S3 = ABS(INT(((Z / 28) - INT(Z / 28)) * 28))
57 C3 = ABS(INT(((Z / 33) - INT(Z / 33)) * 33))
58 P5 = ABS(100 - ((2 * P3) * (100 / 23)))
59 S5 = ABS(100 - ((2 * S3) * (100 / 28)))
60 C5 = ABS(100 - ((2 * C3) * (100 / 33)))
61 PRINT USING "PHYSICAL CYCLE COMPATABILITY (23-DAY) IS    ###.###%"; INT(P5 * 1000) / 1000
63 PRINT USING "SENSITIVITY CYCLE COMPATABILITY (28-DAY) IS ###.###%"; INT(S5 * 1000) / 1000
65 PRINT USING "COGNITIVE CYCLE COMPATABILITY (33-DAY) IS   ###.###%"; INT(C5 * 1000) / 1000
67 PRINT SPC(44); "--------"
69 A5 = (P5 + S5 + C5) / 3
70 PRINT USING "AVERAGE COMPATABILITY IS                    ###.###%"; INT(A5 * 1000) / 1000
71 GOTO 109
72 Y1 = Y - 1800
73 Q1 = INT(Y1 / 4)
74 Q2 = INT(Q1 / 25)
75 Q3 = INT((Y1 + 200) / 400)
76 K = 0
77 IF Q1 * 4 <> Y1 THEN 81
78 IF Q2 * 100 <> Y1 THEN 81
79 IF Q3 * 400 - 200 <> Y1 THEN 81
80 K = 1
81 T = 365 * Y1 + Q1 - Q2 + Q3 - K
82 T = T + A(M) + D - 1
83 IF M < 3 THEN 85
84 T = T + K
85 IF INT(Y1 / 4) <> Y1 / 4 THEN 88
86 IF M > 2 THEN 88
87 T = T - 1
88 J = T - 7 * INT(T / 7)
89 RETURN
90 IF M = 1 THEN PRINT "JANUARY"; : RETURN
91 IF M = 2 THEN PRINT "FEBRUARY"; : RETURN
92 IF M = 3 THEN PRINT "MARCH"; : RETURN
93 IF M = 4 THEN PRINT "APRIL"; : RETURN
94 IF M = 5 THEN PRINT "MAY"; : RETURN
95 IF M = 6 THEN PRINT "JUNE"; : RETURN
96 IF M = 7 THEN PRINT "JULY"; : RETURN
97 IF M = 8 THEN PRINT "AUGUST"; : RETURN
98 IF M = 9 THEN PRINT "SEPTEMBER"; : RETURN
99 IF M = 10 THEN PRINT "OCTOBER"; : RETURN
100 IF M = 11 THEN PRINT "NOVEMBER"; : RETURN
101 PRINT "DECEMBER"; : RETURN
102 IF J = 1 THEN PRINT "WEDNESDAY"; : RETURN
103 IF J = 2 THEN PRINT "THURSDAY"; : RETURN
104 IF J = 3 THEN PRINT "FRIDAY"; : RETURN
105 IF J = 4 THEN PRINT "SATURDAY"; : RETURN
106 IF J = 5 THEN PRINT "SUNDAY"; : RETURN
107 IF J = 6 THEN PRINT "MONDAY"; : RETURN
108 PRINT "TUESDAY"; : RETURN
109 PRINT : COLOR 15: PRINT "Press any key to return to what ever you were doing.": COLOR 7
110 ZZ$ = INKEY$: IF ZZ$ = "" THEN 110
111 END