MPIF002 ;CIOFOSF/CMC-UTILITY ROUTINE OF APIS ;JUL 12, 1996
;;1.0;MASTER PATIENT INDEX VISTA;**20,27,33,43,52,60**;30 Apr 99;Build 2
;
;Integration Agreements Utilized:
; ^DPT( - #2070
;
GETICNH(DFN,ICNHA) ;Return all ICNs (including checksum) in ICN History for patient DFN
; DFN = IEN of patient in the Patient (#2) file
; ICNHA - array where ICN History will be returned.
N IEN,ICN,CNT,RET
I '$D(^DPT(DFN)) S ICNHA="-1^NO SUCH DFN" Q
I '$D(^DPT(DFN,"MPIFHIS")) S ICNHA="-1^NO ICN HISTORY" Q
S (IEN,CNT)=0,RET=""
F S IEN=$O(^DPT(DFN,"MPIFHIS",IEN)) Q:IEN="" D
.S ICN=$P($G(^DPT(DFN,"MPIFHIS",IEN,0)),"^")_"V"_$P($G(^DPT(DFN,"MPIFHIS",IEN,0)),"^",2)
.I ICN'="" S CNT=CNT+1,ICNHA(CNT)=""""_ICN_""""
I CNT=0 S ICNHA="-1^NO ICN HISTORY" Q
S ICNHA=CNT
Q
GETCMORH(DFN,CMORHA) ;Return all CMORs in CMOR History for patient DFN
; DFN = IEN of patient in the Patient (#2) file
; CMORHA - array where CMOR history will be returned
N IEN,CMOR,CNT,RET
I '$D(^DPT(DFN)) S CMORHA="-1^NO SUCH DFN" Q
I '$D(^DPT(DFN,"MPICMOR")) S CMORHA="-1^NO CMOR HISTORY" Q
S (IEN,CNT)=0,RET=""
F S IEN=$O(^DPT(DFN,"MPICMOR",IEN)) Q:IEN="" D
.S CMOR=$P($G(^DPT(DFN,"MPICMOR",IEN,0)),"^")
.I CMOR'="" S CMOR=$P($$NNT^XUAF4(CMOR),"^",2)
.I CMOR'="" S CNT=CNT+1,CMORHA(CNT)=""""_CMOR_""""
I CNT=0 S CMORHA="-1^NO CMOR HISTORY" Q
S CMORHA=CNT
Q
GETDFNS(SSN) ; Find DFN for a given SSN - all if there are more than one
; SSN - SSN for patient attempted to be found in the Patient file (#2)
; Return - list of DFNs or -1^error msg
N DFN,LIST,CNT,NODE
I '$D(^DPT("SSN",SSN)) Q "-1^No such SSN"
S (DFN,LIST)="",CNT=0
F S DFN=$O(^DPT("SSN",SSN,DFN)) Q:DFN="" D
.I $D(^DPT(DFN)) D
..S LIST=LIST_DFN_"^",CNT=CNT+1
..S NODE=$$MPINODE^MPIFAPI(DFN),ICN=$P($G(^DPT(DFN,"MPI")),"^")
..I ICN'="",'$D(^DPT("AICN",ICN,DFN)) S ^DPT("AICN",ICN,DFN)=""
..; check if missing AICN x-ref and set if missing
I CNT=0 Q "-1^No such SSN"
Q LIST
GETICNS(SSN) ; Find all ICNs for a given SSN -- all if there are more than one
; patient with that SSN
; SSN - SSN for patient attempted to be found in the Patient file (#2)
; Returned is a list of ICNs for this SSN
N XX,DFNS,DFN,LIST,ICN,NODE
S LIST=""
I $G(SSN)'="" S DFNS=$$GETDFNS(SSN)
I +DFNS=-1 Q DFNS
F XX=1:1 S DFN=$P(DFNS,"^",XX) Q:DFN="" D
.S ICN=$$GETICN^MPIF001(DFN)
.I +ICN>0 S LIST=LIST_ICN_"^"
.I +ICN<0 S NODE=$$MPINODE^MPIFAPI(DFN),ICN=$P(NODE,"^") I ICN'="",'$D(^DPT("AICN",ICN,DFN)) S ^DPT("AICN",ICN,DFN)=""
Q LIST
TWODFNS(DFN1,DFN2,ICN) ;Logging Exceptions when there are two DFNs trying to have the same ICN, which isn't allowed.
N ARR1,ARR2,NAME1,NAME2,SSN1,SSN2,TEXT
I $G(DFN1)=""!($G(DFN2)="") Q
I '$D(^DPT(DFN1))!('$D(^DPT(DFN2))) Q
D GETDATA^MPIFQ0("^DPT(",DFN1,"MPIFD1",".01;.09","EI")
S NAME1=$G(MPIFD1(2,DFN1,.01,"E")),SSN1=$G(MPIFD1(2,DFN1,.09,"E"))
D GETDATA^MPIFQ0("^DPT(",DFN2,"MPIFD2",".01;.09","EI")
S NAME2=$G(MPIFD2(2,DFN2,.01,"E")),SSN2=$G(MPIFD2(2,DFN2,.09,"E"))
D ADD^XDRDADDS(.XDRSLT1,2,DFN1,DFN2)
;** 52 replace CIRN exception logging and notification with the creation of Local POTENTIAL DUP MERGE with status of UNVERIFIED
K MPIFD1,MPIFD2
Q
CLEAN(DFN,ARR,MPIRETN) ; clean up MPI data from DPT for "stub" records
; called from UPDATE^MPIFAPI
N ICN,CMOR,FICN
S ICN=+$$GETICN^MPIF001(DFN),CMOR=$$SITE^VASITE()
;**60 (elz) MVI_793 added Full ICN
S FICN=$$DFN2ICN^MPIF001(DFN)
I +ICN<0 S MPIRETN="-1^PT HAS NO ICN" Q
I $E(ICN,1,3)'=$P(CMOR,"^",3) S MPIRETN="-1^not a local ICN not cleaned up" Q
S CMOR=$P(CMOR,"^",1)
S ^DPT(DFN,"MPI")=""
;**60 (elz) MVI_793 add cross reference for full ICN
K ^DPT("AICNL",1,ICN),^DPT("AICN",ICN),^DPT("ACMOR",CMOR,DFN),^DPT("AFICN",FICN)
S MPIRETN=0
Q
;**43 COMPARE AND MIMDQ ADDED in patch 43
COMPARE(DFN,INDEX,COMMON,MORE) ; Checking if TFs in common between CURRENT PT (DFN)
; and ^TMP("MPIFVQQ",$J,INDEX,"TF",ien) OR if patient is shared to exclude those with TYPE of OTHER
; INDEX is the selection entry
; COMMON is the value returned indicating if there are TFs in common
N ARR,IEN,ST,TYPE S (MORE,COMMON)=0
D TFL^VAFCTFU1(.ARR,DFN)
S IEN=0 F S IEN=$O(ARR(IEN)) Q:IEN=""!(IEN="ST#") S ARR("ST#",$P(ARR(IEN),"^"))=$$GET1^DIQ(4,$$IEN^XUAF4($P(ARR(IEN),"^"))_",",13,"E")
S IEN=0 F S IEN=$O(ARR("ST#",IEN)) Q:IEN="" D
.Q:IEN=$P($$SITE^VASITE(),"^",3)!(IEN=200)
.I $G(ARR("ST#",IEN))'="OTHER" S MORE=1
S IEN=0
F S IEN=$O(^TMP("MPIFVQQ",$J,INDEX,"TF",IEN)) Q:IEN=""!(COMMON) D
.S ST=$P(^TMP("MPIFVQQ",$J,INDEX,"TF",IEN),"^")
.Q:ST=200
.I $D(ARR("ST#",ST)) I $P($G(ARR("ST#",ST)),"^")'="OTHER" S COMMON=1
Q
MIMDQ(ICN,ICN2,DFN,MSG) ; while reviewing potential duplicates, site picked to link 2 patients together with TFs in common
; send exception to IMDQ team
D START^RGHLLOG()
D EXC^RGHLLOG(208,MSG,DFN)
D STOP^RGHLLOG()
W !,"Unable to match these ICNs together as"_$P(MSG,"-",2)
W !,"Exception has been sent to IMDQ team for assistance in resolving this",!,"MPI Duplicate. Local Exception has been automatically marked as processed."
Q
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HMPIF002 5129 printed Sep 23, 2025@19:46:44 Page 2
MPIF002 ;CIOFOSF/CMC-UTILITY ROUTINE OF APIS ;JUL 12, 1996
+1 ;;1.0;MASTER PATIENT INDEX VISTA;**20,27,33,43,52,60**;30 Apr 99;Build 2
+2 ;
+3 ;Integration Agreements Utilized:
+4 ; ^DPT( - #2070
+5 ;
GETICNH(DFN,ICNHA) ;Return all ICNs (including checksum) in ICN History for patient DFN
+1 ; DFN = IEN of patient in the Patient (#2) file
+2 ; ICNHA - array where ICN History will be returned.
+3 NEW IEN,ICN,CNT,RET
+4 IF '$DATA(^DPT(DFN))
SET ICNHA="-1^NO SUCH DFN"
QUIT
+5 IF '$DATA(^DPT(DFN,"MPIFHIS"))
SET ICNHA="-1^NO ICN HISTORY"
QUIT
+6 SET (IEN,CNT)=0
SET RET=""
+7 FOR
SET IEN=$ORDER(^DPT(DFN,"MPIFHIS",IEN))
if IEN=""
QUIT
Begin DoDot:1
+8 SET ICN=$PIECE($GET(^DPT(DFN,"MPIFHIS",IEN,0)),"^")_"V"_$PIECE($GET(^DPT(DFN,"MPIFHIS",IEN,0)),"^",2)
+9 IF ICN'=""
SET CNT=CNT+1
SET ICNHA(CNT)=""""_ICN_""""
End DoDot:1
+10 IF CNT=0
SET ICNHA="-1^NO ICN HISTORY"
QUIT
+11 SET ICNHA=CNT
+12 QUIT
GETCMORH(DFN,CMORHA) ;Return all CMORs in CMOR History for patient DFN
+1 ; DFN = IEN of patient in the Patient (#2) file
+2 ; CMORHA - array where CMOR history will be returned
+3 NEW IEN,CMOR,CNT,RET
+4 IF '$DATA(^DPT(DFN))
SET CMORHA="-1^NO SUCH DFN"
QUIT
+5 IF '$DATA(^DPT(DFN,"MPICMOR"))
SET CMORHA="-1^NO CMOR HISTORY"
QUIT
+6 SET (IEN,CNT)=0
SET RET=""
+7 FOR
SET IEN=$ORDER(^DPT(DFN,"MPICMOR",IEN))
if IEN=""
QUIT
Begin DoDot:1
+8 SET CMOR=$PIECE($GET(^DPT(DFN,"MPICMOR",IEN,0)),"^")
+9 IF CMOR'=""
SET CMOR=$PIECE($$NNT^XUAF4(CMOR),"^",2)
+10 IF CMOR'=""
SET CNT=CNT+1
SET CMORHA(CNT)=""""_CMOR_""""
End DoDot:1
+11 IF CNT=0
SET CMORHA="-1^NO CMOR HISTORY"
QUIT
+12 SET CMORHA=CNT
+13 QUIT
GETDFNS(SSN) ; Find DFN for a given SSN - all if there are more than one
+1 ; SSN - SSN for patient attempted to be found in the Patient file (#2)
+2 ; Return - list of DFNs or -1^error msg
+3 NEW DFN,LIST,CNT,NODE
+4 IF '$DATA(^DPT("SSN",SSN))
QUIT "-1^No such SSN"
+5 SET (DFN,LIST)=""
SET CNT=0
+6 FOR
SET DFN=$ORDER(^DPT("SSN",SSN,DFN))
if DFN=""
QUIT
Begin DoDot:1
+7 IF $DATA(^DPT(DFN))
Begin DoDot:2
+8 SET LIST=LIST_DFN_"^"
SET CNT=CNT+1
+9 SET NODE=$$MPINODE^MPIFAPI(DFN)
SET ICN=$PIECE($GET(^DPT(DFN,"MPI")),"^")
+10 IF ICN'=""
IF '$DATA(^DPT("AICN",ICN,DFN))
SET ^DPT("AICN",ICN,DFN)=""
+11 ; check if missing AICN x-ref and set if missing
End DoDot:2
End DoDot:1
+12 IF CNT=0
QUIT "-1^No such SSN"
+13 QUIT LIST
GETICNS(SSN) ; Find all ICNs for a given SSN -- all if there are more than one
+1 ; patient with that SSN
+2 ; SSN - SSN for patient attempted to be found in the Patient file (#2)
+3 ; Returned is a list of ICNs for this SSN
+4 NEW XX,DFNS,DFN,LIST,ICN,NODE
+5 SET LIST=""
+6 IF $GET(SSN)'=""
SET DFNS=$$GETDFNS(SSN)
+7 IF +DFNS=-1
QUIT DFNS
+8 FOR XX=1:1
SET DFN=$PIECE(DFNS,"^",XX)
if DFN=""
QUIT
Begin DoDot:1
+9 SET ICN=$$GETICN^MPIF001(DFN)
+10 IF +ICN>0
SET LIST=LIST_ICN_"^"
+11 IF +ICN<0
SET NODE=$$MPINODE^MPIFAPI(DFN)
SET ICN=$PIECE(NODE,"^")
IF ICN'=""
IF '$DATA(^DPT("AICN",ICN,DFN))
SET ^DPT("AICN",ICN,DFN)=""
End DoDot:1
+12 QUIT LIST
TWODFNS(DFN1,DFN2,ICN) ;Logging Exceptions when there are two DFNs trying to have the same ICN, which isn't allowed.
+1 NEW ARR1,ARR2,NAME1,NAME2,SSN1,SSN2,TEXT
+2 IF $GET(DFN1)=""!($GET(DFN2)="")
QUIT
+3 IF '$DATA(^DPT(DFN1))!('$DATA(^DPT(DFN2)))
QUIT
+4 DO GETDATA^MPIFQ0("^DPT(",DFN1,"MPIFD1",".01;.09","EI")
+5 SET NAME1=$GET(MPIFD1(2,DFN1,.01,"E"))
SET SSN1=$GET(MPIFD1(2,DFN1,.09,"E"))
+6 DO GETDATA^MPIFQ0("^DPT(",DFN2,"MPIFD2",".01;.09","EI")
+7 SET NAME2=$GET(MPIFD2(2,DFN2,.01,"E"))
SET SSN2=$GET(MPIFD2(2,DFN2,.09,"E"))
+8 DO ADD^XDRDADDS(.XDRSLT1,2,DFN1,DFN2)
+9 ;** 52 replace CIRN exception logging and notification with the creation of Local POTENTIAL DUP MERGE with status of UNVERIFIED
+10 KILL MPIFD1,MPIFD2
+11 QUIT
CLEAN(DFN,ARR,MPIRETN) ; clean up MPI data from DPT for "stub" records
+1 ; called from UPDATE^MPIFAPI
+2 NEW ICN,CMOR,FICN
+3 SET ICN=+$$GETICN^MPIF001(DFN)
SET CMOR=$$SITE^VASITE()
+4 ;**60 (elz) MVI_793 added Full ICN
+5 SET FICN=$$DFN2ICN^MPIF001(DFN)
+6 IF +ICN<0
SET MPIRETN="-1^PT HAS NO ICN"
QUIT
+7 IF $EXTRACT(ICN,1,3)'=$PIECE(CMOR,"^",3)
SET MPIRETN="-1^not a local ICN not cleaned up"
QUIT
+8 SET CMOR=$PIECE(CMOR,"^",1)
+9 SET ^DPT(DFN,"MPI")=""
+10 ;**60 (elz) MVI_793 add cross reference for full ICN
+11 KILL ^DPT("AICNL",1,ICN),^DPT("AICN",ICN),^DPT("ACMOR",CMOR,DFN),^DPT("AFICN",FICN)
+12 SET MPIRETN=0
+13 QUIT
+14 ;**43 COMPARE AND MIMDQ ADDED in patch 43
COMPARE(DFN,INDEX,COMMON,MORE) ; Checking if TFs in common between CURRENT PT (DFN)
+1 ; and ^TMP("MPIFVQQ",$J,INDEX,"TF",ien) OR if patient is shared to exclude those with TYPE of OTHER
+2 ; INDEX is the selection entry
+3 ; COMMON is the value returned indicating if there are TFs in common
+4 NEW ARR,IEN,ST,TYPE
SET (MORE,COMMON)=0
+5 DO TFL^VAFCTFU1(.ARR,DFN)
+6 SET IEN=0
FOR
SET IEN=$ORDER(ARR(IEN))
if IEN=""!(IEN="ST#")
QUIT
SET ARR("ST#",$PIECE(ARR(IEN),"^"))=$$GET1^DIQ(4,$$IEN^XUAF4($PIECE(ARR(IEN),"^"))_",",13,"E")
+7 SET IEN=0
FOR
SET IEN=$ORDER(ARR("ST#",IEN))
if IEN=""
QUIT
Begin DoDot:1
+8 if IEN=$PIECE($$SITE^VASITE(),"^",3)!(IEN=200)
QUIT
+9 IF $GET(ARR("ST#",IEN))'="OTHER"
SET MORE=1
End DoDot:1
+10 SET IEN=0
+11 FOR
SET IEN=$ORDER(^TMP("MPIFVQQ",$JOB,INDEX,"TF",IEN))
if IEN=""!(COMMON)
QUIT
Begin DoDot:1
+12 SET ST=$PIECE(^TMP("MPIFVQQ",$JOB,INDEX,"TF",IEN),"^")
+13 if ST=200
QUIT
+14 IF $DATA(ARR("ST#",ST))
IF $PIECE($GET(ARR("ST#",ST)),"^")'="OTHER"
SET COMMON=1
End DoDot:1
+15 QUIT
MIMDQ(ICN,ICN2,DFN,MSG) ; while reviewing potential duplicates, site picked to link 2 patients together with TFs in common
+1 ; send exception to IMDQ team
+2 DO START^RGHLLOG()
+3 DO EXC^RGHLLOG(208,MSG,DFN)
+4 DO STOP^RGHLLOG()
+5 WRITE !,"Unable to match these ICNs together as"_$PIECE(MSG,"-",2)
+6 WRITE !,"Exception has been sent to IMDQ team for assistance in resolving this",!,"MPI Duplicate. Local Exception has been automatically marked as processed."
+7 QUIT
+8 QUIT
