302 lines
9.2 KiB
Mathematica
302 lines
9.2 KiB
Mathematica
XUSNPIX2 ;OAK_BP/CMW - NPI EXTRACT REPORT ; 06 Sep 2007 3:34 PM
|
|
;;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="XUSNPIX2" (current routine name, used for ^XTMP and ^TMP
|
|
; storage subscript)
|
|
; Storage Global:
|
|
; ^XTMP("XUSNPIX2",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("XUSNPIX2",1) = STATION INFO
|
|
; ^XTMP("XUSNPIX2",2) = DATA
|
|
;
|
|
; NPI => Unique NPI of entry
|
|
; LDT => Last Date Run, VA Fileman Format
|
|
;
|
|
; Entry Point - ENT called from XUSNPIX1
|
|
;
|
|
Q
|
|
;
|
|
ENT ; ENTRY POINT
|
|
; Initialize variables
|
|
N XUSRTN
|
|
S XUSRTN="XUSNPIX2"
|
|
S DTTM2=$$HTE^XLFDT($H,"2")
|
|
; Check to see if report is in use
|
|
L +^XTMP(XUSRTN):5 I '$T G EXIT
|
|
; Process Institution File
|
|
D INIT(XUSRTN)
|
|
; Pull Station(Institution) data
|
|
D STAT(XUSRTN)
|
|
; Process Report
|
|
D PROC2(XUSRTN)
|
|
; Send the message
|
|
D EMAIL(XUSRTN)
|
|
D VMAIL(XUSRTN)
|
|
S ^XTMP("XUSNPIXT",2)=MSGCNT_U_TOTREC_U_DTTM2
|
|
;
|
|
; Standard EXIT point
|
|
EXIT ;
|
|
K ^TMP(XUSRTN,$J),^TMP($J,"XUS59"),^TMP("XUSNPIX",$J)
|
|
; Log Run Completion Time
|
|
S $P(^XTMP(XUSRTN,0),U,6)=$H
|
|
L -^XTMP(XUSRTN)
|
|
K P,XUSPT,INST,XUSEOL,DTTM2,MAXSIZE,XUSIZE,MSGCNT,COUNT,TOTREC,XUSHDR,XUSTAXID
|
|
Q
|
|
;
|
|
;
|
|
INIT(XUSRTN) ; check/init variables
|
|
N XUSDESC
|
|
; Set end of line character
|
|
S XUSEOL="~~"
|
|
; Set to 300000 for live
|
|
S MAXSIZE=300000
|
|
; Reset Temporary Scratch Global
|
|
K ^TMP(XUSRTN)
|
|
S XUSDESC="NPI EXTRACT TYPE 2 - Do Not Delete"
|
|
S ^XTMP(XUSRTN,0)=(DT+10000)_U_DT_U_XUSDESC_U_DT_U_$H
|
|
;
|
|
I '$D(^TMP("XUSNPIXU",$J)) D BCBSID^XUSNPIXU
|
|
;
|
|
; Create pharmacy institution ^TMP file
|
|
D GETPHARM
|
|
Q
|
|
;
|
|
STAT(XUSRTN) ; Pull station and Institution info
|
|
N SINFO,DIC4,IBSITE,IBFAC,IB0
|
|
; Pull site info
|
|
S SINFO=$$SITE^VASITE
|
|
; Station Number
|
|
S SITE=$P(SINFO,U,3)
|
|
; Institution
|
|
S INST=$P(SINFO,U)
|
|
;
|
|
; Get Federal Tax Id
|
|
S XUSTAXID=""
|
|
S IBSITE=0
|
|
F S IBSITE=$O(^IBE(350.9,IBSITE)) Q:'IBSITE!(XUSTAXID'="") D
|
|
. S XUSTAXID=$P($G(^IBE(350.9,IBSITE,1)),U,5)
|
|
;
|
|
; Get institution mailing address (PAY TO)
|
|
;ST ADDR 1,ST ADDR 2,CITY,ZIP
|
|
I INST D
|
|
. S DIC4=$G(^DIC(4,INST,4))
|
|
. S XUSPT(4)=$P(DIC4,U)
|
|
. S XUSPT(5)=$P(DIC4,U,2)
|
|
. S XUSPT(6)=$P(DIC4,U,3)
|
|
. S XUSPT(7)=$P(DIC4,U,4)
|
|
. I XUSPT(7) S XUSPT(7)=$P($G(^DIC(5,XUSPT(7),0)),U,2)
|
|
. S XUSPT(8)=$P(DIC4,U,5)
|
|
. S PTPMAIL=XUSPT(4)_U_XUSPT(5)_U_XUSPT(6)_U_XUSPT(7)_U_XUSPT(8)
|
|
S XUSHDR="Station: "_SITE_U_XUSPT(6)_U_XUSPT(7)_U_XUSPT(8)_U_"TYPE 2"_U_XUSVER
|
|
;
|
|
Q
|
|
;
|
|
PROC2(XUSRTN) ;Process all Institution records
|
|
N XUSNPI,XUSNEW,XUSDT,XUSI,XUSIN,XUSTXY,XUSSPC,XUSTAX,XUPHM
|
|
N XUSFCT,XUSFCN,XUSDATA1,XUSDATA2,XUSDATA3,XUSDATA4,XUSDATA5,XUSSTA
|
|
N INIEN,DIC0,DIC1,PSIEN,NPIINS,RELINS,PSSTA
|
|
; set counter
|
|
S COUNT=1,(TOTREC,MSGCNT,XUSIZE)=0
|
|
; Loop through INSTITUTION NPI records NPI xref
|
|
S XUSNPI=0
|
|
F S XUSNPI=$O(^DIC(4,"ANPI",XUSNPI)) Q:'XUSNPI D
|
|
. S INIEN=$O(^DIC(4,"ANPI",XUSNPI,""))
|
|
. ;
|
|
. ; Get Station Number
|
|
. S XUSSTA=$P($G(^DIC(4,INIEN,99)),U)
|
|
. ; Parent of Association
|
|
. I (INIEN'=INST)&('$$POA(INIEN,INST)) Q
|
|
. ; Initialize columns
|
|
. F XUSI=1:1:24 S XUSIN(XUSI)=""
|
|
. ;
|
|
. S XUSIN(1)=XUSNPI
|
|
. S DIC0=$G(^DIC(4,INIEN,0)) Q:DIC0=""
|
|
. ;Organization Name
|
|
. S XUSIN(2)=$P($G(DIC0),U)
|
|
. S XUSIN(3)=2
|
|
. S XUSDATA1=XUSIN(1)_U_XUSIN(2)_U_XUSIN(3)
|
|
. ;
|
|
. ; Pay to Provider Address
|
|
. S XUSDATA2=PTPMAIL
|
|
. ;
|
|
. ; Servicing Provider Address
|
|
. S DIC1=$G(^DIC(4,INIEN,1))
|
|
. I DIC1'="" D
|
|
. . S XUSIN(9)=$P(DIC1,U)
|
|
. . S XUSIN(10)=$P(DIC1,U,2)
|
|
. . S XUSIN(11)=$P(DIC1,U,3)
|
|
. . S XUSIN(12)=$P($G(DIC0),U,2)
|
|
. . I XUSIN(12) S XUSIN(12)=$P($G(^DIC(5,XUSIN(12),0)),U,2)
|
|
. . S XUSIN(13)=$P(DIC1,U,4)
|
|
. S XUSDATA3=XUSIN(9)_U_XUSIN(10)_U_XUSIN(11)_U_XUSIN(12)_U_XUSIN(13)
|
|
. ;
|
|
. ;Phone number (place holder)
|
|
. S XUSIN(14)=""
|
|
. ;
|
|
. ; Get Taxonomy and Specialty
|
|
. S XUSTXY=0
|
|
. F S XUSTXY=$O(^DIC(4,INIEN,"TAXONOMY","B",XUSTXY)) Q:'XUSTXY D
|
|
. . S XUSSPC=$P($G(^USC(8932.1,XUSTXY,0)),U,9)
|
|
. . S XUSTAX=$P($G(^USC(8932.1,XUSTXY,0)),U,7)
|
|
. . I XUSSPC'="" D
|
|
. . . I XUSIN(15)="" S XUSIN(15)=XUSSPC Q
|
|
. . . S XUSIN(15)=XUSIN(15)_";"_XUSSPC
|
|
. . I XUSTAX'="" D
|
|
. . . I XUSIN(16)="" S XUSIN(16)=XUSTAX Q
|
|
. . . S XUSIN(16)=XUSIN(16)_";"_XUSTAX
|
|
. ;
|
|
. ; Federal Tax ID
|
|
. S XUSIN(17)=$G(XUSTAXID)
|
|
. ;
|
|
. ; Medicaid Part A/B
|
|
. S XUSIN(18)=670899
|
|
. S XUSIN(19)="VA"_$E(SITE+10000,2,5)
|
|
. ;
|
|
. S XUSDATA4=XUSIN(14)_U_XUSIN(15)_U_XUSIN(16)_U_XUSIN(17)_U_XUSIN(18)_U_XUSIN(19)
|
|
. ;
|
|
. ; DEA Number
|
|
. S XUSIN(20)=$P($G(^DIC(4,INIEN,"DEA")),U)
|
|
. ;
|
|
. ; get Facility Type and Name
|
|
. S XUSFCT=$P($G(^DIC(4,INIEN,3)),U)
|
|
. I XUSFCT'="" S XUSFCN=$P($G(^DIC(4.1,XUSFCT,0)),U)
|
|
. I $G(XUSFCN)="PHARM" D
|
|
. . I $D(^TMP("XUSNPIX",$J,INIEN)) D
|
|
. . . S XUPHM=^TMP("XUSNPIX",$J,INIEN)
|
|
. . . ; get NCPDP from ^TMP
|
|
. . . S XUSIN(21)=$P($G(XUPHM),U)
|
|
. . . ; get station number from^TMP
|
|
. . . I $P($G(XUPHM),U,2) S XUSSTA=$P(XUPHM,U,2)
|
|
. ;
|
|
. ; VISN Station Number
|
|
. S XUSIN(22)=XUSSTA
|
|
. ;
|
|
. S XUSDATA5=XUSIN(20)_U_XUSIN(21)_U_XUSIN(22)
|
|
. ;
|
|
. ; Get BCBS Payer ID Array
|
|
. K XUSBXID
|
|
. D INSTID^XUSNPIXU(.XUSBXID)
|
|
. ;
|
|
. ; Update counter and save Entry
|
|
. ;
|
|
. S COUNT=COUNT+1,TOTREC=TOTREC+1
|
|
. S ^TMP(XUSRTN,$J,COUNT)=XUSDATA1_U_XUSDATA2_U_XUSDATA3_U_XUSDATA4_U_XUSDATA5_U_XUSEOL
|
|
. S XUSIZE=XUSIZE+$L(^TMP(XUSRTN,$J,COUNT))
|
|
. I $D(XUSBXID) D
|
|
. . S XUSB=""
|
|
. . F S XUSB=$O(XUSBXID(XUSB)) Q:XUSB="" D
|
|
. . . S COUNT=COUNT+1,TOTREC=TOTREC+1
|
|
. . . S ^TMP(XUSRTN,$J,COUNT)=XUSDATA1_U_XUSDATA2_U_XUSDATA3_U_XUSDATA4_U_XUSDATA5_U_XUSB_U_XUSBXID(XUSB)_U_XUSEOL
|
|
. . . S XUSIZE=XUSIZE+$L(^TMP(XUSRTN,$J,COUNT))
|
|
. K XUSIN,XUSDATA1,XUSDATA2,XUSDATA3,XUSDATA4,XUSDATA5,XUSB,XUSBXID
|
|
. I XUSIZE>MAXSIZE D
|
|
. . D EOF(XUSRTN)
|
|
. . D EMAIL(XUSRTN)
|
|
. . D VMAIL(XUSRTN)
|
|
. . S ^TMP(XUSRTN,$J,1)=XUSHDR
|
|
. . S COUNT=1,XUSIZE=0
|
|
;
|
|
D EOF(XUSRTN)
|
|
K XUSPT,PTPMAIL,LDTCMP,SITE,XUSTAXID
|
|
Q
|
|
;
|
|
EOF(XUSRTN) ;
|
|
S MSGCNT=MSGCNT+1
|
|
S ^TMP(XUSRTN,$J,1)=XUSHDR_U_"Message Number: "_MSGCNT_U_"Line Count: "_COUNT_U_DTTM2_U_$G(XUSPROD)_U_XUSEOL
|
|
S COUNT=COUNT+1
|
|
S ^TMP(XUSRTN,$J,COUNT)="END OF FILE"_U_XUSEOL
|
|
Q
|
|
;
|
|
; EMail the message
|
|
EMAIL(XUSRTN) ;
|
|
N XMY
|
|
; Send email to designated recipient for live release
|
|
S XMY("XXX@Q-NPS.VA.GOV")=""
|
|
;S XMY(DUZ)="" ;use for testing - remove before live
|
|
D ESEND
|
|
Q
|
|
;
|
|
VMAIL(XUSRTN) ; verification email
|
|
N TMP
|
|
S TMP=^TMP(XUSRTN,$J,1)
|
|
K ^TMP(XUSRTN,$J)
|
|
S ^TMP(XUSRTN,$J,1)=$P(TMP,U,1,4)
|
|
S ^TMP(XUSRTN,$J,2)=""
|
|
S ^TMP(XUSRTN,$J,3)="TYPE 1 : INSTITUTION FILE (#4)"
|
|
S ^TMP(XUSRTN,$J,4)=""
|
|
S ^TMP(XUSRTN,$J,5)="Date/Time of Extract: "_$P(TMP,U,9)
|
|
S ^TMP(XUSRTN,$J,6)=""
|
|
S ^TMP(XUSRTN,$J,7)="Message number: "_MSGCNT_" Total NPI records: "_(COUNT-2)
|
|
S ^TMP(XUSRTN,$J,8)=""
|
|
S ^TMP(XUSRTN,$J,9)="Programmer Notes: "_XUSVER_" - "_$P(TMP,U,10)
|
|
; Send verification email to local mail group and VA Outlook mail group
|
|
S XMY("G.NPI EXTRACT VERIFICATION")=""
|
|
D ESEND
|
|
K ^TMP(XUSRTN)
|
|
Q
|
|
ESEND N XMTEXT,XMSUB,XMDUN,XMDUZ,XMZ
|
|
;Q
|
|
S XMTEXT="^TMP("""_XUSRTN_""","_$J_","
|
|
S XMSUB=$TR($P($G(^TMP(XUSRTN,$J,1)),U),":")_"("_$G(XUSPROD)_") NPI EXTRACT TYPE 2"
|
|
D ^XMD
|
|
Q
|
|
POA(IEN,INST) ; Check Parent of Association for Institution IEN up to VISN level to see if INST is in the chain
|
|
N XUSPOA
|
|
I +$G(INST)=0 Q 0 ; No institution - return false
|
|
POA1 ;
|
|
I $G(IEN)="" Q 0 ; No IEN remaining to check - return false
|
|
I $D(XUSPOA(IEN)) Q 0 ; Already reviewed this IEN - possible infinite loop - return false
|
|
S XUSPOA(IEN)=""
|
|
S XUSPOA=$P($G(^DIC(4,IEN,7,2,0)),U,2) ; Get parent of this institution
|
|
I XUSPOA=INST Q 1 ; Found matching institution - return true
|
|
I IEN=XUSPOA Q 0 ; Top level reached - return false
|
|
S IEN=XUSPOA ; Reset IEN to check next level
|
|
G POA1
|
|
;
|
|
GETPHARM ;
|
|
; this subroutine retrieves data from the OUTPATIENT SITE file
|
|
; using the supported Pharmacy API PSS^PSO59.
|
|
; It takes the results and places them into a temporary
|
|
; global array that is accessed when processing data
|
|
; associated with a pharmacy institution.
|
|
N XUS59DA,XUSNPIDA,XUSRELDA,PSSTA,Y,X,XUNCP
|
|
K ^TMP($J,"XUS59"),^TMP("XUSNPIX",$J) ; remove any pre-existing nodes
|
|
D PSS^PSO59(,"??","XUS59")
|
|
S XUS59DA=0
|
|
; gather data from each Outpatient site entry stored in the pharmacy
|
|
; ^TMP global and build 2nd ^TMP global for later processing
|
|
F S XUS59DA=$O(^TMP($J,"XUS59",XUS59DA)) Q:'XUS59DA D
|
|
. ;
|
|
. ;Get Pharmacy NPI institution from API
|
|
. S XUSNPIDA=$P($G(^TMP($J,"XUS59",XUS59DA,101)),U)
|
|
. Q:XUSNPIDA']"" ; NPI institution does not exist
|
|
. ;
|
|
. ; Get Pharmacy Related Institution from API
|
|
. S XUSRELDA=$P($G(^TMP($J,"XUS59",XUS59DA,100)),U)
|
|
. ; get station number off the related institution
|
|
. S PSSTA=$P($G(^DIC(4,XUSRELDA,99)),U)
|
|
. ;
|
|
. ; Get NCPDP number
|
|
. S XUNCP="" ;prevent previous values being carried over
|
|
. S X=XUSNPIDA S D="C",DIC=9002313.56,DIC(0)="" D IX^DIC
|
|
. I +Y>0 S XUNCP=$$GET1^DIQ(9002313.56,+Y,.02)
|
|
. S:$G(XUNCP)="" XUNCP=$P($G(^TMP($J,"XUS59",XUS59DA,1008)),U)
|
|
. ;
|
|
. ; rebuild the ^TMP global by NPI institution
|
|
. ; collect necessary data used in the 'PHARM' logic
|
|
. S ^TMP("XUSNPIX",$J,XUSNPIDA)=XUNCP_"^"_PSSTA ; ncpdp#^station
|
|
Q
|