1 | FHORD4 ; HISC/REL/NCA - Isolation/Precaution ;10/11/00 07:52
|
---|
2 | ;;5.5;DIETETICS;;Jan 28, 2005
|
---|
3 | S ALL=0 D ^FHDPA G:'DFN KIL G:'FHDFN KIL
|
---|
4 | D NOW^%DTC S NOW=% K %,%H,%I
|
---|
5 | I $P(^FHPT(FHDFN,"A",ADM,0),"^",10)'="" G F1
|
---|
6 | K DIC S DIC="^FH(119.4,",DIC(0)="AEQM" W ! D ^DIC G:Y<1 KIL S IS=+Y
|
---|
7 | S FHNOW=NOW D FIL,ISO^FHWOR61 S NOW=FHNOW
|
---|
8 | S TYP=$P(^FHPT(FHDFN,"A",ADM,0),"^",5) I TYP'="C",TYP'="D" G S2
|
---|
9 | S1 R !!,"Patient is on CAFETERIA/DINING ROOM Service. Change to TRAY? YES// ",X:DTIME G:'$T!(X["^") KIL
|
---|
10 | S:X="" X="Y" D TR^FH I $P("YES",X,1)'="",$P("NO",X,1)'="" W *7," Answer YES or NO" G S1
|
---|
11 | G:X?1"N".E S2 D CUR^FHORD7 I "^^^^"[FHOR S $P(^FHPT(FHDFN,"A",ADM,0),"^",5)="T" G S2
|
---|
12 | S TYP="T",D2=$P(X,"^",10),(D3,D4)=0,COM="",D1=NOW,DT=NOW\1 D STR^FHORD7
|
---|
13 | S2 ;
|
---|
14 | W " ... done" G KIL
|
---|
15 | F1 S X=$P(^FHPT(FHDFN,"A",ADM,0),"^",10)
|
---|
16 | W !!,"Isolation/Precaution Type is: ",$P($G(^FH(119.4,X,0)),"^",1)
|
---|
17 | F2 R !!,"Do you wish to remove? (Y/N) ",X:DTIME G:'$T!(X["^") KIL S:X="" X="*" D TR^FH I $P("YES",X,1)'="",$P("NO",X,1)'="" W *7," Answer YES or NO" G F2
|
---|
18 | I X?1"Y".E D CAN S FHORN=$P(^FHPT(FHDFN,"A",ADM,0),"^",13) D:FHORN>0 CODE^FHWOR61 W " ...removed" G KIL
|
---|
19 | W " ... no change made" G KIL
|
---|
20 | FIL ; File Isolation
|
---|
21 | S $P(^FHPT(FHDFN,"A",ADM,0),"^",10)=IS,X=^FH(119.4,IS,0)
|
---|
22 | S ^FHPT("AIS",FHDFN,ADM)=""
|
---|
23 | S EVT="I^O^"_IS D ^FHORX Q
|
---|
24 | CAN ; Cancel Isolation
|
---|
25 | S IS=$P(^FHPT(FHDFN,"A",ADM,0),"^",10),$P(^(0),"^",10)="" K ^FHPT("AIS",FHDFN,ADM)
|
---|
26 | S EVT="I^C^"_IS D ^FHORX Q
|
---|
27 | KIL K %DT,ADM,ALL,BY,C,COM,D1,D2,D3,D4,DA,FHDFN,DFN,DHD,DIC,DIE,DR,FHDU,FHLD,FHORD,FHDR,FHOR,FHORN,FHWF,FHPV,FLDS,FR,I,IS,L,NOW,POP,TO,TYP,WARD,X,X1,Y Q
|
---|
28 | EN1 ; Enter/Edit Isolation/Precaution Types
|
---|
29 | K DIC S (DIC,DIE)="^FH(119.4,",DIC(0)="AEQLM",DIC("DR")=".01",DLAYGO=119.4 W ! D ^DIC K DIC,DLAYGO G KIL:"^"[X!$D(DTOUT),EN1:Y<1
|
---|
30 | S DA=+Y,DR=".01:99" S:$D(^XUSEC("FHMGR",DUZ)) DIDEL=119.4 D ^DIE K DA,DIE,DIDEL,DR G EN1
|
---|
31 | EN2 ; List Isolation/Precaution Types
|
---|
32 | W ! S L=0,DIC="^FH(119.4,",FLDS="[FHISLST]",BY="NAME"
|
---|
33 | S (FR,TO)="",DHD="ISOLATION/PRECAUTION TYPES" D EN1^DIP,RSET G KIL
|
---|
34 | RSET K %ZIS S IOP="" D ^%ZIS K %ZIS,IOP,BY,DA,DHD,DIC,DIE,DR,FLDS,FR,L,TO,X,Y Q
|
---|
35 | SETVAR ; Set Date in HL7 format
|
---|
36 | S FHIDT=$$FMTHL7^XLFDT(NOW) ;HL7 date format
|
---|
37 | S FILL="I"_";"_ADM_";"_IS D SITE^FH
|
---|
38 | Q
|
---|