IBCEP81 ;ALB/KJH - NPI and Taxonomy Functions ;19 Apr 2008 5:17 PM
;;2.0;INTEGRATED BILLING;**343,391,400,476,516**;21-MAR-94;Build 123
;;Per VA Directive 6402, this routine should not be modified.
;
; Must call at an entry point
Q
;
; NPIREQ - Extrinsic function that will return a flag indicating
; if the NPI 'drop dead date' has passed.
; Input
; IBDT - Date to check (internal Fileman format)
; Output
; 1 - On or after the May 23, 2008 drop dead date
; 0 - Prior to the May 23, 2008 drop dead date
NPIREQ(IBDT) ; Check NPI drop dead date
N IBCHKDT
S IBCHKDT=3080523
Q $S(IBDT<IBCHKDT:0,1:1)
;
; TAXREQ - Extrinsic function that will return a flag indicating
; if the Taxonomy 'drop dead date' has passed.
; Input
; IBDT - Date to check (internal Fileman format)
; Output
; 1 - On or after the May 23, 2008 drop dead date
; 0 - Prior to the May 23, 2008 drop dead date
TAXREQ(IBDT) ; Check Taxonomy drop dead date
N IBCHKDT
S IBCHKDT=3080523
Q $S(IBDT<IBCHKDT:0,1:1)
;
; NPIGET - Extrinsic function to retrieve the NPI of a specified
; record from file 355.93.
; Input
; IBIEN - IEN of the record from file 355.93
; Output
; NPI of that record or "" if not yet defined
NPIGET(IBIEN) ; Get NPI
I IBIEN="" Q ""
N NPI
S NPI=$$GET1^DIQ(355.93,IBIEN_",",41.01,"I")
Q NPI
;
; TAXGET - Extrinsic function to retrieve the Taxonomy of a specified
; record from file 355.93. (NOTE: Returns data for the 'active'
; primary record from the Taxonomy multiple or the earliest
; 'active' secondary record if no primary is present.)
;
; The 'optional' array parameter returns all Taxonomies in a
; formatted array so they can be displayed.
; Input
; IBIEN - IEN of the record from file 355.93
; Output
; Piece 1 = Taxonomy (X12 value) of that record as defined in file 8932.1
; Piece 2 = IEN from file 8932.1
;
; IBARR = IEN of the record from the main output
; IBARR(IEN) = 3 pieces for each Taxonomy record
; Piece 1 = Taxonomy (X12 value) of that record as defined in file 8932.1
; Piece 2 = IEN from file 8932.1
; Piece 3 = Primary/Secondary (1/0)
;
TAXGET(IBIEN,IBARR) ; Get Taxonomy
I IBIEN="" Q U
N TAX,IBPTR,IEN,IENS
S IEN=0,IBPTR=""
F S IEN=$O(^IBA(355.93,IBIEN,"TAXONOMY",IEN)) Q:'IEN D
. S IENS=IEN_","_IBIEN_","
. I $$GET1^DIQ(355.9342,IENS,.03,"E")'="ACTIVE" Q
. S IBARR(IEN)=U_$$GET1^DIQ(355.9342,IENS,.01,"I")_U_$$GET1^DIQ(355.9342,IENS,.02,"I")
. S $P(IBARR(IEN),U)=$$GET1^DIQ(8932.1,$P(IBARR(IEN),U,2),"X12 CODE")
. I $$GET1^DIQ(355.9342,IENS,.02,"E")="YES" S IBPTR=$P(IBARR(IEN),U,2),IBARR=IEN Q
. I IBPTR="" S IBPTR=$P(IBARR(IEN),U,2),IBARR=IEN
S TAX=$$GET1^DIQ(8932.1,IBPTR,"X12 CODE")
Q TAX_U_IBPTR
;
; TAXDEF - Extrinsic function to retrieve the Taxonomy for the Default
; Division from a record in file 399.
; Input
; IBIEN399 - IEN of the record from file 399
; Output
; Piece 1 = Taxonomy (X12 value) of that record as defined in file 8932.1
; Piece 2 = IEN from file 8932.1
TAXDEF(IBIEN399) ; Get Taxonomy for Default Division
I IBIEN399="" Q U
N IBRETVAL,IBORG,IBEVDT,IBDIV,TAX
S IBDIV=$$GET1^DIQ(399,IBIEN399_",",.22,"I")
S IBEVDT=$$GET1^DIQ(399,IBIEN399_",",.03,"I")
S IBORG=$P($$SITE^VASITE(IBEVDT,IBDIV),U)
Q $$TAXORG^XUSTAX(IBORG)
;
; NPIUSED - Extrinsic function to determine whether a given NPI is already being used in files 200, 4, or 355.93.
;
; Input
; IBNPI - NPI number to check.
; IBOLDNPI - NPI that is being replaced or deleted
; IBIEN - entry number for file 355.93 of entry being edited
; IBCHECK - Is this a new NPI entry or existing
; IBKEY - They security key XUSNPIMTL
; Output
; 1 = NPI is already being used.
; 0 = NPI is not currently being used.
;
NPIUSED(IBNPI,IBOLDNPI,IBIEN,IBCHECK,IBKEY) ; Check whether NPI is already used within files 200, 4, or 355.93.
N IBNOTIFY,IBVA200,DUP,DIR,X,Y,DTOUT,DUOUT,DIRUT,DIROUT
I $G(IBFBFLAG)=1 Q "" ;IB*2.0*476 Consider updating RULES^IBCEP8C for FB PAID TO IB interface if changes are made
S (IBNOTIFY,IBVA200,DUP)=""
S IBNOTIFY=$S(IBCHECK=2:1,1:$$RULES(IBNPI,IBIEN,IBOLDNPI))
I IBNOTIFY=0!(IBNOTIFY="") Q ""
;Associating NPI to an entry in NEW PERSON file
;IBNOTIFY of 14 = Replacing an NPI from NEW PERSON file with an NPI from NEW PERSON file
I IBNOTIFY=1!(IBNOTIFY=14) D:$G(IBOLDNPI)'=$G(IBNPI) Q $S($G(Y)=1:0,$G(IBCHECK)=2:0,1:1)
. D EN^DDIOL("The NPI of "_IBNPI_" is also associated with the INDIVIDUAL provider","","!!")
. I $G(IBVA200)="" S IBVA200=$$QI^XUSNPI(IBNPI)
. D EN^DDIOL($$GET1^DIQ(200,$P(IBVA200,U,2),.01))
. D EN^DDIOL(" in the NEW PERSON file. You are trying to associate","","?0")
. D EN^DDIOL("it with "_$S($$GET1^DIQ(355.93,IBIEN,.02,"I")=1:"a FACILITY/GROUP",$$GET1^DIQ(355.93,IBIEN,.02,"I")=2:"an INDIVIDUAL",1:"a")_" provider")
. D EN^DDIOL(" in the IB NON/OTHER VA BILLING PROVIDER file.","","?0"),EN^DDIOL("")
. S DIR(0)="Y",DIR("A")="Do you still want to add this NPI to provider "_$$GET1^DIQ(355.93,IBIEN,.01),DIR("B")="NO"
. S DIR("?")="Answer YES if you wish to associate the NPI from the IB NON/OTHER VA PROVIDER file with the entry in the NEW PERSON file."
. D ^DIR,EN^DDIOL("") Q
; NPI is now or was in the past in use in File 4
I IBNOTIFY=9 D EN^DDIOL("The NPI of "_IBNPI_" is now, or was in the past, associated with "_$$GET1^DIQ(4,$O(^DIC(4,"ANPI",IBNPI,"")),.01),"","!!"),EN^DDIOL(" in the INSTITUTION file.") Q 1
; NPI is now or was in the past in use in 355.93
I IBNOTIFY=11 D EN^DDIOL("The NPI of "_IBNPI_" is now, or was in the past, associated with "_$$GET1^DIQ(355.93,$$DUP(IBNPI),.01),"","!!"),EN^DDIOL(" in the IB NON/OTHER VA BILLING PROVIDER file.") Q 1
;Inactive NPI in 355.93
I IBNOTIFY=12 D EN^DDIOL("The NPI of "_IBNPI_" is already associated with the provider "_$$GET1^DIQ(355.93,$$DUP(IBNPI),.01)_" as","","!!") D Q 1
. D EN^DDIOL("INACTIVE in the IB NON/OTHER VA BILLING PROVIDER file.")
. D EN^DDIOL("You are updating "_$S($$GET1^DIQ(355.93,IBIEN,.02,"I")=1:"a FACILITY/GROUP",$$GET1^DIQ(355.93,IBIEN,.02,"I")=2:"an INDIVIDUAL",1:""),"","!!")
. D EN^DDIOL("in the IB NON/OTHER VA BILLING PROVIDER file.")
;Inactive NPI in NEW PERSON file
I IBNOTIFY=13 D Q 1
.D EN^DDIOL("The NPI of "_IBNPI_" is also associated with the INDIVIDUAL provider","","!!"),EN^DDIOL($$GET1^DIQ(200,$P(IBVA200,U,2),.01)_" in the NEW PERSON file."),EN^DDIOL("The NPI is INACTIVE and may not be used."),EN^DDIOL("")
Q ""
;
; DUP - Extrinsic function to determine whether a given NPI is already being used in file# 355.93.
;
; Input
; IBNPI - NPI number to check.
; Output
; NULL - NPI is not currently being used.
; Otherwise, the IEN of the entry in file# 355.93 associated with that NPI.
;
DUP(IBNPI) ; Check whether this is a duplicate NPI within file# 355.93
I IBNPI="" Q ""
Q $O(^IBA(355.93,"NPIHISTORY",IBNPI,""))
;
; DISPTAX - Function to display extra Taxonomy info in the input templates in screens 6, 7, and 8 in IB EDIT BILLING INFO
;
; Input
; IBIEN - IEN of the entry in file 8932.1 to be displayed
; IBTXT - (optional) extra text to be displayed before the entry
; (i.e. "Billing Provider" or "Non-VA Facility")
;
DISPTAX(IBIEN,IBTXT) ; Display extra Taxonomy info (when available)
N IBX
I $G(IBIEN)="" Q
S IBX=$$GET1^DIQ(8932.1,IBIEN,1) I IBX]"" W !," ",$G(IBTXT)," Classification: ",IBX
S IBX=$$GET1^DIQ(8932.1,IBIEN,2) I IBX]"" W !," ",$G(IBTXT)," Area of Specialization: ",IBX
S IBX=$$GET1^DIQ(8932.1,IBIEN,8) I IBX]"" W !," ",$G(IBTXT)," Specialty Code: ",IBX
S IBX=$$GET1^DIQ(8932.1,IBIEN,6) W !," ",$G(IBTXT)," Taxonomy X12 Code: ",IBX
Q
RULES(IBNPI,IBIEN,IBOLDNPI) ;Verify that the NPI meets all rules for usage
N IBIEN1,IBIEN2,DUP,SPIBIEN
I $G(IBOLDNPI)>0,IBNPI=IBOLDNPI,$D(^VA(200,"ANPI",IBOLDNPI)) Q 1
I IBNPI="" Q ""
S DUP=$$DUP(IBNPI)
;Duplicate in 355.93
; If facility is sole proprietor, NPI is the one pointed to by the sole proprietor, then not a dup - IB*2*516
I $P(^IBA(355.93,IBIEN,0),U,17)="Y",$P(^IBA(355.93,IBIEN,0),U,18) S SPIBIEN=$P(^IBA(355.93,IBIEN,0),U,18)
I DUP'="",DUP'=IBIEN,DUP'=$G(SPIBIEN) Q 11
;Replacing an NPI that is associated to NEW PERSON file with another NPI that is associated with the NEW PERSON file
I $G(IBOLDNPI)>0,$D(^VA(200,"ANPI",IBOLDNPI)),$D(^VA(200,"ANPI",IBNPI)) Q 14
;Already an inactive NPI
S IBIEN2=$O(^IBA(355.93,"NPIHISTORY",IBNPI,"")) D:$G(IBIEN2)'=""
. S IBIEN1=$O(^IBA(355.93,IBIEN2,"NPISTATUS","C",IBNPI,""),-1)
I $G(IBIEN1)'="",$D(^IBA(355.93,IBIEN2,"NPISTATUS","NPISTATUS",0,IBIEN1)) Q 12
;Check for existence in New Person
;file (#200) and/or Institution file (#4)
S IBVA200=$$QI^XUSNPI(IBNPI)
I $E($P(IBVA200,U,4),1,8)="Inactive" Q 13
I $P(IBVA200,U)="Individual_ID",$P(IBVA200,U,4)["Active" Q 1
I $P(IBVA200,U)="Organization_ID",$P(IBVA200,U,4)["Active" Q 9
I $D(^DIC(4,"ANPI",IBNPI)) Q 9
Q 0
;
PRENPI(IBIEN) ;Pre-NPI edit messages
N IBNPI,IBVA200
Q:$G(IBIEN)=""
S IBNPI=$P($G(^IBA(355.93,IBIEN,0)),U,14)
Q:$G(IBNPI)=""
S IBVA200=$$QI^XUSNPI(IBNPI)
;NPI that exists in 355.93 also is used in 200
I $P(IBVA200,U,1)="Individual_ID",$P(IBVA200,U,4)["Active" D
. W !!,"The NPI of ",IBNPI," is also associated with the INDIVIDUAL provider ",!,$$GET1^DIQ(200,$P(IBVA200,U,2),.01)," in the NEW PERSON file."
. W !!,"You are updating ",$S($$GET1^DIQ(355.93,IBIEN,.02,"I")=1:"a FACILITY/GROUP",$$GET1^DIQ(355.93,IBIEN,.02,"I")=2:"an INDIVIDUAL",1:"a")," provider in the"
. W !,"IB NON/OTHER VA BILLING PROVIDER file.",!
;The NPI used in 355.93 is inactive in 200
I $P(IBVA200,U,1)="Individual_ID",$P(IBVA200,U,4)["Inactive" D
. W !!,"The NPI of ",IBNPI," is also associated with the INDIVIDUAL provider ",!,$$GET1^DIQ(200,$P(IBVA200,U,2),.01)," as INACTIVE in the NEW PERSON file."
. W !!,"You are updating ",$S($$GET1^DIQ(355.93,IBIEN,.02,"I")=1:"a FACILITY/GROUP",$$GET1^DIQ(355.93,IBIEN,.02,"I")=2:"an INDIVIDUAL",1:"a")," provider in the"
. W !,"IB NON/OTHER VA BILLING PROVIDER file.",!
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HIBCEP81 10290 printed Oct 16, 2024@18:12:29 Page 2
IBCEP81 ;ALB/KJH - NPI and Taxonomy Functions ;19 Apr 2008 5:17 PM
+1 ;;2.0;INTEGRATED BILLING;**343,391,400,476,516**;21-MAR-94;Build 123
+2 ;;Per VA Directive 6402, this routine should not be modified.
+3 ;
+4 ; Must call at an entry point
+5 QUIT
+6 ;
+7 ; NPIREQ - Extrinsic function that will return a flag indicating
+8 ; if the NPI 'drop dead date' has passed.
+9 ; Input
+10 ; IBDT - Date to check (internal Fileman format)
+11 ; Output
+12 ; 1 - On or after the May 23, 2008 drop dead date
+13 ; 0 - Prior to the May 23, 2008 drop dead date
NPIREQ(IBDT) ; Check NPI drop dead date
+1 NEW IBCHKDT
+2 SET IBCHKDT=3080523
+3 QUIT $SELECT(IBDT<IBCHKDT:0,1:1)
+4 ;
+5 ; TAXREQ - Extrinsic function that will return a flag indicating
+6 ; if the Taxonomy 'drop dead date' has passed.
+7 ; Input
+8 ; IBDT - Date to check (internal Fileman format)
+9 ; Output
+10 ; 1 - On or after the May 23, 2008 drop dead date
+11 ; 0 - Prior to the May 23, 2008 drop dead date
TAXREQ(IBDT) ; Check Taxonomy drop dead date
+1 NEW IBCHKDT
+2 SET IBCHKDT=3080523
+3 QUIT $SELECT(IBDT<IBCHKDT:0,1:1)
+4 ;
+5 ; NPIGET - Extrinsic function to retrieve the NPI of a specified
+6 ; record from file 355.93.
+7 ; Input
+8 ; IBIEN - IEN of the record from file 355.93
+9 ; Output
+10 ; NPI of that record or "" if not yet defined
NPIGET(IBIEN) ; Get NPI
+1 IF IBIEN=""
QUIT ""
+2 NEW NPI
+3 SET NPI=$$GET1^DIQ(355.93,IBIEN_",",41.01,"I")
+4 QUIT NPI
+5 ;
+6 ; TAXGET - Extrinsic function to retrieve the Taxonomy of a specified
+7 ; record from file 355.93. (NOTE: Returns data for the 'active'
+8 ; primary record from the Taxonomy multiple or the earliest
+9 ; 'active' secondary record if no primary is present.)
+10 ;
+11 ; The 'optional' array parameter returns all Taxonomies in a
+12 ; formatted array so they can be displayed.
+13 ; Input
+14 ; IBIEN - IEN of the record from file 355.93
+15 ; Output
+16 ; Piece 1 = Taxonomy (X12 value) of that record as defined in file 8932.1
+17 ; Piece 2 = IEN from file 8932.1
+18 ;
+19 ; IBARR = IEN of the record from the main output
+20 ; IBARR(IEN) = 3 pieces for each Taxonomy record
+21 ; Piece 1 = Taxonomy (X12 value) of that record as defined in file 8932.1
+22 ; Piece 2 = IEN from file 8932.1
+23 ; Piece 3 = Primary/Secondary (1/0)
+24 ;
TAXGET(IBIEN,IBARR) ; Get Taxonomy
+1 IF IBIEN=""
QUIT U
+2 NEW TAX,IBPTR,IEN,IENS
+3 SET IEN=0
SET IBPTR=""
+4 FOR
SET IEN=$ORDER(^IBA(355.93,IBIEN,"TAXONOMY",IEN))
if 'IEN
QUIT
Begin DoDot:1
+5 SET IENS=IEN_","_IBIEN_","
+6 IF $$GET1^DIQ(355.9342,IENS,.03,"E")'="ACTIVE"
QUIT
+7 SET IBARR(IEN)=U_$$GET1^DIQ(355.9342,IENS,.01,"I")_U_$$GET1^DIQ(355.9342,IENS,.02,"I")
+8 SET $PIECE(IBARR(IEN),U)=$$GET1^DIQ(8932.1,$PIECE(IBARR(IEN),U,2),"X12 CODE")
+9 IF $$GET1^DIQ(355.9342,IENS,.02,"E")="YES"
SET IBPTR=$PIECE(IBARR(IEN),U,2)
SET IBARR=IEN
QUIT
+10 IF IBPTR=""
SET IBPTR=$PIECE(IBARR(IEN),U,2)
SET IBARR=IEN
End DoDot:1
+11 SET TAX=$$GET1^DIQ(8932.1,IBPTR,"X12 CODE")
+12 QUIT TAX_U_IBPTR
+13 ;
+14 ; TAXDEF - Extrinsic function to retrieve the Taxonomy for the Default
+15 ; Division from a record in file 399.
+16 ; Input
+17 ; IBIEN399 - IEN of the record from file 399
+18 ; Output
+19 ; Piece 1 = Taxonomy (X12 value) of that record as defined in file 8932.1
+20 ; Piece 2 = IEN from file 8932.1
TAXDEF(IBIEN399) ; Get Taxonomy for Default Division
+1 IF IBIEN399=""
QUIT U
+2 NEW IBRETVAL,IBORG,IBEVDT,IBDIV,TAX
+3 SET IBDIV=$$GET1^DIQ(399,IBIEN399_",",.22,"I")
+4 SET IBEVDT=$$GET1^DIQ(399,IBIEN399_",",.03,"I")
+5 SET IBORG=$PIECE($$SITE^VASITE(IBEVDT,IBDIV),U)
+6 QUIT $$TAXORG^XUSTAX(IBORG)
+7 ;
+8 ; NPIUSED - Extrinsic function to determine whether a given NPI is already being used in files 200, 4, or 355.93.
+9 ;
+10 ; Input
+11 ; IBNPI - NPI number to check.
+12 ; IBOLDNPI - NPI that is being replaced or deleted
+13 ; IBIEN - entry number for file 355.93 of entry being edited
+14 ; IBCHECK - Is this a new NPI entry or existing
+15 ; IBKEY - They security key XUSNPIMTL
+16 ; Output
+17 ; 1 = NPI is already being used.
+18 ; 0 = NPI is not currently being used.
+19 ;
NPIUSED(IBNPI,IBOLDNPI,IBIEN,IBCHECK,IBKEY) ; Check whether NPI is already used within files 200, 4, or 355.93.
+1 NEW IBNOTIFY,IBVA200,DUP,DIR,X,Y,DTOUT,DUOUT,DIRUT,DIROUT
+2 ;IB*2.0*476 Consider updating RULES^IBCEP8C for FB PAID TO IB interface if changes are made
IF $GET(IBFBFLAG)=1
QUIT ""
+3 SET (IBNOTIFY,IBVA200,DUP)=""
+4 SET IBNOTIFY=$SELECT(IBCHECK=2:1,1:$$RULES(IBNPI,IBIEN,IBOLDNPI))
+5 IF IBNOTIFY=0!(IBNOTIFY="")
QUIT ""
+6 ;Associating NPI to an entry in NEW PERSON file
+7 ;IBNOTIFY of 14 = Replacing an NPI from NEW PERSON file with an NPI from NEW PERSON file
+8 IF IBNOTIFY=1!(IBNOTIFY=14)
if $GET(IBOLDNPI)'=$GET(IBNPI)
Begin DoDot:1
+9 DO EN^DDIOL("The NPI of "_IBNPI_" is also associated with the INDIVIDUAL provider","","!!")
+10 IF $GET(IBVA200)=""
SET IBVA200=$$QI^XUSNPI(IBNPI)
+11 DO EN^DDIOL($$GET1^DIQ(200,$PIECE(IBVA200,U,2),.01))
+12 DO EN^DDIOL(" in the NEW PERSON file. You are trying to associate","","?0")
+13 DO EN^DDIOL("it with "_$SELECT($$GET1^DIQ(355.93,IBIEN,.02,"I")=1:"a FACILITY/GROUP",$$GET1^DIQ(355.93,IBIEN,.02,"I")=2:"an INDIVIDUAL",1:"a")_" provider")
+14 DO EN^DDIOL(" in the IB NON/OTHER VA BILLING PROVIDER file.","","?0")
DO EN^DDIOL("")
+15 SET DIR(0)="Y"
SET DIR("A")="Do you still want to add this NPI to provider "_$$GET1^DIQ(355.93,IBIEN,.01)
SET DIR("B")="NO"
+16 SET DIR("?")="Answer YES if you wish to associate the NPI from the IB NON/OTHER VA PROVIDER file with the entry in the NEW PERSON file."
+17 DO ^DIR
DO EN^DDIOL("")
QUIT
End DoDot:1
QUIT $SELECT($GET(Y)=1:0,$GET(IBCHECK)=2:0,1:1)
+18 ; NPI is now or was in the past in use in File 4
+19 IF IBNOTIFY=9
DO EN^DDIOL("The NPI of "_IBNPI_" is now, or was in the past, associated with "_$$GET1^DIQ(4,$ORDER(^DIC(4,"ANPI",IBNPI,"")),.01),"","!!")
DO EN^DDIOL(" in the INSTITUTION file.")
QUIT 1
+20 ; NPI is now or was in the past in use in 355.93
+21 IF IBNOTIFY=11
DO EN^DDIOL("The NPI of "_IBNPI_" is now, or was in the past, associated with "_$$GET1^DIQ(355.93,$$DUP(IBNPI),.01),"","!!")
DO EN^DDIOL(" in the IB NON/OTHER VA BILLING PROVIDER file.")
QUIT 1
+22 ;Inactive NPI in 355.93
+23 IF IBNOTIFY=12
DO EN^DDIOL("The NPI of "_IBNPI_" is already associated with the provider "_$$GET1^DIQ(355.93,$$DUP(IBNPI),.01)_" as","","!!")
Begin DoDot:1
+24 DO EN^DDIOL("INACTIVE in the IB NON/OTHER VA BILLING PROVIDER file.")
+25 DO EN^DDIOL("You are updating "_$SELECT($$GET1^DIQ(355.93,IBIEN,.02,"I")=1:"a FACILITY/GROUP",$$GET1^DIQ(355.93,IBIEN,.02,"I")=2:"an INDIVIDUAL",1:""),"","!!")
+26 DO EN^DDIOL("in the IB NON/OTHER VA BILLING PROVIDER file.")
End DoDot:1
QUIT 1
+27 ;Inactive NPI in NEW PERSON file
+28 IF IBNOTIFY=13
Begin DoDot:1
+29 DO EN^DDIOL("The NPI of "_IBNPI_" is also associated with the INDIVIDUAL provider","","!!")
DO EN^DDIOL($$GET1^DIQ(200,$PIECE(IBVA200,U,2),.01)_" in the NEW PERSON file.")
DO EN^DDIOL("The NPI is INACTIVE and may not be used.")
DO EN^DDIOL("")
End DoDot:1
QUIT 1
+30 QUIT ""
+31 ;
+32 ; DUP - Extrinsic function to determine whether a given NPI is already being used in file# 355.93.
+33 ;
+34 ; Input
+35 ; IBNPI - NPI number to check.
+36 ; Output
+37 ; NULL - NPI is not currently being used.
+38 ; Otherwise, the IEN of the entry in file# 355.93 associated with that NPI.
+39 ;
DUP(IBNPI) ; Check whether this is a duplicate NPI within file# 355.93
+1 IF IBNPI=""
QUIT ""
+2 QUIT $ORDER(^IBA(355.93,"NPIHISTORY",IBNPI,""))
+3 ;
+4 ; DISPTAX - Function to display extra Taxonomy info in the input templates in screens 6, 7, and 8 in IB EDIT BILLING INFO
+5 ;
+6 ; Input
+7 ; IBIEN - IEN of the entry in file 8932.1 to be displayed
+8 ; IBTXT - (optional) extra text to be displayed before the entry
+9 ; (i.e. "Billing Provider" or "Non-VA Facility")
+10 ;
DISPTAX(IBIEN,IBTXT) ; Display extra Taxonomy info (when available)
+1 NEW IBX
+2 IF $GET(IBIEN)=""
QUIT
+3 SET IBX=$$GET1^DIQ(8932.1,IBIEN,1)
IF IBX]""
WRITE !," ",$GET(IBTXT)," Classification: ",IBX
+4 SET IBX=$$GET1^DIQ(8932.1,IBIEN,2)
IF IBX]""
WRITE !," ",$GET(IBTXT)," Area of Specialization: ",IBX
+5 SET IBX=$$GET1^DIQ(8932.1,IBIEN,8)
IF IBX]""
WRITE !," ",$GET(IBTXT)," Specialty Code: ",IBX
+6 SET IBX=$$GET1^DIQ(8932.1,IBIEN,6)
WRITE !," ",$GET(IBTXT)," Taxonomy X12 Code: ",IBX
+7 QUIT
RULES(IBNPI,IBIEN,IBOLDNPI) ;Verify that the NPI meets all rules for usage
+1 NEW IBIEN1,IBIEN2,DUP,SPIBIEN
+2 IF $GET(IBOLDNPI)>0
IF IBNPI=IBOLDNPI
IF $DATA(^VA(200,"ANPI",IBOLDNPI))
QUIT 1
+3 IF IBNPI=""
QUIT ""
+4 SET DUP=$$DUP(IBNPI)
+5 ;Duplicate in 355.93
+6 ; If facility is sole proprietor, NPI is the one pointed to by the sole proprietor, then not a dup - IB*2*516
+7 IF $PIECE(^IBA(355.93,IBIEN,0),U,17)="Y"
IF $PIECE(^IBA(355.93,IBIEN,0),U,18)
SET SPIBIEN=$PIECE(^IBA(355.93,IBIEN,0),U,18)
+8 IF DUP'=""
IF DUP'=IBIEN
IF DUP'=$GET(SPIBIEN)
QUIT 11
+9 ;Replacing an NPI that is associated to NEW PERSON file with another NPI that is associated with the NEW PERSON file
+10 IF $GET(IBOLDNPI)>0
IF $DATA(^VA(200,"ANPI",IBOLDNPI))
IF $DATA(^VA(200,"ANPI",IBNPI))
QUIT 14
+11 ;Already an inactive NPI
+12 SET IBIEN2=$ORDER(^IBA(355.93,"NPIHISTORY",IBNPI,""))
if $GET(IBIEN2)'=""
Begin DoDot:1
+13 SET IBIEN1=$ORDER(^IBA(355.93,IBIEN2,"NPISTATUS","C",IBNPI,""),-1)
End DoDot:1
+14 IF $GET(IBIEN1)'=""
IF $DATA(^IBA(355.93,IBIEN2,"NPISTATUS","NPISTATUS",0,IBIEN1))
QUIT 12
+15 ;Check for existence in New Person
+16 ;file (#200) and/or Institution file (#4)
+17 SET IBVA200=$$QI^XUSNPI(IBNPI)
+18 IF $EXTRACT($PIECE(IBVA200,U,4),1,8)="Inactive"
QUIT 13
+19 IF $PIECE(IBVA200,U)="Individual_ID"
IF $PIECE(IBVA200,U,4)["Active"
QUIT 1
+20 IF $PIECE(IBVA200,U)="Organization_ID"
IF $PIECE(IBVA200,U,4)["Active"
QUIT 9
+21 IF $DATA(^DIC(4,"ANPI",IBNPI))
QUIT 9
+22 QUIT 0
+23 ;
PRENPI(IBIEN) ;Pre-NPI edit messages
+1 NEW IBNPI,IBVA200
+2 if $GET(IBIEN)=""
QUIT
+3 SET IBNPI=$PIECE($GET(^IBA(355.93,IBIEN,0)),U,14)
+4 if $GET(IBNPI)=""
QUIT
+5 SET IBVA200=$$QI^XUSNPI(IBNPI)
+6 ;NPI that exists in 355.93 also is used in 200
+7 IF $PIECE(IBVA200,U,1)="Individual_ID"
IF $PIECE(IBVA200,U,4)["Active"
Begin DoDot:1
+8 WRITE !!,"The NPI of ",IBNPI," is also associated with the INDIVIDUAL provider ",!,$$GET1^DIQ(200,$PIECE(IBVA200,U,2),.01)," in the NEW PERSON file."
+9 WRITE !!,"You are updating ",$SELECT($$GET1^DIQ(355.93,IBIEN,.02,"I")=1:"a FACILITY/GROUP",$$GET1^DIQ(355.93,IBIEN,.02,"I")=2:"an INDIVIDUAL",1:"a")," provider in the"
+10 WRITE !,"IB NON/OTHER VA BILLING PROVIDER file.",!
End DoDot:1
+11 ;The NPI used in 355.93 is inactive in 200
+12 IF $PIECE(IBVA200,U,1)="Individual_ID"
IF $PIECE(IBVA200,U,4)["Inactive"
Begin DoDot:1
+13 WRITE !!,"The NPI of ",IBNPI," is also associated with the INDIVIDUAL provider ",!,$$GET1^DIQ(200,$PIECE(IBVA200,U,2),.01)," as INACTIVE in the NEW PERSON file."
+14 WRITE !!,"You are updating ",$SELECT($$GET1^DIQ(355.93,IBIEN,.02,"I")=1:"a FACILITY/GROUP",$$GET1^DIQ(355.93,IBIEN,.02,"I")=2:"an INDIVIDUAL",1:"a")," provider in the"
+15 WRITE !,"IB NON/OTHER VA BILLING PROVIDER file.",!
End DoDot:1
+16 QUIT
