FHIPST6.m

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 ---FHIPST6   500     printed  Feb 18, 2025@23:14:08                                                                                                                                                                                                      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