home *** CD-ROM | disk | FTP | other *** search
/ Colossal Cookbook / ColossalCookbook.cdr / diet / nutmg / nutrient.bas (.txt) < prev    next >
Encoding:
GW-BASIC  |  1986-03-07  |  29.6 KB  |  339 lines
  1. 10  REM  NUTRIENT                      (C)Copyright 1986 Bob Savryk
  2. 704  CLEAR:DEF SEG=0:POKE 1047, PEEK(1047) OR 64:OPTION BASE 1:Z%=-1:ZZ%=0
  3. 705  CLS:KEY OFF:FOR I%=1 TO 10:KEY I%, "":NEXT:WIDTH 40:ON KEY(1) GOSUB 8010:ON KEY(10) GOSUB 940:KEY(1) ON:KEY(10) ON:GOSUB 31005
  4. 707  GET #1,LOF(1)/121:MAX%=LOC(1):MNR%=0.8*MAX%
  5. 710  SCREEN 0,1,0:LOCATE 3,15,0:COLOR 15,0:PRINT "WELCOME TO";:LOCATE 5,16: PRINT "NUTRIENT";:COLOR 7,0:LOCATE 8,3:PRINT "(C)Copyright 1986 Robert F. Savryk":LOCATE 9,10:PRINT "All  Rights  Reserved"
  6. 711  LOCATE 11,10:PRINT "$35 payment requested"
  7. 712  LOCATE 12,4:PRINT "(please copy & share with others)":LOCATE 14,14:PRINT "Robert Savryk":LOCATE 15,11:PRINT "C/O NUTRITION QUEST":LOCATE 16,14:PRINT "P.O. BOX 3025":LOCATE 17,11:PRINT "San Luis Obispo, CA":LOCATE 18,18:PRINT "93403"
  8. 714  'COLOR 0,7:LOCATE 24,7:PRINT "Press SPACE BAR to continue";:COLOR 7,0
  9. 715  LOCATE 24,1:PRINT "Which Disk Drive for";:LOCATE 25,1:PRINT "Personal Data Files (A,B,C or...)? ";:INPUT "",DRV$:DRV$=DRV$+CHR$(58)
  10. 720  CLS:LOCATE 3,14:COLOR 15,0:PRINT "INITIAL SCREEN";:LOCATE 7,4:COLOR 7,0:PRINT "1 - Directions       2 - Main Menu":LOCATE 9,4: PRINT "Please choose a number (1 or 2)? "
  11. 721  C$="":WHILE C$="":C$=INKEY$:WEND:ON VAL(C$) GOTO 724,940
  12. 722  GOTO 720
  13. 724  COLOR 7,0,0: CLS: WIDTH 80
  14. 725  LOCATE 1,25:COLOR 15,0:PRINT "INTRODUCTION/DIRECTIONS";:COLOR 7,0:LOCATE 4,12,0:PRINT "1. SYSTEM REQUIREMENTS - NUTRIENT runs on:":LOCATE 5,15:PRINT "IBM-PC/PCjr/DOS 2.0+/BASICA/1 320KB drive/128K RAM,"
  15. 726  LOCATE 6,15:PRINT "Printer (EPSON MX-80 or compatible), Monitor":LOCATE 7,15:PRINT "(monochrome or color).  If your system is IBM":LOCATE 8,15:PRINT "compatible, NUTRIENT may also run."
  16. 727  LOCATE 9,12:PRINT "2. FOODFILE - This is the main data file.  A print-":LOCATE 10,15:PRINT "out of FOODFILE is necessary.  Access it from"
  17. 728  LOCATE 11,15:PRINT "the Main Menu, selection 5 or 6.":LOCATE 12,12:PRINT "3. PROMPTS - There will be a prompt line at the":LOCATE 13,15:PRINT "bottom of various screens (F1 HELP, etc.).  Use"
  18. 729  LOCATE 14,15:PRINT "the function keys for your control.":LOCATE 15,12:PRINT "4. READNUT.DOC - This is a text/documentation file.":LOCATE 16,15:PRINT "Please read for more detailed instruction."
  19. 730  LOCATE 17,12:PRINT "5. INPUT - Two types of data are used:":LOCATE 18,15:PRINT "   i. Personal Data":LOCATE 19,15:PRINT "  ii. Food & Quantity Data":LOCATE 20,15:PRINT "DO NOT WRITE PROTECT DATA DISK."
  20. 731  LOCATE 21,12:PRINT "6. HELP - to access help routines, press key: F1":LOCATE 22,12:PRINT "7. PRINT THIS SCREEN - by pressing keys: Shft-PrtSc"
  21. 732  LOCATE 25,22:PRINT "Press space bar to continue ...";
  22. 735  SPC$=INKEY$:IF SPC$="" THEN 735
  23. 940  COMMON Z%,MAX%,MNR%,ANR%,F$,DRV$,KY$,H$
  24. 941  IF Z%=1 THEN Z%=0:ERASE PER$,PLB,RF%,FD$,UNIT$,QTY,NUT,DAY,DAYS,AVG,PCT,P%,C%,HILO%,PS%,CT% ELSE IF Z%=2 THEN Z%=0:ERASE DAT$,PO%,CO% ELSE IF Z%=4 THEN Z%=0:ERASE DI$,P%,C% ELSE Z%=0
  25. 945  SCREEN 0,1:COLOR 15,0:WIDTH 40:CLS:LOCATE 5,3:PRINT "NUTRIENT'S MENU";:COLOR 7,0
  26. 950  LOCATE 7,3,0:PRINT  "1 - FOOD INTAKE ANALYSIS":LOCATE 8,3,0:PRINT  "2 - ADD A FOOD":LOCATE 9,3,0:PRINT  "3 - DELETE A FOOD"
  27. 956  LOCATE 10,3,0:PRINT "4 - CHANGE A FOOD":LOCATE 11,3,0:PRINT "5 - DISPLAY: A FOOD/FOODFILE/ANALYSIS":LOCATE 12,3,0:PRINT "6 - PRINT:   A FOOD/FOODFILE/ANALYSIS"
  28. 962  LOCATE 13,3,0:PRINT "7 - HELP":LOCATE 15,3,0:PRINT "8 - EXIT NUTRIENT":PRINT
  29. 970  INPUT "CHOOSE A NUMBER FROM 1 - 8"; CHOICE%:WHILE CHOICE% <1 OR CHOICE% >8:PRINT:INPUT "CHOOSE ONLY NUMBERS FROM 1 - 8 PLEASE"; CHOICE%:WEND
  30. 990  ON CHOICE% GOTO 1005,2005,3010,4010,5010,6010,8010,32010:GOTO 940
  31. 1005  Z%=1:ZZ%=1:DIM PER$(14),PLB(22),RF%(3,45),FD$(3,45),UNIT$(3,45),QTY(3,45),NUT(46,27),DAY(4,27),DAYS(27),AVG(27),PCT(27),P%(27),C%(27),HILO%(26),PS%(27),CT%(27)
  32. 1007  FOR I%=1 TO 14:PER$(I%)="":NEXT:PREG$="":PW=0:LM=0:PPWT=0:SML$="":SURNAM$="":NAMDAT$="":WTRNG$=""
  33. 1009  CLS:WIDTH 80:LOCATE 1,30:COLOR 15,0:PRINT "FOOD INTAKE ANALYSIS";:LOCATE 2,32:PRINT "(Personal  Data)";:COLOR 7,0
  34. 1010  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 940:KEY(1) ON:KEY(10) ON
  35. 1015  LOCATE 4,1:PRINT "Please enter the following:":PRINT:PRINT "NAME (First Last): ";:I%=1:C%=0:GOTO 1063
  36. 1017  NAM$=PER$(1):LOCATE 7,1:PRINT "DATE (MM-DD-YY):   ";:I%=2:C%=0:GOTO 1063
  37. 1019  DAT$=PER$(2):LOCATE 8,1:PRINT "ADULT, CHILD or INFANT (A, C or I): ";:I%=3:C%=0:GOTO 1063
  38. 1021  ACI$=PER$(3):IF ACI$="I" THEN LOCATE 9,1:PRINT "AGE (months):      ";:I%=4:C%=0:GOTO 1063 ELSE LOCATE 9,1:PRINT "AGE (years):       ";:I%=4:C%=0:GOTO 1063
  39. 1023  AGE=VAL(PER$(4)):LOCATE 10,1:PRINT "SEX (M or F):      ";:I%=5:C%=0:GOTO 1063
  40. 1025  SEX$=PER$(5):IF SEX$="F" AND AGE<11 OR SEX$="M" THEN Y%=11:GOTO 1035 ELSE LOCATE 11,1:PRINT "PREGNANT, LACTATING, BOTH or NO (P, L, B or N): ";:I%=6:C%=0:GOTO 1063
  41. 1027  PREG$=PER$(6):IF PREG$="N" THEN Y%=12:ELSE IF PREG$="B" THEN LOCATE 12,1:PRINT "  No. of pregnant weeks:  ";:I%=7:C%=0:GOTO 1063
  42. 1029  IF PREG$="B" THEN PW=VAL(PER$(7)):LOCATE 13,1:PRINT "  No. of lactating months: ";:I%=8:C%=0:GOTO 1063
  43. 1031  IF PREG$="B" THEN Y%=14:LM=VAL(PER$(8)):ELSE IF PREG$="P" THEN Y%=13:LOCATE 12,1:PRINT "  No. of pregnant weeks: ";:I%=9:C%=0:GOTO 1063
  44. 1033  IF PREG$="P" THEN PW=VAL(PER$(9)):ELSE IF PREG$="L" THEN Y%=13:LOCATE 12,1:PRINT "  No. of lactating months: ";:I%=10:C%=0:GOTO 1063
  45. 1035  LOCATE Y%,1:PRINT "WEIGHT (lbs.):     ";:I%=11:C%=0:IF PREG$="L" THEN LM=VAL(PER$(10)):GOTO 1063:ELSE GOTO 1063
  46. 1037  WT=VAL(PER$(11)):IF PREG$="P" OR PREG$="B" THEN Y%=Y%+1:LOCATE Y%,1:PRINT "  Prepregnant weight:    ";:I%=12:C%=0:GOTO 1063
  47. 1039  PPWT=VAL(PER$(12)):IF ACI$="I" THEN LOCATE Y%+1,1:PRINT "LENGTH (inches/no shoes): ";:I%=13:C%=0:GOTO 1063 ELSE LOCATE Y%+1,1:PRINT "HEIGHT (inches/no shoes): ";:I%=13:C%=0:GOTO 1063
  48. 1041  HT=VAL(PER$(13)):IF AGE<19 THEN 1043 ELSE LOCATE Y%+2,1:PRINT "FRAME: Small, Medium or Large (S, M or L): ";:I%=14:C%=0:GOTO 1063
  49. 1042  SML$=PER$(14)
  50. 1043  L%=LEN(NAM$)-INSTR(NAM$," "):IF L%>3 THEN L%=3
  51. 1045  FOR X%=1 TO L%:SURNAM$=SURNAM$+CHR$(ASC(MID$(NAM$,INSTR(NAM$," ")+X%))):NEXT
  52. 1047  NAMDAT$=NAMDAT$+LEFT$(NAM$,1)+SURNAM$+LEFT$(DAT$,2)+RIGHT$(DAT$,2)
  53. 1049  IF ACI$="I" THEN AGE=AGE/12
  54. 1051  WT1=WT/2.2
  55. 1053  PPWT1=PPWT/2.2
  56. 1055  IF PW<=13 THEN PWT=PPWT*1.017 ELSE IF PW>13 THEN PWT=(PPWT*1.017)*(((PW-13)*0.00678)+1)
  57. 1057  HT1=HT*2.54: HT2=(HT1/100)^2:IF AGE<19 THEN 1125 ELSE GOTO 1077
  58. 1063  A$=INKEY$:IF A$="" THEN 1063
  59. 1065  IF A$=CHR$(13) AND C%=0 THEN 1074 ELSE C%=1
  60. 1067  IF A$=CHR$(13) AND C%=1 THEN I%=I%+1:GOTO 1076
  61. 1068  IF A$=CHR$(8) THEN 1072
  62. 1069  IF A$=CHR$(0)+CHR$(72) OR A$=CHR$(0)+CHR$(80) THEN BEEP:GOTO 1063
  63. 1071  IF ASC(A$)>31 THEN PRINT A$;:PER$(I%)=PER$(I%)+A$:GOTO 1063:ELSE GOTO 1063
  64. 1072  IF LEN (PER$(I%))=0 THEN BEEP:GOTO 1063
  65. 1073  LOCATE CSRLIN,POS(0)-1:PRINT " ";:LOCATE CSRLIN,POS(0)-1:PER$(I%)=LEFT$(PER$(I%),LEN(PER$(I%))-1):GOTO 1063
  66. 1074  IF I%=1 AND C%=0 THEN 940
  67. 1075  I%=I%-1:IF PER$(I%)<>"" THEN PER$(I%)="":GOTO 1076 ELSE GOTO 1075
  68. 1076  ON I% GOTO 1015,1017,1019,1021,1023,1025,1027,1029,1031,1033,1035,1037,1039,1041,1042
  69. 1077  IF SEX$="M" AND AGE<25 OR AGE>59 THEN 1100 ELSE IF SEX$="M" AND AGE=>25 AND AGE<=59 THEN IF HT<62 OR HT>76 THEN 1100 ELSE GOTO 1080
  70. 1079  IF PREG$="P" OR PREG$="B" THEN 1305 ELSE IF SEX$="F" AND AGE<25 OR AGE>59 THEN 1105 ELSE IF SEX$="F" AND AGE=>25 AND AGE<=59 THEN IF HT<58 OR HT>72 THEN 1105 ELSE GOTO 1090
  71. 1080  IF SEX$="M" THEN HT=HT+1:R%=0:FOR I%=62 TO 76:R%=R%+1:IF (HT>=I%) AND (HT<I%+1) THEN RM%=R% ELSE NEXT
  72. 1090  IF SEX$="F" THEN HT=HT+1:R%=15:FOR I%=58 TO 72:R%=R%+1:IF (HT>=I%) AND (HT<I%+1) THEN RM%=R% ELSE NEXT
  73. 1095  OPEN "METRO.DAT" AS #2 LEN=23:FIELD #2, 23 AS M$:GET #2, RM%:CLOSE #2:IF SML$="S" THEN WTRNG$=MID$(M$,3,7) ELSE IF SML$="M" THEN WTRNG$=MID$(M$,10,7) ELSE WTRNG$=MID$(M$,17,7)
  74. 1100  IF SEX$="M" AND AGE=>19 THEN IBW1=HT2*22.4+1:IBW=IBW1*2.2:GOTO 1305
  75. 1105  IF SEX$="F" AND AGE=>19 THEN IF PREG$="N" OR PREG$="L" THEN IBW1=HT2*20.9+0.45:IBW=IBW1*2.2:GOTO 1305
  76. 1125  IF AGE=>19 THEN 1305 ELSE IF (AGE>0) AND (AGE<0.25) THEN RC%=1:GOTO 1150 ELSE IF (AGE>=0.25) AND (AGE<0.5) THEN RC%=2:GOTO 1150 ELSE IF (AGE>=0.5) AND (AGE<0.75) THEN RC%=3:GOTO 1150
  77. 1130  IF (AGE>=0.75) AND (AGE<1) THEN RC%=4:GOTO 1150 ELSE IF (AGE>=1) AND (AGE<1.5) THEN RC%=5:GOTO 1150 ELSE IF (AGE>=1.5) AND (AGE<2) THEN RC%=6
  78. 1140  R%=6:FOR I%=2 TO 18:R%=R%+1:IF (AGE>=I%) AND (AGE<I%+1) THEN RC%=R%:GOTO 1150 ELSE NEXT
  79. 1150  OPEN "CHILD.DAT" AS #2 LEN=66:FIELD #2, 66 AS C$:GET #2, RC%:CLOSE #2
  80. 1155  IF SEX$<>"M" THEN 1174 ELSE IF WT1>VAL(MID$(C$,17,5)) THEN WTP$=">95th" ELSE      IF WT1>=VAL(MID$(C$,12,5)) AND WT1<VAL(MID$(C$,17,5)) THEN WTP=(WT1-VAL(MID$(C$,12,5)))/(VAL(MID$(C$,17,5))-VAL(MID$(C$,12,5)))*45+50:WTP$=STR$(INT(WTP)):ELSE
  81. 1160  IF WT1>=VAL(MID$(C$,7,5)) AND WT1<VAL(MID$(C$,12,5)) THEN WTP=(WT1-VAL(MID$(C$,7,5)))/(VAL(MID$(C$,12,5))-VAL(MID$(C$,7,5)))*45+5:WTP$=STR$(INT(WTP)):ELSE IF WT1<VAL(MID$(C$,7,5)) THEN WTP$="<5th"
  82. 1165  IF SEX$="M" AND HT1>VAL(MID$(C$,32,5)) THEN HTP$=">95th" ELSE IF HT1>=VAL(MID$(C$,27,5)) AND HT1<VAL(MID$(C$,32,5)) THEN HTP=(HT1-VAL(MID$(C$,27,5)))/(VAL(MID$(C$,32,5))-VAL(MID$(C$,27,5)))*45+50:HTP$=STR$(INT(HTP)):ELSE
  83. 1170  IF HT1>=VAL(MID$(C$,22,5)) AND HT1<VAL(MID$(C$,27,5)) THEN HTP=(HT1-VAL(MID$(C$,22,5)))/(VAL(MID$(C$,27,5))-VAL(MID$(C$,22,5)))*45+5:HTP$=STR$(INT(HTP)):ELSE IF HT1<VAL(MID$(C$,22,5)) THEN HTP$="<5th"
  84. 1174  IF SEX$="F" AND PREG$="P" OR PREG$="B" THEN GOTO 1305 ELSE IF SEX$="M" THEN 1460
  85. 1175  IF SEX$="F" AND WT1>=VAL(MID$(C$,47,5)) THEN WTP$=">95th" ELSE IF WT1>=VAL(MID$(C$,42,5)) AND WT1<VAL(MID$(C$,47,5)) THEN WTP=(WT1-VAL(MID$(C$,42,5)))/(VAL(MID$(C$,47,5))-VAL(MID$(C$,42,5)))*45+50:WTP$=STR$(INT(WTP)):ELSE
  86. 1180  IF WT1>VAL(MID$(C$,37,5)) AND WT1<VAL(MID$(C$,42,5)) THEN WTP=(WT1-VAL(MID$(C$,37,5)))/(VAL(MID$(C$,42,5))-VAL(MID$(C$,37,5)))*45+5:WTP$=STR$(INT(WTP)):ELSE IF WT1<VAL(MID$(C$,37,5)) THEN WTP$="<5th"
  87. 1185  IF SEX$="F" AND HT1>=VAL(MID$(C$,62,5)) THEN HTP$=">95th" ELSE IF HT1>=VAL(MID$(C$,57,5)) AND HT1<VAL(MID$(C$,62,5)) THEN HTP=(HT1-VAL(MID$(C$,57,5)))/(VAL(MID$(C$,62,5))-VAL(MID$(C$,57,5)))*45+50:HTP$=STR$(INT(HTP)) ELSE
  88. 1190  IF HT1>=VAL(MID$(C$,52,5)) AND HT1<VAL(MID$(C$,57,5)) THEN HTP=(HT1-VAL(MID$(C$,52,5)))/(VAL(MID$(C$,57,5))-VAL(MID$(C$,52,5)))*45+5:HTP$=STR$(INT(HTP)):ELSE IF HT1<VAL(MID$(C$,52,5)) THEN HTP$="<5th"
  89. 1305  IF SEX$<>"F" OR SEX$="F" AND AGE<11 THEN 1460 ELSE
  90. 1307  IF (AGE>=19) AND (AGE<23) THEN RR%=14:RE%=14:GOTO 1315 ELSE IF (AGE>=15) AND (AGE<19) THEN RR%=13:RE%=13:GOTO 1315 ELSE IF (AGE>=23) AND (AGE<51) THEN RR%=15:RE%=15:GOTO 1315
  91. 1310  IF (AGE>=11) AND (AGE<15) THEN RR%=12:RE%=12:GOTO 1315 ELSE IF (AGE>=51) AND (AGE<76) THEN RR%=16:RE%=16:GOTO 1315 ELSE IF (AGE>=76) THEN RR%=17:RE%=17
  92. 1315  IF PREG$="N" OR PREG$="" THEN GOTO 1510
  93. 1320  OPEN "ENERGY.DAT" AS #2 LEN = 14:FIELD #2, 14 AS E$:GET #2, RE%:CLOSE #2
  94. 1325  IF PREG$="P" THEN PKCAL=VAL(MID$(E$,12,3))*WT1+300:PKCAL1=VAL(MID$(E$,12,3))*(PWT/2.2)+300 ELSE IF PREG$="L" THEN LKCAL=VAL(MID$(E$,12,3))*WT1+500 ELSE PLKCAL=VAL(MID$(E$,12,3))*WT1+800
  95. 1335  OPEN "RDA.DAT" AS #2 LEN = 86:FIELD #2, 86 AS R$:GET #2, RR%:CLOSE #2
  96. 1340  IF PREG$<>"P" THEN GOTO 1360 ELSE PLB(3)=VAL(MID$(R$,12,3))*WT1+30:PLB(21)=VAL(MID$(R$,15,4))+1000:D=VAL(MID$(R$,19,3))+200:PLB(22)=VAL(MID$(R$,22,3))+3
  97. 1345  PLB(14)=VAL(MID$(R$,25,2))+20:PLB(15)=VAL(MID$(R$,27,3))+0.4:PLB(16)=VAL(MID$(R$,30,3))+0.3:PLB(17)=VAL(MID$(R$,33,2))+2:PLB(18)=VAL(MID$(R$,35,3))+0.6:PLB(19)=VAL(MID$(R$,38,3))+400
  98. 1350  PLB(20)=VAL(MID$(R$,41,3))+1:PLB(7)=VAL(MID$(R$,44,4))+400:PLB(10)=VAL(MID$(R$,48,4))+400:PLB(9)=VAL(MID$(R$,52,3))+150:PLB(8)=VAL(MID$(R$,55,2))+45:PLB(13)=VAL(MID$(R$,57,2))+5
  99. 1355  IO=VAL(MID$(R$,58,3))+25:FL$="1.5-4":NA$="1100-1300":K$="1875-5625"
  100. 1360  IF PREG$<>"L" THEN GOTO 1385 ELSE PLB(3)=VAL(MID$(R$,12,3))*WT1+20:PLB(21)=VAL(MID$(R$,15,4))+2000:D=VAL(MID$(R$,19,3))+200:PLB(22)=VAL(MID$(R$,22,3))+4.5
  101. 1365  PLB(14)=VAL(MID$(R$,25,2))+40:PLB(15)=VAL(MID$(R$,27,3))+0.5:PLB(16)=VAL(MID$(R$,30,3))+0.5:PLB(17)=VAL(MID$(R$,33,2))+5:PLB(18)=VAL(MID$(R$,35,3))+0.5:PLB(19)=VAL(MID$(R$,38,3))+100
  102. 1370  PLB(20)=VAL(MID$(R$,41,3))+1:PLB(7)=VAL(MID$(R$,44,4))+400:PLB(10)=VAL(MID$(R$,48,4))+400:PLB(9)=VAL(MID$(R$,52,3))+150:IF LM<=3 THEN PLB(8)=VAL(MID$(R$,55,2))+45 ELSE PLB(8)=VAL(MID$(R$,55,2))
  103. 1375  PLB(13)=VAL(MID$(R$,57,2))+10:IO=VAL(MID$(R$,59,3))+50:FL$="1.5-4":NA$="1100-1300":K$="1875-5625":GOTO 1510
  104. 1385  IF PREG$<>"B" THEN GOTO 1565 ELSE PLB(3)=VAL(MID$(R$,12,3))*WT1+50:PLB(21)=VAL(MID$(R$,15,4))+3000:D=VAL(MID$(R$,19,3))+400:PLB(22)=VAL(MID$(R$,22,3))+7.5
  105. 1390  PLB(14)=VAL(MID$(R$,25,2))+60:PLB(15)=VAL(MID$(R$,27,3))+0.9:PLB(16)=VAL(MID$(R$,30,3))+0.8:PLB(17)=VAL(MID$(R$,33,2))+7:PLB(18)=VAL(MID$(R$,35,3))+1.1:PLB(19)=VAL(MID$(R$,38,3))+500
  106. 1400  PLB(20)=VAL(MID$(R$,41,3))+2:PLB(7)=VAL(MID$(R$,44,4))+800:PLB(10)=VAL(MID$(R$,48,4))+800:PLB(9)=VAL(MID$(R$,52,3))+300:PLB(8)=VAL(MID$(R$,55,2))+45
  107. 1405  PLB(13)=VAL(MID$(R$,57,2))+15:IO=VAL(MID$(R$,59,3))+75:FL$="1.5-4":NA$="1100-1300":K$="1875-5625":GOTO 1565
  108. 1460  IF (AGE>=23) AND (AGE<50) THEN RR%=9:RE%=9:GOTO 1510 ELSE IF (AGE>=19) AND (AGE<23) THEN RR%=8:RE%=8:GOTO 1510 ELSE IF (AGE>=15) AND (AGE<19) THEN RR%=7:RE%=7:GOTO 1510
  109. 1470  IF (AGE>=51) AND (AGE<76) THEN RR%=10:RE%=10:GOTO 1510 ELSE IF (AGE>=11) AND (AGE<15) THEN RR%=6:RE%=6:GOTO 1510 ELSE IF (AGE>=76) THEN RR%=11:RE%=11:GOTO 1510
  110. 1480  IF (AGE>=7) AND (AGE<11) THEN RR%=5:RE%=5:GOTO 1510 ELSE IF (AGE>=4) AND (AGE<7) THEN RR%=4:RE%=4:GOTO 1510 ELSE IF (AGE>=1) AND (AGE<4) THEN RR%=3:RE%=3:GOTO 1510
  111. 1490  IF (AGE>=0.5) AND (AGE<1) THEN RR%=2:RE%=2:GOTO 1510 ELSE IF (AGE>0) AND (AGE<0.5) THEN RR%=1:RE%=1
  112. 1510  IF AGE <19 GOTO 1550 ELSE IF SEX$="F" AND AGE>=19 THEN IF PREG$="N" THEN SS=HT1/(IBW1^0.3333):BMR=65.8*(IBW1^0.75)*(1+0.004*(30-AGE)+0.018*(SS-42.1)) ELSE IF SEX$="F" AND PREG$<>"N" THEN 1565
  113. 1515  IF SEX$="M" AND AGE>=19 THEN SS=HT1/(IBW1^0.3333):BMR=71.2*(IBW1^0.75)*(1+0.004*(30-AGE)+0.01*(SS-43.4))
  114. 1520  ZZ%=21:CLS:LOCATE 3,13:PRINT "DAILY ESTIMATED":LOCATE 4,13:PRINT "ACTIVITY  LEVEL":LOCATE 6,9:PRINT "1 - Sedentary":LOCATE 7,9:PRINT "2 - Lightly active":LOCATE 8,9:PRINT "3 - Moderately active":LOCATE 9,9:PRINT "4 - Heavily active"
  115. 1540  LOCATE 25,1:COLOR 0,15:PRINT "F1";:COLOR 7,0:PRINT " HELP";:LOCATE 11,1,1:PRINT "Choose a number ";:C$="":WHILE C$="":C$=INKEY$:WEND
  116. 1543  IF VAL(C$)<1 OR VAL(C$)>4 THEN 1540 ELSE IF VAL(C$)=2 THEN ENERGY=BMR*1.5 ELSE IF VAL(C$)=3 THEN ENERGY=BMR*1.75 ELSE IF VAL(C$)=1 THEN ENERGY=BMR*1.3 ELSE ENERGY=BMR*2
  117. 1545  GOTO 1565
  118. 1550  OPEN "ENERGY.DAT" AS #2 LEN=14:FIELD #2, 14 AS E$:GET #2, RE%:CLOSE #2:ENERGY=VAL(MID$(E$,12,3))*WT1
  119. 1565  CLS:LOCATE 10,35,0:PRINT "PLEASE WAIT":RESTORE 1567
  120. 1567  FOR I%=1 TO 27:READ P%(I%),C%(I%):NEXT:DATA 32,4,36,4,40,3,43,3,46,3,49,3,52,4,56,3,59,3,62,4,66,4,70,4,74,3,77,3,80,3,83,3,86,3,89,3,92,4,96,3,99,5,104,3,107,3,110,3,113,3,116,3,119,3
  121. 1569  RESTORE 1570
  122. 1570  FOR I%=1 TO 27:READ PS%(I%),CT%(I%):NEXT:DATA 0,0,0,0,12,3,0,0,0,0,0,0,44,4,55,2,52,3,48,4,78,9,69,9,57,2,25,2,27,3,30,3,33,2,35,3,38,3,41,3,15,4,22,3,0,0,0,0,0,0,0,0,0,0
  123. 1580  CLS:WIDTH 40:LOCATE 1,12:COLOR 15,0:PRINT "FOOD INTAKE SCREEN";:COLOR 7,0
  124. 1585  LOCATE 3,1,1:INPUT "Number of days to analyze(1 to 3)? ",DAY%:IF (DAY%<1) OR (DAY%>3) THEN PRINT "Choose a number between 1 & 3, please":INPUT "Number of (Food Intake) days to analyze? ",DAY%
  125. 1587  FOR Y%=1 TO 7:LOCATE Y%,1:PRINT SPACE$(40);:NEXT
  126. 1590  FOR D%=1 TO DAY%:Q%=1
  127. 1600  LOCATE 25,1:COLOR 0,15:PRINT "F1";:COLOR 7,0:PRINT " HELP";:PRINT TAB(12);:COLOR 0,15:PRINT "F10";:COLOR 7,0:PRINT " EXIT";:PRINT TAB(24);
  128. 1603  COLOR 0,15:PRINT "ENTER";:COLOR 7,0:PRINT " END OF DAY";:ON KEY(1) GOSUB 8010:ON KEY(10) GOSUB 940:KEY(1) ON:KEY(10) ON
  129. 1605  ZZ%=23:COLOR 15,0:LOCATE 1,12:PRINT "FOOD INTAKE (DAY";D%;")":COLOR 7,0:PRINT "FOOD" TAB(36);"QTY":PRINT " NO. DESCRIPTION" TAB(27);"UNITS   EATEN":PRINT STRING$(39,"-"):Y%=5
  130. 1607  REC$="":LOCATE Y%,1,1
  131. 1608  RF$=INKEY$:IF RF$="" THEN 1608
  132. 1609  IF RF$=CHR$(13) AND REC$="" THEN 1660
  133. 1610  IF RF$=CHR$(13) THEN RF%=VAL(REC$):GET #1,RF%:GOTO 1615
  134. 1611  IF RF$=CHR$(8) THEN 1614
  135. 1612  IF RF$=CHR$(0)+CHR$(72) OR RF$=CHR$(0)+CHR$(80) THEN BEEP:GOTO 1608
  136. 1613  IF ASC(RF$)>47 AND ASC(RF$)<58 THEN PRINT RF$;:REC$=REC$+RF$:GOTO 1608:ELSE GOTO 1608
  137. 1614  IF LEN(REC$)=0 THEN BEEP:GOTO 1608:ELSE LOCATE CSRLIN,POS(0)-1:PRINT " ";:LOCATE CSRLIN,POS(0)-1:REC$=LEFT$(REC$,LEN(REC$)-1):GOTO 1608
  138. 1615  IF LEFT$(F$,1)=" " THEN LOCATE Y%,6:PRINT "Record no.";RF%;"is empty, try again";:FOR I%=1 TO 3000:NEXT:LOCATE Y%,1:PRINT SPACE$(39);:GOTO 1607
  139. 1620  LOCATE Y%,6:PRINT LEFT$(F$,20);:LOCATE Y%,27:PRINT MID$(F$,23,6);:LOCATE Y%,35,1:AMT$=""
  140. 1630  QTY$=INKEY$:IF QTY$="" THEN 1630
  141. 1631  IF QTY$=CHR$(13) AND AMT$="" THEN LOCATE Y%,1:PRINT SPACE$(39);:GOTO 1607
  142. 1632  IF QTY$=CHR$(13) THEN QTY(D%,Q%)=VAL(AMT$):GOTO 1640
  143. 1633  IF QTY$=CHR$(8) THEN 1637
  144. 1634  IF QTY$=CHR$(0)+CHR$(72) OR QTY$=CHR$(0)+CHR$(80) THEN BEEP:GOTO 1630
  145. 1635  IF ASC(QTY$)=46 OR ASC(QTY$)>47 AND ASC(QTY$)<58 THEN PRINT QTY$;:AMT$=AMT$+QTY$:GOTO 1630:ELSE GOTO 1630
  146. 1637  IF LEN (AMT$)=0 THEN BEEP:GOTO 1630
  147. 1638  LOCATE CSRLIN,POS(0)-1:PRINT " ";:LOCATE CSRLIN,POS(0)-1:AMT$=LEFT$(AMT$,LEN(AMT$)-1):GOTO 1630
  148. 1640  FOR I%=1 TO 27:NUT(Q%,I%)=QTY(D%,Q%)*VAL(MID$(F$,P%(I%),C%(I%))):NEXT
  149. 1645  RF%(D%,Q%)=RF%:FD$(D%,Q%)=LEFT$(F$,20):UNIT$(D%,Q%)=MID$(F$,23,6)
  150. 1650  Q%=Q%+1:IF Q%=21 OR Q%=41 THEN FOR Y%=5 TO 24:LOCATE Y%,1:PRINT SPACE$(39);:NEXT:Y%=5:GOTO 1607 ELSE Y%=Y%+1:GOTO 1607
  151. 1660  CLS:LOCATE 1,12:PRINT "CALCULATING DAY";D%:LOCATE 2,13:PRINT "NUTRIENT TOTALS":LOCATE 4,13,0:PRINT ".....WAIT.....":Q%=Q%-1
  152. 1665  FOR I%=1 TO 27:FOR J%=1 TO Q% STEP 2:DAY(D%,I%)=DAY(D%,I%)+NUT(J%,I%)+NUT(J%+1,I%):NEXT
  153. 1670  NEXT:IF D%=1 THEN GOSUB 1800 ELSE IF D%>1 THEN GOSUB 1815
  154. 1675  NEXT
  155. 1680  FOR I%=1 TO 27:DAYS(I%)=0:FOR D%=1 TO DAY% STEP 2:DAYS(I%)=DAYS(I%)+DAY(D%,I%)+DAY(D%+1,I%)
  156. 1690  NEXT:AVG(I%)=DAYS(I%)/DAY%:NEXT
  157. 1700  OPEN "RDA.DAT" AS #2 LEN=86:FIELD #2,86 AS R$:GET #2,RR%:CLOSE #2
  158. 1703  IF PREG$="P" OR PREG$="L" OR PREG$="B" THEN 1715
  159. 1705  PCT(2)=(AVG(2)/ENERGY)*100:PCT(3)=(AVG(3)/(VAL(MID$(R$,12,3))*IBW1))*100:FOR I%=7 TO 10:PCT(I%)=(AVG(I%)/VAL(MID$(R$,PS%(I%),CT%(I%))))*100:NEXT
  160. 1710  PCT(26)=(AVG(26)/300)*100:FOR I%=13 TO 22:PCT(I%)=(AVG(I%)/VAL(MID$(R$,PS%(I%),CT%(I%))))*100:NEXT:GOTO 1720
  161. 1715  IF PREG$="P" THEN PCT(2)=(AVG(2)/PKCAL)*100 ELSE IF PREG$="L" THEN PCT(2)=(AVG(2)/LKCAL)*100 ELSE IF PREG$="B" THEN PCT(2)=(AVG(2)/PLKCAL)*100
  162. 1716  PCT(3)=(AVG(3)/PLB(3))*100: FOR I%=7 TO 10:PCT(I%)=(AVG(I%)/PLB(I%))*100:NEXT
  163. 1717  PCT(26)=(AVG(26)/300)*100:FOR I%=13 TO 22:PCT(I%)=(AVG(I%)/PLB(I%))*100:NEXT
  164. 1720  PCHO=((AVG(5)*4)/AVG(2))*100:PPRO=((AVG(3)*4)/AVG(2))*100:PFAT=((AVG(4)*9)/AVG(2))*100:PALC=((AVG(27)*7)/AVG(2))*100:FACID=AVG(25)/AVG(23):CA.P=AVG(7)/AVG(10)
  165. 1730  IF SEX$="F" AND PREG$="P" OR PREG$="L" OR PREG$="B" THEN GOTO 1780 ELSE IF AVG(2)<(ENERGY-500) THEN HILO%(2)=-1 ELSE IF AVG(2)>(ENERGY+500) THEN HILO%(2)=1
  166. 1735  IF AGE<19 THEN IF (AVG(3)/WT1)<(0.8*VAL(MID$(R$,12,3))) THEN HILO%(3)=-1
  167. 1737  IF AGE=>19 THEN IF (AVG(3)/IBW1)<(0.8*VAL(MID$(R$,12,3))) THEN HILO%(3)=-1
  168. 1740  IF PFAT>35 THEN HILO%(4)=1
  169. 1745  FOR I%=7 TO 10:IF PCT(I%)<70 THEN HILO%(I%)=-1 ELSE IF PCT(I%)>300 THEN HILO%(I%)=1
  170. 1747  NEXT
  171. 1750  IF MID$(R$,81,1)="-" THEN IF AVG(11)<VAL(MID$(R$,78,3)) THEN HILO%(11)=-1 ELSE IF MID$(R$,81,1)="-" THEN IF AVG(11)>(3*VAL(MID$(R$,82,4))) THEN HILO%(11)=1 ELSE
  172. 1755  IF MID$(R$,82,1)="-" THEN IF AVG(11)<VAL(MID$(R$,78,4)) THEN HILO%(11)=-1 ELSE IF AVG(11)>(3*VAL(MID$(R$,83,4))) THEN HILO%(11)=1
  173. 1760  IF MID$(R$,72,1)="-" THEN IF AVG(12)>(2*VAL(MID$(R$,73,4))) THEN HILO%(12)=1 ELSE IF MID$(R$,73,1)="-" THEN IF AVG(12)>(2*VAL(MID$(R$,74,4))) THEN HILO%(12)=1
  174. 1765  FOR I%=13 TO 20:IF PCT(I%)<70 THEN HILO%(I%)=-1 ELSE IF PCT(I%)>1000 THEN HILO%(I%)=1
  175. 1767  NEXT
  176. 1770  FOR I%=21 TO 22:                                                                  IF PCT(I%)<70 THEN HILO%(I%)=-1 ELSE IF PCT(I%)>300 THEN HILO%(I%)=1
  177. 1772  NEXT
  178. 1775  IF PCT(26)>100 THEN HILO%(26)=1:GOTO 1830 ELSE GOTO 1830
  179. 1780  IF (AVG(2)<PKCAL-500) OR (AVG(2)<LKCAL-500) OR (AVG(2)<PLKCAL-500) THEN HILO%(2)=-1 ELSE IF (AVG(2)>PKCAL+500) OR (AVG(2)>LKCAL+500) OR (AVG(2)>PLKCAL+500) THEN HILO%(2)=1
  180. 1785  IF PCT(3)<70 THEN HILO%(3)=-1:GOTO 1740:ELSE GOTO 1740
  181. 1800  OPEN DRV$+NAMDAT$ FOR OUTPUT AS #2
  182. 1801  DY$="DAY=":TDY$="TOTDAY=":AVG$="AVG=":CAL$="CAL=":PCT$="PCT="
  183. 1803  WRITE #2,NAM$,DAT$,ACI$,AGE,SEX$,PREG$
  184. 1804  IF SEX$="M" OR SEX$="F" AND PREG$="N" OR PREG$="" THEN 1811
  185. 1805  IF PREG$="L" THEN WRITE #2,LM:GOTO 1811
  186. 1806  IF PREG$="P" OR PREG$="B" THEN WRITE #2,PW;WT;PPWT;PWT;HT:IF LM THEN WRITE #2,LM:GOTO 1814:ELSE GOTO 1814
  187. 1811  IF AGE=>19 THEN WRITE #2,WT;HT;SML$,C%:IF WTRNG$ <>"" THEN WRITE #2,WTRNG$ ELSE WRITE #2,IBW
  188. 1813  IF AGE<19 THEN WRITE #2,WT;HT;WTP$,HTP$
  189. 1814  WRITE #2,DAY%
  190. 1815  WRITE #2,DY$,Q%:FOR I%=1 TO Q%:IF RF%(D%,I%)=0 THEN 1820 ELSE WRITE #2,RF%(D%,I%);FD$(D%,I%),UNIT$(D%,I%),QTY(D%,I%):FOR J%=1 TO 27:WRITE #2,NUT(I%,J%):NEXT:NEXT
  191. 1820  WRITE #2,TDY$:FOR I%=1 TO 27:WRITE #2,DAY(D%,I%):NEXT:IF D%=DAY% THEN CLOSE #2:RETURN ELSE RETURN
  192. 1830  OPEN DRV$+NAMDAT$ FOR APPEND AS #2
  193. 1833  WRITE #2,AVG$:FOR I%=1 TO 27:WRITE #2,AVG(I%):NEXT
  194. 1835  WRITE #2,CAL$:IF PREG$="P" THEN WRITE #2,PKCAL ELSE IF PREG$="L" THEN WRITE #2,LKCAL ELSE IF PREG$="B" THEN WRITE #2,PLKCAL ELSE WRITE #2,ENERGY
  195. 1840  IF PREG$="P" OR PREG$="L" OR PREG$="B" THEN FOR I%=3 TO 22:WRITE #2,PLB(I%):NEXT:WRITE #2,K$,NA$ ELSE WRITE #2,R$
  196. 1845  WRITE #2,PCT$,PCT(2),PCT(3):FOR I%=7 TO 10:WRITE #2,PCT(I%):NEXT:FOR I%=13 TO 22:WRITE #2,PCT(I%):NEXT:WRITE #2,PCT(26)
  197. 1847  WRITE #2,PCHO,PPRO,PFAT,PALC,FACID,CA.P
  198. 1850  FOR I%=2 TO 22:WRITE #2,HILO%(I%):NEXT:WRITE #2,HILO%(26)
  199. 1860  CLOSE #2:GOTO 1007
  200. 2005  Z%=2:ZZ%=31:DIM DAT$(31),PO%(31),CO%(31):RESTORE 2006:FOR K%=1 TO 31:READ PO%(K%),CO%(K%):NEXT
  201. 2006  DATA 1,20,21,2,23,6,29,3,32,4,36,4,40,3,43,3,46,3,49,3,52,4,56,3,59,3,62,4,66,4,70,4,74,3,77,3,80,3,83,3,86,3,89,3,92,4,96,3,99,5,104,3,107,3,110,3,113,3,116,3,119,3
  202. 2008  CLS:FOR I%=1 TO 31:DAT$(I%)="":NEXT
  203. 2010  GET #1,1:IF VAL(F$)<MNR% THEN GOTO 2015 ELSE LOCATE 20,12:PRINT "FOODFILE IS FULL":LOCATE 21,11:PRINT "Press F1 for HELP":ON KEY(1) GOSUB 8010:KEY(1) ON:F1$=INKEY$:IF F1$="" THEN 2010
  204. 2015  CLS:WIDTH 80:LOCATE 1,35:COLOR 15,0:PRINT "ADD A FOOD";:COLOR 7,0: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";
  205. 2020  ON KEY(1) GOSUB 8010:ON KEY(10) GOSUB 940:KEY(1) ON:KEY(10) ON
  206. 2030  LOCATE 4,1:PRINT "ENTER DATA WITHIN BRACKETS [   ]:":LOCATE 6,1:PRINT "Food Description [                    ]":LOCATE 6,19,1:I%=1:L%=20:FD%=1:GOTO 2520
  207. 2040  I%=2:FD%=0:FD$=DAT$(1):GOSUB 10010:IF F%=1 THEN LOCATE 7,1:PRINT "[";FD$;"] has already been added";:FOR I%=1 TO 3000:NEXT:LOCATE 7,1:PRINT SPACE$(50);:DAT$(1)="":GOTO 2030
  208. 2050  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) [   ]"
  209. 2060  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) [   ]"
  210. 2070  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) [     ]"
  211. 2080  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) [   ]"
  212. 2090  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) [   ]"
  213. 2100  LOCATE 22,1:PRINT "Ascorbic Acid (mg) [   ]":LOCATE 25,40:COLOR 0,15:PRINT "Press TAB to goto next data item";:COLOR 7,0
  214. 2110  IF I%=1 THEN L%=20:LOCATE 6,19+LEN(DAT$(I%)),1:GOTO 2520 ELSE IF I%=2 THEN L%=2:LOCATE 7,13+LEN(DAT$(I%)),1:GOTO 2520 ELSE IF I%=3 THEN L%=6:LOCATE 7,44+LEN(DAT$(I%)),1:GOTO 2520 ELSE
  215. 2120  IF I%=4 THEN L%=3:LOCATE 7,73+LEN(DAT$(I%)),1:GOTO 2520 ELSE IF I%=5 THEN L%=4:LOCATE 9,12+LEN(DAT$(I%)),1:GOTO 2520 ELSE IF I%=6 THEN L%=4:LOCATE 10,21+LEN(DAT$(I%)),1:GOTO 2520 ELSE
  216. 2130  IF I%=7 THEN L%=3:LOCATE 11,14+LEN(DAT$(I%)),1:GOTO 2520 ELSE IF I%=8 THEN L%=3:LOCATE 12,16+LEN(DAT$(I%)),1:GOTO 2520 ELSE IF I%=9 THEN L%=3:LOCATE 13,19+LEN(DAT$(I%)),1:GOTO 2520 ELSE
  217. 2140  IF I%=10 THEN L%=3:LOCATE 14,18+LEN(DAT$(I%)),1:GOTO 2520 ELSE IF I%=11 THEN L%=4:LOCATE 15,15+LEN(DAT$(I%)),1:GOTO 2520 ELSE IF I%=12 THEN L%=3:LOCATE 16,12+LEN(DAT$(I%)),1:GOTO 2520 ELSE
  218. 2150  IF I%=13 THEN L%=3:LOCATE 17,16+LEN(DAT$(I%)),1:GOTO 2520 ELSE IF I%=14 THEN L%=4:LOCATE 18,18+LEN(DAT$(I%)),1:GOTO 2520 ELSE IF I%=15 THEN L%=4:LOCATE 19,17+LEN(DAT$(I%)),1:GOTO 2520 ELSE
  219. 2160  IF I%=16 THEN L%=4:LOCATE 20,14+LEN(DAT$(I%)),1:GOTO 2520 ELSE IF I%=17 THEN L%=3:LOCATE 21,12+LEN(DAT$(I%)),1:GOTO 2520 ELSE IF I%=18 THEN L%=3:LOCATE 22,21+LEN(DAT$(I%)),1:GOTO 2520 ELSE
  220. 2170  IF I%=19 THEN L%=3:LOCATE 9,54+LEN(DAT$(I%)),1:GOTO 2520 ELSE IF I%=20 THEN L%=3:LOCATE 10,57+LEN(DAT$(I%)),1:GOTO 2520 ELSE IF I%=21 THEN L%=3:LOCATE 11,53+LEN(DAT$(I%)),1:GOTO 2520 ELSE
  221. 2180  IF I%=22 THEN L%=3:LOCATE 12,58+LEN(DAT$(I%)),1:GOTO 2520 ELSE IF I%=23 THEN L%=4:LOCATE 13,55+LEN(DAT$(I%)),1:GOTO 2520 ELSE IF I%=24 THEN L%=3:LOCATE 14,60+LEN(DAT$(I%)),1:GOTO 2520 ELSE
  222. 2190  IF I%=25 THEN L%=5:LOCATE 15,56+LEN(DAT$(I%)),1:GOTO 2520 ELSE IF I%=26 THEN L%=3:LOCATE 16,56+LEN(DAT$(I%)),1:GOTO 2520 ELSE IF I%=27 THEN L%=3:LOCATE 17,59+LEN(DAT$(I%)),1:GOTO 2520 ELSE
  223. 2200  IF I%=28 THEN L%=3:LOCATE 18,65+LEN(DAT$(I%)),1:GOTO 2520 ELSE IF I%=29 THEN L%=3:LOCATE 19,65+LEN(DAT$(I%)),1:GOTO 2520 ELSE IF I%=30 THEN L%=3:LOCATE 20,58+LEN(DAT$(I%)),1:GOTO 2520 ELSE
  224. 2210  IF I%=31 THEN L%=3: LOCATE 21,53+LEN(DAT$(I%)),1:GOTO 2520
  225. 2220  LOCATE 23,30:PRINT "Press ENTER if ok (press TAB to correct data)":LOCATE 23,74
  226. 2230  ANS$=INKEY$:IF ANS$="" THEN 2230 ELSE IF ANS$=CHR$(13) THEN GOTO 2235 ELSE IF ANS$=CHR$(9) THEN I%=1:GOTO 2110 ELSE BEEP:GOTO 2230
  227. 2235  IF DAT$(1)<>FD$ THEN FD$=DAT$(1):GOSUB 10010
  228. 2240  CLS:LOCATE 10,27,0:PRINT "SAVING YOUR DATA...":PC$="":FOR K%=1 TO 31:MID$(F$,PO%(K%),CO%(K%))=DAT$(K%):PC$=PC$+MID$(F$,PO%(K%),CO%(K%)):NEXT:LSET F$=PC$:PUT #1,RF%
  229. 2250  BEEP:LOCATE 10,49:PRINT "DATA SAVED":LOCATE 12,1:PRINT FD$:PRINT "FOOD NO. = ";RF%;" (Add Food Description and Food No. to FOODFILE printout)":GET #1,1:ANR%=VAL(F$)+1:PRINT #1,STR$(ANR%):PUT #1,1:LOCATE 16,27:PRINT "Press space bar to continue"
  230. 2260  C$=INKEY$:IF C$="" THEN 2260
  231. 2270  CLS:LOCATE 10,25:PRINT "ADD ANOTHER FOOD (Y or N)? ":C$="":WHILE C$="":C$=INKEY$:WEND:IF C$="Y" THEN 2008 ELSE GOTO 940
  232. 2520  A$=INKEY$:IF A$="" THEN 2520
  233. 2530  IF A$=CHR$(9) THEN I%=I%+1:IF I%>31 THEN 2220 ELSE GOTO 2110
  234. 2540  IF A$=CHR$(13) AND FD%=1 THEN 2040
  235. 2545  IF A$=CHR$(13) THEN BEEP:GOTO 2520
  236. 2550  IF A$=CHR$(8) THEN 2600
  237. 2555  IF A$=>CHR$(0)+CHR$(71) AND A$<=CHR$(0)+CHR$(83) THEN BEEP:GOTO 2520
  238. 2560  IF LEN(DAT$(I%))=L% THEN BEEP:GOTO 2520
  239. 2580  IF ASC(A$)>31 THEN PRINT A$;:DAT$(I%)=DAT$(I%)+A$:GOTO 2520
  240. 2600  IF LEN (DAT$(I%))=0 THEN BEEP:GOTO 2520
  241. 2610  LOCATE CSRLIN,POS(0)-1:PRINT " ";:LOCATE CSRLIN,POS(0)-1:DAT$(I%)=LEFT$(DAT$(I%),LEN(DAT$(I%))-1):GOTO 2520
  242. 3010  Z%=3:ZZ%=43:CLS:WIDTH 80:LOCATE 1,32:COLOR 15,0:PRINT "DELETE A FOOD";:COLOR 7,0: 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";
  243. 3015  ON KEY(1) GOSUB 8010:ON KEY(10) GOSUB 940:KEY(1) ON:KEY(10) ON
  244. 3020  REC$="":LOCATE 4,1,1:PRINT "Enter Food Number to Delete (0 to end)? ";
  245. 3021  RF$=INKEY$:IF RF$="" THEN 3021
  246. 3023  IF RF$=CHR$(13) THEN RF%=VAL(REC$):GOTO 3031
  247. 3025  IF RF$=CHR$(8) THEN 3030
  248. 3027  IF ASC(RF$)>47 AND ASC(RF$)<58 THEN PRINT RF$;:REC$=REC$+RF$:GOTO 3021:ELSE GOTO 3021
  249. 3030  IF LEN(REC$)=0 THEN BEEP:GOTO 3020:ELSE LOCATE CSRLIN,POS(0)-1:PRINT " ";:LOCATE CSRLIN,POS(0)-1:REC$=LEFT$(REC$,LEN(REC$)-1):GOTO 3021
  250. 3031  IF RF%=0 THEN 940
  251. 3035  IF RF%>MAX% THEN LOCATE 5,1:PRINT "Food Numbers are from 1 to ";MAX%;" - Try Again";:FOR X%=1 TO 3000:NEXT:LOCATE 4,1:PRINT SPACE$(158);:GOTO 3020 ELSE GET #1,RF%
  252. 3040  PRINT:IF LEFT$(F$,1)=" " THEN LOCATE 5,1:PRINT "FOOD NUMBER ";RF%;"'s record is empty - try again";:FOR X%=1 TO 3000:NEXT:LOCATE 4,1:PRINT SPACE$(158);:GOTO 3020
  253. 3045  IF YN$="Y" OR YN$="N" THEN FOR Y%=7 TO 9:LOCATE Y%,1:PRINT SPACE$(20):NEXT
  254. 3050  LOCATE 7,1:PRINT LEFT$(F$,20):INPUT "Delete (Y or N)? ",YN$:IF YN$<>"Y" AND YN$<>"N" THEN 3050
  255. 3060  IF YN$="Y" OR YN$="y" THEN LSET F$=" ":PUT #1,RF%:GET #1,1:ANR%=VAL(F$)-1:PRINT #1,STR$(ANR%):PUT #1,1:PRINT "** Deleted **":LOCATE 4,1:PRINT SPACE$(45);:GOTO 3020 ELSE PRINT "** NOT DELETED **":LOCATE 4,1:PRINT SPACE$(45);:GOTO 3020
  256. 4010  Z%=4:ZZ%=45:DIM DI$(31),P%(31),C%(31):RESTORE 4011:FOR I%=1 TO 31:READ P%(I%),C%(I%):NEXT
  257. 4011  DATA 1,20,21,2,23,6,29,3,32,4,36,4,40,3,43,3,46,3,49,3,52,4,56,3,59,3,62,4,66,4,70,4,74,3,77,3,80,3,83,3,86,3,89,3,92,4,96,3,99,5,104,3,107,3,110,3,113,3,116,3,119,3
  258. 4020  CLS:WIDTH 80:LOCATE 1,32:COLOR 15,0:PRINT "CHANGE A FOOD";:COLOR 7,0: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";
  259. 4021  ON KEY(1) GOSUB 8010:ON KEY(10) GOSUB 940:KEY(1) ON:KEY(10) ON
  260. 4025  REC$="":LOCATE 3,1,1:PRINT "Enter Food Number to Change (0 to end)? ";
  261. 4027  RF$=INKEY$:IF RF$="" THEN 4027
  262. 4029  IF RF$=CHR$(13) THEN RF%=VAL(REC$):GOTO 4037
  263. 4031  IF RF$=CHR$(8) THEN 4035
  264. 4033  IF ASC(RF$)>47 AND ASC(RF$)<58 THEN PRINT RF$;:REC$=REC$+RF$:GOTO 4027:ELSE GOTO 4027
  265. 4035  IF LEN(REC$)=0 THEN BEEP:GOTO 4025:ELSE LOCATE CSRLIN,POS(0)-1:PRINT " ";:LOCATE CSRLIN,POS(0)-1:REC$=LEFT$(REC$,LEN(REC$)-1):GOTO 4027
  266. 4037  IF RF%=0 THEN 940
  267. 4039  IF RF%>MAX% THEN LOCATE 4,1:PRINT "Food Numbers are from 1 to ";MAX%;" - Try Again";:FOR X%=1 TO 3000:NEXT:LOCATE 3,1:PRINT SPACE$(130);:GOTO 4025 ELSE GET #1,RF%
  268. 4040  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 4025 ELSE LOCATE 3,1:PRINT SPACE$(43);
  269. 4045  LOCATE 4,1:PRINT "CHANGE DATA WITHIN BRACKETS [   ]:":LOCATE 6,1:PRINT "Food Description [                    ]":I%=1:FD%=0
  270. 4050  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) [   ]"
  271. 4060  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) [   ]"
  272. 4070  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) [     ]"
  273. 4080  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) [   ]"
  274. 4090  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) [   ]"
  275. 4100  LOCATE 22,1:PRINT "Ascorbic Acid (mg) [   ]":LOCATE 25,40:COLOR 0,15:PRINT "Press TAB to goto next data item";:COLOR 7,0
  276. 4110  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)
  277. 4120  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)
  278. 4130  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)
  279. 4140  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)
  280. 4150  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)
  281. 4160  LOCATE 22,21,1:PRINT MID$(F$,77,3):FD$=LEFT$(F$,20):FOR I%=1 TO 31:DI$(I%)=MID$(F$,P%(I%),C%(I%)):NEXT:I%=1
  282. 4170  IF I%=1 THEN L%=20:LOCATE 6,19+LEN(DI$(I%)),1:GOTO 4510 ELSE IF I%=2 THEN L%=2: LOCATE 7,13+LEN(DI$(I%)),1:GOTO 4510 ELSE IF I%=3 THEN L%=6: LOCATE 7,44+LEN(DI$(I%)),1:GOTO 4510 ELSE
  283. 4180  IF I%=4 THEN L%=3: LOCATE 7,73+LEN(DI$(I%)),1:GOTO 4510 ELSE IF I%=5 THEN L%=4: LOCATE 9,12+LEN(DI$(I%)),1:GOTO 4510 ELSE IF I%=6 THEN L%=4: LOCATE 10,21+LEN(DI$(I%)),1:GOTO 4510 ELSE
  284. 4190  IF I%=7 THEN L%=3: LOCATE 11,14+LEN(DI$(I%)),1:GOTO 4510 ELSE IF I%=8 THEN L%=3: LOCATE 12,16+LEN(DI$(I%)),1:GOTO 4510 ELSE IF I%=9 THEN L%=3: LOCATE 13,19+LEN(DI$(I%)),1:GOTO 4510 ELSE
  285. 4200  IF I%=10 THEN L%=3: LOCATE 14,18+LEN(DI$(I%)),1:GOTO 4510 ELSE IF I%=11 THEN L%=4: LOCATE 15,15+LEN(DI$(I%)),1:GOTO 4510 ELSE IF I%=12 THEN L%=3: LOCATE 16,12+LEN(DI$(I%)),1:GOTO 4510 ELSE
  286. 4210  IF I%=13 THEN L%=3: LOCATE 17,16+LEN(DI$(I%)),1:GOTO 4510 ELSE IF I%=14 THEN L%=4: LOCATE 18,18+LEN(DI$(I%)),1:GOTO 4510 ELSE IF I%=15 THEN L%=4: LOCATE 19,17+LEN(DI$(I%)),1:GOTO 4510 ELSE
  287. 4220  IF I%=16 THEN L%=4: LOCATE 20,14+LEN(DI$(I%)),1:GOTO 4510 ELSE IF I%=17 THEN L%=3: LOCATE 21,12+LEN(DI$(I%)),1:GOTO 4510 ELSE IF I%=18 THEN L%=3: LOCATE 22,21+LEN(DI$(I%)),1:GOTO 4510 ELSE
  288. 4230  IF I%=19 THEN L%=3: LOCATE 9,54+LEN(DI$(I%)),1:GOTO 4510 ELSE IF I%=20 THEN L%=3: LOCATE 10,57+LEN(DI$(I%)),1:GOTO 4510 ELSE IF I%=21 THEN L%=3: LOCATE 11,53+LEN(DI$(I%)),1:GOTO 4510 ELSE
  289. 4240  IF I%=22 THEN L%=3: LOCATE 12,58+LEN(DI$(I%)),1:GOTO 4510 ELSE IF I%=23 THEN L%=4: LOCATE 13,55+LEN(DI$(I%)),1:GOTO 4510 ELSE IF I%=24 THEN L%=3: LOCATE 14,60+LEN(DI$(I%)),1:GOTO 4510 ELSE
  290. 4250  IF I%=25 THEN L%=5: LOCATE 15,56+LEN(DI$(I%)),1:GOTO 4510 ELSE IF I%=26 THEN L%=3: LOCATE 16,56+LEN(DI$(I%)),1:GOTO 4510 ELSE IF I%=27 THEN L%=3: LOCATE 17,59+LEN(DI$(I%)),1:GOTO 4510 ELSE
  291. 4260  IF I%=28 THEN L%=3: LOCATE 18,65+LEN(DI$(I%)),1:GOTO 4510 ELSE IF I%=29 THEN L%=3: LOCATE 19,65+LEN(DI$(I%)),1:GOTO 4510 ELSE IF I%=30 THEN L%=3: LOCATE 20,58+LEN(DI$(I%)),1:GOTO 4510 ELSE
  292. 4270  IF I%=31 THEN L%=3: LOCATE 21,53+LEN(DI$(I%)),1:GOTO 4510
  293. 4280  LOCATE 23,30:PRINT "Press ENTER if ok (press TAB to correct data)":LOCATE 23,74
  294. 4290  ANS$=INKEY$:IF ANS$="" THEN 4290 ELSE IF ANS$=CHR$(13) THEN 4295 ELSE IF ANS$=CHR$(9) THEN I%=1:GOTO 4170 ELSE BEEP:GOTO 4290
  295. 4295  LSET F$=" ":PUT #1,RF%:IF DI$(1)=FD$ THEN 4300 ELSE FD%=1:FD$=DI$(1):GOSUB 10010:IF F%=0 THEN GOTO 4300 ELSE
  296. 4296  IF F%=1 THEN PRINT "[";FD$;"] already exists":PRINT "Make Food Description unique":LOCATE 6,19+LEN(DI$(1)),1:GOTO 4510
  297. 4300  CLS:LOCATE 10,27,0:PRINT "SAVING YOUR DATA  ...":PC$="":FOR I%=1 TO 31:MID$(F$,P%(I%),C%(I%))=DI$(I%):PC$=PC$+MID$(F$,P%(I%),C%(I%)):NEXT:LSET F$=PC$:PUT #1,RF%
  298. 4310  BEEP:LOCATE 10,49:PRINT "DATA SAVED":LOCATE 12,1:PRINT FD$:PRINT "FOOD NO. = ";RF%;" (If either changed, add Food Description and Food No. to FOODFILE printout)":LOCATE 16,27:PRINT "Press space bar to continue"
  299. 4320  C$=INKEY$:IF C$="" THEN 4320
  300. 4330  CLS:LOCATE 10,27:PRINT "CHANGE ANOTHER FOOD (Y or N)?":C$="":WHILE C$="":C$=INKEY$:WEND:IF C$="Y" THEN 4020 ELSE 940
  301. 4510  A$=INKEY$:IF A$="" THEN 4510
  302. 4530  IF A$=CHR$(9) THEN I%=I%+1:IF I%>31 THEN 4280 ELSE GOTO 4170
  303. 4540  IF A$=CHR$(13) AND FD%=1 THEN 4295
  304. 4545  IF A$=CHR$(13) THEN BEEP:GOTO 4510
  305. 4550  IF A$=CHR$(8) THEN 4600
  306. 4555  IF A$=>CHR$(0)+CHR$(71) AND A$<=CHR$(0)+CHR$(83) THEN BEEP:GOTO 4510
  307. 4560  IF LEN(DI$(I%))=L% THEN BEEP:GOTO 4510
  308. 4580  IF ASC(A$)>31 THEN PRINT A$;:DI$(I%)=DI$(I%)+A$:GOTO 4510:ELSE GOTO 4510
  309. 4600  IF LEN (DI$(I%))=0 THEN BEEP:GOTO 4510
  310. 4610  LOCATE CSRLIN,POS(0)-1:PRINT " ";:LOCATE CSRLIN,POS(0)-1:DI$(I%)=LEFT$(DI$(I%),LEN(DI$(I%))-1):GOTO 4510
  311. 5010  CLS:LOCATE 3,13:PRINT "Please Wait ...";:CHAIN "DSPLYNUT",5010
  312. 6010  'CLS:LOCATE 3,13:PRINT "Please Wait ...";:CHAIN "PRINTNUT",6010
  313. 6020  CLS:PRINT "PRINT ROUTINE PENDING RECEIPT":PRINT "OF REQUESTED PAYMENT":FOR X%=1 TO 5000:NEXT:GOTO 940
  314. 8010  DEF SEG=&H40:DIS%=(PEEK(16)AND 48)/16:IF DIS%=3 THEN DEF SEG=&HB000 ELSE DEF SEG=&HB800
  315. 8020  DIM LN$(5):ORIGY%=CSRLIN:ORIGX%=POS(0)
  316. 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
  317. 8070  LOCATE 13,1:PRINT CHR$(218);STRING$(38,196);CHR$(191);
  318. 8080  FOR O%=14 TO 16:LOCATE O%,1:PRINT CHR$(179);SPACE$(38);CHR$(179);:NEXT
  319. 8090  LOCATE 17,1:PRINT CHR$(192);STRING$(38,196);CHR$(217);:LOCATE 14,7:PRINT "NUTRIENT HELP: "
  320. 8100  LOCATE 15,2:PRINT "HELP ROUTINE PENDING RECEIPT";:LOCATE 16,2:PRINT "OF REQUESTED PAYMENT";:FOR X%=1 TO 5000:NEXT
  321. 8607  FOR O%=17 TO 13 STEP -1:LOCATE O%,1:N%=N%-1:PRINT LN$(N%);:NEXT
  322. 8610  ERASE LN$:IF Z%=0 THEN 940 ELSE LOCATE ORIGY%,ORIGX%:RETURN
  323. 10010  GOSUB 30020:DIFF%=1:FD$=FD$+SPACE$(20-LEN(FD$))
  324. 10020  GET #1, HASH%+1
  325. 10030  IF LEFT$(F$,1)=" " THEN F%=0:RF%=HASH%+1:RETURN
  326. 10040  IF LEFT$(F$,20)=FD$ THEN F%=1:RF%=HASH%+1:RETURN
  327. 10050  HASH%=HASH%+DIFF%:DIFF%=DIFF%+2:IF HASH%>MAX% THEN HASH%=HASH% MOD MAX%+1
  328. 10060  GOTO 10020
  329. 30020  HASH%=0
  330. 30040  FOR J%=1 TO LEN(FD$):HASH%=HASH% + ASC(MID$(FD$,J%,1)):NEXT
  331. 30050  HASH%=HASH% MOD MAX% + 1
  332. 30090  RETURN
  333. 31005  ON ERROR GOTO 31020:OPEN "FOODFILE" FOR INPUT AS #1:CLOSE #1
  334. 31010  OPEN "FOODFILE" AS #1 LEN=121:FIELD #1, 121 AS F$:ON ERROR GOTO 0:RETURN
  335. 31020  CLS:LOCATE 10,20:PRINT "FOODFILE not found.  Please check disk.":PRINT "error and line = ";ERR;"and";ERL:RESUME 32010
  336. 32010  KEY 1,"LIST ":KEY 2,"RUN"+CHR$(13):KEY 3,"LOAD"+CHR$(34):KEY 4,"SAVE"+CHR$(34):KEY 5,"CONT"+CHR$(13):KEY 6,","+CHR$(34)+"LPT1:"+CHR$(34)+CHR$(13)
  337. 32011  KEY 7,"TRON"+CHR$(13):KEY 8,"TROFF"+CHR$(13):KEY 9,"KEY ":KEY 10,"SCREEN 0,0,0"+CHR$(13):FOR I%=1 TO 10:KEY(I%)ON:NEXT
  338. 32020  CLS:WIDTH 80:LOCATE 10,33,0:PRINT "GOODBYE FRIEND":FOR I%=1 TO 2500:NEXT:LOCATE 10,33:PRINT SPACE$(15):NEW
  339.