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

Last change on this file was 623, checked in by George Lilly, 15 years ago

revised back to 6/30/08 version

File size: 5.5 KB
Line 
1IBCEP81 ;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
15NPIREQ(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
27TAXREQ(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
38NPIGET(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 ;
63TAXGET(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
84TAXDEF(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 ;
100NPIUSED(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 ;
123DUP(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 ;
133DISPTAX(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 TracBrowser for help on using the repository browser.