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

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

initial load of FOIAVistA 6/30/08 version
File size: 9.2 KB
Line 
1XUSNPIX2 ;OAK_BP/CMW - NPI EXTRACT REPORT ; 06 Sep 2007 3:34 PM
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="XUSNPIX2" (current routine name, used for ^XTMP and ^TMP
11 ; storage subscript)
12 ; Storage Global:
13 ; ^XTMP("XUSNPIX2",0) = Piece 1^Piece 2^Piece 3^Piece 4^Piece 5^Piece 6
14 ; where:
15 ; Piece 1 => Purge Date - 1 year in future
16 ; Piece 2 => Create Date - Today
17 ; Piece 3 => Description
18 ; Piece 4 => Last Date Compiled
19 ; Piece 5 => $H last run start time
20 ; Piece 6 => $H last run completion time
21 ;
22 ; ^XTMP("XUSNPIX2",1) = STATION INFO
23 ; ^XTMP("XUSNPIX2",2) = DATA
24 ;
25 ; NPI => Unique NPI of entry
26 ; LDT => Last Date Run, VA Fileman Format
27 ;
28 ; Entry Point - ENT called from XUSNPIX1
29 ;
30 Q
31 ;
32ENT ; ENTRY POINT
33 ; Initialize variables
34 N XUSRTN
35 S XUSRTN="XUSNPIX2"
36 S DTTM2=$$HTE^XLFDT($H,"2")
37 ; Check to see if report is in use
38 L +^XTMP(XUSRTN):5 I '$T G EXIT
39 ; Process Institution File
40 D INIT(XUSRTN)
41 ; Pull Station(Institution) data
42 D STAT(XUSRTN)
43 ; Process Report
44 D PROC2(XUSRTN)
45 ; Send the message
46 D EMAIL(XUSRTN)
47 D VMAIL(XUSRTN)
48 S ^XTMP("XUSNPIXT",2)=MSGCNT_U_TOTREC_U_DTTM2
49 ;
50 ; Standard EXIT point
51EXIT ;
52 K ^TMP(XUSRTN,$J),^TMP($J,"XUS59"),^TMP("XUSNPIX",$J)
53 ; Log Run Completion Time
54 S $P(^XTMP(XUSRTN,0),U,6)=$H
55 L -^XTMP(XUSRTN)
56 K P,XUSPT,INST,XUSEOL,DTTM2,MAXSIZE,XUSIZE,MSGCNT,COUNT,TOTREC,XUSHDR,XUSTAXID
57 Q
58 ;
59 ;
60INIT(XUSRTN) ; check/init variables
61 N XUSDESC
62 ; Set end of line character
63 S XUSEOL="~~"
64 ; Set to 300000 for live
65 S MAXSIZE=300000
66 ; Reset Temporary Scratch Global
67 K ^TMP(XUSRTN)
68 S XUSDESC="NPI EXTRACT TYPE 2 - Do Not Delete"
69 S ^XTMP(XUSRTN,0)=(DT+10000)_U_DT_U_XUSDESC_U_DT_U_$H
70 ;
71 I '$D(^TMP("XUSNPIXU",$J)) D BCBSID^XUSNPIXU
72 ;
73 ; Create pharmacy institution ^TMP file
74 D GETPHARM
75 Q
76 ;
77STAT(XUSRTN) ; Pull station and Institution info
78 N SINFO,DIC4,IBSITE,IBFAC,IB0
79 ; Pull site info
80 S SINFO=$$SITE^VASITE
81 ; Station Number
82 S SITE=$P(SINFO,U,3)
83 ; Institution
84 S INST=$P(SINFO,U)
85 ;
86 ; Get Federal Tax Id
87 S XUSTAXID=""
88 S IBSITE=0
89 F S IBSITE=$O(^IBE(350.9,IBSITE)) Q:'IBSITE!(XUSTAXID'="") D
90 . S XUSTAXID=$P($G(^IBE(350.9,IBSITE,1)),U,5)
91 ;
92 ; Get institution mailing address (PAY TO)
93 ;ST ADDR 1,ST ADDR 2,CITY,ZIP
94 I INST D
95 . S DIC4=$G(^DIC(4,INST,4))
96 . S XUSPT(4)=$P(DIC4,U)
97 . S XUSPT(5)=$P(DIC4,U,2)
98 . S XUSPT(6)=$P(DIC4,U,3)
99 . S XUSPT(7)=$P(DIC4,U,4)
100 . I XUSPT(7) S XUSPT(7)=$P($G(^DIC(5,XUSPT(7),0)),U,2)
101 . S XUSPT(8)=$P(DIC4,U,5)
102 . S PTPMAIL=XUSPT(4)_U_XUSPT(5)_U_XUSPT(6)_U_XUSPT(7)_U_XUSPT(8)
103 S XUSHDR="Station: "_SITE_U_XUSPT(6)_U_XUSPT(7)_U_XUSPT(8)_U_"TYPE 2"_U_XUSVER
104 ;
105 Q
106 ;
107PROC2(XUSRTN) ;Process all Institution records
108 N XUSNPI,XUSNEW,XUSDT,XUSI,XUSIN,XUSTXY,XUSSPC,XUSTAX,XUPHM
109 N XUSFCT,XUSFCN,XUSDATA1,XUSDATA2,XUSDATA3,XUSDATA4,XUSDATA5,XUSSTA
110 N INIEN,DIC0,DIC1,PSIEN,NPIINS,RELINS,PSSTA
111 ; set counter
112 S COUNT=1,(TOTREC,MSGCNT,XUSIZE)=0
113 ; Loop through INSTITUTION NPI records NPI xref
114 S XUSNPI=0
115 F S XUSNPI=$O(^DIC(4,"ANPI",XUSNPI)) Q:'XUSNPI D
116 . S INIEN=$O(^DIC(4,"ANPI",XUSNPI,""))
117 . ;
118 . ; Get Station Number
119 . S XUSSTA=$P($G(^DIC(4,INIEN,99)),U)
120 . ; Parent of Association
121 . I (INIEN'=INST)&('$$POA(INIEN,INST)) Q
122 . ; Initialize columns
123 . F XUSI=1:1:24 S XUSIN(XUSI)=""
124 . ;
125 . S XUSIN(1)=XUSNPI
126 . S DIC0=$G(^DIC(4,INIEN,0)) Q:DIC0=""
127 . ;Organization Name
128 . S XUSIN(2)=$P($G(DIC0),U)
129 . S XUSIN(3)=2
130 . S XUSDATA1=XUSIN(1)_U_XUSIN(2)_U_XUSIN(3)
131 . ;
132 . ; Pay to Provider Address
133 . S XUSDATA2=PTPMAIL
134 . ;
135 . ; Servicing Provider Address
136 . S DIC1=$G(^DIC(4,INIEN,1))
137 . I DIC1'="" D
138 . . S XUSIN(9)=$P(DIC1,U)
139 . . S XUSIN(10)=$P(DIC1,U,2)
140 . . S XUSIN(11)=$P(DIC1,U,3)
141 . . S XUSIN(12)=$P($G(DIC0),U,2)
142 . . I XUSIN(12) S XUSIN(12)=$P($G(^DIC(5,XUSIN(12),0)),U,2)
143 . . S XUSIN(13)=$P(DIC1,U,4)
144 . S XUSDATA3=XUSIN(9)_U_XUSIN(10)_U_XUSIN(11)_U_XUSIN(12)_U_XUSIN(13)
145 . ;
146 . ;Phone number (place holder)
147 . S XUSIN(14)=""
148 . ;
149 . ; Get Taxonomy and Specialty
150 . S XUSTXY=0
151 . F S XUSTXY=$O(^DIC(4,INIEN,"TAXONOMY","B",XUSTXY)) Q:'XUSTXY D
152 . . S XUSSPC=$P($G(^USC(8932.1,XUSTXY,0)),U,9)
153 . . S XUSTAX=$P($G(^USC(8932.1,XUSTXY,0)),U,7)
154 . . I XUSSPC'="" D
155 . . . I XUSIN(15)="" S XUSIN(15)=XUSSPC Q
156 . . . S XUSIN(15)=XUSIN(15)_";"_XUSSPC
157 . . I XUSTAX'="" D
158 . . . I XUSIN(16)="" S XUSIN(16)=XUSTAX Q
159 . . . S XUSIN(16)=XUSIN(16)_";"_XUSTAX
160 . ;
161 . ; Federal Tax ID
162 . S XUSIN(17)=$G(XUSTAXID)
163 . ;
164 . ; Medicaid Part A/B
165 . S XUSIN(18)=670899
166 . S XUSIN(19)="VA"_$E(SITE+10000,2,5)
167 . ;
168 . S XUSDATA4=XUSIN(14)_U_XUSIN(15)_U_XUSIN(16)_U_XUSIN(17)_U_XUSIN(18)_U_XUSIN(19)
169 . ;
170 . ; DEA Number
171 . S XUSIN(20)=$P($G(^DIC(4,INIEN,"DEA")),U)
172 . ;
173 . ; get Facility Type and Name
174 . S XUSFCT=$P($G(^DIC(4,INIEN,3)),U)
175 . I XUSFCT'="" S XUSFCN=$P($G(^DIC(4.1,XUSFCT,0)),U)
176 . I $G(XUSFCN)="PHARM" D
177 . . I $D(^TMP("XUSNPIX",$J,INIEN)) D
178 . . . S XUPHM=^TMP("XUSNPIX",$J,INIEN)
179 . . . ; get NCPDP from ^TMP
180 . . . S XUSIN(21)=$P($G(XUPHM),U)
181 . . . ; get station number from^TMP
182 . . . I $P($G(XUPHM),U,2) S XUSSTA=$P(XUPHM,U,2)
183 . ;
184 . ; VISN Station Number
185 . S XUSIN(22)=XUSSTA
186 . ;
187 . S XUSDATA5=XUSIN(20)_U_XUSIN(21)_U_XUSIN(22)
188 . ;
189 . ; Get BCBS Payer ID Array
190 . K XUSBXID
191 . D INSTID^XUSNPIXU(.XUSBXID)
192 . ;
193 . ; Update counter and save Entry
194 . ;
195 . S COUNT=COUNT+1,TOTREC=TOTREC+1
196 . S ^TMP(XUSRTN,$J,COUNT)=XUSDATA1_U_XUSDATA2_U_XUSDATA3_U_XUSDATA4_U_XUSDATA5_U_XUSEOL
197 . S XUSIZE=XUSIZE+$L(^TMP(XUSRTN,$J,COUNT))
198 . I $D(XUSBXID) D
199 . . S XUSB=""
200 . . F S XUSB=$O(XUSBXID(XUSB)) Q:XUSB="" D
201 . . . S COUNT=COUNT+1,TOTREC=TOTREC+1
202 . . . S ^TMP(XUSRTN,$J,COUNT)=XUSDATA1_U_XUSDATA2_U_XUSDATA3_U_XUSDATA4_U_XUSDATA5_U_XUSB_U_XUSBXID(XUSB)_U_XUSEOL
203 . . . S XUSIZE=XUSIZE+$L(^TMP(XUSRTN,$J,COUNT))
204 . K XUSIN,XUSDATA1,XUSDATA2,XUSDATA3,XUSDATA4,XUSDATA5,XUSB,XUSBXID
205 . I XUSIZE>MAXSIZE D
206 . . D EOF(XUSRTN)
207 . . D EMAIL(XUSRTN)
208 . . D VMAIL(XUSRTN)
209 . . S ^TMP(XUSRTN,$J,1)=XUSHDR
210 . . S COUNT=1,XUSIZE=0
211 ;
212 D EOF(XUSRTN)
213 K XUSPT,PTPMAIL,LDTCMP,SITE,XUSTAXID
214 Q
215 ;
216EOF(XUSRTN) ;
217 S MSGCNT=MSGCNT+1
218 S ^TMP(XUSRTN,$J,1)=XUSHDR_U_"Message Number: "_MSGCNT_U_"Line Count: "_COUNT_U_DTTM2_U_$G(XUSPROD)_U_XUSEOL
219 S COUNT=COUNT+1
220 S ^TMP(XUSRTN,$J,COUNT)="END OF FILE"_U_XUSEOL
221 Q
222 ;
223 ; EMail the message
224EMAIL(XUSRTN) ;
225 N XMY
226 ; Send email to designated recipient for live release
227 S XMY("XXX@Q-NPS.VA.GOV")=""
228 ;S XMY(DUZ)="" ;use for testing - remove before live
229 D ESEND
230 Q
231 ;
232VMAIL(XUSRTN) ; verification email
233 N TMP
234 S TMP=^TMP(XUSRTN,$J,1)
235 K ^TMP(XUSRTN,$J)
236 S ^TMP(XUSRTN,$J,1)=$P(TMP,U,1,4)
237 S ^TMP(XUSRTN,$J,2)=""
238 S ^TMP(XUSRTN,$J,3)="TYPE 1 : INSTITUTION FILE (#4)"
239 S ^TMP(XUSRTN,$J,4)=""
240 S ^TMP(XUSRTN,$J,5)="Date/Time of Extract: "_$P(TMP,U,9)
241 S ^TMP(XUSRTN,$J,6)=""
242 S ^TMP(XUSRTN,$J,7)="Message number: "_MSGCNT_" Total NPI records: "_(COUNT-2)
243 S ^TMP(XUSRTN,$J,8)=""
244 S ^TMP(XUSRTN,$J,9)="Programmer Notes: "_XUSVER_" - "_$P(TMP,U,10)
245 ; Send verification email to local mail group and VA Outlook mail group
246 S XMY("G.NPI EXTRACT VERIFICATION")=""
247 D ESEND
248 K ^TMP(XUSRTN)
249 Q
250ESEND N XMTEXT,XMSUB,XMDUN,XMDUZ,XMZ
251 ;Q
252 S XMTEXT="^TMP("""_XUSRTN_""","_$J_","
253 S XMSUB=$TR($P($G(^TMP(XUSRTN,$J,1)),U),":")_"("_$G(XUSPROD)_") NPI EXTRACT TYPE 2"
254 D ^XMD
255 Q
256POA(IEN,INST) ; Check Parent of Association for Institution IEN up to VISN level to see if INST is in the chain
257 N XUSPOA
258 I +$G(INST)=0 Q 0 ; No institution - return false
259POA1 ;
260 I $G(IEN)="" Q 0 ; No IEN remaining to check - return false
261 I $D(XUSPOA(IEN)) Q 0 ; Already reviewed this IEN - possible infinite loop - return false
262 S XUSPOA(IEN)=""
263 S XUSPOA=$P($G(^DIC(4,IEN,7,2,0)),U,2) ; Get parent of this institution
264 I XUSPOA=INST Q 1 ; Found matching institution - return true
265 I IEN=XUSPOA Q 0 ; Top level reached - return false
266 S IEN=XUSPOA ; Reset IEN to check next level
267 G POA1
268 ;
269GETPHARM ;
270 ; this subroutine retrieves data from the OUTPATIENT SITE file
271 ; using the supported Pharmacy API PSS^PSO59.
272 ; It takes the results and places them into a temporary
273 ; global array that is accessed when processing data
274 ; associated with a pharmacy institution.
275 N XUS59DA,XUSNPIDA,XUSRELDA,PSSTA,Y,X,XUNCP
276 K ^TMP($J,"XUS59"),^TMP("XUSNPIX",$J) ; remove any pre-existing nodes
277 D PSS^PSO59(,"??","XUS59")
278 S XUS59DA=0
279 ; gather data from each Outpatient site entry stored in the pharmacy
280 ; ^TMP global and build 2nd ^TMP global for later processing
281 F S XUS59DA=$O(^TMP($J,"XUS59",XUS59DA)) Q:'XUS59DA D
282 . ;
283 . ;Get Pharmacy NPI institution from API
284 . S XUSNPIDA=$P($G(^TMP($J,"XUS59",XUS59DA,101)),U)
285 . Q:XUSNPIDA']"" ; NPI institution does not exist
286 . ;
287 . ; Get Pharmacy Related Institution from API
288 . S XUSRELDA=$P($G(^TMP($J,"XUS59",XUS59DA,100)),U)
289 . ; get station number off the related institution
290 . S PSSTA=$P($G(^DIC(4,XUSRELDA,99)),U)
291 . ;
292 . ; Get NCPDP number
293 . S XUNCP="" ;prevent previous values being carried over
294 . S X=XUSNPIDA S D="C",DIC=9002313.56,DIC(0)="" D IX^DIC
295 . I +Y>0 S XUNCP=$$GET1^DIQ(9002313.56,+Y,.02)
296 . S:$G(XUNCP)="" XUNCP=$P($G(^TMP($J,"XUS59",XUS59DA,1008)),U)
297 . ;
298 . ; rebuild the ^TMP global by NPI institution
299 . ; collect necessary data used in the 'PHARM' logic
300 . S ^TMP("XUSNPIX",$J,XUSNPIDA)=XUNCP_"^"_PSSTA ; ncpdp#^station
301 Q
Note: See TracBrowser for help on using the repository browser.