FHORT3.m

FHORT3 ; HISC/REL/NCA - Tubefeeding Utilities ;8/9/96  11:41 ;

 ;;5.5;DIETETICS;**5,8**;Jan 28, 2005;Build 28

EN1 ; Edit Tubefeeding Products

 S CHK=0,TYP="T",EVENT="UPD",REC=1,(NOD1,NOD3)="" K ^TMP($J,"FHNOD2")

 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

 S DA=+Y,IEN=Y,NOD1=$P($G(^FH(118.2,+IEN,0)),"^",1),NOD3=$G(^FH(118.2,+IEN,"I"))

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

 ;DR STRING MODIFIED TO ONLY EDIT INACTIVE STATUS IF TF PRODUCT INACTIVE

 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

 G EN1

EN2 ; List Tubefeeding Products

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

 W ! S L=0,DIC="^FH(118.2,",FLDS="[FHTFLST]",BY="NAME"

 S FR="",TO="",DHD="TUBEFEEDING PRODUCTS" D EN1^DIP,RSET Q

RSET K %ZIS S IOP="" D ^%ZIS K %ZIS,IOP,BY,DA,DHD,DIC,DIE,DR,FLDS,FR,L,TO,X,Y Q

KIL K ^TMP($J),CHK,DIC,DIE,DTOUT,EVENT,IEN,IEN1,NOD1,NOD3,REC,TYP,X,Y Q

POST ; Generate bulletin [NEW PATCH 8]

 S WRD=$P($G(^FHPT(FHDFN,"A",ADM,0)),"^",8)

 Q:'$D(^FH(119.6,+WRD,0))

 K XMY,XMB S XMB(1)=$P(^DPT(DFN,0),"^",1),XMB(2)=BID

 F FHXMKK=0:0 S FHXMKK=$O(^FH(119.6,WRD,2,"B",FHXMKK)) Q:FHXMKK'>0  D

 .S XMY(FHXMKK)=""

 Q:'$D(XMY)  S XMB(4)=$S($D(^DPT(DFN,.101)):^(.101),1:"unknown")

 S XMB(5)="" I CAN S XMB(5)="Diet Orders"_$S(CAN=2:" and Supplemental Feedings",1:"")_" have been cancelled."

 S XMB(3)=$P(^FH(119.6,WRD,0),"^",1),XMB="FHDITF" D ^XMB

 K XMY,XMB,XMM,XMDT,FHXMKK Q

FHORT3    ; HISC/REL/NCA - Tubefeeding Utilities ;8/9/96  11:41 ;

 +1       ;;5.5;DIETETICS;**5,8**;Jan 28, 2005;Build 28

EN1       ; Edit Tubefeeding Products

 +1        SET CHK=0

           SET TYP="T"

           SET EVENT="UPD"

           SET REC=1

           SET (NOD1,NOD3)=""

           KILL ^TMP($JOB,"FHNOD2")

 +2        WRITE !

           SET (DIC,DIE)="^FH(118.2,"

           SET DIC(0)="AEQLM"

           SET DIC("DR")=".01"

           SET DLAYGO=118.2

           WRITE !

           DO ^DIC

           KILL DIC,DLAYGO

           IF U[X!$DATA(DTOUT)

               GOTO KIL

           IF Y<1

               GOTO EN1

 +3        SET DA=+Y

           SET IEN=Y

           SET NOD1=$PIECE($GET(^FH(118.2,+IEN,0)),"^",1)

           SET NOD3=$GET(^FH(118.2,+IEN,"I"))

 +4        FOR IEN1=0:0

               SET IEN1=$ORDER(^FH(118.2,+IEN,1,IEN1))

               IF IEN1<1

                   QUIT 

               IF '$DATA(^TMP($JOB,"FHNOD2",IEN1))

                   SET ^TMP($JOB,"FHNOD2",IEN1)=$GET(^FH(118.2,+IEN,1,IEN1,0))

 +5       ;DR STRING MODIFIED TO ONLY EDIT INACTIVE STATUS IF TF PRODUCT INACTIVE

 +6        SET DR="I $G(^FH(118.2,+IEN,""I""))=""Y"" S Y=99;.01;1;2;S:X[""G"" Y=""@1"";3;@1;10:99"

           IF $DATA(^XUSEC("FHMGR",DUZ))

               SET DIDEL=118.2

           DO ^DIE

           KILL DA,DIE,DIDEL,DR

           IF $DATA(^ORD(101.43))

               DO UPDATE^FHWOR6

 +7        GOTO EN1

EN2       ; List Tubefeeding Products

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

 +2        WRITE !

           SET L=0

           SET DIC="^FH(118.2,"

           SET FLDS="[FHTFLST]"

           SET BY="NAME"

 +3        SET FR=""

           SET TO=""

           SET DHD="TUBEFEEDING PRODUCTS"

           DO EN1^DIP

           DO RSET

           QUIT 

RSET       KILL %ZIS

           SET IOP=""

           DO ^%ZIS

           KILL %ZIS,IOP,BY,DA,DHD,DIC,DIE,DR,FLDS,FR,L,TO,X,Y

           QUIT 

KIL        KILL ^TMP($JOB),CHK,DIC,DIE,DTOUT,EVENT,IEN,IEN1,NOD1,NOD3,REC,TYP,X,Y

           QUIT 

POST      ; Generate bulletin [NEW PATCH 8]

 +1        SET WRD=$PIECE($GET(^FHPT(FHDFN,"A",ADM,0)),"^",8)

 +2        IF '$DATA(^FH(119.6,+WRD,0))

               QUIT 

 +3        KILL XMY,XMB

           SET XMB(1)=$PIECE(^DPT(DFN,0),"^",1)

           SET XMB(2)=BID

 +4        FOR FHXMKK=0:0

               SET FHXMKK=$ORDER(^FH(119.6,WRD,2,"B",FHXMKK))

               IF FHXMKK'>0

                   QUIT 

               Begin DoDot:1

 +5                SET XMY(FHXMKK)=""

               End DoDot:1

 +6        IF '$DATA(XMY)

               QUIT 

           SET XMB(4)=$SELECT($DATA(^DPT(DFN,.101)):^(.101),1:"unknown")

 +7        SET XMB(5)=""

           IF CAN

               SET XMB(5)="Diet Orders"_$SELECT(CAN=2:" and Supplemental Feedings",1:"")_" have been cancelled."

 +8        SET XMB(3)=$PIECE(^FH(119.6,WRD,0),"^",1)

           SET XMB="FHDITF"

           DO ^XMB

 +9        KILL XMY,XMB,XMM,XMDT,FHXMKK

           QUIT