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/XUSNPIX1.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/XUSNPIX1.m
r613 r623 1 XUSNPIX1 ;OAK_BP/CMW - NPI EXTRACT REPORT ;11:45 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="XUSNPIX1" (current routine name, used for ^XTMP and ^TMP 11 ; storage subscript) 12 ; Storage Global: 13 ; ^XTMP("XUSNPIX1",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("XUSNPIX1",1) = DATA 23 ; 24 ; XUSNPI => Unique NPI of entry 25 ; LDT => Last Date Run, VA Fileman Format 26 ; 27 ; Entry Point - TASKMAN => Run report in background using TASKMAN 28 ; 29 Q 30 ; 31 TASKMAN ;TASKMAN ENTRY POINT 32 ; Process Report 33 N XUSRTN,DTTM,XUSPROD,XUSVER,INSMAIL 34 ; 35 ; Check for required variables 36 I $G(U)=""!($G(DT)="") G EXIT 37 S XUSRTN="XUSNPIX1" 38 S DTTM=$$HTE^XLFDT($H,"2") 39 ; Check to see if report is in use 40 L +^XTMP(XUSRTN):5 I '$T G EXIT 41 ; 42 ;Reset Summary Scratch Globals 43 K ^TMP("XUSNPIXS",$J) 44 K ^TMP("XUSNPIXT",$J) 45 ; 46 ; Initialize variables 47 D INIT(XUSRTN) 48 ; 49 ; Pull Station(Institution) data 50 D INST(XUSRTN,XUSVER,.INSMAIL) 51 ; 52 ;Process New Person File 53 D PROC1(XUSRTN,XUSPROD,XUSVER,DTTM,INSMAIL) 54 ; 55 ; Process Institution File 56 D ENT^XUSNPIX2(XUSPROD,XUSVER) 57 ; 58 ; Process Non VA File 59 D ENT^XUSNPIX3(XUSPROD,XUSVER) 60 ; 61 ; Send summary message 62 D SMAIL^XUSNPIX5("XUSNPIXT",XUSPROD,XUSVER,DTTM) 63 ; 64 ;Standard EXIT point 65 EXIT ; 66 K DTTM,XUSVER,XUSHDR,XUSPROD,INSMAIL 67 ; 68 ;Kill off Scratch Globals 69 K ^TMP("XUSNPIXS",$J) 70 K ^TMP("XUSNPIXT",$J) 71 K ^TMP("XUSNPIXU",$J) 72 ; Log Run Completion Time 73 S $P(^XTMP(XUSRTN,0),U,6)=$H 74 L -^XTMP(XUSRTN) 75 ; 76 Q 77 ; 78 INIT(XUSRTN) ; check/init variables 79 N XUSDESC 80 ; Set to NEXT release version from NPM 81 S XUSVER="481.5" 82 ; Get production/test account flag 83 S XUSPROD=$S($$PROD^XUPROD(1):"PROD",1:"TEST") 84 ; 85 ; Reset Temporary Scratch Global 86 D INIT^XUSNPIXU 87 K ^TMP(XUSRTN) 88 S XUSDESC="NPI EXTRACT TYPE 1 - Do Not Delete" 89 S ^XTMP(XUSRTN,0)=(DT+10000)_U_DT_U_XUSDESC_U_DT_U_$H 90 ; Generate TMP BCBS Array 91 D BCBSID^XUSNPIXU 92 ; 93 Q 94 ; 95 INST(XUSRTN,XUSVER,INSMAIL) ;Pull station and Institution info 96 N INST,SINFO,DIC4 97 ; Pull site info 98 S SINFO=$$SITE^VASITE 99 ; Station Number 100 S SITE=$P(SINFO,U,3) 101 ; Institution 102 S INST=$P(SINFO,U) 103 ; 104 ; Get institution mailing address 105 I INST D 106 . S DIC4=$G(^DIC(4,INST,4)) 107 . S XUSNP(7)=$P(DIC4,U) 108 . S XUSNP(8)=$P(DIC4,U,2) 109 . S XUSNP(9)=$P(DIC4,U,3) 110 . S XUSNP(10)=$P(DIC4,U,4) 111 . I XUSNP(10) S XUSNP(10)=$P($G(^DIC(5,XUSNP(10),0)),U,2) 112 . S XUSNP(11)=$P(DIC4,U,5) 113 . S INSMAIL=XUSNP(7)_U_XUSNP(8)_U_XUSNP(9)_U_XUSNP(10)_U_XUSNP(11) 114 S XUSHDR="Station: "_SITE_U_XUSNP(9)_U_XUSNP(10)_U_XUSNP(11)_U_"TYPE 1"_U_XUSVER 115 ; 116 Q 117 ; 118 PROC1(XUSRTN,XUSPROD,XUSVER,DTTM,INSMAIL) ;Process all New Person records 119 N XUSNPI,XUSDT,XUSNEW,XUSI,XUSDATA,XUSVA0,XUSVA0,XUSVA1,XUSNAME,XUSDOB,XUSDIV,XUSSTL,XUSSTLN,XUSOPN 120 N XUSPER,XUSSPC,XUSTAX,XUSTAXID,XUSIZE,NPIEN,DIC4,SPDIV,VA12,VA13,COUNT,MSGCNT,MAXSIZE,TOTREC,XUSEOL 121 ; 122 ; Set to 300000 for live 123 S MAXSIZE=300000 124 ; 125 ; Set end of line character 126 S XUSEOL="~~" 127 ; 128 ; set counter 129 S COUNT=1,(TOTREC,MSGCNT,XUSIZE)=0 130 ; Loop through NEW PERSON NPI records NPI cross ref 131 S XUSNPI=0 132 F S XUSNPI=$O(^VA(200,"ANPI",XUSNPI)) Q:'XUSNPI D 133 . S NPIEN=$O(^VA(200,"ANPI",XUSNPI,"")) 134 . ; 135 . ; Init columns 136 . F XUSI=1:1:29 S XUSNP(XUSI)="" 137 . S XUSNP(1)=XUSNPI S XUSDATA1=XUSNP(1) 138 . ; 139 . S XUSVA0=$G(^VA(200,NPIEN,0)) 140 . S XUSVA1=$G(^VA(200,NPIEN,1)) 141 . S XUSNAME=$P(XUSVA0,U) 142 . ; BREAK NAME INTO COMPONENTS 143 . I XUSNAME'="" D 144 . . ;Begin WorldVistA Change; 07/28/2009 145 . . ;S XLFNC=XUSNAME D FORMAT^XLFNAME7(.XLFNC,,,,0) 146 . . S XLFNC=XUSNAME S XLFNC=$$FORMAT^XLFNAME7(.XLFNC,,,,0) 147 . . ;End WorldVistA change 148 . . S XUSNP(2)=XLFNC("GIVEN"),XUSNP(3)=XLFNC("MIDDLE"),XUSNP(4)=XLFNC("FAMILY") 149 . . I XLFNC("SUFFIX")'="" S XUSNP(4)=XUSNP(4)_" "_XLFNC("SUFFIX") 150 . . K XLFNC 151 . S XUSDATA1=XUSDATA1_U_XUSNP(2)_U_XUSNP(3)_U_XUSNP(4) 152 . S XUSNP(5)=1 ;TYPE 153 . S XUSDOB=$P(XUSVA1,U,3) 154 . ; dob formatted as mm/dd/yyyy 155 . I XUSDOB D 156 . . S XUSNP(6)=$$FMTE^XLFDT(XUSDOB,5) 157 . S XUSDATA1=XUSDATA1_U_XUSNP(5)_U_XUSNP(6) 158 . ; 159 . ; Pay to Provider Address Use primary institution mailing address NP7-11 160 . S XUSDATA1=XUSDATA1_U_INSMAIL 161 . ; 162 . ; Servicing Provider Address 163 . S (XUSDIV)=0 164 . ; Loop through Division multiple 165 . F S XUSDIV=$O(^VA(200,NPIEN,2,XUSDIV)) Q:'XUSDIV D 166 . . S DIC4=$G(^DIC(4,XUSDIV,4)) 167 . . S XUSNP(12)=$P(DIC4,U) 168 . . S XUSNP(13)=$P(DIC4,U,2) 169 . . S XUSNP(14)=$P(DIC4,U,3) 170 . . S XUSNP(15)=$P(DIC4,U,4) 171 . . I XUSNP(15) S XUSNP(15)=$P($G(^DIC(5,XUSNP(15),0)),U,2) 172 . . S XUSNP(16)=$P(DIC4,U,5) 173 . . S XUSSTA(XUSDIV)=$P($G(^DIC(4,XUSDIV,99)),U) 174 . . S SPADR(XUSDIV)=XUSNP(12)_U_XUSNP(13)_U_XUSNP(14)_U_XUSNP(15)_U_XUSNP(16) 175 . ; If no divisions found 176 . I '$D(SPADR) D 177 . . S XUSSTA(9999)="N/A",SPADR(9999)=XUSNP(12)_U_XUSNP(13)_U_XUSNP(14)_U_XUSNP(15)_U_XUSNP(16) 178 . ; 179 . ; Office Phone number 180 . S XUSOPN=$P($G(^VA(200,NPIEN,.13)),U,2) 181 . I XUSOPN'="" S XUSNP(17)=XUSOPN 182 . ; 183 . ; Degree 184 . S XUSNP(18)=$P($G(^VA(200,NPIEN,3.1)),U,6) 185 . ; Degree Code (place holder) 186 . S XUSNP(19)="" 187 . ; 188 . ; get taxonomy and specialty 189 . S XUSPER=0 190 . F S XUSPER=$O(^VA(200,NPIEN,"USC1","B",XUSPER)) Q:'XUSPER D 191 . . S XUSSPC=$P($G(^USC(8932.1,XUSPER,0)),U,9) 192 . . S XUSTAX=$P($G(^USC(8932.1,XUSPER,0)),U,7) 193 . . I XUSSPC'="" D 194 . . . I XUSNP(20)="" S XUSNP(20)=XUSSPC Q 195 . . . S XUSNP(20)=XUSNP(20)_";"_XUSSPC 196 . . I XUSTAX'="" D 197 . . . I XUSNP(21)="" S XUSNP(21)=XUSTAX Q 198 . . . S XUSNP(21)=XUSNP(21)_";"_XUSTAX 199 . ; 200 . ; Tax ID 201 . S XUSTAXID=$P($G(^VA(200,NPIEN,"TPB")),U,2) 202 . I XUSTAXID="" S XUSTAXID=$P($G(^VA(200,NPIEN,1)),U,9) 203 . S XUSNP(22)=XUSTAXID 204 . ; 205 . S XUSDATA2=XUSNP(17)_U_XUSNP(18)_U_XUSNP(19)_U_XUSNP(20)_U_XUSNP(21)_U_XUSNP(22) 206 . ; 207 . ; Medicare Part A/B 208 . S XUSNP(23)=670899 209 . S XUSNP(24)="VA"_$E(SITE+10000,2,5) 210 . ; 211 . ; State License 212 . S XUSSTL=0 213 . F S XUSSTL=$O(^VA(200,NPIEN,"PS1",XUSSTL)) Q:'XUSSTL D 214 . . S XUSSTLN=$P($G(^VA(200,NPIEN,"PS1",XUSSTL,0)),U,2) 215 . . I XUSSTLN'="" D 216 . . . I XUSNP(25)="" S XUSNP(25)=XUSSTLN Q 217 . . . S XUSNP(25)=XUSNP(25)_";"_XUSSTLN 218 . ; DEA # 219 . S XUSNP(26)=$P($G(^VA(200,NPIEN,"PS")),U,2) 220 . ; 221 . S XUSDATA2=XUSDATA2_U_XUSNP(23)_U_XUSNP(24)_U_XUSNP(25)_U_XUSNP(26) 222 . ; 223 . ; Station # 224 . S XUSNP(27)="" 225 . ; 226 . ; Get BCBS Payer ID Array 227 . K XUSBXID 228 . D PRACID^XUSNPIXU(NPIEN,.XUSBXID) 229 . ; 230 . ; Save entry to ^TMP and update count 231 . N XUSB 232 . S XUSDIV=0 233 . F S XUSDIV=$O(SPADR(XUSDIV)) Q:'XUSDIV D 234 . . S COUNT=COUNT+1,TOTREC=TOTREC+1 235 . . S ^TMP(XUSRTN,$J,COUNT)=XUSDATA1_U_SPADR(XUSDIV)_U_XUSDATA2_U_XUSSTA(XUSDIV)_U_XUSEOL 236 . . S XUSIZE=XUSIZE+$L(^TMP(XUSRTN,$J,COUNT)) 237 . . ; Check BCBS Id array 238 . . I $D(XUSBXID) D 239 . . . S XUSB="" 240 . . . F S XUSB=$O(XUSBXID(XUSB)) Q:XUSB="" D 241 . . . . S COUNT=COUNT+1,TOTREC=TOTREC+1 242 . . . . S ^TMP(XUSRTN,$J,COUNT)=XUSDATA1_U_SPADR(XUSDIV)_U_XUSDATA2_U_XUSSTA(XUSDIV)_U_XUSB_U_XUSEOL 243 . . . . S XUSIZE=XUSIZE+$L(^TMP(XUSRTN,$J,COUNT)) 244 . K XUSNP,XUSDATA1,XUSDATA2,XUSDATA3,SPADR,XUSBXID,CNT,XUSSTA 245 . I XUSIZE>MAXSIZE D 246 . . D EOF(XUSRTN) 247 . . D EMAIL^XUSNPIX5(XUSRTN) 248 . . K ^TMP(XUSRTN,$J) 249 . . S ^TMP("XUSNPIXS",$J,1,MSGCNT)="1^"_(COUNT-2) 250 . . S ^TMP(XUSRTN,$J,1)=XUSHDR 251 . . S COUNT=1,XUSIZE=0 252 D EOF(XUSRTN) 253 ; 254 ; Send the last message (if it has records) 255 I $G(COUNT)>1 D 256 .D EMAIL^XUSNPIX5(XUSRTN) 257 .K ^TMP(XUSRTN,$J) 258 .S ^TMP("XUSNPIXS",$J,1,MSGCNT)="1^"_(COUNT-2) 259 ; 260 ; Set summary totals 261 S ^XTMP("XUSNPIXT",0)=(DT+10000)_U_DT_U_"NPI EXTRACT SUMMARY TOTALS"_U_DT_U_$H 262 S ^XTMP("XUSNPIXT","H")=$P(XUSHDR,U,1,4) 263 S ^XTMP("XUSNPIXT",1)=MSGCNT_U_TOTREC_U_DTTM 264 K INSMAIL,SITE 265 Q 266 ; 267 EOF(XUSRTN) ; 268 Q:COUNT=1 269 S MSGCNT=MSGCNT+1 270 S ^TMP(XUSRTN,$J,1)=XUSHDR_U_"Message Number: "_MSGCNT_U_"Line Count: "_COUNT_U_DTTM_U_$G(XUSPROD)_U_XUSEOL 271 S COUNT=COUNT+1 272 S ^TMP(XUSRTN,$J,COUNT)="END OF FILE"_U_XUSEOL 273 Q 1 XUSNPIX1 ;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="XUSNPIX1" (current routine name, used for ^XTMP and ^TMP 11 ; storage subscript) 12 ; Storage Global: 13 ; ^XTMP("XUSNPIX1",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("XUSNPIX1",1) = DATA 23 ; 24 ; XUSNPI => Unique NPI of entry 25 ; LDT => Last Date Run, VA Fileman Format 26 ; 27 ; Entry Point - TASKMAN => Run report in background using TASKMAN 28 ; 29 Q 30 ; 31 TASKMAN ;TASKMAN ENTRY POINT 32 ; Process Report 33 N XUSRTN,DTTM 34 ; Check for required variables 35 I $G(U)=""!($G(DT)="") G EXIT 36 S XUSRTN="XUSNPIX1" 37 S DTTM=$$HTE^XLFDT($H,"2") 38 ; Check to see if report is in use 39 L +^XTMP(XUSRTN):5 I '$T G EXIT 40 ; 41 D INIT(XUSRTN) 42 ; Pull Station(Institution) data 43 D INST(XUSRTN) 44 ; 45 D PROC1(XUSRTN) 46 ; Send the message 47 D EMAIL^XUSNPIX5(XUSRTN) 48 D VMAIL^XUSNPIX5(XUSRTN) 49 ; 50 ; Process Institution File 51 D ENT^XUSNPIX2 52 ; 53 ; Process Non VA File 54 D ENT^XUSNPIX3 55 ; 56 ; Send summary message 57 D SMAIL^XUSNPIX5("XUSNPIXT") 58 ; 59 ;Standard EXIT point 60 EXIT ; 61 K XUSEOL,DTTM,MAXSIZE,XUSVER,XUSHDR,XUSPROD 62 K MSGCNT,TOTREC,COUNT 63 K ^TMP("XUSNPIXU",$J) 64 ; Log Run Completion Time 65 S $P(^XTMP(XUSRTN,0),U,6)=$H 66 L -^XTMP(XUSRTN) 67 ; 68 Q 69 ; 70 INIT(XUSRTN) ; check/init variables 71 N XUSDESC 72 ; Set to NEXT release version from NPM 73 S XUSVER="453.16" 74 ; Get production/test account flag 75 S XUSPROD=$S($$PROD^XUPROD(1):"PROD",1:"TEST") 76 ; Set end of line character 77 S XUSEOL="~~" 78 ; Set to 300000 for live 79 S MAXSIZE=300000 80 ; Reset Temporary Scratch Global 81 D INIT^XUSNPIXU 82 K ^TMP(XUSRTN) 83 S XUSDESC="NPI EXTRACT TYPE 1 - Do Not Delete" 84 S ^XTMP(XUSRTN,0)=(DT+10000)_U_DT_U_XUSDESC_U_DT_U_$H 85 ; Generate TMP BCBS Array 86 D BCBSID^XUSNPIXU 87 ; 88 Q 89 ; 90 INST(XUSRTN) ;Pull station and Institution info 91 N INST,SINFO,DIC4 92 ; Pull site info 93 S SINFO=$$SITE^VASITE 94 ; Station Number 95 S SITE=$P(SINFO,U,3) 96 ; Institution 97 S INST=$P(SINFO,U) 98 ; 99 ; Get institution mailing address 100 I INST D 101 . S DIC4=$G(^DIC(4,INST,4)) 102 . S XUSNP(7)=$P(DIC4,U) 103 . S XUSNP(8)=$P(DIC4,U,2) 104 . S XUSNP(9)=$P(DIC4,U,3) 105 . S XUSNP(10)=$P(DIC4,U,4) 106 . I XUSNP(10) S XUSNP(10)=$P($G(^DIC(5,XUSNP(10),0)),U,2) 107 . S XUSNP(11)=$P(DIC4,U,5) 108 . S INSMAIL=XUSNP(7)_U_XUSNP(8)_U_XUSNP(9)_U_XUSNP(10)_U_XUSNP(11) 109 S XUSHDR="Station: "_SITE_U_XUSNP(9)_U_XUSNP(10)_U_XUSNP(11)_U_"TYPE 1"_U_XUSVER 110 ; 111 Q 112 ; 113 PROC1(XUSRTN) ;Process all New Person records 114 N XUSNPI,XUSDT,XUSNEW,XUSI,XUSDATA,XUSVA0,XUSVA0,XUSVA1,XUSNAME,XUSDOB,XUSDIV,XUSSTL,XUSSTLN,XUSOPN 115 N XUSPER,XUSSPC,XUSTAX,XUSTAXID,XUSIZE,NPIEN,DIC4,SPDIV,VA12,VA13 116 ; set counter 117 S COUNT=1,(TOTREC,MSGCNT,XUSIZE)=0 118 ; Loop through NEW PERSON NPI records NPI cross ref 119 S XUSNPI=0 120 F S XUSNPI=$O(^VA(200,"ANPI",XUSNPI)) Q:'XUSNPI D 121 . S NPIEN=$O(^VA(200,"ANPI",XUSNPI,"")) 122 . ; 123 . ; Init columns 124 . F XUSI=1:1:29 S XUSNP(XUSI)="" 125 . S XUSNP(1)=XUSNPI S XUSDATA1=XUSNP(1) 126 . ; 127 . S XUSVA0=$G(^VA(200,NPIEN,0)) 128 . S XUSVA1=$G(^VA(200,NPIEN,1)) 129 . S XUSNAME=$P(XUSVA0,U) 130 . ; BREAK NAME INTO COMPONENTS 131 . I XUSNAME'="" D 132 . . S XLFNC=XUSNAME D FORMAT^XLFNAME7(.XLFNC,,,,0) 133 . . S XUSNP(2)=XLFNC("GIVEN"),XUSNP(3)=XLFNC("MIDDLE"),XUSNP(4)=XLFNC("FAMILY") 134 . . I XLFNC("SUFFIX")'="" S XUSNP(4)=XUSNP(4)_" "_XLFNC("SUFFIX") 135 . . K XLFNC 136 . S XUSDATA1=XUSDATA1_U_XUSNP(2)_U_XUSNP(3)_U_XUSNP(4) 137 . S XUSNP(5)=1 ;TYPE 138 . S XUSDOB=$P(XUSVA1,U,3) 139 . ; dob formatted as mm/dd/yyyy 140 . I XUSDOB D 141 . . S XUSNP(6)=$$FMTE^XLFDT(XUSDOB,5) 142 . S XUSDATA1=XUSDATA1_U_XUSNP(5)_U_XUSNP(6) 143 . ; 144 . ; Pay to Provider Address Use primary institution mailing address NP7-11 145 . S XUSDATA1=XUSDATA1_U_INSMAIL 146 . ; 147 . ; Servicing Provider Address 148 . S (XUSDIV)=0 149 . ; Loop through Division multiple 150 . F S XUSDIV=$O(^VA(200,NPIEN,2,XUSDIV)) Q:'XUSDIV D 151 . . S DIC4=$G(^DIC(4,XUSDIV,4)) 152 . . S XUSNP(12)=$P(DIC4,U) 153 . . S XUSNP(13)=$P(DIC4,U,2) 154 . . S XUSNP(14)=$P(DIC4,U,3) 155 . . S XUSNP(15)=$P(DIC4,U,4) 156 . . I XUSNP(15) S XUSNP(15)=$P($G(^DIC(5,XUSNP(15),0)),U,2) 157 . . S XUSNP(16)=$P(DIC4,U,5) 158 . . S XUSSTA(XUSDIV)=$P($G(^DIC(4,XUSDIV,99)),U) 159 . . S SPADR(XUSDIV)=XUSNP(12)_U_XUSNP(13)_U_XUSNP(14)_U_XUSNP(15)_U_XUSNP(16) 160 . ; If no divisions found 161 . I '$D(SPADR) D 162 . . S XUSSTA(9999)="N/A",SPADR(9999)=XUSNP(12)_U_XUSNP(13)_U_XUSNP(14)_U_XUSNP(15)_U_XUSNP(16) 163 . ; 164 . ; Office Phone number 165 . S XUSOPN=$P($G(^VA(200,NPIEN,.13)),U,2) 166 . I XUSOPN'="" S XUSNP(17)=XUSOPN 167 . ; 168 . ; Degree 169 . S XUSNP(18)=$P($G(^VA(200,NPIEN,3.1)),U,6) 170 . ; Degree Code (place holder) 171 . S XUSNP(19)="" 172 . ; 173 . ; get taxonomy and specialty 174 . S XUSPER=0 175 . F S XUSPER=$O(^VA(200,NPIEN,"USC1","B",XUSPER)) Q:'XUSPER D 176 . . S XUSSPC=$P($G(^USC(8932.1,XUSPER,0)),U,9) 177 . . S XUSTAX=$P($G(^USC(8932.1,XUSPER,0)),U,7) 178 . . I XUSSPC'="" D 179 . . . I XUSNP(20)="" S XUSNP(20)=XUSSPC Q 180 . . . S XUSNP(20)=XUSNP(20)_";"_XUSSPC 181 . . I XUSTAX'="" D 182 . . . I XUSNP(21)="" S XUSNP(21)=XUSTAX Q 183 . . . S XUSNP(21)=XUSNP(21)_";"_XUSTAX 184 . ; 185 . ; Tax ID 186 . S XUSTAXID=$P($G(^VA(200,NPIEN,"TPB")),U,2) 187 . I XUSTAXID="" S XUSTAXID=$P($G(^VA(200,NPIEN,1)),U,9) 188 . S XUSNP(22)=XUSTAXID 189 . ; 190 . S XUSDATA2=XUSNP(17)_U_XUSNP(18)_U_XUSNP(19)_U_XUSNP(20)_U_XUSNP(21)_U_XUSNP(22) 191 . ; 192 . ; Medicare Part A/B 193 . S XUSNP(23)=670899 194 . S XUSNP(24)="VA"_$E(SITE+10000,2,5) 195 . ; 196 . ; State License 197 . S XUSSTL=0 198 . F S XUSSTL=$O(^VA(200,NPIEN,"PS1",XUSSTL)) Q:'XUSSTL D 199 . . S XUSSTLN=$P($G(^VA(200,NPIEN,"PS1",XUSSTL,0)),U,2) 200 . . I XUSSTLN'="" D 201 . . . I XUSNP(25)="" S XUSNP(25)=XUSSTLN Q 202 . . . S XUSNP(25)=XUSNP(25)_";"_XUSSTLN 203 . ; DEA # 204 . S XUSNP(26)=$P($G(^VA(200,NPIEN,"PS")),U,2) 205 . ; 206 . S XUSDATA2=XUSDATA2_U_XUSNP(23)_U_XUSNP(24)_U_XUSNP(25)_U_XUSNP(26) 207 . ; 208 . ; Station # 209 . S XUSNP(27)="" 210 . ; 211 . ; Get BCBS Payer ID Array 212 . K XUSBXID 213 . D PRACID^XUSNPIXU(NPIEN,.XUSBXID) 214 . ; 215 . ; Save entry to ^TMP and update count 216 . N XUSB 217 . S XUSDIV=0 218 . F S XUSDIV=$O(SPADR(XUSDIV)) Q:'XUSDIV D 219 . . S COUNT=COUNT+1,TOTREC=TOTREC+1 220 . . S ^TMP(XUSRTN,$J,COUNT)=XUSDATA1_U_SPADR(XUSDIV)_U_XUSDATA2_U_XUSSTA(XUSDIV)_U_XUSEOL 221 . . S XUSIZE=XUSIZE+$L(^TMP(XUSRTN,$J,COUNT)) 222 . . ; Check BCBS Id array 223 . . I $D(XUSBXID) D 224 . . . S XUSB="" 225 . . . F S XUSB=$O(XUSBXID(XUSB)) Q:XUSB="" D 226 . . . . S COUNT=COUNT+1,TOTREC=TOTREC+1 227 . . . . S ^TMP(XUSRTN,$J,COUNT)=XUSDATA1_U_SPADR(XUSDIV)_U_XUSDATA2_U_XUSSTA(XUSDIV)_U_XUSB_U_XUSEOL 228 . . . . S XUSIZE=XUSIZE+$L(^TMP(XUSRTN,$J,COUNT)) 229 . K XUSNP,XUSDATA1,XUSDATA2,XUSDATA3,SPADR,XUSBXID,CNT,XUSSTA 230 . I XUSIZE>MAXSIZE D 231 . . D EOF(XUSRTN) 232 . . D EMAIL^XUSNPIX5(XUSRTN) 233 . . D VMAIL^XUSNPIX5(XUSRTN) 234 . . S ^TMP(XUSRTN,$J,1)=XUSHDR 235 . . S COUNT=1,XUSIZE=0 236 D EOF(XUSRTN) 237 ; set summary totals 238 S ^XTMP("XUSNPIXT",0)=(DT+10000)_U_DT_U_"NPI EXTRACT SUMMARY TOTALS"_U_DT_U_$H 239 S ^XTMP("XUSNPIXT","H")=$P(XUSHDR,U,1,4) 240 S ^XTMP("XUSNPIXT",1)=MSGCNT_U_TOTREC_U_DTTM 241 K INSMAIL,SITE 242 Q 243 ; 244 EOF(XUSRTN) ; 245 S MSGCNT=MSGCNT+1 246 S ^TMP(XUSRTN,$J,1)=XUSHDR_U_"Message Number: "_MSGCNT_U_"Line Count: "_COUNT_U_DTTM_U_$G(XUSPROD)_U_XUSEOL 247 S COUNT=COUNT+1 248 S ^TMP(XUSRTN,$J,COUNT)="END OF FILE"_U_XUSEOL 249 Q
Note:
See TracChangeset
for help on using the changeset viewer.
