source: FOIAVistA/tag/r/KERNEL-XU-A4A7-USC-XG-XLF-XNOA-XPD-XQ-XVIR-ZI-ZOSF-ZOSV-ZT-ZU-%Z-XIP--XQAB--XUC--XUR--ZIN--ZTED/XUMF416.m@ 719

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

initial load of FOIAVistA 6/30/08 version
File size: 6.6 KB
Line 
1XUMF416 ;ISS/RAM - Load NPI;12/15/05
2 ;;8.0;KERNEL;**416**;Jul 10, 1995;Build 5
3 ;
4 ; $$PARAM^HLCS2 call supported by IA #3552
5 ;
6 Q
7 ;
8BG ; -- background job
9 ;
10 N ZTRTN,ZTDESC,ZTDTH
11 ;
12 S ZTRTN="EN^XUMF416"
13 S ZTDESC="XUMF Load NPI"
14 S ZTDTH=$$NOW^XLFDT
15 S ZTIO=""
16 ;
17 D ^%ZTLOAD
18 ;
19 Q
20 ;
21EN ; -- entry point
22 ;
23 K ^TMP("XUMF ARRAY",$J)
24 ;
25 N PARAM,XUMFLAG,ERROR,TEST
26 ;
27 S (ERROR,XUMFLAG,TEST)=0
28 ;
29 I $P($$PARAM^HLCS2,U,3)="T" S TEST=1
30 ;
31 L +^TMP("XUMF ARRAY",$J):0 D:'$T
32 .S ERROR="1^another process is using the Master File Server"
33 ;
34 I ERROR D EXIT Q
35 ;
36 D MFS0
37 ;
38 I ERROR D EXIT Q
39 ;
40 I '$D(^TMP("XUMF ARRAY",$J)) D
41 .S ERROR="1^Connection to master file server failed!"
42 ;
43 I ERROR D EXIT Q
44 ;
45 D NPI
46 ;
47 D EXIT
48 ;
49 Q
50 ;
51MFS0 ; -- get NPI from Institution Master File
52 ;
53 S PARAM("CDSYS")="NPI"
54 S PARAM("LLNK")="XUMF MFR^XUMF "_$S('TEST:"FORUM",1:"TEST")
55 S PARAM("PROTOCOL")=$O(^ORD(101,"B","XUMF MFQ",0))
56 ;
57 D MAIN^XUMFP(4,"ALL",7,.PARAM,.ERROR) Q:ERROR
58 D MAIN^XUMFI(4,"ALL",7,.PARAM,.ERROR) Q:ERROR
59 D MAIN^XUMFH
60 ;
61 Q
62 ;
63EXIT ; -- cleanup and quit
64 ;
65 I '$$FIND1^DIC(4,,"BX","BONHAM PHARMACY") D EM
66 ;
67 K ^TMP("XUMF ARRAY",$J),^TMP("XUMF MFS",$J),^TMP("DIERR",$J)
68 ;
69 L -^TMP("XUMF ARRAY",$J)
70 ;
71 S ZTREQ="@"
72 ;
73 Q
74 ;
75NPI ; -- add NPI ID to Institution file
76 ;
77 N ID,FDA,ERROR,IEN,IENS,HLNODE,ARRAY,XUMF,STANUM,TAX,TAXPC,TAXSTAT,NPI,NPIDT,NPISTAT,X,ERR,VISN
78 N NAME,OFNME,AGENCY,FACTYP,STREET,CITY,STATE,ZIP,FDA,PARENT,STRT1,CITY1,STATE1,ZIP1,INACTIVE
79 ;
80 S XUMF=1
81 ;
82 S ID=""
83 F S ID=$O(^TMP("XUMF ARRAY",$J,ID)) Q:ID="" D
84 .K HLNODE
85 .M HLNODE=^TMP("XUMF ARRAY",$J,ID)
86 .D UPDATE
87 ;
88 Q
89 ;
90UPDATE ;
91 ;
92 D SEGPRSE^XUMFXHL7("HLNODE","ARRAY")
93 ;
94 S NAME=ARRAY(1)
95 S STANUM=ARRAY(2)
96 S FACTYP=$P(ARRAY(4),"~",1)
97 S OFNME=ARRAY(5)
98 S INACTIVE=ARRAY(6)
99 S STATE=ARRAY(7)
100 S VISN=ARRAY(8)
101 S PARENT=ARRAY(9)
102 S STREET=$P(ARRAY(14),"~",2)
103 S CITY=$P(ARRAY(14),"~",3)
104 S ZIP=$P(ARRAY(14),"~",5)
105 S STRT1=$P(ARRAY(15),"~",2)
106 S CITY1=$P(ARRAY(15),"~",3)
107 S STATE1=$P(ARRAY(15),"~",4)
108 S ZIP1=$P(ARRAY(15),"~",5)
109 S AGENCY=$P(ARRAY(16),"~")
110 S NPIDT=$$FMDATE^HLFNC(ARRAY(17))
111 S NPISTAT=ARRAY(18)
112 S NPI=ARRAY(19)
113 S TAX=ARRAY(20)
114 S TAXPC=ARRAY(21)
115 S TAXSTAT=ARRAY(22)
116 ;
117 S IEN=$$IEN^XUMF(4,"NPI",ID)
118 I 'IEN,$G(STANUM)'="" S IEN=$O(^DIC(4,"D",STANUM,0))
119 I 'IEN,$D(^DIC(4,"B",NAME)) S IEN=$O(^DIC(4,"B",NAME,0))
120 ;
121 I 'IEN D Q:'IEN
122 .N X,Y S X=NAME
123 .K DIC S DIC=4,DIC(0)="F"
124 .D FILE^DICN K DIC
125 .S IEN=$S(Y="-1":0,1:+Y)
126 ;
127 S IENS=IEN_","
128 ;
129 K FDA
130 S FDA(4,IENS,.01)=NAME
131 S FDA(4,IENS,13)=FACTYP
132 S FDA(4,IENS,1.01)=STREET
133 S FDA(4,IENS,1.03)=CITY
134 S FDA(4,IENS,1.04)=ZIP
135 S FDA(4,IENS,.02)=STATE
136 S FDA(4,IENS,4.01)=STRT1
137 S FDA(4,IENS,4.03)=CITY1
138 S FDA(4,IENS,4.04)=STATE1
139 S FDA(4,IENS,4.05)=ZIP1
140 S FDA(4,IENS,11)="National"
141 S FDA(4,IENS,100)=OFNME
142 S FDA(4,IENS,101)=INACTIVE
143 S FDA(4,IENS,95)=AGENCY
144 D FILE^DIE("E","FDA","ERR")
145 ;
146 K FDA
147 S IENS="?+1,"_IEN_","
148 S FDA(4.014,IENS,.01)="VISN"
149 S FDA(4.014,IENS,1)=VISN
150 D UPDATE^DIE("E","FDA")
151 ;
152 K FDA
153 S IENS="?+2,"_IEN_","
154 S FDA(4.014,IENS,.01)="PARENT FACILITY"
155 S FDA(4.014,IENS,1)=PARENT
156 D UPDATE^DIE("E","FDA")
157 ;
158 S X=$$NPI^XUSNPI("Organization_ID",IEN,NPIDT)
159 I $S(X=0:1,$$UP^XLFSTR($P(X,U,3))'=NPISTAT:1,NPI'=+X:1,1:0) D
160 .S X=$$ADDNPI^XUSNPI("Organization_ID",IEN,NPI,NPIDT,$S(NPISTAT="ACTIVE":1,1:0))
161 ;
162 S IENS="?+1,"_IEN_","
163 K FDA
164 S FDA(4.9999,IENS,.01)="NPI"
165 S FDA(4.9999,IENS,.02)=NPI
166 D UPDATE^DIE("E","FDA",,"ERR")
167 ;
168 K FDA
169 S IENS="?+1,"_IEN_","
170 S FDA(4.043,IENS,.01)=TAX
171 S FDA(4.043,IENS,.02)=TAXPC
172 S FDA(4.043,IENS,.03)=TAXSTAT
173 D UPDATE^DIE("E","FDA",,"ERR")
174 ;
175 Q
176 ;
177POST ;
178 ;
179 D TAX,STA,OPT
180 ;
181 Q
182 ;
183TAX ;
184 ;
185 N IENS,FDA
186 ;
187 S IENS="?+954,"
188 K FDA
189 S FDA(8932.1,IENS,.01)="General Acute Care Hospital"
190 S FDA(8932.1,IENS,6)="282N00000X"
191 S FDA(8932.1,IENS,90002)="NON-INDIVIDUAL"
192 D UPDATE^DIE("E","FDA","IEN","ERR")
193 ;
194 S IENS="?+955,"
195 K FDA
196 S FDA(8932.1,IENS,.01)="VA FACILITY"
197 S FDA(8932.1,IENS,6)="261QV0200X"
198 S FDA(8932.1,IENS,90002)="NON-INDIVIDUAL"
199 D UPDATE^DIE("E","FDA","IEN","ERR")
200 ;
201 S IENS="?+956,"
202 K FDA
203 S FDA(8932.1,IENS,.01)="Department of Veterans Affairs (VA) Pharmacy"
204 S FDA(8932.1,IENS,6)="332100000X"
205 S FDA(8932.1,IENS,90002)="NON-INDIVIDUAL"
206 D UPDATE^DIE("E","FDA","IEN","ERR")
207 ;
208 Q
209 ;
210OPT ;
211 ;
212 N IEN,FDA,IENS
213 ;
214 S IEN=$$FIND1^DIC(19,,"B","XUKERNEL")
215 K FDA
216 S IENS="?+1,"_IEN_","
217 S FDA(19.01,IENS,.01)="XUMF LOAD NPI"
218 D UPDATE^DIE("E","FDA")
219 ;
220 Q
221 ;
222STA ;
223 ;
224 N STA,IEN,IENS,FDA,FTYP,XUMF
225 ;
226 S XUMF=1
227 ;
228 S STA=""
229 F S STA=$O(^DIC(4,"D",STA)) Q:STA="" D
230 .S IEN=$O(^DIC(4,"D",STA,0))
231 .S IENS="?+1,"_IEN_","
232 .K FDA
233 .S FDA(4.9999,IENS,.01)="VASTANUM"
234 .S FDA(4.9999,IENS,.02)=STA
235 .D
236 ..N IEN,STA
237 ..D UPDATE^DIE("E","FDA")
238 ;
239 Q
240 ;
241DEL ;USE EXTREME CAUTION!!!!
242 ;
243 N IEN,NPI,IEN1,FDA,ERR
244 ;
245 S IEN=0
246 F S IEN=$O(^DIC(4,IEN)) Q:'IEN D
247 .;Q:'$G(^DIC(4,IEN,99))
248 .S NPI=$G(^DIC(4,IEN,"NPI")) ;Q:'NPI
249 .K ^DIC(4,"ANPI",+NPI,IEN)
250 .K ^DIC(4,"NPI42",+NPI,IEN)
251 .K ^DIC(4,IEN,"NPI")
252 .K ^DIC(4,IEN,"NPISTATUS")
253 .K ^DIC(4,IEN,"TAXONOMY")
254 .K ^DIC(4,"TAXSTATUS","A",IEN)
255 ;
256XXX ;
257 ;
258 S NPI=0
259 F S NPI=$O(^DIC(4,"XUMFIDX","NPI",NPI)) Q:'NPI D
260 .S IEN=$O(^DIC(4,"XUMFIDX","NPI",NPI,0)) Q:'IEN
261 .S IEN1=$O(^DIC(4,"XUMFIDX","NPI",NPI,IEN,0)) Q:'IEN1
262 .;Q:'$G(^DIC(4,IEN,99))
263 .K FDA
264 .S FDA(4.9999,IEN1_","_IEN_",",.01)="@"
265 .D FILE^DIE("E","FDA","ERR")
266 ;
267YYY ;
268 ;
269 S IEN=$$FIND1^DIC(870,,"BX","XUMF FORUM")
270 S IENS=IEN_","
271 ;
272 K FDA
273 S FDA(870,IENS,4.5)=1
274 S FDA(870,IENS,200.04)=60
275 S FDA(870,IENS,200.05)=60
276 D UPDATE^DIE(,"FDA")
277 ;
278 Q
279 ;
280EM ;
281 ;
282 N X,XMTEXT,XMDUZ,XMSUB
283 ;
284 S X(1)="The post install of patch XU*8*416 has completed but the NPI values"
285 S X(2)="did not get updated in your INSTITUTION (#4) file. Check your HL LOGICAL"
286 S X(3)="LINK (#870) 'XUMF FORUM.' You should be able to PING the link -- stop/start"
287 S X(4)="the link if necessary.",X(4.5)=""
288 S X(5)="After you have verified your XUMF FORUM link use the 'Load Institution"
289 S X(6)="NPI values' [XUMF LOAD NPI] in the [XUKERNEL] menu to load the NPI values."
290 S X(7)=""
291 S X(8)="NOTE: If you are installing in a TEST ACCOUNT then you may disregard this"
292 S X(9)="message. If you do need to install the NPI values in a test/development"
293 S X(10)="environment then you must set up the 'XUMF TEST' logical link to connect"
294 S X(11)="to a test server environment. Hospitals will most likely not wish to update"
295 S X(12)="the Institution file using HL7 messaging but rather wait until the mirror"
296 S X(13)="image overwrites the file normally. If you do need to update the test or"
297 S X(14)="development account and you don't have a test server available then you'll"
298 S X(16)="need to contact the Institution file developer."
299 ;
300 S XMSUB="XUMF NPI ERROR/WARNING/INFO"
301 S XMY("G.XUMF NPI")="",XMY(DUZ)="",XMDUZ=.5
302 S XMTEXT="X("
303 ;
304 D ^XMD
305 ;
306 Q
307 ;
Note: See TracBrowser for help on using the repository browser.