source: WorldVistAEHR/trunk/r/INTEGRATED_BILLING-IB-PRQ--IBD--IBQ--PRQS/IBCEP81.m@ 1464

IBCEP81 ;ALB/KJH - NPI and Taxonomy Functions ; 12 Jul 2006  6:56 PM

 ;;2.0;INTEGRATED BILLING;**343**;21-MAR-94;Build 16

 ;;Per VHA Directive 10-93-142, 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.

 ; Output

 ;    1 = NPI is already being used.

 ;    0 = NPI is not currently being used.

 ;

NPIUSED(IBNPI) ; Check whether NPI is already used within files 200, 4, or 355.93.

 N DUP

 I IBNPI="" Q ""

 S DUP=$$DUP(IBNPI)

 I DUP'="" D  Q 1

 . W !,"The NPI of ",IBNPI," in file IB NON/OTHER VA BILLING PROVIDER is now, or was in the past, assigned to: ",$$GET1^DIQ(355.93,DUP,.01),!

 . Q

 S DUP=$$QI^XUSNPI(IBNPI)

 I $P(DUP,U)'=0 D  Q 1

 . I $P(DUP,U)="Individual_ID" W !,"The NPI of ",IBNPI," in file NEW PERSON is now, or was in the past, assigned to: ",$$GET1^DIQ(200,$P(DUP,U,2),.01),!

 . I $P(DUP,U)="Organization_ID" W !,"The NPI of ",IBNPI," in file INSTITUTION is now, or was in the past, assigned to: ",$$GET1^DIQ(4,$P(DUP,U,2),.01),!

 . I $P(DUP,U)="Non_VA_Provider_ID" W !,"The NPI of ",IBNPI," in file IB NON/OTHER VA BILLING PROVIDER is now, or was in the past, assigned to: ",$$GET1^DIQ(355.93,$P(DUP,U,2),.01),!

 . Q

 Q 0

 ;

 ; 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. "Default Division" 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