FHORD4 ; HISC/REL/NCA - Isolation/Precaution ;10/11/00 07:52
;;5.5;DIETETICS;;Jan 28, 2005
S ALL=0 D ^FHDPA G:'DFN KIL G:'FHDFN KIL
D NOW^%DTC S NOW=% K %,%H,%I
I $P(^FHPT(FHDFN,"A",ADM,0),"^",10)'="" G F1
K DIC S DIC="^FH(119.4,",DIC(0)="AEQM" W ! D ^DIC G:Y<1 KIL S IS=+Y
S FHNOW=NOW D FIL,ISO^FHWOR61 S NOW=FHNOW
S TYP=$P(^FHPT(FHDFN,"A",ADM,0),"^",5) I TYP'="C",TYP'="D" G S2
S1 R !!,"Patient is on CAFETERIA/DINING ROOM Service. Change to TRAY? YES// ",X:DTIME G:'$T!(X["^") KIL
S:X="" X="Y" D TR^FH I $P("YES",X,1)'="",$P("NO",X,1)'="" W *7," Answer YES or NO" G S1
G:X?1"N".E S2 D CUR^FHORD7 I "^^^^"[FHOR S $P(^FHPT(FHDFN,"A",ADM,0),"^",5)="T" G S2
S TYP="T",D2=$P(X,"^",10),(D3,D4)=0,COM="",D1=NOW,DT=NOW\1 D STR^FHORD7
S2 ;
W " ... done" G KIL
F1 S X=$P(^FHPT(FHDFN,"A",ADM,0),"^",10)
W !!,"Isolation/Precaution Type is: ",$P($G(^FH(119.4,X,0)),"^",1)
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
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
W " ... no change made" G KIL
FIL ; File Isolation
S $P(^FHPT(FHDFN,"A",ADM,0),"^",10)=IS,X=^FH(119.4,IS,0)
S ^FHPT("AIS",FHDFN,ADM)=""
S EVT="I^O^"_IS D ^FHORX Q
CAN ; Cancel Isolation
S IS=$P(^FHPT(FHDFN,"A",ADM,0),"^",10),$P(^(0),"^",10)="" K ^FHPT("AIS",FHDFN,ADM)
S EVT="I^C^"_IS D ^FHORX Q
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
EN1 ; Enter/Edit Isolation/Precaution Types
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
S DA=+Y,DR=".01:99" S:$D(^XUSEC("FHMGR",DUZ)) DIDEL=119.4 D ^DIE K DA,DIE,DIDEL,DR G EN1
EN2 ; List Isolation/Precaution Types
W ! S L=0,DIC="^FH(119.4,",FLDS="[FHISLST]",BY="NAME"
S (FR,TO)="",DHD="ISOLATION/PRECAUTION TYPES" D EN1^DIP,RSET G KIL
RSET K %ZIS S IOP="" D ^%ZIS K %ZIS,IOP,BY,DA,DHD,DIC,DIE,DR,FLDS,FR,L,TO,X,Y Q
SETVAR ; Set Date in HL7 format
S FHIDT=$$FMTHL7^XLFDT(NOW) ;HL7 date format
S FILL="I"_";"_ADM_";"_IS D SITE^FH
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HFHORD4 2255 printed Dec 13, 2024@01:53:29 Page 2
FHORD4 ; HISC/REL/NCA - Isolation/Precaution ;10/11/00 07:52
+1 ;;5.5;DIETETICS;;Jan 28, 2005
+2 SET ALL=0
DO ^FHDPA
if 'DFN
GOTO KIL
if 'FHDFN
GOTO KIL
+3 DO NOW^%DTC
SET NOW=%
KILL %,%H,%I
+4 IF $PIECE(^FHPT(FHDFN,"A",ADM,0),"^",10)'=""
GOTO F1
+5 KILL DIC
SET DIC="^FH(119.4,"
SET DIC(0)="AEQM"
WRITE !
DO ^DIC
if Y<1
GOTO KIL
SET IS=+Y
+6 SET FHNOW=NOW
DO FIL
DO ISO^FHWOR61
SET NOW=FHNOW
+7 SET TYP=$PIECE(^FHPT(FHDFN,"A",ADM,0),"^",5)
IF TYP'="C"
IF TYP'="D"
GOTO S2
S1 READ !!,"Patient is on CAFETERIA/DINING ROOM Service. Change to TRAY? YES// ",X:DTIME
if '$TEST!(X["^")
GOTO KIL
+1 if X=""
SET X="Y"
DO TR^FH
IF $PIECE("YES",X,1)'=""
IF $PIECE("NO",X,1)'=""
WRITE *7," Answer YES or NO"
GOTO S1
+2 if X?1"N".E
GOTO S2
DO CUR^FHORD7
IF "^^^^"[FHOR
SET $PIECE(^FHPT(FHDFN,"A",ADM,0),"^",5)="T"
GOTO S2
+3 SET TYP="T"
SET D2=$PIECE(X,"^",10)
SET (D3,D4)=0
SET COM=""
SET D1=NOW
SET DT=NOW\1
DO STR^FHORD7
S2 ;
+1 WRITE " ... done"
GOTO KIL
F1 SET X=$PIECE(^FHPT(FHDFN,"A",ADM,0),"^",10)
+1 WRITE !!,"Isolation/Precaution Type is: ",$PIECE($GET(^FH(119.4,X,0)),"^",1)
F2 READ !!,"Do you wish to remove? (Y/N) ",X:DTIME
if '$TEST!(X["^")
GOTO KIL
if X=""
SET X="*"
DO TR^FH
IF $PIECE("YES",X,1)'=""
IF $PIECE("NO",X,1)'=""
WRITE *7," Answer YES or NO"
GOTO F2
+1 IF X?1"Y".E
DO CAN
SET FHORN=$PIECE(^FHPT(FHDFN,"A",ADM,0),"^",13)
if FHORN>0
DO CODE^FHWOR61
WRITE " ...removed"
GOTO KIL
+2 WRITE " ... no change made"
GOTO KIL
FIL ; File Isolation
+1 SET $PIECE(^FHPT(FHDFN,"A",ADM,0),"^",10)=IS
SET X=^FH(119.4,IS,0)
+2 SET ^FHPT("AIS",FHDFN,ADM)=""
+3 SET EVT="I^O^"_IS
DO ^FHORX
QUIT
CAN ; Cancel Isolation
+1 SET IS=$PIECE(^FHPT(FHDFN,"A",ADM,0),"^",10)
SET $PIECE(^(0),"^",10)=""
KILL ^FHPT("AIS",FHDFN,ADM)
+2 SET EVT="I^C^"_IS
DO ^FHORX
QUIT
KIL KILL %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
QUIT
EN1 ; Enter/Edit Isolation/Precaution Types
+1 KILL DIC
SET (DIC,DIE)="^FH(119.4,"
SET DIC(0)="AEQLM"
SET DIC("DR")=".01"
SET DLAYGO=119.4
WRITE !
DO ^DIC
KILL DIC,DLAYGO
if "^"[X!$DATA(DTOUT)
GOTO KIL
if Y<1
GOTO EN1
+2 SET DA=+Y
SET DR=".01:99"
if $DATA(^XUSEC("FHMGR",DUZ))
SET DIDEL=119.4
DO ^DIE
KILL DA,DIE,DIDEL,DR
GOTO EN1
EN2 ; List Isolation/Precaution Types
+1 WRITE !
SET L=0
SET DIC="^FH(119.4,"
SET FLDS="[FHISLST]"
SET BY="NAME"
+2 SET (FR,TO)=""
SET DHD="ISOLATION/PRECAUTION TYPES"
DO EN1^DIP
DO RSET
GOTO KIL
RSET KILL %ZIS
SET IOP=""
DO ^%ZIS
KILL %ZIS,IOP,BY,DA,DHD,DIC,DIE,DR,FLDS,FR,L,TO,X,Y
QUIT
SETVAR ; Set Date in HL7 format
+1 ;HL7 date format
SET FHIDT=$$FMTHL7^XLFDT(NOW)
+2 SET FILL="I"_";"_ADM_";"_IS
DO SITE^FH
+3 QUIT
