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

Last change on this file since 1586 was 628, checked in by George Lilly, 15 years ago

initial load of FOIAVistA 6/30/08 version

File size: 6.8 KB
Line 
1IBCEF73A ;ALB/KJH - FORMATTER AND EXTRACTOR SPECIFIC (NPI) BILL FUNCTIONS ; 30 Aug 2006 10:38 AM
2 ;;2.0;INTEGRATED BILLING;**343,374,395**;21-MAR-94;Build 3
3 ;; Per VHA Directive 10-93-142, this routine should not be modified.
4 ;
5PROVNPI(IBIEN399,IBNONPI) ;
6 ;Retrieves NPIs from #200 or 355.93
7 ; Input:
8 ; IBIEN399 - IEN of record in BILL/CLAIMS file 399
9 ; IBNONPI - variable to pass info on missing NPI to calling routine. Pass by reference
10 ; Output:
11 ; NPI codes for all providers
12 ; IBNONPI - U-delimited list of provider types with missing NPIs
13 N IBRETVAL,IBPTR,IBFT
14 S IBRETVAL="",IBNONPI=""
15 F IBFT=1:1:9 D
16 . S IBPTR=$$PROVPTR^IBCEF7(IBIEN399,IBFT)
17 . I IBPTR S $P(IBRETVAL,"^",IBFT)=$$GETNPI(IBPTR)
18 Q IBRETVAL
19GETNPI(IBPTR) ;look for NPI in #200 or #355.93
20 ;Input: IBPTR from 399.0222, field .02
21 ;Output: NPI
22 ;if in file #200
23 N NPI
24 S NPI=""
25 ;if in 200 then get it from 200
26 I $P(IBPTR,";",2)="VA(200," S NPI=$P($$NPI^XUSNPI("Individual_ID",$P(IBPTR,";")),U) S:NPI=-1 NPI=""
27 ;if in 355.93 then use 355.93
28 I $P(IBPTR,";",2)="IBA(355.93," S NPI=$$NPIGET^IBCEP81($P(IBPTR,";"))
29 I NPI="",$D(IBNONPI) S IBNONPI=$S(IBNONPI="":IBFT,1:IBNONPI_U_IBFT)
30 Q NPI
31 ;
32SPECTAX(IBIEN399,IBNOSPEC) ;
33 ;Retrieves Specialty Codes from Current Taxonomy entries for a claim from #399
34 ; Input:
35 ; IBIEN399 - IEN of record in BILL/CLAIMS file 399
36 ; IBNOSPEC - variable to pass info on missing taxonomies to calling routine. Pass by reference
37 ; Output:
38 ; Taxonomy Specialty Codes for all providers
39 ; IBNOSPEC - U-delimited list of provider types with missing Taxonomy Specialty codes
40 N IBRETVAL,IBN,IBFT,IBSPEC,SPEC
41 S IBRETVAL="",IBNOSPEC=""
42 I $G(IBIEN399)="" Q ""
43 F IBFT=1:1:9 D
44 . S IBN=$O(^DGCR(399,IBIEN399,"PRV","B",IBFT,0))
45 . I +IBN=0 Q
46 . S IBSPEC=$P($G(^DGCR(399,IBIEN399,"PRV",+IBN,0)),"^",15)
47 . S SPEC=$$GET1^DIQ(8932.1,IBSPEC,"SPECIALTY CODE")
48 . S $P(IBRETVAL,"^",IBFT)=SPEC
49 . I SPEC="",$D(IBNOSPEC) S IBNOSPEC=$S(IBNOSPEC="":IBFT,1:IBNOSPEC_U_IBFT)
50 Q IBRETVAL
51 ;
52PROVTAX(IBIEN399,IBNOTAX) ;
53 ;Retrieves Current Taxonomy entries for a claim from #399
54 ; Input:
55 ; IBIEN399 - IEN of record in BILL/CLAIMS file 399
56 ; IBNOTAX - variable to pass info on missing taxonomies to calling routine. Pass by reference
57 ; Output:
58 ; Taxonomy X12 codes for all providers
59 ; IBNOTAX - U-delimited list of provider types with missing Taxonomy X12 codes
60 N IBRETVAL,IBN,IBFT,IBTAX,TAX
61 S IBRETVAL="",IBNOTAX=""
62 I $G(IBIEN399)="" Q ""
63 F IBFT=1:1:9 D
64 . S IBN=$O(^DGCR(399,IBIEN399,"PRV","B",IBFT,0))
65 . I +IBN=0 Q
66 . S IBTAX=$P($G(^DGCR(399,IBIEN399,"PRV",+IBN,0)),"^",15)
67 . S TAX=$$GET1^DIQ(8932.1,IBTAX,"X12 CODE")
68 . S $P(IBRETVAL,"^",IBFT)=TAX
69 . I TAX="",$D(IBNOTAX) S IBNOTAX=$S(IBNOTAX="":IBFT,1:IBNOTAX_U_IBFT)
70 Q IBRETVAL
71GETTAX(IBPTR) ;look for Taxonomy in #200 or #355.93
72 ;Input: IBPTR from 399.0222, field .02
73 ;Output: Taxonomy X12 code_"^"_IEN
74 N TAX
75 S TAX="^"
76 ;if in 200 then get it from 200
77 I $P(IBPTR,";",2)="VA(200," S TAX=$$TAXIND^XUSTAX($P(IBPTR,";"))
78 ;if in 355.93 then use 355.93
79 I $P(IBPTR,";",2)="IBA(355.93," S TAX=$$TAXGET^IBCEP81($P(IBPTR,";"))
80 Q TAX
81 ;
82ORGNPI(IBIEN399,IBNONPI) ; Extract NPIs for organizations on this claim
83 ; Input
84 ; IBIEN399 - Claim IEN in file 399
85 ; IBNONPI - Variable to pass info on missing NPI back to calling routine. Pass by reference.
86 ; Output - NPI codes for facilities
87 ; Piece 1) Division (Responsible Institution) NPI code
88 ; Piece 2) Non-VA Service Facility NPI code
89 ; Piece 3) Billing Provider NPI code (main VA division)
90 N IBRETVAL,IBORG,IBEVDT,IBDIV,NPI
91 S IBNONPI=""
92 I $G(IBIEN399)="" Q ""
93 S IBRETVAL=""
94 S IBEVDT=$$GET1^DIQ(399,IBIEN399_",",.03,"I")
95 I IBEVDT="" S IBEVDT=DT
96 S IBDIV=$$GET1^DIQ(399,IBIEN399_",",.22,"I")
97 I IBDIV="" S IBDIV=$$PRIM^VASITE(IBEVDT)
98 S IBORG=$P($$SITE^VASITE(IBEVDT,IBDIV),U),NPI=""
99 I IBORG S NPI=$P($$NPI^XUSNPI("Organization_ID",IBORG),U) S:NPI'=-1 $P(IBRETVAL,U)=NPI
100 I NPI<1,$D(IBNONPI) S IBNONPI=1
101 S IBORG=$$GET1^DIQ(399,IBIEN399_",",232,"I")
102 I IBORG S NPI=$$NPIGET^IBCEP81(IBORG),$P(IBRETVAL,U,2)=NPI I 'NPI,$D(IBNONPI) S IBNONPI=$S(IBNONPI="":2,1:IBNONPI_U_2)
103 S IBORG=$P($$SITE^VASITE,U),NPI=""
104 I IBORG S NPI=$P($$NPI^XUSNPI("Organization_ID",IBORG),U) S:NPI'=-1 $P(IBRETVAL,U,3)=NPI
105 I NPI<1,$D(IBNONPI) S IBNONPI=$S(IBNONPI="":3,1:IBNONPI_U_3)
106 I $$ISRX^IBCEF1(IBIEN399) S IBORG=$$RXSITE(IBIEN399) I IBORG S NPI=$P($$NPI^XUSNPI("Organization_ID",IBORG),U) S:NPI'=-1 $P(IBRETVAL,U,3)=NPI
107 Q IBRETVAL
108 ;
109ORGTAX(IBIEN399,IBNOTAX) ; Extract Taxonomies for organizations on this claim
110 ; Input
111 ; IBIEN399 - Claim IEN in file 399
112 ; IBNOTAX - Variable to pass info on missing taxonomies back to calling routine. Pass by reference.
113 ; Output - Taxonomy X12 codes for facilities
114 ; Piece 1) Division (Responsible Institution) Taxonomy X12 code
115 ; Piece 2) Non-VA Service Facility Taxonomy X12 code
116 ; Piece 3) Billing Provider Taxonomy X12 code (main VA division)
117 N IBRETVAL,IBTAX,TAX
118 S IBTAX=$$GET1^DIQ(399,IBIEN399_",",243,"I")
119 S TAX=$$GET1^DIQ(8932.1,IBTAX,"X12 CODE")
120 S $P(IBRETVAL,U)=TAX
121 I '$L(TAX),$D(IBNOTAX) S IBNOTAX=1
122 S IBTAX=$$GET1^DIQ(399,IBIEN399_",",244,"I")
123 S TAX=$$GET1^DIQ(8932.1,IBTAX,"X12 CODE")
124 S $P(IBRETVAL,U,2)=TAX
125 I '$L(TAX),$$GET1^DIQ(399,IBIEN399_",",232,"I"),$D(IBNOTAX) S IBNOTAX=$S(IBNOTAX="":2,1:IBNOTAX_U_2)
126 S IBORG=$P($$SITE^VASITE,U)
127 S TAX=$P($$TAXORG^XUSTAX(IBORG),U)
128 S $P(IBRETVAL,U,3)=TAX
129 I '$L(TAX),$D(IBNOTAX) S IBNOTAX=$S(IBNOTAX="":3,1:IBNOTAX_U_3)
130 Q IBRETVAL
131 ;
132RXSITE(IBIEN399,IBLIST) ; returns prescription organization (file 4) pointer
133 ; for the given bill. If IBLIST passed by reference, then a list of
134 ; the possible organizations are returned for a bill, since a bill may
135 ; have more than one prescription. If more than one rx on the bill, the
136 ; $$ return is the pointer of the last prescription found.
137 ; IBLIST(rx ien,fill date)=ORGINATION (file 4 pointer)
138 ;
139 N IBX,IBDATA,IBORG,IBRX,IBDT,IBY,IBRXN,DFN
140 K ^TMP($J,"IBCEF73A")
141 S IBORG=0,DFN=$P($G(^DGCR(399,IBIEN399,0)),"^",2),IBLIST="IBCEF73A"
142 S IBRXN=0 F S IBRXN=$O(^IBA(362.4,"AIFN"_IBIEN399,IBRXN)) Q:'IBRXN S IBX=0 F S IBX=$O(^IBA(362.4,"AIFN"_IBIEN399,IBRXN,IBX)) Q:'IBX D
143 . S IBDATA=$G(^IBA(362.4,IBX,0))
144 . S IBRX=$P(IBDATA,"^",5),IBDT=$P(IBDATA,"^",3) Q:'IBRX!('IBDT)
145 . D RX^PSO52API(DFN,IBLIST,IBRX,,"0,2,R")
146 . I IBDT=+$G(^TMP($J,"IBCEF73A",DFN,IBRX,22)) S (IBORG,IBLIST(IBRX,IBDT))=$$PSONPI(+$G(^TMP($J,"IBCEF73A",DFN,IBRX,20))) Q
147 . S IBY=0 F S IBY=$O(^TMP($J,"IBCEF73A",DFN,IBRX,"RF",IBY)) Q:'IBY I IBDT=+$G(^TMP($J,"IBCEF73A",DFN,IBRX,"RF",IBY,.01)) S (IBORG,IBLIST(IBRX,IBDT))=$$PSONPI(+$G(^TMP($J,"IBCEF73A",DFN,IBRX,"RF",IBY,8))) Q
148 K ^TMP($J,"IBCEF73A")
149 Q IBORG
150 ;
151PSONPI(IB59IEN) ; returns institution ien for a file 59 ien
152 N IB4IEN
153 K ^TMP($J,"IBCEF59")
154 D PSS^PSO59(IB59IEN,,"IBCEF59")
155 S IB4IEN=+$G(^TMP($J,"IBCEF59",IB59IEN,101))
156 K ^TMP($J,"IBCEF59")
157 Q IB4IEN
Note: See TracBrowser for help on using the repository browser.