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

IBCEP81.m

Go to the documentation of this file. 
  1. 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
  1.  ;;Per VA Directive 6402, this routine should not be modified.
  1.  ;
  1.  ; Must call at an entry point  
  1.  Q
  1.  ;
  1.  ; NPIREQ - Extrinsic function that will return a flag indicating
  1.  ;          if the NPI 'drop dead date' has passed.
  1.  ; Input
  1.  ;    IBDT - Date to check (internal Fileman format)
  1.  ; Output
  1.  ;    1 - On or after the May 23, 2008 drop dead date
  1.  ;    0 - Prior to the May 23, 2008 drop dead date 
  1. NPIREQ(IBDT) ; Check NPI drop dead date
  1.  N IBCHKDT
  1.  S IBCHKDT=3080523
  1.  Q $S(IBDT<IBCHKDT:0,1:1)
  1.  ;
  1.  ; TAXREQ - Extrinsic function that will return a flag indicating
  1.  ;          if the Taxonomy 'drop dead date' has passed.
  1.  ; Input
  1.  ;    IBDT - Date to check (internal Fileman format)
  1.  ; Output
  1.  ;    1 - On or after the May 23, 2008 drop dead date
  1.  ;    0 - Prior to the May 23, 2008 drop dead date 
  1. TAXREQ(IBDT) ; Check Taxonomy drop dead date
  1.  N IBCHKDT
  1.  S IBCHKDT=3080523
  1.  Q $S(IBDT<IBCHKDT:0,1:1)
  1.  ;
  1.  ; NPIGET - Extrinsic function to retrieve the NPI of a specified
  1.  ;          record from file 355.93.
  1.  ; Input
  1.  ;    IBIEN - IEN of the record from file 355.93
  1.  ; Output
  1.  ;    NPI of that record or "" if not yet defined
  1. NPIGET(IBIEN) ; Get NPI
  1.  I IBIEN="" Q ""
  1.  N NPI
  1.  S NPI=$$GET1^DIQ(355.93,IBIEN_",",41.01,"I")
  1.  Q NPI
  1.  ;
  1.  ; TAXGET - Extrinsic function to retrieve the Taxonomy of a specified
  1.  ;          record from file 355.93. (NOTE: Returns data for the 'active'
  1.  ;          primary record from the Taxonomy multiple or the earliest
  1.  ;          'active' secondary record if no primary is present.)
  1.  ;
  1.  ;          The 'optional' array parameter returns all Taxonomies in a
  1.  ;          formatted array so they can be displayed.
  1.  ; Input
  1.  ;    IBIEN - IEN of the record from file 355.93
  1.  ; Output
  1.  ;    Piece 1 = Taxonomy (X12 value) of that record as defined in file 8932.1
  1.  ;    Piece 2 = IEN from file 8932.1
  1.  ;
  1.  ;    IBARR = IEN of the record from the main output
  1.  ;    IBARR(IEN) = 3 pieces for each Taxonomy record
  1.  ;    Piece 1 = Taxonomy (X12 value) of that record as defined in file 8932.1
  1.  ;    Piece 2 = IEN from file 8932.1
  1.  ;    Piece 3 = Primary/Secondary (1/0)
  1.  ;    
  1. TAXGET(IBIEN,IBARR) ; Get Taxonomy
  1.  I IBIEN="" Q U
  1.  N TAX,IBPTR,IEN,IENS
  1.  S IEN=0,IBPTR=""
  1.  F  S IEN=$O(^IBA(355.93,IBIEN,"TAXONOMY",IEN)) Q:'IEN  D
  1.  . S IENS=IEN_","_IBIEN_","
  1.  . I $$GET1^DIQ(355.9342,IENS,.03,"E")'="ACTIVE" Q
  1.  . S IBARR(IEN)=U_$$GET1^DIQ(355.9342,IENS,.01,"I")_U_$$GET1^DIQ(355.9342,IENS,.02,"I")
  1.  . S $P(IBARR(IEN),U)=$$GET1^DIQ(8932.1,$P(IBARR(IEN),U,2),"X12 CODE")
  1.  . I $$GET1^DIQ(355.9342,IENS,.02,"E")="YES" S IBPTR=$P(IBARR(IEN),U,2),IBARR=IEN Q
  1.  . I IBPTR="" S IBPTR=$P(IBARR(IEN),U,2),IBARR=IEN
  1.  S TAX=$$GET1^DIQ(8932.1,IBPTR,"X12 CODE")
  1.  Q TAX_U_IBPTR
  1.  ;
  1.  ; TAXDEF - Extrinsic function to retrieve the Taxonomy for the Default
  1.  ;          Division from a record in file 399.
  1.  ; Input
  1.  ;    IBIEN399 - IEN of the record from file 399
  1.  ; Output
  1.  ;    Piece 1 = Taxonomy (X12 value) of that record as defined in file 8932.1
  1.  ;    Piece 2 = IEN from file 8932.1
  1. TAXDEF(IBIEN399) ; Get Taxonomy for Default Division
  1.  I IBIEN399="" Q U
  1.  N IBRETVAL,IBORG,IBEVDT,IBDIV,TAX
  1.  S IBDIV=$$GET1^DIQ(399,IBIEN399_",",.22,"I")
  1.  S IBEVDT=$$GET1^DIQ(399,IBIEN399_",",.03,"I")
  1.  S IBORG=$P($$SITE^VASITE(IBEVDT,IBDIV),U)
  1.  Q $$TAXORG^XUSTAX(IBORG)
  1.  ;
  1.  ; NPIUSED - Extrinsic function to determine whether a given NPI is already being used in files 200, 4, or 355.93.
  1.  ;
  1.  ; Input
  1.  ;    IBNPI - NPI number to check.
  1.  ;    IBOLDNPI - NPI that is being replaced or deleted
  1.  ;    IBIEN - entry number for file 355.93 of entry being edited
  1.  ;    IBCHECK - Is this a new NPI entry or existing
  1.  ;    IBKEY - They security key XUSNPIMTL
  1.  ; Output
  1.  ;    1 = NPI is already being used.
  1.  ;    0 = NPI is not currently being used.
  1.  ;
  1. NPIUSED(IBNPI,IBOLDNPI,IBIEN,IBCHECK,IBKEY) ; Check whether NPI is already used within files 200, 4, or 355.93.
  1.  N IBNOTIFY,IBVA200,DUP,DIR,X,Y,DTOUT,DUOUT,DIRUT,DIROUT
  1.  I $G(IBFBFLAG)=1 Q ""  ;IB*2.0*476 Consider updating RULES^IBCEP8C for FB PAID TO IB interface if changes are made
  1.  S (IBNOTIFY,IBVA200,DUP)=""
  1.  S IBNOTIFY=$S(IBCHECK=2:1,1:$$RULES(IBNPI,IBIEN,IBOLDNPI))
  1.  I IBNOTIFY=0!(IBNOTIFY="") Q ""
  1.  ;Associating NPI to an entry in NEW PERSON file
  1.  ;IBNOTIFY of 14 = Replacing an NPI from NEW PERSON file with an NPI from NEW PERSON file
  1.  I IBNOTIFY=1!(IBNOTIFY=14) D:$G(IBOLDNPI)'=$G(IBNPI)  Q $S($G(Y)=1:0,$G(IBCHECK)=2:0,1:1)
  1.  . D EN^DDIOL("The NPI of "_IBNPI_" is also associated with the INDIVIDUAL provider","","!!")
  1.  . I $G(IBVA200)="" S IBVA200=$$QI^XUSNPI(IBNPI)
  1.  . D EN^DDIOL($$GET1^DIQ(200,$P(IBVA200,U,2),.01))
  1.  . D EN^DDIOL(" in the NEW PERSON file.  You are trying to associate","","?0")
  1.  . 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")
  1.  . D EN^DDIOL(" in the IB NON/OTHER VA BILLING PROVIDER file.","","?0"),EN^DDIOL("")
  1.  . 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"
  1.  . 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."
  1.  . D ^DIR,EN^DDIOL("") Q
  1.  ; NPI is now or was in the past in use in File 4
  1.  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
  1.  ; NPI is now or was in the past in use in 355.93
  1.  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
  1.  ;Inactive NPI in 355.93
  1.  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
  1.  . D EN^DDIOL("INACTIVE in the IB NON/OTHER VA BILLING PROVIDER file.")
  1.  . 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:""),"","!!")
  1.  . D EN^DDIOL("in the IB NON/OTHER VA BILLING PROVIDER file.")
  1.  ;Inactive NPI in NEW PERSON file
  1.  I IBNOTIFY=13 D  Q 1
  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("")
  1.  Q ""
  1.  ;
  1.  ; DUP - Extrinsic function to determine whether a given NPI is already being used in file# 355.93.
  1.  ;
  1.  ; Input
  1.  ;    IBNPI - NPI number to check.
  1.  ; Output
  1.  ;    NULL - NPI is not currently being used.
  1.  ;    Otherwise, the IEN of the entry in file# 355.93 associated with that NPI.
  1.  ;
  1. DUP(IBNPI) ; Check whether this is a duplicate NPI within file# 355.93
  1.  I IBNPI="" Q ""
  1.  Q $O(^IBA(355.93,"NPIHISTORY",IBNPI,""))
  1.  ;
  1.  ; DISPTAX - Function to display extra Taxonomy info in the input templates in screens 6, 7, and 8 in IB EDIT BILLING INFO
  1.  ; 
  1.  ; Input
  1.  ;    IBIEN - IEN of the entry in file 8932.1 to be displayed
  1.  ;    IBTXT - (optional) extra text to be displayed before the entry
  1.  ;            (i.e. "Billing Provider" or "Non-VA Facility")
  1.  ;
  1. DISPTAX(IBIEN,IBTXT) ; Display extra Taxonomy info (when available)
  1.  N IBX
  1.  I $G(IBIEN)="" Q
  1.  S IBX=$$GET1^DIQ(8932.1,IBIEN,1) I IBX]"" W !,"    ",$G(IBTXT)," Classification: ",IBX
  1.  S IBX=$$GET1^DIQ(8932.1,IBIEN,2) I IBX]"" W !,"    ",$G(IBTXT)," Area of Specialization: ",IBX
  1.  S IBX=$$GET1^DIQ(8932.1,IBIEN,8) I IBX]"" W !,"    ",$G(IBTXT)," Specialty Code: ",IBX
  1.  S IBX=$$GET1^DIQ(8932.1,IBIEN,6) W !,"    ",$G(IBTXT)," Taxonomy X12 Code: ",IBX
  1.  Q
  1. RULES(IBNPI,IBIEN,IBOLDNPI) ;Verify that the NPI meets all rules for usage
  1.  N IBIEN1,IBIEN2,DUP,SPIBIEN
  1.  I $G(IBOLDNPI)>0,IBNPI=IBOLDNPI,$D(^VA(200,"ANPI",IBOLDNPI)) Q 1
  1.  I IBNPI="" Q ""
  1.  S DUP=$$DUP(IBNPI)
  1.  ;Duplicate in 355.93
  1.  ; If facility is sole proprietor, NPI is the one pointed to by the sole proprietor, then not a dup - IB*2*516
  1.  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)
  1.  I DUP'="",DUP'=IBIEN,DUP'=$G(SPIBIEN) Q 11
  1.  ;Replacing an NPI that is associated to NEW PERSON file with another NPI that is associated with the NEW PERSON file
  1.  I $G(IBOLDNPI)>0,$D(^VA(200,"ANPI",IBOLDNPI)),$D(^VA(200,"ANPI",IBNPI)) Q 14
  1.  ;Already an inactive NPI
  1.  S IBIEN2=$O(^IBA(355.93,"NPIHISTORY",IBNPI,"")) D:$G(IBIEN2)'=""
  1.  . S IBIEN1=$O(^IBA(355.93,IBIEN2,"NPISTATUS","C",IBNPI,""),-1)
  1.  I $G(IBIEN1)'="",$D(^IBA(355.93,IBIEN2,"NPISTATUS","NPISTATUS",0,IBIEN1)) Q 12
  1.  ;Check for existence in New Person 
  1.  ;file (#200) and/or Institution file (#4)
  1.  S IBVA200=$$QI^XUSNPI(IBNPI)
  1.  I $E($P(IBVA200,U,4),1,8)="Inactive" Q 13
  1.  I $P(IBVA200,U)="Individual_ID",$P(IBVA200,U,4)["Active" Q 1
  1.  I $P(IBVA200,U)="Organization_ID",$P(IBVA200,U,4)["Active" Q 9
  1.  I $D(^DIC(4,"ANPI",IBNPI)) Q 9
  1.  Q 0
  1.  ;
  1. PRENPI(IBIEN) ;Pre-NPI edit messages
  1.  N IBNPI,IBVA200
  1.  Q:$G(IBIEN)=""
  1.  S IBNPI=$P($G(^IBA(355.93,IBIEN,0)),U,14)
  1.  Q:$G(IBNPI)=""
  1.  S IBVA200=$$QI^XUSNPI(IBNPI)
  1.  ;NPI that exists in 355.93 also is used in 200
  1.  I $P(IBVA200,U,1)="Individual_ID",$P(IBVA200,U,4)["Active" D
  1.  . 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."
  1.  . 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"
  1.  . W !,"IB NON/OTHER VA BILLING PROVIDER file.",!
  1.  ;The NPI used in 355.93 is inactive in 200
  1.  I $P(IBVA200,U,1)="Individual_ID",$P(IBVA200,U,4)["Inactive" D
  1.  . 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."
  1.  . 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"
  1.  . W !,"IB NON/OTHER VA BILLING PROVIDER file.",!
  1.  Q