| 1 | XUSNPIX2 ;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 | ;
|
|---|
| 32 | ENT ; 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
|
|---|
| 51 | EXIT ;
|
|---|
| 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 | ;
|
|---|
| 60 | INIT(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 | ;
|
|---|
| 77 | STAT(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 | ;
|
|---|
| 107 | PROC2(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 | ;
|
|---|
| 216 | EOF(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
|
|---|
| 224 | EMAIL(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 | ;
|
|---|
| 232 | VMAIL(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
|
|---|
| 250 | ESEND 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
|
|---|
| 256 | POA(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
|
|---|
| 259 | POA1 ;
|
|---|
| 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 | ;
|
|---|
| 269 | GETPHARM ;
|
|---|
| 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
|
|---|
