- 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 Jan 18, 2025@02:54:01 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