- FHPRC11 ; HISC/NCA - Meal Analysis (cont.) ;2/15/95 16:10
- ;;5.5;DIETETICS;;Jan 28, 2005
- D Q1^FHPRC14
- PRT ; Print Meal Analysis
- D NOW^%DTC S DT=%,DTP=DT D DTP^FH S (DAY,PG)=0 G:SUM ^FHPRC12
- P1 S DAY=$O(^TMP($J,"R",DAY)) G:DAY="" ^FHPRC12 S MEAL=0,NEW=1
- P2 S MEAL=$O(^TMP($J,"R",DAY,MEAL)) G:MEAL="" P3
- I 'NEW W !!,"Meal ",MEAL,! S X=$G(^TMP($J,"RECIPES",DAY,MEAL,0)) S Y=$E($P($G(^FH(116.1,+$P(X,"^",1),0)),"^",1),1,22) W Y,!,"Prod Diet: " S Y=$E($P($G(^FH(116.2,+$P(X,"^",2),0)),"^",1),1,14) W Y,!
- D:NEW HEAD,HD1
- S RNAM="" F S RNAM=$O(^TMP($J,"R",DAY,MEAL,RNAM)) Q:RNAM="" S X0=$G(^(RNAM,0)),X1=$G(^(1)),X2=$G(^(2)),X3=$G(^(3)),X4=$G(^(4)),SVG=+X0 D:$Y>(IOSL-8) HEAD,HD1 W !,$J(SVG,4)," ",RNAM,?24,$J($P(X0,"^",2),5,0) D LIS^FHNU2
- D:$Y>(IOSL-10) HEAD,HD1 W !!?7,"Recipe Total",?29 S X1=$G(^TMP($J,"M",DAY,MEAL,1)),X2=$G(^(2)),X3=$G(^(3)),X4=$G(^(4)) D LIS^FHNU2
- W !?7,"% of Kcal",?36 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)
- G P2
- P3 D:$Y>(IOSL-12) HEAD,HD1 W !!,"Daily Total",?29 S X1=$G(^TMP($J,"D",DAY,1)),X2=$G(^(2)),X3=$G(^(3)),X4=$G(^(4)) D LIS^FHNU2
- I RDA W !,"% DRI",?29 D RDA^FHNU9
- W !,"% of Kcal",?36 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)
- W:$P(X1,"^",1) !!,"Kcal:N Ratio = ",$J(6.25*$P(X1,"^",4)/$P(X1,"^",1),0,0),":1"
- P4 S MEAL=0,NEW=1
- P5 S MEAL=$O(^TMP($J,"R",DAY,MEAL)) G:MEAL="" P6
- I 'NEW W !!,"Meal ",MEAL,! S X=$G(^TMP($J,"RECIPES",DAY,MEAL,0)) S Y=$E($P($G(^FH(116.1,+$P(X,"^",1),0)),"^",1),1,14) W Y,!,"PD: " S Y=$E($P($G(^FH(116.2,+$P(X,"^",2),0)),"^",1),1,11) W Y,!
- D:NEW HEAD,HD2
- S RNAM="" F S RNAM=$O(^TMP($J,"R",DAY,MEAL,RNAM)) Q:RNAM="" S X0=$G(^(RNAM,0)),X1=$G(^(1)),X2=$G(^(2)),X3=$G(^(3)),X4=$G(^(4)),SVG=+X0 D:$Y>(IOSL-8) HEAD,HD2 W !,$E(RNAM,1,10),?12 D LIS^FHNU2
- D:$Y>(IOSL-9) HEAD,HD2 W !!?3,"Total",?12 S X1=$G(^TMP($J,"M",DAY,MEAL,1)),X2=$G(^(2)),X3=$G(^(3)),X4=$G(^(4)) D LIS^FHNU2 G P5
- P6 D:$Y>(IOSL-10) HEAD,HD2 W !!,"Daily Total",?12 S X1=$G(^TMP($J,"D",DAY,1)),X2=$G(^(2)),X3=$G(^(3)),X4=$G(^(4)) D LIS^FHNU2
- I RDA W !,"% DRI",?12 D RDA^FHNU9
- G P1
- HEAD ; Print Header
- W:'($E(IOST,1,2)'="C-"&'PG) @IOF S PG=PG+1 D:PG=1 SITE^FH G:NAM'="" HEAD1
- W !,"Station #: ",SITE(1),?42,"A N A L Y S I S O F M E A L P O R T I O N",?124,"Page ",PG
- W !,"Station Name: ",SITE,?57,DTP W:RDA ?110,"DRI: ",$P(^FH(112.2,RDA,0),U,1)
- W !?(132-$L(MNAM)\2),MNAM S NEW=0 Q
- HEAD1 W !?42,"A N A L Y S I S O F M E A L P O R T I O N",?124,"Page ",PG,!?57,DTP
- W !?(132-$L(MNAM)\2),MNAM S NEW=0
- W !!,"Patient: ",NAM,?63,$S(SEX="M":"Male",1:"Female"),?124,"Age: ",AGE,! Q
- HD1 W !!,"Day ",DAY,!! W:MEAL'="" "Meal ",MEAL S:MEAL'="" X=$G(^TMP($J,"RECIPES",DAY,MEAL,0)) S Y=$S(MEAL'="":$E($P($G(^FH(116.1,+$P(X,"^",1),0)),"^",1),1,22),1:"") W !
- W Y,?24,"Quant Energ Pro CHO Fat Sod Pot Calc Phos Iron Zinc Mag Man Cop Sel DFib" S Y=$S(MEAL'="":$E($P($G(^FH(116.2,+$P(X,"^",2),0)),"^",1),1,14),1:"")
- W ! W:MEAL'="" "Prod Diet: ",Y W ?27,"Gm KCal Gm Gm Gm Mg Mg Mg Mg Mg Mg Mg Mg Mg Mcg Gm",!
- ;NUT String contains 7 characters per nut: 1=node in ^FHNU,2-3=pos. in ^FHNU, 4=field size, 5=# decimals, 6-7=pos. of DRI in ^FH(112.2
- S NUT="104700010171011037100102710011370191127020108701111170121097114114711511071131167218115621746661222376100" Q
- HD2 W !!,"Day ",DAY,!! W:MEAL'="" "Meal ",MEAL S:MEAL'="" X=$G(^TMP($J,"RECIPES",DAY,MEAL,0)) S Y=$S(MEAL'="":$E($P($G(^FH(116.1,+$P(X,"^",1),0)),"^",1),1,14),1:"") W !
- W Y,?18,"K A C E Rib Thi Nia B6 B12 Fol Pant Chol 18C2 18C3 Mono PuFA SaFa" S Y=$S(MEAL'="":$E($P($G(^FH(116.2,+$P(X,"^",2),0)),"^",1),1,11),1:"")
- W ! W:MEAL'="" "PD: ",Y W ?16,"Mcg RE Mg Mg Mg Mg Mg Mg Mcg Mcg Mg Mg Gm Gm Gm Gm Gm",!
- S NUT="46571262337002119710411771032217206120720522272072247208226721022572092237216229700022771002287100231710023271002307100" Q
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HFHPRC11 4059 printed Feb 18, 2025@23:20:35 Page 2
- FHPRC11 ; HISC/NCA - Meal Analysis (cont.) ;2/15/95 16:10
- +1 ;;5.5;DIETETICS;;Jan 28, 2005
- +2 DO Q1^FHPRC14
- PRT ; Print Meal Analysis
- +1 DO NOW^%DTC
- SET DT=%
- SET DTP=DT
- DO DTP^FH
- SET (DAY,PG)=0
- if SUM
- GOTO ^FHPRC12
- P1 SET DAY=$ORDER(^TMP($JOB,"R",DAY))
- if DAY=""
- GOTO ^FHPRC12
- SET MEAL=0
- SET NEW=1
- P2 SET MEAL=$ORDER(^TMP($JOB,"R",DAY,MEAL))
- if MEAL=""
- GOTO P3
- +1 IF 'NEW
- WRITE !!,"Meal ",MEAL,!
- SET X=$GET(^TMP($JOB,"RECIPES",DAY,MEAL,0))
- SET Y=$EXTRACT($PIECE($GET(^FH(116.1,+$PIECE(X,"^",1),0)),"^",1),1,22)
- WRITE Y,!,"Prod Diet: "
- SET Y=$EXTRACT($PIECE($GET(^FH(116.2,+$PIECE(X,"^",2),0)),"^",1),1,14)
- WRITE Y,!
- +2 if NEW
- DO HEAD
- DO HD1
- +3 SET RNAM=""
- FOR
- SET RNAM=$ORDER(^TMP($JOB,"R",DAY,MEAL,RNAM))
- if RNAM=""
- QUIT
- SET X0=$GET(^(RNAM,0))
- SET X1=$GET(^(1))
- SET X2=$GET(^(2))
- SET X3=$GET(^(3))
- SET X4=$GET(^(4))
- SET SVG=+X0
- if $Y>(IOSL-8)
- DO HEAD
- DO HD1
- WRITE !,$JUSTIFY(SVG,4)," ",RNAM,?24,$JUSTIFY($PIECE(X0,"^",2),5,0)
- DO LIS^FHNU2
- +4 if $Y>(IOSL-10)
- DO HEAD
- DO HD1
- WRITE !!?7,"Recipe Total",?29
- SET X1=$GET(^TMP($JOB,"M",DAY,MEAL,1))
- SET X2=$GET(^(2))
- SET X3=$GET(^(3))
- SET X4=$GET(^(4))
- DO LIS^FHNU2
- +5 WRITE !?7,"% of Kcal",?36
- 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)
- +6 GOTO P2
- P3 if $Y>(IOSL-12)
- DO HEAD
- DO HD1
- WRITE !!,"Daily Total",?29
- SET X1=$GET(^TMP($JOB,"D",DAY,1))
- SET X2=$GET(^(2))
- SET X3=$GET(^(3))
- SET X4=$GET(^(4))
- DO LIS^FHNU2
- +1 IF RDA
- WRITE !,"% DRI",?29
- DO RDA^FHNU9
- +2 WRITE !,"% of Kcal",?36
- 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 if $PIECE(X1,"^",1)
- WRITE !!,"Kcal:N Ratio = ",$JUSTIFY(6.25*$PIECE(X1,"^",4)/$PIECE(X1,"^",1),0,0),":1"
- P4 SET MEAL=0
- SET NEW=1
- P5 SET MEAL=$ORDER(^TMP($JOB,"R",DAY,MEAL))
- if MEAL=""
- GOTO P6
- +1 IF 'NEW
- WRITE !!,"Meal ",MEAL,!
- SET X=$GET(^TMP($JOB,"RECIPES",DAY,MEAL,0))
- SET Y=$EXTRACT($PIECE($GET(^FH(116.1,+$PIECE(X,"^",1),0)),"^",1),1,14)
- WRITE Y,!,"PD: "
- SET Y=$EXTRACT($PIECE($GET(^FH(116.2,+$PIECE(X,"^",2),0)),"^",1),1,11)
- WRITE Y,!
- +2 if NEW
- DO HEAD
- DO HD2
- +3 SET RNAM=""
- FOR
- SET RNAM=$ORDER(^TMP($JOB,"R",DAY,MEAL,RNAM))
- if RNAM=""
- QUIT
- SET X0=$GET(^(RNAM,0))
- SET X1=$GET(^(1))
- SET X2=$GET(^(2))
- SET X3=$GET(^(3))
- SET X4=$GET(^(4))
- SET SVG=+X0
- if $Y>(IOSL-8)
- DO HEAD
- DO HD2
- WRITE !,$EXTRACT(RNAM,1,10),?12
- DO LIS^FHNU2
- +4 if $Y>(IOSL-9)
- DO HEAD
- DO HD2
- WRITE !!?3,"Total",?12
- SET X1=$GET(^TMP($JOB,"M",DAY,MEAL,1))
- SET X2=$GET(^(2))
- SET X3=$GET(^(3))
- SET X4=$GET(^(4))
- DO LIS^FHNU2
- GOTO P5
- P6 if $Y>(IOSL-10)
- DO HEAD
- DO HD2
- WRITE !!,"Daily Total",?12
- SET X1=$GET(^TMP($JOB,"D",DAY,1))
- SET X2=$GET(^(2))
- SET X3=$GET(^(3))
- SET X4=$GET(^(4))
- DO LIS^FHNU2
- +1 IF RDA
- WRITE !,"% DRI",?12
- DO RDA^FHNU9
- +2 GOTO P1
- HEAD ; Print Header
- +1 if '($EXTRACT(IOST,1,2)'="C-"&'PG)
- WRITE @IOF
- SET PG=PG+1
- if PG=1
- DO SITE^FH
- if NAM'=""
- GOTO HEAD1
- +2 WRITE !,"Station #: ",SITE(1),?42,"A N A L Y S I S O F M E A L P O R T I O N",?124,"Page ",PG
- +3 WRITE !,"Station Name: ",SITE,?57,DTP
- if RDA
- WRITE ?110,"DRI: ",$PIECE(^FH(112.2,RDA,0),U,1)
- +4 WRITE !?(132-$LENGTH(MNAM)\2),MNAM
- SET NEW=0
- QUIT
- HEAD1 WRITE !?42,"A N A L Y S I S O F M E A L P O R T I O N",?124,"Page ",PG,!?57,DTP
- +1 WRITE !?(132-$LENGTH(MNAM)\2),MNAM
- SET NEW=0
- +2 WRITE !!,"Patient: ",NAM,?63,$SELECT(SEX="M":"Male",1:"Female"),?124,"Age: ",AGE,!
- QUIT
- HD1 WRITE !!,"Day ",DAY,!!
- if MEAL'=""
- WRITE "Meal ",MEAL
- if MEAL'=""
- SET X=$GET(^TMP($JOB,"RECIPES",DAY,MEAL,0))
- SET Y=$SELECT(MEAL'="":$EXTRACT($PIECE($GET(^FH(116.1,+$PIECE(X,"^",1),0)),"^",1),1,22),1:"")
- WRITE !
- +1 WRITE Y,?24,"Quant Energ Pro CHO Fat Sod Pot Calc Phos Iron Zinc Mag Man Cop Sel DFib"
- SET Y=$SELECT(MEAL'="":$EXTRACT($PIECE($GET(^FH(116.2,+$PIECE(X,"^",2),0)),"^",1),1,14),1:"")
- +2 WRITE !
- if MEAL'=""
- WRITE "Prod Diet: ",Y
- WRITE ?27,"Gm KCal Gm Gm Gm Mg Mg Mg Mg Mg Mg Mg Mg Mg Mcg Gm",!
- +3 ;NUT String contains 7 characters per nut: 1=node in ^FHNU,2-3=pos. in ^FHNU, 4=field size, 5=# decimals, 6-7=pos. of DRI in ^FH(112.2
- +4 SET NUT="104700010171011037100102710011370191127020108701111170121097114114711511071131167218115621746661222376100"
- QUIT
- HD2 WRITE !!,"Day ",DAY,!!
- if MEAL'=""
- WRITE "Meal ",MEAL
- if MEAL'=""
- SET X=$GET(^TMP($JOB,"RECIPES",DAY,MEAL,0))
- SET Y=$SELECT(MEAL'="":$EXTRACT($PIECE($GET(^FH(116.1,+$PIECE(X,"^",1),0)),"^",1),1,14),1:"")
- WRITE !
- +1 WRITE Y,?18,"K A C E Rib Thi Nia B6 B12 Fol Pant Chol 18C2 18C3 Mono PuFA SaFa"
- SET Y=$SELECT(MEAL'="":$EXTRACT($PIECE($GET(^FH(116.2,+$PIECE(X,"^",2),0)),"^",1),1,11),1:"")
- +2 WRITE !
- if MEAL'=""
- WRITE "PD: ",Y
- WRITE ?16,"Mcg RE Mg Mg Mg Mg Mg Mg Mcg Mcg Mg Mg Gm Gm Gm Gm Gm",!
- +3 SET NUT="46571262337002119710411771032217206120720522272072247208226721022572092237216229700022771002287100231710023271002307100"
- QUIT