- Timestamp:
- Dec 4, 2009, 12:11:15 AM (14 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
WorldVistAEHR/trunk/r/INTEGRATED_BILLING-IB-PRQ--IBD--IBQ--PRQS/IBCEP81.m
r613 r623 1 IBCEP81 ;ALB/KJH - NPI and Taxonomy Functions ;19 Apr 2008 5:17 PM 2 ;;2.0;INTEGRATED BILLING;**343,391**;21-MAR-94;Build 39 3 ;;Per VHA Directive 2004-038, this routine should not be modified. 4 ; 5 ; Must call at an entry point 6 Q 7 ; 8 ; NPIREQ - Extrinsic function that will return a flag indicating 9 ; if the NPI 'drop dead date' has passed. 10 ; Input 11 ; IBDT - Date to check (internal Fileman format) 12 ; Output 13 ; 1 - On or after the May 23, 2008 drop dead date 14 ; 0 - Prior to the May 23, 2008 drop dead date 15 NPIREQ(IBDT) ; Check NPI drop dead date 16 N IBCHKDT 17 S IBCHKDT=3080523 18 Q $S(IBDT<IBCHKDT:0,1:1) 19 ; 20 ; TAXREQ - Extrinsic function that will return a flag indicating 21 ; if the Taxonomy 'drop dead date' has passed. 22 ; Input 23 ; IBDT - Date to check (internal Fileman format) 24 ; Output 25 ; 1 - On or after the May 23, 2008 drop dead date 26 ; 0 - Prior to the May 23, 2008 drop dead date 27 TAXREQ(IBDT) ; Check Taxonomy drop dead date 28 N IBCHKDT 29 S IBCHKDT=3080523 30 Q $S(IBDT<IBCHKDT:0,1:1) 31 ; 32 ; NPIGET - Extrinsic function to retrieve the NPI of a specified 33 ; record from file 355.93. 34 ; Input 35 ; IBIEN - IEN of the record from file 355.93 36 ; Output 37 ; NPI of that record or "" if not yet defined 38 NPIGET(IBIEN) ; Get NPI 39 I IBIEN="" Q "" 40 N NPI 41 S NPI=$$GET1^DIQ(355.93,IBIEN_",",41.01,"I") 42 Q NPI 43 ; 44 ; TAXGET - Extrinsic function to retrieve the Taxonomy of a specified 45 ; record from file 355.93. (NOTE: Returns data for the 'active' 46 ; primary record from the Taxonomy multiple or the earliest 47 ; 'active' secondary record if no primary is present.) 48 ; 49 ; The 'optional' array parameter returns all Taxonomies in a 50 ; formatted array so they can be displayed. 51 ; Input 52 ; IBIEN - IEN of the record from file 355.93 53 ; Output 54 ; Piece 1 = Taxonomy (X12 value) of that record as defined in file 8932.1 55 ; Piece 2 = IEN from file 8932.1 56 ; 57 ; IBARR = IEN of the record from the main output 58 ; IBARR(IEN) = 3 pieces for each Taxonomy record 59 ; Piece 1 = Taxonomy (X12 value) of that record as defined in file 8932.1 60 ; Piece 2 = IEN from file 8932.1 61 ; Piece 3 = Primary/Secondary (1/0) 62 ; 63 TAXGET(IBIEN,IBARR) ; Get Taxonomy 64 I IBIEN="" Q U 65 N TAX,IBPTR,IEN,IENS 66 S IEN=0,IBPTR="" 67 F S IEN=$O(^IBA(355.93,IBIEN,"TAXONOMY",IEN)) Q:'IEN D 68 . S IENS=IEN_","_IBIEN_"," 69 . I $$GET1^DIQ(355.9342,IENS,.03,"E")'="ACTIVE" Q 70 . S IBARR(IEN)=U_$$GET1^DIQ(355.9342,IENS,.01,"I")_U_$$GET1^DIQ(355.9342,IENS,.02,"I") 71 . S $P(IBARR(IEN),U)=$$GET1^DIQ(8932.1,$P(IBARR(IEN),U,2),"X12 CODE") 72 . I $$GET1^DIQ(355.9342,IENS,.02,"E")="YES" S IBPTR=$P(IBARR(IEN),U,2),IBARR=IEN Q 73 . I IBPTR="" S IBPTR=$P(IBARR(IEN),U,2),IBARR=IEN 74 S TAX=$$GET1^DIQ(8932.1,IBPTR,"X12 CODE") 75 Q TAX_U_IBPTR 76 ; 77 ; TAXDEF - Extrinsic function to retrieve the Taxonomy for the Default 78 ; Division from a record in file 399. 79 ; Input 80 ; IBIEN399 - IEN of the record from file 399 81 ; Output 82 ; Piece 1 = Taxonomy (X12 value) of that record as defined in file 8932.1 83 ; Piece 2 = IEN from file 8932.1 84 TAXDEF(IBIEN399) ; Get Taxonomy for Default Division 85 I IBIEN399="" Q U 86 N IBRETVAL,IBORG,IBEVDT,IBDIV,TAX 87 S IBDIV=$$GET1^DIQ(399,IBIEN399_",",.22,"I") 88 S IBEVDT=$$GET1^DIQ(399,IBIEN399_",",.03,"I") 89 S IBORG=$P($$SITE^VASITE(IBEVDT,IBDIV),U) 90 Q $$TAXORG^XUSTAX(IBORG) 91 ; 92 ; NPIUSED - Extrinsic function to determine whether a given NPI is already being used in files 200, 4, or 355.93. 93 ; 94 ; Input 95 ; IBNPI - NPI number to check. 96 ; IBOLDNPI - NPI that is being replaced or deleted 97 ; IBIEN - entry number for file 355.93 of entry being edited 98 ; IBCHECK - Is this a new NPI entry or existing 99 ; IBKEY - They security key XUSNPIMTL 100 ; Output 101 ; 1 = NPI is already being used. 102 ; 0 = NPI is not currently being used. 103 ; 104 NPIUSED(IBNPI,IBOLDNPI,IBIEN,IBCHECK,IBKEY) ; Check whether NPI is already used within files 200, 4, or 355.93. 105 N IBNOTIFY,IBVA200,DUP,DIR,X,Y,DTOUT,DUOUT,DIRUT,DIROUT 106 S (IBNOTIFY,IBVA200,DUP)="" 107 S IBNOTIFY=$S(IBCHECK=2:1,1:$$RULES(IBNPI,IBIEN,IBOLDNPI)) 108 I IBNOTIFY=0!(IBNOTIFY="") Q "" 109 ;Associating NPI to an entry in NEW PERSON file 110 ;IBNOTIFY of 14 = Replacing an NPI from NEW PERSON file with an NPI from NEW PERSON file 111 I IBNOTIFY=1!(IBNOTIFY=14) D:$G(IBOLDNPI)'=$G(IBNPI) Q $S($G(Y)=1:0,$G(IBCHECK)=2:0,1:1) 112 . D EN^DDIOL("The NPI of "_IBNPI_" is also associated with the INDIVIDUAL provider","","!!") 113 . I $G(IBVA200)="" S IBVA200=$$QI^XUSNPI(IBNPI) 114 . D EN^DDIOL($$GET1^DIQ(200,$P(IBVA200,U,2),.01)) 115 . D EN^DDIOL(" in the NEW PERSON file. You are trying to associate","","?0") 116 . 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") 117 . D EN^DDIOL(" in the IB NON/OTHER VA BILLING PROVIDER file.","","?0"),EN^DDIOL("") 118 . 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" 119 . 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." 120 . D ^DIR,EN^DDIOL("") Q 121 ; NPI is now or was in the past in use in File 4 122 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 123 ; NPI is now or was in the past in use in 355.93 124 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 125 ;Inactive NPI in 355.93 126 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 127 . D EN^DDIOL("INACTIVE in the IB NON/OTHER VA BILLING PROVIDER file.") 128 . 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:""),"","!!") 129 . D EN^DDIOL("in the IB NON/OTHER VA BILLING PROVIDER file.") 130 ;Inactive NPI in NEW PERSON file 131 I IBNOTIFY=13 D Q 1 132 .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("") 133 Q "" 134 ; 135 ; DUP - Extrinsic function to determine whether a given NPI is already being used in file# 355.93. 136 ; 137 ; Input 138 ; IBNPI - NPI number to check. 139 ; Output 140 ; NULL - NPI is not currently being used. 141 ; Otherwise, the IEN of the entry in file# 355.93 associated with that NPI. 142 ; 143 DUP(IBNPI) ; Check whether this is a duplicate NPI within file# 355.93 144 I IBNPI="" Q "" 145 Q $O(^IBA(355.93,"NPIHISTORY",IBNPI,"")) 146 ; 147 ; DISPTAX - Function to display extra Taxonomy info in the input templates in screens 6, 7, and 8 in IB EDIT BILLING INFO 148 ; 149 ; Input 150 ; IBIEN - IEN of the entry in file 8932.1 to be displayed 151 ; IBTXT - (optional) extra text to be displayed before the entry (i.e. "Default Division" or "Non-VA Facility") 152 ; 153 DISPTAX(IBIEN,IBTXT) ; Display extra Taxonomy info (when available) 154 N IBX 155 I $G(IBIEN)="" Q 156 S IBX=$$GET1^DIQ(8932.1,IBIEN,1) I IBX]"" W !," ",$G(IBTXT)," Classification: ",IBX 157 S IBX=$$GET1^DIQ(8932.1,IBIEN,2) I IBX]"" W !," ",$G(IBTXT)," Area of Specialization: ",IBX 158 S IBX=$$GET1^DIQ(8932.1,IBIEN,8) I IBX]"" W !," ",$G(IBTXT)," Specialty Code: ",IBX 159 S IBX=$$GET1^DIQ(8932.1,IBIEN,6) W !," ",$G(IBTXT)," Taxonomy X12 Code: ",IBX 160 Q 161 RULES(IBNPI,IBIEN,IBOLDNPI) ;Verify that the NPI meets all rules for usage 162 N IBIEN1,IBIEN2,DUP 163 I $G(IBOLDNPI)>0,IBNPI=IBOLDNPI,$D(^VA(200,"ANPI",IBOLDNPI)) Q 1 164 I IBNPI="" Q "" 165 S DUP=$$DUP(IBNPI) 166 ;Duplicate in 355.93 167 I DUP'="",DUP'=IBIEN Q 11 168 ;Replacing an NPI that is associated to NEW PERSON file with another NPI that is associated with the NEW PERSON file 169 I $G(IBOLDNPI)>0,$D(^VA(200,"ANPI",IBOLDNPI)),$D(^VA(200,"ANPI",IBNPI)) Q 14 170 ;Already an inactive NPI 171 S IBIEN2=$O(^IBA(355.93,"NPIHISTORY",IBNPI,"")) D:$G(IBIEN2)'="" 172 . S IBIEN1=$O(^IBA(355.93,IBIEN2,"NPISTATUS","C",IBNPI,""),-1) 173 I $G(IBIEN1)'="",$D(^IBA(355.93,IBIEN2,"NPISTATUS","NPISTATUS",0,IBIEN1)) Q 12 174 ;Check for existence in New Person 175 ;file (#200) and/or Institution file (#4) 176 S IBVA200=$$QI^XUSNPI(IBNPI) 177 I $E($P(IBVA200,U,4),1,8)="Inactive" Q 13 178 I $P(IBVA200,U)="Individual_ID",$P(IBVA200,U,4)["Active" Q 1 179 I $P(IBVA200,U)="Organization_ID",$P(IBVA200,U,4)["Active" Q 9 180 I $D(^DIC(4,"ANPI",IBNPI)) Q 9 181 Q 0 182 ; 183 PRENPI(IBIEN) ;Pre-NPI edit messages 184 N IBNPI,IBVA200 185 Q:$G(IBIEN)="" 186 S IBNPI=$P($G(^IBA(355.93,IBIEN,0)),U,14) 187 Q:$G(IBNPI)="" 188 S IBVA200=$$QI^XUSNPI(IBNPI) 189 ;NPI that exists in 355.93 also is used in 200 190 I $P(IBVA200,U,1)="Individual_ID",$P(IBVA200,U,4)["Active" D 191 . 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." 192 . 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" 193 . W !,"IB NON/OTHER VA BILLING PROVIDER file.",! 194 ;The NPI used in 355.93 is inactive in 200 195 I $P(IBVA200,U,1)="Individual_ID",$P(IBVA200,U,4)["Inactive" D 196 . 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." 197 . 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" 198 . W !,"IB NON/OTHER VA BILLING PROVIDER file.",! 199 Q 1 IBCEP81 ;ALB/KJH - NPI and Taxonomy Functions ; 12 Jul 2006 6:56 PM 2 ;;2.0;INTEGRATED BILLING;**343**;21-MAR-94;Build 16 3 ;;Per VHA Directive 10-93-142, this routine should not be modified. 4 ; 5 ; Must call at an entry point 6 Q 7 ; 8 ; NPIREQ - Extrinsic function that will return a flag indicating 9 ; if the NPI 'drop dead date' has passed. 10 ; Input 11 ; IBDT - Date to check (internal Fileman format) 12 ; Output 13 ; 1 - On or after the May 23, 2008 drop dead date 14 ; 0 - Prior to the May 23, 2008 drop dead date 15 NPIREQ(IBDT) ; Check NPI drop dead date 16 N IBCHKDT 17 S IBCHKDT=3080523 18 Q $S(IBDT<IBCHKDT:0,1:1) 19 ; 20 ; TAXREQ - Extrinsic function that will return a flag indicating 21 ; if the Taxonomy 'drop dead date' has passed. 22 ; Input 23 ; IBDT - Date to check (internal Fileman format) 24 ; Output 25 ; 1 - On or after the May 23, 2008 drop dead date 26 ; 0 - Prior to the May 23, 2008 drop dead date 27 TAXREQ(IBDT) ; Check Taxonomy drop dead date 28 N IBCHKDT 29 S IBCHKDT=3080523 30 Q $S(IBDT<IBCHKDT:0,1:1) 31 ; 32 ; NPIGET - Extrinsic function to retrieve the NPI of a specified 33 ; record from file 355.93. 34 ; Input 35 ; IBIEN - IEN of the record from file 355.93 36 ; Output 37 ; NPI of that record or "" if not yet defined 38 NPIGET(IBIEN) ; Get NPI 39 I IBIEN="" Q "" 40 N NPI 41 S NPI=$$GET1^DIQ(355.93,IBIEN_",",41.01,"I") 42 Q NPI 43 ; 44 ; TAXGET - Extrinsic function to retrieve the Taxonomy of a specified 45 ; record from file 355.93. (NOTE: Returns data for the 'active' 46 ; primary record from the Taxonomy multiple or the earliest 47 ; 'active' secondary record if no primary is present.) 48 ; 49 ; The 'optional' array parameter returns all Taxonomies in a 50 ; formatted array so they can be displayed. 51 ; Input 52 ; IBIEN - IEN of the record from file 355.93 53 ; Output 54 ; Piece 1 = Taxonomy (X12 value) of that record as defined in file 8932.1 55 ; Piece 2 = IEN from file 8932.1 56 ; 57 ; IBARR = IEN of the record from the main output 58 ; IBARR(IEN) = 3 pieces for each Taxonomy record 59 ; Piece 1 = Taxonomy (X12 value) of that record as defined in file 8932.1 60 ; Piece 2 = IEN from file 8932.1 61 ; Piece 3 = Primary/Secondary (1/0) 62 ; 63 TAXGET(IBIEN,IBARR) ; Get Taxonomy 64 I IBIEN="" Q U 65 N TAX,IBPTR,IEN,IENS 66 S IEN=0,IBPTR="" 67 F S IEN=$O(^IBA(355.93,IBIEN,"TAXONOMY",IEN)) Q:'IEN D 68 . S IENS=IEN_","_IBIEN_"," 69 . I $$GET1^DIQ(355.9342,IENS,.03,"E")'="ACTIVE" Q 70 . S IBARR(IEN)=U_$$GET1^DIQ(355.9342,IENS,.01,"I")_U_$$GET1^DIQ(355.9342,IENS,.02,"I") 71 . S $P(IBARR(IEN),U)=$$GET1^DIQ(8932.1,$P(IBARR(IEN),U,2),"X12 CODE") 72 . I $$GET1^DIQ(355.9342,IENS,.02,"E")="YES" S IBPTR=$P(IBARR(IEN),U,2),IBARR=IEN Q 73 . I IBPTR="" S IBPTR=$P(IBARR(IEN),U,2),IBARR=IEN 74 S TAX=$$GET1^DIQ(8932.1,IBPTR,"X12 CODE") 75 Q TAX_U_IBPTR 76 ; 77 ; TAXDEF - Extrinsic function to retrieve the Taxonomy for the Default 78 ; Division from a record in file 399. 79 ; Input 80 ; IBIEN399 - IEN of the record from file 399 81 ; Output 82 ; Piece 1 = Taxonomy (X12 value) of that record as defined in file 8932.1 83 ; Piece 2 = IEN from file 8932.1 84 TAXDEF(IBIEN399) ; Get Taxonomy for Default Division 85 I IBIEN399="" Q U 86 N IBRETVAL,IBORG,IBEVDT,IBDIV,TAX 87 S IBDIV=$$GET1^DIQ(399,IBIEN399_",",.22,"I") 88 S IBEVDT=$$GET1^DIQ(399,IBIEN399_",",.03,"I") 89 S IBORG=$P($$SITE^VASITE(IBEVDT,IBDIV),U) 90 Q $$TAXORG^XUSTAX(IBORG) 91 ; 92 ; NPIUSED - Extrinsic function to determine whether a given NPI is already being used in files 200, 4, or 355.93. 93 ; 94 ; Input 95 ; IBNPI - NPI number to check. 96 ; Output 97 ; 1 = NPI is already being used. 98 ; 0 = NPI is not currently being used. 99 ; 100 NPIUSED(IBNPI) ; Check whether NPI is already used within files 200, 4, or 355.93. 101 N DUP 102 I IBNPI="" Q "" 103 S DUP=$$DUP(IBNPI) 104 I DUP'="" D Q 1 105 . 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),! 106 . Q 107 S DUP=$$QI^XUSNPI(IBNPI) 108 I $P(DUP,U)'=0 D Q 1 109 . 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),! 110 . 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),! 111 . 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),! 112 . Q 113 Q 0 114 ; 115 ; DUP - Extrinsic function to determine whether a given NPI is already being used in file# 355.93. 116 ; 117 ; Input 118 ; IBNPI - NPI number to check. 119 ; Output 120 ; NULL - NPI is not currently being used. 121 ; Otherwise, the IEN of the entry in file# 355.93 associated with that NPI. 122 ; 123 DUP(IBNPI) ; Check whether this is a duplicate NPI within file# 355.93 124 I IBNPI="" Q "" 125 Q $O(^IBA(355.93,"NPIHISTORY",IBNPI,"")) 126 ; 127 ; DISPTAX - Function to display extra Taxonomy info in the input templates in screens 6, 7, and 8 in IB EDIT BILLING INFO 128 ; 129 ; Input 130 ; IBIEN - IEN of the entry in file 8932.1 to be displayed 131 ; IBTXT - (optional) extra text to be displayed before the entry (i.e. "Default Division" or "Non-VA Facility") 132 ; 133 DISPTAX(IBIEN,IBTXT) ; Display extra Taxonomy info (when available) 134 N IBX 135 I $G(IBIEN)="" Q 136 S IBX=$$GET1^DIQ(8932.1,IBIEN,1) I IBX]"" W !," ",$G(IBTXT)," Classification: ",IBX 137 S IBX=$$GET1^DIQ(8932.1,IBIEN,2) I IBX]"" W !," ",$G(IBTXT)," Area of Specialization: ",IBX 138 S IBX=$$GET1^DIQ(8932.1,IBIEN,8) I IBX]"" W !," ",$G(IBTXT)," Specialty Code: ",IBX 139 S IBX=$$GET1^DIQ(8932.1,IBIEN,6) W !," ",$G(IBTXT)," Taxonomy X12 Code: ",IBX 140 Q
Note:
See TracChangeset
for help on using the changeset viewer.
