source: FOIAVistA/trunk/r/DIETETICS-FH/FHNU9.m@ 1607

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

initial load of FOIAVistA 6/30/08 version

File size: 1.8 KB
Line 
1FHNU9 ; HISC/REL/NCA - Nutrient Analysis Utilities ;7/29/94 11:54
2 ;;5.5;DIETETICS;;Jan 28, 2005
3RDA ; Calculate RDA values
4 S ZR=^FH(112.2,RDA,1),KK=1
5R1 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
6 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))
7 S Q=$J($S($P(ZR,"^",Q):Z1/$P(ZR,"^",Q)*100,1:""),SIZ,0)
8R2 W Q G R1
9TOT ; Calculate total nutrient values
10 K ^TMP($J) S DAY=0
11T1 S DAY=$O(^FHUM(MENU,1,DAY)) Q:DAY<1 S MEAL=0,(D(1),D(2),D(3),D(4),D(5))=""
12T2 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
13 S (ITM,NM)=0,(T(1),T(2),T(3),T(4))=""
14T3 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
15 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))
16 S AMT=$P(X,"^",2) I TYP="C" S AMT=AMT*$P(Y(0),"^",4)
17 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
18 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
19 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
20 S NM=NM+1,^TMP($J,"I",DAY,MEAL,NM,0)=$E($P(^FHNU(+X,0),"^",1),1,15)_"^"_AMT
21 S ^TMP($J,"I",DAY,MEAL,NM,1)=Y(1),^(2)=Y(2),^(4)=Y(4) G T3
22ADD ; Calculate Total Nutrient Values For a Day
23 F KK=1:1:20 S Z1=$P(T(1),"^",KK) I Z1 S $P(D(1),"^",KK)=$P(D(1),"^",KK)+Z1
24 F KK=1:1:18 S Z1=$P(T(2),"^",KK) I Z1 S $P(D(2),"^",KK)=$P(D(2),"^",KK)+Z1
25 F KK=9,10 S Z1=$P(T(4),"^",KK) I Z1 S $P(D(4),"^",KK)=$P(D(4),"^",KK)+Z1
26 Q
Note: See TracBrowser for help on using the repository browser.