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

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