| 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
|
|---|
