FHNU8 ; HISC/REL/NCA - Nutrient Intake Study ;11/16/93 09:52
;;5.5;DIETETICS;;Jan 28, 2005
S %DT="X",X="T" D ^%DT,HDR S DT=Y
F4 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)
F5 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
F1 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
I $P($G(^DPT(DFN,.35)),"^",1) W *7,!!?5," [ Patient has expired. ]" G KIL
S AGE=$E(DT,1,3)-$E(AGE,1,3)-($E(DT,4,7)<$E(AGE,4,7))
F2 K IOP S %ZIS="MQ" W ! D ^%ZIS K %ZIS,IOP G:POP KIL
I $D(IO("Q")) S FHPGM="Q1^FHNU8",FHLST="MENU^MNAM^TYP^RDA^NAM^SEX^AGE^DTP" D EN2^FH G KIL
U IO D Q1 D ^%ZISC K %ZIS,IOP G KIL
Q1 ; Printing Nutrient Intake
S %DT="X",X="T" D ^%DT S (DT,DTP)=Y D DTP^FH
D TOT^FHNU9,HEAD S (DAY,NDAY)=0,(T(1),T(2),T(3),T(4),T(5))=""
C1 S DAY=$O(^TMP($J,"M",DAY)) G:DAY="" C4 S MEAL=0 W !!,"Day ",DAY
C2 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))
W !," Meal ",MEAL,?7 D LIS^FHNU2 G C2
C3 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
S NDAY=NDAY+1 I RDA W !," % DRI",?7 D RDA^FHNU9
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)
D RAT F K=1:1:20 S Z1=$P(X1,"^",K) I Z1 S $P(T(1),"^",K)=$P(T(1),"^",K)+Z1
F K=1:1:13 S Z1=$P(X2,"^",K) I Z1 S $P(T(2),"^",K)=$P(T(2),"^",K)+Z1
F K=1:1:33 S:$P(X5,"^",K) $P(T(5),"^",K)=1
G C1
C4 D AVG^FHNU3 W !!,"Day Avg." S X1=T(1),X2=T(2),X5=T(5) D LIS^FHNU3
I RDA W !," % DRI",?7 D RDA^FHNU9
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)
D RAT W !!,"'+' following a daily value indicates that incomplete data exists.",!
KIL K ^TMP($J) G KILL^XUSCLEAN
HDR W @IOF,!!?19,"N U T R I E N T I N T A K E S T U D Y",!! Q
RAT W:$P(X1,"^",1) !," Kcal:N Ratio = ",$J(6.25*$P(X1,"^",4)/$P(X1,"^",1),0,0),":1" Q
PAT R !!,"Enter Patient's Name: ",NAM:DTIME G:'$T!("^"[NAM) KIL
I NAM["?"!(NAM'?.ANP)!(NAM["^") W *7,!?5,"Enter Patient's Name to be printed on the report." G PAT
P1 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
S SEX=$E(SEX,1)
P2 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
G F2
HEAD 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,!
W !,"Patient: ",NAM,?40,$S(SEX="M":"Male",1:"Female"),?70,"Age: ",AGE,!
W !?9,"Energ Pro CHO Fat Sod Pot Calc Phos Chol H2O"
W !?10,"KCal Gm Gm Gm Mg Mg Mg Mg Mg Ml",!
S NUT="1047000101710110371001027100113701911270201087011111701222970001057000" Q
FHNU8 ; HISC/REL/NCA - Nutrient Intake Study ;11/16/93 09:52
+1 ;;5.5;DIETETICS;;Jan 28, 2005
+2 SET %DT="X"
SET X="T"
DO ^%DT
DO HDR
SET DT=Y
F4 KILL DIC
SET MENU=0
SET DIC="^FHUM("
SET DIC(0)="AEQMZ"
SET DIC("S")="I '$P(^(0),U,5)"
WRITE !
DO ^DIC
IF U[X!$DATA(DTOUT)
GOTO KIL
IF Y<1
GOTO F4
SET MENU=+Y
SET MNAM="Menu: "_$PIECE(Y,U,2)
SET TYP=$PIECE(Y(0),U,2)
F5 KILL DIC
SET DIC="^FH(112.2,"
SET DIC(0)="AEQM"
SET DIC("A")="Select DRI Category: "
WRITE !
DO ^DIC
IF X["^"!$DATA(DTOUT)
GOTO KIL
SET RDA=$SELECT(Y<1:0,1:+Y)
KILL DIC
F1 SET ALL=1
DO ^FHDPA
IF X="*"
GOTO PAT
IF 'DFN
GOTO KIL
IF FHDFN=""
GOTO KIL
SET NAM=$PIECE(Y(0),U,1)
SET SEX=$PIECE(Y(0),U,2)
SET AGE=$PIECE(Y(0),U,3)
IF SEX=""!(AGE="")
GOTO P1
+1 IF $PIECE($GET(^DPT(DFN,.35)),"^",1)
WRITE *7,!!?5," [ Patient has expired. ]"
GOTO KIL
+2 SET AGE=$EXTRACT(DT,1,3)-$EXTRACT(AGE,1,3)-($EXTRACT(DT,4,7)<$EXTRACT(AGE,4,7))
F2 KILL IOP
SET %ZIS="MQ"
WRITE !
DO ^%ZIS
KILL %ZIS,IOP
IF POP
GOTO KIL
+1 IF $DATA(IO("Q"))
SET FHPGM="Q1^FHNU8"
SET FHLST="MENU^MNAM^TYP^RDA^NAM^SEX^AGE^DTP"
DO EN2^FH
GOTO KIL
+2 USE IO
DO Q1
DO ^%ZISC
KILL %ZIS,IOP
GOTO KIL
Q1 ; Printing Nutrient Intake
+1 SET %DT="X"
SET X="T"
DO ^%DT
SET (DT,DTP)=Y
DO DTP^FH
+2 DO TOT^FHNU9
DO HEAD
SET (DAY,NDAY)=0
SET (T(1),T(2),T(3),T(4),T(5))=""
C1 SET DAY=$ORDER(^TMP($JOB,"M",DAY))
IF DAY=""
GOTO C4
SET MEAL=0
WRITE !!,"Day ",DAY
C2 SET MEAL=$ORDER(^TMP($JOB,"M",DAY,MEAL))
IF MEAL=""
GOTO C3
SET X1=$GET(^(MEAL,1))
SET X2=$GET(^(2))
SET X3=$GET(^(3))
SET X4=$GET(^(4))
+1 WRITE !," Meal ",MEAL,?7
DO LIS^FHNU2
GOTO C2
C3 SET X1=$GET(^TMP($JOB,"D",DAY,1))
SET X2=$GET(^(2))
SET X3=$GET(^(3))
SET X4=$GET(^(4))
SET X5=$GET(^(5))
WRITE !!," Total",?8
DO LIS^FHNU3
+1 SET NDAY=NDAY+1
IF RDA
WRITE !," % DRI",?7
DO RDA^FHNU9
+2 WRITE !," % Kcal",?14
SET Z1=$PIECE(X1,"^",4)
IF 'Z1
SET Z1=1
FOR KK=1,3,2
WRITE $JUSTIFY($PIECE(X1,"^",KK)*$SELECT(KK=2:900,1:400)/Z1,7,0)
+3 DO RAT
FOR K=1:1:20
SET Z1=$PIECE(X1,"^",K)
IF Z1
SET $PIECE(T(1),"^",K)=$PIECE(T(1),"^",K)+Z1
+4 FOR K=1:1:13
SET Z1=$PIECE(X2,"^",K)
IF Z1
SET $PIECE(T(2),"^",K)=$PIECE(T(2),"^",K)+Z1
+5 FOR K=1:1:33
IF $PIECE(X5,"^",K)
SET $PIECE(T(5),"^",K)=1
+6 GOTO C1
C4 DO AVG^FHNU3
WRITE !!,"Day Avg."
SET X1=T(1)
SET X2=T(2)
SET X5=T(5)
DO LIS^FHNU3
+1 IF RDA
WRITE !," % DRI",?7
DO RDA^FHNU9
+2 WRITE !," % Kcal",?14
SET Z1=$PIECE(X1,"^",4)
IF 'Z1
SET Z1=1
FOR KK=1,3,2
WRITE $JUSTIFY($PIECE(X1,"^",KK)*$SELECT(KK=2:900,1:400)/Z1,7,0)
+3 DO RAT
WRITE !!,"'+' following a daily value indicates that incomplete data exists.",!
KIL KILL ^TMP($JOB)
GOTO KILL^XUSCLEAN
HDR WRITE @IOF,!!?19,"N U T R I E N T I N T A K E S T U D Y",!!
QUIT
RAT IF $PIECE(X1,"^",1)
WRITE !," Kcal:N Ratio = ",$JUSTIFY(6.25*$PIECE(X1,"^",4)/$PIECE(X1,"^",1),0,0),":1"
QUIT
PAT READ !!,"Enter Patient's Name: ",NAM:DTIME
IF '$TEST!("^"[NAM)
GOTO KIL
+1 IF NAM["?"!(NAM'?.ANP)!(NAM["^")
WRITE *7,!?5,"Enter Patient's Name to be printed on the report."
GOTO PAT
P1 READ !,"Sex: ",SEX:DTIME
IF '$TEST!("^"[SEX)
GOTO KIL
SET X=SEX
DO TR^FH
SET SEX=X
IF $PIECE("MALE",SEX,1)'=""
IF $PIECE("FEMALE",SEX,1)'=""
WRITE *7," Enter M or F"
GOTO P1
+1 SET SEX=$EXTRACT(SEX,1)
P2 READ !,"Age: ",AGE:DTIME
IF '$TEST!("^"[AGE)
GOTO KIL
IF AGE'?1N.N!(AGE<6)!(AGE>124)
WRITE !?5,"Enter Age in years between 6 and 124"
GOTO P2
+1 GOTO F2
HEAD IF $EXTRACT(IOST,1,2)="C-"
WRITE @IOF
WRITE !?19,"N U T R I E N T I N T A K E S T U D Y",?68,DTP,!
+1 WRITE !,"Patient: ",NAM,?40,$SELECT(SEX="M":"Male",1:"Female"),?70,"Age: ",AGE,!
+2 WRITE !?9,"Energ Pro CHO Fat Sod Pot Calc Phos Chol H2O"
+3 WRITE !?10,"KCal Gm Gm Gm Mg Mg Mg Mg Mg Ml",!
+4 SET NUT="1047000101710110371001027100113701911270201087011111701222970001057000"
QUIT
