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

MPIFRCMP.m

Go to the documentation of this file. 
  1. MPIFRCMP ;BPCIO/CMC-PUSHING CMOR TO ANOTHER SITE REMOTELY ;JUNE 23, 2004
  1.  ;;1.0; MASTER PATIENT INDEX VISTA ;**36**;30 Apr 99
  1.  ;
  1.  ; Integration Agreements Utilized:
  1.  ;
  1.  ; ^DGCN(391.91   IA #2751
  1.  ; AVAFC^VAFCDD01 IA #3493
  1.  ;
  1.  ; Create a new request to change CMOR when your site is the CMOR VIA
  1.  ; Remote RPC from the MPI
  1.  ;
  1. EN(RETURN,ICN,NCMOR) ;
  1.  ; RETURN - Array to return the value 1 if successfully created request
  1.  ; or -1^error message
  1.  ; ICN - ICN for the patient that the CMOR is being changed for
  1.  ; NCMOR - Which site should be the new CMOR - Station #
  1.  ;
  1.  N DFN
  1.  S DFN=$$GETDFN^MPIF001(+ICN)
  1.  I +DFN<1 S RETURN="-1^No such ICN at site" Q
  1.  I $$GETVCCI^MPIF001(DFN)<0 S RETURN="-1^Patient doesn't have a CMOR" Q
  1.  I $$GETVCCI^MPIF001(DFN)'=$P($$SITE^VASITE(),"^",3) S RETURN="-1^This site is NOT the CMOR, can't push the CMOR somewhere else." Q
  1.  N TMP,TCNT,TF
  1.  S TF=0
  1.  S TMP=$O(^DGCN(391.91,"APAT",DFN,"")) I $O(^DGCN(391.91,"APAT",DFN,TMP))="" S RETURN="-1^Patient isn't SHARED - CAN'T change CMOR" Q
  1.  ;Pt is shared, but are they shared with another VAMC?
  1.  S TMP="",TCNT=0 F  S TMP=$O(^DGCN(391.91,"APAT",DFN,TMP)) Q:TMP=""  D
  1.  .N TP S TP=$$GET1^DIQ(4,TMP_",",13)
  1.  .Q:TP'="VAMC"&(TP'="OC")&(TP'="M&ROC")&(TP'="RO-OC")
  1.  .; ^ only valid types of TFs that can be a CMOR 
  1.  .S TCNT=TCNT+1
  1.  .I $$STA^XUAF4(TMP)=NCMOR S TF=1
  1.  I TCNT<2 S RETURN="-1^Patient isn't SHARED with another VAMC - CAN'T change CMOR" Q
  1.  I TF=0 S RETURN="-1^Site to be new CMOR is NOT a TF - Can't change CMOR" Q
  1.  ; CHECK IF ALREADY OPEN/PENDING REQUEST
  1.  N ENT,STOP,MPIFNM,REQNM
  1.  S ENT=0,STOP=0 F  S ENT=$O(^MPIF(984.9,"C",DFN,ENT)) Q:ENT=""!(STOP)  D
  1.  .I $P($G(^MPIF(984.9,ENT,0)),"^",6)<4 S STOP=1
  1.  I STOP S RETURN="-1^There is already an open CMOR request for this patient" Q
  1.  N DA,DIE,DR,DIK,Y,DIRUT,REQ,TDA,XX,WHO,PHONE
  1.  S DA=$$ADD^MPIFNEW(),TDA=DA,PHONE=""
  1.  S DIE="^MPIF(984.9,",DR=".04///`"_DFN D ^DIE
  1.  S REQ=$P($G(^MPIF(984.9,DA,0)),"^")
  1.  S XX="CMOR Push by MPI Data Quality Team",WHO=.5,PHONE="MPI DQ Team"
  1.  S DIE="^MPIF(984.9,",DR="1.02///"_XX_";.02///`"_WHO_";.05///"_PHONE D ^DIE
  1.  N TSITE S TSITE=$$IEN^XUAF4(NCMOR)
  1.  S DIE="^MPIF(984.9,",DR=".07///`"_TSITE_";1.03///3;.09///`"_TSITE D ^DIE
  1.  ;update site, type of action and cmor after approval
  1.  ;
  1.  I $$CHK^MPIFEDIT(DA) S RETURN="-1^This request is missing required data." Q
  1.  ;
  1.  S DR=".08////^S X=2;.06////^S X=2",DIE="^MPIF(984.9," D ^DIE S RETURN=1
  1.  ; removed event queue due to delivery issues - this msg must be sent first followed by the actual change cmor msg.
  1.  N ERR,MPIFHL7 S ERR="ERRS",MPIFHL7=""
  1.  D EN^MPIFREQ("CMOR CHANGE REQUEST",DA,.ERR,MPIFHL7)
  1.  ;
  1.  ;NOW CHANGE CMOR AND SEND CHANGE CMOR MESSAGE
  1.  N TEXT,DIR,DR,CMOR,TMP,ERROR
  1.  S TEXT="Auto change - pushed CMOR",ERROR=0
  1.  S DIE="^MPIF(984.9,",DA=TDA,DR=".06///^S X=4;3.01///^S X=TEXT"
  1.  D ^DIE
  1.  S CMOR=$P($G(^MPIF(984.9,TDA,0)),"^",7)
  1.  I CMOR="" D  Q
  1.  .S RETURN="-1^New CMOR Not Defined, PROBLEM WITH REQUEST"
  1.  S TMP=$$CHANGE^MPIF001(DFN,CMOR)
  1.  I +TMP<0 S ^DIE="^MPIF(984.9,",DA=TDA,DR=".06///^S X=1" D ^DIE Q
  1.  D BROAD^MPIFCMOR(DA,.ERROR)
  1.  Q
  1. SYNC(RETURN,ICN) ;
  1.  N DFN
  1.  S DFN=$$GETDFN^MPIF001(ICN)
  1.  I +DFN<0 S RETURN(1)="-1^ICN doesn't exist at this site" Q
  1.  D AVAFC^VAFCDD01(DFN) ; trigger A08 msg
  1.  S RETURN(1)=1
  1.  Q