- 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
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HFHNU10 2235 printed Jan 18, 2025@02:53:43 Page 2
- 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