FHNU6 ; HISC/REL/NCA - Abbreviated Analysis Output ;8/2/94 16:09
;;5.5;DIETETICS;;Jan 28, 2005
K A,B,C F K=1:1:3 S C(K)=0 F K=1:1:66 S A(K)=0,B(K)=0
S NX=0
D1 S NX=$O(FHM(NX)) I NX="" G D2
S AMT=+FHM(NX) I TYP="C" S WT=$P(FHM(NX),",",3),AMT=AMT*WT
S AMT=AMT/100,Y=$G(^FHNU(NX,1)) F K=1:1:20 S Z1=$P(Y,"^",K) I Z1'="" S A(K)=Z1*AMT+A(K),B(K)=B(K)+1
S Y=$G(^FHNU(NX,2)) F K=21:1:38 S Z1=$P(Y,"^",K-20) I Z1'="" S A(K)=Z1*AMT+A(K),B(K)=B(K)+1
S Y=$G(^FHNU(NX,3)) F K=39:1:56 S Z1=$P(Y,"^",K-38) I Z1'="" S A(K)=Z1*AMT+A(K),B(K)=B(K)+1
S Y=$G(^FHNU(NX,4)) F K=57:1:66 S Z1=$P(Y,"^",K-56) I Z1'="" S A(K)=Z1*AMT+A(K),B(K)=B(K)+1
G D1
D2 S ZR=$S(RDA:^FH(112.2,RDA,1),1:""),ANS=""
S Z1=4*A(1)+(9*A(2))+(4*A(3)) S:'Z1 Z1=1 F KK=1,3,2 S C(KK)=$J(A(KK)*$S(KK=2:900,1:400)/Z1,4,0)
W:$E(IOST,1,2)="C-" @IOF W !?28,"--- Analysis of Menu ---",!!?(80-$L(TIT)\2),TIT,!!?34,"%",?39,"%",?76,"%",!
W ?33,"DRI",?37,"Kcal",?75,"DRI",!
F K=1:1:34 S Y=$T(COM+K),Z1=$P(Y,";",3) D LST
D PSE I ANS="^" K A,B,C,KK,T1,Z1,Z2,ZR Q
F K=35:1:70 S Y=$T(COM+K),Z1=$P(Y,";",3) D LST
D PSE W ! K A,B,C,KK,T1,Z1,Z2,ZR Q
LST W:K#2 ! Q:'Z1 S T1=$S(K#2:0,1:42)
W ?T1,$P(Y,";",4)," (",B(Z1),")" I B(Z1) W ?(T1+21),$J(A(Z1),7,$P(Y,";",6))," ",$P(Y,";",5)
S Z2=$P(Y,";",7) I Z2,ZR'="" S Z2=A(Z1)/$P(ZR,U,Z2) W ?(T1+33),$J(Z2*100,3,0)
I $D(C(Z1)) W ?(T1+37),C(Z1)
Q
PSE I IOST?1"C-".E R !!,"Press RETURN to Continue ",X:DTIME W ! S:'$T!(X["^") ANS="^" Q:ANS="^" I "^"'[X W !,"Enter a RETURN to Continue." G PSE
Q
COM ;;
;;4;Calories;K;0;0
;;33;Vitamin A;RE;0;2
;;1;Protein;Gms;1;1
;;19;Ascorbic Acid;Mg;1;4
;;3;Carbohydrate;Gms;1;0
;;17;Vitamin E;Mg;1;3
;;2;Fat;Gms;1;0
;;21;Riboflavin;Mg;1;6
;;13;Sodium;Mg;1;19
;;20;Thiamin;Mg;1;5
;;12;Potassium;Mg;1;20
;;22;Niacin;Mg;1;7
;;8;Calcium;Mg;1;11
;;24;Vitamin B6;Mg;1;8
;;11;Phosphorus;Mg;1;12
;;26;Vitamin B12;Mcg;1;10
;;9;Iron;Mg;1;14
;;65;Vitamin K;Mcg;1;26
;;14;Zinc;Mg;1;15
;;25;Folate;Mcg;1;9
;;10;Magnesium;Mg;1;13
;;23;Pantothenic Ac;Mg;1;16
;;16;Manganese;Mg;1;18
;;29;Cholesterol;Mg;1;0
;;15;Copper;Mg;1;17
;;27;Linoleic Acid;Gms;1;0
;;66;Selenium;Mcg;1;22
;;28;Linolenic Acid;Gms;1;0
;;0;Crude Fiber;Gms;1;0
;;31;Monounsat. Fat;Gms;1;0
;;0;Dietary Fiber;Gms;1;0
;;32;Polyunsat. Fat;Gms;1;0
;;5;Water;Ml;1;0
;;30;Saturated Fat;Gms;1;0
;;34;Ash;Gms;1;0
;;39;Tryptophan;Gms;2;0
;;35;Alcohol;Gms;1;0
;;40;Threonine;Gms;2;0
;;36;Caffeine;Mg;1;0
;;41;Isoleucine;Gms;2;0
;;37;Total Diet Fiber;Gms;1;0
;;42;Leucine;Gms;2;0
;;38;Total Tocopherol;Mg;1;0
;;43;Lysine;Gms;2;0
;;57;Capric Acid;Gms;2;0
;;44;Methionine;Gms;2;0
;;58;Lauric Acid;Gms;2;0
;;45;Cystine;Gms;2;0
;;59;Myristic Acid;Gms;2;0
;;46;Phenylalanine;Gms;2;0
;;60;Palmitic Acid;Gms;2;0
;;47;Tyrosine;Gms;2;0
;;61;Palmitoleic Acid;Gms;2;0
;;48;Valine;Gms;2;0
;;62;Stearic Acid;Gms;2;0
;;49;Arginine;Gms;2;0
;;63;Oleic Acid;Gms;2;0
;;50;Histidine;Gms;2;0
;;64;Arachidonic Acid;Gms;2;0
;;51;Alanine;Gms;2;0
;;0
;;52;Aspartic Acid;Gms;2;0
;;0
;;53;Glutamic Acid;Gms;2;0
;;0
;;54;Glycine;Gms;2;0
;;0
;;55;Proline;Gms;2;0
;;0
;;56;Serine;Gms;2;0
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HFHNU6 3200 printed Dec 13, 2024@01:52:36 Page 2
FHNU6 ; HISC/REL/NCA - Abbreviated Analysis Output ;8/2/94 16:09
+1 ;;5.5;DIETETICS;;Jan 28, 2005
+2 KILL A,B,C
FOR K=1:1:3
SET C(K)=0
FOR K=1:1:66
SET A(K)=0
SET B(K)=0
+3 SET NX=0
D1 SET NX=$ORDER(FHM(NX))
IF NX=""
GOTO D2
+1 SET AMT=+FHM(NX)
IF TYP="C"
SET WT=$PIECE(FHM(NX),",",3)
SET AMT=AMT*WT
+2 SET AMT=AMT/100
SET Y=$GET(^FHNU(NX,1))
FOR K=1:1:20
SET Z1=$PIECE(Y,"^",K)
IF Z1'=""
SET A(K)=Z1*AMT+A(K)
SET B(K)=B(K)+1
+3 SET Y=$GET(^FHNU(NX,2))
FOR K=21:1:38
SET Z1=$PIECE(Y,"^",K-20)
IF Z1'=""
SET A(K)=Z1*AMT+A(K)
SET B(K)=B(K)+1
+4 SET Y=$GET(^FHNU(NX,3))
FOR K=39:1:56
SET Z1=$PIECE(Y,"^",K-38)
IF Z1'=""
SET A(K)=Z1*AMT+A(K)
SET B(K)=B(K)+1
+5 SET Y=$GET(^FHNU(NX,4))
FOR K=57:1:66
SET Z1=$PIECE(Y,"^",K-56)
IF Z1'=""
SET A(K)=Z1*AMT+A(K)
SET B(K)=B(K)+1
+6 GOTO D1
D2 SET ZR=$SELECT(RDA:^FH(112.2,RDA,1),1:"")
SET ANS=""
+1 SET Z1=4*A(1)+(9*A(2))+(4*A(3))
if 'Z1
SET Z1=1
FOR KK=1,3,2
SET C(KK)=$JUSTIFY(A(KK)*$SELECT(KK=2:900,1:400)/Z1,4,0)
+2 if $EXTRACT(IOST,1,2)="C-"
WRITE @IOF
WRITE !?28,"--- Analysis of Menu ---",!!?(80-$LENGTH(TIT)\2),TIT,!!?34,"%",?39,"%",?76,"%",!
+3 WRITE ?33,"DRI",?37,"Kcal",?75,"DRI",!
+4 FOR K=1:1:34
SET Y=$TEXT(COM+K)
SET Z1=$PIECE(Y,";",3)
DO LST
+5 DO PSE
IF ANS="^"
KILL A,B,C,KK,T1,Z1,Z2,ZR
QUIT
+6 FOR K=35:1:70
SET Y=$TEXT(COM+K)
SET Z1=$PIECE(Y,";",3)
DO LST
+7 DO PSE
WRITE !
KILL A,B,C,KK,T1,Z1,Z2,ZR
QUIT
LST if K#2
WRITE !
if 'Z1
QUIT
SET T1=$SELECT(K#2:0,1:42)
+1 WRITE ?T1,$PIECE(Y,";",4)," (",B(Z1),")"
IF B(Z1)
WRITE ?(T1+21),$JUSTIFY(A(Z1),7,$PIECE(Y,";",6))," ",$PIECE(Y,";",5)
+2 SET Z2=$PIECE(Y,";",7)
IF Z2
IF ZR'=""
SET Z2=A(Z1)/$PIECE(ZR,U,Z2)
WRITE ?(T1+33),$JUSTIFY(Z2*100,3,0)
+3 IF $DATA(C(Z1))
WRITE ?(T1+37),C(Z1)
+4 QUIT
PSE IF IOST?1"C-".E
READ !!,"Press RETURN to Continue ",X:DTIME
WRITE !
if '$TEST!(X["^")
SET ANS="^"
if ANS="^"
QUIT
IF "^"'[X
WRITE !,"Enter a RETURN to Continue."
GOTO PSE
+1 QUIT
COM ;;
+1 ;;4;Calories;K;0;0
+2 ;;33;Vitamin A;RE;0;2
+3 ;;1;Protein;Gms;1;1
+4 ;;19;Ascorbic Acid;Mg;1;4
+5 ;;3;Carbohydrate;Gms;1;0
+6 ;;17;Vitamin E;Mg;1;3
+7 ;;2;Fat;Gms;1;0
+8 ;;21;Riboflavin;Mg;1;6
+9 ;;13;Sodium;Mg;1;19
+10 ;;20;Thiamin;Mg;1;5
+11 ;;12;Potassium;Mg;1;20
+12 ;;22;Niacin;Mg;1;7
+13 ;;8;Calcium;Mg;1;11
+14 ;;24;Vitamin B6;Mg;1;8
+15 ;;11;Phosphorus;Mg;1;12
+16 ;;26;Vitamin B12;Mcg;1;10
+17 ;;9;Iron;Mg;1;14
+18 ;;65;Vitamin K;Mcg;1;26
+19 ;;14;Zinc;Mg;1;15
+20 ;;25;Folate;Mcg;1;9
+21 ;;10;Magnesium;Mg;1;13
+22 ;;23;Pantothenic Ac;Mg;1;16
+23 ;;16;Manganese;Mg;1;18
+24 ;;29;Cholesterol;Mg;1;0
+25 ;;15;Copper;Mg;1;17
+26 ;;27;Linoleic Acid;Gms;1;0
+27 ;;66;Selenium;Mcg;1;22
+28 ;;28;Linolenic Acid;Gms;1;0
+29 ;;0;Crude Fiber;Gms;1;0
+30 ;;31;Monounsat. Fat;Gms;1;0
+31 ;;0;Dietary Fiber;Gms;1;0
+32 ;;32;Polyunsat. Fat;Gms;1;0
+33 ;;5;Water;Ml;1;0
+34 ;;30;Saturated Fat;Gms;1;0
+35 ;;34;Ash;Gms;1;0
+36 ;;39;Tryptophan;Gms;2;0
+37 ;;35;Alcohol;Gms;1;0
+38 ;;40;Threonine;Gms;2;0
+39 ;;36;Caffeine;Mg;1;0
+40 ;;41;Isoleucine;Gms;2;0
+41 ;;37;Total Diet Fiber;Gms;1;0
+42 ;;42;Leucine;Gms;2;0
+43 ;;38;Total Tocopherol;Mg;1;0
+44 ;;43;Lysine;Gms;2;0
+45 ;;57;Capric Acid;Gms;2;0
+46 ;;44;Methionine;Gms;2;0
+47 ;;58;Lauric Acid;Gms;2;0
+48 ;;45;Cystine;Gms;2;0
+49 ;;59;Myristic Acid;Gms;2;0
+50 ;;46;Phenylalanine;Gms;2;0
+51 ;;60;Palmitic Acid;Gms;2;0
+52 ;;47;Tyrosine;Gms;2;0
+53 ;;61;Palmitoleic Acid;Gms;2;0
+54 ;;48;Valine;Gms;2;0
+55 ;;62;Stearic Acid;Gms;2;0
+56 ;;49;Arginine;Gms;2;0
+57 ;;63;Oleic Acid;Gms;2;0
+58 ;;50;Histidine;Gms;2;0
+59 ;;64;Arachidonic Acid;Gms;2;0
+60 ;;51;Alanine;Gms;2;0
+61 ;;0
+62 ;;52;Aspartic Acid;Gms;2;0
+63 ;;0
+64 ;;53;Glutamic Acid;Gms;2;0
+65 ;;0
+66 ;;54;Glycine;Gms;2;0
+67 ;;0
+68 ;;55;Proline;Gms;2;0
+69 ;;0
+70 ;;56;Serine;Gms;2;0
