source: WorldVistAEHR/trunk/r/MASTER_PATIENT_INDEX_VISTA-MPIF/MPIFAPI.m@ 701

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

initial load of WorldVistAEHR

File size: 9.0 KB
Line 
1MPIFAPI ;CMC/BP-APIS FOR MPI ;DEC 21, 1998
2 ;;1.0; MASTER PATIENT INDEX VISTA ;**1,3,14,16,17,21,27,28,33,35,37,43,45,44,46,48,40**;30 Apr 99;Build 13
3 ; Modified from FOIA VISTA,
4 ; Copyright (C) 2007 WorldVistA
5 ;
6 ; This program is free software; you can redistribute it and/or modify
7 ; it under the terms of the GNU General Public License as published by
8 ; the Free Software Foundation; either version 2 of the License, or
9 ; (at your option) any later version.
10 ;
11 ; This program is distributed in the hope that it will be useful,
12 ; but WITHOUT ANY WARRANTY; without even the implied warranty of
13 ; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
14 ; GNU General Public License for more details.
15 ;
16 ; You should have received a copy of the GNU General Public License
17 ; along with this program; if not, write to the Free Software
18 ; Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301 USA
19 ;
20 ; 2/5/2005 DAOU/WCJ: VOE patch created
21 ; 4/22/2005 ALB/PTD: MPIF*1*37
22 ; 9/14/2005 VA/CJS: VOE patch reworked as MPIF*1*40 T1
23 ; 4/3/2006 WV/TOAD: VOE patch reapplied after YS*5.01*37
24 ;
25 ; Integration Agreements Utilized:
26 ; ^DPT( - #2070 and #4079
27 ; ^DPT("AICN", ^DPT("AMPIMIS", ^DPT("ASCN2" - #2070
28 ; EXC, START, STOP^RGHLLOG - #2796
29 ;
30EN2() ;NEW ENTRY POINT FOR LOCALS
31 N MPIOUT,DIC,MPICHK,MPINCK,MPINNM,MPINUM1,DA,MPINUM
32 I $O(^MPIF(984.1,0))="" G SETUP
33AGN2 L +^MPIF(984.1):1 E H 3 G AGN2
34 S MPINUM=0,X=$$SITE^VASITE,X=$P(X,"^",3),X=X\1
35 S DIC="^MPIF(984.1,",DIC(0)="XZ" D ^DIC
36 S MPINUM1=$P(Y(0),"^",4),MPICHK=$P(Y(0),"^",5),MPINNM=MPINUM1+1
37 S MPINUM=MPINUM1_"V"_MPICHK,MPINCK=$$CHECKDG^MPIFSPC(MPINNM)
38 S DA=1,DIE="^MPIF(984.1,",DR="1////^S X=MPINUM1;2////^S X=MPICHK;3////^S X=MPINNM;5////"_MPINCK
39 D ^DIE
40 K DIE,DR,X,Y
41 L -^MPIF(984.1)
42 Q MPINUM
43SETUP ;
44 N CHK,NUM,NXTCHK,NXTNUM,SITE,DA
45 S SITE=$$SITE^VASITE,SITE=$P(SITE,"^",3),SITE=SITE\1
46 S DIC="^MPIF(984.1,",DA=1,DIC(0)="",X=SITE
47 S NUM=SITE_"0000000",CHK=$$CHECKDG^MPIFSPC(NUM),MPINUM=NUM_"V"_CHK
48 S NXTNUM=NUM+1,NXTCHK=$$CHECKDG^MPIFSPC(NXTNUM)
49 S DIC("DR")="1////^S X=NUM;2////^S X=CHK;3////^S X=NXTNUM;5////"_NXTCHK
50 K DD,D0
51 D FILE^DICN
52 K DIC,X,Y
53 Q MPINUM
54 ;
55MPILINK() ;returns MPI logical Link
56 N MPIL,MPILINK
57 D LINK^HLUTIL3("MPI",.MPIL)
58 I '$D(MPIL) Q "-1^NOT DEFINED"
59 S MPILINK=$O(MPIL(0))
60 I MPILINK="" Q "-1^NOT DEFINED"
61 S MPILINK=$G(MPIL(MPILINK))
62 Q MPILINK
63 ;
64SUBNUM(DFN) ; returns SCN from MPI node for given DFN
65 ; DFN - ien of patient file
66 ; returns: -1^error message << always returns.
67 ;*** Subscription control numbers no longer exist
68 Q "-1^No Subscription Control Number for DFN "_DFN
69 ;
70MPINODE(DFN) ; returns MPI node for given DFN
71 ; DFN - patient file ien
72 ; returns: -1^error message or MPI node from patient file
73 N TMP
74 I '$D(DFN) Q "-1^DFN not defined"
75 I '$D(^DPT(DFN)) Q "-1^DFN doesn't exist"
76 I '$D(^DPT(DFN,"MPI")) Q "-1^No MPI node for DFN "_DFN
77 L +^DPT("MPI",DFN):10 ;**45 added lock check for getting ICN data back
78 N NODE S NODE=$G(^DPT(DFN,"MPI"))
79 I NODE=""!(NODE?."^") S NODE="-1^No MPI data for DFN "_DFN
80 I +NODE>0 D
81 .;**45 checking if checksum for ICN is correct, if not update the 991.02 field
82 .; and include new value in NODE returned.
83 .N CHK S CHK=$$CHECKDG^MPIFSPC($P(NODE,"^"))
84 .I CHK'=$P(NODE,"^",2) S TMP=$$SETICN^MPIF001(DFN,$P(NODE,"^"),CHK) S $P(NODE,"^",2)=CHK
85 L -^DPT("MPI",DFN)
86 Q NODE
87 ;
88GETADFN(ICN) ; return DFN ONLY if ICN is the active ICN
89 ; ICN - Integration Control Number for patient to be returned
90 ; returns: -1^error message
91 ; DFN - IEN for the patient entry in the Patient file (#2)
92 N RETURN,DFN
93 I $G(ICN)'>0 Q "-1^NO ICN"
94 I '$D(^DPT("AICN",ICN)) Q "-1^ICN NOT IN DATABASE"
95 S DFN=$O(^DPT("AICN",ICN,0))
96 I $G(DFN)'>0 Q "-1^BAD AICN CROSS-REFERENCE"
97 I $P($G(^DPT(DFN,"MPI")),"^")'=ICN Q "-1^ICN is not Active one"
98 Q DFN
99 ;
100UPDATE(DFN,ARR,MPISILNT,REMOVE) ;api to edit 'mpi','mpifhis' and 'mpicmor' nodes
101 ;**37 UPDATE module moved 3/30/05 from MPIFAPI into MPIFAPI1.
102 ;Linetag must remain due to DBIA #2706.
103 Q $$UPDATE^MPIFAPI1(DFN,ARR,.MPISILNT,.REMOVE)
104 ;
105MPIQ(DFN) ;MPI QUERY
106 N MPIFARR
107 L +^DPT(DFN):2 I '$T,'$D(MPIFS) W $C(7),!!,"Patient is being edited. No attempt will be made to connect to the MPI." H 2 Q
108 I '$D(MPIFS) D ;Not from SmartCard background job
109 .;**37 mods to L -^DPT
110 .I $G(DGNEW)=1 D ;New patient, fields always blank, ask
111 ..D WRTLN
112 ..; **44 Adding Pseudo SSN Reason to the list of prompted fields if SSN is a pseudo and there isn't already a reason stored
113 ..N MPIFP S MPIFP="" S DA=DFN,DIQ(0)="EI",DIC=2,DR=".09;.0906",DIQ="MPIFARR" D EN^DIQ1 K DA,DR,DIC,DQ,DR
114 ..I $D(MPIFARR(2,DFN,.0906,"I")) D
115 ...I MPIFARR(2,DFN,.09,"E")["P",("S"[MPIFARR(2,DFN,.0906,"I")) S MPIFP=".0906;"
116 ..S DIE="^DPT(",DA=DFN,DIE("NO^")="BACK"
117 ..; start of VOE change part 1 of 2
118 ..; if agency is EHR or IHS, ask Health Record Number before other fields
119 ..;
120 ..; before change
121 ..;S DR=MPIFP_".2403;.092;.093;1",DR(2,2.01)=".01" D ^DIE K DA,DIE,DR Q
122 ..;
123 ..; after change
124 ..S DR=MPIFP_".2403;.092;.093;1"
125 ..I "EI"[$G(DUZ("AG")) S DR="D HRN^MPIFAG1;"_DR
126 ..S DR(2,2.01)=".01"
127 ..D ^DIE
128 ..K DA,DIE,DR
129 ..;
130 ..; end of VOE change 1 of 2
131 ..;
132 .I $G(DGNEW)="" D ;Existing patient, get current values
133 ..N MPIDOB,IMPRS,MPIMMN,MPICTY,MPIST
134 ..S DIC=2,DR=".02;.03;.09;.0906;.092;.093;.2403;994;1",DR(2.01)=".01" ;**44 include pseudo ssn reason to list
135 ..S DA=DFN,DA(2.01)=1,DIQ(0)="EI",DIQ="MPIFARR"
136 ..D EN^DIQ1 K DA,DIC,DIQ,DR
137 ..;build DR from blank fields / imprecise DOB / pseudo SSN
138 ..S DR=""
139 ..S MPIDOB=$G(MPIFARR(2,DFN,.03,"I")) ;DATE OF BIRTH
140 ..I MPIDOB="" S DR=DR_".03;" ;DOB null
141 ..;Is DOB imprecise?
142 ..I MPIDOB'="" S IMPRS=0 D
143 ...I $E(MPIDOB,4,7)="0000" S IMPRS=1 ;Year only; no month/day
144 ...I ($E(MPIDOB,6,7)="00")&($E(MPIDOB,4,5)'="00") S IMPRS=1 ;Year/month only; no day
145 ...I IMPRS=1 S DR=DR_".03;" ;DOB imprecise
146 ..I $G(MPIFARR(2,DFN,.02,"I"))="" S DR=DR_".02;" ;SEX
147 ..;if the SSN is null, add to prompted fields
148 ..N SSNP S SSNP=0
149 ..I ($G(MPIFARR(2,DFN,.09,"E"))="") S DR=DR_".09;",SSNP=1 ;SSN
150 ..I DR'="" D
151 ...D WRTLN
152 ...S DIE="^DPT(",DA=DFN,DIE("NO^")="BACK"
153 ...D ^DIE K DA,DIE,DR,DIC,DIQ
154 ...;if SSN was prompted then reinitialize SSN ARRAY variable
155 ...I SSNP=1 S MPIFARR(2,DFN,.09,"E")="" S DIC=2,DR=".09" S DA=DFN,DA(2.01)=1,DIQ(0)="E",DIQ="MPIFARR" D EN^DIQ1 K DA,DIC,DIQ,DR
156 ...;**44 if the PSEUDO SSN REASON field exist
157 ..S DR="" ;reset DR to null to be able to concatenate the fields together since DR was just killed above
158 ..I $D(MPIFARR(2,DFN,.0906,"I")) D
159 ...;check to see if the SSN is a PSEUDO and the PSEUDO SSN REASON is null or "S" (FOLLOW-UP REQUIRED), if so add PSEUDO SSN REASON to the prompted fields
160 ...I MPIFARR(2,DFN,.09,"E")["P",(MPIFARR(2,DFN,.0906,"I")="") S DR=DR_".0906;" ;**48 correct when SSN is prompted
161 ...I MPIFARR(2,DFN,.09,"E")["P",(MPIFARR(2,DFN,.0906,"I")="S") S DR=DR_".09;" ;**48 correct when SSN is prompted
162 ..;
163 ..; start of VOE change part 2 of 2
164 ..; if agency is EHR or IHS, ask Health Record Number after SSN
165 ..;
166 ..I "EI"[$G(DUZ("AG")) S DR=DR_"D HRN^MPIFAG1;"
167 ..;
168 ..; end of VOE change 2 of 2
169 ..;
170 ..I $G(MPIFARR(2,DFN,994,"I"))="" S DR=DR_"994;" ;MULTIPLE BIRTH INDICATOR
171 ..S MPIMMN=$G(MPIFARR(2,DFN,.2403,"E")) ;MOTHER'S MAIDEN NAME
172 ..I $$VALDT(MPIMMN) S DR=DR_".2403;" ;Validate MMN value
173 ..S MPICTY=$G(MPIFARR(2,DFN,.092,"E")) ;PLACE OF BIRTH [CITY]
174 ..S MPIST=$G(MPIFARR(2,DFN,.093,"E")) ;PLACE OF BIRTH [STATE]
175 ..I $S($$VALDT(MPICTY):1,$$VALDT(MPIST):1,1:0) S DR=DR_".092;.093;" ;Validate POB [CITY] & [STATE] value
176 ..I $G(MPIFARR(2.01,1,.01,"E"))="" S DR=DR_"1",DR(2,2.01)=".01;1" ;ALIAS **44 ADDING ALIAS SSN TO FIELDS
177 ..I DR'="" D
178 ...D WRTLN
179 ...S DIE="^DPT(",DA=DFN,DIE("NO^")="BACK"
180 ...D ^DIE K DA,DIE,DR,DIC,DIQ
181 L -^DPT(DFN)
182 I $D(ZTQUEUED) S ZTREQ="@"
183 K MPIFRTN D VTQ^MPIFQ0
184 ;**43 No longer get list of potential matches to pick from
185 ;I $G(MPIFRTN)="" D
186 ;. ^ Quit at LM screen when presented with a list of possible matches
187 ;. \/ setup Local ICN and proceed
188 ;.N ICN,ERR
189 ;.S ICN=$$EN2^MPIFAPI()
190 ;.Q:ICN=""!(+ICN=-1)
191 ;.S ERR=$$SETICN^MPIF001(DFN,+ICN,$P(ICN,"V",2))
192 ;.Q:+ERR=-1
193 ;. ^ couldn't set ICN don't set other fields
194 ;.S ERR=$$SETLOC^MPIF001(DFN,1),ERR=$$CHANGE^MPIF001(DFN,$P($$SITE^VASITE,"^"))
195 K MPIFRTN,ZTREQ
196 Q
197 ;
198MPIQQ(PDFN) ; Entry point for queuing d/c
199 ; Returned is -1^error message OR Task #
200 Q:'$D(PDFN) "-1^No DFN passed"
201 S ZTRTN="MPIQ^MPIFAPI(PDFN)"
202 I $D(DUZ) S ZTSAVE("DUZ")=DUZ
203 S ZTSAVE("PDFN")=PDFN,ZTSAVE("MPIFS")=1
204 ; ^ silent flag
205 S ZTIO="",ZTDTH=$$FMADD^XLFDT($$NOW^XLFDT,0,0,1,0)
206 D ^%ZTLOAD
207 D HOME^%ZIS K IO("Q")
208 N TSK S TSK=ZTSK
209 K ZTSAVE,ZTRTN,ZTIO,ZTDTH,ZTSK
210 Q TSK
211 ;
212WRTLN ;**37 Write intro text ONLY if there are fields to ask
213 W !!,"Please verify or update the following information:",!
214 Q
215 ;
216VALDT(VAL) ;**37 Validate value passed in.
217 ;Prompt if field contains invalid data (e.g., UNKNOWN, NOT KNOWN, etc.)
218 ;Returns 0 if not found
219 ;Returns 1 if found
220 I VAL="" Q 1
221 I $E($$UP^XLFSTR(VAL),1,3)="UNK" Q 1
222 I $E($$UP^XLFSTR(VAL),1,4)="NONE" Q 1
223 I $E($$UP^XLFSTR(VAL),1,4)="NOT " Q 1
224 I $$UP^XLFSTR(VAL)["UNAVAILABLE" Q 1
225 I $$UP^XLFSTR(VAL)["DECEASED" Q 1
226 I $E($$UP^XLFSTR(VAL),1,2)="DC" Q 1
227 Q 0
228 ;
Note: See TracBrowser for help on using the repository browser.