Changeset 623 for 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
- Timestamp:
- Dec 4, 2009, 12:11:15 AM (14 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
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
r613 r623 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 1 XUSNPIX4 ;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 28 TYPE1 ; 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 ; 131 EOF1(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 ; 138 TYPE2 ;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 ; 231 EOF2(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 TracChangeset
for help on using the changeset viewer.
