MPIFRPC2 ;SFCIO/CMC-MPIF RPC APIS ;24 OCT 01
;;1.0; MASTER PATIENT INDEX VISTA ;**20,24,33,43**;30 Apr 99
;
;Integration Agreements Utilized:
; ^DPT( - #2070
; FILE^VAFCTFU - #2988
; AVAFC^VAFCDD01 - #3493
; START, STOP, EXC^RGHLLOG - #2070
;
MULT(DFN,OLDFN) ; API to get "primary" dfn for a merged record
;**43 api created
I $D(^DPT(DFN,-9)) S OLDFN=OLDFN_DFN_"^"
F S DFN=$P($G(^DPT(DFN,-9)),"^") Q:'DFN!'$D(^DPT(DFN,-9)) S OLDFN=OLDFN_DFN_"^"
Q
;
SPI(RETURN,SSN,DFN1) ;
;RPC to Single Patient Initialization on patient with SSN
; RETURN - 1 for successful inactivation or -1^error msg
; SSN = is the SSN for the patient that is to be SPI'd
; DFN1 = is the IEN for the patient that is to be SPI'd
;
N RES,XX,DFN,ICN,TICN,MPIFA,OLDC,DFNOLD
I SSN=""&($G(DFN1)="") S RETURN="-1^No SSN or DFN Passed" Q
I SSN'="",SSN'?9N S RETURN="-1^Invalid SSN" Q
I SSN'="",'$D(^DPT("SSN",SSN)) S RETURN="-1^No such SSN" Q
I SSN'="" D
.S RETURN(0)="SSN USED "_SSN
.S RES=$$GETDFNS^MPIF002(SSN)
I SSN="",DFN1'?1N.N S RETURN="-1^Invalid DFN" Q
I SSN="",'$D(^DPT(DFN1)) S RETURN="-1^No such DFN" Q
;^ **43 Check only for DFN1 not DFN1,0 as not all merges have 0 nodes
I SSN="" D
.S RETURN(0)="DFN USED "_DFN1
.S RES=DFN1
I +RES=-1 S RETURN=RES Q
S DFNOLD=""
F XX=1:1 S DFN=$P(RES,"^",XX) Q:DFN="" D
.;**43 check to see if DFN is a FROM record in a duplicate record merge pair
.I $D(^DPT(DFN,-9)) S DFNOLD=DFNOLD_DFN_"^" S DFN=$P($G(^DPT(DFN,-9)),"^") D
..I $D(^DPT(DFN,-9)) D MULT(.DFN,.DFNOLD)
..S RETURN(0)="DFN-"_DFN_"-was used to SPI patient because the DFN passed was a merged DFN. The merged DFN(s) are: "_DFNOLD
.; a TO record of a merge can be the from record in another merge, need to find the final primary record
.; DFN is now the primary DFN
.; can be multiple entries with same SSN
.S TICN=$$GETICN^MPIF001(DFN)
.I +TICN'=-1&($P($$SITE^VASITE,"^",3)'=$E(TICN,1,3)) S RETURN(XX,0)="The DFN= "_DFN_" already has an ICN, ICN="_TICN Q
.S MPIFS=1,HLP("ACKTIME")=300,MPIFRES=1,MPIFRPC=1
.I '$D(^DPT(DFN)) S RETURN="-1^No such DFN" Q
.D GETS^DIQ(2,DFN_",",".01","IE","MPIFA")
.D CIRNEXC^MPIFQ0
.;**43 check to see if A28 message was requested to be sent to Add patient to MPI
.I MPIFRTN="DID A28" S RETURN(XX,0)="A28 Add Patient message has been triggered" K MPIFRTN,MPIFS,MPIFRES,MPIFRPC Q
.K MPIFRTN,MPIFS,MPIFRES,MPIFRPC
.S ICN=$$GETICN^MPIF001(DFN)
.I +ICN=-1 S RETURN(XX,0)="DFN "_DFN_" problem getting ICN assinged "_$P(ICN,"^",2),RETURN="-1^Unable to get ICN" Q
.K RET S RET=""
.;commented out in **43 as these exceptions shouldn't be happening any longer AND we want to SPI a local ICN
.;I $P($$SITE^VASITE,"^",3)=$E(+ICN,1,3) S RETURN="-1^Local ICN assigned" Q
.;D EXC^MPIFRPC(DFN,.RET,XX)
.;S RET(XX,"EXCEPTIONS")=$TR($G(RET(XX,"EXCEPTIONS")),"""","")
.;S RETURN(XX,0)="DFN "_DFN_" Local ICN assigned "_ICN_" EXCEPTIONS: "_$G(RET(XX,"EXCEPTIONS")),RETURN="-1^Local ICN assigned" Q
.S RETURN(XX)=ICN
Q
;
UPDATE(RET,SSN,ICN,CHK,CMOR,A08) ;
; update fields 991.01,991.02 and 991.03 remotely
I SSN=""!(ICN="")!(CHK="")!(CMOR="") S RET="-1^Missing required parameter" Q
I '$D(^DPT("SSN",SSN)) S RET="-1^No patient has that SSN at this site" Q
N DFN,MPIFA,TMP,RESLT
S DFN=$O(^DPT("SSN",SSN,""))
I $O(^DPT("SSN",SSN,DFN))'="" S RET="-1^More than one patient has that SSN at this site" Q
S TMP=$P($$MPINODE^MPIFAPI(DFN),"^")
I +TMP'=-1,$E(TMP,1,3)'=$P($$SITE^VASITE(),"^",3) S RET="-1^Patient has a national ICN, ICN="_TMP Q
S MPIFA(991.01)=ICN,MPIFA(991.02)=CHK,MPIFA(991.03)=$$LKUP^XUAF4(CMOR)
S RET=$$UPDATE^MPIFAPI(DFN,"MPIFA")
S RESLT=$$A24^MPIFA24B(DFN)
I +RESLT<0 D START^RGHLLOG(),EXC^RGHLLOG(208,"Problem building A24 (ADD TF) for DFN= "_DFN,DFN),STOP^RGHLLOG() S RET="-1^Problem building A24 (ADD TF) for Pt" Q
I A08=1 D AVAFC^VAFCDD01(DFN) ; trigger A08 msg
I A08=1 S RET=RET_"^and A08 triggered"
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HMPIFRPC2 3961 printed Nov 22, 2024@17:21:41 Page 2
MPIFRPC2 ;SFCIO/CMC-MPIF RPC APIS ;24 OCT 01
+1 ;;1.0; MASTER PATIENT INDEX VISTA ;**20,24,33,43**;30 Apr 99
+2 ;
+3 ;Integration Agreements Utilized:
+4 ; ^DPT( - #2070
+5 ; FILE^VAFCTFU - #2988
+6 ; AVAFC^VAFCDD01 - #3493
+7 ; START, STOP, EXC^RGHLLOG - #2070
+8 ;
MULT(DFN,OLDFN) ; API to get "primary" dfn for a merged record
+1 ;**43 api created
+2 IF $DATA(^DPT(DFN,-9))
SET OLDFN=OLDFN_DFN_"^"
+3 FOR
SET DFN=$PIECE($GET(^DPT(DFN,-9)),"^")
if 'DFN!'$DATA(^DPT(DFN,-9))
QUIT
SET OLDFN=OLDFN_DFN_"^"
+4 QUIT
+5 ;
SPI(RETURN,SSN,DFN1) ;
+1 ;RPC to Single Patient Initialization on patient with SSN
+2 ; RETURN - 1 for successful inactivation or -1^error msg
+3 ; SSN = is the SSN for the patient that is to be SPI'd
+4 ; DFN1 = is the IEN for the patient that is to be SPI'd
+5 ;
+6 NEW RES,XX,DFN,ICN,TICN,MPIFA,OLDC,DFNOLD
+7 IF SSN=""&($GET(DFN1)="")
SET RETURN="-1^No SSN or DFN Passed"
QUIT
+8 IF SSN'=""
IF SSN'?9N
SET RETURN="-1^Invalid SSN"
QUIT
+9 IF SSN'=""
IF '$DATA(^DPT("SSN",SSN))
SET RETURN="-1^No such SSN"
QUIT
+10 IF SSN'=""
Begin DoDot:1
+11 SET RETURN(0)="SSN USED "_SSN
+12 SET RES=$$GETDFNS^MPIF002(SSN)
End DoDot:1
+13 IF SSN=""
IF DFN1'?1N.N
SET RETURN="-1^Invalid DFN"
QUIT
+14 IF SSN=""
IF '$DATA(^DPT(DFN1))
SET RETURN="-1^No such DFN"
QUIT
+15 ;^ **43 Check only for DFN1 not DFN1,0 as not all merges have 0 nodes
+16 IF SSN=""
Begin DoDot:1
+17 SET RETURN(0)="DFN USED "_DFN1
+18 SET RES=DFN1
End DoDot:1
+19 IF +RES=-1
SET RETURN=RES
QUIT
+20 SET DFNOLD=""
+21 FOR XX=1:1
SET DFN=$PIECE(RES,"^",XX)
if DFN=""
QUIT
Begin DoDot:1
+22 ;**43 check to see if DFN is a FROM record in a duplicate record merge pair
+23 IF $DATA(^DPT(DFN,-9))
SET DFNOLD=DFNOLD_DFN_"^"
SET DFN=$PIECE($GET(^DPT(DFN,-9)),"^")
Begin DoDot:2
+24 IF $DATA(^DPT(DFN,-9))
DO MULT(.DFN,.DFNOLD)
+25 SET RETURN(0)="DFN-"_DFN_"-was used to SPI patient because the DFN passed was a merged DFN. The merged DFN(s) are: "_DFNOLD
End DoDot:2
+26 ; a TO record of a merge can be the from record in another merge, need to find the final primary record
+27 ; DFN is now the primary DFN
+28 ; can be multiple entries with same SSN
+29 SET TICN=$$GETICN^MPIF001(DFN)
+30 IF +TICN'=-1&($PIECE($$SITE^VASITE,"^",3)'=$EXTRACT(TICN,1,3))
SET RETURN(XX,0)="The DFN= "_DFN_" already has an ICN, ICN="_TICN
QUIT
+31 SET MPIFS=1
SET HLP("ACKTIME")=300
SET MPIFRES=1
SET MPIFRPC=1
+32 IF '$DATA(^DPT(DFN))
SET RETURN="-1^No such DFN"
QUIT
+33 DO GETS^DIQ(2,DFN_",",".01","IE","MPIFA")
+34 DO CIRNEXC^MPIFQ0
+35 ;**43 check to see if A28 message was requested to be sent to Add patient to MPI
+36 IF MPIFRTN="DID A28"
SET RETURN(XX,0)="A28 Add Patient message has been triggered"
KILL MPIFRTN,MPIFS,MPIFRES,MPIFRPC
QUIT
+37 KILL MPIFRTN,MPIFS,MPIFRES,MPIFRPC
+38 SET ICN=$$GETICN^MPIF001(DFN)
+39 IF +ICN=-1
SET RETURN(XX,0)="DFN "_DFN_" problem getting ICN assinged "_$PIECE(ICN,"^",2)
SET RETURN="-1^Unable to get ICN"
QUIT
+40 KILL RET
SET RET=""
+41 ;commented out in **43 as these exceptions shouldn't be happening any longer AND we want to SPI a local ICN
+42 ;I $P($$SITE^VASITE,"^",3)=$E(+ICN,1,3) S RETURN="-1^Local ICN assigned" Q
+43 ;D EXC^MPIFRPC(DFN,.RET,XX)
+44 ;S RET(XX,"EXCEPTIONS")=$TR($G(RET(XX,"EXCEPTIONS")),"""","")
+45 ;S RETURN(XX,0)="DFN "_DFN_" Local ICN assigned "_ICN_" EXCEPTIONS: "_$G(RET(XX,"EXCEPTIONS")),RETURN="-1^Local ICN assigned" Q
+46 SET RETURN(XX)=ICN
End DoDot:1
+47 QUIT
+48 ;
UPDATE(RET,SSN,ICN,CHK,CMOR,A08) ;
+1 ; update fields 991.01,991.02 and 991.03 remotely
+2 IF SSN=""!(ICN="")!(CHK="")!(CMOR="")
SET RET="-1^Missing required parameter"
QUIT
+3 IF '$DATA(^DPT("SSN",SSN))
SET RET="-1^No patient has that SSN at this site"
QUIT
+4 NEW DFN,MPIFA,TMP,RESLT
+5 SET DFN=$ORDER(^DPT("SSN",SSN,""))
+6 IF $ORDER(^DPT("SSN",SSN,DFN))'=""
SET RET="-1^More than one patient has that SSN at this site"
QUIT
+7 SET TMP=$PIECE($$MPINODE^MPIFAPI(DFN),"^")
+8 IF +TMP'=-1
IF $EXTRACT(TMP,1,3)'=$PIECE($$SITE^VASITE(),"^",3)
SET RET="-1^Patient has a national ICN, ICN="_TMP
QUIT
+9 SET MPIFA(991.01)=ICN
SET MPIFA(991.02)=CHK
SET MPIFA(991.03)=$$LKUP^XUAF4(CMOR)
+10 SET RET=$$UPDATE^MPIFAPI(DFN,"MPIFA")
+11 SET RESLT=$$A24^MPIFA24B(DFN)
+12 IF +RESLT<0
DO START^RGHLLOG()
DO EXC^RGHLLOG(208,"Problem building A24 (ADD TF) for DFN= "_DFN,DFN)
DO STOP^RGHLLOG()
SET RET="-1^Problem building A24 (ADD TF) for Pt"
QUIT
+13 ; trigger A08 msg
IF A08=1
DO AVAFC^VAFCDD01(DFN)
+14 IF A08=1
SET RET=RET_"^and A08 triggered"
+15 QUIT
