MPIFRCMP ;BPCIO/CMC-PUSHING CMOR TO ANOTHER SITE REMOTELY ;JUNE 23, 2004
;;1.0; MASTER PATIENT INDEX VISTA ;**36**;30 Apr 99
;
; Integration Agreements Utilized:
;
; ^DGCN(391.91 IA #2751
; AVAFC^VAFCDD01 IA #3493
;
; Create a new request to change CMOR when your site is the CMOR VIA
; Remote RPC from the MPI
;
EN(RETURN,ICN,NCMOR) ;
; RETURN - Array to return the value 1 if successfully created request
; or -1^error message
; ICN - ICN for the patient that the CMOR is being changed for
; NCMOR - Which site should be the new CMOR - Station #
;
N DFN
S DFN=$$GETDFN^MPIF001(+ICN)
I +DFN<1 S RETURN="-1^No such ICN at site" Q
I $$GETVCCI^MPIF001(DFN)<0 S RETURN="-1^Patient doesn't have a CMOR" Q
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
N TMP,TCNT,TF
S TF=0
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
;Pt is shared, but are they shared with another VAMC?
S TMP="",TCNT=0 F S TMP=$O(^DGCN(391.91,"APAT",DFN,TMP)) Q:TMP="" D
.N TP S TP=$$GET1^DIQ(4,TMP_",",13)
.Q:TP'="VAMC"&(TP'="OC")&(TP'="M&ROC")&(TP'="RO-OC")
.; ^ only valid types of TFs that can be a CMOR
.S TCNT=TCNT+1
.I $$STA^XUAF4(TMP)=NCMOR S TF=1
I TCNT<2 S RETURN="-1^Patient isn't SHARED with another VAMC - CAN'T change CMOR" Q
I TF=0 S RETURN="-1^Site to be new CMOR is NOT a TF - Can't change CMOR" Q
; CHECK IF ALREADY OPEN/PENDING REQUEST
N ENT,STOP,MPIFNM,REQNM
S ENT=0,STOP=0 F S ENT=$O(^MPIF(984.9,"C",DFN,ENT)) Q:ENT=""!(STOP) D
.I $P($G(^MPIF(984.9,ENT,0)),"^",6)<4 S STOP=1
I STOP S RETURN="-1^There is already an open CMOR request for this patient" Q
N DA,DIE,DR,DIK,Y,DIRUT,REQ,TDA,XX,WHO,PHONE
S DA=$$ADD^MPIFNEW(),TDA=DA,PHONE=""
S DIE="^MPIF(984.9,",DR=".04///`"_DFN D ^DIE
S REQ=$P($G(^MPIF(984.9,DA,0)),"^")
S XX="CMOR Push by MPI Data Quality Team",WHO=.5,PHONE="MPI DQ Team"
S DIE="^MPIF(984.9,",DR="1.02///"_XX_";.02///`"_WHO_";.05///"_PHONE D ^DIE
N TSITE S TSITE=$$IEN^XUAF4(NCMOR)
S DIE="^MPIF(984.9,",DR=".07///`"_TSITE_";1.03///3;.09///`"_TSITE D ^DIE
;update site, type of action and cmor after approval
;
I $$CHK^MPIFEDIT(DA) S RETURN="-1^This request is missing required data." Q
;
S DR=".08////^S X=2;.06////^S X=2",DIE="^MPIF(984.9," D ^DIE S RETURN=1
; removed event queue due to delivery issues - this msg must be sent first followed by the actual change cmor msg.
N ERR,MPIFHL7 S ERR="ERRS",MPIFHL7=""
D EN^MPIFREQ("CMOR CHANGE REQUEST",DA,.ERR,MPIFHL7)
;
;NOW CHANGE CMOR AND SEND CHANGE CMOR MESSAGE
N TEXT,DIR,DR,CMOR,TMP,ERROR
S TEXT="Auto change - pushed CMOR",ERROR=0
S DIE="^MPIF(984.9,",DA=TDA,DR=".06///^S X=4;3.01///^S X=TEXT"
D ^DIE
S CMOR=$P($G(^MPIF(984.9,TDA,0)),"^",7)
I CMOR="" D Q
.S RETURN="-1^New CMOR Not Defined, PROBLEM WITH REQUEST"
S TMP=$$CHANGE^MPIF001(DFN,CMOR)
I +TMP<0 S ^DIE="^MPIF(984.9,",DA=TDA,DR=".06///^S X=1" D ^DIE Q
D BROAD^MPIFCMOR(DA,.ERROR)
Q
SYNC(RETURN,ICN) ;
N DFN
S DFN=$$GETDFN^MPIF001(ICN)
I +DFN<0 S RETURN(1)="-1^ICN doesn't exist at this site" Q
D AVAFC^VAFCDD01(DFN) ; trigger A08 msg
S RETURN(1)=1
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HMPIFRCMP 3289 printed Apr 09, 2024@21:13:41 Page 2
MPIFRCMP ;BPCIO/CMC-PUSHING CMOR TO ANOTHER SITE REMOTELY ;JUNE 23, 2004
+1 ;;1.0; MASTER PATIENT INDEX VISTA ;**36**;30 Apr 99
+2 ;
+3 ; Integration Agreements Utilized:
+4 ;
+5 ; ^DGCN(391.91 IA #2751
+6 ; AVAFC^VAFCDD01 IA #3493
+7 ;
+8 ; Create a new request to change CMOR when your site is the CMOR VIA
+9 ; Remote RPC from the MPI
+10 ;
EN(RETURN,ICN,NCMOR) ;
+1 ; RETURN - Array to return the value 1 if successfully created request
+2 ; or -1^error message
+3 ; ICN - ICN for the patient that the CMOR is being changed for
+4 ; NCMOR - Which site should be the new CMOR - Station #
+5 ;
+6 NEW DFN
+7 SET DFN=$$GETDFN^MPIF001(+ICN)
+8 IF +DFN<1
SET RETURN="-1^No such ICN at site"
QUIT
+9 IF $$GETVCCI^MPIF001(DFN)<0
SET RETURN="-1^Patient doesn't have a CMOR"
QUIT
+10 IF $$GETVCCI^MPIF001(DFN)'=$PIECE($$SITE^VASITE(),"^",3)
SET RETURN="-1^This site is NOT the CMOR, can't push the CMOR somewhere else."
QUIT
+11 NEW TMP,TCNT,TF
+12 SET TF=0
+13 SET TMP=$ORDER(^DGCN(391.91,"APAT",DFN,""))
IF $ORDER(^DGCN(391.91,"APAT",DFN,TMP))=""
SET RETURN="-1^Patient isn't SHARED - CAN'T change CMOR"
QUIT
+14 ;Pt is shared, but are they shared with another VAMC?
+15 SET TMP=""
SET TCNT=0
FOR
SET TMP=$ORDER(^DGCN(391.91,"APAT",DFN,TMP))
if TMP=""
QUIT
Begin DoDot:1
+16 NEW TP
SET TP=$$GET1^DIQ(4,TMP_",",13)
+17 if TP'="VAMC"&(TP'="OC")&(TP'="M&ROC")&(TP'="RO-OC")
QUIT
+18 ; ^ only valid types of TFs that can be a CMOR
+19 SET TCNT=TCNT+1
+20 IF $$STA^XUAF4(TMP)=NCMOR
SET TF=1
End DoDot:1
+21 IF TCNT<2
SET RETURN="-1^Patient isn't SHARED with another VAMC - CAN'T change CMOR"
QUIT
+22 IF TF=0
SET RETURN="-1^Site to be new CMOR is NOT a TF - Can't change CMOR"
QUIT
+23 ; CHECK IF ALREADY OPEN/PENDING REQUEST
+24 NEW ENT,STOP,MPIFNM,REQNM
+25 SET ENT=0
SET STOP=0
FOR
SET ENT=$ORDER(^MPIF(984.9,"C",DFN,ENT))
if ENT=""!(STOP)
QUIT
Begin DoDot:1
+26 IF $PIECE($GET(^MPIF(984.9,ENT,0)),"^",6)<4
SET STOP=1
End DoDot:1
+27 IF STOP
SET RETURN="-1^There is already an open CMOR request for this patient"
QUIT
+28 NEW DA,DIE,DR,DIK,Y,DIRUT,REQ,TDA,XX,WHO,PHONE
+29 SET DA=$$ADD^MPIFNEW()
SET TDA=DA
SET PHONE=""
+30 SET DIE="^MPIF(984.9,"
SET DR=".04///`"_DFN
DO ^DIE
+31 SET REQ=$PIECE($GET(^MPIF(984.9,DA,0)),"^")
+32 SET XX="CMOR Push by MPI Data Quality Team"
SET WHO=.5
SET PHONE="MPI DQ Team"
+33 SET DIE="^MPIF(984.9,"
SET DR="1.02///"_XX_";.02///`"_WHO_";.05///"_PHONE
DO ^DIE
+34 NEW TSITE
SET TSITE=$$IEN^XUAF4(NCMOR)
+35 SET DIE="^MPIF(984.9,"
SET DR=".07///`"_TSITE_";1.03///3;.09///`"_TSITE
DO ^DIE
+36 ;update site, type of action and cmor after approval
+37 ;
+38 IF $$CHK^MPIFEDIT(DA)
SET RETURN="-1^This request is missing required data."
QUIT
+39 ;
+40 SET DR=".08////^S X=2;.06////^S X=2"
SET DIE="^MPIF(984.9,"
DO ^DIE
SET RETURN=1
+41 ; removed event queue due to delivery issues - this msg must be sent first followed by the actual change cmor msg.
+42 NEW ERR,MPIFHL7
SET ERR="ERRS"
SET MPIFHL7=""
+43 DO EN^MPIFREQ("CMOR CHANGE REQUEST",DA,.ERR,MPIFHL7)
+44 ;
+45 ;NOW CHANGE CMOR AND SEND CHANGE CMOR MESSAGE
+46 NEW TEXT,DIR,DR,CMOR,TMP,ERROR
+47 SET TEXT="Auto change - pushed CMOR"
SET ERROR=0
+48 SET DIE="^MPIF(984.9,"
SET DA=TDA
SET DR=".06///^S X=4;3.01///^S X=TEXT"
+49 DO ^DIE
+50 SET CMOR=$PIECE($GET(^MPIF(984.9,TDA,0)),"^",7)
+51 IF CMOR=""
Begin DoDot:1
+52 SET RETURN="-1^New CMOR Not Defined, PROBLEM WITH REQUEST"
End DoDot:1
QUIT
+53 SET TMP=$$CHANGE^MPIF001(DFN,CMOR)
+54 IF +TMP<0
SET ^DIE="^MPIF(984.9,"
SET DA=TDA
SET DR=".06///^S X=1"
DO ^DIE
QUIT
+55 DO BROAD^MPIFCMOR(DA,.ERROR)
+56 QUIT
SYNC(RETURN,ICN) ;
+1 NEW DFN
+2 SET DFN=$$GETDFN^MPIF001(ICN)
+3 IF +DFN<0
SET RETURN(1)="-1^ICN doesn't exist at this site"
QUIT
+4 ; trigger A08 msg
DO AVAFC^VAFCDD01(DFN)
+5 SET RETURN(1)=1
+6 QUIT
