home *** CD-ROM | disk | FTP | other *** search
/ RBBS in a Box Volume 1 #3.1 / RBBSIABOX31.cdr / swal / stress.bas < prev    next >
Encoding:
BASIC Source File  |  1990-09-29  |  6.5 KB  |  162 lines
  1. 10 '*************************************************************************
  2. 20 '                    HOLMES LIFE CHANGE EVENTS INDEX
  3. 30 '                        Lawrence R. Walker, Ph.D.
  4. 40 '                           VERSION 1.1     1984
  5. 50 '*************************************************************************
  6. 60 KEY OFF:CLS:GOSUB 960:CLS:DIM CHANGE$(5)
  7. 70 LOCATE 3,25:PRINT   "HOLMES LIFE CHANGE EVENTS INDEX"
  8. 80 LOCATE 5,13:PRINT   "This questionnaire will help you analyze the stress"
  9. 90 LOCATE 6,13:PRINT   "that may be caused by changes in your life"
  10. 100 LOCATE 8,13:PRINT   "The Life Change Events Index was originally developed by"
  11. 110 LOCATE 9,13:PRINT   "Dr. Thomas Holmes, M.D., Professor of Psychiatry at the"
  12. 120 LOCATE 10,13:PRINT  "University of Washington.  The Index consist of 43 life"
  13. 130 LOCATE 11,13:PRINT  "events with weights ranging from 100 to 11 attached to"
  14. 140 LOCATE 12,13:PRINT  "each.  It has been found that the as the rate of change"
  15. 150 LOCATE 13,13:PRINT  "in our life increases, the greater the vulnerability or"
  16. 160 LOCATE 14,13:PRINT  "lowering of resistance to disease, and the more serious"
  17. 170 LOCATE 15,13:PRINT  "the disease that does develop."
  18. 180 LOCATE 17,13:PRINT  "If one of the following events has been true for you"
  19. 190 LOCATE 18,13:PRINT "during the past year or will occur in the near future,"
  20. 200 LOCATE 19,13:PRINT "please press the number <1>.  Otherwise, press the "
  21. 210 LOCATE 20,13:PRINT "number <2>"
  22. 220 LOCATE 23,27:PRINT "PRESS ANY KEY TO CONTINUE"
  23. 230 A$=INKEY$:IF A$="" THEN 230
  24. 240 FOR I=1 TO 43
  25. 250 READ EVENT$,IMPACT:ADJUST=(80-LEN(EVENT$))/2
  26. 260 CLS:LOCATE 4,ADJUST:PRINT EVENT$
  27. 270 LOCATE 7,37:PRINT "<1>  Yes"
  28. 280 LOCATE 9,37:PRINT "<2>  No"
  29. 290 LOCATE 12,28:PRINT "Please enter your response"
  30. 300 LOCATE 14,31:PRINT "Do NOT press <ENTER>"
  31. 310 B$=INKEY$:IF B$="" THEN 310
  32. 320 IF VAL(B$)<>INT(1) AND VAL(B$)<>INT(2) GOTO 260
  33. 330 IF VAL(B$)=1 THEN TOTAL=TOTAL+IMPACT
  34. 340 B$=""
  35. 350 NEXT I
  36. 360 CLS:LOCATE 10,26:PRINT "Your Life Change Index is";TOTAL
  37. 370 FOR J=1 TO 5:READ CHANGE$(J):NEXT J
  38. 380 IF TOTAL >=300 THEN K=1:GOTO 430
  39. 390 IF TOTAL >=250 AND TOTAL <=299 THEN K=2:GOTO 430
  40. 400 IF TOTAL >=200 AND TOTAL <=249 THEN K=3:GOTO 430
  41. 410 IF TOTAL >=150 AND TOTAL <=199 THEN K=4:GOTO 430
  42. 420 K=5
  43. 430 ADJUST=(80-LEN(CHANGE$(K)))/2:LOCATE 12,ADJUST:PRINT CHANGE$(K)
  44. 440 LOCATE 18,9:PRINT "Thank you very much for taking time to answer this questionnaire"
  45. 450 LOCATE 22,26:PRINT "PRESS ANY KEY TO END PROGRAM"
  46. 460 E$=INKEY$:IF E$="" THEN 460
  47. 470 CLS:END
  48. 480 DATA Death of Spouse,100
  49. 490 DATA Divorce,73
  50. 500 DATA Marital Separation,65
  51. 510 DATA Jail Term,63
  52. 520 DATA Death of Close Family Member,63
  53. 530 DATA Personal Injury or Illness,53
  54. 540 DATA Marriage,50
  55. 550 DATA Fired at Work,47
  56. 560 DATA Marital Reconciliation,45
  57. 570 DATA Retirement,45
  58. 580 DATA Change in Health of Family Member,44
  59. 590 DATA Pregnancy,40
  60. 600 DATA Sex Difficulties,39
  61. 610 DATA Gain of New Family Member,39
  62. 620 DATA Business Readjustment,39
  63. 630 DATA Change in Financial State,38
  64. 640 DATA Death of Close Friend,37
  65. 650 DATA Change to Different Line of Work,36
  66. 660 DATA Change in Number of Arguments with Spouse,35
  67. 670 DATA "Mortgage over $50,000",31
  68. 680 DATA Foreclosure of Mortgage or Loan,30
  69. 690 DATA Change in Responsibilities at Work,29
  70. 700 DATA Son or Daughter Leaving Home,29
  71. 710 DATA Trouble with In-Laws,29
  72. 720 DATA Outstanding Personal Achievement,28
  73. 730 DATA Spouse Begins or Stops Work,26
  74. 740 DATA Begin or End School,26
  75. 750 DATA Change in Living Conditions,25
  76. 760 DATA Revision of Personal Habits,24
  77. 770 DATA Trouble with Boss,23
  78. 780 DATA Change in Work Hours or Conditions,20
  79. 790 DATA Change in Residence,20
  80. 800 DATA Change in Schools,20
  81. 810 DATA Change in Recreation,19
  82. 820 DATA Change in Church Activities,19
  83. 830 DATA Change in Social Activities,18
  84. 840 DATA "Mortgage or Loan less than $50,000",17
  85. 850 DATA Change in Sleeping Habits,15
  86. 860 DATA Change in Number of Family Get-Togethers,15
  87. 870 DATA Change in Eating Habits,15
  88. 880 DATA Vacation,13
  89. 890 DATA Christmas (if approaching),12
  90. 900 DATA Minor Violations of the Law,11
  91. 910 DATA Your Score Indicates You Have Had Major Life Change
  92. 920 DATA Your Score Indicates You Have Had Serious Life Change
  93. 930 DATA Your Score Indicates You Have Had Moderate Life Change
  94. 940 DATA Your Score Indicates You Have Had Mild Life Change
  95. 950 DATA Your Score Indicates You Have Had Very Little Life Change
  96. 960 Z$=STRING$(80,"*"):PRINT Z$;:PRINT Z$;:LOCATE 22,1:PRINT Z$;:LOCATE 23,1:PRINT Z$;
  97. 970 X$="**"
  98. 980 C=2
  99. 990 C=C+1
  100. 1000 LOCATE C,1:PRINT X$;:LOCATE C,79:PRINT X$
  101. 1010 IF C=21 THEN 1030
  102. 1020 GOTO 990
  103. 1030 COLOR 9,0
  104. 1040 LOCATE 6,36:PRINT "HEY YOU"
  105. 1050 FOR X=1 TO 6000:NEXT X
  106. 1060 COLOR 25,0
  107. 1070 LOCATE 10,33:PRINT "!! YES, YOU !!"
  108. 1080 FOR X=1 TO 6000
  109. 1090 NEXT X
  110. 1100 COLOR 7,0
  111. 1110 LOCATE 16,28:PRINT "HOW'S LIFE BEEN TREATING"
  112. 1120 LOCATE 17,38:PRINT "YOU"
  113. 1130 LOCATE 18,36:PRINT "LATELY?"
  114. 1140 FOR X=1 TO 12000:NEXT X
  115. 1150 COLOR 7,0
  116. 1160 CLS
  117. 1170 LOCATE 1,39: PRINT "**"
  118. 1180 LOCATE 24,39: PRINT "**"
  119. 1190 LOCATE 2,37:PRINT "******
  120. 1200 LOCATE 23,37:PRINT "******
  121. 1210 LOCATE 3,34:PRINT "************"
  122. 1220 LOCATE 22,34:PRINT "************"
  123. 1230 LOCATE 4,28:PRINT "************************"
  124. 1240 LOCATE 21,28:PRINT "************************"
  125. 1250 LOCATE 5,22:PRINT "************************************"
  126. 1260 LOCATE 20,22:PRINT "************************************"
  127. 1270 LOCATE 6,16:PRINT "************************************************"
  128. 1280 LOCATE 19,16:PRINT "************************************************"
  129. 1290 LOCATE 11,27:PRINT "DON'T LET STRESS MAKE YOU"
  130. 1300 LOCATE 12,32: PRINT "ITS NEXT VICTIM"
  131. 1310 FOR X = 1 TO 6000: NEXT X
  132. 1320 LOCATE 14,24:PRINT "FIND OUT BEFORE IT'S TOO LATE !"
  133. 1330 FOR X= 1 TO 12000: NEXT X
  134. 1340 CLS
  135. 1350 GOSUB 1500
  136. 1360 RT=1:CL=1:CR=80:RB=21
  137. 1370 FOR I=1 TO 5
  138. 1380 LOCATE RT,CL+1
  139. 1390 PRINT STRING$(CR-CL-1,CHR$(205));
  140. 1400 PRINT CHR$(187)
  141. 1410 FOR J=RT+1 TO RB-1:LOCATE J,CR:PRINT CHR$(186):NEXT J
  142. 1420 LOCATE RB,CR:PRINT CHR$(188)
  143. 1430 FOR J=CR-1 TO CL+1 STEP -1:LOCATE RB,J:PRINT CHR$(205):NEXT J
  144. 1440 LOCATE RB,CL:PRINT CHR$(200)
  145. 1450 FOR J=RB-1 TO RT+1 STEP -1:LOCATE J,CL:PRINT CHR$(186):NEXT J
  146. 1460 LOCATE RT,CL:PRINT CHR$(201)
  147. 1470 RT=RT+2:CL=CL+2:CR=CR-2:RB=RB-2
  148. 1480 NEXT I
  149. 1490 GOTO 1570
  150. 1500 FOR I=1 TO 27
  151. 1510 LOCATE 10,I:PRINT CHR$(16);" HOLMES LIFE CHANGE INDEX ";CHR$(17)
  152. 1520 FOR K=1 TO 50:NEXT K
  153. 1530 IF I=27 THEN 1560
  154. 1540 LOCATE 10,I:PRINT " "
  155. 1550 NEXT I
  156. 1560 RETURN
  157. 1570 LOCATE 11,18:PRINT "Program written by Lawrence R. Walker, Ph.D."
  158. 1580 LOCATE 12,34:PRINT "version 1.1"
  159. 1590 FOR I=1 TO 12000:NEXT I
  160. 1600 RETURN
  161.  "Program written by Lawrence R. Walker, Ph.D."
  162. 1580 LOCATE 12,34:PRINT "vers