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@ 1800

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

revised back to 6/30/08 version
File size: 6.7 KB
RevLine 
[623]1XUSNPIX4 ;OAK_BP/CMW - NPI EXTRACT REPORT ;01-OCT-06
2 ;;8.0;KERNEL;**438,452,453**; Jul 10, 1995;Build 36
3 ;;Per VHA Directive 10-93-142, 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 ;
29 N IBA0,NVIEN,XUSNPI
30 N XUSI,XUSNM,XUSNV,XLFNC,XUSIZE,XUSDT,XUSNEW
31 N TOTREC1,TOTREC2
32 S XUSCNT=1,(TOTREC1,MSGCNT,XUSIZE)=0
33 S XUSNPI=""
34 F S XUSNPI=$O(^TMP("XUSNPI",$J,1,XUSNPI)) Q:'XUSNPI D
35 . S XUSDATA=XUSNPI
36 . S NVIEN=$G(^TMP("XUSNPI",$J,1,XUSNPI))
37 . ;
38 . F XUSI=1:1:29 S XUSNV(XUSI)=""
39 . S IBA0=$G(^IBA(355.93,NVIEN,0))
40 . S XUSNM=$P(IBA0,U)
41 . ; Break Name into components
42 . I XUSNM'="" D
43 . . S XLFNC=XUSNM D FORMAT^XLFNAME7(.XLFNC,,,,0)
44 . . S XUSNV(2)=XLFNC("GIVEN"),XUSNV(3)=XLFNC("MIDDLE"),XUSNV(4)=XLFNC("FAMILY")
45 . . I XLFNC("SUFFIX")'="" S XUSNV(4)=XUSNV(4)_" "_XLFNC("SUFFIX")
46 . . K XLFNC
47 . S XUSDATA=XUSDATA_U_XUSNV(2)_U_XUSNV(3)_U_XUSNV(4)
48 . S XUSNV(5)=1 ;TYPE
49 . ;
50 . ; DOB (place holder)
51 . S XUSNV(6)=""
52 . S XUSDATA=XUSDATA_U_XUSNV(5)_U_XUSNV(6)
53 . ;
54 . ; Pay to Provider Address (7-11)
55 . S XUSDATA=XUSDATA_U_PTPMAIL
56 . ;
57 . ; Servicing Provider Address
58 . S XUSNV(12)=$P(IBA0,U,5)
59 . S XUSNV(13)=$P(IBA0,U,10)
60 . S XUSNV(14)=$P(IBA0,U,6)
61 . S XUSNV(15)=$P(IBA0,U,7)
62 . I XUSNV(15) S XUSNV(15)=$P($G(^DIC(5,XUSNV(12),0)),U,2)
63 . S XUSNV(16)=$P(IBA0,U,8)
64 . S XUSDATA=XUSDATA_U_XUSNV(12)_U_XUSNV(13)_U_XUSNV(14)_U_XUSNV(15)_U_XUSNV(16)
65 . ;
66 . ; Office Phone number (place holder)
67 . S XUSNV(17)=""
68 . ;
69 . ; Degree Description / Degree Code (place holder)
70 . S XUSNV(18)=""
71 . S XUSNV(19)=""
72 . ;
73 . ; Get Taxonomy and specialty codes
74 . N NVTX,NVSPC,NVTAX
75 . S NVTX=0
76 . F S NVTX=$O(^IBA(355.93,NVIEN,"TAXONOMY","B",NVTX)) Q:'NVTX D
77 . . S NVSPC=$P($G(^USC(8932.1,NVTX,0)),U,9)
78 . . S NVTAX=$P($G(^USC(8932.1,NVTX,0)),U,7)
79 . . I NVSPC'="" D
80 . . . I XUSNV(20)="" S XUSNV(20)=NVSPC Q
81 . . . S XUSNV(20)=XUSNV(20)_";"_NVSPC
82 . . I NVTAX'="" D
83 . . . I XUSNV(21)="" S XUSNV(21)=NVTAX Q
84 . . . S XUSNV(21)=XUSNV(21)_";"_NVTAX
85 . ;
86 . ; Fed tax ID
87 . S XUSNV(22)=$P($G(IBA0),U,9)
88 . ;
89 . S XUSDATA=XUSDATA_U_XUSNV(17)_U_XUSNV(18)_U_XUSNV(19)_U_XUSNV(20)_U_XUSNV(21)_U_XUSNV(22)
90 . ;
91 . ; Medicare Part A/B
92 . S XUSNV(23)=670899
93 . S XUSNV(24)="VA"_$E(SITE+10000,2,5)
94 . ;
95 . ; State Lic and DEA (place holder)
96 . S XUSNV(25)=""
97 . S XUSNV(26)=""
98 . ;
99 . ; VISN Station
100 . S XUSNV(27)=SITE
101 . ;
102 . S XUSDATA=XUSDATA_U_XUSNV(23)_U_XUSNV(24)_U_XUSNV(25)_U_XUSNV(26)_U_XUSNV(27)
103 . ;
104 . ;BCBS info
105 . K XUSBXID
106 . D NNVAID^XUSNPIXU(NVIEN,.XUSBXID)
107 . ;
108 . ;Update counter and save Entry
109 . N XUSB
110 . S XUSCNT=XUSCNT+1,TOTREC1=TOTREC1+1
111 . S ^TMP(XUSRTN,$J,XUSCNT)=XUSDATA_U_XUSEOL
112 . S XUSIZE=XUSIZE+$L(^TMP(XUSRTN,$J,XUSCNT))
113 . I $D(XUSBXID) D
114 . . S XUSB=""
115 . . F S XUSB=$O(XUSBXID(XUSB)) Q:XUSB="" D
116 . . . S XUSCNT=XUSCNT+1,TOTREC1=TOTREC1+1
117 . . . S ^TMP(XUSRTN,$J,XUSCNT)=XUSDATA_U_XUSB_U_XUSEOL
118 . . . S XUSIZE=XUSIZE+$L(^TMP(XUSRTN,$J,XUSCNT))
119 . I XUSIZE>MAXSIZE D
120 . . D EOF1(XUSRTN)
121 . . D EMAIL^XUSNPIX3(XUSRTN)
122 . . D VMAIL^XUSNPIX3(XUSRTN)
123 . . S ^TMP(XUSRTN,$J,1)=XUSHDR
124 . . S XUSCNT=1,XUSIZE=0
125 . K XUSNV,XUSDATA,XUSBXID
126 ;
127 D EOF1(XUSRTN)
128 S ^XTMP("XUSNPIXT","1NV")=MSGCNT_U_TOTREC1_U_DTTM3
129 Q
130 ;
131EOF1(XUSRTN) ;
132 S MSGCNT=MSGCNT+1
133 S ^TMP(XUSRTN,$J,1)=XUSHDR_U_"Message Number: "_MSGCNT_U_"Line Count: "_XUSCNT_U_DTTM3_U_$G(XUSPROD)_U_XUSEOL
134 S XUSCNT=XUSCNT+1
135 S ^TMP(XUSRTN,$J,XUSCNT)="END OF FILE"_U_XUSEOL
136 Q
137 ;
138TYPE2 ;Facility/Group
139 N IBA0,NVIEN,XUSNPI
140 N XUSNV,XUSI,XUSNM,XLFNC,MSGCNT,XUSIZE,XUSDT,XUSNEW
141 S XUSNPI=""
142 S XUSCNT=1,(TOTREC2,MSGCNT,XUSIZE)=0
143 F S XUSNPI=$O(^TMP("XUSNPI",$J,2,XUSNPI)) Q:'XUSNPI D
144 . S XUSDATA=XUSNPI
145 . S NVIEN=$G(^TMP("XUSNPI",$J,2,XUSNPI))
146 . ;
147 . F XUSI=1:1:24 S XUSNV(XUSI)=""
148 . S IBA0=$G(^IBA(355.93,NVIEN,0))
149 . ;Get Organization name
150 . S XUSNV(2)=$P(IBA0,U)
151 . ;Type
152 . S XUSNV(3)=2
153 . ;
154 . S XUSDATA=XUSDATA_U_XUSNV(2)_U_XUSNV(3)
155 . ;
156 . ; Pay to Provider Address (4-8)
157 . S XUSDATA=XUSDATA_U_PTPMAIL
158 . ;
159 . ; Servicing Provider Address
160 . S XUSNV(9)=$P(IBA0,U,5)
161 . S XUSNV(10)=$P(IBA0,U,10)
162 . S XUSNV(11)=$P(IBA0,U,6)
163 . S XUSNV(12)=$P(IBA0,U,7)
164 . I XUSNV(12) S XUSNV(12)=$P($G(^DIC(5,XUSNV(12),0)),U,2)
165 . S XUSNV(13)=$P(IBA0,U,8)
166 . S XUSDATA=XUSDATA_U_XUSNV(9)_U_XUSNV(10)_U_XUSNV(11)_U_XUSNV(12)_U_XUSNV(13)
167 . ;
168 . ;Office Phone number (place holder)
169 . S XUSNV(14)=""
170 . ;
171 . ; get Taxonomy and Specialty
172 . N NVTX,NVSPC,NVTAX
173 . S NVTX=0
174 . F S NVTX=$O(^IBA(355.93,NVIEN,"TAXONOMY","B",NVTX)) Q:'NVTX D
175 . . S NVSPC=$P($G(^USC(8932.1,NVTX,0)),U,9)
176 . . S NVTAX=$P($G(^USC(8932.1,NVTX,0)),U,7)
177 . . I NVSPC'="" D
178 . . . I XUSNV(15)="" S XUSNV(15)=NVSPC Q
179 . . . S XUSNV(15)=XUSNV(15)_";"_NVSPC
180 . . I NVTAX'="" D
181 . . . I XUSNV(16)="" S XUSNV(16)=NVTAX Q
182 . . . S XUSNV(16)=XUSNV(16)_";"_NVTAX
183 . ;
184 . ; Fed Tax ID
185 . S XUSNV(17)=$P($G(IBA0),U,9)
186 . ;
187 . ;Medicare A/B
188 . S XUSNV(18)=670899
189 . S XUSNV(19)="VA"_$E(SITE+10000,2,5)
190 . ;
191 . S XUSDATA=XUSDATA_U_XUSNV(14)_U_XUSNV(15)_U_XUSNV(16)_U_XUSNV(17)_U_XUSNV(18)_U_XUSNV(19)
192 . ;
193 . ;State License Number
194 . S XUSNV(20)=$P($G(IBA0),U,12)
195 . ;
196 . ;DEA Number (place holder)
197 . S XUSNV(21)=""
198 . ;
199 . ;VISN STATION ID
200 . S XUSNV(22)=SITE
201 . ;
202 . S XUSDATA=XUSDATA_U_XUSNV(20)_U_XUSNV(21)_U_XUSNV(22)
203 . ;
204 . ;BCBS info
205 . K XUSBXID
206 . D NNVAID^XUSNPIXU(NVIEN,.XUSBXID)
207 . ;
208 . ;Update counter and save Entry
209 . N XUSB
210 . S XUSCNT=XUSCNT+1,TOTREC2=TOTREC2+1
211 . S ^TMP(XUSRTN,$J,XUSCNT)=XUSDATA_U_XUSEOL
212 . S XUSIZE=XUSIZE+$L(^TMP(XUSRTN,$J,XUSCNT))
213 . I $D(XUSBXID) D
214 . . S XUSB=""
215 . . F S XUSB=$O(XUSBXID(XUSB)) Q:XUSB="" D
216 . . . S XUSCNT=XUSCNT+1,TOTREC2=TOTREC2+1
217 . . . S ^TMP(XUSRTN,$J,XUSCNT)=XUSDATA_U_XUSB_U_XUSEOL
218 . . . S XUSIZE=XUSIZE+$L(^TMP(XUSRTN,$J,XUSCNT))
219 . I XUSIZE>MAXSIZE D
220 . . D EOF2(XUSRTN)
221 . . D EMAIL^XUSNPIX3(XUSRTN)
222 . . D VMAIL^XUSNPIX3(XUSRTN)
223 . . S ^TMP(XUSRTN,$J,1)=XUSHDR
224 . . S XUSCNT=1,XUSIZE=0
225 . K XUSNV,XUSDATA,XUSB,XUSBXID
226 ;
227 D EOF2(XUSRTN)
228 S ^XTMP("XUSNPIXT","2NV")=MSGCNT_U_TOTREC2_U_DTTM3
229 Q
230 ;
231EOF2(XUSRTN) ;
232 S MSGCNT=MSGCNT+1
233 S ^TMP(XUSRTN,$J,1)=XUSHDR_U_"Message Number: "_MSGCNT_U_"Line Count: "_XUSCNT_U_DTTM3_U_$G(XUSPROD)_U_XUSEOL
234 S XUSCNT=XUSCNT+1
235 S ^TMP(XUSRTN,$J,XUSCNT)="END OF FILE"_U_XUSEOL
236 Q
Note: See TracBrowser for help on using the repository browser.