source: FOIAVistA/trunk/r/MASTER_PATIENT_INDEX_VISTA-MPIF/MPIFAPI.m@ 979

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

initial load of FOIAVistA 6/30/08 version

File size: 7.5 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**;30 Apr 99;Build 6
3 ; Integration Agreements Utilized:
4 ; ^DPT( - #2070 and #4079
5 ; ^DPT("AICN", ^DPT("AMPIMIS", ^DPT("ASCN2" - #2070
6 ; EXC, START, STOP^RGHLLOG - #2796
7 ;
8EN2() ;NEW ENTRY POINT FOR LOCALS
9 N MPIOUT,DIC,MPICHK,MPINCK,MPINNM,MPINUM1,DA,MPINUM
10 I $O(^MPIF(984.1,0))="" G SETUP
11AGN2 L +^MPIF(984.1):1 E H 3 G AGN2
12 S MPINUM=0,X=$$SITE^VASITE,X=$P(X,"^",3),X=X\1
13 S DIC="^MPIF(984.1,",DIC(0)="XZ" D ^DIC
14 S MPINUM1=$P(Y(0),"^",4),MPICHK=$P(Y(0),"^",5),MPINNM=MPINUM1+1
15 S MPINUM=MPINUM1_"V"_MPICHK,MPINCK=$$CHECKDG^MPIFSPC(MPINNM)
16 S DA=1,DIE="^MPIF(984.1,",DR="1////^S X=MPINUM1;2////^S X=MPICHK;3////^S X=MPINNM;5////"_MPINCK
17 D ^DIE
18 K DIE,DR,X,Y
19 L -^MPIF(984.1)
20 Q MPINUM
21SETUP ;
22 N CHK,NUM,NXTCHK,NXTNUM,SITE,DA
23 S SITE=$$SITE^VASITE,SITE=$P(SITE,"^",3),SITE=SITE\1
24 S DIC="^MPIF(984.1,",DA=1,DIC(0)="",X=SITE
25 S NUM=SITE_"0000000",CHK=$$CHECKDG^MPIFSPC(NUM),MPINUM=NUM_"V"_CHK
26 S NXTNUM=NUM+1,NXTCHK=$$CHECKDG^MPIFSPC(NXTNUM)
27 S DIC("DR")="1////^S X=NUM;2////^S X=CHK;3////^S X=NXTNUM;5////"_NXTCHK
28 K DD,D0
29 D FILE^DICN
30 K DIC,X,Y
31 Q MPINUM
32 ;
33MPILINK() ;returns MPI logical Link
34 N MPIL,MPILINK
35 D LINK^HLUTIL3("MPI",.MPIL)
36 I '$D(MPIL) Q "-1^NOT DEFINED"
37 S MPILINK=$O(MPIL(0))
38 I MPILINK="" Q "-1^NOT DEFINED"
39 S MPILINK=$G(MPIL(MPILINK))
40 Q MPILINK
41 ;
42SUBNUM(DFN) ; returns SCN from MPI node for given DFN
43 ; DFN - ien of patient file
44 ; returns: -1^error message << always returns.
45 ;*** Subscription control numbers no longer exist
46 Q "-1^No Subscription Control Number for DFN "_DFN
47 ;
48MPINODE(DFN) ; returns MPI node for given DFN
49 ; DFN - patient file ien
50 ; returns: -1^error message or MPI node from patient file
51 N TMP
52 I '$D(DFN) Q "-1^DFN not defined"
53 I '$D(^DPT(DFN)) Q "-1^DFN doesn't exist"
54 I '$D(^DPT(DFN,"MPI")) Q "-1^No MPI node for DFN "_DFN
55 L +^DPT("MPI",DFN):10 ;**45 added lock check for getting ICN data back
56 N NODE S NODE=$G(^DPT(DFN,"MPI"))
57 I NODE=""!(NODE?."^") S NODE="-1^No MPI data for DFN "_DFN
58 I +NODE>0 D
59 .;**45 checking if checksum for ICN is correct, if not update the 991.02 field
60 .; and include new value in NODE returned.
61 .N CHK S CHK=$$CHECKDG^MPIFSPC($P(NODE,"^"))
62 .I CHK'=$P(NODE,"^",2) S TMP=$$SETICN^MPIF001(DFN,$P(NODE,"^"),CHK) S $P(NODE,"^",2)=CHK
63 L -^DPT("MPI",DFN)
64 Q NODE
65 ;
66GETADFN(ICN) ; return DFN ONLY if ICN is the active ICN
67 ; ICN - Integration Control Number for patient to be returned
68 ; returns: -1^error message
69 ; DFN - IEN for the patient entry in the Patient file (#2)
70 N RETURN,DFN
71 I $G(ICN)'>0 Q "-1^NO ICN"
72 I '$D(^DPT("AICN",ICN)) Q "-1^ICN NOT IN DATABASE"
73 S DFN=$O(^DPT("AICN",ICN,0))
74 I $G(DFN)'>0 Q "-1^BAD AICN CROSS-REFERENCE"
75 I $P($G(^DPT(DFN,"MPI")),"^")'=ICN Q "-1^ICN is not Active one"
76 Q DFN
77 ;
78UPDATE(DFN,ARR,MPISILNT,REMOVE) ;api to edit 'mpi','mpifhis' and 'mpicmor' nodes
79 ;**37 UPDATE module moved 3/30/05 from MPIFAPI into MPIFAPI1.
80 ;Linetag must remain due to DBIA #2706.
81 Q $$UPDATE^MPIFAPI1(DFN,ARR,.MPISILNT,.REMOVE)
82 ;
83MPIQ(DFN) ;MPI QUERY
84 N MPIFARR
85 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
86 I '$D(MPIFS) D ;Not from SmartCard background job
87 .;**37 mods to L -^DPT
88 .I $G(DGNEW)=1 D ;New patient, fields always blank, ask
89 ..D WRTLN
90 ..; **44 Adding Pseudo SSN Reason to the list of prompted fields if SSN is a pseudo and there isn't already a reason stored
91 ..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
92 ..I $D(MPIFARR(2,DFN,.0906,"I")) D
93 ...I MPIFARR(2,DFN,.09,"E")["P",("S"[MPIFARR(2,DFN,.0906,"I")) S MPIFP=".0906;"
94 ..S DIE="^DPT(",DA=DFN,DIE("NO^")="BACK"
95 ..S DR=MPIFP_".2403;.092;.093;1",DR(2,2.01)=".01" D ^DIE K DA,DIE,DR Q
96 .I $G(DGNEW)="" D ;Existing patient, get current values
97 ..N MPIDOB,IMPRS,MPIMMN,MPICTY,MPIST
98 ..S DIC=2,DR=".02;.03;.09;.0906;.092;.093;.2403;994;1",DR(2.01)=".01" ;**44 include pseudo ssn reason to list
99 ..S DA=DFN,DA(2.01)=1,DIQ(0)="EI",DIQ="MPIFARR"
100 ..D EN^DIQ1 K DA,DIC,DIQ,DR
101 ..;build DR from blank fields / imprecise DOB / pseudo SSN
102 ..S DR=""
103 ..S MPIDOB=$G(MPIFARR(2,DFN,.03,"I")) ;DATE OF BIRTH
104 ..I MPIDOB="" S DR=DR_".03;" ;DOB null
105 ..;Is DOB imprecise?
106 ..I MPIDOB'="" S IMPRS=0 D
107 ...I $E(MPIDOB,4,7)="0000" S IMPRS=1 ;Year only; no month/day
108 ...I ($E(MPIDOB,6,7)="00")&($E(MPIDOB,4,5)'="00") S IMPRS=1 ;Year/month only; no day
109 ...I IMPRS=1 S DR=DR_".03;" ;DOB imprecise
110 ..I $G(MPIFARR(2,DFN,.02,"I"))="" S DR=DR_".02;" ;SEX
111 ..;if the SSN is null, add to prompted fields
112 ..N SSNP S SSNP=0
113 ..I ($G(MPIFARR(2,DFN,.09,"E"))="") S DR=DR_".09;",SSNP=1 ;SSN
114 ..I DR'="" D
115 ...D WRTLN
116 ...S DIE="^DPT(",DA=DFN,DIE("NO^")="BACK"
117 ...D ^DIE K DA,DIE,DR,DIC,DIQ
118 ...;if SSN was prompted then reinitialize SSN ARRAY variable
119 ...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
120 ...;**44 if the PSEUDO SSN REASON field exist
121 ..S DR="" ;reset DR to null to be able to concatenate the fields together since DR was just killed above
122 ..I $D(MPIFARR(2,DFN,.0906,"I")) D
123 ...;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
124 ...I MPIFARR(2,DFN,.09,"E")["P",(MPIFARR(2,DFN,.0906,"I")="") S DR=DR_".0906;" ;**48 correct when SSN is prompted
125 ...I MPIFARR(2,DFN,.09,"E")["P",(MPIFARR(2,DFN,.0906,"I")="S") S DR=DR_".09;" ;**48 correct when SSN is prompted
126 ..I $G(MPIFARR(2,DFN,994,"I"))="" S DR=DR_"994;" ;MULTIPLE BIRTH INDICATOR
127 ..S MPIMMN=$G(MPIFARR(2,DFN,.2403,"E")) ;MOTHER'S MAIDEN NAME
128 ..I $$VALDT(MPIMMN) S DR=DR_".2403;" ;Validate MMN value
129 ..S MPICTY=$G(MPIFARR(2,DFN,.092,"E")) ;PLACE OF BIRTH [CITY]
130 ..S MPIST=$G(MPIFARR(2,DFN,.093,"E")) ;PLACE OF BIRTH [STATE]
131 ..I $S($$VALDT(MPICTY):1,$$VALDT(MPIST):1,1:0) S DR=DR_".092;.093;" ;Validate POB [CITY] & [STATE] value
132 ..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
133 ..I DR'="" D
134 ...D WRTLN
135 ...S DIE="^DPT(",DA=DFN,DIE("NO^")="BACK"
136 ...D ^DIE K DA,DIE,DR,DIC,DIQ
137 L -^DPT(DFN)
138 I $D(ZTQUEUED) S ZTREQ="@"
139 K MPIFRTN D VTQ^MPIFQ0
140 ;**43 No longer get list of potential matches to pick from
141 ;I $G(MPIFRTN)="" D
142 ;. ^ Quit at LM screen when presented with a list of possible matches
143 ;. \/ setup Local ICN and proceed
144 ;.N ICN,ERR
145 ;.S ICN=$$EN2^MPIFAPI()
146 ;.Q:ICN=""!(+ICN=-1)
147 ;.S ERR=$$SETICN^MPIF001(DFN,+ICN,$P(ICN,"V",2))
148 ;.Q:+ERR=-1
149 ;. ^ couldn't set ICN don't set other fields
150 ;.S ERR=$$SETLOC^MPIF001(DFN,1),ERR=$$CHANGE^MPIF001(DFN,$P($$SITE^VASITE,"^"))
151 K MPIFRTN,ZTREQ
152 Q
153 ;
154MPIQQ(PDFN) ; Entry point for queuing d/c
155 ; Returned is -1^error message OR Task #
156 Q:'$D(PDFN) "-1^No DFN passed"
157 S ZTRTN="MPIQ^MPIFAPI(PDFN)"
158 I $D(DUZ) S ZTSAVE("DUZ")=DUZ
159 S ZTSAVE("PDFN")=PDFN,ZTSAVE("MPIFS")=1
160 ; ^ silent flag
161 S ZTIO="",ZTDTH=$$FMADD^XLFDT($$NOW^XLFDT,0,0,1,0)
162 D ^%ZTLOAD
163 D HOME^%ZIS K IO("Q")
164 N TSK S TSK=ZTSK
165 K ZTSAVE,ZTRTN,ZTIO,ZTDTH,ZTSK
166 Q TSK
167 ;
168WRTLN ;**37 Write intro text ONLY if there are fields to ask
169 W !!,"Please verify or update the following information:",!
170 Q
171 ;
172VALDT(VAL) ;**37 Validate value passed in.
173 ;Prompt if field contains invalid data (e.g., UNKNOWN, NOT KNOWN, etc.)
174 ;Returns 0 if not found
175 ;Returns 1 if found
176 I VAL="" Q 1
177 I $E($$UP^XLFSTR(VAL),1,3)="UNK" Q 1
178 I $E($$UP^XLFSTR(VAL),1,4)="NONE" Q 1
179 I $E($$UP^XLFSTR(VAL),1,4)="NOT " Q 1
180 I $$UP^XLFSTR(VAL)["UNAVAILABLE" Q 1
181 I $$UP^XLFSTR(VAL)["DECEASED" Q 1
182 I $E($$UP^XLFSTR(VAL),1,2)="DC" Q 1
183 Q 0
184 ;
Note: See TracBrowser for help on using the repository browser.