Routine: FHWOR61

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

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

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

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

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HFHWOR61   2042     printed  Apr 23, 2025@18:09:57                                                                                                                                                                                                     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

FHWOR61.m