Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: XUSNPIX4

XUSNPIX4.m

Go to the documentation of this file. 
  1. 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
  1.  ;;Per VHA Directive 2004-038, this routine should not be modified.
  1.  ;
  1.  ; 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
  1.  ; Integration Agreement #4964.
  1.  ;
  1.  ; NPI Extract Report
  1.  ;
  1.  ; Input parameter: N/A
  1.  ;
  1.  ; Other relevant variables:
  1.  ;   XUSRTN="XUSNPIX1NV" (current routine name, used for ^XTMP and ^TMP
  1.  ;   XUSRTN="XUSNPIX2NV"  storage subscript)
  1.  ; Storage Global:
  1.  ;   ^XTMP("XUSNPIX1VA",0) = Piece 1^Piece 2^Piece 3^Piece 4^Piece 5^Piece 6
  1.  ;   ^XTMP("XUSNPIX2VA",0)
  1.  ;      where:
  1.  ;      Piece 1 => Purge Date - 1 year in future
  1.  ;      Piece 2 => Create Date - Today
  1.  ;      Piece 3 => Description
  1.  ;      Piece 4 => Last Date Compiled
  1.  ;      Piece 5 => $H last run start time
  1.  ;      Piece 6 => $H last run completion time
  1.  ;      
  1.  ;      Entry Point - ENT called from XUSNPIX1
  1.  ;
  1.  Q
  1.  ;
  1.  ; Individual records
  1. TYPE1(DTTM3,SITE,XUSPROD,XUSHDR,XUSP2P) ;
  1.  N IBA0,NVIEN,XUSNPI,MAXSIZE,XUSEOL,XUSCNT
  1.  N XUSI,XUSNM,XUSNV,XLFNC,XUSIZE,XUSDT,XUSNEW
  1.  N TOTREC1
  1.  ;
  1.  ; Set Maximum Message Size
  1.  S MAXSIZE=300000
  1.  ;
  1.  ; Set end of line character
  1.  S XUSEOL="~~"
  1.  ;
  1.  S XUSCNT=1,(TOTREC1,MSGCNT,XUSIZE)=0
  1.  S XUSNPI=""
  1.  F  S XUSNPI=$O(^TMP("XUSNPI",$J,1,XUSNPI)) Q:'XUSNPI  D
  1.  . S XUSDATA=XUSNPI
  1.  . S NVIEN=$G(^TMP("XUSNPI",$J,1,XUSNPI))
  1.  . ;
  1.  . F XUSI=1:1:33 S XUSNV(XUSI)=""
  1.  . S IBA0=$G(^IBA(355.93,NVIEN,0))
  1.  . S XUSNM=$P(IBA0,U)
  1.  . ; Break Name into components
  1.  . I XUSNM'="" D
  1.  . . S XLFNC=XUSNM D FORMAT^XLFNAME7(.XLFNC,,,,0)
  1.  . . I $G(XLFNC("FAMILY"))="" S XLFNC("FAMILY")=$G(XUSNAME) ;p774
  1.  . . S XUSNP(2)=$G(XLFNC("GIVEN")),XUSNP(3)=$G(XLFNC("MIDDLE")),XUSNP(4)=$G(XLFNC("FAMILY")) ;p774
  1.  . . I $G(XLFNC("SUFFIX"))'="" S XUSNV(4)=XUSNV(4)_" "_XLFNC("SUFFIX")
  1.  . . K XLFNC
  1.  . S XUSDATA=XUSDATA_U_XUSNV(2)_U_XUSNV(3)_U_XUSNV(4)
  1.  . S XUSNV(5)=1 ;TYPE
  1.  . ;                                    
  1.  . ; DOB (place holder)
  1.  . S XUSNV(6)=""
  1.  . S XUSDATA=XUSDATA_U_XUSNV(5)_U_XUSNV(6)
  1.  . ;
  1.  . ; Pay to Provider Address (7-12)
  1.  . S XUSDATA=XUSDATA_U_XUSP2P
  1.  . ;
  1.  . ; Servicing Provider Address
  1.  . S XUSNV(13)=$P(IBA0,U,5)
  1.  . S XUSNV(14)=$P(IBA0,U,10)
  1.  . S XUSNV(15)=$P(IBA0,U,6)
  1.  . S XUSNV(16)=$P(IBA0,U,7)
  1.  . I XUSNV(16) S XUSNV(16)=$P($G(^DIC(5,XUSNV(16),0)),U,2)
  1.  . S XUSNV(17)=$P(IBA0,U,8)
  1.  . S XUSDATA=XUSDATA_U_XUSNV(13)_U_XUSNV(14)_U_XUSNV(15)_U_XUSNV(16)_U_XUSNV(17)
  1.  . ;
  1.  . ; Office Phone number (place holder)
  1.  . S XUSNV(18)=""
  1.  . ;
  1.  . ; Degree Description / Degree Code (place holder)
  1.  . S XUSNV(19)=""
  1.  . S XUSNV(20)=""
  1.  . ;
  1.  . ; Get Taxonomy and specialty codes
  1.  . N NVTX,NVSPC,NVTAX
  1.  . S NVTX=0
  1.  . F  S NVTX=$O(^IBA(355.93,NVIEN,"TAXONOMY","B",NVTX)) Q:'NVTX  D
  1.  . . S NVSPC=$P($G(^USC(8932.1,NVTX,0)),U,9)
  1.  . . ;S NVTAX=$P($G(^USC(8932.1,NVTX,0)),U,7)
  1.  . . I NVSPC'="" D
  1.  . . . I XUSNV(21)="" S XUSNV(21)=NVSPC Q
  1.  . . . S XUSNV(21)=XUSNV(21)_";"_NVSPC
  1.  . . . Q
  1.  . . Q
  1.  . ;use "B" cross ref to find primary vs non-primary code 0 (no)!1 (yes), and only "A"'s
  1.  . S NVTX=0
  1.  . F  S NVTX=$O(^IBA(355.93,NVIEN,"TAXONOMY",NVTX)) Q:NVTX'?1N.N  D
  1.  . . S IBA=$G(^IBA(355.93,NVIEN,"TAXONOMY",NVTX,0))
  1.  . . I $P(IBA,U,3)="A" D
  1.  . . . I $P(IBA,U,2)=1 S XUSNV(22)=$P($G(^USC(8932.1,$P(IBA,U,1),0)),U,7)
  1.  . . . I $P(IBA,U,2)=0 D
  1.  . . . . I XUSNV(23)="" S XUSNV(23)=$P($G(^USC(8932.1,$P(IBA,U,1),0)),U,7) Q
  1.  . . . . ;
  1.  . . . . ; *** Start XU*8.0*548 - RBN ***
  1.  . . . . ;
  1.  . . . . 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
  1.  . . . . . S XUSNV(23)=XUSNV(23)_";"_$P($G(^USC(8932.1,$P(IBA,U,1),0)),U,7)
  1.  . . . . . ;
  1.  . . . . . ; *** End XU*8.0*548 - RBN ***
  1.  . . . . . ;
  1.  . . . . Q
  1.  . . . Q
  1.  . . Q
  1.  . K IBA
  1.  . ;
  1.  . ; Fed tax ID
  1.  . S XUSNV(24)=$P($G(IBA0),U,9)
  1.  . ;
  1.  . S XUSDATA=XUSDATA_U_XUSNV(18)_U_XUSNV(19)_U_XUSNV(20)_U_XUSNV(21)_U_XUSNV(22)
  1.  . S XUSDATA=XUSDATA_U_XUSNV(23)_U_XUSNV(24)
  1.  . ;
  1.  . ; Medicare Part A/B
  1.  . S XUSNV(25)=670899
  1.  . S XUSNV(26)="VA"_$E(SITE+10000,2,5)
  1.  . ;
  1.  . ; State Lic and DEA (place holder)
  1.  . S XUSNV(27)=""
  1.  . S XUSNV(28)=""
  1.  . ;
  1.  . ; Status and Creation/Termination Date (place holder)
  1.  . S XUSNV(29)=""
  1.  . S XUSNV(30)=""
  1.  . ; VISN Station
  1.  . S XUSNV(31)=SITE
  1.  . ;
  1.  . S XUSDATA=XUSDATA_U_XUSNV(25)_U_XUSNV(26)_U_XUSNV(27)
  1.  . S XUSDATA=XUSDATA_U_XUSNV(28)_U_XUSNV(29)_U_XUSNV(30)_U_XUSNV(31)
  1.  . ;
  1.  . ;BCBS info
  1.  . K XUSBXID
  1.  . D NNVAID^XUSNPIXU(NVIEN,.XUSBXID)
  1.  . ;
  1.  . ;Update counter and save Entry
  1.  . N XUSB,XUSB1
  1.  . S XUSCNT=XUSCNT+1,TOTREC1=TOTREC1+1
  1.  . S ^TMP(XUSRTN,$J,XUSCNT)=XUSDATA_U_XUSEOL
  1.  . S XUSIZE=XUSIZE+$L(^TMP(XUSRTN,$J,XUSCNT))
  1.  . I $D(XUSBXID) D
  1.  . . S XUSB=""
  1.  . . F  S XUSB=$O(XUSBXID(XUSB)) Q:XUSB=""  D
  1.  . . . S XUSB1=$G(XUSBXID(XUSB)) I XUSB1'="" S XUSB1="^"_XUSB1 ;add p 528
  1.  . . . S XUSCNT=XUSCNT+1,TOTREC1=TOTREC1+1
  1.  . . . S ^TMP(XUSRTN,$J,XUSCNT)=XUSDATA_U_$$TRIM^XLFSTR(XUSB)_XUSB1_U_XUSEOL ;add _XUSB1 p 528
  1.  . . . S XUSIZE=XUSIZE+$L(^TMP(XUSRTN,$J,XUSCNT))
  1.  . I XUSIZE>MAXSIZE D
  1.  . . D EOF1(XUSRTN)
  1.  . . D EMAIL^XUSNPIX3(XUSRTN) ;sending the extracted data via MailMan
  1.  . . K ^TMP(XUSRTN,$J)
  1.  . . S ^TMP("XUSNPIXS",$J,3,MSGCNT)="1 (Non-VA)^"_(XUSCNT-2)
  1.  . . S ^TMP(XUSRTN,$J,1)=XUSHDR
  1.  . . S XUSCNT=1,XUSIZE=0
  1.  . K XUSNV,XUSDATA,XUSBXID
  1.  ;
  1.  D EOF1(XUSRTN)
  1.  ;
  1.  ; Send last message (if it has records)
  1.  I $G(XUSCNT)>1 D
  1.  . D EMAIL^XUSNPIX3(XUSRTN) ;sending the extracted data via MailMan
  1.  . K ^TMP(XUSRTN,$J)
  1.  . S ^TMP("XUSNPIXS",$J,3,MSGCNT)="1 (Non-VA)^"_($G(XUSCNT)-2)
  1.  ;
  1.  ; Update Summary
  1.  S ^XTMP("XUSNPIXT","1NV")=MSGCNT_U_TOTREC1_U_DTTM3
  1.  Q
  1.  ;
  1. EOF1(XUSRTN) ;
  1.  Q:$G(XUSCNT)=1
  1.  S MSGCNT=MSGCNT+1
  1.  S ^TMP(XUSRTN,$J,1)=XUSHDR_U_"Message Number: "_MSGCNT_U_"Line Count: "_XUSCNT_U_DTTM3_U_$G(XUSPROD)_U_XUSEOL
  1.  S XUSCNT=XUSCNT+1
  1.  S ^TMP(XUSRTN,$J,XUSCNT)="END OF FILE"_U_XUSEOL
  1.  Q
  1.  ;
  1. TYPE2(DTTM3,SITE,XUSPROD,XUSHDR,XUSP2P) ;Facility/Group
  1.  N IBA0,NVIEN,XUSNPI,MAXSIZE,XUSEOL,XUSCNT
  1.  N XUSNV,XUSI,XUSNM,XLFNC,MSGCNT,XUSIZE,XUSDT,XUSNEW,TOTREC2
  1.  ;
  1.  ; Set Maximum Message Size
  1.  S MAXSIZE=300000
  1.  ;
  1.  ; Set end of line character
  1.  S XUSEOL="~~"
  1.  ;
  1.  S XUSNPI=""
  1.  S XUSCNT=1,(TOTREC2,MSGCNT,XUSIZE)=0
  1.  F  S XUSNPI=$O(^TMP("XUSNPI",$J,2,XUSNPI)) Q:'XUSNPI  D
  1.  . S XUSDATA=XUSNPI
  1.  . S NVIEN=$G(^TMP("XUSNPI",$J,2,XUSNPI))
  1.  . ;
  1.  . F XUSI=1:1:24 S XUSNV(XUSI)=""
  1.  . S IBA0=$G(^IBA(355.93,NVIEN,0))
  1.  . ;Get Organization name  
  1.  . S XUSNV(2)=$P(IBA0,U)
  1.  . ;Type
  1.  . S XUSNV(3)=2
  1.  . ;
  1.  . S XUSDATA=XUSDATA_U_XUSNV(2)_U_XUSNV(3)
  1.  . ;
  1.  . ; Pay to Provider Address (4-9)
  1.  . S XUSDATA=XUSDATA_U_XUSP2P
  1.  . ;
  1.  . ; Servicing Provider Address
  1.  . S XUSNV(10)=$P(IBA0,U,5)
  1.  . S XUSNV(11)=$P(IBA0,U,10)
  1.  . S XUSNV(12)=$P(IBA0,U,6)
  1.  . S XUSNV(13)=$P(IBA0,U,7)
  1.  . I XUSNV(13) S XUSNV(13)=$P($G(^DIC(5,XUSNV(13),0)),U,2) ;SLT 9/23/10
  1.  . S XUSNV(14)=$P(IBA0,U,8)
  1.  . S XUSDATA=XUSDATA_U_XUSNV(10)_U_XUSNV(11)_U_XUSNV(12)_U_XUSNV(13)_U_XUSNV(14)
  1.  . ;
  1.  . ;Office Phone number (place holder)
  1.  . S XUSNV(15)=""
  1.  . ; 
  1.  . ; get Taxonomy and Specialty
  1.  . N NVTX,NVSPC,NVTAX
  1.  . S NVTX=0
  1.  . F  S NVTX=$O(^IBA(355.93,NVIEN,"TAXONOMY","B",NVTX)) Q:'NVTX  D
  1.  . . S NVSPC=$P($G(^USC(8932.1,NVTX,0)),U,9)
  1.  . . S NVTAX=$P($G(^USC(8932.1,NVTX,0)),U,7)
  1.  . . I NVSPC'="" D
  1.  . . . I XUSNV(16)="" S XUSNV(16)=NVSPC Q
  1.  . . . S XUSNV(16)=XUSNV(16)_";"_NVSPC
  1.  . . I NVTAX'="" D
  1.  . . . I XUSNV(17)="" S XUSNV(17)=NVTAX Q
  1.  . . . ;
  1.  . . . ; *** Start XU*8.0*548 - RBN ***
  1.  . . . ;
  1.  . . . ;S XUSNV(17)=XUSNV(17)_";"_NVTAX
  1.  . . . S:(XUSNV(17)'[NVTAX) XUSNV(17)=XUSNV(17)_";"_NVTAX
  1.  . . . ;
  1.  . . . ; *** End XU*8.0*548 - RBN ***
  1.  . ;
  1.  . ; Fed Tax ID
  1.  . S XUSNV(18)=$P($G(IBA0),U,9)
  1.  . ;
  1.  . ;Medicare A/B
  1.  . S XUSNV(19)=670899
  1.  . S XUSNV(20)="VA"_$E(SITE+10000,2,5)
  1.  . ;
  1.  . S XUSDATA=XUSDATA_U_XUSNV(15)_U_XUSNV(16)_U_XUSNV(17)_U_XUSNV(18)_U_XUSNV(19)_U_XUSNV(20)
  1.  . ;
  1.  . ;State License Number
  1.  . ;S XUSNV(20)=$P($G(IBA0),U,12)
  1.  . ;
  1.  . ;DEA Number (place holder)
  1.  . S XUSNV(21)=""
  1.  . ;
  1.  . ;NCPDP #
  1.  . S XUSNV(22)=""
  1.  . ;
  1.  . ;VISN STATION ID
  1.  . S XUSNV(23)=SITE
  1.  . ;
  1.  . S XUSDATA=XUSDATA_U_XUSNV(21)_U_XUSNV(22)_U_XUSNV(23)
  1.  . ;
  1.  . ;BCBS info
  1.  . K XUSBXID
  1.  . D NNVAID^XUSNPIXU(NVIEN,.XUSBXID)
  1.  . ;
  1.  . ;Update counter and save Entry
  1.  . N XUSB,XUSB1
  1.  . S XUSCNT=XUSCNT+1,TOTREC2=TOTREC2+1
  1.  . S ^TMP(XUSRTN,$J,XUSCNT)=XUSDATA_U_XUSEOL
  1.  . S XUSIZE=XUSIZE+$L(^TMP(XUSRTN,$J,XUSCNT))
  1.  . I $D(XUSBXID) D
  1.  . . S XUSB=""
  1.  . . F  S XUSB=$O(XUSBXID(XUSB)) Q:XUSB=""  D
  1.  . . . S XUSB1=$G(XUSBXID(XUSB)) I XUSB1'="" S XUSB1="^"_XUSB1 ;add p 528
  1.  . . . S XUSCNT=XUSCNT+1,TOTREC2=TOTREC2+1
  1.  . . . S ^TMP(XUSRTN,$J,XUSCNT)=XUSDATA_U_$$TRIM^XLFSTR(XUSB)_XUSB1_U_XUSEOL ;add _XUSB1 p 528
  1.  . . . S XUSIZE=XUSIZE+$L(^TMP(XUSRTN,$J,XUSCNT))
  1.  . I XUSIZE>MAXSIZE D
  1.  . . D EOF2(XUSRTN)
  1.  . . D EMAIL^XUSNPIX3(XUSRTN) ;sending the extracted data via MailMan
  1.  . . K ^TMP(XUSRTN,$J)
  1.  . . S ^TMP("XUSNPIXS",$J,4,MSGCNT)="2 (Non-VA)^"_(XUSCNT-2)
  1.  . . S ^TMP(XUSRTN,$J,1)=XUSHDR
  1.  . . S XUSCNT=1,XUSIZE=0
  1.  . K XUSNV,XUSDATA,XUSB,XUSBXID
  1.  ;
  1.  D EOF2(XUSRTN)
  1.  ;
  1.  ; Send last message (if it has records)
  1.  I $G(XUSCNT)>1 D
  1.  . D EMAIL^XUSNPIX3(XUSRTN) ;sending the extracted data via MailMan
  1.  . K ^TMP(XUSRTN,$J)
  1.  . S ^TMP("XUSNPIXS",$J,4,MSGCNT)="2 (Non-VA)^"_($G(XUSCNT)-2)
  1.  ;
  1.  ; Update Summary
  1.  S ^XTMP("XUSNPIXT","2NV")=MSGCNT_U_TOTREC2_U_DTTM3
  1.  Q
  1.  ;
  1. EOF2(XUSRTN) ;
  1.  Q:$G(XUSCNT)=1
  1.  S MSGCNT=MSGCNT+1
  1.  S ^TMP(XUSRTN,$J,1)=XUSHDR_U_"Message Number: "_MSGCNT_U_"Line Count: "_XUSCNT_U_DTTM3_U_$G(XUSPROD)_U_XUSEOL
  1.  S XUSCNT=XUSCNT+1
  1.  S ^TMP(XUSRTN,$J,XUSCNT)="END OF FILE"_U_XUSEOL
  1.  Q