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