source: WorldVistAEHR/trunk/r/DIETETICS-FH/FHORD4.m@ 1474

Last change on this file since 1474 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR

File size: 2.2 KB
RevLine 
[613]1FHORD4 ; 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
9S1 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
13S2 ;
14 W " ... done" G KIL
15F1 S X=$P(^FHPT(FHDFN,"A",ADM,0),"^",10)
16 W !!,"Isolation/Precaution Type is: ",$P($G(^FH(119.4,X,0)),"^",1)
17F2 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
20FIL ; 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
24CAN ; 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
27KIL 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
28EN1 ; 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
31EN2 ; 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
34RSET K %ZIS S IOP="" D ^%ZIS K %ZIS,IOP,BY,DA,DHD,DIC,DIE,DR,FLDS,FR,L,TO,X,Y Q
35SETVAR ; 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
Note: See TracBrowser for help on using the repository browser.