FHWOR61 ; HISC/JH - Dietetics Isolation/Precaution ;2/23/00 09:53
;;5.5;DIETETICS;;Jan 28, 2005
GET ; Get OBR
N FHIS1
S OBR=$P(X,"|",13),(FHIS1,IS)=$P(OBR,"^",4)
I $P(^FHPT(FHDFN,"A",ADM,0),"^",10)'="" S FHIS=$P(^FHPT(FHDFN,"A",ADM,0),"^",10) D CAN^FHORD4 S FHHOLD=FHORN,FHORN=$P(^FHPT(FHDFN,"A",ADM,0),"^",13) D:FHORN>0 CODE^FHWOR61 S FHORN=FHHOLD,IS=FHIS K FHHOLD,FHIS
S IS=FHIS1 D FIL^FHORD4 S $P(^FHPT(FHDFN,"A",ADM,0),"^",13)=+FHORN,FILL="I"_";"_ADM_";"_IS D SEND^FHWOR
K OBR Q
ISO ; Isolation/Precaution Order
K MSG D SETVAR^FHORD4
S MSG(1)="MSH|^~\&|DIETETICS|"_SITE(1)_"|||||ORM"
S MSG(2)="PID|||"_DFN_"||"_$P($G(^DPT(DFN,0)),"^",1)
S WARD=$G(^DPT(DFN,.1)) Q:WARD="" S FHWRD=$O(^DIC(42,"B",WARD,0)) Q:'FHWRD S HOSP=+$P($G(^DIC(42,+FHWRD,44)),"^",1) Q:'HOSP S RM=$G(^DPT(DFN,.108)) S:RM RM=$P($G(^DG(405.4,+RM,0)),"^",1)
S MSG(3)="PV1||I|"_HOSP_"^"_RM_"||||||||||||||||"
S MSG(4)="ORC|SN||"_FILL_"^FH||||^^^"_FHIDT_"|||"_DUZ_"||"_DUZ_"|||"_FHIDT
S MSG(5)="OBR||||||||||||^^^"_IS_"^"_$P(^FH(119.4,IS,0),"^")_"^99FHI"
K FHIDT,FILL,FHWRD,HOSP,RM,SITE,SDT
D:$D(MSG) MSG^XQOR("FH EVSEND OR",.MSG) K MSG
Q
CODE ; Cancelation From Dietetic
K MSG D SETVAR^FHORD4
S MSG(1)="MSH|^~\&|DIETETICS|"_SITE(1)_"|||||ORM"
S MSG(2)="PID|||"_DFN_"||"_$P($G(^DPT(DFN,0)),"^")
S MSG(3)="ORC|OC|"_FHORN_"^OR|"_FILL_"^FH|||||||||"_FHPV_"|||"_FHIDT_"|Dietetics Canceled Isolation/Precaution"
D:$D(MSG) MSG^XQOR("FH EVSEND OR",.MSG) K MSG
Q
CAN ; Cancel Isolation From Order Entry
S IS=+$P(FILL,";",3) I 'IS D CSEND^FHWOR Q
D GADM^FHWORR
I IS'=$P($G(^FHPT(FHDFN,"A",+ADM,0)),"^",10) D CSEND^FHWOR Q
I +FHORN'=$P($G(^FHPT(FHDFN,"A",ADM,0)),"^",13) D CSEND^FHWOR Q
D CAN^FHORD4,CSEND^FHWOR
K IS
Q
NA ; If isolation store in Ditetics and Order/Entry
G:'$P(FILL,";",3) KILL
S:ADM'=$P(FILL,";",2) ADM=$P(ADM,";",2) ;Check if same admission
S OBR=$P($G(^FHPT(FHDFN,"A",ADM,0)),"^",10) I OBR=+$P(FILL,";",3) D
.I +FHORN>0 S $P(^FHPT(FHDFN,"A",ADM,0),"^",13)=+FHORN
.Q
KILL K FHIDT,IS
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HFHWOR61 2042 printed Apr 09, 2024@20:53:30 Page 2
FHWOR61 ; HISC/JH - Dietetics Isolation/Precaution ;2/23/00 09:53
+1 ;;5.5;DIETETICS;;Jan 28, 2005
GET ; Get OBR
+1 NEW FHIS1
+2 SET OBR=$PIECE(X,"|",13)
SET (FHIS1,IS)=$PIECE(OBR,"^",4)
+3 IF $PIECE(^FHPT(FHDFN,"A",ADM,0),"^",10)'=""
SET FHIS=$PIECE(^FHPT(FHDFN,"A",ADM,0),"^",10)
DO CAN^FHORD4
SET FHHOLD=FHORN
SET FHORN=$PIECE(^FHPT(FHDFN,"A",ADM,0),"^",13)
if FHORN>0
DO CODE^FHWOR61
SET FHORN=FHHOLD
SET IS=FHIS
KILL FHHOLD,FHIS
+4 SET IS=FHIS1
DO FIL^FHORD4
SET $PIECE(^FHPT(FHDFN,"A",ADM,0),"^",13)=+FHORN
SET FILL="I"_";"_ADM_";"_IS
DO SEND^FHWOR
+5 KILL OBR
QUIT
ISO ; Isolation/Precaution Order
+1 KILL MSG
DO SETVAR^FHORD4
+2 SET MSG(1)="MSH|^~\&|DIETETICS|"_SITE(1)_"|||||ORM"
+3 SET MSG(2)="PID|||"_DFN_"||"_$PIECE($GET(^DPT(DFN,0)),"^",1)
+4 SET WARD=$GET(^DPT(DFN,.1))
if WARD=""
QUIT
SET FHWRD=$ORDER(^DIC(42,"B",WARD,0))
if 'FHWRD
QUIT
SET HOSP=+$PIECE($GET(^DIC(42,+FHWRD,44)),"^",1)
if 'HOSP
QUIT
SET RM=$GET(^DPT(DFN,.108))
if RM
SET RM=$PIECE($GET(^DG(405.4,+RM,0)),"^",1)
+5 SET MSG(3)="PV1||I|"_HOSP_"^"_RM_"||||||||||||||||"
+6 SET MSG(4)="ORC|SN||"_FILL_"^FH||||^^^"_FHIDT_"|||"_DUZ_"||"_DUZ_"|||"_FHIDT
+7 SET MSG(5)="OBR||||||||||||^^^"_IS_"^"_$PIECE(^FH(119.4,IS,0),"^")_"^99FHI"
+8 KILL FHIDT,FILL,FHWRD,HOSP,RM,SITE,SDT
+9 if $DATA(MSG)
DO MSG^XQOR("FH EVSEND OR",.MSG)
KILL MSG
+10 QUIT
CODE ; Cancelation From Dietetic
+1 KILL MSG
DO SETVAR^FHORD4
+2 SET MSG(1)="MSH|^~\&|DIETETICS|"_SITE(1)_"|||||ORM"
+3 SET MSG(2)="PID|||"_DFN_"||"_$PIECE($GET(^DPT(DFN,0)),"^")
+4 SET MSG(3)="ORC|OC|"_FHORN_"^OR|"_FILL_"^FH|||||||||"_FHPV_"|||"_FHIDT_"|Dietetics Canceled Isolation/Precaution"
+5 if $DATA(MSG)
DO MSG^XQOR("FH EVSEND OR",.MSG)
KILL MSG
+6 QUIT
CAN ; Cancel Isolation From Order Entry
+1 SET IS=+$PIECE(FILL,";",3)
IF 'IS
DO CSEND^FHWOR
QUIT
+2 DO GADM^FHWORR
+3 IF IS'=$PIECE($GET(^FHPT(FHDFN,"A",+ADM,0)),"^",10)
DO CSEND^FHWOR
QUIT
+4 IF +FHORN'=$PIECE($GET(^FHPT(FHDFN,"A",ADM,0)),"^",13)
DO CSEND^FHWOR
QUIT
+5 DO CAN^FHORD4
DO CSEND^FHWOR
+6 KILL IS
+7 QUIT
NA ; If isolation store in Ditetics and Order/Entry
+1 if '$PIECE(FILL,";",3)
GOTO KILL
+2 ;Check if same admission
if ADM'=$PIECE(FILL,";",2)
SET ADM=$PIECE(ADM,";",2)
+3 SET OBR=$PIECE($GET(^FHPT(FHDFN,"A",ADM,0)),"^",10)
IF OBR=+$PIECE(FILL,";",3)
Begin DoDot:1
+4 IF +FHORN>0
SET $PIECE(^FHPT(FHDFN,"A",ADM,0),"^",13)=+FHORN
+5 QUIT
End DoDot:1
KILL KILL FHIDT,IS
+1 QUIT
