1  COM A0$[7]
2  IF LEN(A0$)>0 THEN 5
3  A0$="$DIET  "
4  CHAIN X,"1.A007"
5  REM LINES 1-5 AFM MOD 2
100  REM DIET - A DIETARY EXAMINATION SIMULATION
110  REM COPYRIGHT 1974, STATE UNIVERSITY OF NEW YORK
120  REM DEVELOPED AND PROGRAMMED BY J. FRIEDLAND, M. WEISNER
130  REM LATEST REVISION: AUGUST 23, 1974
140  DIM F[4],M[4],N[4,4],P[4]
150  PRINT TAB(15);"DIETARY EXAMINATION PROGRAM"
160  LET Z=1
170  FOR X=1 TO 4
180  LET P[X]=0
190  FOR M=1 TO 4
200  LET N[X,M]=0
210  NEXT M
220  NEXT X
230  PRINT 
240  LET M=0
250  PRINT 
260  PRINT 
270  PRINT "SUBJECT'S AGE IN YEARS";
280  INPUT A
290  IF ABS(A-45.5)>44.5 THEN 270
300  IF A >= 12 THEN 320
310  PRINT "DIET MAY BE INACCURATE FOR SUBJECTS YOUNGER THAN 12"
320  PRINT "SEX: 1=MALE, 2=FEMALE";
330  INPUT S
340  LET S=S-1
350  IF (S-1)*S <> 0 THEN 320
360  PRINT "APPROXIMATE WEIGHT IN POUNDS";
370  INPUT L
380  LET L=L*.45
390  IF L <= 0 THEN 360
400  PRINT "HEIGHT IN INCHES";
410  INPUT H
420  LET H=H*2.54
430  IF H <= 0 THEN 400
440  PRINT "ACTIVITY FROM 1 TO 5";
450  INPUT A9
460  IF ABS(A9-3)>2 THEN 440
470  LET S1=.0072*L^.425*H^.725
480  REM FIGURE BMR BASED ON SEX AND AGE
490  IF A>11 THEN 520
500  LET B=(-18-1.7*S)*A+1266-66*S
510  GOTO 590
520  IF A >= 15 THEN 550
530  LET B=(-11.3-8.4*S)*A+1230-30*S
540  GOTO 590
550  IF A>18 THEN 580
560  LET B=(-11.3+11.3*S)*A+1230-390*S
570  GOTO 590
580  LET B=(-2.3+.4*S)*A+986-103*S
590  LET B=B*S1
600  LET M[1]=1.06*(B+L*(-.8+8*(A9-.5)))
610  IF A>18 THEN 660
620  LET M[2]=(-.056*A+1.9)*L
630  IF INT(A/10)*S=0 THEN 670
640  LET M[2]=(-.064*A+2.05)*L
650  GOTO 670
660  LET M[2]=B*.037
670  LET M[3]=M[1]*.25/8.93
680  PRINT 
690  PRINT "TYPICAL DAILY INTAKE, USE PLAN SHEET."
700  PRINT "TYPE 0,0 WHEN FINISHED WITH A MEAL"
710  PRINT 
720  PRINT "BREAKFAST"
730  PRINT "========="
740  PRINT "FOOD,QUANTITY"
750  GOSUB 1360
760  PRINT "LUNCH"
770  PRINT "====="
780  GOSUB 1360
790  PRINT "SUPPER"
800  PRINT "======"
810  GOSUB 1360
820  PRINT "SNACKS AND OTHER FOODS"
830  PRINT "======================"
840  GOSUB 1360
850  LET M[4]=(M[1]*.75-4.05*P[2])/4.03
860  IF M[4]>0 THEN 880
870  LET M[4]=.001
880  PRINT "REPORT"
890  PRINT " ","PROVIDED","RECOMMENDED","STATE"
900  PRINT " ","========","===========","====="
910  FOR X=1 TO 4
920  GOSUB 1250
930  PRINT INT(P[X]+.5),INT(M[X]+.5),'9;
940  IF ABS(1-P[X]/M[X])>.1 THEN 970
950  PRINT "GOOD"
960  GOTO 1060
970  IF ABS(1-P[X]/M[X])>.25 THEN 1010
980  IF X=2 THEN 950
990  PRINT "FAIR"
1000  GOTO 1060
1010  IF M[X]>P[X] THEN 1050
1020  IF X=2 THEN 950
1030  PRINT "EXCESS"
1040  GOTO 1060
1050  PRINT "DEFICIENCY"
1060  NEXT X
1061  IF A<18-S*3 THEN 1071
1062  LET X=INT(.02624*(P[1]-M[1]))
1063  IF X=0 THEN 1071
1064  PRINT 
1065  PRINT "THIS DIET WOULD RESULT IN A WEIGHT ";
1066  IF X>0 THEN 1069
1067  PRINT "LOSS";
1068  GOTO 1070
1069  PRINT "GAIN";
1070  PRINT " OF";ABS(INT(X+SGN(X)*.5)/100);"POUNDS/DAY."
1071  PRINT 
1080  PRINT "MEAL BREAKDOWN (1=YES, 0=NO)";
1090  INPUT X
1100  IF X <> 1 THEN 1190
1110  PRINT " ","BREAKFAST","LUNCH","SUPPER","OTHER"
1120  PRINT " ","=========","=====","======","====="
1130  FOR X=1 TO 4
1140  GOSUB 1250
1150  FOR M=1 TO 3
1160  PRINT INT(N[X,M]+.5),'9;
1170  NEXT M
1180  PRINT INT(N[X,4]+.5)
1190  NEXT X
1200  PRINT 
1210  PRINT "ANOTHER RUN (1=YES, 0=NO)";
1220  INPUT X
1230  IF X=1 THEN 170
1240  STOP 
1250  IF X>1 THEN 1270
1260  PRINT "CALORIES",'9,'9;
1270  IF X <> 2 THEN 1290
1280  PRINT "PROTEIN GM.",'9,'9;
1290  IF X <> 3 THEN 1310
1300  PRINT "LIPID GM.",'9,'9;
1310  IF X <> 4 THEN 1330
1320  PRINT "CARBOHYDRATE",'9,'9;
1330  RETURN 
1340  LET Z=1.E+30
1350  PRINT "ITEM NOT FOUND"
1360  INPUT F,Q
1370  IF ABS(F)+ABS(Q)=0 THEN 1530
1380  IF SGN(F)+SGN(Q)+INT(F) <> F+2 THEN 1350
1390  IF F=Z-1 THEN 1470
1400  IF Z <= F THEN 1430
1410  LET Z=1
1420  RESTORE 
1430  FOR X=Z TO F
1440  READ F[1],F[2],F[3],F[4]
1450  IF F[1]<0 THEN 1340
1460  NEXT X
1470  LET Z=F+1
1480  FOR X=1 TO 4
1490  LET N[X,M+1]=N[X,M+1]+F[X]*Q
1500  LET P[X]=P[X]+F[X]*Q
1510  NEXT X
1520  GOTO 1360
1530  PRINT 
1540  LET M=M+1
1550  RETURN 
1560  DATA 54,.1,.1,14,43,1.8,4,.1,88,1.2,.2,23,250,12,6,38
1570  DATA 205,12,1,38,33,3,.3,5.3,185,26,8,0,145,23,5,0
1580  DATA 64,2,.3,14,123,2,5.6,15,74,5,5,1.2,2,.4,.1,.01
1590  DATA 62,2,1,12,56,2,1,11,44,5,.3,8.2,100,.5,11,.1
1600  DATA 342,5,9,60,108,0,.1,27,385,1.1,.4,8.3,20,.6,.1,4.5
1610  DATA 44,1.8,.4,12,100,6,8,1,200,28,8,6,105,2.6,10.5,.6,96,7,8,1
1620  DATA 396,56.6,17.2,0,146,2,9,16,0,0,0,0,91,0,0,23,99,1,5,14
1630  DATA 132,4,2,32,129,2.7,.1,28.3,24.6,.5,.6,4.6,17,.5,.5,3
1640  DATA 97,.7,10,.9,36,2,.3,8,136,2.1,6.7,16.9,81,7,6,.4
1650  DATA 110,0,13,0,100,15,8,0,364,11,1,76,124,7,10,1
1660  DATA 118,4,0,15,80,1,.4,20.2,3.5,.07,.07,.8,157,21,7,0
1670  DATA 170,22,13,0,64,.1,0,17,269,5,17,27,55,.1,.06,14.2
1680  DATA 2.5,.2,.03,.5,229,26,11,5,221,8,1.5,45,101,.2,11,.01
1690  DATA 65,.2,6,2,166,8.6,9.5,11.9,87,8.5,.2,12.4
1700  DATA 253,11,10.7,29,82,3,1.5,15,49,1,.2,12,108,2.1,.5,27
1710  DATA 56,2,2,8,33,.2,.05,9,873,39,73,28,87,4,7,3
1720  DATA 131,9,.5,23.6,327,9,17,35,410,4,18,60,58,.2,.05,14
1730  DATA 236,12,8,28,195,22,13,0,54,2,1,10,98,2.4,.1,22.5
1740  DATA 14,.2,.7,2,11,.1,.7,1,296,6,10,52,429,4,.8,114
1750  DATA 143,4,.5,39,162,3,.15,36,178,4.5,1.5,39
1760  DATA 260,30,14,0,235,9,22,0,60,2.7,2,8,74,1.8,1.8,14.6
1770  DATA 65,3.3,1.4,11.5,103,9,5,7,154,7.5,6,16.5
1780  DATA 46,6,.1,8,74,1.6,1,16.6,25,0,0,6.5,0,0,0,0,20,1,.3,4
1790  DATA 279,41,12,0,67,10,2.5,0,219,28,11,0,.8,0,0,.3
1800  DATA 28,.5,.2,6.9,246,17.1,6.8,33.7,22,3,.1,3,123,8,4,13
1810  DATA -1,0,0,0
1820  END 
