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

XUSNPIX2.m

Go to the documentation of this file.
  1. XUSNPIX2 ;OAK_BP/CMW - NPI EXTRACT REPORT ;7/7/08 17:17
  1. ;;8.0;KERNEL;**438,452,453,481,548**; Jul 10, 1995;Build 24
  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. ;
  1. ; NPI Extract Report
  1. ;
  1. ; Input parameter: N/A
  1. ;
  1. ; Other relevant variables:
  1. ; XUSRTN="XUSNPIX2" (current routine name, used for ^XTMP and ^TMP
  1. ; storage subscript)
  1. ; Storage Global:
  1. ; ^XTMP("XUSNPIX2",0) = Piece 1^Piece 2^Piece 3^Piece 4^Piece 5^Piece 6
  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. ; ^XTMP("XUSNPIX2",1) = STATION INFO
  1. ; ^XTMP("XUSNPIX2",2) = DATA
  1. ;
  1. ; NPI => Unique NPI of entry
  1. ; LDT => Last Date Run, VA Fileman Format
  1. ;
  1. ; Entry Point - ENT called from XUSNPIX1
  1. ;
  1. Q
  1. ;
  1. ENT(XUSPROD,XUSVER) ; ENTRY POINT
  1. ; Initialize variables
  1. N XUSRTN
  1. S XUSRTN="XUSNPIX2"
  1. S DTTM2=$$HTE^XLFDT($H,"2")
  1. ; Check to see if report is in use
  1. L +^XTMP(XUSRTN):5 I '$T G EXIT
  1. ; Process Institution File
  1. D INIT(XUSRTN)
  1. ; Pull Station(Institution) data
  1. D STAT(XUSRTN)
  1. ; Process Report
  1. D PROC2(XUSRTN,XUSPROD,DTTM2)
  1. ;
  1. ; Standard EXIT point
  1. EXIT ;
  1. K ^TMP(XUSRTN,$J),^TMP($J,"XUS59"),^TMP("XUSNPIX",$J)
  1. ; Log Run Completion Time
  1. S $P(^XTMP(XUSRTN,0),U,6)=$H
  1. L -^XTMP(XUSRTN)
  1. K P,XUSPT,INST,DTTM2,XUSIZE,XUSHDR,XUSTAXID
  1. Q
  1. ;
  1. INIT(XUSRTN) ; check/init variables
  1. N XUSDESC
  1. ;
  1. ; Reset Temporary Scratch Global
  1. K ^TMP(XUSRTN)
  1. S XUSDESC="NPI EXTRACT TYPE 2 - Do Not Delete"
  1. S ^XTMP(XUSRTN,0)=(DT+10000)_U_DT_U_XUSDESC_U_DT_U_$H
  1. ;
  1. I '$D(^TMP("XUSNPIXU",$J)) D BCBSID^XUSNPIXU
  1. ;
  1. ; Create pharmacy institution ^TMP file
  1. D GETPHARM
  1. Q
  1. ;
  1. STAT(XUSRTN) ; Pull station and Institution info
  1. N SINFO,DIC4,IBSITE,XUSCITY,XUSSTATE,XUSZIP
  1. S (XUSCITY,XUSSTATE,XUSZIP)=""
  1. ; Pull site info
  1. S SINFO=$$SITE^VASITE
  1. ; Station Number
  1. S SITE=$P(SINFO,U,3)
  1. ; Institution
  1. S INST=$P(SINFO,U)
  1. ;
  1. ; Get Federal Tax Id
  1. S XUSTAXID=""
  1. S IBSITE=0
  1. F S IBSITE=$O(^IBE(350.9,IBSITE)) Q:'IBSITE!(XUSTAXID'="") D
  1. . S XUSTAXID=$P($G(^IBE(350.9,IBSITE,1)),U,5)
  1. ;
  1. ; *** Start XU*8.0*548 - RBN ***
  1. ; Get header for extracted data NOT email
  1. I INST D
  1. . S DIC4=$G(^DIC(4,INST,4))
  1. . S XUSCITY=$P(DIC4,U,3)
  1. . S XUSSTATE=$P(DIC4,U,4)
  1. . I XUSSTATE S XUSSTATE=$P($G(^DIC(5,XUSSTATE,0)),U,2)
  1. . S XUSZIP=$P(DIC4,U,5)
  1. S XUSHDR="Station: "_SITE_U_XUSCITY_U_XUSSTATE_U_XUSZIP_U_"TYPE 2"_U_XUSVER
  1. ;
  1. Q
  1. ;
  1. PROC2(XUSRTN,XUSPROD,DTTM2) ;Process all Institution records
  1. N XUSNPI,XUSNEW,XUSDT,XUSI,XUSIN,XUSTXY,XUSSPC,XUSTAX,XUPHM,XUSDIV
  1. N XUSFCT,XUSFCN,XUSDATA1,XUSDATA2,XUSDATA3,XUSDATA4,XUSDATA5,XUSSTA,XUSEOL
  1. N INIEN,DIC0,DIC1,PSIEN,NPIINS,RELINS,PSSTA,COUNT,TOTREC,MSGCNT,MAXSIZE,XUSBFN,I
  1. ;
  1. ; Set to 300000 for live
  1. S MAXSIZE=300000
  1. ;
  1. ; Set end of line character
  1. S XUSEOL="~~"
  1. ;
  1. ; set counter
  1. S COUNT=1,(TOTREC,MSGCNT,XUSIZE)=0
  1. ; Loop through INSTITUTION NPI records NPI xref
  1. S XUSNPI=0
  1. F S XUSNPI=$O(^DIC(4,"ANPI",XUSNPI)) Q:'XUSNPI D
  1. . S INIEN=$O(^DIC(4,"ANPI",XUSNPI,""))
  1. . ;
  1. . ; Get Station Number
  1. . S XUSSTA=$P($G(^DIC(4,INIEN,99)),U)
  1. . ; Parent of Association
  1. . I (INIEN'=INST)&('$$POA(INIEN,INST)) Q
  1. . ; Initialize columns
  1. . F XUSI=1:1:24 S XUSIN(XUSI)=""
  1. . ;
  1. . S XUSIN(1)=XUSNPI
  1. . S DIC0=$G(^DIC(4,INIEN,0)) Q:DIC0=""
  1. . ;Organization Name
  1. . S XUSIN(2)=$P($G(^DIC(4,INIEN,99)),U,2)
  1. . S XUSIN(3)=2
  1. . S XUSDATA1=XUSIN(1)_U_XUSIN(2)_U_XUSIN(3)
  1. . ;
  1. . ; Pay to Provider Address
  1. . S XUSDIV=""
  1. . I $D(XUSTMP("P2P","DEFAULT")) S XUSDIV=XUSTMP("P2P","DEFAULT")
  1. . I $D(XUSTMP("P2P",INIEN))=1 S XUSDIV=XUSTMP("P2P",INIEN)
  1. . I XUSDIV="" F I=1:1:6 S $P(XUSDATA2,U,I)=""
  1. . I XUSDIV'="" S XUSDATA2=$$P2PEXP^XUSNPIXU(XUSDIV)
  1. . ;
  1. . ; Servicing Provider Address
  1. . S DIC1=$G(^DIC(4,INIEN,1))
  1. . I DIC1'="" D
  1. . . S XUSIN(10)=$P(DIC1,U)
  1. . . S XUSIN(11)=$P(DIC1,U,2)
  1. . . S XUSIN(12)=$P(DIC1,U,3)
  1. . . S XUSIN(13)=$P($G(DIC0),U,2)
  1. . . I XUSIN(13) S XUSIN(13)=$P($G(^DIC(5,XUSIN(13),0)),U,2)
  1. . . S XUSIN(14)=$P(DIC1,U,4)
  1. . S XUSDATA3=XUSIN(10)_U_XUSIN(11)_U_XUSIN(12)_U_XUSIN(13)_U_XUSIN(14)
  1. . ;
  1. . ;Phone number (place holder)
  1. . S XUSIN(15)=""
  1. . ;
  1. . ; Get Taxonomy and Specialty
  1. . S XUSTXY=0
  1. . F S XUSTXY=$O(^DIC(4,INIEN,"TAXONOMY","B",XUSTXY)) Q:'XUSTXY D
  1. . . S XUSSPC=$P($G(^USC(8932.1,XUSTXY,0)),U,9)
  1. . . S XUSTAX=$P($G(^USC(8932.1,XUSTXY,0)),U,7)
  1. . . I XUSSPC'="" D
  1. . . . I XUSIN(16)="" S XUSIN(16)=XUSSPC Q
  1. . . . S XUSIN(16)=XUSIN(16)_";"_XUSSPC
  1. . . I XUSTAX'="" D
  1. . . . I XUSIN(17)="" S XUSIN(17)=XUSTAX Q
  1. . . . ;S XUSIN(17)=XUSIN(17)_";"_XUSTAX
  1. . . . ;
  1. . . . ; *** Start ^XU*8.0*548 - RBN ***
  1. . . . ;
  1. . . . S:(XUSIN(17)'[XUSTAX) XUSIN(17)=XUSIN(17)_";"_XUSTAX
  1. . . . ;
  1. . . . ; *** End ^XU*8.0*548 - RBN ***
  1. . ;
  1. . ; Federal Tax ID
  1. . S XUSIN(18)=$G(XUSTAXID)
  1. . ;
  1. . ; Medicaid Part A/B
  1. . S XUSIN(19)=670899
  1. . S XUSIN(20)="VA"_$E(SITE+10000,2,5)
  1. . ;
  1. . S XUSDATA4=XUSIN(15)_U_XUSIN(16)_U_XUSIN(17)_U_XUSIN(18)_U_XUSIN(19)_U_XUSIN(20)
  1. . ;
  1. . ; DEA Number
  1. . S XUSIN(21)=$P($G(^DIC(4,INIEN,"DEA")),U)
  1. . ;
  1. . ; get Facility Type and Name
  1. . S XUSFCT=$P($G(^DIC(4,INIEN,3)),U)
  1. . I XUSFCT'="" S XUSFCN=$P($G(^DIC(4.1,XUSFCT,0)),U)
  1. . I $G(XUSFCN)="PHARM" D
  1. . . I $D(^TMP("XUSNPIX",$J,INIEN)) D
  1. . . . S XUPHM=^TMP("XUSNPIX",$J,INIEN)
  1. . . . ; get NCPDP from ^TMP
  1. . . . S XUSIN(22)=$P($G(XUPHM),U)
  1. . . . ; get station number from^TMP
  1. . . . I $P($G(XUPHM),U,2) S XUSSTA=$P(XUPHM,U,2)
  1. . ;
  1. . ; VISN Station Number
  1. . S XUSIN(23)=XUSSTA
  1. . ;
  1. . S XUSDATA5=XUSIN(21)_U_XUSIN(22)_U_XUSIN(23)
  1. . ;
  1. . ; Get BCBS Payer ID Array
  1. . K XUSBXID
  1. . D INSTID^XUSNPIXU(.XUSBXID)
  1. . ;
  1. . ; Update counter and save Entry
  1. . ;
  1. . S COUNT=COUNT+1,TOTREC=TOTREC+1
  1. . S ^TMP(XUSRTN,$J,COUNT)=XUSDATA1_U_XUSDATA2_U_XUSDATA3_U_XUSDATA4_U_XUSDATA5_U_XUSEOL
  1. . S XUSIZE=XUSIZE+$L(^TMP(XUSRTN,$J,COUNT))
  1. . I $D(XUSBXID) D
  1. . . S XUSB=""
  1. . . F S XUSB=$O(XUSBXID(XUSB)) Q:XUSB="" D
  1. . . . S COUNT=COUNT+1,TOTREC=TOTREC+1
  1. . . . S ^TMP(XUSRTN,$J,COUNT)=XUSDATA1_U_XUSDATA2_U_XUSDATA3_U_XUSDATA4_U_XUSDATA5_U_XUSB_U_XUSBXID(XUSB)_U_XUSEOL
  1. . . . S XUSIZE=XUSIZE+$L(^TMP(XUSRTN,$J,COUNT))
  1. . K XUSIN,XUSDATA1,XUSDATA2,XUSDATA3,XUSDATA4,XUSDATA5,XUSB,XUSBXID
  1. . I XUSIZE>MAXSIZE D
  1. . . D EOF(XUSRTN)
  1. . . D EMAIL(XUSRTN) ;sending extracted data via MailMan
  1. . . K ^TMP(XUSRTN,$J)
  1. . . S ^TMP("XUSNPIXS",$J,2,MSGCNT)="2^"_(COUNT-2)
  1. . . S ^TMP(XUSRTN,$J,1)=XUSHDR
  1. . . S COUNT=1,XUSIZE=0
  1. ;
  1. D EOF(XUSRTN)
  1. ;
  1. ; Send the last message (if it has records)
  1. I $G(COUNT)>1 D
  1. .D EMAIL(XUSRTN) ;sending extracted data via MailMan
  1. .K ^TMP(XUSRTN,$J)
  1. .S ^TMP("XUSNPIXS",$J,2,MSGCNT)="2^"_(COUNT-2)
  1. ;
  1. ; Set Summary totals
  1. S ^XTMP("XUSNPIXT",2)=MSGCNT_U_TOTREC_U_DTTM2
  1. ;
  1. K XUSPT,LDTCMP,SITE,XUSTAXID
  1. Q
  1. ;
  1. EOF(XUSRTN) ;
  1. Q:COUNT=1
  1. S MSGCNT=MSGCNT+1
  1. S ^TMP(XUSRTN,$J,1)=XUSHDR_U_"Message Number: "_MSGCNT_U_"Line Count: "_COUNT_U_DTTM2_U_$G(XUSPROD)_U_XUSEOL
  1. S COUNT=COUNT+1
  1. S ^TMP(XUSRTN,$J,COUNT)="END OF FILE"_U_XUSEOL
  1. Q
  1. ;
  1. ; Email the message
  1. EMAIL(XUSRTN) ;
  1. N XMY
  1. ; Send email to designated recipients for live release
  1. D MAILTO^XUSNPIX1(.XMY) ;p548
  1. D ESEND
  1. Q
  1. ;
  1. ESEND N XMTEXT,XMSUB,XMDUN,XMDUZ,XMZ,XMMG,DIFROM
  1. ;
  1. S XMTEXT="^TMP("""_XUSRTN_""","_$J_","
  1. S XMSUB=$TR($P($G(^TMP(XUSRTN,$J,1)),U),":")_"("_$G(XUSPROD)_") NPI EXTRACT TYPE 2"
  1. D ^XMD
  1. Q
  1. POA(IEN,INST) ; Check Parent of Association for Institution IEN up to VISN level to see if INST is in the chain
  1. N XUSPOA
  1. I +$G(INST)=0 Q 0 ; No institution - return false
  1. POA1 ;
  1. I $G(IEN)="" Q 0 ; No IEN remaining to check - return false
  1. I $D(XUSPOA(IEN)) Q 0 ; Already reviewed this IEN - possible infinite loop - return false
  1. S XUSPOA(IEN)=""
  1. S XUSPOA=$P($G(^DIC(4,IEN,7,2,0)),U,2) ; Get parent of this institution
  1. I XUSPOA=INST Q 1 ; Found matching institution - return true
  1. I IEN=XUSPOA Q 0 ; Top level reached - return false
  1. S IEN=XUSPOA ; Reset IEN to check next level
  1. G POA1
  1. ;
  1. GETPHARM ;
  1. ; this subroutine retrieves data from the OUTPATIENT SITE file
  1. ; using the supported Pharmacy API PSS^PSO59.
  1. ; It takes the results and places them into a temporary
  1. ; global array that is accessed when processing data
  1. ; associated with a pharmacy institution.
  1. N D,DIC,XUS59DA,XUSNPIDA,XUSRELDA,PSSTA,Y,X,XUNCP
  1. ;
  1. ;Fix for Remedy Ticket 217164
  1. ;Quit if Outpatient Site API routine is not loaded
  1. S X="PSO59" X ^%ZOSF("TEST") Q:'$T
  1. ;
  1. K ^TMP($J,"XUS59"),^TMP("XUSNPIX",$J) ; remove any pre-existing nodes
  1. D PSS^PSO59(,"??","XUS59") ;IA#4827
  1. S XUS59DA=0
  1. ; gather data from each Outpatient site entry stored in the pharmacy
  1. ; ^TMP global and build 2nd ^TMP global for later processing
  1. F S XUS59DA=$O(^TMP($J,"XUS59",XUS59DA)) Q:'XUS59DA D
  1. . ;
  1. . ;Get Pharmacy NPI institution from API
  1. . S XUSNPIDA=$P($G(^TMP($J,"XUS59",XUS59DA,101)),U)
  1. . Q:XUSNPIDA']"" ; NPI institution does not exist
  1. . ;
  1. . ; Get Pharmacy Related Institution from API
  1. . S XUSRELDA=$P($G(^TMP($J,"XUS59",XUS59DA,100)),U)
  1. . ; get station number off the related institution
  1. . S PSSTA=$P($G(^DIC(4,XUSRELDA,99)),U)
  1. . ;
  1. . ; Get NCPDP number
  1. . S XUNCP="" ;prevent previous values being carried over
  1. . S X=XUSNPIDA S D="C",DIC=9002313.56,DIC(0)="" D IX^DIC
  1. . I +Y>0 S XUNCP=$$GET1^DIQ(9002313.56,+Y,.02)
  1. . S:$G(XUNCP)="" XUNCP=$P($G(^TMP($J,"XUS59",XUS59DA,1008)),U)
  1. . ;
  1. . ; rebuild the ^TMP global by NPI institution
  1. . ; collect necessary data used in the 'PHARM' logic
  1. . S ^TMP("XUSNPIX",$J,XUSNPIDA)=XUNCP_"^"_PSSTA ; ncpdp#^station
  1. Q