XUSNPIX4 ;OAK_BP/CMW/SLT - NPI EXTRACT REPORT ; Aug 30, 2022@04:47:47
;;8.0;KERNEL;**438,452,453,481,528,548,774**; Jul 10, 1995;Build 2
;;Per VHA Directive 2004-038, this routine should not be modified.
;
; Direct access to ^IBE(350.9, fields .02, 1.05, 19;.02, 19;1.01, 19;1.02, 19;1.03, 19;,1.04, 19;1.05 authorized by
; Integration Agreement #4964.
;
; 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(DTTM3,SITE,XUSPROD,XUSHDR,XUSP2P) ;
N IBA0,NVIEN,XUSNPI,MAXSIZE,XUSEOL,XUSCNT
N XUSI,XUSNM,XUSNV,XLFNC,XUSIZE,XUSDT,XUSNEW
N TOTREC1
;
; Set Maximum Message Size
S MAXSIZE=300000
;
; Set end of line character
S XUSEOL="~~"
;
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:33 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)
. . I $G(XLFNC("FAMILY"))="" S XLFNC("FAMILY")=$G(XUSNAME) ;p774
. . S XUSNP(2)=$G(XLFNC("GIVEN")),XUSNP(3)=$G(XLFNC("MIDDLE")),XUSNP(4)=$G(XLFNC("FAMILY")) ;p774
. . I $G(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-12)
. S XUSDATA=XUSDATA_U_XUSP2P
. ;
. ; Servicing Provider Address
. S XUSNV(13)=$P(IBA0,U,5)
. S XUSNV(14)=$P(IBA0,U,10)
. S XUSNV(15)=$P(IBA0,U,6)
. S XUSNV(16)=$P(IBA0,U,7)
. I XUSNV(16) S XUSNV(16)=$P($G(^DIC(5,XUSNV(16),0)),U,2)
. S XUSNV(17)=$P(IBA0,U,8)
. S XUSDATA=XUSDATA_U_XUSNV(13)_U_XUSNV(14)_U_XUSNV(15)_U_XUSNV(16)_U_XUSNV(17)
. ;
. ; Office Phone number (place holder)
. S XUSNV(18)=""
. ;
. ; Degree Description / Degree Code (place holder)
. S XUSNV(19)=""
. S XUSNV(20)=""
. ;
. ; 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(21)="" S XUSNV(21)=NVSPC Q
. . . S XUSNV(21)=XUSNV(21)_";"_NVSPC
. . . Q
. . Q
. ;use "B" cross ref to find primary vs non-primary code 0 (no)!1 (yes), and only "A"'s
. S NVTX=0
. F S NVTX=$O(^IBA(355.93,NVIEN,"TAXONOMY",NVTX)) Q:NVTX'?1N.N D
. . S IBA=$G(^IBA(355.93,NVIEN,"TAXONOMY",NVTX,0))
. . I $P(IBA,U,3)="A" D
. . . I $P(IBA,U,2)=1 S XUSNV(22)=$P($G(^USC(8932.1,$P(IBA,U,1),0)),U,7)
. . . I $P(IBA,U,2)=0 D
. . . . I XUSNV(23)="" S XUSNV(23)=$P($G(^USC(8932.1,$P(IBA,U,1),0)),U,7) Q
. . . . ;
. . . . ; *** Start XU*8.0*548 - RBN ***
. . . . ;
. . . . I (XUSNV(23)'[$P($G(^USC(8932.1,$P(IBA,U,1),0)),U,7))&($P($G(^USC(8932.1,$P(IBA,U,1),0)),U,7)'=XUSNV(22)) D
. . . . . S XUSNV(23)=XUSNV(23)_";"_$P($G(^USC(8932.1,$P(IBA,U,1),0)),U,7)
. . . . . ;
. . . . . ; *** End XU*8.0*548 - RBN ***
. . . . . ;
. . . . Q
. . . Q
. . Q
. K IBA
. ;
. ; Fed tax ID
. S XUSNV(24)=$P($G(IBA0),U,9)
. ;
. S XUSDATA=XUSDATA_U_XUSNV(18)_U_XUSNV(19)_U_XUSNV(20)_U_XUSNV(21)_U_XUSNV(22)
. S XUSDATA=XUSDATA_U_XUSNV(23)_U_XUSNV(24)
. ;
. ; Medicare Part A/B
. S XUSNV(25)=670899
. S XUSNV(26)="VA"_$E(SITE+10000,2,5)
. ;
. ; State Lic and DEA (place holder)
. S XUSNV(27)=""
. S XUSNV(28)=""
. ;
. ; Status and Creation/Termination Date (place holder)
. S XUSNV(29)=""
. S XUSNV(30)=""
. ; VISN Station
. S XUSNV(31)=SITE
. ;
. S XUSDATA=XUSDATA_U_XUSNV(25)_U_XUSNV(26)_U_XUSNV(27)
. S XUSDATA=XUSDATA_U_XUSNV(28)_U_XUSNV(29)_U_XUSNV(30)_U_XUSNV(31)
. ;
. ;BCBS info
. K XUSBXID
. D NNVAID^XUSNPIXU(NVIEN,.XUSBXID)
. ;
. ;Update counter and save Entry
. N XUSB,XUSB1
. 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 XUSB1=$G(XUSBXID(XUSB)) I XUSB1'="" S XUSB1="^"_XUSB1 ;add p 528
. . . S XUSCNT=XUSCNT+1,TOTREC1=TOTREC1+1
. . . S ^TMP(XUSRTN,$J,XUSCNT)=XUSDATA_U_$$TRIM^XLFSTR(XUSB)_XUSB1_U_XUSEOL ;add _XUSB1 p 528
. . . S XUSIZE=XUSIZE+$L(^TMP(XUSRTN,$J,XUSCNT))
. I XUSIZE>MAXSIZE D
. . D EOF1(XUSRTN)
. . D EMAIL^XUSNPIX3(XUSRTN) ;sending the extracted data via MailMan
. . K ^TMP(XUSRTN,$J)
. . S ^TMP("XUSNPIXS",$J,3,MSGCNT)="1 (Non-VA)^"_(XUSCNT-2)
. . S ^TMP(XUSRTN,$J,1)=XUSHDR
. . S XUSCNT=1,XUSIZE=0
. K XUSNV,XUSDATA,XUSBXID
;
D EOF1(XUSRTN)
;
; Send last message (if it has records)
I $G(XUSCNT)>1 D
. D EMAIL^XUSNPIX3(XUSRTN) ;sending the extracted data via MailMan
. K ^TMP(XUSRTN,$J)
. S ^TMP("XUSNPIXS",$J,3,MSGCNT)="1 (Non-VA)^"_($G(XUSCNT)-2)
;
; Update Summary
S ^XTMP("XUSNPIXT","1NV")=MSGCNT_U_TOTREC1_U_DTTM3
Q
;
EOF1(XUSRTN) ;
Q:$G(XUSCNT)=1
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(DTTM3,SITE,XUSPROD,XUSHDR,XUSP2P) ;Facility/Group
N IBA0,NVIEN,XUSNPI,MAXSIZE,XUSEOL,XUSCNT
N XUSNV,XUSI,XUSNM,XLFNC,MSGCNT,XUSIZE,XUSDT,XUSNEW,TOTREC2
;
; Set Maximum Message Size
S MAXSIZE=300000
;
; Set end of line character
S XUSEOL="~~"
;
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-9)
. S XUSDATA=XUSDATA_U_XUSP2P
. ;
. ; Servicing Provider Address
. S XUSNV(10)=$P(IBA0,U,5)
. S XUSNV(11)=$P(IBA0,U,10)
. S XUSNV(12)=$P(IBA0,U,6)
. S XUSNV(13)=$P(IBA0,U,7)
. I XUSNV(13) S XUSNV(13)=$P($G(^DIC(5,XUSNV(13),0)),U,2) ;SLT 9/23/10
. S XUSNV(14)=$P(IBA0,U,8)
. S XUSDATA=XUSDATA_U_XUSNV(10)_U_XUSNV(11)_U_XUSNV(12)_U_XUSNV(13)_U_XUSNV(14)
. ;
. ;Office Phone number (place holder)
. S XUSNV(15)=""
. ;
. ; 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(16)="" S XUSNV(16)=NVSPC Q
. . . S XUSNV(16)=XUSNV(16)_";"_NVSPC
. . I NVTAX'="" D
. . . I XUSNV(17)="" S XUSNV(17)=NVTAX Q
. . . ;
. . . ; *** Start XU*8.0*548 - RBN ***
. . . ;
. . . ;S XUSNV(17)=XUSNV(17)_";"_NVTAX
. . . S:(XUSNV(17)'[NVTAX) XUSNV(17)=XUSNV(17)_";"_NVTAX
. . . ;
. . . ; *** End XU*8.0*548 - RBN ***
. ;
. ; Fed Tax ID
. S XUSNV(18)=$P($G(IBA0),U,9)
. ;
. ;Medicare A/B
. S XUSNV(19)=670899
. S XUSNV(20)="VA"_$E(SITE+10000,2,5)
. ;
. S XUSDATA=XUSDATA_U_XUSNV(15)_U_XUSNV(16)_U_XUSNV(17)_U_XUSNV(18)_U_XUSNV(19)_U_XUSNV(20)
. ;
. ;State License Number
. ;S XUSNV(20)=$P($G(IBA0),U,12)
. ;
. ;DEA Number (place holder)
. S XUSNV(21)=""
. ;
. ;NCPDP #
. S XUSNV(22)=""
. ;
. ;VISN STATION ID
. S XUSNV(23)=SITE
. ;
. S XUSDATA=XUSDATA_U_XUSNV(21)_U_XUSNV(22)_U_XUSNV(23)
. ;
. ;BCBS info
. K XUSBXID
. D NNVAID^XUSNPIXU(NVIEN,.XUSBXID)
. ;
. ;Update counter and save Entry
. N XUSB,XUSB1
. 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 XUSB1=$G(XUSBXID(XUSB)) I XUSB1'="" S XUSB1="^"_XUSB1 ;add p 528
. . . S XUSCNT=XUSCNT+1,TOTREC2=TOTREC2+1
. . . S ^TMP(XUSRTN,$J,XUSCNT)=XUSDATA_U_$$TRIM^XLFSTR(XUSB)_XUSB1_U_XUSEOL ;add _XUSB1 p 528
. . . S XUSIZE=XUSIZE+$L(^TMP(XUSRTN,$J,XUSCNT))
. I XUSIZE>MAXSIZE D
. . D EOF2(XUSRTN)
. . D EMAIL^XUSNPIX3(XUSRTN) ;sending the extracted data via MailMan
. . K ^TMP(XUSRTN,$J)
. . S ^TMP("XUSNPIXS",$J,4,MSGCNT)="2 (Non-VA)^"_(XUSCNT-2)
. . S ^TMP(XUSRTN,$J,1)=XUSHDR
. . S XUSCNT=1,XUSIZE=0
. K XUSNV,XUSDATA,XUSB,XUSBXID
;
D EOF2(XUSRTN)
;
; Send last message (if it has records)
I $G(XUSCNT)>1 D
. D EMAIL^XUSNPIX3(XUSRTN) ;sending the extracted data via MailMan
. K ^TMP(XUSRTN,$J)
. S ^TMP("XUSNPIXS",$J,4,MSGCNT)="2 (Non-VA)^"_($G(XUSCNT)-2)
;
; Update Summary
S ^XTMP("XUSNPIXT","2NV")=MSGCNT_U_TOTREC2_U_DTTM3
Q
;
EOF2(XUSRTN) ;
Q:$G(XUSCNT)=1
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
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HXUSNPIX4 9720 printed Dec 13, 2024@02:12:47 Page 2
XUSNPIX4 ;OAK_BP/CMW/SLT - NPI EXTRACT REPORT ; Aug 30, 2022@04:47:47
+1 ;;8.0;KERNEL;**438,452,453,481,528,548,774**; Jul 10, 1995;Build 2
+2 ;;Per VHA Directive 2004-038, this routine should not be modified.
+3 ;
+4 ; Direct access to ^IBE(350.9, fields .02, 1.05, 19;.02, 19;1.01, 19;1.02, 19;1.03, 19;,1.04, 19;1.05 authorized by
+5 ; Integration Agreement #4964.
+6 ;
+7 ; NPI Extract Report
+8 ;
+9 ; Input parameter: N/A
+10 ;
+11 ; Other relevant variables:
+12 ; XUSRTN="XUSNPIX1NV" (current routine name, used for ^XTMP and ^TMP
+13 ; XUSRTN="XUSNPIX2NV" storage subscript)
+14 ; Storage Global:
+15 ; ^XTMP("XUSNPIX1VA",0) = Piece 1^Piece 2^Piece 3^Piece 4^Piece 5^Piece 6
+16 ; ^XTMP("XUSNPIX2VA",0)
+17 ; where:
+18 ; Piece 1 => Purge Date - 1 year in future
+19 ; Piece 2 => Create Date - Today
+20 ; Piece 3 => Description
+21 ; Piece 4 => Last Date Compiled
+22 ; Piece 5 => $H last run start time
+23 ; Piece 6 => $H last run completion time
+24 ;
+25 ; Entry Point - ENT called from XUSNPIX1
+26 ;
+27 QUIT
+28 ;
+29 ; Individual records
TYPE1(DTTM3,SITE,XUSPROD,XUSHDR,XUSP2P) ;
+1 NEW IBA0,NVIEN,XUSNPI,MAXSIZE,XUSEOL,XUSCNT
+2 NEW XUSI,XUSNM,XUSNV,XLFNC,XUSIZE,XUSDT,XUSNEW
+3 NEW TOTREC1
+4 ;
+5 ; Set Maximum Message Size
+6 SET MAXSIZE=300000
+7 ;
+8 ; Set end of line character
+9 SET XUSEOL="~~"
+10 ;
+11 SET XUSCNT=1
SET (TOTREC1,MSGCNT,XUSIZE)=0
+12 SET XUSNPI=""
+13 FOR
SET XUSNPI=$ORDER(^TMP("XUSNPI",$JOB,1,XUSNPI))
if 'XUSNPI
QUIT
Begin DoDot:1
+14 SET XUSDATA=XUSNPI
+15 SET NVIEN=$GET(^TMP("XUSNPI",$JOB,1,XUSNPI))
+16 ;
+17 FOR XUSI=1:1:33
SET XUSNV(XUSI)=""
+18 SET IBA0=$GET(^IBA(355.93,NVIEN,0))
+19 SET XUSNM=$PIECE(IBA0,U)
+20 ; Break Name into components
+21 IF XUSNM'=""
Begin DoDot:2
+22 SET XLFNC=XUSNM
DO FORMAT^XLFNAME7(.XLFNC,,,,0)
+23 ;p774
IF $GET(XLFNC("FAMILY"))=""
SET XLFNC("FAMILY")=$GET(XUSNAME)
+24 ;p774
SET XUSNP(2)=$GET(XLFNC("GIVEN"))
SET XUSNP(3)=$GET(XLFNC("MIDDLE"))
SET XUSNP(4)=$GET(XLFNC("FAMILY"))
+25 IF $GET(XLFNC("SUFFIX"))'=""
SET XUSNV(4)=XUSNV(4)_" "_XLFNC("SUFFIX")
+26 KILL XLFNC
End DoDot:2
+27 SET XUSDATA=XUSDATA_U_XUSNV(2)_U_XUSNV(3)_U_XUSNV(4)
+28 ;TYPE
SET XUSNV(5)=1
+29 ;
+30 ; DOB (place holder)
+31 SET XUSNV(6)=""
+32 SET XUSDATA=XUSDATA_U_XUSNV(5)_U_XUSNV(6)
+33 ;
+34 ; Pay to Provider Address (7-12)
+35 SET XUSDATA=XUSDATA_U_XUSP2P
+36 ;
+37 ; Servicing Provider Address
+38 SET XUSNV(13)=$PIECE(IBA0,U,5)
+39 SET XUSNV(14)=$PIECE(IBA0,U,10)
+40 SET XUSNV(15)=$PIECE(IBA0,U,6)
+41 SET XUSNV(16)=$PIECE(IBA0,U,7)
+42 IF XUSNV(16)
SET XUSNV(16)=$PIECE($GET(^DIC(5,XUSNV(16),0)),U,2)
+43 SET XUSNV(17)=$PIECE(IBA0,U,8)
+44 SET XUSDATA=XUSDATA_U_XUSNV(13)_U_XUSNV(14)_U_XUSNV(15)_U_XUSNV(16)_U_XUSNV(17)
+45 ;
+46 ; Office Phone number (place holder)
+47 SET XUSNV(18)=""
+48 ;
+49 ; Degree Description / Degree Code (place holder)
+50 SET XUSNV(19)=""
+51 SET XUSNV(20)=""
+52 ;
+53 ; Get Taxonomy and specialty codes
+54 NEW NVTX,NVSPC,NVTAX
+55 SET NVTX=0
+56 FOR
SET NVTX=$ORDER(^IBA(355.93,NVIEN,"TAXONOMY","B",NVTX))
if 'NVTX
QUIT
Begin DoDot:2
+57 SET NVSPC=$PIECE($GET(^USC(8932.1,NVTX,0)),U,9)
+58 ;S NVTAX=$P($G(^USC(8932.1,NVTX,0)),U,7)
+59 IF NVSPC'=""
Begin DoDot:3
+60 IF XUSNV(21)=""
SET XUSNV(21)=NVSPC
QUIT
+61 SET XUSNV(21)=XUSNV(21)_";"_NVSPC
+62 QUIT
End DoDot:3
+63 QUIT
End DoDot:2
+64 ;use "B" cross ref to find primary vs non-primary code 0 (no)!1 (yes), and only "A"'s
+65 SET NVTX=0
+66 FOR
SET NVTX=$ORDER(^IBA(355.93,NVIEN,"TAXONOMY",NVTX))
if NVTX'?1N.N
QUIT
Begin DoDot:2
+67 SET IBA=$GET(^IBA(355.93,NVIEN,"TAXONOMY",NVTX,0))
+68 IF $PIECE(IBA,U,3)="A"
Begin DoDot:3
+69 IF $PIECE(IBA,U,2)=1
SET XUSNV(22)=$PIECE($GET(^USC(8932.1,$PIECE(IBA,U,1),0)),U,7)
+70 IF $PIECE(IBA,U,2)=0
Begin DoDot:4
+71 IF XUSNV(23)=""
SET XUSNV(23)=$PIECE($GET(^USC(8932.1,$PIECE(IBA,U,1),0)),U,7)
QUIT
+72 ;
+73 ; *** Start XU*8.0*548 - RBN ***
+74 ;
+75 IF (XUSNV(23)'[$PIECE($GET(^USC(8932.1,$PIECE(IBA,U,1),0)),U,7))&($PIECE($GET(^USC(8932.1,$PIECE(IBA,U,1),0)),U,7)'=XUSNV(22))
Begin DoDot:5
+76 SET XUSNV(23)=XUSNV(23)_";"_$PIECE($GET(^USC(8932.1,$PIECE(IBA,U,1),0)),U,7)
+77 ;
+78 ; *** End XU*8.0*548 - RBN ***
+79 ;
End DoDot:5
+80 QUIT
End DoDot:4
+81 QUIT
End DoDot:3
+82 QUIT
End DoDot:2
+83 KILL IBA
+84 ;
+85 ; Fed tax ID
+86 SET XUSNV(24)=$PIECE($GET(IBA0),U,9)
+87 ;
+88 SET XUSDATA=XUSDATA_U_XUSNV(18)_U_XUSNV(19)_U_XUSNV(20)_U_XUSNV(21)_U_XUSNV(22)
+89 SET XUSDATA=XUSDATA_U_XUSNV(23)_U_XUSNV(24)
+90 ;
+91 ; Medicare Part A/B
+92 SET XUSNV(25)=670899
+93 SET XUSNV(26)="VA"_$EXTRACT(SITE+10000,2,5)
+94 ;
+95 ; State Lic and DEA (place holder)
+96 SET XUSNV(27)=""
+97 SET XUSNV(28)=""
+98 ;
+99 ; Status and Creation/Termination Date (place holder)
+100 SET XUSNV(29)=""
+101 SET XUSNV(30)=""
+102 ; VISN Station
+103 SET XUSNV(31)=SITE
+104 ;
+105 SET XUSDATA=XUSDATA_U_XUSNV(25)_U_XUSNV(26)_U_XUSNV(27)
+106 SET XUSDATA=XUSDATA_U_XUSNV(28)_U_XUSNV(29)_U_XUSNV(30)_U_XUSNV(31)
+107 ;
+108 ;BCBS info
+109 KILL XUSBXID
+110 DO NNVAID^XUSNPIXU(NVIEN,.XUSBXID)
+111 ;
+112 ;Update counter and save Entry
+113 NEW XUSB,XUSB1
+114 SET XUSCNT=XUSCNT+1
SET TOTREC1=TOTREC1+1
+115 SET ^TMP(XUSRTN,$JOB,XUSCNT)=XUSDATA_U_XUSEOL
+116 SET XUSIZE=XUSIZE+$LENGTH(^TMP(XUSRTN,$JOB,XUSCNT))
+117 IF $DATA(XUSBXID)
Begin DoDot:2
+118 SET XUSB=""
+119 FOR
SET XUSB=$ORDER(XUSBXID(XUSB))
if XUSB=""
QUIT
Begin DoDot:3
+120 ;add p 528
SET XUSB1=$GET(XUSBXID(XUSB))
IF XUSB1'=""
SET XUSB1="^"_XUSB1
+121 SET XUSCNT=XUSCNT+1
SET TOTREC1=TOTREC1+1
+122 ;add _XUSB1 p 528
SET ^TMP(XUSRTN,$JOB,XUSCNT)=XUSDATA_U_$$TRIM^XLFSTR(XUSB)_XUSB1_U_XUSEOL
+123 SET XUSIZE=XUSIZE+$LENGTH(^TMP(XUSRTN,$JOB,XUSCNT))
End DoDot:3
End DoDot:2
+124 IF XUSIZE>MAXSIZE
Begin DoDot:2
+125 DO EOF1(XUSRTN)
+126 ;sending the extracted data via MailMan
DO EMAIL^XUSNPIX3(XUSRTN)
+127 KILL ^TMP(XUSRTN,$JOB)
+128 SET ^TMP("XUSNPIXS",$JOB,3,MSGCNT)="1 (Non-VA)^"_(XUSCNT-2)
+129 SET ^TMP(XUSRTN,$JOB,1)=XUSHDR
+130 SET XUSCNT=1
SET XUSIZE=0
End DoDot:2
+131 KILL XUSNV,XUSDATA,XUSBXID
End DoDot:1
+132 ;
+133 DO EOF1(XUSRTN)
+134 ;
+135 ; Send last message (if it has records)
+136 IF $GET(XUSCNT)>1
Begin DoDot:1
+137 ;sending the extracted data via MailMan
DO EMAIL^XUSNPIX3(XUSRTN)
+138 KILL ^TMP(XUSRTN,$JOB)
+139 SET ^TMP("XUSNPIXS",$JOB,3,MSGCNT)="1 (Non-VA)^"_($GET(XUSCNT)-2)
End DoDot:1
+140 ;
+141 ; Update Summary
+142 SET ^XTMP("XUSNPIXT","1NV")=MSGCNT_U_TOTREC1_U_DTTM3
+143 QUIT
+144 ;
EOF1(XUSRTN) ;
+1 if $GET(XUSCNT)=1
QUIT
+2 SET MSGCNT=MSGCNT+1
+3 SET ^TMP(XUSRTN,$JOB,1)=XUSHDR_U_"Message Number: "_MSGCNT_U_"Line Count: "_XUSCNT_U_DTTM3_U_$GET(XUSPROD)_U_XUSEOL
+4 SET XUSCNT=XUSCNT+1
+5 SET ^TMP(XUSRTN,$JOB,XUSCNT)="END OF FILE"_U_XUSEOL
+6 QUIT
+7 ;
TYPE2(DTTM3,SITE,XUSPROD,XUSHDR,XUSP2P) ;Facility/Group
+1 NEW IBA0,NVIEN,XUSNPI,MAXSIZE,XUSEOL,XUSCNT
+2 NEW XUSNV,XUSI,XUSNM,XLFNC,MSGCNT,XUSIZE,XUSDT,XUSNEW,TOTREC2
+3 ;
+4 ; Set Maximum Message Size
+5 SET MAXSIZE=300000
+6 ;
+7 ; Set end of line character
+8 SET XUSEOL="~~"
+9 ;
+10 SET XUSNPI=""
+11 SET XUSCNT=1
SET (TOTREC2,MSGCNT,XUSIZE)=0
+12 FOR
SET XUSNPI=$ORDER(^TMP("XUSNPI",$JOB,2,XUSNPI))
if 'XUSNPI
QUIT
Begin DoDot:1
+13 SET XUSDATA=XUSNPI
+14 SET NVIEN=$GET(^TMP("XUSNPI",$JOB,2,XUSNPI))
+15 ;
+16 FOR XUSI=1:1:24
SET XUSNV(XUSI)=""
+17 SET IBA0=$GET(^IBA(355.93,NVIEN,0))
+18 ;Get Organization name
+19 SET XUSNV(2)=$PIECE(IBA0,U)
+20 ;Type
+21 SET XUSNV(3)=2
+22 ;
+23 SET XUSDATA=XUSDATA_U_XUSNV(2)_U_XUSNV(3)
+24 ;
+25 ; Pay to Provider Address (4-9)
+26 SET XUSDATA=XUSDATA_U_XUSP2P
+27 ;
+28 ; Servicing Provider Address
+29 SET XUSNV(10)=$PIECE(IBA0,U,5)
+30 SET XUSNV(11)=$PIECE(IBA0,U,10)
+31 SET XUSNV(12)=$PIECE(IBA0,U,6)
+32 SET XUSNV(13)=$PIECE(IBA0,U,7)
+33 ;SLT 9/23/10
IF XUSNV(13)
SET XUSNV(13)=$PIECE($GET(^DIC(5,XUSNV(13),0)),U,2)
+34 SET XUSNV(14)=$PIECE(IBA0,U,8)
+35 SET XUSDATA=XUSDATA_U_XUSNV(10)_U_XUSNV(11)_U_XUSNV(12)_U_XUSNV(13)_U_XUSNV(14)
+36 ;
+37 ;Office Phone number (place holder)
+38 SET XUSNV(15)=""
+39 ;
+40 ; get Taxonomy and Specialty
+41 NEW NVTX,NVSPC,NVTAX
+42 SET NVTX=0
+43 FOR
SET NVTX=$ORDER(^IBA(355.93,NVIEN,"TAXONOMY","B",NVTX))
if 'NVTX
QUIT
Begin DoDot:2
+44 SET NVSPC=$PIECE($GET(^USC(8932.1,NVTX,0)),U,9)
+45 SET NVTAX=$PIECE($GET(^USC(8932.1,NVTX,0)),U,7)
+46 IF NVSPC'=""
Begin DoDot:3
+47 IF XUSNV(16)=""
SET XUSNV(16)=NVSPC
QUIT
+48 SET XUSNV(16)=XUSNV(16)_";"_NVSPC
End DoDot:3
+49 IF NVTAX'=""
Begin DoDot:3
+50 IF XUSNV(17)=""
SET XUSNV(17)=NVTAX
QUIT
+51 ;
+52 ; *** Start XU*8.0*548 - RBN ***
+53 ;
+54 ;S XUSNV(17)=XUSNV(17)_";"_NVTAX
+55 if (XUSNV(17)'[NVTAX)
SET XUSNV(17)=XUSNV(17)_";"_NVTAX
+56 ;
+57 ; *** End XU*8.0*548 - RBN ***
End DoDot:3
End DoDot:2
+58 ;
+59 ; Fed Tax ID
+60 SET XUSNV(18)=$PIECE($GET(IBA0),U,9)
+61 ;
+62 ;Medicare A/B
+63 SET XUSNV(19)=670899
+64 SET XUSNV(20)="VA"_$EXTRACT(SITE+10000,2,5)
+65 ;
+66 SET XUSDATA=XUSDATA_U_XUSNV(15)_U_XUSNV(16)_U_XUSNV(17)_U_XUSNV(18)_U_XUSNV(19)_U_XUSNV(20)
+67 ;
+68 ;State License Number
+69 ;S XUSNV(20)=$P($G(IBA0),U,12)
+70 ;
+71 ;DEA Number (place holder)
+72 SET XUSNV(21)=""
+73 ;
+74 ;NCPDP #
+75 SET XUSNV(22)=""
+76 ;
+77 ;VISN STATION ID
+78 SET XUSNV(23)=SITE
+79 ;
+80 SET XUSDATA=XUSDATA_U_XUSNV(21)_U_XUSNV(22)_U_XUSNV(23)
+81 ;
+82 ;BCBS info
+83 KILL XUSBXID
+84 DO NNVAID^XUSNPIXU(NVIEN,.XUSBXID)
+85 ;
+86 ;Update counter and save Entry
+87 NEW XUSB,XUSB1
+88 SET XUSCNT=XUSCNT+1
SET TOTREC2=TOTREC2+1
+89 SET ^TMP(XUSRTN,$JOB,XUSCNT)=XUSDATA_U_XUSEOL
+90 SET XUSIZE=XUSIZE+$LENGTH(^TMP(XUSRTN,$JOB,XUSCNT))
+91 IF $DATA(XUSBXID)
Begin DoDot:2
+92 SET XUSB=""
+93 FOR
SET XUSB=$ORDER(XUSBXID(XUSB))
if XUSB=""
QUIT
Begin DoDot:3
+94 ;add p 528
SET XUSB1=$GET(XUSBXID(XUSB))
IF XUSB1'=""
SET XUSB1="^"_XUSB1
+95 SET XUSCNT=XUSCNT+1
SET TOTREC2=TOTREC2+1
+96 ;add _XUSB1 p 528
SET ^TMP(XUSRTN,$JOB,XUSCNT)=XUSDATA_U_$$TRIM^XLFSTR(XUSB)_XUSB1_U_XUSEOL
+97 SET XUSIZE=XUSIZE+$LENGTH(^TMP(XUSRTN,$JOB,XUSCNT))
End DoDot:3
End DoDot:2
+98 IF XUSIZE>MAXSIZE
Begin DoDot:2
+99 DO EOF2(XUSRTN)
+100 ;sending the extracted data via MailMan
DO EMAIL^XUSNPIX3(XUSRTN)
+101 KILL ^TMP(XUSRTN,$JOB)
+102 SET ^TMP("XUSNPIXS",$JOB,4,MSGCNT)="2 (Non-VA)^"_(XUSCNT-2)
+103 SET ^TMP(XUSRTN,$JOB,1)=XUSHDR
+104 SET XUSCNT=1
SET XUSIZE=0
End DoDot:2
+105 KILL XUSNV,XUSDATA,XUSB,XUSBXID
End DoDot:1
+106 ;
+107 DO EOF2(XUSRTN)
+108 ;
+109 ; Send last message (if it has records)
+110 IF $GET(XUSCNT)>1
Begin DoDot:1
+111 ;sending the extracted data via MailMan
DO EMAIL^XUSNPIX3(XUSRTN)
+112 KILL ^TMP(XUSRTN,$JOB)
+113 SET ^TMP("XUSNPIXS",$JOB,4,MSGCNT)="2 (Non-VA)^"_($GET(XUSCNT)-2)
End DoDot:1
+114 ;
+115 ; Update Summary
+116 SET ^XTMP("XUSNPIXT","2NV")=MSGCNT_U_TOTREC2_U_DTTM3
+117 QUIT
+118 ;
EOF2(XUSRTN) ;
+1 if $GET(XUSCNT)=1
QUIT
+2 SET MSGCNT=MSGCNT+1
+3 SET ^TMP(XUSRTN,$JOB,1)=XUSHDR_U_"Message Number: "_MSGCNT_U_"Line Count: "_XUSCNT_U_DTTM3_U_$GET(XUSPROD)_U_XUSEOL
+4 SET XUSCNT=XUSCNT+1
+5 SET ^TMP(XUSRTN,$JOB,XUSCNT)="END OF FILE"_U_XUSEOL
+6 QUIT
