| 1 | FHORT3 ; HISC/REL/NCA - Tubefeeding Utilities ;8/9/96 11:41 ;
|
|---|
| 2 | ;;5.5;DIETETICS;**5,8**;Jan 28, 2005;Build 28
|
|---|
| 3 | EN1 ; Edit Tubefeeding Products
|
|---|
| 4 | S CHK=0,TYP="T",EVENT="UPD",REC=1,(NOD1,NOD3)="" K ^TMP($J,"FHNOD2")
|
|---|
| 5 | W ! S (DIC,DIE)="^FH(118.2,",DIC(0)="AEQLM",DIC("DR")=".01",DLAYGO=118.2 W ! D ^DIC K DIC,DLAYGO G KIL:U[X!$D(DTOUT),EN1:Y<1
|
|---|
| 6 | S DA=+Y,IEN=Y,NOD1=$P($G(^FH(118.2,+IEN,0)),"^",1),NOD3=$G(^FH(118.2,+IEN,"I"))
|
|---|
| 7 | F IEN1=0:0 S IEN1=$O(^FH(118.2,+IEN,1,IEN1)) Q:IEN1<1 S:'$D(^TMP($J,"FHNOD2",IEN1)) ^TMP($J,"FHNOD2",IEN1)=$G(^FH(118.2,+IEN,1,IEN1,0))
|
|---|
| 8 | ;DR STRING MODIFIED TO ONLY EDIT INACTIVE STATUS IF TF PRODUCT INACTIVE
|
|---|
| 9 | S DR="I $G(^FH(118.2,+IEN,""I""))=""Y"" S Y=99;.01;1;2;S:X[""G"" Y=""@1"";3;@1;10:99" S:$D(^XUSEC("FHMGR",DUZ)) DIDEL=118.2 D ^DIE K DA,DIE,DIDEL,DR I $D(^ORD(101.43)) D UPDATE^FHWOR6
|
|---|
| 10 | G EN1
|
|---|
| 11 | EN2 ; List Tubefeeding Products
|
|---|
| 12 | W !!,"The list requires a 132 column printer.",!
|
|---|
| 13 | W ! S L=0,DIC="^FH(118.2,",FLDS="[FHTFLST]",BY="NAME"
|
|---|
| 14 | S FR="",TO="",DHD="TUBEFEEDING PRODUCTS" D EN1^DIP,RSET Q
|
|---|
| 15 | RSET K %ZIS S IOP="" D ^%ZIS K %ZIS,IOP,BY,DA,DHD,DIC,DIE,DR,FLDS,FR,L,TO,X,Y Q
|
|---|
| 16 | KIL K ^TMP($J),CHK,DIC,DIE,DTOUT,EVENT,IEN,IEN1,NOD1,NOD3,REC,TYP,X,Y Q
|
|---|
| 17 | POST ; Generate bulletin [NEW PATCH 8]
|
|---|
| 18 | S WRD=$P($G(^FHPT(FHDFN,"A",ADM,0)),"^",8)
|
|---|
| 19 | Q:'$D(^FH(119.6,+WRD,0))
|
|---|
| 20 | K XMY,XMB S XMB(1)=$P(^DPT(DFN,0),"^",1),XMB(2)=BID
|
|---|
| 21 | F FHXMKK=0:0 S FHXMKK=$O(^FH(119.6,WRD,2,"B",FHXMKK)) Q:FHXMKK'>0 D
|
|---|
| 22 | .S XMY(FHXMKK)=""
|
|---|
| 23 | Q:'$D(XMY) S XMB(4)=$S($D(^DPT(DFN,.101)):^(.101),1:"unknown")
|
|---|
| 24 | S XMB(5)="" I CAN S XMB(5)="Diet Orders"_$S(CAN=2:" and Supplemental Feedings",1:"")_" have been cancelled."
|
|---|
| 25 | S XMB(3)=$P(^FH(119.6,WRD,0),"^",1),XMB="FHDITF" D ^XMB
|
|---|
| 26 | K XMY,XMB,XMM,XMDT,FHXMKK Q
|
|---|
