- FHNU2 ; HISC/REL/NCA - Analyze Menu ;3/6/95 15:53
- ;;5.5;DIETETICS;;Jan 28, 2005
- GET 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),GET:Y<1 S MENU=+Y,MNAM="Menu: "_$P(Y,U,2),TYP=$P(Y(0),U,2)
- F0 K DIC S DIC="^FH(112.2,",DIC(0)="AEQM",DIC("A")="Select DRI Category: " W ! D ^DIC G KIL:X["^"!$D(DTOUT),F0:Y<1 S RDA=+Y K DIC
- S0 R !!,"Do you wish a detailed analysis? Y// ",SUM:DTIME G:'$T!(SUM["^") KIL S:SUM="" SUM="Y" S X=SUM D TR^FH S SUM=X I $P("YES",SUM,1)'="",$P("NO",SUM,1)'="" W *7,!," Answer YES or NO" G S0
- S SUM=$E(SUM,1),SUM=SUM="N"
- W !!,"The Analysis requires a 132 column printer.",!
- K IOP S %ZIS="MQ" W ! D ^%ZIS K %ZIS,IOP G:POP KIL
- I $D(IO("Q")) S FHPGM="F1^FHNU2",FHLST="MENU^MNAM^TYP^RDA^SUM" D EN2^FH G KIL
- U IO X ^%ZOSF("BRK") D F1 X ^%ZOSF("NBRK") D ^%ZISC K %ZIS,IOP G KIL
- F1 ; Print Nutrient Menu Analysis
- S %DT="X",X="T" D ^%DT S DT=+Y,DTP=DT D DTP^FH,TOT^FHNU9 S (DAY,PG)=0 K D,T G:SUM ^FHNU3
- F5 S DAY=$O(^TMP($J,"I",DAY)) G:DAY="" ^FHNU3 S MEAL=0,NEW=1
- F6 S MEAL=$O(^TMP($J,"I",DAY,MEAL)) G:MEAL="" F8
- W:'NEW !!,"Meal ",MEAL,! D:NEW HEAD,HD1
- F7 F NM=1:1 Q:'$D(^TMP($J,"I",DAY,MEAL,NM)) S X0=$G(^(NM,0)),X1=$G(^(1)),X2=$G(^(2)),X3=$G(^(3)),X4=$G(^(4)) D:$Y>(IOSL-8) HEAD,HD1 W !,$J(NM,5)," ",$P(X0,"^",1),?24,$J($P(X0,"^",2),5,0) D LIS
- D:$Y>(IOSL-10) HEAD,HD1 W !!?7,"Meal Total",?29 S X1=$G(^TMP($J,"M",DAY,MEAL,1)),X2=$G(^(2)),X3=$G(^(3)),X4=$G(^(4)) D LIS
- 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 F6
- F8 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
- 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"
- S MEAL=0,NEW=1
- F9 S MEAL=$O(^TMP($J,"I",DAY,MEAL)) G:MEAL="" F11
- W:'NEW !!,"Meal ",MEAL,! D:NEW HEAD,HD2
- F10 F NM=1:1 Q:'$D(^TMP($J,"I",DAY,MEAL,NM)) S X0=$G(^(NM,0)),X1=$G(^(1)),X2=$G(^(2)),X3=$G(^(3)),X4=$G(^(4)) D:$Y>(IOSL-8) HEAD,HD2 W !,$J(NM,5),?12 D LIS
- 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 G F9
- F11 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
- W !,"% DRI",?12 D RDA^FHNU9 G F5
- LIS ; List nutrient values
- S KK=1
- L1 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
- 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))
- S Z1=$S(Z1'="":$J(Z1,SIZ,DEC),1:$J(Z1,SIZ)) W Z1 G L1
- KIL ; Final Variable Kill
- K ^TMP($J) G KILL^XUSCLEAN
- HEAD ; Print Header
- W:'($E(IOST,1,2)'="C-"&'PG) @IOF S PG=PG+1 I PG=1 D SITE^FH
- W !,"Station #: ",SITE(1),?44,"E N E R G Y / N U T R I E N T A N A L Y S I S",?124,"Page ",PG
- W !,"Station Name: ",SITE,?61,DTP,?110,"DRI: ",$P(^FH(112.2,RDA,0),U,1)
- W !?(132-$L(MNAM)\2),MNAM S NEW=0 Q
- HD1 W !!,"Day ",DAY,?24,"Quant Energ Pro CHO Fat Sod Pot Calc Phos Iron Zinc Mag Man Cop Sel DFib"
- W ! W:MEAL'="" "Meal ",MEAL 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,?18,"K A C E Rib Thi Nia B6 B12 Fol Pant Chol 18C2 18C3 Mono PuFA SaFa"
- W ! W:MEAL'="" "Meal ",MEAL 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[HFHNU2 4088 printed Feb 18, 2025@23:18:55 Page 2
- FHNU2 ; HISC/REL/NCA - Analyze Menu ;3/6/95 15:53
- +1 ;;5.5;DIETETICS;;Jan 28, 2005
- GET 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 GET
- SET MENU=+Y
- SET MNAM="Menu: "_$PIECE(Y,U,2)
- SET TYP=$PIECE(Y(0),U,2)
- F0 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
- if Y<1
- GOTO F0
- SET RDA=+Y
- KILL DIC
- S0 READ !!,"Do you wish a detailed analysis? Y// ",SUM:DTIME
- if '$TEST!(SUM["^")
- GOTO KIL
- if SUM=""
- SET SUM="Y"
- SET X=SUM
- DO TR^FH
- SET SUM=X
- IF $PIECE("YES",SUM,1)'=""
- IF $PIECE("NO",SUM,1)'=""
- WRITE *7,!," Answer YES or NO"
- GOTO S0
- +1 SET SUM=$EXTRACT(SUM,1)
- SET SUM=SUM="N"
- +2 WRITE !!,"The Analysis requires a 132 column printer.",!
- +3 KILL IOP
- SET %ZIS="MQ"
- WRITE !
- DO ^%ZIS
- KILL %ZIS,IOP
- if POP
- GOTO KIL
- +4 IF $DATA(IO("Q"))
- SET FHPGM="F1^FHNU2"
- SET FHLST="MENU^MNAM^TYP^RDA^SUM"
- DO EN2^FH
- GOTO KIL
- +5 USE IO
- XECUTE ^%ZOSF("BRK")
- DO F1
- XECUTE ^%ZOSF("NBRK")
- DO ^%ZISC
- KILL %ZIS,IOP
- GOTO KIL
- F1 ; Print Nutrient Menu Analysis
- +1 SET %DT="X"
- SET X="T"
- DO ^%DT
- SET DT=+Y
- SET DTP=DT
- DO DTP^FH
- DO TOT^FHNU9
- SET (DAY,PG)=0
- KILL D,T
- if SUM
- GOTO ^FHNU3
- F5 SET DAY=$ORDER(^TMP($JOB,"I",DAY))
- if DAY=""
- GOTO ^FHNU3
- SET MEAL=0
- SET NEW=1
- F6 SET MEAL=$ORDER(^TMP($JOB,"I",DAY,MEAL))
- if MEAL=""
- GOTO F8
- +1 if 'NEW
- WRITE !!,"Meal ",MEAL,!
- if NEW
- DO HEAD
- DO HD1
- F7 FOR NM=1:1
- if '$DATA(^TMP($JOB,"I",DAY,MEAL,NM))
- QUIT
- SET X0=$GET(^(NM,0))
- SET X1=$GET(^(1))
- SET X2=$GET(^(2))
- SET X3=$GET(^(3))
- SET X4=$GET(^(4))
- if $Y>(IOSL-8)
- DO HEAD
- DO HD1
- WRITE !,$JUSTIFY(NM,5)," ",$PIECE(X0,"^",1),?24,$JUSTIFY($PIECE(X0,"^",2),5,0)
- DO LIS
- +1 if $Y>(IOSL-10)
- DO HEAD
- DO HD1
- WRITE !!?7,"Meal 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
- +2 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)
- +3 GOTO F6
- F8 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
- +1 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"
- +4 SET MEAL=0
- SET NEW=1
- F9 SET MEAL=$ORDER(^TMP($JOB,"I",DAY,MEAL))
- if MEAL=""
- GOTO F11
- +1 if 'NEW
- WRITE !!,"Meal ",MEAL,!
- if NEW
- DO HEAD
- DO HD2
- F10 FOR NM=1:1
- if '$DATA(^TMP($JOB,"I",DAY,MEAL,NM))
- QUIT
- SET X0=$GET(^(NM,0))
- SET X1=$GET(^(1))
- SET X2=$GET(^(2))
- SET X3=$GET(^(3))
- SET X4=$GET(^(4))
- if $Y>(IOSL-8)
- DO HEAD
- DO HD2
- WRITE !,$JUSTIFY(NM,5),?12
- DO LIS
- +1 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
- GOTO F9
- F11 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
- +1 WRITE !,"% DRI",?12
- DO RDA^FHNU9
- GOTO F5
- LIS ; List nutrient values
- +1 SET KK=1
- L1 SET NODE=$EXTRACT(NUT,KK)
- if 'NODE
- QUIT
- SET ITM=+$EXTRACT(NUT,KK+1,KK+2)
- if 'ITM
- QUIT
- SET SIZ=$EXTRACT(NUT,KK+3)
- SET DEC=$EXTRACT(NUT,KK+4)
- SET KK=KK+7
- +1 SET Z1=$SELECT(NODE=1:$PIECE(X1,"^",ITM),NODE=2:$PIECE(X2,"^",ITM-20),NODE=3:$PIECE(X3,"^",ITM-38),1:$PIECE(X4,"^",ITM-56))
- +2 SET Z1=$SELECT(Z1'="":$JUSTIFY(Z1,SIZ,DEC),1:$JUSTIFY(Z1,SIZ))
- WRITE Z1
- GOTO L1
- KIL ; Final Variable Kill
- +1 KILL ^TMP($JOB)
- GOTO KILL^XUSCLEAN
- HEAD ; Print Header
- +1 if '($EXTRACT(IOST,1,2)'="C-"&'PG)
- WRITE @IOF
- SET PG=PG+1
- IF PG=1
- DO SITE^FH
- +2 WRITE !,"Station #: ",SITE(1),?44,"E N E R G Y / N U T R I E N T A N A L Y S I S",?124,"Page ",PG
- +3 WRITE !,"Station Name: ",SITE,?61,DTP,?110,"DRI: ",$PIECE(^FH(112.2,RDA,0),U,1)
- +4 WRITE !?(132-$LENGTH(MNAM)\2),MNAM
- SET NEW=0
- QUIT
- HD1 WRITE !!,"Day ",DAY,?24,"Quant Energ Pro CHO Fat Sod Pot Calc Phos Iron Zinc Mag Man Cop Sel DFib"
- +1 WRITE !
- if MEAL'=""
- WRITE "Meal ",MEAL
- WRITE ?27,"Gm KCal Gm Gm Gm Mg Mg Mg Mg Mg Mg Mg Mg Mg Mcg Gm",!
- +2 ;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
- +3 SET NUT="104700010171011037100102710011370191127020108701111170121097114114711511071131167218115621746661222376100"
- QUIT
- HD2 WRITE !!,"Day ",DAY,?18,"K A C E Rib Thi Nia B6 B12 Fol Pant Chol 18C2 18C3 Mono PuFA SaFa"
- +1 WRITE !
- if MEAL'=""
- WRITE "Meal ",MEAL
- WRITE ?16,"Mcg RE Mg Mg Mg Mg Mg Mg Mcg Mcg Mg Mg Gm Gm Gm Gm Gm",!
- +2 SET NUT="46571262337002119710411771032217206120720522272072247208226721022572092237216229700022771002287100231710023271002307100"
- QUIT