source: WorldVistAEHR/trunk/r/DIETETICS-FH/FHREC6.m@ 1284

Last change on this file since 1284 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR

File size: 3.4 KB
Line 
1FHREC6 ; HISC/REL/NCA - Recipe Analysis Output ;7/30/93 15:05
2 ;;5.5;DIETETICS;;Jan 28, 2005
3 K DIC S DIC="^FH(114,",DIC(0)="AEQM" W ! D ^DIC G:Y<1 KIL S REC=+Y
4 S L1=$P($G(^FH(114,REC,0)),"^",14)
5 I 'L1 W !!,"This Recipe has not been analyzed." G FHREC6
6 K DIC S DIC="^FH(112.2,",DIC(0)="AEQM",DIC("A")="Select DRI Category: " W ! D ^DIC G:X["^"!$D(DTOUT) KIL S RDA=$S(Y<1:0,1:+Y) K DIC
7 K IOP,%ZIS S %ZIS("A")="Print on Device: ",%ZIS="MQ" W ! D ^%ZIS K %ZIS,IOP G:POP KIL
8 I $D(IO("Q")) S FHPGM="Q1^FHREC6",FHLST="L1^RDA^REC" D EN2^FH G FHREC6
9 U IO D Q1 D ^%ZISC K %ZIS,IOP G FHREC6
10Q1 ; List Analysis
11 S PW=$P($G(^FHNU(L1,0)),"^",4) Q:'PW
12 S Y=$G(^FHNU(L1,1)) F K=1:1:20 S Z1=$P(Y,"^",K) I Z1'="" S A(K)=$J(Z1*PW/100,0,3)
13 S Y=$G(^FHNU(L1,2)) F K=21:1:38 S Z1=$P(Y,"^",K-20) I Z1'="" S A(K)=$J(Z1*PW/100,0,3)
14 S Y=$G(^FHNU(L1,3)) F K=39:1:56 S Z1=$P(Y,"^",K-38) I Z1'="" S A(K)=$J(Z1*PW/100,0,3)
15 S Y=$G(^FHNU(L1,4)) F K=57:1:66 S Z1=$P(Y,"^",K-56) I Z1'="" S A(K)=$J(Z1*PW/100,0,3)
16 S ZR=$S(RDA:^FH(112.2,RDA,1),1:""),TIT=$P($G(^FH(114,REC,0)),"^",1),ANS=""
17 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)
18 K B F KK=1:1:66 S B(KK)=0
19 K M,N F KK=0:0 S KK=$O(^FH(114,REC,"R",KK)) Q:KK<1 S Y0=$G(^(KK,0)) D R1
20 F KK=0:0 S KK=$O(^FH(114,REC,"I",KK)) Q:KK<1 S Y0=$G(^(KK,0)) I +Y0 S ER="A",NAM=$P($G(^FHING(+Y0,0)),"^",1) I NAM'="" D GET
21 W:$E(IOST,1,2)="C-" @IOF W !?25,"--- Recipe Ingredient List ---",!!?(80-$L(TIT)\2),TIT
22 W !!,"Number of Portions: ",$P($G(^FH(114,REC,0)),"^",2)
23 W !!,"Ingredient",?34,"Amt In Lbs",?46,"Associated Nutrient",!
24 S ER="A",CTR=0 D P1 Q:ANS="^"
25 K M(ER) S R2="" F KK=0:0 S R2=$O(N(R2)) Q:R2="" S ER=$G(N(R2)) W !!,"Embedded Recipe: ",R2,!!,"Ingredient",?34,"Amt In LBS",?46,"Associated Nutrient",! S CTR=CTR+1 D P1 Q:ANS="^"
26 D PSE Q:ANS="^" W @IOF,!?23,"--- Analysis of Recipe Portion ---",!!?(80-$L(TIT)\2),TIT,!!?34,"%",?39,"%",?76,"%",!
27 W ?33,"DRI",?37,"Kcal",?75,"DRI",!
28 F K=1:1:34 S Y=$T(COM+K^FHNU6),Z1=$P(Y,";",3) D LST
29 D PSE Q:ANS="^" F K=35:1:70 S Y=$T(COM+K^FHNU6),Z1=$P(Y,";",3) D LST
30 W !!,"Grams/Portion: ",PW D PSE W ! Q
31LST W:K#2 ! Q:'Z1 S T1=$S(K#2:0,1:42)
32 W ?T1,$P(Y,";",4)," (",B(Z1),")" I B(Z1) W ?(T1+21),$J(A(Z1),7,$P(Y,";",6))," ",$P(Y,";",5)
33 S Z2=$P(Y,";",7) I Z2,ZR'="",$D(A(Z1)) S Z2=A(Z1)/$P(ZR,U,Z2) W ?(T1+33),$J(Z2*100,3,0)
34 I $D(C(Z1)) W ?(T1+37),C(Z1)
35 Q
36R1 ; Embedded Recipe List
37 S R1=+Y0 Q:'R1 S R2=$P($G(^FH(114,R1,0)),"^",1) Q:R2="" S ER=R1 S:'$D(N(R2)) N(R2)=R1
38 F LL=0:0 S LL=$O(^FH(114,R1,"I",LL)) Q:LL<1 S Y0=$G(^(LL,0)) I +Y0 S NAM=$P($G(^FHING(+Y0,0)),"^",1) I NAM'="" D GET
39 Q
40GET ; Set Ingredient List
41 S K1=+$P(Y0,"^",3)
42 S:'$D(M(ER,NAM)) M(ER,NAM)=$E($P($G(^FHNU(K1,0)),"^",1),1,33)_"^"_$P(Y0,"^",4)
43 S Y=$G(^FHNU(K1,1)) F K=1:1:20 S Z1=$P(Y,"^",K) I Z1'="" S B(K)=B(K)+1
44 S Y=$G(^FHNU(K1,2)) F K=21:1:38 S Z1=$P(Y,"^",K-20) I Z1'="" S B(K)=B(K)+1
45 S Y=$G(^FHNU(K1,3)) F K=39:1:56 S Z1=$P(Y,"^",K-38) I Z1'="" S B(K)=B(K)+1
46 S Y=$G(^FHNU(K1,4)) F K=57:1:66 S Z1=$P(Y,"^",K-56) I Z1'="" S B(K)=B(K)+1
47 Q
48P1 S NAM=""
49 F LL=0:0 S NAM=$O(M(ER,NAM)) Q:NAM="" D Q:ANS="^"
50 .W !,$E(NAM,1,30),?32,$S($P(M(ER,NAM),"^",2):$J($P(M(ER,NAM),"^",2),10,3),1:$J("***",10)),?46,$S($P(M(ER,NAM),"^",1)'="":$P(M(ER,NAM),"^",1),1:"***")
51 .S CTR=CTR+1 I CTR>18 D PSE S CTR=0
52 .Q
53 Q
54PSE 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
55 Q
56KIL G KILL^XUSCLEAN
Note: See TracBrowser for help on using the repository browser.