1 | FHORTR ; HISC/NCA - Tubefeeding Product Search ;8/8/96 08:12
|
---|
2 | ;;5.5;DIETETICS;;Jan 28, 2005
|
---|
3 | SRCH(FHX) ; Search For Tubefeeding Product
|
---|
4 | N DIC,FHY,X,Y
|
---|
5 | S X=FHX,FHY=""
|
---|
6 | W ! K DIC S DIC="^FH(118.2,",DIC(0)="EQM" D ^DIC G:"^"[X!$D(DTOUT) EXIT
|
---|
7 | G:Y<1 EXIT
|
---|
8 | S FHY=+Y
|
---|
9 | EXIT Q FHY
|
---|
10 | DISP ; Display Edited Tubefeeding
|
---|
11 | N TC,TK S (TC,TK)=0 W !
|
---|
12 | I $O(TUN(0))="" W !!,"No Tubefeeding Products Selected." Q
|
---|
13 | F K=0:0 S K=$O(TUN(K)) Q:K<1 D
|
---|
14 | .S TC=TC+$P(TUN(K),"^",4)+$P(TUN(K),"^",5)
|
---|
15 | .S TK=TK+$P(TUN(K),"^",6),STR=$P(TUN(K),"^",2)
|
---|
16 | .S PRO=$P(TUN(K),"^",1)
|
---|
17 | .W !,"Product: ",$P($G(^FH(118.2,PRO,0)),"^",1),", "
|
---|
18 | .W $S(STR=4:"Full",STR=2:"1/2",STR=1:"1/4",STR=3:"3/4",1:""),", "
|
---|
19 | .W $P(TUN(K),"^",3)
|
---|
20 | .Q
|
---|
21 | W !!,"Total Kcal: ",TK,?36,"Total Quantity: ",TC
|
---|
22 | Q
|
---|
23 | HELP ; Help Prompt for Tubefeeding Product.
|
---|
24 | W !!,"Hit return to take the default.",!,"Enter a ""@"" to delete the product, strength and quantity.",!,"Enter another product name to replace existing product name."
|
---|
25 | W !,"To Replace, enter first few characters of the product name, e.g., SUS for SUSTACAL."
|
---|
26 | W !,"Enter a ""^"" will Exit Completely."
|
---|
27 | Q
|
---|