FHREC6 ; HISC/REL/NCA - Recipe Analysis Output ;7/30/93 15:05
;;5.5;DIETETICS;;Jan 28, 2005
K DIC S DIC="^FH(114,",DIC(0)="AEQM" W ! D ^DIC G:Y<1 KIL S REC=+Y
S L1=$P($G(^FH(114,REC,0)),"^",14)
I 'L1 W !!,"This Recipe has not been analyzed." G FHREC6
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
K IOP,%ZIS S %ZIS("A")="Print on Device: ",%ZIS="MQ" W ! D ^%ZIS K %ZIS,IOP G:POP KIL
I $D(IO("Q")) S FHPGM="Q1^FHREC6",FHLST="L1^RDA^REC" D EN2^FH G FHREC6
U IO D Q1 D ^%ZISC K %ZIS,IOP G FHREC6
Q1 ; List Analysis
S PW=$P($G(^FHNU(L1,0)),"^",4) Q:'PW
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)
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)
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)
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)
S ZR=$S(RDA:^FH(112.2,RDA,1),1:""),TIT=$P($G(^FH(114,REC,0)),"^",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)
K B F KK=1:1:66 S B(KK)=0
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
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
W:$E(IOST,1,2)="C-" @IOF W !?25,"--- Recipe Ingredient List ---",!!?(80-$L(TIT)\2),TIT
W !!,"Number of Portions: ",$P($G(^FH(114,REC,0)),"^",2)
W !!,"Ingredient",?34,"Amt In Lbs",?46,"Associated Nutrient",!
S ER="A",CTR=0 D P1 Q:ANS="^"
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="^"
D PSE Q:ANS="^" W @IOF,!?23,"--- Analysis of Recipe Portion ---",!!?(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^FHNU6),Z1=$P(Y,";",3) D LST
D PSE Q:ANS="^" F K=35:1:70 S Y=$T(COM+K^FHNU6),Z1=$P(Y,";",3) D LST
W !!,"Grams/Portion: ",PW D PSE W ! 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'="",$D(A(Z1)) 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
R1 ; Embedded Recipe List
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
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
Q
GET ; Set Ingredient List
S K1=+$P(Y0,"^",3)
S:'$D(M(ER,NAM)) M(ER,NAM)=$E($P($G(^FHNU(K1,0)),"^",1),1,33)_"^"_$P(Y0,"^",4)
S Y=$G(^FHNU(K1,1)) F K=1:1:20 S Z1=$P(Y,"^",K) I Z1'="" S B(K)=B(K)+1
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
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
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
Q
P1 S NAM=""
F LL=0:0 S NAM=$O(M(ER,NAM)) Q:NAM="" D Q:ANS="^"
.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:"***")
.S CTR=CTR+1 I CTR>18 D PSE S CTR=0
.Q
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
KIL G KILL^XUSCLEAN
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HFHREC6 3535 printed Dec 13, 2024@01:54:56 Page 2
FHREC6 ; HISC/REL/NCA - Recipe Analysis Output ;7/30/93 15:05
+1 ;;5.5;DIETETICS;;Jan 28, 2005
+2 KILL DIC
SET DIC="^FH(114,"
SET DIC(0)="AEQM"
WRITE !
DO ^DIC
if Y<1
GOTO KIL
SET REC=+Y
+3 SET L1=$PIECE($GET(^FH(114,REC,0)),"^",14)
+4 IF 'L1
WRITE !!,"This Recipe has not been analyzed."
GOTO FHREC6
+5 KILL DIC
SET DIC="^FH(112.2,"
SET DIC(0)="AEQM"
SET DIC("A")="Select DRI Category: "
WRITE !
DO ^DIC
if X["^"!$DATA(DTOUT)
GOTO KIL
SET RDA=$SELECT(Y<1:0,1:+Y)
KILL DIC
+6 KILL IOP,%ZIS
SET %ZIS("A")="Print on Device: "
SET %ZIS="MQ"
WRITE !
DO ^%ZIS
KILL %ZIS,IOP
if POP
GOTO KIL
+7 IF $DATA(IO("Q"))
SET FHPGM="Q1^FHREC6"
SET FHLST="L1^RDA^REC"
DO EN2^FH
GOTO FHREC6
+8 USE IO
DO Q1
DO ^%ZISC
KILL %ZIS,IOP
GOTO FHREC6
Q1 ; List Analysis
+1 SET PW=$PIECE($GET(^FHNU(L1,0)),"^",4)
if 'PW
QUIT
+2 SET Y=$GET(^FHNU(L1,1))
FOR K=1:1:20
SET Z1=$PIECE(Y,"^",K)
IF Z1'=""
SET A(K)=$JUSTIFY(Z1*PW/100,0,3)
+3 SET Y=$GET(^FHNU(L1,2))
FOR K=21:1:38
SET Z1=$PIECE(Y,"^",K-20)
IF Z1'=""
SET A(K)=$JUSTIFY(Z1*PW/100,0,3)
+4 SET Y=$GET(^FHNU(L1,3))
FOR K=39:1:56
SET Z1=$PIECE(Y,"^",K-38)
IF Z1'=""
SET A(K)=$JUSTIFY(Z1*PW/100,0,3)
+5 SET Y=$GET(^FHNU(L1,4))
FOR K=57:1:66
SET Z1=$PIECE(Y,"^",K-56)
IF Z1'=""
SET A(K)=$JUSTIFY(Z1*PW/100,0,3)
+6 SET ZR=$SELECT(RDA:^FH(112.2,RDA,1),1:"")
SET TIT=$PIECE($GET(^FH(114,REC,0)),"^",1)
SET ANS=""
+7 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)
+8 KILL B
FOR KK=1:1:66
SET B(KK)=0
+9 KILL M,N
FOR KK=0:0
SET KK=$ORDER(^FH(114,REC,"R",KK))
if KK<1
QUIT
SET Y0=$GET(^(KK,0))
DO R1
+10 FOR KK=0:0
SET KK=$ORDER(^FH(114,REC,"I",KK))
if KK<1
QUIT
SET Y0=$GET(^(KK,0))
IF +Y0
SET ER="A"
SET NAM=$PIECE($GET(^FHING(+Y0,0)),"^",1)
IF NAM'=""
DO GET
+11 if $EXTRACT(IOST,1,2)="C-"
WRITE @IOF
WRITE !?25,"--- Recipe Ingredient List ---",!!?(80-$LENGTH(TIT)\2),TIT
+12 WRITE !!,"Number of Portions: ",$PIECE($GET(^FH(114,REC,0)),"^",2)
+13 WRITE !!,"Ingredient",?34,"Amt In Lbs",?46,"Associated Nutrient",!
+14 SET ER="A"
SET CTR=0
DO P1
if ANS="^"
QUIT
+15 KILL M(ER)
SET R2=""
FOR KK=0:0
SET R2=$ORDER(N(R2))
if R2=""
QUIT
SET ER=$GET(N(R2))
WRITE !!,"Embedded Recipe: ",R2,!!,"Ingredient",?34,"Amt In LBS",?46,"Associated Nutrient",!
SET CTR=CTR+1
DO P1
if ANS="^"
QUIT
+16 DO PSE
if ANS="^"
QUIT
WRITE @IOF,!?23,"--- Analysis of Recipe Portion ---",!!?(80-$LENGTH(TIT)\2),TIT,!!?34,"%",?39,"%",?76,"%",!
+17 WRITE ?33,"DRI",?37,"Kcal",?75,"DRI",!
+18 FOR K=1:1:34
SET Y=$TEXT(COM+K^FHNU6)
SET Z1=$PIECE(Y,";",3)
DO LST
+19 DO PSE
if ANS="^"
QUIT
FOR K=35:1:70
SET Y=$TEXT(COM+K^FHNU6)
SET Z1=$PIECE(Y,";",3)
DO LST
+20 WRITE !!,"Grams/Portion: ",PW
DO PSE
WRITE !
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'=""
IF $DATA(A(Z1))
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
R1 ; Embedded Recipe List
+1 SET R1=+Y0
if 'R1
QUIT
SET R2=$PIECE($GET(^FH(114,R1,0)),"^",1)
if R2=""
QUIT
SET ER=R1
if '$DATA(N(R2))
SET N(R2)=R1
+2 FOR LL=0:0
SET LL=$ORDER(^FH(114,R1,"I",LL))
if LL<1
QUIT
SET Y0=$GET(^(LL,0))
IF +Y0
SET NAM=$PIECE($GET(^FHING(+Y0,0)),"^",1)
IF NAM'=""
DO GET
+3 QUIT
GET ; Set Ingredient List
+1 SET K1=+$PIECE(Y0,"^",3)
+2 if '$DATA(M(ER,NAM))
SET M(ER,NAM)=$EXTRACT($PIECE($GET(^FHNU(K1,0)),"^",1),1,33)_"^"_$PIECE(Y0,"^",4)
+3 SET Y=$GET(^FHNU(K1,1))
FOR K=1:1:20
SET Z1=$PIECE(Y,"^",K)
IF Z1'=""
SET B(K)=B(K)+1
+4 SET Y=$GET(^FHNU(K1,2))
FOR K=21:1:38
SET Z1=$PIECE(Y,"^",K-20)
IF Z1'=""
SET B(K)=B(K)+1
+5 SET Y=$GET(^FHNU(K1,3))
FOR K=39:1:56
SET Z1=$PIECE(Y,"^",K-38)
IF Z1'=""
SET B(K)=B(K)+1
+6 SET Y=$GET(^FHNU(K1,4))
FOR K=57:1:66
SET Z1=$PIECE(Y,"^",K-56)
IF Z1'=""
SET B(K)=B(K)+1
+7 QUIT
P1 SET NAM=""
+1 FOR LL=0:0
SET NAM=$ORDER(M(ER,NAM))
if NAM=""
QUIT
Begin DoDot:1
+2 WRITE !,$EXTRACT(NAM,1,30),?32,$SELECT($PIECE(M(ER,NAM),"^",2):$JUSTIFY($PIECE(M(ER,NAM),"^",2),10,3),1:$JUSTIFY("***",10)),?46,$SELECT($PIECE(M(ER,NAM),"^",1)'="":$PIECE(M(ER,NAM),"^",1),1:"***")
+3 SET CTR=CTR+1
IF CTR>18
DO PSE
SET CTR=0
+4 QUIT
End DoDot:1
if ANS="^"
QUIT
+5 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
KIL GOTO KILL^XUSCLEAN
