home *** CD-ROM | disk | FTP | other *** search
/ Colossal Cookbook / ColossalCookbook.cdr / diet / nutmg / dsplynut.bas (.txt) < prev    next >
Encoding:
GW-BASIC  |  1986-03-07  |  12.1 KB  |  141 lines
  1. 10  'DSPLYNUT.BAS (a NUTRIENT routine)       (C)Copyright 1986 Robert F. Savryk      ---------------------------------       ----------------------------------     '
  2. 5010  Z%=5:ZZ%=49:WIDTH 40:DSPLYNUT$="YES"
  3. 5012  CLS:RTN%=0:LOCATE 1,14:COLOR 15,0:PRINT "DISPLAY SCREEN";:COLOR 7,0:LOCATE 5,1:PRINT "DISPLAY OPTIONS:":LOCATE 7,11:PRINT "1 - FOOD(s)":LOCATE 8,11:PRINT "2 - FOODFILE":LOCATE 9,11:PRINT "3 - FOOD INTAKE ANALYSIS"
  4. 5015  LOCATE 25,1:COLOR 0,15:PRINT "F1";:COLOR 7,0:PRINT " HELP";:PRINT TAB(15);:COLOR 0,15:PRINT "F10";:COLOR 7,0:PRINT " EXIT";:ON KEY(1) GOSUB 8010:ON KEY(10) GOSUB 9000:KEY(1) ON:KEY(10) ON
  5. 5017  ON RTN% GOTO 5110,5121,5210,5225,5245,5270,5300,5325,5345,5375,5400,5425
  6. 5030  LOCATE 11,1,1:PRINT "Choose a number please ";:C$="":WHILE C$="":C$=INKEY$:WEND:ON VAL(C$) GOTO 5100,5500,5700:5020
  7. 5100  CLS:LOCATE 1,15:COLOR 15,0:PRINT "DISPLAY FOOD(s)";:LOCATE 5,1:COLOR 7,0:PRINT "DISPLAY a:":LOCATE 7,11:PRINT "1 - FOOD":LOCATE 8,11:PRINT "2 - FOOD GROUP":RTN%=1:GOTO 5015
  8. 5110  LOCATE 10,1,1:PRINT "Choose a number please ";:C$="":WHILE C$="":C$=INKEY$:WEND:ON VAL(C$) GOTO 5120,5200:5110
  9. 5120  CLS:WIDTH 80:LOCATE 1,34:COLOR 15,0:PRINT "DISPLAY A FOOD";:COLOR 7,0:RTN%=2:GOTO 5015
  10. 5121  REC$="":LOCATE 3,1:PRINT "Enter Food Number to display (0 to end)? ";
  11. 5122  RF$=INKEY$:IF RF$="" THEN 5122
  12. 5124  IF RF$=CHR$(13) THEN RF%=VAL(REC$):GOTO 5131
  13. 5125  IF RF$=CHR$(8) THEN 5130
  14. 5127  IF ASC(RF$)>47 AND ASC(RF$)<58 THEN PRINT RF$;:REC$=REC$+RF$:GOTO 5122:ELSE GOTO 5122
  15. 5130  IF LEN(REC$)=0 THEN BEEP:GOTO 5121:ELSE LOCATE CSRLIN,POS(0)-1:PRINT " ";:LOCATE CSRLIN,POS(0)-1:REC$=LEFT$(REC$,LEN(REC$)-1):GOTO 5122
  16. 5131  IF RF%=0 THEN RTN%=0:GOTO 5010
  17. 5132  IF RF%>MAX% THEN LOCATE 4,1:PRINT "Food Number must be less than";MAX%+1;" - try again";:FOR X%=1 TO 3000:NEXT:LOCATE 3,1:PRINT SPACE$(130);:GOTO 5121 ELSE GET #1, RF%
  18. 5135  IF LEFT$(F$,1)=" " THEN LOCATE 4,1:PRINT "Food record is empty - try again";:FOR X%=1 TO 3000:NEXT:LOCATE 3,1:PRINT SPACE$(130);:GOTO 5121 ELSE LOCATE 3,1:PRINT SPACE$(45);
  19. 5140  LOCATE 6,1:PRINT "Food Description [                    ]"
  20. 5145  LOCATE 7,1:PRINT "Food Group [  ]" TAB(25) "Amount (No.+Unit) [      ]" TAB(61) "Weight (g) [   ]":PRINT STRING$(78,"-"):LOCATE 9,1:PRINT "Water (g) [    ]" TAB(40) "Thiamin (mg) [   ]"
  21. 5150  LOCATE 10,1:PRINT "Food Energy (kcal) [    ]" TAB(40)"Riboflavin (mg) [   ]   ":LOCATE 11,1:PRINT "Protein (g) [   ]" TAB(40) "Niacin (mg) [   ]":LOCATE 12,1:PRINT "Total Fat (g) [   ]" TAB(40) "Vitamin B-6 (mg) [   ]"
  22. 5155  LOCATE 13,1:PRINT "Carbohydrate (g) [   ]" TAB(40) "Folacin (mcg) [    ]":LOCATE 14,1:PRINT "Crude Fiber (g) [   ]"TAB(40)"Vitamin B-12 (mcg) [   ]":LOCATE 15,1:PRINT "Calcium (mg) [    ]" TAB(40) "Vitamin A (IU) [     ]"
  23. 5160  LOCATE 16,1:PRINT "Iron (mg) [   ]" TAB(40) "Vitamin E (IU) [   ]":LOCATE 17,1:PRINT "Magnesium (g) [   ]" TAB(40) "Saturated Fat (g) [   ]":LOCATE 18,1:PRINT "Phosphorus (mg) [    ]" TAB(40) "Monounsaturated Fat (g) [   ]"
  24. 5165  LOCATE 19,1:PRINT "Potassium (mg) [    ]" TAB(40) "Polyunsaturated Fat (g) [   ]":LOCATE 20,1:PRINT "Sodium (mg) [    ]" TAB(40) "Cholesterol (mg) [   ]":LOCATE 21,1:PRINT "Zinc (mg) [   ]" TAB(40) "Alcohol (g) [   ]"
  25. 5170  LOCATE 22,1:PRINT "Ascorbic Acid (mg) [   ]"
  26. 5175  LOCATE 6,19,1:PRINT LEFT$(F$,20):LOCATE 7,13,1:PRINT MID$(F$,21,2):LOCATE 7,44,1:PRINT MID$(F$,23,6):LOCATE 7,73,1:PRINT MID$(F$,29,3):LOCATE 9,12,1:PRINT MID$(F$,32,4):LOCATE 9,54,1:PRINT MID$(F$,80,3)
  27. 5180  LOCATE 10,21,1:PRINT MID$(F$,36,4):LOCATE 10,57,1:PRINT MID$(F$,83,3):LOCATE 11,14,1:PRINT MID$(F$,40,3):LOCATE 11,53,1:PRINT MID$(F$,86,3):LOCATE 12,16,1:PRINT MID$(F$,43,3):LOCATE 12,58,1:PRINT MID$(F$,89,3)
  28. 5185  LOCATE 13,19,1:PRINT MID$(F$,46,3):LOCATE 13,55,1:PRINT MID$(F$,92,4):LOCATE 14,18,1:PRINT MID$(F$,49,3):LOCATE 14,60,1:PRINT MID$(F$,96,3):LOCATE 15,15,1:PRINT MID$(F$,52,4):LOCATE 15,56,1:PRINT MID$(F$,99,5)
  29. 5190  LOCATE 16,12,1:PRINT MID$(F$,56,3):LOCATE 16,56,1:PRINT MID$(F$,104,3):LOCATE 17,16,1:PRINT MID$(F$,59,3):LOCATE 17,59,1:PRINT MID$(F$,107,3):LOCATE 18,18,1:PRINT MID$(F$,62,4):LOCATE 18,65,1:PRINT MID$(F$,110,3)
  30. 5195  LOCATE 19,17,1:PRINT MID$(F$,66,4):LOCATE 19,65,1:PRINT MID$(F$,113,3):LOCATE 20,14,1:PRINT MID$(F$,70,4):LOCATE 20,58,1:PRINT MID$(F$,116,3):LOCATE 21,12,1:PRINT MID$(F$,74,3):LOCATE 21,53,1:PRINT MID$(F$,119,3)
  31. 5196  LOCATE 22,21,1:PRINT MID$(F$,77,3):GOTO 5121
  32. 5200  CLS:LOCATE 1,12:COLOR 15,0:PRINT "DISPLAY FOOD GROUP";:COLOR 7,0:LOCATE 5,1:PRINT "1 - DAIRY/MILK       5 - PROTEIN/MEATS":LOCATE 6,1:PRINT "2 - VEGETABLES       6 - OILS/FATS"
  33. 5205  LOCATE 7,1:PRINT "3 - FRUITS           7 - SWEETS":LOCATE 8,1:PRINT "4 - BREADS/STARCHES  8 - COMBINATION":LOCATE 9,22:PRINT "9 - MISC/OTHER":RTN%=3:GOTO 5015
  34. 5210  LOCATE 11,1:PRINT "Choose a number ";:C$="":WHILE C$="":C$=INKEY$:WEND:ON VAL(C$) GOTO 5220,5240,5265,5290,5315,5340,5365,5390,5415
  35. 5211  GOTO 5210
  36. 5220  CLS:LOCATE 1,12:COLOR 15,0:PRINT "DISPLAY DAIRY/MILK";:COLOR 7,0:LOCATE 5,3:PRINT "1 - NONFAT":LOCATE 6,3:PRINT "2 - LOWFAT":LOCATE 7,3:PRINT "3 - HIGHFAT":LOCATE 8,3:PRINT "4 - ENTIRE DAIRY/MILK GROUP":RTN%=4:GOTO 5015
  37. 5225  LOCATE 10,1:PRINT "Choose a number ";:C$="":WHILE C$="":C$=INKEY$:WEND
  38. 5230  IF VAL(C$)=1 THEN KY$="DN":H$="NONFAT DAIRY/MILK":GOTO 5450 ELSE IF VAL(C$)=2 THEN KY$="DL":H$="LOW FAT DAIRY/MILK":GOTO 5450 ELSE IF VAL(C$)=3 THEN KY$="DH":H$="HIGH FAT DAIRY/MILK":GOTO 5450 ELSE
  39. 5235  IF VAL(C$)=4 THEN KY$="D":H$="ENTIRE DAIRY/MILK":GOTO 5450 ELSE GOTO 5225
  40. 5240  CLS:LOCATE 1,12:COLOR 15,0:PRINT "DISPLAY VEGETABLES";:COLOR 7,0:LOCATE 5,3:PRINT "1 - NONSTARCHY":LOCATE 6,3:PRINT "2 - STARCHY":LOCATE 7,3:PRINT "3 - OTHER":LOCATE 8,3:PRINT "4 - ENTIRE VEGETABLE GROUP":RTN%=5:GOTO 5015
  41. 5245  LOCATE 10,1:PRINT "Choose a number ";:C$="":WHILE C$="":C$=INKEY$:WEND
  42. 5250  IF VAL(C$)=1 THEN KY$="VN":H$="NONSTARCHY VEGETABLES":GOTO 5450 ELSE IF VAL(C$)=2 THEN KY$="VS":H$="STARCHY VEGETABLES":GOTO 5450 ELSE IF VAL(C$)=3 THEN KY$="VO":H$="OTHER VEGETABLES":GOTO 5450 ELSE
  43. 5255  IF VAL(C$)=4 THEN KY$="V":H$="ENTIRE VEGETABLES":GOTO 5450 ELSE GOTO 5245
  44. 5265  CLS:LOCATE 1,13:COLOR 15,0:PRINT "DISPLAY FRUITS";:COLOR 7,0:LOCATE 5,3:PRINT "1 - VITAMIN A":LOCATE 6,3:PRINT "2 - VITAMIN C":LOCATE 7,3:PRINT "3 - OTHER":LOCATE 8,3:PRINT "4 - ENTIRE FRUIT GROUP":RTN%=6:GOTO 5015
  45. 5270  LOCATE 10,1:PRINT "Choose a number ";:C$="":WHILE C$="":C$=INKEY$:WEND
  46. 5275  IF VAL(C$)=1 THEN KY$="FA":H$="VITAMIN A FRUIT":GOTO 5450 ELSE IF VAL(C$)=2 THEN KY$="FC":H$="VITAMIN C FRUIT":GOTO 5450 ELSE IF VAL(C$)=3 THEN KY$="FO":H$="OTHER FRUIT":GOTO 5450 ELSE
  47. 5280  IF VAL(C$)=4 THEN KY$="F":H$="ENTIRE FRUIT":GOTO 5450 ELSE GOTO 5270
  48. 5290  CLS:LOCATE 1,9:COLOR 15,0:PRINT "DISPLAY BREADS/STARCHES";:COLOR 7,0:LOCATE 5,3:PRINT "1 - BREAD":LOCATE 6,3:PRINT "2 - CEREAL":LOCATE 7,3:PRINT "3 - GRAINS":LOCATE 8,3:PRINT "4 - PASTA"
  49. 5295  LOCATE 9,3:PRINT "5 - OTHER":LOCATE 10,3:PRINT "6 - ENTIRE BREADS/STARCHES GROUP":RTN%=7:GOTO 5015
  50. 5300  LOCATE 12,1:PRINT "Choose a number ";:C$="":WHILE C$="":C$=INKEY$:WEND
  51. 5305  IF VAL(C$)=1 THEN KY$="BB":H$="BREAD":GOTO 5450 ELSE IF VAL(C$)=2 THEN KY$="BC":H$="CEREAL":GOTO 5450 ELSE IF VAL(C$)=3 THEN KY$="BG":H$="GRAINS":GOTO 5450 ELSE
  52. 5310  IF VAL(C$)=4 THEN KY$="BP":H$="PASTA":GOTO 5450 ELSE IF VAL(C$)=5 THEN KY$="BO":H$="OTHER BREADS/STARCHES":GOTO 5450 ELSE IF VAL(C$)=6 THEN KY$="B":H$="ENTIRE BREADS/STARCHES":GOTO 5450 ELSE GOTO 5300
  53. 5315  CLS:LOCATE 1,10:COLOR 15,0:PRINT "DISPLAY PROTEIN/MEATS";:COLOR 7,0:LOCATE 5,3:PRINT "1 - LOW FAT":LOCATE 6,3:PRINT "2 - MEDIUM FAT":LOCATE 7,3:PRINT "3 - HIGH FAT":LOCATE 8,3:PRINT "4 - OTHER"
  54. 5320  LOCATE 9,3:PRINT "5 - ENTIRE PROTEIN/MEATS GROUP":RTN%=8:GOTO 5015
  55. 5325  LOCATE 11,1:PRINT "Choose a number ";:C$="":WHILE C$="":C$=INKEY$:WEND
  56. 5330  IF VAL(C$)=1 THEN KY$="PL":H$="LOW FAT PROTEINS":GOTO 5450 ELSE IF VAL(C$)=2 THEN KY$="PM":H$="MEDIUM FAT PROTEINS":GOTO 5450 ELSE IF VAL(C$)=3 THEN KY$="PH":H$="HIGH FAT PROTEINS":GOTO 5450 ELSE
  57. 5335  IF VAL(C$)=4 THEN KY$="PO":H$="OTHER PROTEINS":GOTO 5450 ELSE IF VAL(C$)=5 THEN KY$="P":H$="ENTIRE PROTEIN/MEATS GROUP":GOTO 5450 ELSE GOTO 5325
  58. 5340  CLS:LOCATE 1,12:COLOR 15,0:PRINT "DISPLAY OILS/FATS";:COLOR 7,0:LOCATE 5,3:PRINT "1 - ANIMAL":LOCATE 6,3:PRINT "2 - VEGETABLE":LOCATE 7,3:PRINT "3 - OTHER":LOCATE 8,3:PRINT "4 - ENTIRE OILS/FATS GROUP":RTN%=9:GOTO 5015
  59. 5345  LOCATE 10,1:PRINT "Choose a number ";:C$="":WHILE C$="":C$=INKEY$:WEND
  60. 5350  IF VAL(C$)=1 THEN KY$="OA":H$="ANIMAL OILS/FATS":GOTO 5450 ELSE IF VAL(C$)=2 THEN KY$="OV":H$="VEGETABLE OILS/FATS":GOTO 5450 ELSE IF VAL(C$)=3 THEN KY$="OO":H$="OTHER OILS/FATS":GOTO 5450 ELSE
  61. 5355  IF VAL(C$)=4 THEN KY$="O":H$="ENTIRE OILS/FATS":GOTO 5450 ELSE GOTO 5345
  62. 5365  CLS:LOCATE 1,13:COLOR 15,0:PRINT "DISPLAY SWEETS";:COLOR 7,0:LOCATE 5,3:PRINT "1 - BEVERAGES":LOCATE 6,3:PRINT "2 - CAKES/COOKIES/CANDY":LOCATE 7,3:PRINT "3 - JAMS/JELLIES":LOCATE 8,3:PRINT "4 - SWEETENERS/SYRUPS"
  63. 5370  LOCATE 9,3:PRINT "5 - ARTIFICIALLY SWEET":LOCATE 10,3:PRINT "6 - OTHER SWEETS":LOCATE 11,3:PRINT "7 - ENTIRE SWEETS GROUP":RTN%=10:GOTO 5015
  64. 5375  LOCATE 13,1:PRINT "Choose a number ";:C$="":WHILE C$="":C$=INKEY$:WEND
  65. 5380  IF VAL(C$)=1 THEN KY$="SB":H$="SWEET BEVERAGES":GOTO 5450 ELSE IF VAL(C$)=2 THEN KY$="SC":H$="CAKES/COOKIES/CANDY":GOTO 5450 ELSE IF VAL(C$)=3 THEN KY$="SJ":H$="JAMS/JELLIES":GOTO 5450 ELSE
  66. 5385  IF VAL(C$)=4 THEN KY$="SS":H$="SWEETENERS/SYRUPS":GOTO 5450 ELSE IF VAL(C$)=5 THEN KY$="SA":H$="ARTIFICIALLY SWEET":GOTO 5450 ELSE IF VAL(C$)=6 THEN KY$="SO":H$="OTHER SWEETS":GOTO 5450 ELSE
  67. 5387  IF VAL(C$)=7 THEN KY$="S":H$="ENTIRE SWEETS GROUP":GOTO 5450 ELSE GOTO 5375
  68. 5390  CLS:LOCATE 1,11:COLOR 15,0:PRINT "DISPLAY COMBINATION";:COLOR 7,0:LOCATE 5,3:PRINT "1 - CASSEROLES":LOCATE 6,3:PRINT "2 - EGG/CHEESE DISHES":LOCATE 7,3:PRINT "3 - FAST FOODS":LOCATE 8,3:PRINT "4 - SANDWICHES & LUNCH FOODS"
  69. 5395  LOCATE 9,3:PRINT "5 - MEATS/POULTRY/FISH":LOCATE 10,3:PRINT "6 - SOUPS/SALADS":LOCATE 11,3:PRINT "7 - OTHER COMBINATIONS":LOCATE 12,3:PRINT "8 - ENTIRE COMBINATION GROUP":RTN%=11:GOTO 5015
  70. 5400  LOCATE 14,1:PRINT "Choose a number ";:C$="":WHILE C$="":C$=INKEY$:WEND
  71. 5405  IF VAL(C$)=1 THEN KY$="CC":H$="CASSEROLES":GOTO 5450 ELSE IF VAL(C$)=2 THEN KY$="CE":H$="EGG/CHEESE DISHES":GOTO 5450 ELSE IF VAL(C$)=3 THEN KY$="CF":H$="FAST FOODS":GOTO 5450 ELSE
  72. 5407  IF VAL(C$)=4 THEN KY$="CL":H$="SANDWICHES & LUNCH FOODS":GOTO 5450 ELSE IF VAL(C$)=5 THEN KY$="CM":H$="MEATS/POULTRY/FISH":GOTO 5450 ELSE IF VAL(C$)=6 THEN KY$="CS":H$="SOUPS/SALADS":GOTO 5450 ELSE
  73. 5410  IF VAL(C$)=7 THEN KY$="CO":H$="OTHER COMBINATIONS":GOTO 5450 ELSE IF VAL(C$)=8 THEN KY$="C":H$="ENTIRE COMBINATION GROUP":GOTO 5450 ELSE GOTO 5400
  74. 5415  CLS:LOCATE 1,11:COLOR 15,0:PRINT "DISPLAY MISC/OTHER";:COLOR 7,0:LOCATE 5,3:PRINT "1 - ALCOHOL":LOCATE 6,3:PRINT "2 - BABY FOOD":LOCATE 7,3:PRINT "3 - DRINKS (UNSWEET)"
  75. 5420  LOCATE 8,3:PRINT "4 - CONDIMENTS/SPICES":LOCATE 9,3:PRINT "5 - OTHER":LOCATE 10,3:PRINT "6 - ENTIRE MISC/OTHER GROUP":RTN%=12:GOTO 5015
  76. 5425  LOCATE 12,1:PRINT "Choose a number ";:C$="":WHILE C$="":C$=INKEY$:WEND
  77. 5430  IF VAL(C$)=1 THEN KY$="MA":H$="ALCOHOL":GOTO 5450 ELSE IF VAL(C$)=2 THEN KY$="MB":H$="BABY FOOD":GOTO 5450 ELSE IF VAL(C$)=3 THEN KY$="MD":H$="DRINKS (UNSWEET)":GOTO 5450 ELSE
  78. 5435  IF VAL(C$)=4 THEN KY$="MC":H$="CONDIMENTS/SPICES":GOTO 5450 ELSE IF VAL(C$)=5 THEN KY$="MO":H$="OTHER MISC FOODS":GOTO 5450 ELSE IF VAL(C$)=6 THEN KY$="M":H$="ENTIRE MISC/OTHER GROUP":GOTO 5450 ELSE GOTO 5425
  79. 5450  CHAIN "SORTNUT",5450,ALL
  80. 5500  CHAIN "SORTNUT",5500,ALL
  81. 5700  ON ERROR GOTO 0
  82. 5710  CLS:WIDTH 80:LOCATE 1,26:COLOR 15,0:PRINT "DISPLAY FOOD INTAKE ANALYSIS";:COLOR 7,0
  83. 5720  LOCATE 4,1:PRINT "Please enter the following:":PRINT:INPUT "NAME (First Last): ",NAM$:IF NAM$="" THEN 5010 ELSE INPUT "DATE (MM-DD-YY):   ",DAT$:IF DAT$="" THEN 5720
  84. 5725  L%=LEN(NAM$)-INSTR(NAM$," "):IF L%>3 THEN L%=3
  85. 5730  FOR X%=1 TO L%:SURNAM$=SURNAM$+CHR$(ASC(MID$(NAM$,INSTR(NAM$," ")+X%))):NEXT
  86. 5735  NAMDAT$=NAMDAT$+LEFT$(NAM$,1)+SURNAM$+LEFT$(DAT$,2)+RIGHT$(DAT$,2)
  87. 5740  ON ERROR GOTO 5910
  88. 5745  OPEN DRV$+NAMDAT$ FOR INPUT AS #2
  89. 5750  FOR Y%=4 TO 10:LOCATE Y%,1:PRINT SPACE$(80);:NEXT
  90. 5753  LOCATE 2,32:COLOR 15,0:PRINT "(DAILY  AVERAGE)";:COLOR 7,0
  91. 5755  INPUT #2,NAM$,DAT$,ACI$,AGE,SEX$,PREG$
  92. 5757  LOCATE 3,1:PRINT NAM$:LOCATE 4,1:PRINT "Intake Date: ";DAT$:LOCATE 5,1:IF ACI$="I" THEN PRINT "Age (mos):";INT(AGE*12); ELSE PRINT "Age (yrs):";AGE;
  93. 5759  IF SEX$="M" THEN PRINT "  Sex: male" ELSE PRINT "  Sex: female"
  94. 5760  IF SEX$="M" OR SEX$="F" AND PREG$="N" OR PREG$="" THEN 5775
  95. 5763  IF PREG$="L" THEN INPUT #2,LM:GOTO 5767
  96. 5765  IF PREG$="P" OR PREG$="B" THEN INPUT #2,PW,WT,PPWT,PWT,HT:LOCATE 3,30:PRINT"Height (in):";HT;TAB(50) "Prepregnant Wt:";PPWT:LOCATE 4,30:PRINT "Weight (lb):";WT;TAB(50) "Expected Wt:   ";INT(PWT):IF PREG$="B" THEN INPUT #2,LM
  97. 5766  LOCATE 5,30:PRINT "Weeks Pregnant:";PW:IF LM THEN LOCATE 5,50:PRINT "Months Lactating:";LM:GOTO 5800:ELSE GOTO 5800
  98. 5767  IF AGE=>19 THEN INPUT #2,WT,HT,SML$,C%:IF AGE=>25 AND AGE<=59 AND HT=>58 AND HT<=72 THEN INPUT #2,WTRNG$:GOTO 5780 ELSE INPUT #2,IBW:GOTO 5780
  99. 5768  GOTO 5787
  100. 5775  IF AGE<19 THEN 5787 ELSE INPUT #2,WT,HT,SML$,C%:IF AGE=>25 AND AGE<=59 THEN 5777 ELSE INPUT #2,IBW:GOTO 5780
  101. 5777  IF SEX$="M" AND HT=>62 AND HT<=76 THEN 5779 ELSE IF SEX$="F" AND HT=>58 AND HT<=72 THEN 5779 ELSE INPUT #2,IBW:GOTO 5780
  102. 5779  INPUT #2,WTRNG$
  103. 5780  LOCATE 3,30:PRINT "Height (in):";HT;TAB(50) "Frame: ";:IF SML$="S" THEN PRINT "   small" ELSE IF SML$="M" THEN PRINT "   medium" ELSE PRINT "   large"
  104. 5783  LOCATE 4,30:PRINT "Weight (lb):";WT;TAB(50) "Activity: ";:IF C%=1 THEN PRINT "sedentary"; ELSE IF C%=2 THEN PRINT "light" ELSE IF C%=3 THEN PRINT "moderate" ELSE PRINT "heavy"
  105. 5785  LOCATE 5,30:IF WTRNG$<>"" THEN PRINT "WtRange: ";WTRNG$ ELSE PRINT "Ideal Wt:";INT(IBW)
  106. 5787  IF AGE<19 THEN INPUT #2,WT,HT,WTP$,HTP$:LOCATE 3,30:IF ACI$="I" THEN PRINT "Length (in):";HT;TAB(50) "LtPercentile: ";HTP$ ELSE PRINT "Height (in):";HT;TAB(50) "HtPercentile: ";HTP$
  107. 5790  IF AGE<19 THEN LOCATE 4,30:PRINT "Weight (lb):";WT;TAB(50) "WtPercentile: ";WTP$
  108. 5795  IF LM THEN LOCATE 5,50:PRINT "Months Lactating:";LM
  109. 5800  DIM PCT(17),SCALE%(17),NUT$(17)
  110. 5804  RESTORE 5807
  111. 5805  FOR J%=1 TO 17:READ NUT$(J%):NEXT
  112. 5807  DATA FD.ENERGY,PROTEIN,CALCIUM,IRON,MAGNESIUM,PHOSPHORUS,ZINC,VIT. C,THIAMIN,RIBOFLAVIN,NIACIN,B-6,FOLACIN,B-12,VIT. A,VIT. E,CHOLESTEROL
  113. 5810  INPUT #2,KY$:IF KY$="PCT=" THEN 5815 ELSE GOTO 5810
  114. 5815  FOR I%=1 TO 17:INPUT #2,PCT(I%):IF PCT(I%)<=100 THEN SCALE%(I%)=PCT(I%)/100*43
  115. 5820  IF PCT(I%)>100 AND PCT(I%)<=300 THEN SCALE%(I%)=PCT(I%)/300*15+43 ELSE IF PCT(I%)>300 THEN SCALE%(I%)=62
  116. 5821  NEXT
  117. 5822  CLOSE #2:LOCATE 6,1:PRINT STRING$(80,"-");
  118. 5823  J%=1:I%=1
  119. 5825  FOR Y%=7 TO 23
  120. 5830  LOCATE Y%,1:PRINT NUT$(J%);
  121. 5837  LOCATE Y%,13:PRINT USING "###_%_|";PCT(I%);:PRINT STRING$(SCALE%(I%),"X");
  122. 5840  I%=I%+1:J%=J%+1
  123. 5845  NEXT
  124. 5850  LOCATE 24,4:PRINT "% RDA --- ";CHR$(24);" ->" TAB(60) CHR$(24);"100%" TAB(75) CHR$(24);"300%";
  125. 5855  LOCATE 25,26:PRINT "Press SPACE BAR to continue";:SPC$="":WHILE SPC$="":SPC$=INKEY$:WEND:IF SPC$=" " THEN 5860 ELSE GOTO 5860
  126. 5860  NAM$="":SURNAM$="":NAMDAT$="":ERASE PCT,SCALE%,NUT$:GOTO 5700
  127. 5910  IF (ERR=53) AND (ERL=5745) THEN PRINT NAM$;"'s file not found.  Try Again.";:FOR C%=1 TO 3000:NEXT:LOCATE CSRLIN,1:PRINT SPACE$(80);
  128. 5915  NAM$="":SURNAM$="":NAMDAT$=""
  129. 5920  RESUME 5700
  130. 8010  DEF SEG=&H40:DIS%=(PEEK(16)AND 48)/16:IF DIS%=3 THEN DEF SEG=&HB000 ELSE DEF SEG=&HB800
  131. 8020  DIM LN$(5):ORIGY%=CSRLIN:ORIGX%=POS(0)
  132. 8060  N%=1:FOR O%=13 TO 17:LN$(N%)="":FOR X%=1 TO 40:LN$(N%)=LN$(N%)+CHR$(SCREEN(O%,X%)):NEXT X%:N%=N%+1:LOCATE 13,1:COLOR 0,7:PRINT "...SAVING TEXT...";:COLOR 7,0:NEXT
  133. 8070  LOCATE 13,1:PRINT CHR$(218);STRING$(38,196);CHR$(191);
  134. 8080  FOR O%=14 TO 16:LOCATE O%,1:PRINT CHR$(179);SPACE$(38);CHR$(179);:NEXT
  135. 8090  LOCATE 17,1:PRINT CHR$(192);STRING$(38,196);CHR$(217);:LOCATE 14,7:PRINT "NUTRIENT HELP: "
  136. 8100  LOCATE 15,2:PRINT "HELP ROUTINE PENDING RECEIPT";:LOCATE 16,2:PRINT "OF REQUESTED PAYMENT";:FOR X%=1 TO 5000:NEXT
  137. 8607  FOR O%=17 TO 13 STEP -1:LOCATE O%,1:N%=N%-1:PRINT LN$(N%);:NEXT
  138. 8610  ERASE LN$:IF Z%=0 THEN 940 ELSE LOCATE ORIGY%,ORIGX%:RETURN
  139. 9000  WIDTH 40:IF RTN%>3 THEN 5200 ELSE IF RTN%=2 OR RTN%=3 THEN 5100 ELSE IF RTN%=1 THEN 5012
  140. 9010  CLS:LOCATE 3,13,0:PRINT "Please Wait ... ":CLOSE #2:CHAIN "NUTRIENT",940,ALL
  141.