FHNU9.m

FHNU9 ; HISC/REL/NCA - Nutrient Analysis Utilities ;7/29/94  11:54 

 ;;5.5;DIETETICS;;Jan 28, 2005

RDA ; Calculate RDA values

 S ZR=^FH(112.2,RDA,1),KK=1

R1 S NODE=$E(NUT,KK) Q:'NODE  S ITM=+$E(NUT,KK+1,KK+2) Q:'ITM  S SIZ=$E(NUT,KK+3),Q=+$E(NUT,KK+5,KK+6),KK=KK+7 I 'Q S Q=$J("",SIZ) G R2

 S Z1=$S(NODE=1:$P(X1,"^",ITM),NODE=2:$P(X2,"^",ITM-20),NODE=3:$P(X3,"^",ITM-38),1:$P(X4,"^",ITM-56))

 S Q=$J($S($P(ZR,"^",Q):Z1/$P(ZR,"^",Q)*100,1:""),SIZ,0)

R2 W Q G R1

TOT ; Calculate total nutrient values

 K ^TMP($J) S DAY=0

T1 S DAY=$O(^FHUM(MENU,1,DAY)) Q:DAY<1  S MEAL=0,(D(1),D(2),D(3),D(4),D(5))=""

T2 S MEAL=$O(^FHUM(MENU,1,DAY,1,MEAL)) I MEAL<1 S ^TMP($J,"D",DAY,1)=D(1),^(2)=D(2),^(4)=D(4),^(5)=D(5) G T1

 S (ITM,NM)=0,(T(1),T(2),T(3),T(4))=""

T3 S ITM=$O(^FHUM(MENU,1,DAY,1,MEAL,1,ITM)) I ITM<1 S ^TMP($J,"M",DAY,MEAL,1)=T(1),^(2)=T(2),^(4)=T(4) D ADD G T2

 S X=^FHUM(MENU,1,DAY,1,MEAL,1,ITM,0),Y(0)=^FHNU(+X,0),Y(1)=$G(^(1)),Y(2)=$G(^(2)),Y(4)=$G(^(4))

 S AMT=$P(X,"^",2) I TYP="C" S AMT=AMT*$P(Y(0),"^",4)

 S MUL=AMT/100 F K=1:1:20 S Z1=$P(Y(1),"^",K) S:Z1="" $P(D(5),"^",K)=1 I Z1 S Z1=$J(Z1*MUL,0,3),$P(Y(1),"^",K)=Z1,$P(T(1),"^",K)=$P(T(1),"^",K)+Z1

 F K=1:1:18 S Z1=$P(Y(2),"^",K) S:Z1="" $P(D(5),"^",K+20)=1 I Z1 S Z1=$J(Z1*MUL,0,3),$P(Y(2),"^",K)=Z1,$P(T(2),"^",K)=$P(T(2),"^",K)+Z1

 F K=9,10 S Z1=$P(Y(4),"^",K) S:Z1="" $P(D(5),"^",K+56)=1 I Z1 S Z1=$J(Z1*MUL,0,3),$P(Y(4),"^",K)=Z1,$P(T(4),"^",K)=$P(T(4),"^",K)+Z1

 S NM=NM+1,^TMP($J,"I",DAY,MEAL,NM,0)=$E($P(^FHNU(+X,0),"^",1),1,15)_"^"_AMT

 S ^TMP($J,"I",DAY,MEAL,NM,1)=Y(1),^(2)=Y(2),^(4)=Y(4) G T3

ADD ; Calculate Total Nutrient Values For a Day

 F KK=1:1:20 S Z1=$P(T(1),"^",KK) I Z1 S $P(D(1),"^",KK)=$P(D(1),"^",KK)+Z1

 F KK=1:1:18 S Z1=$P(T(2),"^",KK) I Z1 S $P(D(2),"^",KK)=$P(D(2),"^",KK)+Z1

 F KK=9,10 S Z1=$P(T(4),"^",KK) I Z1 S $P(D(4),"^",KK)=$P(D(4),"^",KK)+Z1

 Q

FHNU9     ; HISC/REL/NCA - Nutrient Analysis Utilities ;7/29/94  11:54 

 +1       ;;5.5;DIETETICS;;Jan 28, 2005

RDA       ; Calculate RDA values

 +1        SET ZR=^FH(112.2,RDA,1)

           SET KK=1

R1         SET NODE=$EXTRACT(NUT,KK)

           IF 'NODE

               QUIT 

           SET ITM=+$EXTRACT(NUT,KK+1,KK+2)

           IF 'ITM

               QUIT 

           SET SIZ=$EXTRACT(NUT,KK+3)

           SET Q=+$EXTRACT(NUT,KK+5,KK+6)

           SET KK=KK+7

           IF 'Q

               SET Q=$JUSTIFY("",SIZ)

               GOTO R2

 +1        SET Z1=$SELECT(NODE=1:$PIECE(X1,"^",ITM),NODE=2:$PIECE(X2,"^",ITM-20),NODE=3:$PIECE(X3,"^",ITM-38),1:$PIECE(X4,"^",ITM-56))

 +2        SET Q=$JUSTIFY($SELECT($PIECE(ZR,"^",Q):Z1/$PIECE(ZR,"^",Q)*100,1:""),SIZ,0)

R2         WRITE Q

           GOTO R1

TOT       ; Calculate total nutrient values

 +1        KILL ^TMP($JOB)

           SET DAY=0

T1         SET DAY=$ORDER(^FHUM(MENU,1,DAY))

           IF DAY<1

               QUIT 

           SET MEAL=0

           SET (D(1),D(2),D(3),D(4),D(5))=""

T2         SET MEAL=$ORDER(^FHUM(MENU,1,DAY,1,MEAL))

           IF MEAL<1

               SET ^TMP($JOB,"D",DAY,1)=D(1)

               SET ^(2)=D(2)

               SET ^(4)=D(4)

               SET ^(5)=D(5)

               GOTO T1

 +1        SET (ITM,NM)=0

           SET (T(1),T(2),T(3),T(4))=""

T3         SET ITM=$ORDER(^FHUM(MENU,1,DAY,1,MEAL,1,ITM))

           IF ITM<1

               SET ^TMP($JOB,"M",DAY,MEAL,1)=T(1)

               SET ^(2)=T(2)

               SET ^(4)=T(4)

               DO ADD

               GOTO T2

 +1        SET X=^FHUM(MENU,1,DAY,1,MEAL,1,ITM,0)

           SET Y(0)=^FHNU(+X,0)

           SET Y(1)=$GET(^(1))

           SET Y(2)=$GET(^(2))

           SET Y(4)=$GET(^(4))

 +2        SET AMT=$PIECE(X,"^",2)

           IF TYP="C"

               SET AMT=AMT*$PIECE(Y(0),"^",4)

 +3        SET MUL=AMT/100

           FOR K=1:1:20

               SET Z1=$PIECE(Y(1),"^",K)

               IF Z1=""

                   SET $PIECE(D(5),"^",K)=1

               IF Z1

                   SET Z1=$JUSTIFY(Z1*MUL,0,3)

                   SET $PIECE(Y(1),"^",K)=Z1

                   SET $PIECE(T(1),"^",K)=$PIECE(T(1),"^",K)+Z1

 +4        FOR K=1:1:18

               SET Z1=$PIECE(Y(2),"^",K)

               IF Z1=""

                   SET $PIECE(D(5),"^",K+20)=1

               IF Z1

                   SET Z1=$JUSTIFY(Z1*MUL,0,3)

                   SET $PIECE(Y(2),"^",K)=Z1

                   SET $PIECE(T(2),"^",K)=$PIECE(T(2),"^",K)+Z1

 +5        FOR K=9,10

               SET Z1=$PIECE(Y(4),"^",K)

               IF Z1=""

                   SET $PIECE(D(5),"^",K+56)=1

               IF Z1

                   SET Z1=$JUSTIFY(Z1*MUL,0,3)

                   SET $PIECE(Y(4),"^",K)=Z1

                   SET $PIECE(T(4),"^",K)=$PIECE(T(4),"^",K)+Z1

 +6        SET NM=NM+1

           SET ^TMP($JOB,"I",DAY,MEAL,NM,0)=$EXTRACT($PIECE(^FHNU(+X,0),"^",1),1,15)_"^"_AMT

 +7        SET ^TMP($JOB,"I",DAY,MEAL,NM,1)=Y(1)

           SET ^(2)=Y(2)

           SET ^(4)=Y(4)

           GOTO T3

ADD       ; Calculate Total Nutrient Values For a Day

 +1        FOR KK=1:1:20

               SET Z1=$PIECE(T(1),"^",KK)

               IF Z1

                   SET $PIECE(D(1),"^",KK)=$PIECE(D(1),"^",KK)+Z1

 +2        FOR KK=1:1:18

               SET Z1=$PIECE(T(2),"^",KK)

               IF Z1

                   SET $PIECE(D(2),"^",KK)=$PIECE(D(2),"^",KK)+Z1

 +3        FOR KK=9,10

               SET Z1=$PIECE(T(4),"^",KK)

               IF Z1

                   SET $PIECE(D(4),"^",KK)=$PIECE(D(4),"^",KK)+Z1

 +4        QUIT