source: WorldVistAEHR/trunk/r/DIETETICS-FH/FHNU8.m@ 1394

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

initial load of WorldVistAEHR

File size: 2.9 KB
Line 
1FHNU8 ; HISC/REL/NCA - Nutrient Intake Study ;11/16/93 09:52
2 ;;5.5;DIETETICS;;Jan 28, 2005
3 S %DT="X",X="T" D ^%DT,HDR S DT=Y
4F4 K DIC S MENU=0,DIC="^FHUM(",DIC(0)="AEQMZ",DIC("S")="I '$P(^(0),U,5)" W ! D ^DIC G KIL:U[X!$D(DTOUT),F4:Y<1 S MENU=+Y,MNAM="Menu: "_$P(Y,U,2),TYP=$P(Y(0),U,2)
5F5 K DIC S DIC="^FH(112.2,",DIC(0)="AEQM",DIC("A")="Select DRI Category: " W ! D ^DIC G:X["^"!$D(DTOUT) KIL S RDA=$S(Y<1:0,1:+Y) K DIC
6F1 S ALL=1 D ^FHDPA G PAT:X="*",KIL:'DFN G:FHDFN="" KIL S NAM=$P(Y(0),U,1),SEX=$P(Y(0),U,2),AGE=$P(Y(0),U,3) G:SEX=""!(AGE="") P1
7 I $P($G(^DPT(DFN,.35)),"^",1) W *7,!!?5," [ Patient has expired. ]" G KIL
8 S AGE=$E(DT,1,3)-$E(AGE,1,3)-($E(DT,4,7)<$E(AGE,4,7))
9F2 K IOP S %ZIS="MQ" W ! D ^%ZIS K %ZIS,IOP G:POP KIL
10 I $D(IO("Q")) S FHPGM="Q1^FHNU8",FHLST="MENU^MNAM^TYP^RDA^NAM^SEX^AGE^DTP" D EN2^FH G KIL
11 U IO D Q1 D ^%ZISC K %ZIS,IOP G KIL
12Q1 ; Printing Nutrient Intake
13 S %DT="X",X="T" D ^%DT S (DT,DTP)=Y D DTP^FH
14 D TOT^FHNU9,HEAD S (DAY,NDAY)=0,(T(1),T(2),T(3),T(4),T(5))=""
15C1 S DAY=$O(^TMP($J,"M",DAY)) G:DAY="" C4 S MEAL=0 W !!,"Day ",DAY
16C2 S MEAL=$O(^TMP($J,"M",DAY,MEAL)) G:MEAL="" C3 S X1=$G(^(MEAL,1)),X2=$G(^(2)),X3=$G(^(3)),X4=$G(^(4))
17 W !," Meal ",MEAL,?7 D LIS^FHNU2 G C2
18C3 S X1=$G(^TMP($J,"D",DAY,1)),X2=$G(^(2)),X3=$G(^(3)),X4=$G(^(4)),X5=$G(^(5)) W !!," Total",?8 D LIS^FHNU3
19 S NDAY=NDAY+1 I RDA W !," % DRI",?7 D RDA^FHNU9
20 W !," % Kcal",?14 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 D RAT F K=1:1:20 S Z1=$P(X1,"^",K) I Z1 S $P(T(1),"^",K)=$P(T(1),"^",K)+Z1
22 F K=1:1:13 S Z1=$P(X2,"^",K) I Z1 S $P(T(2),"^",K)=$P(T(2),"^",K)+Z1
23 F K=1:1:33 S:$P(X5,"^",K) $P(T(5),"^",K)=1
24 G C1
25C4 D AVG^FHNU3 W !!,"Day Avg." S X1=T(1),X2=T(2),X5=T(5) D LIS^FHNU3
26 I RDA W !," % DRI",?7 D RDA^FHNU9
27 W !," % Kcal",?14 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)
28 D RAT W !!,"'+' following a daily value indicates that incomplete data exists.",!
29KIL K ^TMP($J) G KILL^XUSCLEAN
30HDR W @IOF,!!?19,"N U T R I E N T I N T A K E S T U D Y",!! Q
31RAT W:$P(X1,"^",1) !," Kcal:N Ratio = ",$J(6.25*$P(X1,"^",4)/$P(X1,"^",1),0,0),":1" Q
32PAT R !!,"Enter Patient's Name: ",NAM:DTIME G:'$T!("^"[NAM) KIL
33 I NAM["?"!(NAM'?.ANP)!(NAM["^") W *7,!?5,"Enter Patient's Name to be printed on the report." G PAT
34P1 R !,"Sex: ",SEX:DTIME G:'$T!("^"[SEX) KIL S X=SEX D TR^FH S SEX=X I $P("MALE",SEX,1)'="",$P("FEMALE",SEX,1)'="" W *7," Enter M or F" G P1
35 S SEX=$E(SEX,1)
36P2 R !,"Age: ",AGE:DTIME G:'$T!("^"[AGE) KIL I AGE'?1N.N!(AGE<6)!(AGE>124) W !?5,"Enter Age in years between 6 and 124" G P2
37 G F2
38HEAD W:$E(IOST,1,2)="C-" @IOF W !?19,"N U T R I E N T I N T A K E S T U D Y",?68,DTP,!
39 W !,"Patient: ",NAM,?40,$S(SEX="M":"Male",1:"Female"),?70,"Age: ",AGE,!
40 W !?9,"Energ Pro CHO Fat Sod Pot Calc Phos Chol H2O"
41 W !?10,"KCal Gm Gm Gm Mg Mg Mg Mg Mg Ml",!
42 S NUT="1047000101710110371001027100113701911270201087011111701222970001057000" Q
Note: See TracBrowser for help on using the repository browser.