- XUSNPIX1 ;OAK_BP/CMW - NPI EXTRACT REPORT ; Aug 30, 2022@04:49:29
- ;;8.0;KERNEL;**438,452,453,481,528,548,774,689**; Jul 10, 1995;Build 113
- ;;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="XUSNPIX1" (current routine name, used for ^XTMP and ^TMP
- ; storage subscript)
- ; Storage Global:
- ; ^XTMP("XUSNPIX1",0) = Piece 1^Piece 2^Piece 3^Piece 4^Piece 5^Piece 6
- ; 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
- ;
- ; ^XTMP("XUSNPIX1",1) = DATA
- ;
- ; XUSNPI => Unique NPI of entry
- ; LDT => Last Date Run, VA Fileman Format
- ;
- ; Entry Point - TASKMAN => Run report in background using TASKMAN
- ;
- Q
- ;
- TASKMAN ;TASKMAN ENTRY POINT
- ; Process Report
- N XUSRTN,DTTM,XUSPROD,XUSVER,INSMAIL,XUSNP2P,XUSTMP
- ;
- ; Check for required variables
- I $G(U)=""!($G(DT)="") G EXIT
- S XUSRTN="XUSNPIX1"
- S DTTM=$$HTE^XLFDT($H,"2")
- ; Check to see if report is in use
- L +^XTMP(XUSRTN):5 I '$T G EXIT
- ;
- ;Reset Summary Scratch Globals
- K ^TMP("XUSNPIXS",$J)
- K ^TMP("XUSNPIXT",$J)
- ;
- ; Initialize variables
- D INIT(XUSRTN)
- ;
- ; Pull Station(Institution) data
- D INST(XUSRTN,XUSVER,.INSMAIL)
- ;
- ;Process New Person File
- D PROC1(XUSRTN,XUSPROD,XUSVER,DTTM,INSMAIL)
- ;
- ; Process Institution File
- D ENT^XUSNPIX2(XUSPROD,XUSVER)
- ;
- ; Process Non VA File
- D ENT^XUSNPIX3(XUSPROD,XUSVER)
- ;
- ; Send summary message
- D SMAIL^XUSNPIX5("XUSNPIXT",XUSPROD,XUSVER,DTTM)
- ;
- ;Standard EXIT point
- EXIT ;
- K DTTM,XUSVER,XUSHDR,XUSPROD,INSMAIL
- ;
- ;Kill off Scratch Globals
- K ^TMP("XUSNPIXS",$J)
- K ^TMP("XUSNPIXT",$J)
- K ^TMP("XUSNPIXU",$J)
- K ^TMP("P2P")
- ; Log Run Completion Time
- S $P(^XTMP(XUSRTN,0),U,6)=$H
- L -^XTMP(XUSRTN)
- ;
- Q
- ;
- INIT(XUSRTN) ; check/init variables
- N XUSDESC,IBSIEN,ZN19,P2PVAL
- ; Set to NEXT release version from NPM
- ; Update the build number here.
- S XUSVER="548.14" ; last patch to update the structure of the data extract (XU*8.0*548)
- ;
- ; Get production/test account flag
- S XUSPROD=$S($$PROD^XUPROD(1):"PROD",1:"TEST")
- ;
- ; Reset Temporary Scratch Global
- D INIT^XUSNPIXU
- K ^TMP(XUSRTN)
- S XUSDESC="NPI EXTRACT TYPE 1 - Do Not Delete"
- S ^XTMP(XUSRTN,0)=(DT+10000)_U_DT_U_XUSDESC_U_DT_U_$H
- ; Generate TMP BCBS Array
- D BCBSID^XUSNPIXU
- D P2PBASE^XUSNPIXU(.XUSTMP) ;XUSTMP array used for Type 1 and 2 VA
- Q
- ;
- MAILTO(XMY) ;sets the MailMan recipients based on need (XU*8.0*548)
- ;
- ;When you don't want data to go out to Austin's FSC but you need it to
- ;stay within the VistA's MailMan for internal testing, comment out setting
- ;the XMY("XXX@Q-NPS.DOMAIN.EXT) array and add your own MailMan address that
- ;is present in the VistA account your are on.
- ;When you want data to go out to Austin's FSC group, uncomment this line.
- ;S XMY("XXX@Q-NPS.DOMAIN.EXT")="" ;uncomment to run for live ***
- S XUWHO606=$G(XUWHO606,"XXX@Q-NPS.DOMAIN.EXT") ;p774
- S XMY(XUWHO606)=""
- Q
- ;
- INST(XUSRTN,XUSVER,INSMAIL) ;Pull station and Institution info
- N INST,SINFO,DIC4
- ; Pull site info
- S SINFO=$$SITE^VASITE
- ; Station Number
- S SITE=$P(SINFO,U,3)
- ; Institution
- S INST=$P(SINFO,U)
- ;
- ; Get institution mailing address
- I INST D
- . S DIC4=$G(^DIC(4,INST,4))
- . S XUSNP(7)=$P(DIC4,U)
- . S XUSNP(8)=$P(DIC4,U,2)
- . S XUSNP(9)=$P(DIC4,U,3)
- . S XUSNP(10)=$P(DIC4,U,4)
- . I XUSNP(10) S XUSNP(10)=$P($G(^DIC(5,XUSNP(10),0)),U,2)
- . S XUSNP(11)=$P(DIC4,U,5)
- . S INSMAIL=XUSNP(7)_U_XUSNP(8)_U_XUSNP(9)_U_XUSNP(10)_U_XUSNP(11)
- S XUSHDR="Station: "_SITE_U_XUSNP(9)_U_XUSNP(10)_U_XUSNP(11)_U_"TYPE 1"_U_XUSVER
- ;
- Q
- ;
- PROC1(XUSRTN,XUSPROD,XUSVER,DTTM,INSMAIL) ;Process all New Person records
- N XUSNPI,XUSDT,XUSNEW,XUSI,XUSDATA,XUSVA0,XUSVA0,XUSVA1,XUSNAME,XUSDOB,XUSDIV,XUSSTL,XUSSTLN,XUSOPN
- N XUSPER,XUSSPC,XUSTAX,XUSTAXID,XUSIZE,NPIEN,DIC4,SPDIV,VA12,VA13,COUNT,MSGCNT,MAXSIZE,TOTREC,XUSEOL
- N FND,XUSUSCT,XUSUSC1,I
- ;
- ; Set to 300000 for live
- S MAXSIZE=300000
- ;
- ; Set end of line character
- S XUSEOL="~~"
- ;
- ; set counter
- S COUNT=1,(TOTREC,MSGCNT,XUSIZE)=0
- ;
- ; Loop through NEW PERSON NPI records NPI cross ref
- S XUSNPI=0
- F S XUSNPI=$O(^VA(200,"ANPI",XUSNPI)) Q:'XUSNPI D
- . S NPIEN=$O(^VA(200,"ANPI",XUSNPI,""))
- . ;
- . ; Init columns
- . ;F XUSI=1:1:29 S XUSNP(XUSI)=""
- . F XUSI=1:1:33 S XUSNP(XUSI)=""
- . S XUSNP(1)=XUSNPI S XUSDATA1=XUSNP(1)
- . ;
- . S XUSVA0=$G(^VA(200,NPIEN,0))
- . S XUSVA1=$G(^VA(200,NPIEN,1))
- . S XUSNAME=$P(XUSVA0,U)
- . ;
- . ; Break name into components
- . I XUSNAME'="" D
- . . S XLFNC=XUSNAME 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 XUSNP(4)=XUSNP(4)_" "_XLFNC("SUFFIX")
- . . K XLFNC
- . S XUSDATA1=XUSDATA1_U_XUSNP(2)_U_XUSNP(3)_U_XUSNP(4)
- . ;
- . S XUSNP(5)=1 ;type
- . S XUSDOB=$P(XUSVA1,U,3)
- . ; dob formatted as mm/dd/yyyy
- . I XUSDOB D
- . . S XUSNP(6)=$$FMTE^XLFDT(XUSDOB,5)
- . S XUSDATA1=XUSDATA1_U_XUSNP(5)_U_XUSNP(6)
- . ;
- . ; Office Phone number
- . S XUSOPN=$P($G(^VA(200,NPIEN,.13)),U,2)
- . ;I XUSOPN'="" S XUSNP(17)=XUSOPN
- . I XUSOPN'="" S XUSNP(18)=XUSOPN
- . ;
- . ; Servicing Provider Address
- . S (XUSDIV)=0
- . ; Loop through Division multiple
- . F S XUSDIV=$O(^VA(200,NPIEN,2,XUSDIV)) Q:'XUSDIV D
- . . S DIC4=$G(^DIC(4,XUSDIV,4))
- . . S XUSNP(13)=$P(DIC4,U)
- . . S XUSNP(14)=$P(DIC4,U,2)
- . . S XUSNP(15)=$P(DIC4,U,3)
- . . S XUSNP(16)=$P(DIC4,U,4)
- . . I XUSNP(16) S XUSNP(16)=$P($G(^DIC(5,XUSNP(16),0)),U,2)
- . . S XUSNP(17)=$P(DIC4,U,5)
- . . S XUSSTA(XUSDIV)=$P($G(^DIC(4,XUSDIV,99)),U)
- . . S SPADR(XUSDIV)=XUSNP(13)_U_XUSNP(14)_U_XUSNP(15)_U_XUSNP(16)_U_XUSNP(17)_U_XUSNP(18)
- . ;
- . ; If no divisions found
- . I '$D(SPADR) D
- . . S XUSSTA(9999)="N/A",SPADR(9999)=XUSNP(13)_U_XUSNP(14)_U_XUSNP(15)_U_XUSNP(16)_U_XUSNP(17)_U_XUSNP(18)
- . ;
- . ; Degree
- . S XUSNP(19)=$P($G(^VA(200,NPIEN,3.1)),U,6)
- . ; Degree Code (place holder, currently empty)
- . S XUSNP(20)=""
- . ;
- . ; get primary specialty
- . S XUSPER=0
- . F S XUSPER=$O(^VA(200,NPIEN,"USC1","B",XUSPER)) Q:'XUSPER D
- . . S XUSSPC=$P($G(^USC(8932.1,XUSPER,0)),U,9)
- . . ;S XUSTAX=$P($G(^USC(8932.1,XUSPER,0)),U,7)
- . . I XUSSPC'="" D
- . . . ;I XUSNP(20)="" S XUSNP(20)=XUSSPC Q
- . . . ;S XUSNP(20)=XUSNP(20)_";"_XUSSPC
- . . . I XUSNP(21)="" S XUSNP(21)=XUSSPC Q
- . . . S XUSNP(21)=XUSNP(21)_";"_XUSSPC
- . . . Q
- . . Q
- . ;get taxonomy (primary and all secondaries)
- . N XUSCLASS,XUSEXPDT ; ptr to Person class, expiration date
- . S XUSPER=0
- . K ^XTMP("USC1",$J)
- . F S XUSPER=$O(^VA(200,NPIEN,"USC1","AD",XUSPER)) Q:'XUSPER D
- . . S XUSUSC1=""
- . . F S XUSUSC1=$O(^VA(200,NPIEN,"USC1","AD",XUSPER,XUSUSC1)) Q:XUSUSC1="" D
- . . . S XUSCLASS=$P($G(^VA(200,NPIEN,"USC1",XUSUSC1,0)),U),XUSEXPDT=$P($G(^VA(200,NPIEN,"USC1",XUSUSC1,0)),U,3)
- . . . S ^XTMP("USC1",$J,XUSUSC1)=XUSEXPDT_U_XUSCLASS
- . . . Q
- . . Q
- . ;find primary taxonomy code
- . S XUSUSC1="",FND=0,XUSUSCT=""
- . F S XUSUSC1=$O(^XTMP("USC1",$J,XUSUSC1),-1) Q:XUSUSC1=""!(FND=1) D
- . . I $P($G(^XTMP("USC1",$J,XUSUSC1)),U)'="" Q ; not active, expiration dt exists
- . . S XUSCLASS=$P($G(^XTMP("USC1",$J,XUSUSC1)),U,2)
- . . I XUSCLASS="" Q
- . . S XUSNP(22)=$P($G(^USC(8932.1,XUSCLASS,0)),U,7),FND=1,XUSUSCT=XUSUSC1
- . . Q
- . I $D(^XTMP("USC1",$J))&$G(XUSUSCT) K ^XTMP("USC1",$J,XUSUSCT) ;remove the active taxonomy code
- . S XUSUSC1=""
- . F S XUSUSC1=$O(^XTMP("USC1",$J,XUSUSC1)) Q:XUSUSC1="" D
- . . S XUSCLASS=$P($G(^XTMP("USC1",$J,XUSUSC1)),U,2)
- . . I XUSCLASS="" Q
- . . S XUSTAX=$P($G(^USC(8932.1,XUSCLASS,0)),U,7)
- . . I XUSTAX'="" D
- . . . ;
- . . . I XUSNP(23)="" S XUSNP(23)=XUSTAX Q
- . . . ;
- . . . ; *** Start ^XU*8.0*548 - RBN ***
- . . . ;
- . . . ;S XUSNP(23)=XUSNP(23)_";"_XUSTAX
- . . . S:(XUSNP(23)'[XUSTAX&(XUSTAX'=XUSNP(22))) XUSNP(23)=XUSNP(23)_";"_XUSTAX
- . . . ;
- . . . ; *** End ^XU*8.0*548 - RBN ***
- . . . ;
- . ;
- . ; Tax ID
- . S XUSTAXID=$P($G(^VA(200,NPIEN,"TPB")),U,2)
- . I XUSTAXID="" S XUSTAXID=$P($G(^VA(200,NPIEN,1)),U,9)
- . ;S XUSNP(22)=XUSTAXID
- . S XUSNP(24)=XUSTAXID
- . ;
- . ;S XUSDATA2=XUSNP(17)_U_XUSNP(18)_U_XUSNP(19)_U_XUSNP(20)_U_XUSNP(21)_U_XUSNP(22)
- . S XUSDATA2=XUSNP(19)_U_XUSNP(20)_U_XUSNP(21)_U_XUSNP(22)_U_XUSNP(23)_U_XUSNP(24)
- . ;
- . ; Medicare Part A/B
- . ;S XUSNP(23)=670899
- . ;S XUSNP(24)="VA"_$E(SITE+10000,2,5)
- . S XUSNP(25)=670899
- . S XUSNP(26)="VA"_$E(SITE+10000,2,5)
- . ;
- . ; State License
- . S XUSSTL=0
- . F S XUSSTL=$O(^VA(200,NPIEN,"PS1",XUSSTL)) Q:'XUSSTL D
- . . S XUSSTLN=$P($G(^VA(200,NPIEN,"PS1",XUSSTL,0)),U,2)
- . . I XUSSTLN'="" D
- . . . ;I XUSNP(25)="" S XUSNP(25)=XUSSTLN Q
- . . . ;S XUSNP(25)=XUSNP(25)_";"_XUSSTLN
- . . . I XUSNP(27)="" S XUSNP(27)=XUSSTLN Q
- . . . ;S XUSNP(27)=XUSNP(27)_";"_XUSSTLN
- . ;S XUSNP(28)=$P($G(^VA(200,NPIEN,"PS")),U,2)
- . ; *689 - DEA #
- . S XUSNP(28)=$$PRDEA^XUSER(NPIEN)
- . ;
- . ;S XUSDATA2=XUSDATA2_U_XUSNP(23)_U_XUSNP(24)_U_XUSNP(25)_U_XUSNP(26)
- . S XUSDATA2=XUSDATA2_U_XUSNP(25)_U_XUSNP(26)_U_XUSNP(27)_U_XUSNP(28)
- . ;
- . ; Add logic for STATUS and CREATION/TERMINATION DATE from file #200
- . S XUSNP(29)="",XUSNP(30)=""
- . S XUSNP(29)=$P($G(^VA(200,NPIEN,0)),U,11)
- . I $G(XUSNP(29))'="" S XUSNP(30)=$$FMTE^XLFDT(XUSNP(29),5),XUSNP(29)="TERMINATED"
- . I $G(XUSNP(29))="" S XUSNP(29)=$P($G(^VA(200,NPIEN,1)),U,7),XUSNP(30)=$$FMTE^XLFDT(XUSNP(29),5),XUSNP(29)="ACTIVE"
- . ;
- . S XUSDATA2=XUSDATA2_U_XUSNP(29)_U_XUSNP(30)
- . ;
- . ; Get BCBS Payer ID Array
- . K XUSBXID
- . D PRACID^XUSNPIXU(NPIEN,.XUSBXID)
- . ;
- . ; Save entry to ^TMP and update count
- . N XUSB,XUSB1
- . S XUSDIV=0
- . F S XUSDIV=$O(SPADR(XUSDIV)) Q:'XUSDIV D
- . . ;
- . . ; Pay to Provider Address NP7-12
- . . I $D(XUSTMP("P2P",XUSDIV)) D
- . . . S $P(XUSDATA1,U,7)=$P($G(^IBE(350.9,1,19,$G(XUSTMP("P2P",XUSDIV)),0)),U,2)
- . . . S $P(XUSDATA1,U,8)=$P($G(^IBE(350.9,1,19,$G(XUSTMP("P2P",XUSDIV)),1)),U,1)
- . . . S $P(XUSDATA1,U,9)=$P($G(^IBE(350.9,1,19,$G(XUSTMP("P2P",XUSDIV)),1)),U,2)
- . . . S $P(XUSDATA1,U,10)=$P($G(^IBE(350.9,1,19,$G(XUSTMP("P2P",XUSDIV)),1)),U,3)
- . . . S $P(XUSDATA1,U,11)=$P($G(^IBE(350.9,1,19,$G(XUSTMP("P2P",XUSDIV)),1)),U,4)
- . . . I $P(XUSDATA1,U,11)?1N.N S $P(XUSDATA1,U,11)=$P($G(^DIC(5,$P(XUSDATA1,U,11),0)),U,2)
- . . . S $P(XUSDATA1,U,12)=$P($G(^IBE(350.9,1,19,$G(XUSTMP("P2P",XUSDIV)),1)),U,5)
- . . . Q
- . . I '$D(XUSTMP("P2P",XUSDIV)) D
- . . . I '$D(XUSTMP("P2P","DEFAULT")) D Q
- . . . . F I=7:1:12 S $P(XUSDATA1,U,I)=""
- . . . N XUSDEF
- . . . S XUSDEF=$G(XUSTMP("P2P","DEFAULT"))
- . . . S $P(XUSDATA1,U,7)=$P($G(^IBE(350.9,1,19,XUSDEF,0)),U,2)
- . . . S $P(XUSDATA1,U,8)=$P($G(^IBE(350.9,1,19,XUSDEF,1)),U,1)
- . . . S $P(XUSDATA1,U,9)=$P($G(^IBE(350.9,1,19,XUSDEF,1)),U,2)
- . . . S $P(XUSDATA1,U,10)=$P($G(^IBE(350.9,1,19,XUSDEF,1)),U,3)
- . . . S $P(XUSDATA1,U,11)=$P($G(^IBE(350.9,1,19,XUSDEF,1)),U,4)
- . . . I $P(XUSDATA1,U,11)?1N.N S $P(XUSDATA1,U,11)=$P($G(^DIC(5,$P(XUSDATA1,U,11),0)),U,2)
- . . . S $P(XUSDATA1,U,12)=$P($G(^IBE(350.9,1,19,XUSDEF,1)),U,5)
- . . . Q
- . . ;
- . . S COUNT=COUNT+1,TOTREC=TOTREC+1
- . . S ^TMP(XUSRTN,$J,COUNT)=XUSDATA1_U_SPADR(XUSDIV)_U_XUSDATA2_U_XUSSTA(XUSDIV)_U_XUSEOL
- . . S XUSIZE=XUSIZE+$L(^TMP(XUSRTN,$J,COUNT))
- . . ; Check BCBS Id array
- . . 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 p528
- . . . . S COUNT=COUNT+1,TOTREC=TOTREC+1
- . . . . S ^TMP(XUSRTN,$J,COUNT)=XUSDATA1_U_SPADR(XUSDIV)_U_XUSDATA2_U_XUSSTA(XUSDIV)_U_$$TRIM^XLFSTR(XUSB)_XUSB1_U_XUSEOL ;add _XUSB1 p 528
- . . . . S XUSIZE=XUSIZE+$L(^TMP(XUSRTN,$J,COUNT))
- . K XUSNP,XUSDATA1,XUSDATA2,XUSDATA3,SPADR,XUSBXID,CNT,XUSSTA
- . I XUSIZE>MAXSIZE D
- . . D EOF(XUSRTN)
- . . D EMAIL^XUSNPIX5(XUSRTN) ;transmitting extract data via MailMan
- . . K ^TMP(XUSRTN,$J)
- . . S ^TMP("XUSNPIXS",$J,1,MSGCNT)="1^"_(COUNT-2)
- . . S ^TMP(XUSRTN,$J,1)=XUSHDR
- . . S COUNT=1,XUSIZE=0
- D EOF(XUSRTN)
- ;
- ; Send the last message (if it has records)
- I $G(COUNT)>1 D
- .D EMAIL^XUSNPIX5(XUSRTN) ;transmitting extract data via MailMan
- .K ^TMP(XUSRTN,$J)
- .S ^TMP("XUSNPIXS",$J,1,MSGCNT)="1^"_(COUNT-2)
- ;
- ; Set summary totals
- S ^XTMP("XUSNPIXT",0)=(DT+10000)_U_DT_U_"NPI EXTRACT SUMMARY TOTALS"_U_DT_U_$H
- S ^XTMP("XUSNPIXT","H")=$P(XUSHDR,U,1,4)
- S ^XTMP("XUSNPIXT",1)=MSGCNT_U_TOTREC_U_DTTM
- K INSMAIL,SITE
- Q
- ;
- EOF(XUSRTN) ;
- Q:COUNT=1
- S MSGCNT=MSGCNT+1
- S ^TMP(XUSRTN,$J,1)=XUSHDR_U_"Message Number: "_MSGCNT_U_"Line Count: "_COUNT_U_DTTM_U_$G(XUSPROD)_U_XUSEOL
- S COUNT=COUNT+1
- S ^TMP(XUSRTN,$J,COUNT)="END OF FILE"_U_XUSEOL
- Q
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HXUSNPIX1 13263 printed Feb 18, 2025@23:39:11 Page 2
- XUSNPIX1 ;OAK_BP/CMW - NPI EXTRACT REPORT ; Aug 30, 2022@04:49:29
- +1 ;;8.0;KERNEL;**438,452,453,481,528,548,774,689**; Jul 10, 1995;Build 113
- +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 ;
- +8 ; NPI Extract Report
- +9 ;
- +10 ; Input parameter: N/A
- +11 ;
- +12 ; Other relevant variables:
- +13 ; XUSRTN="XUSNPIX1" (current routine name, used for ^XTMP and ^TMP
- +14 ; storage subscript)
- +15 ; Storage Global:
- +16 ; ^XTMP("XUSNPIX1",0) = Piece 1^Piece 2^Piece 3^Piece 4^Piece 5^Piece 6
- +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 ; ^XTMP("XUSNPIX1",1) = DATA
- +26 ;
- +27 ; XUSNPI => Unique NPI of entry
- +28 ; LDT => Last Date Run, VA Fileman Format
- +29 ;
- +30 ; Entry Point - TASKMAN => Run report in background using TASKMAN
- +31 ;
- +32 QUIT
- +33 ;
- TASKMAN ;TASKMAN ENTRY POINT
- +1 ; Process Report
- +2 NEW XUSRTN,DTTM,XUSPROD,XUSVER,INSMAIL,XUSNP2P,XUSTMP
- +3 ;
- +4 ; Check for required variables
- +5 IF $GET(U)=""!($GET(DT)="")
- GOTO EXIT
- +6 SET XUSRTN="XUSNPIX1"
- +7 SET DTTM=$$HTE^XLFDT($HOROLOG,"2")
- +8 ; Check to see if report is in use
- +9 LOCK +^XTMP(XUSRTN):5
- IF '$TEST
- GOTO EXIT
- +10 ;
- +11 ;Reset Summary Scratch Globals
- +12 KILL ^TMP("XUSNPIXS",$JOB)
- +13 KILL ^TMP("XUSNPIXT",$JOB)
- +14 ;
- +15 ; Initialize variables
- +16 DO INIT(XUSRTN)
- +17 ;
- +18 ; Pull Station(Institution) data
- +19 DO INST(XUSRTN,XUSVER,.INSMAIL)
- +20 ;
- +21 ;Process New Person File
- +22 DO PROC1(XUSRTN,XUSPROD,XUSVER,DTTM,INSMAIL)
- +23 ;
- +24 ; Process Institution File
- +25 DO ENT^XUSNPIX2(XUSPROD,XUSVER)
- +26 ;
- +27 ; Process Non VA File
- +28 DO ENT^XUSNPIX3(XUSPROD,XUSVER)
- +29 ;
- +30 ; Send summary message
- +31 DO SMAIL^XUSNPIX5("XUSNPIXT",XUSPROD,XUSVER,DTTM)
- +32 ;
- +33 ;Standard EXIT point
- EXIT ;
- +1 KILL DTTM,XUSVER,XUSHDR,XUSPROD,INSMAIL
- +2 ;
- +3 ;Kill off Scratch Globals
- +4 KILL ^TMP("XUSNPIXS",$JOB)
- +5 KILL ^TMP("XUSNPIXT",$JOB)
- +6 KILL ^TMP("XUSNPIXU",$JOB)
- +7 KILL ^TMP("P2P")
- +8 ; Log Run Completion Time
- +9 SET $PIECE(^XTMP(XUSRTN,0),U,6)=$HOROLOG
- +10 LOCK -^XTMP(XUSRTN)
- +11 ;
- +12 QUIT
- +13 ;
- INIT(XUSRTN) ; check/init variables
- +1 NEW XUSDESC,IBSIEN,ZN19,P2PVAL
- +2 ; Set to NEXT release version from NPM
- +3 ; Update the build number here.
- +4 ; last patch to update the structure of the data extract (XU*8.0*548)
- SET XUSVER="548.14"
- +5 ;
- +6 ; Get production/test account flag
- +7 SET XUSPROD=$SELECT($$PROD^XUPROD(1):"PROD",1:"TEST")
- +8 ;
- +9 ; Reset Temporary Scratch Global
- +10 DO INIT^XUSNPIXU
- +11 KILL ^TMP(XUSRTN)
- +12 SET XUSDESC="NPI EXTRACT TYPE 1 - Do Not Delete"
- +13 SET ^XTMP(XUSRTN,0)=(DT+10000)_U_DT_U_XUSDESC_U_DT_U_$HOROLOG
- +14 ; Generate TMP BCBS Array
- +15 DO BCBSID^XUSNPIXU
- +16 ;XUSTMP array used for Type 1 and 2 VA
- DO P2PBASE^XUSNPIXU(.XUSTMP)
- +17 QUIT
- +18 ;
- MAILTO(XMY) ;sets the MailMan recipients based on need (XU*8.0*548)
- +1 ;
- +2 ;When you don't want data to go out to Austin's FSC but you need it to
- +3 ;stay within the VistA's MailMan for internal testing, comment out setting
- +4 ;the XMY("XXX@Q-NPS.DOMAIN.EXT) array and add your own MailMan address that
- +5 ;is present in the VistA account your are on.
- +6 ;When you want data to go out to Austin's FSC group, uncomment this line.
- +7 ;S XMY("XXX@Q-NPS.DOMAIN.EXT")="" ;uncomment to run for live ***
- +8 ;p774
- SET XUWHO606=$GET(XUWHO606,"XXX@Q-NPS.DOMAIN.EXT")
- +9 SET XMY(XUWHO606)=""
- +10 QUIT
- +11 ;
- INST(XUSRTN,XUSVER,INSMAIL) ;Pull station and Institution info
- +1 NEW INST,SINFO,DIC4
- +2 ; Pull site info
- +3 SET SINFO=$$SITE^VASITE
- +4 ; Station Number
- +5 SET SITE=$PIECE(SINFO,U,3)
- +6 ; Institution
- +7 SET INST=$PIECE(SINFO,U)
- +8 ;
- +9 ; Get institution mailing address
- +10 IF INST
- Begin DoDot:1
- +11 SET DIC4=$GET(^DIC(4,INST,4))
- +12 SET XUSNP(7)=$PIECE(DIC4,U)
- +13 SET XUSNP(8)=$PIECE(DIC4,U,2)
- +14 SET XUSNP(9)=$PIECE(DIC4,U,3)
- +15 SET XUSNP(10)=$PIECE(DIC4,U,4)
- +16 IF XUSNP(10)
- SET XUSNP(10)=$PIECE($GET(^DIC(5,XUSNP(10),0)),U,2)
- +17 SET XUSNP(11)=$PIECE(DIC4,U,5)
- +18 SET INSMAIL=XUSNP(7)_U_XUSNP(8)_U_XUSNP(9)_U_XUSNP(10)_U_XUSNP(11)
- End DoDot:1
- +19 SET XUSHDR="Station: "_SITE_U_XUSNP(9)_U_XUSNP(10)_U_XUSNP(11)_U_"TYPE 1"_U_XUSVER
- +20 ;
- +21 QUIT
- +22 ;
- PROC1(XUSRTN,XUSPROD,XUSVER,DTTM,INSMAIL) ;Process all New Person records
- +1 NEW XUSNPI,XUSDT,XUSNEW,XUSI,XUSDATA,XUSVA0,XUSVA0,XUSVA1,XUSNAME,XUSDOB,XUSDIV,XUSSTL,XUSSTLN,XUSOPN
- +2 NEW XUSPER,XUSSPC,XUSTAX,XUSTAXID,XUSIZE,NPIEN,DIC4,SPDIV,VA12,VA13,COUNT,MSGCNT,MAXSIZE,TOTREC,XUSEOL
- +3 NEW FND,XUSUSCT,XUSUSC1,I
- +4 ;
- +5 ; Set to 300000 for live
- +6 SET MAXSIZE=300000
- +7 ;
- +8 ; Set end of line character
- +9 SET XUSEOL="~~"
- +10 ;
- +11 ; set counter
- +12 SET COUNT=1
- SET (TOTREC,MSGCNT,XUSIZE)=0
- +13 ;
- +14 ; Loop through NEW PERSON NPI records NPI cross ref
- +15 SET XUSNPI=0
- +16 FOR
- SET XUSNPI=$ORDER(^VA(200,"ANPI",XUSNPI))
- if 'XUSNPI
- QUIT
- Begin DoDot:1
- +17 SET NPIEN=$ORDER(^VA(200,"ANPI",XUSNPI,""))
- +18 ;
- +19 ; Init columns
- +20 ;F XUSI=1:1:29 S XUSNP(XUSI)=""
- +21 FOR XUSI=1:1:33
- SET XUSNP(XUSI)=""
- +22 SET XUSNP(1)=XUSNPI
- SET XUSDATA1=XUSNP(1)
- +23 ;
- +24 SET XUSVA0=$GET(^VA(200,NPIEN,0))
- +25 SET XUSVA1=$GET(^VA(200,NPIEN,1))
- +26 SET XUSNAME=$PIECE(XUSVA0,U)
- +27 ;
- +28 ; Break name into components
- +29 IF XUSNAME'=""
- Begin DoDot:2
- +30 SET XLFNC=XUSNAME
- DO FORMAT^XLFNAME7(.XLFNC,,,,0)
- +31 ;p774
- IF $GET(XLFNC("FAMILY"))=""
- SET XLFNC("FAMILY")=$GET(XUSNAME)
- +32 ;p774
- SET XUSNP(2)=$GET(XLFNC("GIVEN"))
- SET XUSNP(3)=$GET(XLFNC("MIDDLE"))
- SET XUSNP(4)=$GET(XLFNC("FAMILY"))
- +33 IF $GET(XLFNC("SUFFIX"))'=""
- SET XUSNP(4)=XUSNP(4)_" "_XLFNC("SUFFIX")
- +34 KILL XLFNC
- End DoDot:2
- +35 SET XUSDATA1=XUSDATA1_U_XUSNP(2)_U_XUSNP(3)_U_XUSNP(4)
- +36 ;
- +37 ;type
- SET XUSNP(5)=1
- +38 SET XUSDOB=$PIECE(XUSVA1,U,3)
- +39 ; dob formatted as mm/dd/yyyy
- +40 IF XUSDOB
- Begin DoDot:2
- +41 SET XUSNP(6)=$$FMTE^XLFDT(XUSDOB,5)
- End DoDot:2
- +42 SET XUSDATA1=XUSDATA1_U_XUSNP(5)_U_XUSNP(6)
- +43 ;
- +44 ; Office Phone number
- +45 SET XUSOPN=$PIECE($GET(^VA(200,NPIEN,.13)),U,2)
- +46 ;I XUSOPN'="" S XUSNP(17)=XUSOPN
- +47 IF XUSOPN'=""
- SET XUSNP(18)=XUSOPN
- +48 ;
- +49 ; Servicing Provider Address
- +50 SET (XUSDIV)=0
- +51 ; Loop through Division multiple
- +52 FOR
- SET XUSDIV=$ORDER(^VA(200,NPIEN,2,XUSDIV))
- if 'XUSDIV
- QUIT
- Begin DoDot:2
- +53 SET DIC4=$GET(^DIC(4,XUSDIV,4))
- +54 SET XUSNP(13)=$PIECE(DIC4,U)
- +55 SET XUSNP(14)=$PIECE(DIC4,U,2)
- +56 SET XUSNP(15)=$PIECE(DIC4,U,3)
- +57 SET XUSNP(16)=$PIECE(DIC4,U,4)
- +58 IF XUSNP(16)
- SET XUSNP(16)=$PIECE($GET(^DIC(5,XUSNP(16),0)),U,2)
- +59 SET XUSNP(17)=$PIECE(DIC4,U,5)
- +60 SET XUSSTA(XUSDIV)=$PIECE($GET(^DIC(4,XUSDIV,99)),U)
- +61 SET SPADR(XUSDIV)=XUSNP(13)_U_XUSNP(14)_U_XUSNP(15)_U_XUSNP(16)_U_XUSNP(17)_U_XUSNP(18)
- End DoDot:2
- +62 ;
- +63 ; If no divisions found
- +64 IF '$DATA(SPADR)
- Begin DoDot:2
- +65 SET XUSSTA(9999)="N/A"
- SET SPADR(9999)=XUSNP(13)_U_XUSNP(14)_U_XUSNP(15)_U_XUSNP(16)_U_XUSNP(17)_U_XUSNP(18)
- End DoDot:2
- +66 ;
- +67 ; Degree
- +68 SET XUSNP(19)=$PIECE($GET(^VA(200,NPIEN,3.1)),U,6)
- +69 ; Degree Code (place holder, currently empty)
- +70 SET XUSNP(20)=""
- +71 ;
- +72 ; get primary specialty
- +73 SET XUSPER=0
- +74 FOR
- SET XUSPER=$ORDER(^VA(200,NPIEN,"USC1","B",XUSPER))
- if 'XUSPER
- QUIT
- Begin DoDot:2
- +75 SET XUSSPC=$PIECE($GET(^USC(8932.1,XUSPER,0)),U,9)
- +76 ;S XUSTAX=$P($G(^USC(8932.1,XUSPER,0)),U,7)
- +77 IF XUSSPC'=""
- Begin DoDot:3
- +78 ;I XUSNP(20)="" S XUSNP(20)=XUSSPC Q
- +79 ;S XUSNP(20)=XUSNP(20)_";"_XUSSPC
- +80 IF XUSNP(21)=""
- SET XUSNP(21)=XUSSPC
- QUIT
- +81 SET XUSNP(21)=XUSNP(21)_";"_XUSSPC
- +82 QUIT
- End DoDot:3
- +83 QUIT
- End DoDot:2
- +84 ;get taxonomy (primary and all secondaries)
- +85 ; ptr to Person class, expiration date
- NEW XUSCLASS,XUSEXPDT
- +86 SET XUSPER=0
- +87 KILL ^XTMP("USC1",$JOB)
- +88 FOR
- SET XUSPER=$ORDER(^VA(200,NPIEN,"USC1","AD",XUSPER))
- if 'XUSPER
- QUIT
- Begin DoDot:2
- +89 SET XUSUSC1=""
- +90 FOR
- SET XUSUSC1=$ORDER(^VA(200,NPIEN,"USC1","AD",XUSPER,XUSUSC1))
- if XUSUSC1=""
- QUIT
- Begin DoDot:3
- +91 SET XUSCLASS=$PIECE($GET(^VA(200,NPIEN,"USC1",XUSUSC1,0)),U)
- SET XUSEXPDT=$PIECE($GET(^VA(200,NPIEN,"USC1",XUSUSC1,0)),U,3)
- +92 SET ^XTMP("USC1",$JOB,XUSUSC1)=XUSEXPDT_U_XUSCLASS
- +93 QUIT
- End DoDot:3
- +94 QUIT
- End DoDot:2
- +95 ;find primary taxonomy code
- +96 SET XUSUSC1=""
- SET FND=0
- SET XUSUSCT=""
- +97 FOR
- SET XUSUSC1=$ORDER(^XTMP("USC1",$JOB,XUSUSC1),-1)
- if XUSUSC1=""!(FND=1)
- QUIT
- Begin DoDot:2
- +98 ; not active, expiration dt exists
- IF $PIECE($GET(^XTMP("USC1",$JOB,XUSUSC1)),U)'=""
- QUIT
- +99 SET XUSCLASS=$PIECE($GET(^XTMP("USC1",$JOB,XUSUSC1)),U,2)
- +100 IF XUSCLASS=""
- QUIT
- +101 SET XUSNP(22)=$PIECE($GET(^USC(8932.1,XUSCLASS,0)),U,7)
- SET FND=1
- SET XUSUSCT=XUSUSC1
- +102 QUIT
- End DoDot:2
- +103 ;remove the active taxonomy code
- IF $DATA(^XTMP("USC1",$JOB))&$GET(XUSUSCT)
- KILL ^XTMP("USC1",$JOB,XUSUSCT)
- +104 SET XUSUSC1=""
- +105 FOR
- SET XUSUSC1=$ORDER(^XTMP("USC1",$JOB,XUSUSC1))
- if XUSUSC1=""
- QUIT
- Begin DoDot:2
- +106 SET XUSCLASS=$PIECE($GET(^XTMP("USC1",$JOB,XUSUSC1)),U,2)
- +107 IF XUSCLASS=""
- QUIT
- +108 SET XUSTAX=$PIECE($GET(^USC(8932.1,XUSCLASS,0)),U,7)
- +109 IF XUSTAX'=""
- Begin DoDot:3
- +110 ;
- +111 IF XUSNP(23)=""
- SET XUSNP(23)=XUSTAX
- QUIT
- +112 ;
- +113 ; *** Start ^XU*8.0*548 - RBN ***
- +114 ;
- +115 ;S XUSNP(23)=XUSNP(23)_";"_XUSTAX
- +116 if (XUSNP(23)'[XUSTAX&(XUSTAX'=XUSNP(22)))
- SET XUSNP(23)=XUSNP(23)_";"_XUSTAX
- +117 ;
- +118 ; *** End ^XU*8.0*548 - RBN ***
- +119 ;
- End DoDot:3
- End DoDot:2
- +120 ;
- +121 ; Tax ID
- +122 SET XUSTAXID=$PIECE($GET(^VA(200,NPIEN,"TPB")),U,2)
- +123 IF XUSTAXID=""
- SET XUSTAXID=$PIECE($GET(^VA(200,NPIEN,1)),U,9)
- +124 ;S XUSNP(22)=XUSTAXID
- +125 SET XUSNP(24)=XUSTAXID
- +126 ;
- +127 ;S XUSDATA2=XUSNP(17)_U_XUSNP(18)_U_XUSNP(19)_U_XUSNP(20)_U_XUSNP(21)_U_XUSNP(22)
- +128 SET XUSDATA2=XUSNP(19)_U_XUSNP(20)_U_XUSNP(21)_U_XUSNP(22)_U_XUSNP(23)_U_XUSNP(24)
- +129 ;
- +130 ; Medicare Part A/B
- +131 ;S XUSNP(23)=670899
- +132 ;S XUSNP(24)="VA"_$E(SITE+10000,2,5)
- +133 SET XUSNP(25)=670899
- +134 SET XUSNP(26)="VA"_$EXTRACT(SITE+10000,2,5)
- +135 ;
- +136 ; State License
- +137 SET XUSSTL=0
- +138 FOR
- SET XUSSTL=$ORDER(^VA(200,NPIEN,"PS1",XUSSTL))
- if 'XUSSTL
- QUIT
- Begin DoDot:2
- +139 SET XUSSTLN=$PIECE($GET(^VA(200,NPIEN,"PS1",XUSSTL,0)),U,2)
- +140 IF XUSSTLN'=""
- Begin DoDot:3
- +141 ;I XUSNP(25)="" S XUSNP(25)=XUSSTLN Q
- +142 ;S XUSNP(25)=XUSNP(25)_";"_XUSSTLN
- +143 IF XUSNP(27)=""
- SET XUSNP(27)=XUSSTLN
- QUIT
- +144 ;S XUSNP(27)=XUSNP(27)_";"_XUSSTLN
- End DoDot:3
- End DoDot:2
- +145 ;S XUSNP(28)=$P($G(^VA(200,NPIEN,"PS")),U,2)
- +146 ; *689 - DEA #
- +147 SET XUSNP(28)=$$PRDEA^XUSER(NPIEN)
- +148 ;
- +149 ;S XUSDATA2=XUSDATA2_U_XUSNP(23)_U_XUSNP(24)_U_XUSNP(25)_U_XUSNP(26)
- +150 SET XUSDATA2=XUSDATA2_U_XUSNP(25)_U_XUSNP(26)_U_XUSNP(27)_U_XUSNP(28)
- +151 ;
- +152 ; Add logic for STATUS and CREATION/TERMINATION DATE from file #200
- +153 SET XUSNP(29)=""
- SET XUSNP(30)=""
- +154 SET XUSNP(29)=$PIECE($GET(^VA(200,NPIEN,0)),U,11)
- +155 IF $GET(XUSNP(29))'=""
- SET XUSNP(30)=$$FMTE^XLFDT(XUSNP(29),5)
- SET XUSNP(29)="TERMINATED"
- +156 IF $GET(XUSNP(29))=""
- SET XUSNP(29)=$PIECE($GET(^VA(200,NPIEN,1)),U,7)
- SET XUSNP(30)=$$FMTE^XLFDT(XUSNP(29),5)
- SET XUSNP(29)="ACTIVE"
- +157 ;
- +158 SET XUSDATA2=XUSDATA2_U_XUSNP(29)_U_XUSNP(30)
- +159 ;
- +160 ; Get BCBS Payer ID Array
- +161 KILL XUSBXID
- +162 DO PRACID^XUSNPIXU(NPIEN,.XUSBXID)
- +163 ;
- +164 ; Save entry to ^TMP and update count
- +165 NEW XUSB,XUSB1
- +166 SET XUSDIV=0
- +167 FOR
- SET XUSDIV=$ORDER(SPADR(XUSDIV))
- if 'XUSDIV
- QUIT
- Begin DoDot:2
- +168 ;
- +169 ; Pay to Provider Address NP7-12
- +170 IF $DATA(XUSTMP("P2P",XUSDIV))
- Begin DoDot:3
- +171 SET $PIECE(XUSDATA1,U,7)=$PIECE($GET(^IBE(350.9,1,19,$GET(XUSTMP("P2P",XUSDIV)),0)),U,2)
- +172 SET $PIECE(XUSDATA1,U,8)=$PIECE($GET(^IBE(350.9,1,19,$GET(XUSTMP("P2P",XUSDIV)),1)),U,1)
- +173 SET $PIECE(XUSDATA1,U,9)=$PIECE($GET(^IBE(350.9,1,19,$GET(XUSTMP("P2P",XUSDIV)),1)),U,2)
- +174 SET $PIECE(XUSDATA1,U,10)=$PIECE($GET(^IBE(350.9,1,19,$GET(XUSTMP("P2P",XUSDIV)),1)),U,3)
- +175 SET $PIECE(XUSDATA1,U,11)=$PIECE($GET(^IBE(350.9,1,19,$GET(XUSTMP("P2P",XUSDIV)),1)),U,4)
- +176 IF $PIECE(XUSDATA1,U,11)?1N.N
- SET $PIECE(XUSDATA1,U,11)=$PIECE($GET(^DIC(5,$PIECE(XUSDATA1,U,11),0)),U,2)
- +177 SET $PIECE(XUSDATA1,U,12)=$PIECE($GET(^IBE(350.9,1,19,$GET(XUSTMP("P2P",XUSDIV)),1)),U,5)
- +178 QUIT
- End DoDot:3
- +179 IF '$DATA(XUSTMP("P2P",XUSDIV))
- Begin DoDot:3
- +180 IF '$DATA(XUSTMP("P2P","DEFAULT"))
- Begin DoDot:4
- +181 FOR I=7:1:12
- SET $PIECE(XUSDATA1,U,I)=""
- End DoDot:4
- QUIT
- +182 NEW XUSDEF
- +183 SET XUSDEF=$GET(XUSTMP("P2P","DEFAULT"))
- +184 SET $PIECE(XUSDATA1,U,7)=$PIECE($GET(^IBE(350.9,1,19,XUSDEF,0)),U,2)
- +185 SET $PIECE(XUSDATA1,U,8)=$PIECE($GET(^IBE(350.9,1,19,XUSDEF,1)),U,1)
- +186 SET $PIECE(XUSDATA1,U,9)=$PIECE($GET(^IBE(350.9,1,19,XUSDEF,1)),U,2)
- +187 SET $PIECE(XUSDATA1,U,10)=$PIECE($GET(^IBE(350.9,1,19,XUSDEF,1)),U,3)
- +188 SET $PIECE(XUSDATA1,U,11)=$PIECE($GET(^IBE(350.9,1,19,XUSDEF,1)),U,4)
- +189 IF $PIECE(XUSDATA1,U,11)?1N.N
- SET $PIECE(XUSDATA1,U,11)=$PIECE($GET(^DIC(5,$PIECE(XUSDATA1,U,11),0)),U,2)
- +190 SET $PIECE(XUSDATA1,U,12)=$PIECE($GET(^IBE(350.9,1,19,XUSDEF,1)),U,5)
- +191 QUIT
- End DoDot:3
- +192 ;
- +193 SET COUNT=COUNT+1
- SET TOTREC=TOTREC+1
- +194 SET ^TMP(XUSRTN,$JOB,COUNT)=XUSDATA1_U_SPADR(XUSDIV)_U_XUSDATA2_U_XUSSTA(XUSDIV)_U_XUSEOL
- +195 SET XUSIZE=XUSIZE+$LENGTH(^TMP(XUSRTN,$JOB,COUNT))
- +196 ; Check BCBS Id array
- +197 IF $DATA(XUSBXID)
- Begin DoDot:3
- +198 SET XUSB=""
- +199 FOR
- SET XUSB=$ORDER(XUSBXID(XUSB))
- if XUSB=""
- QUIT
- Begin DoDot:4
- +200 ;add p528
- SET XUSB1=$GET(XUSBXID(XUSB))
- IF XUSB1'=""
- SET XUSB1="^"_XUSB1
- +201 SET COUNT=COUNT+1
- SET TOTREC=TOTREC+1
- +202 ;add _XUSB1 p 528
- SET ^TMP(XUSRTN,$JOB,COUNT)=XUSDATA1_U_SPADR(XUSDIV)_U_XUSDATA2_U_XUSSTA(XUSDIV)_U_$$TRIM^XLFSTR(XUSB)_XUSB1_U_XUSEOL
- +203 SET XUSIZE=XUSIZE+$LENGTH(^TMP(XUSRTN,$JOB,COUNT))
- End DoDot:4
- End DoDot:3
- End DoDot:2
- +204 KILL XUSNP,XUSDATA1,XUSDATA2,XUSDATA3,SPADR,XUSBXID,CNT,XUSSTA
- +205 IF XUSIZE>MAXSIZE
- Begin DoDot:2
- +206 DO EOF(XUSRTN)
- +207 ;transmitting extract data via MailMan
- DO EMAIL^XUSNPIX5(XUSRTN)
- +208 KILL ^TMP(XUSRTN,$JOB)
- +209 SET ^TMP("XUSNPIXS",$JOB,1,MSGCNT)="1^"_(COUNT-2)
- +210 SET ^TMP(XUSRTN,$JOB,1)=XUSHDR
- +211 SET COUNT=1
- SET XUSIZE=0
- End DoDot:2
- End DoDot:1
- +212 DO EOF(XUSRTN)
- +213 ;
- +214 ; Send the last message (if it has records)
- +215 IF $GET(COUNT)>1
- Begin DoDot:1
- +216 ;transmitting extract data via MailMan
- DO EMAIL^XUSNPIX5(XUSRTN)
- +217 KILL ^TMP(XUSRTN,$JOB)
- +218 SET ^TMP("XUSNPIXS",$JOB,1,MSGCNT)="1^"_(COUNT-2)
- End DoDot:1
- +219 ;
- +220 ; Set summary totals
- +221 SET ^XTMP("XUSNPIXT",0)=(DT+10000)_U_DT_U_"NPI EXTRACT SUMMARY TOTALS"_U_DT_U_$HOROLOG
- +222 SET ^XTMP("XUSNPIXT","H")=$PIECE(XUSHDR,U,1,4)
- +223 SET ^XTMP("XUSNPIXT",1)=MSGCNT_U_TOTREC_U_DTTM
- +224 KILL INSMAIL,SITE
- +225 QUIT
- +226 ;
- EOF(XUSRTN) ;
- +1 if COUNT=1
- QUIT
- +2 SET MSGCNT=MSGCNT+1
- +3 SET ^TMP(XUSRTN,$JOB,1)=XUSHDR_U_"Message Number: "_MSGCNT_U_"Line Count: "_COUNT_U_DTTM_U_$GET(XUSPROD)_U_XUSEOL
- +4 SET COUNT=COUNT+1
- +5 SET ^TMP(XUSRTN,$JOB,COUNT)="END OF FILE"_U_XUSEOL
- +6 QUIT