source: FOIAVistA/trunk/r/MASTER_PATIENT_INDEX_VISTA-MPIF/MPIF002.m@ 1757

Last change on this file since 1757 was 628, checked in by George Lilly, 15 years ago

initial load of FOIAVistA 6/30/08 version

File size: 5.6 KB
Line 
1MPIF002 ;CIOFOSF/CMC-UTILITY ROUTINE OF APIS ;JUL 12, 1996
2 ;;1.0; MASTER PATIENT INDEX VISTA ;**20,27,33,43**;30 Apr 99
3 ;
4 ;Integration Agreements Utilized:
5 ; ^DPT( - #2070
6 ;
7GETICNH(DFN,ICNHA) ;Return all ICNs (including checksum) in ICN History for patient DFN
8 ; DFN = IEN of patient in the Patient (#2) file
9 ; ICNHA - array where ICN History will be returned.
10 N IEN,ICN,CNT,RET
11 I '$D(^DPT(DFN)) S ICNHA="-1^NO SUCH DFN" Q
12 I '$D(^DPT(DFN,"MPIFHIS")) S ICNHA="-1^NO ICN HISTORY" Q
13 S (IEN,CNT)=0,RET=""
14 F S IEN=$O(^DPT(DFN,"MPIFHIS",IEN)) Q:IEN="" D
15 .S ICN=$P($G(^DPT(DFN,"MPIFHIS",IEN,0)),"^")_"V"_$P($G(^DPT(DFN,"MPIFHIS",IEN,0)),"^",2)
16 .I ICN'="" S CNT=CNT+1,ICNHA(CNT)=""""_ICN_""""
17 I CNT=0 S ICNHA="-1^NO ICN HISTORY" Q
18 S ICNHA=CNT
19 Q
20GETCMORH(DFN,CMORHA) ;Return all CMORs in CMOR History for patient DFN
21 ; DFN = IEN of patient in the Patient (#2) file
22 ; CMORHA - array where CMOR history will be returned
23 N IEN,CMOR,CNT,RET
24 I '$D(^DPT(DFN)) S CMORHA="-1^NO SUCH DFN" Q
25 I '$D(^DPT(DFN,"MPICMOR")) S CMORHA="-1^NO CMOR HISTORY" Q
26 S (IEN,CNT)=0,RET=""
27 F S IEN=$O(^DPT(DFN,"MPICMOR",IEN)) Q:IEN="" D
28 .S CMOR=$P($G(^DPT(DFN,"MPICMOR",IEN,0)),"^")
29 .I CMOR'="" S CMOR=$P($$NNT^XUAF4(CMOR),"^",2)
30 .I CMOR'="" S CNT=CNT+1,CMORHA(CNT)=""""_CMOR_""""
31 I CNT=0 S CMORHA="-1^NO CMOR HISTORY" Q
32 S CMORHA=CNT
33 Q
34GETDFNS(SSN) ; Find DFN for a given SSN - all if there are more than one
35 ; SSN - SSN for patient attempted to be found in the Patient file (#2)
36 ; Return - list of DFNs or -1^error msg
37 N DFN,LIST,CNT,NODE
38 I '$D(^DPT("SSN",SSN)) Q "-1^No such SSN"
39 S (DFN,LIST)="",CNT=0
40 F S DFN=$O(^DPT("SSN",SSN,DFN)) Q:DFN="" D
41 .I $D(^DPT(DFN)) D
42 ..S LIST=LIST_DFN_"^",CNT=CNT+1
43 ..S NODE=$$MPINODE^MPIFAPI(DFN),ICN=$P($G(^DPT(DFN,"MPI")),"^")
44 ..I ICN'="",'$D(^DPT("AICN",ICN,DFN)) S ^DPT("AICN",ICN,DFN)=""
45 ..; check if missing AICN x-ref and set if missing
46 I CNT=0 Q "-1^No such SSN"
47 Q LIST
48GETICNS(SSN) ; Find all ICNs for a given SSN -- all if there are more than one
49 ; patient with that SSN
50 ; SSN - SSN for patient attempted to be found in the Patient file (#2)
51 ; Returned is a list of ICNs for this SSN
52 N XX,DFNS,DFN,LIST,ICN,NODE
53 S LIST=""
54 I $G(SSN)'="" S DFNS=$$GETDFNS(SSN)
55 I +DFNS=-1 Q DFNS
56 F XX=1:1 S DFN=$P(DFNS,"^",XX) Q:DFN="" D
57 .S ICN=$$GETICN^MPIF001(DFN)
58 .I +ICN>0 S LIST=LIST_ICN_"^"
59 .I +ICN<0 S NODE=$$MPINODE^MPIFAPI(DFN),ICN=$P(NODE,"^") I ICN'="",'$D(^DPT("AICN",ICN,DFN)) S ^DPT("AICN",ICN,DFN)=""
60 Q LIST
61TWODFNS(DFN1,DFN2,ICN) ;Logging Exceptions when there are two DFNs trying to have the same ICN, which isn't allowed.
62 N ARR1,ARR2,NAME1,NAME2,SSN1,SSN2,TEXT
63 I $G(DFN1)=""!($G(DFN2)="") Q
64 I '$D(^DPT(DFN1))!('$D(^DPT(DFN2))) Q
65 D GETDATA^MPIFQ0("^DPT(",DFN1,"MPIFD1",".01;.09","EI")
66 S NAME1=$G(MPIFD1(2,DFN1,.01,"E")),SSN1=$G(MPIFD1(2,DFN1,.09,"E"))
67 D GETDATA^MPIFQ0("^DPT(",DFN2,"MPIFD2",".01;.09","EI")
68 S NAME2=$G(MPIFD2(2,DFN2,.01,"E")),SSN2=$G(MPIFD2(2,DFN2,.09,"E"))
69 D START^RGHLLOG()
70 D EXC^RGHLLOG(227,"Patient DFN="_DFN2_"is trying to be assigned ICN "_ICN_" which is already in use for DFN="_DFN1,DFN2)
71 D STOP^RGHLLOG()
72 ; send format e-mail to RG CIRN DEMOGRAPHICS MAIL GROUP
73 N MPIF,XMDUZ,XMSUB,XMY,XMTEXT
74 S MPIF(1,1)="Multiple ICN Conflict"
75 S MPIF(1,2)=""
76 S MPIF(1,3)="Record for Patient "_NAME2_" SSN= "_SSN2_" DFN= "_DFN2
77 S MPIF(1,4)="returned ICN "_ICN_" which is already in use by Patient"
78 S MPIF(1,5)=NAME1_" SSN= "_SSN1_" DFN= "_DFN1_". This may"
79 S MPIF(1,6)="indicate duplicate patients on your system. Check pair"
80 S MPIF(1,7)="to determine if a duplicate record exists. If records are"
81 S MPIF(1,8)="found to be duplicates they will need to be merged using"
82 S MPIF(1,9)="the Duplicate Record Merge software."
83 S MPIF(1,10)=""
84 S MPIF(1,11)="Please log a NOIS or contact the MPI Data Quality Management"
85 S MPIF(1,12)="Team if you are unable to resolve the conflict."
86 S XMDUZ="MPI/PD VISTA PACKAGE"
87 S XMSUB="MPI/PD Exception: Multiple ICNs"
88 S XMY("G.RG CIRN DEMOGRAPHIC ISSUES")="",XMTEXT="MPIF(1,"
89 D ^XMD
90 K MPIFD1,MPIFD2
91 Q
92CLEAN(DFN,ARR,MPIRETN) ; clean up MPI data from DPT for "stub" records
93 ; called from UPDATE^MPIFAPI
94 N ICN,CMOR
95 S ICN=+$$GETICN^MPIF001(DFN),CMOR=$$SITE^VASITE()
96 I +ICN<0 S MPIRETN="-1^PT HAS NO ICN" Q
97 I $E(ICN,1,3)'=$P(CMOR,"^",3) S MPIRETN="-1^not a local ICN not cleaned up" Q
98 S CMOR=$P(CMOR,"^",1)
99 S ^DPT(DFN,"MPI")=""
100 K ^DPT("AICNL",1,ICN),^DPT("AICN",ICN),^DPT("ACMOR",CMOR,DFN)
101 S MPIRETN=0
102 Q
103 ;**43 COMPARE AND MIMDQ ADDED in patch 43
104COMPARE(DFN,INDEX,COMMON,MORE) ; Checking if TFs in common between CURRENT PT (DFN)
105 ; and ^TMP("MPIFVQQ",$J,INDEX,"TF",ien) OR if patient is shared to exclude those with TYPE of OTHER
106 ; INDEX is the selection entry
107 ; COMMON is the value returned indicating if there are TFs in common
108 N ARR,IEN,ST,TYPE S (MORE,COMMON)=0
109 D TFL^VAFCTFU1(.ARR,DFN)
110 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")
111 S IEN=0 F S IEN=$O(ARR("ST#",IEN)) Q:IEN="" D
112 .Q:IEN=$P($$SITE^VASITE(),"^",3)!(IEN=200)
113 .I $G(ARR("ST#",IEN))'="OTHER" S MORE=1
114 S IEN=0
115 F S IEN=$O(^TMP("MPIFVQQ",$J,INDEX,"TF",IEN)) Q:IEN=""!(COMMON) D
116 .S ST=$P(^TMP("MPIFVQQ",$J,INDEX,"TF",IEN),"^")
117 .Q:ST=200
118 .I $D(ARR("ST#",ST)) I $P($G(ARR("ST#",ST)),"^")'="OTHER" S COMMON=1
119 Q
120MIMDQ(ICN,ICN2,DFN,MSG) ; while reviewing potential duplicates, site picked to link 2 patients together with TFs in common
121 ; send exception to IMDQ team
122 D START^RGHLLOG()
123 D EXC^RGHLLOG(208,MSG,DFN)
124 D STOP^RGHLLOG()
125 W !,"Unable to match these ICNs together as"_$P(MSG,"-",2)
126 W !,"Exception has been sent to IMDQ team for assistance in resolving this",!,"MPI Duplicate. Local Exception has been automatically marked as processed."
127 Q
128 Q
Note: See TracBrowser for help on using the repository browser.