237 lines
6.7 KiB
Mathematica
237 lines
6.7 KiB
Mathematica
XUSNPIX4 ;OAK_BP/CMW - NPI EXTRACT REPORT ;01-OCT-06
|
|
;;8.0;KERNEL;**438,452,453**; Jul 10, 1995;Build 36
|
|
;;Per VHA Directive 10-93-142, this routine should not be modified.
|
|
;
|
|
; NPI Extract Report
|
|
;
|
|
; Input parameter: N/A
|
|
;
|
|
; Other relevant variables:
|
|
; XUSRTN="XUSNPIX1NV" (current routine name, used for ^XTMP and ^TMP
|
|
; XUSRTN="XUSNPIX2NV" storage subscript)
|
|
; Storage Global:
|
|
; ^XTMP("XUSNPIX1VA",0) = Piece 1^Piece 2^Piece 3^Piece 4^Piece 5^Piece 6
|
|
; ^XTMP("XUSNPIX2VA",0)
|
|
; where:
|
|
; Piece 1 => Purge Date - 1 year in future
|
|
; Piece 2 => Create Date - Today
|
|
; Piece 3 => Description
|
|
; Piece 4 => Last Date Compiled
|
|
; Piece 5 => $H last run start time
|
|
; Piece 6 => $H last run completion time
|
|
;
|
|
; Entry Point - ENT called from XUSNPIX1
|
|
;
|
|
Q
|
|
;
|
|
; Individual records
|
|
TYPE1 ;
|
|
N IBA0,NVIEN,XUSNPI
|
|
N XUSI,XUSNM,XUSNV,XLFNC,XUSIZE,XUSDT,XUSNEW
|
|
N TOTREC1,TOTREC2
|
|
S XUSCNT=1,(TOTREC1,MSGCNT,XUSIZE)=0
|
|
S XUSNPI=""
|
|
F S XUSNPI=$O(^TMP("XUSNPI",$J,1,XUSNPI)) Q:'XUSNPI D
|
|
. S XUSDATA=XUSNPI
|
|
. S NVIEN=$G(^TMP("XUSNPI",$J,1,XUSNPI))
|
|
. ;
|
|
. F XUSI=1:1:29 S XUSNV(XUSI)=""
|
|
. S IBA0=$G(^IBA(355.93,NVIEN,0))
|
|
. S XUSNM=$P(IBA0,U)
|
|
. ; Break Name into components
|
|
. I XUSNM'="" D
|
|
. . S XLFNC=XUSNM D FORMAT^XLFNAME7(.XLFNC,,,,0)
|
|
. . S XUSNV(2)=XLFNC("GIVEN"),XUSNV(3)=XLFNC("MIDDLE"),XUSNV(4)=XLFNC("FAMILY")
|
|
. . I XLFNC("SUFFIX")'="" S XUSNV(4)=XUSNV(4)_" "_XLFNC("SUFFIX")
|
|
. . K XLFNC
|
|
. S XUSDATA=XUSDATA_U_XUSNV(2)_U_XUSNV(3)_U_XUSNV(4)
|
|
. S XUSNV(5)=1 ;TYPE
|
|
. ;
|
|
. ; DOB (place holder)
|
|
. S XUSNV(6)=""
|
|
. S XUSDATA=XUSDATA_U_XUSNV(5)_U_XUSNV(6)
|
|
. ;
|
|
. ; Pay to Provider Address (7-11)
|
|
. S XUSDATA=XUSDATA_U_PTPMAIL
|
|
. ;
|
|
. ; Servicing Provider Address
|
|
. S XUSNV(12)=$P(IBA0,U,5)
|
|
. S XUSNV(13)=$P(IBA0,U,10)
|
|
. S XUSNV(14)=$P(IBA0,U,6)
|
|
. S XUSNV(15)=$P(IBA0,U,7)
|
|
. I XUSNV(15) S XUSNV(15)=$P($G(^DIC(5,XUSNV(12),0)),U,2)
|
|
. S XUSNV(16)=$P(IBA0,U,8)
|
|
. S XUSDATA=XUSDATA_U_XUSNV(12)_U_XUSNV(13)_U_XUSNV(14)_U_XUSNV(15)_U_XUSNV(16)
|
|
. ;
|
|
. ; Office Phone number (place holder)
|
|
. S XUSNV(17)=""
|
|
. ;
|
|
. ; Degree Description / Degree Code (place holder)
|
|
. S XUSNV(18)=""
|
|
. S XUSNV(19)=""
|
|
. ;
|
|
. ; Get Taxonomy and specialty codes
|
|
. N NVTX,NVSPC,NVTAX
|
|
. S NVTX=0
|
|
. F S NVTX=$O(^IBA(355.93,NVIEN,"TAXONOMY","B",NVTX)) Q:'NVTX D
|
|
. . S NVSPC=$P($G(^USC(8932.1,NVTX,0)),U,9)
|
|
. . S NVTAX=$P($G(^USC(8932.1,NVTX,0)),U,7)
|
|
. . I NVSPC'="" D
|
|
. . . I XUSNV(20)="" S XUSNV(20)=NVSPC Q
|
|
. . . S XUSNV(20)=XUSNV(20)_";"_NVSPC
|
|
. . I NVTAX'="" D
|
|
. . . I XUSNV(21)="" S XUSNV(21)=NVTAX Q
|
|
. . . S XUSNV(21)=XUSNV(21)_";"_NVTAX
|
|
. ;
|
|
. ; Fed tax ID
|
|
. S XUSNV(22)=$P($G(IBA0),U,9)
|
|
. ;
|
|
. S XUSDATA=XUSDATA_U_XUSNV(17)_U_XUSNV(18)_U_XUSNV(19)_U_XUSNV(20)_U_XUSNV(21)_U_XUSNV(22)
|
|
. ;
|
|
. ; Medicare Part A/B
|
|
. S XUSNV(23)=670899
|
|
. S XUSNV(24)="VA"_$E(SITE+10000,2,5)
|
|
. ;
|
|
. ; State Lic and DEA (place holder)
|
|
. S XUSNV(25)=""
|
|
. S XUSNV(26)=""
|
|
. ;
|
|
. ; VISN Station
|
|
. S XUSNV(27)=SITE
|
|
. ;
|
|
. S XUSDATA=XUSDATA_U_XUSNV(23)_U_XUSNV(24)_U_XUSNV(25)_U_XUSNV(26)_U_XUSNV(27)
|
|
. ;
|
|
. ;BCBS info
|
|
. K XUSBXID
|
|
. D NNVAID^XUSNPIXU(NVIEN,.XUSBXID)
|
|
. ;
|
|
. ;Update counter and save Entry
|
|
. N XUSB
|
|
. S XUSCNT=XUSCNT+1,TOTREC1=TOTREC1+1
|
|
. S ^TMP(XUSRTN,$J,XUSCNT)=XUSDATA_U_XUSEOL
|
|
. S XUSIZE=XUSIZE+$L(^TMP(XUSRTN,$J,XUSCNT))
|
|
. I $D(XUSBXID) D
|
|
. . S XUSB=""
|
|
. . F S XUSB=$O(XUSBXID(XUSB)) Q:XUSB="" D
|
|
. . . S XUSCNT=XUSCNT+1,TOTREC1=TOTREC1+1
|
|
. . . S ^TMP(XUSRTN,$J,XUSCNT)=XUSDATA_U_XUSB_U_XUSEOL
|
|
. . . S XUSIZE=XUSIZE+$L(^TMP(XUSRTN,$J,XUSCNT))
|
|
. I XUSIZE>MAXSIZE D
|
|
. . D EOF1(XUSRTN)
|
|
. . D EMAIL^XUSNPIX3(XUSRTN)
|
|
. . D VMAIL^XUSNPIX3(XUSRTN)
|
|
. . S ^TMP(XUSRTN,$J,1)=XUSHDR
|
|
. . S XUSCNT=1,XUSIZE=0
|
|
. K XUSNV,XUSDATA,XUSBXID
|
|
;
|
|
D EOF1(XUSRTN)
|
|
S ^XTMP("XUSNPIXT","1NV")=MSGCNT_U_TOTREC1_U_DTTM3
|
|
Q
|
|
;
|
|
EOF1(XUSRTN) ;
|
|
S MSGCNT=MSGCNT+1
|
|
S ^TMP(XUSRTN,$J,1)=XUSHDR_U_"Message Number: "_MSGCNT_U_"Line Count: "_XUSCNT_U_DTTM3_U_$G(XUSPROD)_U_XUSEOL
|
|
S XUSCNT=XUSCNT+1
|
|
S ^TMP(XUSRTN,$J,XUSCNT)="END OF FILE"_U_XUSEOL
|
|
Q
|
|
;
|
|
TYPE2 ;Facility/Group
|
|
N IBA0,NVIEN,XUSNPI
|
|
N XUSNV,XUSI,XUSNM,XLFNC,MSGCNT,XUSIZE,XUSDT,XUSNEW
|
|
S XUSNPI=""
|
|
S XUSCNT=1,(TOTREC2,MSGCNT,XUSIZE)=0
|
|
F S XUSNPI=$O(^TMP("XUSNPI",$J,2,XUSNPI)) Q:'XUSNPI D
|
|
. S XUSDATA=XUSNPI
|
|
. S NVIEN=$G(^TMP("XUSNPI",$J,2,XUSNPI))
|
|
. ;
|
|
. F XUSI=1:1:24 S XUSNV(XUSI)=""
|
|
. S IBA0=$G(^IBA(355.93,NVIEN,0))
|
|
. ;Get Organization name
|
|
. S XUSNV(2)=$P(IBA0,U)
|
|
. ;Type
|
|
. S XUSNV(3)=2
|
|
. ;
|
|
. S XUSDATA=XUSDATA_U_XUSNV(2)_U_XUSNV(3)
|
|
. ;
|
|
. ; Pay to Provider Address (4-8)
|
|
. S XUSDATA=XUSDATA_U_PTPMAIL
|
|
. ;
|
|
. ; Servicing Provider Address
|
|
. S XUSNV(9)=$P(IBA0,U,5)
|
|
. S XUSNV(10)=$P(IBA0,U,10)
|
|
. S XUSNV(11)=$P(IBA0,U,6)
|
|
. S XUSNV(12)=$P(IBA0,U,7)
|
|
. I XUSNV(12) S XUSNV(12)=$P($G(^DIC(5,XUSNV(12),0)),U,2)
|
|
. S XUSNV(13)=$P(IBA0,U,8)
|
|
. S XUSDATA=XUSDATA_U_XUSNV(9)_U_XUSNV(10)_U_XUSNV(11)_U_XUSNV(12)_U_XUSNV(13)
|
|
. ;
|
|
. ;Office Phone number (place holder)
|
|
. S XUSNV(14)=""
|
|
. ;
|
|
. ; get Taxonomy and Specialty
|
|
. N NVTX,NVSPC,NVTAX
|
|
. S NVTX=0
|
|
. F S NVTX=$O(^IBA(355.93,NVIEN,"TAXONOMY","B",NVTX)) Q:'NVTX D
|
|
. . S NVSPC=$P($G(^USC(8932.1,NVTX,0)),U,9)
|
|
. . S NVTAX=$P($G(^USC(8932.1,NVTX,0)),U,7)
|
|
. . I NVSPC'="" D
|
|
. . . I XUSNV(15)="" S XUSNV(15)=NVSPC Q
|
|
. . . S XUSNV(15)=XUSNV(15)_";"_NVSPC
|
|
. . I NVTAX'="" D
|
|
. . . I XUSNV(16)="" S XUSNV(16)=NVTAX Q
|
|
. . . S XUSNV(16)=XUSNV(16)_";"_NVTAX
|
|
. ;
|
|
. ; Fed Tax ID
|
|
. S XUSNV(17)=$P($G(IBA0),U,9)
|
|
. ;
|
|
. ;Medicare A/B
|
|
. S XUSNV(18)=670899
|
|
. S XUSNV(19)="VA"_$E(SITE+10000,2,5)
|
|
. ;
|
|
. S XUSDATA=XUSDATA_U_XUSNV(14)_U_XUSNV(15)_U_XUSNV(16)_U_XUSNV(17)_U_XUSNV(18)_U_XUSNV(19)
|
|
. ;
|
|
. ;State License Number
|
|
. S XUSNV(20)=$P($G(IBA0),U,12)
|
|
. ;
|
|
. ;DEA Number (place holder)
|
|
. S XUSNV(21)=""
|
|
. ;
|
|
. ;VISN STATION ID
|
|
. S XUSNV(22)=SITE
|
|
. ;
|
|
. S XUSDATA=XUSDATA_U_XUSNV(20)_U_XUSNV(21)_U_XUSNV(22)
|
|
. ;
|
|
. ;BCBS info
|
|
. K XUSBXID
|
|
. D NNVAID^XUSNPIXU(NVIEN,.XUSBXID)
|
|
. ;
|
|
. ;Update counter and save Entry
|
|
. N XUSB
|
|
. S XUSCNT=XUSCNT+1,TOTREC2=TOTREC2+1
|
|
. S ^TMP(XUSRTN,$J,XUSCNT)=XUSDATA_U_XUSEOL
|
|
. S XUSIZE=XUSIZE+$L(^TMP(XUSRTN,$J,XUSCNT))
|
|
. I $D(XUSBXID) D
|
|
. . S XUSB=""
|
|
. . F S XUSB=$O(XUSBXID(XUSB)) Q:XUSB="" D
|
|
. . . S XUSCNT=XUSCNT+1,TOTREC2=TOTREC2+1
|
|
. . . S ^TMP(XUSRTN,$J,XUSCNT)=XUSDATA_U_XUSB_U_XUSEOL
|
|
. . . S XUSIZE=XUSIZE+$L(^TMP(XUSRTN,$J,XUSCNT))
|
|
. I XUSIZE>MAXSIZE D
|
|
. . D EOF2(XUSRTN)
|
|
. . D EMAIL^XUSNPIX3(XUSRTN)
|
|
. . D VMAIL^XUSNPIX3(XUSRTN)
|
|
. . S ^TMP(XUSRTN,$J,1)=XUSHDR
|
|
. . S XUSCNT=1,XUSIZE=0
|
|
. K XUSNV,XUSDATA,XUSB,XUSBXID
|
|
;
|
|
D EOF2(XUSRTN)
|
|
S ^XTMP("XUSNPIXT","2NV")=MSGCNT_U_TOTREC2_U_DTTM3
|
|
Q
|
|
;
|
|
EOF2(XUSRTN) ;
|
|
S MSGCNT=MSGCNT+1
|
|
S ^TMP(XUSRTN,$J,1)=XUSHDR_U_"Message Number: "_MSGCNT_U_"Line Count: "_XUSCNT_U_DTTM3_U_$G(XUSPROD)_U_XUSEOL
|
|
S XUSCNT=XUSCNT+1
|
|
S ^TMP(XUSRTN,$J,XUSCNT)="END OF FILE"_U_XUSEOL
|
|
Q
|