source: WorldVistAEHR/trunk/r/DIETETICS-FH/FHPRC12.m@ 1361

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

initial load of WorldVistAEHR

File size: 2.9 KB
Line 
1FHPRC12 ; HISC/NCA - Meal Analysis Summary ;2/15/95 16:11
2 ;;5.5;DIETETICS;;Jan 28, 2005
3 W:'($E(IOST,1,2)'="C-"&'PG) @IOF S PG=PG+1 I PG=1 D SITE^FH
4 I NAM'="" W !?45,"M E A L A N A L Y S I S S U M M A R Y",?124,"Page ",PG,!?57,DTP,!?(132-$L(MNAM)\2),MNAM,!!,"Patient: ",NAM,?63,$S(SEX="M":"Male",1:"Female"),?124,"Age: ",AGE
5 I NAM="" W !,"Station #: ",SITE(1),?45,"M E A L A N A L Y S I S S U M M A R Y",?124,"Page ",PG
6 I NAM="" W !,"Station Name: ",SITE,?57,DTP W:RDA ?110,"DRI: ",$P(^FH(112.2,RDA,0),U,1)
7 I NAM="" W !?(132-$L(MNAM)\2),MNAM
8 S (T(1),T(2),T(3),T(4),T(5))="",NDAY=0
9 W !!,"Daily Totals",?20,"Energ Pro CHO Fat Sod Pot Calc Phos Iron Zinc Mag Man Cop Sel DFib K"
10 W !?21,"KCal Gm Gm Gm Mg Mg Mg Mg Mg Mg Mg Mg Mg Mcg Gm Mcg",!
11 S NUT="1047000101710110370001027000113701911270201087011111701210971141147115110711311672181157217466712223771004657126",DAY=0
12T1 S DAY=$O(^TMP($J,"D",DAY)) G:DAY="" T2 S X1=$G(^(DAY,1)),X2=$G(^(2)),X3=$G(^(3)),X4=$G(^(4)),X5=$G(^(5)),NDAY=NDAY+1
13 F K=1:1:20 S Z1=$P(X1,"^",K) I Z1 S $P(T(1),"^",K)=$P(T(1),"^",K)+Z1
14 F K=1:1:18 S Z1=$P(X2,"^",K) I Z1 S $P(T(2),"^",K)=$P(T(2),"^",K)+Z1
15 F K=9,10 S Z1=$P(X4,"^",K) I Z1 S $P(T(4),"^",K)=$P(T(4),"^",K)+Z1
16 F K=1:1:66 S:$P(X5,"^",K) $P(T(5),"^",K)=1
17 W !?3,"Day ",DAY,?19 D LIS G T1
18T2 D AVG W !!,"Daily Average",?19 S X1=T(1),X2=T(2),X4=T(4),X5=T(5) D LIS
19 I RDA W !,"Average % DRI",?18 D RDA^FHNU9
20 W !,"% of Kcal",?25 S Z1=$P(X1,"^",4) S:'Z1 Z1=1 F KK=1,3,2 W $J($P(X1,"^",KK)*$S(KK=2:900,1:400)/Z1,7,0)
21 W !!!!,"Daily Totals",?24,"A C E Rib Thi Nia B6 B12 Fol Pant Chol 18C2 18C3 Mono PuFa SaFa"
22 W !?23,"RE Mg Mg Mg Mg Mg Mg Mcg Mcg Mg Mg Gm Gm Gm Gm Gm",!
23 S NUT="2338002119710411771032217206120720522272072247208226721022572092237216229700022771002287100231710023271002307100",DAY=0
24T3 S DAY=$O(^TMP($J,"D",DAY)) G:DAY="" T4 S X1=$G(^(DAY,1)),X2=$G(^(2)),X4=$G(^(4)),X5=$G(^(5))
25 W !?3,"Day ",DAY,?18 D LIS G T3
26T4 W !!,"Daily Average",?18 S X1=T(1),X2=T(2),X4=T(4),X5=T(5) D LIS
27 I RDA W !,"Average % DRI",?17 D RDA^FHNU9
28 W:$P(X1,"^",1) !!,"Kcal:N Ratio = ",$J(6.25*$P(X1,"^",4)/$P(X1,"^",1),0,0),":1"
29 W !!,"'+' following a daily value indicates that incomplete data exists.",! G KIL^FHPRC10
30LIS ; List nutrient values
31 S KK=1
32L1 S NODE=$E(NUT,KK) Q:'NODE S ITM=+$E(NUT,KK+1,KK+2) Q:'ITM S SIZ=$E(NUT,KK+3),DEC=$E(NUT,KK+4),KK=KK+7
33 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))
34 S Z1=$S(Z1'="":$J(Z1,SIZ-1,DEC),1:$J(Z1,SIZ-1))_$S($P(X5,"^",ITM):"+",1:" ") W Z1 G L1
35AVG ; Get averages
36 S:'NDAY NDAY=1 F K=1:1:20 S $P(T(1),"^",K)=$J($P(T(1),"^",K)/NDAY,0,3)
37 F K=1:1:18 S $P(T(2),"^",K)=$J($P(T(2),"^",K)/NDAY,0,3)
38 F K=9,10 S $P(T(4),"^",K)=$J($P(T(4),"^",K)/NDAY,0,3)
39 Q
Note: See TracBrowser for help on using the repository browser.