source: WorldVistAEHR/trunk/r/KERNEL-XU-A4A7-USC-XG-XLF-XNOA-XPD-XQ-XVIR-ZI-ZOSF-ZOSV-ZT-ZU-%Z-XIP--XQAB--XUC--XUR--ZIN--ZTED/XUSNPIX4.m@ 613

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

initial load of WorldVistAEHR
File size: 7.6 KB
Line 
1XUSNPIX4 ;OAK_BP/CMW - NPI EXTRACT REPORT ;11:47 AM 28 Jul 2009
2 ;;8.0;KERNEL;**438,452,453,481,WV**; Jul 10, 1995;Build 21
3 ;;Per VHA Directive 2004-038, this routine should not be modified.
4 ;
5 ; NPI Extract Report
6 ;
7 ; Input parameter: N/A
8 ;
9 ; Other relevant variables:
10 ; XUSRTN="XUSNPIX1NV" (current routine name, used for ^XTMP and ^TMP
11 ; XUSRTN="XUSNPIX2NV" storage subscript)
12 ; Storage Global:
13 ; ^XTMP("XUSNPIX1VA",0) = Piece 1^Piece 2^Piece 3^Piece 4^Piece 5^Piece 6
14 ; ^XTMP("XUSNPIX2VA",0)
15 ; where:
16 ; Piece 1 => Purge Date - 1 year in future
17 ; Piece 2 => Create Date - Today
18 ; Piece 3 => Description
19 ; Piece 4 => Last Date Compiled
20 ; Piece 5 => $H last run start time
21 ; Piece 6 => $H last run completion time
22 ;
23 ; Entry Point - ENT called from XUSNPIX1
24 ;
25 Q
26 ;
27 ; Individual records
28TYPE1(DTTM3,PTPMAIL,SITE,XUSPROD,XUSHDR) ;
29 N IBA0,NVIEN,XUSNPI,MAXSIZE,XUSEOL,XUSCNT
30 N XUSI,XUSNM,XUSNV,XLFNC,XUSIZE,XUSDT,XUSNEW
31 N TOTREC1
32 ;
33 ; Set Maximum Message Size
34 S MAXSIZE=300000
35 ;
36 ; Set end of line character
37 S XUSEOL="~~"
38 ;
39 S XUSCNT=1,(TOTREC1,MSGCNT,XUSIZE)=0
40 S XUSNPI=""
41 F S XUSNPI=$O(^TMP("XUSNPI",$J,1,XUSNPI)) Q:'XUSNPI D
42 . S XUSDATA=XUSNPI
43 . S NVIEN=$G(^TMP("XUSNPI",$J,1,XUSNPI))
44 . ;
45 . F XUSI=1:1:29 S XUSNV(XUSI)=""
46 . S IBA0=$G(^IBA(355.93,NVIEN,0))
47 . S XUSNM=$P(IBA0,U)
48 . ; Break Name into components
49 . I XUSNM'="" D
50 . . ;Begin WorldVistA Change; 07/28/2009
51 . . ;S XLFNC=XUSNM D FORMAT^XLFNAME7(.XLFNC,,,,0)
52 . . S XLFNC=XUSNM S XLFNC=$$FORMAT^XLFNAME7(.XLFNC,,,,0)
53 . . ;End WorldVistA change
54 . . S XUSNV(2)=XLFNC("GIVEN"),XUSNV(3)=XLFNC("MIDDLE"),XUSNV(4)=XLFNC("FAMILY")
55 . . I XLFNC("SUFFIX")'="" S XUSNV(4)=XUSNV(4)_" "_XLFNC("SUFFIX")
56 . . K XLFNC
57 . S XUSDATA=XUSDATA_U_XUSNV(2)_U_XUSNV(3)_U_XUSNV(4)
58 . S XUSNV(5)=1 ;TYPE
59 . ;
60 . ; DOB (place holder)
61 . S XUSNV(6)=""
62 . S XUSDATA=XUSDATA_U_XUSNV(5)_U_XUSNV(6)
63 . ;
64 . ; Pay to Provider Address (7-11)
65 . S XUSDATA=XUSDATA_U_PTPMAIL
66 . ;
67 . ; Servicing Provider Address
68 . S XUSNV(12)=$P(IBA0,U,5)
69 . S XUSNV(13)=$P(IBA0,U,10)
70 . S XUSNV(14)=$P(IBA0,U,6)
71 . S XUSNV(15)=$P(IBA0,U,7)
72 . I XUSNV(15) S XUSNV(15)=$P($G(^DIC(5,XUSNV(12),0)),U,2)
73 . S XUSNV(16)=$P(IBA0,U,8)
74 . S XUSDATA=XUSDATA_U_XUSNV(12)_U_XUSNV(13)_U_XUSNV(14)_U_XUSNV(15)_U_XUSNV(16)
75 . ;
76 . ; Office Phone number (place holder)
77 . S XUSNV(17)=""
78 . ;
79 . ; Degree Description / Degree Code (place holder)
80 . S XUSNV(18)=""
81 . S XUSNV(19)=""
82 . ;
83 . ; Get Taxonomy and specialty codes
84 . N NVTX,NVSPC,NVTAX
85 . S NVTX=0
86 . F S NVTX=$O(^IBA(355.93,NVIEN,"TAXONOMY","B",NVTX)) Q:'NVTX D
87 . . S NVSPC=$P($G(^USC(8932.1,NVTX,0)),U,9)
88 . . S NVTAX=$P($G(^USC(8932.1,NVTX,0)),U,7)
89 . . I NVSPC'="" D
90 . . . I XUSNV(20)="" S XUSNV(20)=NVSPC Q
91 . . . S XUSNV(20)=XUSNV(20)_";"_NVSPC
92 . . I NVTAX'="" D
93 . . . I XUSNV(21)="" S XUSNV(21)=NVTAX Q
94 . . . S XUSNV(21)=XUSNV(21)_";"_NVTAX
95 . ;
96 . ; Fed tax ID
97 . S XUSNV(22)=$P($G(IBA0),U,9)
98 . ;
99 . S XUSDATA=XUSDATA_U_XUSNV(17)_U_XUSNV(18)_U_XUSNV(19)_U_XUSNV(20)_U_XUSNV(21)_U_XUSNV(22)
100 . ;
101 . ; Medicare Part A/B
102 . S XUSNV(23)=670899
103 . S XUSNV(24)="VA"_$E(SITE+10000,2,5)
104 . ;
105 . ; State Lic and DEA (place holder)
106 . S XUSNV(25)=""
107 . S XUSNV(26)=""
108 . ;
109 . ; VISN Station
110 . S XUSNV(27)=SITE
111 . ;
112 . S XUSDATA=XUSDATA_U_XUSNV(23)_U_XUSNV(24)_U_XUSNV(25)_U_XUSNV(26)_U_XUSNV(27)
113 . ;
114 . ;BCBS info
115 . K XUSBXID
116 . D NNVAID^XUSNPIXU(NVIEN,.XUSBXID)
117 . ;
118 . ;Update counter and save Entry
119 . N XUSB
120 . S XUSCNT=XUSCNT+1,TOTREC1=TOTREC1+1
121 . S ^TMP(XUSRTN,$J,XUSCNT)=XUSDATA_U_XUSEOL
122 . S XUSIZE=XUSIZE+$L(^TMP(XUSRTN,$J,XUSCNT))
123 . I $D(XUSBXID) D
124 . . S XUSB=""
125 . . F S XUSB=$O(XUSBXID(XUSB)) Q:XUSB="" D
126 . . . S XUSCNT=XUSCNT+1,TOTREC1=TOTREC1+1
127 . . . S ^TMP(XUSRTN,$J,XUSCNT)=XUSDATA_U_XUSB_U_XUSEOL
128 . . . S XUSIZE=XUSIZE+$L(^TMP(XUSRTN,$J,XUSCNT))
129 . I XUSIZE>MAXSIZE D
130 . . D EOF1(XUSRTN)
131 . . D EMAIL^XUSNPIX3(XUSRTN)
132 . . K ^TMP(XUSRTN,$J)
133 . . S ^TMP("XUSNPIXS",$J,3,MSGCNT)="1 (Non-VA)^"_(XUSCNT-2)
134 . . S ^TMP(XUSRTN,$J,1)=XUSHDR
135 . . S XUSCNT=1,XUSIZE=0
136 . K XUSNV,XUSDATA,XUSBXID
137 ;
138 D EOF1(XUSRTN)
139 ;
140 ; Send last message (if it has records)
141 I $G(XUSCNT)>1 D
142 . D EMAIL^XUSNPIX3(XUSRTN)
143 . K ^TMP(XUSRTN,$J)
144 . S ^TMP("XUSNPIXS",$J,3,MSGCNT)="1 (Non-VA)^"_($G(XUSCNT)-2)
145 ;
146 ; Update Summary
147 S ^XTMP("XUSNPIXT","1NV")=MSGCNT_U_TOTREC1_U_DTTM3
148 Q
149 ;
150EOF1(XUSRTN) ;
151 Q:$G(XUSCNT)=1
152 S MSGCNT=MSGCNT+1
153 S ^TMP(XUSRTN,$J,1)=XUSHDR_U_"Message Number: "_MSGCNT_U_"Line Count: "_XUSCNT_U_DTTM3_U_$G(XUSPROD)_U_XUSEOL
154 S XUSCNT=XUSCNT+1
155 S ^TMP(XUSRTN,$J,XUSCNT)="END OF FILE"_U_XUSEOL
156 Q
157 ;
158TYPE2(DTTM3,PTPMAIL,SITE,XUSPROD,XUSHDR) ;Facility/Group
159 N IBA0,NVIEN,XUSNPI,MAXSIZE,XUSEOL,XUSCNT
160 N XUSNV,XUSI,XUSNM,XLFNC,MSGCNT,XUSIZE,XUSDT,XUSNEW,TOTREC2
161 ;
162 ; Set Maximum Message Size
163 S MAXSIZE=300000
164 ;
165 ; Set end of line character
166 S XUSEOL="~~"
167 ;
168 S XUSNPI=""
169 S XUSCNT=1,(TOTREC2,MSGCNT,XUSIZE)=0
170 F S XUSNPI=$O(^TMP("XUSNPI",$J,2,XUSNPI)) Q:'XUSNPI D
171 . S XUSDATA=XUSNPI
172 . S NVIEN=$G(^TMP("XUSNPI",$J,2,XUSNPI))
173 . ;
174 . F XUSI=1:1:24 S XUSNV(XUSI)=""
175 . S IBA0=$G(^IBA(355.93,NVIEN,0))
176 . ;Get Organization name
177 . S XUSNV(2)=$P(IBA0,U)
178 . ;Type
179 . S XUSNV(3)=2
180 . ;
181 . S XUSDATA=XUSDATA_U_XUSNV(2)_U_XUSNV(3)
182 . ;
183 . ; Pay to Provider Address (4-8)
184 . S XUSDATA=XUSDATA_U_PTPMAIL
185 . ;
186 . ; Servicing Provider Address
187 . S XUSNV(9)=$P(IBA0,U,5)
188 . S XUSNV(10)=$P(IBA0,U,10)
189 . S XUSNV(11)=$P(IBA0,U,6)
190 . S XUSNV(12)=$P(IBA0,U,7)
191 . I XUSNV(12) S XUSNV(12)=$P($G(^DIC(5,XUSNV(12),0)),U,2)
192 . S XUSNV(13)=$P(IBA0,U,8)
193 . S XUSDATA=XUSDATA_U_XUSNV(9)_U_XUSNV(10)_U_XUSNV(11)_U_XUSNV(12)_U_XUSNV(13)
194 . ;
195 . ;Office Phone number (place holder)
196 . S XUSNV(14)=""
197 . ;
198 . ; get Taxonomy and Specialty
199 . N NVTX,NVSPC,NVTAX
200 . S NVTX=0
201 . F S NVTX=$O(^IBA(355.93,NVIEN,"TAXONOMY","B",NVTX)) Q:'NVTX D
202 . . S NVSPC=$P($G(^USC(8932.1,NVTX,0)),U,9)
203 . . S NVTAX=$P($G(^USC(8932.1,NVTX,0)),U,7)
204 . . I NVSPC'="" D
205 . . . I XUSNV(15)="" S XUSNV(15)=NVSPC Q
206 . . . S XUSNV(15)=XUSNV(15)_";"_NVSPC
207 . . I NVTAX'="" D
208 . . . I XUSNV(16)="" S XUSNV(16)=NVTAX Q
209 . . . S XUSNV(16)=XUSNV(16)_";"_NVTAX
210 . ;
211 . ; Fed Tax ID
212 . S XUSNV(17)=$P($G(IBA0),U,9)
213 . ;
214 . ;Medicare A/B
215 . S XUSNV(18)=670899
216 . S XUSNV(19)="VA"_$E(SITE+10000,2,5)
217 . ;
218 . S XUSDATA=XUSDATA_U_XUSNV(14)_U_XUSNV(15)_U_XUSNV(16)_U_XUSNV(17)_U_XUSNV(18)_U_XUSNV(19)
219 . ;
220 . ;State License Number
221 . S XUSNV(20)=$P($G(IBA0),U,12)
222 . ;
223 . ;DEA Number (place holder)
224 . S XUSNV(21)=""
225 . ;
226 . ;VISN STATION ID
227 . S XUSNV(22)=SITE
228 . ;
229 . S XUSDATA=XUSDATA_U_XUSNV(20)_U_XUSNV(21)_U_XUSNV(22)
230 . ;
231 . ;BCBS info
232 . K XUSBXID
233 . D NNVAID^XUSNPIXU(NVIEN,.XUSBXID)
234 . ;
235 . ;Update counter and save Entry
236 . N XUSB
237 . S XUSCNT=XUSCNT+1,TOTREC2=TOTREC2+1
238 . S ^TMP(XUSRTN,$J,XUSCNT)=XUSDATA_U_XUSEOL
239 . S XUSIZE=XUSIZE+$L(^TMP(XUSRTN,$J,XUSCNT))
240 . I $D(XUSBXID) D
241 . . S XUSB=""
242 . . F S XUSB=$O(XUSBXID(XUSB)) Q:XUSB="" D
243 . . . S XUSCNT=XUSCNT+1,TOTREC2=TOTREC2+1
244 . . . S ^TMP(XUSRTN,$J,XUSCNT)=XUSDATA_U_XUSB_U_XUSEOL
245 . . . S XUSIZE=XUSIZE+$L(^TMP(XUSRTN,$J,XUSCNT))
246 . I XUSIZE>MAXSIZE D
247 . . D EOF2(XUSRTN)
248 . . D EMAIL^XUSNPIX3(XUSRTN)
249 . . K ^TMP(XUSRTN,$J)
250 . . S ^TMP("XUSNPIXS",$J,4,MSGCNT)="2 (Non-VA)^"_(XUSCNT-2)
251 . . S ^TMP(XUSRTN,$J,1)=XUSHDR
252 . . S XUSCNT=1,XUSIZE=0
253 . K XUSNV,XUSDATA,XUSB,XUSBXID
254 ;
255 D EOF2(XUSRTN)
256 ;
257 ; Send last message (if it has records)
258 I $G(XUSCNT)>1 D
259 . D EMAIL^XUSNPIX3(XUSRTN)
260 . K ^TMP(XUSRTN,$J)
261 . S ^TMP("XUSNPIXS",$J,4,MSGCNT)="2 (Non-VA)^"_($G(XUSCNT)-2)
262 ;
263 ; Update Summary
264 S ^XTMP("XUSNPIXT","2NV")=MSGCNT_U_TOTREC2_U_DTTM3
265 Q
266 ;
267EOF2(XUSRTN) ;
268 Q:$G(XUSCNT)=1
269 S MSGCNT=MSGCNT+1
270 S ^TMP(XUSRTN,$J,1)=XUSHDR_U_"Message Number: "_MSGCNT_U_"Line Count: "_XUSCNT_U_DTTM3_U_$G(XUSPROD)_U_XUSEOL
271 S XUSCNT=XUSCNT+1
272 S ^TMP(XUSRTN,$J,XUSCNT)="END OF FILE"_U_XUSEOL
273 Q
Note: See TracBrowser for help on using the repository browser.