source: WorldVistAEHR/trunk/r/MASTER_PATIENT_INDEX_VISTA-MPIF/MPIF001.m@ 846

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

initial load of WorldVistAEHR
File size: 8.6 KB
Line 
1MPIF001 ;ALB/RJS/CMC-UTILITY ROUTINE OF APIS ;JUL 12, 1996
2 ;;1.0; MASTER PATIENT INDEX VISTA ;**1,3,9,16,18,21,27,33,35,41,45,48**;30 Apr 99;Build 6
3 ;
4 ; Integration Agreements Utilized:
5 ; ^DPT( - #2070
6 ; ^DPT("AICN" - #2070
7 ; ^DPT("AMPIMIS" - #2070
8 ; EXC^RGHLLOG - #2796
9 ; START^RGHLLOG - #2796
10 ; STOP^RGHLLOG - #2796
11 ;
12GETICN(DFN) ; This function returns the ICN, including checksum for a given
13 ; DFN or -1^error message
14 ; INPUT: DFN - ien in Patient file
15 ;
16 N RETURN,NODE
17 I $G(DFN)'>0 S RETURN="-1^NO DFN" G EXIT1
18 I '$D(^DPT(DFN,0)) S RETURN="-1^PATIENT NOT IN DATABASE" G EXIT1
19 I '$D(^DPT(DFN,"MPI")) S RETURN="-1^NO MPI NODE" G EXIT1
20 S NODE=$G(^DPT(DFN,"MPI"))
21 I $P(NODE,"^",1)'>0 S RETURN="-1^NO ICN" G EXIT1
22 S RETURN=$P(NODE,"^",1)_"V"_$$CHECKDG^MPIFSPC($P(NODE,"^",1)) ;**48
23 I '$D(^DPT("AICN",$P(NODE,"^"),DFN)) S ^DPT("AICN",$P(NODE,"^"),DFN)=""
24 ; ^ set AICN x-ref if missing one
25EXIT1 ;
26 Q RETURN
27 ;
28GETDFN(ICN) ; Returns DFN (ien Patient file) or -1^error message for a given ICN
29 ; ICN - ICN for a given Patient in the Patient file
30 N RETURN,DFN
31 I $G(ICN)'>0 S RETURN="-1^NO ICN" G EXIT2
32 I ICN["V" S ICN=+ICN
33 I '$D(^DPT("AICN",ICN)) S RETURN="-1^ICN NOT IN DATABASE" G EXIT2
34 S DFN=$O(^DPT("AICN",ICN,0))
35 I $G(DFN)'>0 S RETURN="-1^BAD ICN CROSS-REFERENCE" G EXIT2
36 I '$D(^DPT(DFN)) K ^DPT("AICN",ICN) S RETURN="-1^ICN NOT IN DATABASE" G EXIT2
37 ;^ **41 - CHECK IF THE DFN HOLDING THIS ICN IS RELATED TO BOGUS XREF
38 S RETURN=DFN
39EXIT2 ;
40 Q RETURN
41 ;
42ICNLC(DFN) ;This API will return an ICN if one exists or create and return
43 ; a Local ICN and update the appropriate fields if a Local was created
44 ; DFN= Patient IEN
45 ; Returns ICN (local or National including checksum) or -1^error msg
46 N ICN,TMP,CHKSUM,ICNX
47 I $G(DFN)'>0 Q "-1^No DFN Passed"
48 D LOCK
49 S ICN=$$GETICN(DFN)
50 I +ICN=-1 D
51 .;no icn create a Local ICN
52 .S ICN=$$EN2^MPIFAPI()
53 .S CHKSUM=$P(ICN,"V",2),ICNX=$P(ICN,"V")
54 .S NOLOCK=""
55 .I ICNX="" K NOLOCK S ICN="-1^PROBLEM CREATING LOCAL ICN" Q
56 .S TMP=$$SETICN(DFN,ICNX,CHKSUM)
57 .I +TMP=-1 K NOLOCK Q
58 .S TMP=$$SETLOC(DFN,1)
59 .S TMP=$$CHANGE(DFN,$P($$SITE^VASITE(),"^"))
60 .K NOLOCK
61 D UNLOCK
62 Q ICN
63 ;
64CMOR2(DFN) ; Returns CMOR Site Name or -1^error message
65 ; DFN = Patient IEN
66 I $G(DFN)'>0 Q "-1^No DFN Passed"
67 N NODE
68 S NODE=$$MPINODE^MPIFAPI(DFN)
69 Q:$P(NODE,"^",3)="" "-1^No CMOR"
70 Q $$CMORNAME($P(NODE,"^",3))
71 ;
72CMORNAME(CIEN) ; Returns CMOR site name or -1^error message
73 ; CIEN - ien from Institution file
74 ;
75 Q:CIEN="" "-1^No Institution parameter"
76 N INST
77 S INST=$$NNT^XUAF4(CIEN)
78 Q:INST="" "-1^No Institution for that IEN"
79 Q:$P(INST,"^")="" "-1^No Name for this Institution"
80 Q $P(INST,"^")
81 ;
82GETVCCI(DFN) ; Returns CMOR or -1^error message for a given patient
83 ; DFN - ien of patient in Patient file
84 N RETURN,NODE,PTR,STANUM
85 I $G(DFN)'>0 S RETURN="-1^NO DFN" G EXIT3
86 I '$D(^DPT(DFN,0)) S RETURN="-1^PATIENT NOT IN DATABASE" G EXIT3
87 I '$D(^DPT(DFN,"MPI")) S RETURN="-1^NO MPI NODE" G EXIT3
88 S NODE=$$MPINODE^MPIFAPI(DFN)
89 S PTR=$P(NODE,"^",3)
90 I PTR'>0 S RETURN="-1^NO CMOR DEFINED FOR PT" G EXIT3
91 S STANUM=$P($$NNT^XUAF4(PTR),"^",2)
92 I STANUM'>0 S RETURN="-1^PTS CMOR IS DANGLING PTR" G EXIT3
93 S RETURN=STANUM
94EXIT3 ;
95 Q RETURN
96 ;
97CHANGE(DFN,VCCI) ;
98 ; ** This function is only to be used by approved packages **
99 ;
100 ; This function updates the CMOR field in the Patient file
101 ; DFN = ien in Patient file
102 ; VCCI = CMOR ien from the institution file
103 ; returned: -1^error message - problem
104 ; 1 - successful
105 ; Exception will be generated if Update to File Fails only
106 N RETURN,DIQUIET,DIE,DA,DR,Y,X,DIC
107 S (RETURN,DIQUIET)=1
108 I $G(DFN)'>0 S RETURN="-1^NO DFN PASSED" G EXIT4
109 I '$D(^DPT(DFN,0)) S RETURN="-1^PATIENT NOT IN DATABASE" G EXIT4
110 I $G(VCCI)="" S RETURN="-1^NO CMOR PASSED" G EXIT4
111 N CNT,TIEN S DIQUIET=1,CNT=0
112 I '$D(NOLOCK) D LOCK
113 ; moved to here to fix problem with timing
114 I $E($$GETICN(DFN),1,3)=$P($$SITE^VASITE(),"^",3) S VCCI=$P($$SITE^VASITE(),"^")
115 ; ^ to be sure site is self for a local icn
116 S VCCI="`"_VCCI
117 ; ^ Have ien stuff added to use ien instead of station number
118REP S DIE="^DPT(",DA=DFN,DR="991.03///^S X=VCCI"
119 D ^DIE
120 S CNT=CNT+1
121 S TIEN=$P($$MPINODE^MPIFAPI(DFN),"^",3)
122 I "`"_TIEN'=VCCI&(CNT<4) G REP
123 I "`"_TIEN'=VCCI&(CNT>3) D
124 .S RETURN="-1^Couldn't Update CMOR"
125 .D START^RGHLLOG(0)
126 .D EXC^RGHLLOG(221,"Unable to update CMOR to "_$$STA^XUAF4(TIEN)_" for patient DFN= "_DFN,DFN)
127 .D STOP^RGHLLOG(0)
128 I '$D(NOLOCK) D UNLOCK
129EXIT4 ;
130 Q RETURN
131 ;
132SETICN(DFN,ICN,CHKSUM) ;
133 ; ** this function is to only be used by approved packages **
134 ;
135 ; This function updates the ICN and ICN Checksum fields in the Patient
136 ; file for a given patient.
137 ; DFN - ien in the Patient file to be updated
138 ; ICN - ICN (without checksum) to be updated
139 ; CHKSUM - ICN checksum
140 ; return: -1^error message - problem
141 ; 1 - successful
142 N RETURN,DIQUIET,DIE,DA,DR,RGRSICN,Y,ERR
143 S (RETURN,DIQUIET,RGRSICN)=1
144 I $G(DFN)'>0 S RETURN="-1^NO DFN PASSED" G EXIT5
145 I '$D(^DPT(DFN,0)) S RETURN="-1^PATIENT NOT IN DATABASE" G EXIT5
146 I $G(ICN)="" S RETURN="-1^NO ICN PASSED" G EXIT5
147 I $G(CHKSUM)="" S RETURN="-1^NO CHKSUM PASSED" G EXIT5
148 I +$$GETICN(DFN)>0 I $E(ICN,1,3)=$P($$SITE^VASITE(),"^",3),$E($$GETICN(DFN),1,3)'=$E(ICN,1,3) S RETURN="-1^Don't overwrite national with local" G EXIT5
149 ; ^ stop local from overwriting a national ICN
150 I +$$GETICN(DFN)>0 I $E(ICN,1,3)=$P($$SITE^VASITE(),"^",3),$E($$GETICN(DFN),1,3)=$P($$SITE^VASITE(),"^",3) S RETURN="-1^Don't overwrite local ICN with another Local ICN" G EXIT5
151 ; ^ STOP LOCAL FROM OVERWRITING ANOTHER LOCAL ICN
152 I $D(^DPT("AICN",ICN)) D
153 .Q:DFN=$O(^DPT("AICN",ICN,""))
154 .I DFN'=($O(^DPT("AICN",ICN,""))) D
155 ..N DFN2 S DFN2=$O(^DPT("AICN",ICN,""))
156 ..I '$D(TWODFN) D TWODFNS^MPIF002(DFN2,DFN,ICN)
157 .S RETURN="-1^ICN ALREADY IN USE"
158 G:+RETURN=-1 EXIT5
159 I '$D(NOLOCK) D LOCK
160 S DIQUIET=1
161 S CHKSUM=$$CHECKDG^MPIFSPC(ICN) ;**45 calculate checksum based upon what's passed for ICN and use that to update 991.02
162 S DIE="^DPT(",DA=DFN,DR="991.01///^S X=ICN;991.02///^S X=CHKSUM"
163 D ^DIE
164 I +$G(Y)=-1 S RETURN="-1^UNSUCCESSFUL DIE CALL"
165 I +RETURN>0 D
166 .K ^DPT("AMPIMIS",DFN)
167 .I $E(ICN,1,3)=$P($$SITE^VASITE(),"^",3) S ERR=$$SETLOC(DFN,1)
168 .I $E(ICN,1,3)'=$P($$SITE^VASITE(),"^",3) S ERR=$$SETLOC(DFN,0)
169 I '$D(NOLOCK) D UNLOCK
170EXIT5 ;
171 Q RETURN
172 ;
173SETLOC(DFN,DELFLAG) ;
174 ; ** This function should be only used by approved packages **
175 ;
176 ; This function updates the LOCALLY ASSIGNED ICN field in the Patient
177 ; for the given patient
178 ;DFN - ien from Patient file of patient to be updated
179 ;DELFLAG - 1 is to turn the flag on
180 ; - 0 is to turn off the flag
181 ;
182 N RETURN,DIQUIET,DIE,DA,DR,VALUE,Y
183 S (RETURN,DIQUIET)=1
184 I $G(DFN)'>0 S RETURN="-1^NO DFN PASSED" G EXIT6
185 I '$D(^DPT(DFN,0)) S RETURN="-1^PATIENT NOT IN DATABASE" G EXIT6
186 I '$D(NOLOCK) D LOCK
187 S DIQUIET=1,VALUE=$S($G(DELFLAG)=0:"@",1:1)
188 S DIE="^DPT(",DA=DFN,DR="991.04///^S X=VALUE"
189 D ^DIE
190 I +$G(Y)=-1 S RETURN="-1^UNSUCCESSFUL DIE CALL"
191 I +RETURN>0 K ^DPT("AMPIMIS",DFN)
192 I '$D(NOLOCK) D UNLOCK
193EXIT6 ;
194 Q RETURN
195 ;
196IFLOCAL(DFN) ; This function is used to see if a patient has a local ICN
197 ; DFN - ien of patient in Patient file
198 ; returned: 0 = patient does not exist, dfn is not defined or no MPI node OR Patient does not have a local ICN
199 ; 1 = patient has a Local ICN assigned
200 Q:$G(DFN)="" 0
201 Q:$G(^DPT(DFN,0))="" 0
202 Q:'$D(^DPT(DFN,"MPI")) 0
203 Q:$E($$GETICN(DFN),1,3)=$P($$SITE^VASITE,"^",3) 1
204 Q 0
205 ;
206IFVCCI(DFN) ; this function returns 1 if your facility is the CMOR for the given pt
207 ; DFN - ien of patient in Patient file
208 ; returns: 1 = your site in the CMOR for this patient
209 ; -1 = your site is not the CMOR for this patient
210 ; 0^ERROR MSG
211 N VCCI,SITE
212 I $G(DFN)'>0 Q "0^No DFN Passed"
213 S VCCI=$P($$GETVCCI(DFN),"^",1)
214 S SITE=$P($$SITE^VASITE,"^",3)\1
215 I $P(VCCI,"^",1)=-1 Q -1
216 I VCCI'=SITE Q -1
217 Q 1
218 ;
219HL7CMOR(DFN,SEP) ; This function returns the CMOR station number and institution name for
220 ; the given patient.
221 ; DFN = ien for patient in Patient file
222 ; SEP = delimiter to separate station number and name
223 ; returned: Station Number <sep> Institution name
224 ; -1^error message
225 N RETURN,NODE,PTR,STAT
226 I $G(DFN)'>0 S RETURN="-1^NO DFN" G EXIT7
227 I $G(SEP)="" S RETURN="-1^NO FIELD SEPERATOR" G EXIT7
228 I '$D(^DPT(DFN,0)) S RETURN="-1^PATIENT NOT IN DATABASE" G EXIT7
229 I $$MPINODE^MPIFAPI(DFN)<1 S RETURN="-1^NO MPI NODE" G EXIT7
230 S NODE=$$MPINODE^MPIFAPI(DFN)
231 S PTR=$P(NODE,"^",3)
232 I PTR'>0 S RETURN="-1^NO CMOR DEFINED FOR PT" G EXIT7
233 S STAT=$$NNT^XUAF4(PTR)
234 I STAT="" S RETURN="-1^PTS CMOR IS DANGLING PTR" G EXIT7
235 I $P(STAT,"^")="" S RETURN="-1^NO INSTITUTION NAME" G EXIT7
236 S RETURN=$P(STAT,"^",2)_SEP_$P(STAT,"^")
237EXIT7 ;
238 Q RETURN
239 ;
240LOCK ;
241 F L +^DPT(DFN,"MPI"):10 Q:$T
242 Q
243 ;
244UNLOCK ;
245 L -^DPT(DFN,"MPI")
246 Q
Note: See TracBrowser for help on using the repository browser.