Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: FHOMIP

FHOMIP.m

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