FHOMIP ;Hines OIFO/RTK OUTPATIENT ISOLATION/PRECAUTION EDIT ;9/22/03 11:15
;;5.5;DIETETICS;**2**;Jan 28, 2005
;
D ^FHOMDPA I FHDFN="" Q
I '$D(^FHPT(FHDFN,0)) W !!,"UNKNOWN SELECTION !" Q
S FHIPBEF=$P($G(^FHPT(FHDFN,0)),U,5)
S DIE="^FHPT(",DA=FHDFN,DR="19" D ^DIE
S FHIP=$P($G(^FHPT(FHDFN,0)),U,5) I FHIP=FHIPBEF Q
D UPD100
I FHIP'="" S FHIP=$P($G(^FH(119.4,FHIP,0)),U,1)
I FHIP="" S FHIP="Cancelled"
S FHACT="O",FHOPTY="I",(FHDIET,FHLOC,FHMEAL)="" D SETORX^FHOMRO2
Q
HL7SET ;
; Use this to set isolations/precautions received from CPRS via HL7 msg
; segments. Just set the necessary variables.
S FHOBR=$P(FHX,"|",13),FHIP=$P(FHOBR,"^",4)
S FHORN=$S($G(FHORN)="":"",1:FHORN)
I '$D(^FH(119.4,FHIP,0)) S TXT="Invalid I/P" D GETOR^FHWOR,ERR^FHOMWOR Q
S DIE="^FHPT(",DA=FHDFN,DR="19////^S X=FHIP;20////^S X=FHORN" D ^DIE
S FILL="I;"_FHIP
D SEND^FHWOR
S FHIP=$P($G(^FH(119.4,FHIP,0)),U,1)
S FHACT="O",FHOPTY="I",(FHDIET,FHLOC,FHMEAL)="" D SETORX^FHOMRO2
Q
CAN ;
S DIE="^FHPT(",DA=FHDFN,DR="19////@;20////FHORN" D ^DIE
S FHACT="O",FHOPTY="I",FHIP="Cancelled",(FHDIET,FHLOC,FHMEAL)=""
D SETORX^FHOMRO2
Q
UPD100 ;Backdoor message to update file #100 with a new IP order
Q:'$$PATCH^XPDUTL("OR*3.0*215") ;must have CPRSv26 for O.M. backdoor
Q:'DFN Q:FHIP="" K MSG D SITE^FH
S FHOLOC=$O(^FH(119.6,"AL",0)),FHOLOCNM=$P($G(^SC(FHOLOC,0)),U,1)
S MSG(1)="MSH|^~\&|DIETETICS|"_SITE(1)_"|||||ORM"
S MSG(2)="PID|||"_DFN_"||"_$P($G(^DPT(DFN,0)),"^",1)
S MSG(3)="PV1||O|"_FHOLOC_"^"_FHOLOCNM_"||||||||||||||||"
D NOW^%DTC S FHNOW=%,FHODT=$E(%,1,7),FHODT=$$FMTHL7^XLFDT(FHODT)
S FILL="I;"_FHNOW,FHIPEXT=$P($G(^FH(119.4,FHIP,0)),U,1)
S MSG(4)="ORC|SN||"_FILL_"^FH||||^^^"_FHODT_"^"_FHODT_"||||||||"_FHNOW
S MSG(5)="OBR||||||||||||^^^"_FHIP_"^"_FHIPEXT
D EVSEND^FHWOR
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HFHOMIP 1834 printed Dec 13, 2024@01:52:48 Page 2
FHOMIP ;Hines OIFO/RTK OUTPATIENT ISOLATION/PRECAUTION EDIT ;9/22/03 11:15
+1 ;;5.5;DIETETICS;**2**;Jan 28, 2005
+2 ;
+3 DO ^FHOMDPA
IF FHDFN=""
QUIT
+4 IF '$DATA(^FHPT(FHDFN,0))
WRITE !!,"UNKNOWN SELECTION !"
QUIT
+5 SET FHIPBEF=$PIECE($GET(^FHPT(FHDFN,0)),U,5)
+6 SET DIE="^FHPT("
SET DA=FHDFN
SET DR="19"
DO ^DIE
+7 SET FHIP=$PIECE($GET(^FHPT(FHDFN,0)),U,5)
IF FHIP=FHIPBEF
QUIT
+8 DO UPD100
+9 IF FHIP'=""
SET FHIP=$PIECE($GET(^FH(119.4,FHIP,0)),U,1)
+10 IF FHIP=""
SET FHIP="Cancelled"
+11 SET FHACT="O"
SET FHOPTY="I"
SET (FHDIET,FHLOC,FHMEAL)=""
DO SETORX^FHOMRO2
+12 QUIT
HL7SET ;
+1 ; Use this to set isolations/precautions received from CPRS via HL7 msg
+2 ; segments. Just set the necessary variables.
+3 SET FHOBR=$PIECE(FHX,"|",13)
SET FHIP=$PIECE(FHOBR,"^",4)
+4 SET FHORN=$SELECT($GET(FHORN)="":"",1:FHORN)
+5 IF '$DATA(^FH(119.4,FHIP,0))
SET TXT="Invalid I/P"
DO GETOR^FHWOR
DO ERR^FHOMWOR
QUIT
+6 SET DIE="^FHPT("
SET DA=FHDFN
SET DR="19////^S X=FHIP;20////^S X=FHORN"
DO ^DIE
+7 SET FILL="I;"_FHIP
+8 DO SEND^FHWOR
+9 SET FHIP=$PIECE($GET(^FH(119.4,FHIP,0)),U,1)
+10 SET FHACT="O"
SET FHOPTY="I"
SET (FHDIET,FHLOC,FHMEAL)=""
DO SETORX^FHOMRO2
+11 QUIT
CAN ;
+1 SET DIE="^FHPT("
SET DA=FHDFN
SET DR="19////@;20////FHORN"
DO ^DIE
+2 SET FHACT="O"
SET FHOPTY="I"
SET FHIP="Cancelled"
SET (FHDIET,FHLOC,FHMEAL)=""
+3 DO SETORX^FHOMRO2
+4 QUIT
UPD100 ;Backdoor message to update file #100 with a new IP order
+1 ;must have CPRSv26 for O.M. backdoor
if '$$PATCH^XPDUTL("OR*3.0*215")
QUIT
+2 if 'DFN
QUIT
if FHIP=""
QUIT
KILL MSG
DO SITE^FH
+3 SET FHOLOC=$ORDER(^FH(119.6,"AL",0))
SET FHOLOCNM=$PIECE($GET(^SC(FHOLOC,0)),U,1)
+4 SET MSG(1)="MSH|^~\&|DIETETICS|"_SITE(1)_"|||||ORM"
+5 SET MSG(2)="PID|||"_DFN_"||"_$PIECE($GET(^DPT(DFN,0)),"^",1)
+6 SET MSG(3)="PV1||O|"_FHOLOC_"^"_FHOLOCNM_"||||||||||||||||"
+7 DO NOW^%DTC
SET FHNOW=%
SET FHODT=$EXTRACT(%,1,7)
SET FHODT=$$FMTHL7^XLFDT(FHODT)
+8 SET FILL="I;"_FHNOW
SET FHIPEXT=$PIECE($GET(^FH(119.4,FHIP,0)),U,1)
+9 SET MSG(4)="ORC|SN||"_FILL_"^FH||||^^^"_FHODT_"^"_FHODT_"||||||||"_FHNOW
+10 SET MSG(5)="OBR||||||||||||^^^"_FHIP_"^"_FHIPEXT
+11 DO EVSEND^FHWOR
+12 QUIT
