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