- 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 Feb 18, 2025@23:36:59 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