FHNU10.m

FHNU10 ; HISC/REL - Print DRI Values ;3/8/95  13:26

 ;;5.5;DIETETICS;;Jan 28, 2005

 W !!,"The list requires a 132 column printer.",!

 W ! K IOP,%ZIS S %ZIS("A")="Select LIST PRINTER: ",%ZIS="MQ" D ^%ZIS K %ZIS,IOP G:POP KIL

 I $D(IO("Q")) S FHPGM="Q1^FHNU10",FHLST="" D EN2^FH G KIL

 U IO D Q1 D ^%ZISC K %ZIS,IOP G KIL

Q1 ; Print the DRI Values

 D NOW^%DTC S DTP=% D DTP^FH

 S PG=0 D HD1,HD2 S ITMS=$T(ITMS+1)

 S MNE="" F  S MNE=$O(^FH(112.2,"C",MNE)) Q:MNE=""  S FN=$O(^FH(112.2,"C",MNE,0)) D L1

 D HD1,HD3 S ITMS=$T(ITMS+2)

 S MNE="" F  S MNE=$O(^FH(112.2,"C",MNE)) Q:MNE=""  S FN=$O(^FH(112.2,"C",MNE,0)) D L1

 D HD1,HD4 S ITMS=$T(ITMS+3)

 S MNE="" F  S MNE=$O(^FH(112.2,"C",MNE)) Q:MNE=""  S FN=$O(^FH(112.2,"C",MNE,0)) D L1

 W ! Q

L1 S X=$G(^FH(112.2,FN,0)) W !,$E($P(X,"^",1),1,30)

 S X=$G(^FH(112.2,FN,1))

 F LL=3:1 S Y=$P(ITMS,";",LL) Q:Y=""  S P1=$P(Y,",",1),P2=$P(Y,",",2),P3=$P(Y,",",3),P4=$P(Y,",",4),Y=$P(X,"^",P1) W:Y'="" ?P2,$J(Y,P3,P4)

 Q

HD1 W:'($E(IOST,1,2)'="C-"&'PG) @IOF S PG=PG+1 W !,"DRI VALUES",?104,DTP,?125,"Page ",PG Q

HD2 W !?32,"Protein",?42,"Vitamin A",?54,"Vitamin E",?66,"Vitamin C",?77,"Thiamin",?87,"Riboflavin",?99,"Niacin",?108,"Vitamin B6",?121,"Folate"

 W !,"Name",?35,"Gm.",?46,"RE",?58,"Mg",?70,"Mg",?80,"Mg",?91,"Mg",?101,"Mg",?112,"Mg",?123,"Mcg"

 D LN Q

HD3 W !?32,"Vitamin B12",?46,"Calcium",?57,"Phosphorus",?70,"Magnesium",?84,"Iron",?93,"Zinc",?101,"Pantothenic",?117,"Copper"

 W !,"Name",?36,"Mcg",?49,"Mg",?61,"Mg",?74,"Mg",?85,"Mg",?94,"Mg",?104,"Acid Mg",?118,"Mg"

 D LN Q

HD4 W !?32,"Manganese",?45,"Sodium",?56,"Potassium",?69,"Biotin",?80,"Selenium",?92,"Choline",?103,"Vitamin D",?116,"Fluoride"

 W !,"Name",?36,"Mg",?47,"Mg",?60,"Mg",?71,"Mcg",?83,"Mcg",?95,"Mg",?107,"Mcg",?119,"Mg"

 D LN Q

ITMS ;;Piece,?Tab,Size,Dec

 ;;1,32,6,1;2,43,6,0;3,55,5,0;4,66,5,0;5,77,5,1;6,86,7,1;7,99,4,0;8,110,5,1;9,121,5,0;

 ;;10,34,5,1;11,46,6,0;12,57,7,0;13,70,6,0;14,84,3,0;15,93,3,0;16,102,7,1;17,117,4,2;

 ;;18,32,7,2;19,45,5,0;20,56,7,0;21,69,4,0;22,79,6,0;23,93,4,0;24,105,4,0;25,116,6,2;

LN W !,"-----------------------------------------------------------------------------------------------------------------------------------",! Q

KIL G KILL^XUSCLEAN

FHNU10    ; HISC/REL - Print DRI Values ;3/8/95  13:26

 +1       ;;5.5;DIETETICS;;Jan 28, 2005

 +2        WRITE !!,"The list requires a 132 column printer.",!

 +3        WRITE !

           KILL IOP,%ZIS

           SET %ZIS("A")="Select LIST PRINTER: "

           SET %ZIS="MQ"

           DO ^%ZIS

           KILL %ZIS,IOP

           IF POP

               GOTO KIL

 +4        IF $DATA(IO("Q"))

               SET FHPGM="Q1^FHNU10"

               SET FHLST=""

               DO EN2^FH

               GOTO KIL

 +5        USE IO

           DO Q1

           DO ^%ZISC

           KILL %ZIS,IOP

           GOTO KIL

Q1        ; Print the DRI Values

 +1        DO NOW^%DTC

           SET DTP=%

           DO DTP^FH

 +2        SET PG=0

           DO HD1

           DO HD2

           SET ITMS=$TEXT(ITMS+1)

 +3        SET MNE=""

           FOR 

               SET MNE=$ORDER(^FH(112.2,"C",MNE))

               IF MNE=""

                   QUIT 

               SET FN=$ORDER(^FH(112.2,"C",MNE,0))

               DO L1

 +4        DO HD1

           DO HD3

           SET ITMS=$TEXT(ITMS+2)

 +5        SET MNE=""

           FOR 

               SET MNE=$ORDER(^FH(112.2,"C",MNE))

               IF MNE=""

                   QUIT 

               SET FN=$ORDER(^FH(112.2,"C",MNE,0))

               DO L1

 +6        DO HD1

           DO HD4

           SET ITMS=$TEXT(ITMS+3)

 +7        SET MNE=""

           FOR 

               SET MNE=$ORDER(^FH(112.2,"C",MNE))

               IF MNE=""

                   QUIT 

               SET FN=$ORDER(^FH(112.2,"C",MNE,0))

               DO L1

 +8        WRITE !

           QUIT 

L1         SET X=$GET(^FH(112.2,FN,0))

           WRITE !,$EXTRACT($PIECE(X,"^",1),1,30)

 +1        SET X=$GET(^FH(112.2,FN,1))

 +2        FOR LL=3:1

               SET Y=$PIECE(ITMS,";",LL)

               IF Y=""

                   QUIT 

               SET P1=$PIECE(Y,",",1)

               SET P2=$PIECE(Y,",",2)

               SET P3=$PIECE(Y,",",3)

               SET P4=$PIECE(Y,",",4)

               SET Y=$PIECE(X,"^",P1)

               IF Y'=""

                   WRITE ?P2,$JUSTIFY(Y,P3,P4)

 +3        QUIT 

HD1        IF '($EXTRACT(IOST,1,2)'="C-"&'PG)

               WRITE @IOF

           SET PG=PG+1

           WRITE !,"DRI VALUES",?104,DTP,?125,"Page ",PG

           QUIT 

HD2        WRITE !?32,"Protein",?42,"Vitamin A",?54,"Vitamin E",?66,"Vitamin C",?77,"Thiamin",?87,"Riboflavin",?99,"Niacin",?108,"Vitamin B6",?121,"Folate"

 +1        WRITE !,"Name",?35,"Gm.",?46,"RE",?58,"Mg",?70,"Mg",?80,"Mg",?91,"Mg",?101,"Mg",?112,"Mg",?123,"Mcg"

 +2        DO LN

           QUIT 

HD3        WRITE !?32,"Vitamin B12",?46,"Calcium",?57,"Phosphorus",?70,"Magnesium",?84,"Iron",?93,"Zinc",?101,"Pantothenic",?117,"Copper"

 +1        WRITE !,"Name",?36,"Mcg",?49,"Mg",?61,"Mg",?74,"Mg",?85,"Mg",?94,"Mg",?104,"Acid Mg",?118,"Mg"

 +2        DO LN

           QUIT 

HD4        WRITE !?32,"Manganese",?45,"Sodium",?56,"Potassium",?69,"Biotin",?80,"Selenium",?92,"Choline",?103,"Vitamin D",?116,"Fluoride"

 +1        WRITE !,"Name",?36,"Mg",?47,"Mg",?60,"Mg",?71,"Mcg",?83,"Mcg",?95,"Mg",?107,"Mcg",?119,"Mg"

 +2        DO LN

           QUIT 

ITMS      ;;Piece,?Tab,Size,Dec

 +1       ;;1,32,6,1;2,43,6,0;3,55,5,0;4,66,5,0;5,77,5,1;6,86,7,1;7,99,4,0;8,110,5,1;9,121,5,0;

 +2       ;;10,34,5,1;11,46,6,0;12,57,7,0;13,70,6,0;14,84,3,0;15,93,3,0;16,102,7,1;17,117,4,2;

 +3       ;;18,32,7,2;19,45,5,0;20,56,7,0;21,69,4,0;22,79,6,0;23,93,4,0;24,105,4,0;25,116,6,2;

LN         WRITE !,"-----------------------------------------------------------------------------------------------------------------------------------",!

           QUIT 

KIL        GOTO KILL^XUSCLEAN