[613] | 1 | XUSNPIX4 ;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
|
---|
| 28 | TYPE1(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 | ;
|
---|
| 150 | EOF1(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 | ;
|
---|
| 158 | TYPE2(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 | ;
|
---|
| 267 | EOF2(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
|
---|