FHIPST6 ; HISC/REL - Set up Recipe Analysis values ;5/4/93 14:19
;;5.5;DIETETICS;;Jan 28, 2005
F REC=0:0 S REC=$O(^FH(114,REC)) Q:REC<1 F KK=0:0 S KK=$O(^FH(114,REC,"I",KK)) Q:KK<1 S Y0=$G(^(KK,0)) D I1
Q
I1 ; Set up Ingredient values
Q:$P(Y0,"^",3) S I1=+Y0 Q:'I1 S AMT=$P(Y0,"^",2) Q:'AMT
S Y0=$G(^FHING(I1,0)),N1=$P(Y0,"^",21),A1=$P(Y0,"^",22) Q:'N1
S EP=$P($G(^FHNU(N1,0)),"^",5)
I A1 S A1=A1*AMT I EP,EP'=100 S A1=A1*EP/100
S $P(^FH(114,REC,"I",KK,0),"^",3,4)=N1_"^"_A1 Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HFHIPST6 500 printed Dec 13, 2024@01:47:45 Page 2
FHIPST6 ; HISC/REL - Set up Recipe Analysis values ;5/4/93 14:19
+1 ;;5.5;DIETETICS;;Jan 28, 2005
+2 FOR REC=0:0
SET REC=$ORDER(^FH(114,REC))
if REC<1
QUIT
FOR KK=0:0
SET KK=$ORDER(^FH(114,REC,"I",KK))
if KK<1
QUIT
SET Y0=$GET(^(KK,0))
DO I1
+3 QUIT
I1 ; Set up Ingredient values
+1 if $PIECE(Y0,"^",3)
QUIT
SET I1=+Y0
if 'I1
QUIT
SET AMT=$PIECE(Y0,"^",2)
if 'AMT
QUIT
+2 SET Y0=$GET(^FHING(I1,0))
SET N1=$PIECE(Y0,"^",21)
SET A1=$PIECE(Y0,"^",22)
if 'N1
QUIT
+3 SET EP=$PIECE($GET(^FHNU(N1,0)),"^",5)
+4 IF A1
SET A1=A1*AMT
IF EP
IF EP'=100
SET A1=A1*EP/100
+5 SET $PIECE(^FH(114,REC,"I",KK,0),"^",3,4)=N1_"^"_A1
QUIT
