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

MPIF002.m

Go to the documentation of this file.
  1. 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
  1. ;
  1. ;Integration Agreements Utilized:
  1. ; ^DPT( - #2070
  1. ;
  1. GETICNH(DFN,ICNHA) ;Return all ICNs (including checksum) in ICN History for patient DFN
  1. ; DFN = IEN of patient in the Patient (#2) file
  1. ; ICNHA - array where ICN History will be returned.
  1. N IEN,ICN,CNT,RET
  1. I '$D(^DPT(DFN)) S ICNHA="-1^NO SUCH DFN" Q
  1. I '$D(^DPT(DFN,"MPIFHIS")) S ICNHA="-1^NO ICN HISTORY" Q
  1. S (IEN,CNT)=0,RET=""
  1. F S IEN=$O(^DPT(DFN,"MPIFHIS",IEN)) Q:IEN="" D
  1. .S ICN=$P($G(^DPT(DFN,"MPIFHIS",IEN,0)),"^")_"V"_$P($G(^DPT(DFN,"MPIFHIS",IEN,0)),"^",2)
  1. .I ICN'="" S CNT=CNT+1,ICNHA(CNT)=""""_ICN_""""
  1. I CNT=0 S ICNHA="-1^NO ICN HISTORY" Q
  1. S ICNHA=CNT
  1. Q
  1. GETCMORH(DFN,CMORHA) ;Return all CMORs in CMOR History for patient DFN
  1. ; DFN = IEN of patient in the Patient (#2) file
  1. ; CMORHA - array where CMOR history will be returned
  1. N IEN,CMOR,CNT,RET
  1. I '$D(^DPT(DFN)) S CMORHA="-1^NO SUCH DFN" Q
  1. I '$D(^DPT(DFN,"MPICMOR")) S CMORHA="-1^NO CMOR HISTORY" Q
  1. S (IEN,CNT)=0,RET=""
  1. F S IEN=$O(^DPT(DFN,"MPICMOR",IEN)) Q:IEN="" D
  1. .S CMOR=$P($G(^DPT(DFN,"MPICMOR",IEN,0)),"^")
  1. .I CMOR'="" S CMOR=$P($$NNT^XUAF4(CMOR),"^",2)
  1. .I CMOR'="" S CNT=CNT+1,CMORHA(CNT)=""""_CMOR_""""
  1. I CNT=0 S CMORHA="-1^NO CMOR HISTORY" Q
  1. S CMORHA=CNT
  1. Q
  1. 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)
  1. ; Return - list of DFNs or -1^error msg
  1. N DFN,LIST,CNT,NODE
  1. I '$D(^DPT("SSN",SSN)) Q "-1^No such SSN"
  1. S (DFN,LIST)="",CNT=0
  1. F S DFN=$O(^DPT("SSN",SSN,DFN)) Q:DFN="" D
  1. .I $D(^DPT(DFN)) D
  1. ..S LIST=LIST_DFN_"^",CNT=CNT+1
  1. ..S NODE=$$MPINODE^MPIFAPI(DFN),ICN=$P($G(^DPT(DFN,"MPI")),"^")
  1. ..I ICN'="",'$D(^DPT("AICN",ICN,DFN)) S ^DPT("AICN",ICN,DFN)=""
  1. ..; check if missing AICN x-ref and set if missing
  1. I CNT=0 Q "-1^No such SSN"
  1. Q LIST
  1. GETICNS(SSN) ; Find all ICNs for a given SSN -- all if there are more than one
  1. ; patient with that SSN
  1. ; SSN - SSN for patient attempted to be found in the Patient file (#2)
  1. ; Returned is a list of ICNs for this SSN
  1. N XX,DFNS,DFN,LIST,ICN,NODE
  1. S LIST=""
  1. I $G(SSN)'="" S DFNS=$$GETDFNS(SSN)
  1. I +DFNS=-1 Q DFNS
  1. F XX=1:1 S DFN=$P(DFNS,"^",XX) Q:DFN="" D
  1. .S ICN=$$GETICN^MPIF001(DFN)
  1. .I +ICN>0 S LIST=LIST_ICN_"^"
  1. .I +ICN<0 S NODE=$$MPINODE^MPIFAPI(DFN),ICN=$P(NODE,"^") I ICN'="",'$D(^DPT("AICN",ICN,DFN)) S ^DPT("AICN",ICN,DFN)=""
  1. Q LIST
  1. TWODFNS(DFN1,DFN2,ICN) ;Logging Exceptions when there are two DFNs trying to have the same ICN, which isn't allowed.
  1. N ARR1,ARR2,NAME1,NAME2,SSN1,SSN2,TEXT
  1. I $G(DFN1)=""!($G(DFN2)="") Q
  1. I '$D(^DPT(DFN1))!('$D(^DPT(DFN2))) Q
  1. D GETDATA^MPIFQ0("^DPT(",DFN1,"MPIFD1",".01;.09","EI")
  1. S NAME1=$G(MPIFD1(2,DFN1,.01,"E")),SSN1=$G(MPIFD1(2,DFN1,.09,"E"))
  1. D GETDATA^MPIFQ0("^DPT(",DFN2,"MPIFD2",".01;.09","EI")
  1. S NAME2=$G(MPIFD2(2,DFN2,.01,"E")),SSN2=$G(MPIFD2(2,DFN2,.09,"E"))
  1. D ADD^XDRDADDS(.XDRSLT1,2,DFN1,DFN2)
  1. ;** 52 replace CIRN exception logging and notification with the creation of Local POTENTIAL DUP MERGE with status of UNVERIFIED
  1. K MPIFD1,MPIFD2
  1. Q
  1. CLEAN(DFN,ARR,MPIRETN) ; clean up MPI data from DPT for "stub" records
  1. ; called from UPDATE^MPIFAPI
  1. N ICN,CMOR,FICN
  1. S ICN=+$$GETICN^MPIF001(DFN),CMOR=$$SITE^VASITE()
  1. ;**60 (elz) MVI_793 added Full ICN
  1. S FICN=$$DFN2ICN^MPIF001(DFN)
  1. I +ICN<0 S MPIRETN="-1^PT HAS NO ICN" Q
  1. I $E(ICN,1,3)'=$P(CMOR,"^",3) S MPIRETN="-1^not a local ICN not cleaned up" Q
  1. S CMOR=$P(CMOR,"^",1)
  1. S ^DPT(DFN,"MPI")=""
  1. ;**60 (elz) MVI_793 add cross reference for full ICN
  1. K ^DPT("AICNL",1,ICN),^DPT("AICN",ICN),^DPT("ACMOR",CMOR,DFN),^DPT("AFICN",FICN)
  1. S MPIRETN=0
  1. Q
  1. ;**43 COMPARE AND MIMDQ ADDED in patch 43
  1. 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
  1. ; INDEX is the selection entry
  1. ; COMMON is the value returned indicating if there are TFs in common
  1. N ARR,IEN,ST,TYPE S (MORE,COMMON)=0
  1. D TFL^VAFCTFU1(.ARR,DFN)
  1. 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")
  1. S IEN=0 F S IEN=$O(ARR("ST#",IEN)) Q:IEN="" D
  1. .Q:IEN=$P($$SITE^VASITE(),"^",3)!(IEN=200)
  1. .I $G(ARR("ST#",IEN))'="OTHER" S MORE=1
  1. S IEN=0
  1. F S IEN=$O(^TMP("MPIFVQQ",$J,INDEX,"TF",IEN)) Q:IEN=""!(COMMON) D
  1. .S ST=$P(^TMP("MPIFVQQ",$J,INDEX,"TF",IEN),"^")
  1. .Q:ST=200
  1. .I $D(ARR("ST#",ST)) I $P($G(ARR("ST#",ST)),"^")'="OTHER" S COMMON=1
  1. Q
  1. 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
  1. D START^RGHLLOG()
  1. D EXC^RGHLLOG(208,MSG,DFN)
  1. D STOP^RGHLLOG()
  1. W !,"Unable to match these ICNs together as"_$P(MSG,"-",2)
  1. W !,"Exception has been sent to IMDQ team for assistance in resolving this",!,"MPI Duplicate. Local Exception has been automatically marked as processed."
  1. Q
  1. Q