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

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

initial load of FOIAVistA 6/30/08 version
File size: 7.9 KB
Line 
1IBTUBO1 ;ALB/AAS - UNBILLED AMOUNTS - GENERATE UNBILLED REPORTS ;29-SEP-94
2 ;;2.0;INTEGRATED BILLING;**19,31,32,91,123,159,247,155,277,339**;21-MAR-94;Build 2
3 ;;Per VHA Directive 2004-038, this routine should not be modified.
4 ;
5OPT(IBOE,IBQUERY) ; - Has the outpatient encounter been billed?
6 ; Input: IBOE=pointer to outpatient encounter in file #409.68
7 ; (NOTE: this value may be null)
8 ; IBQUERY (Passed by reference)=flag that is incremented when
9 ; the Scheduling query API is invoked
10 ; *Pre-set variables: DFN=patient IEN, IBDT=event date, IBRT=bill rate,
11 ; IBEDT=End of reporting period date.
12 ; IBX=ien of CLAIMS TRACKING entry file 356
13 ;
14 I '$G(DFN)!('$G(IBDT))!('$G(IBRT))!'$G(IBX) G OPTQ
15 N IBCN,IBCPT,IBCT,IBDATA,IBDAY,IBDIV,IBFL,IBNAME,IBQUIT,IBNCF,IBXX,IBYD,IBYY,IBZ,IBMRA
16 ;
17 ; - Check to be sure the encounter is billable.
18 I $$INPT^IBAMTS1(DFN,IBDT\1_.2359) G OPTQ ; Became inpatient same day.
19 I $G(IBOE),$$ENCL^IBAMTS2(IBOE)["1" G OPTQ ; "ao^ir^sc^swa^mst^hnc^cv^shad" encounter.
20 S IBDAY=$E(IBDT,1,7),IBNAME=$P($G(^DPT(DFN,0)),U),IBQUIT="",IBNCF=0
21 ;
22 ; - If no encounter, see if add/edits or registrations are not billable.
23 I '$G(IBOE) D NOOE G:IBQUIT OPTQ
24 ;
25 ; - If encounter was dated prior to Reasonable Charges (9/1/99) and
26 ; the claim was not authorized before end of reporting period, add
27 ; encounter Tort Rate to Unbilled Outpatient Amount
28 I IBDAY<2990901 D PRERC,SETUB:'IBQUIT G OPTQ
29 I '$G(IBOE) G OPTQ ; If still no encounter, quit.
30 ;
31 ; - If encounter was made after start of Reasonable Charges (9/1/99)
32 ; and any of the encounter's procedure codes have no corresponding
33 ; inst. or prof. claims that were not authorized before end of the
34 ; reporting period, add the charges for the procedures to the
35 ; Unbilled Outpatient Amount.
36 ;
37 ; - Gather all procedures associated with the encounter.
38 D GETCPT^SDOE(IBOE,"IBYY") G:'$G(IBYY) OPTQ ; Check CPT qty.
39 ;
40 ; - Determine the encounter division.
41 S IBDIV=+$P($$GETOE^SDOE(IBOE),U,11) S:'IBDIV IBDIV=+$$PRIM^VASITE()
42 ;
43 ; - Build array of all billable encounter procedures.
44 S IBXX=0 F S IBXX=$O(IBYY(IBXX)) Q:'IBXX D
45 . ;
46 . ; - Get procedure pointer and code.
47 . S IBZ=+IBYY(IBXX),IBCN=$P($$CPT^ICPTCOD(IBZ),"^",2)
48 . ;
49 . ; - Ignore LAB services for vets with Medicare Supplemental coverage.
50 . I IBCN>79999,IBCN<90000 Q
51 . ;
52 . ; - Get the institutional/professional charge components.
53 . S IBCPT(IBZ,1)=+$$BICOST^IBCRCI(IBRT,3,IBDAY,"PROCEDURE",IBZ,"",IBDIV,"",1)
54 . S IBCPT(IBZ,2)=+$$BICOST^IBCRCI(IBRT,3,IBDAY,"PROCEDURE",IBZ,"",IBDIV,"",2)
55 . ;
56 . ; - Eliminate components without a charge.
57 . I 'IBCPT(IBZ,1) K IBCPT(IBZ,1)
58 . I 'IBCPT(IBZ,2) K IBCPT(IBZ,2)
59 ;
60 I '$D(IBCPT) G OPTQ ; Quit if no billable procedures remain.
61 ;
62 ; - Look at all of the vet's bills for the day and eliminate
63 ; from the array those procedures that have been billed.
64 S IBXX=0
65 F S IBXX=$O(^DGCR(399,"AOPV",DFN,IBDAY,IBXX)) Q:'IBXX D
66 . ;
67 . ; - Perform general checks on the claim.
68 . S IBDATA=$$CKBIL^IBTUBOU(IBXX) Q:IBDATA=""
69 . I $P(IBDATA,U,2)=2 S IBMRA(IBXX)=IBDATA ; MRA request
70 . S IBNCF=IBNCF+1
71 . ;
72 . ; If Compile/Store & Not authorized/MRA requested before reporting period - Quit.
73 . I $G(IBCOMP),$S('$G(IBMRA(IBXX)):$P(IBDATA,U,3),1:$P(IBDATA,U,6))>IBEDT Q
74 . ;
75 . ; - The episode has been billed. Check the revenue code multiple for
76 . ; all procedures billed on the claim.
77 . S IBYY=0
78 . F S IBYY=$O(^DGCR(399,IBXX,"RC",IBYY)) Q:'IBYY S IBYD=^(IBYY,0) D
79 . . ;
80 . . ; - Get the procedure code and charge type for the revenue code.
81 . . S IBZ=$P(IBYD,U,6)
82 . . S IBCT=$S($P(IBYD,U,12):$P(IBYD,U,12),1:$P(IBDATA,U,4))
83 . . I 'IBZ!('IBCT) Q ; Can't determine code/charge type for procedure.
84 . . I $G(IBMRA(IBXX))'="" S:$D(IBCPT(IBZ)) IBCPT("MRA",IBZ,IBCT)=1 Q
85 . . ; Delete procedure from unbilled procedures array.
86 . . I $D(IBCPT(IBZ,IBCT)) K IBCPT(IBZ,IBCT) Q
87 . . K IBCPT(IBZ)
88 ;
89 ; - Again, quit if no billable procedures remain.
90 I '$D(IBCPT) G OPTQ
91 ;
92 ; - The encounter has unbilled procedure codes. Increment the counters
93 ; as per the extract specification.
94 ;
95 ; - Count the encounter (element 37N).
96 S IBMRA=$S($D(IBCPT("MRA")):1,1:0)
97 S:'IBMRA IBUNB("ENCNTRS")=IBUNB("ENCNTRS")+1
98 S:$G(IBXTRACT) IB(14)=IB(14)+1
99 ;
100 ; - Look at all the unbilled procedures.
101 S IBZ=0 F S IBZ=$O(IBCPT(IBZ)) Q:'IBZ D
102 . ;
103 . S IBMRA=$S($D(IBCPT("MRA",IBZ)):1,1:0)
104 . ; - Count the procedure (element 37M).
105 . I $G(IBXTRACT) S IB(13)=IB(13)+1
106 . ;
107 . ; - Count the institutional component (element 37I) and its
108 . ; corresponding charge amount (element 37J).
109 . I $G(IBCPT(IBZ,1)) D
110 . . S:'IBMRA IBUNB("CPTMS-I")=IBUNB("CPTMS-I")+1
111 . . S:'IBMRA IBUNB("UNBILOP")=IBUNB("UNBILOP")+IBCPT(IBZ,1)
112 . . S:IBMRA IBUNB("CPTMS-I-MRA")=IBUNB("CPTMS-I-MRA")+1
113 . . S:IBMRA IBUNB("UNBILOP-MRA")=IBUNB("UNBILOP-MRA")+IBCPT(IBZ,1)
114 . . I $G(IBXTRACT) S IB(9)=IB(9)+1,IB(10)=IB(10)+IBCPT(IBZ,1)
115 . ;
116 . ; - Count the professional component (element 37K) and its
117 . ; corresponding charge amount (element 37L).
118 . I $G(IBCPT(IBZ,2)) D
119 . . S:'IBMRA IBUNB("CPTMS-P")=IBUNB("CPTMS-P")+1
120 . . S:'IBMRA IBUNB("UNBILOP")=IBUNB("UNBILOP")+IBCPT(IBZ,2)
121 . . S:IBMRA IBUNB("CPTMS-P-MRA")=IBUNB("CPTMS-P-MRA")+1
122 . . S:IBMRA IBUNB("UNBILOP-MRA")=IBUNB("UNBILOP-MRA")+IBCPT(IBZ,2)
123 . . I $G(IBXTRACT) S IB(11)=IB(11)+1,IB(12)=IB(12)+IBCPT(IBZ,2)
124 ;
125 D SETUB
126 ;
127OPTQ Q
128 ;
129PRERC ; - Determine if a pre-9/1/99 visit has been billed.
130 ; Output: IBQUIT will be set to 1 if the visit has been billed.
131 ; *Pre-set variables DFN,IBDAY,IBDET,IBNAME,IBNCF,IBQUIT,IBRT,IBEDT
132 ; and IB/IBUNB arrays required.
133 ; NO MRA Extract code needed for pre-RC processes
134 I $D(^TMP($J,"IBTUB-OPT",IBNAME_"@@"_DFN,IBDAY)) S IBQUIT=1 G PRCQ
135 ;
136 ; - Check all outpatient claims on event date.
137 N IBXX S IBXX=0
138 F S IBXX=$O(^DGCR(399,"AOPV",DFN,IBDAY,IBXX)) Q:'IBXX D Q:IBQUIT
139 . ;
140 . ; - Perform general checks on the claim.
141 . S IBDATA=$$CKBIL^IBTUBOU(IBXX) Q:IBDATA="" S IBNCF=IBNCF+1
142 . ;
143 . ; If Compile/Store & Not authorized before reporting period - Quit.
144 . I $G(IBCOMP),$P(IBDATA,U,3)>IBEDT Q
145 . ;
146 . S IBQUIT=1 ; Episode has been billed-set flag.
147 ;
148 I IBQUIT G PRCQ ; Episode was billed.
149 ;
150 ; - The episode was not billed; determine the tort rate for a visit
151 ; and increment the number and amount of unbilled pre-9/1/99 visits.
152 S IBXX=+$$BICOST^IBCRCI(IBRT,3,IBDAY,"OUTPATIENT VISIT DATE")
153 S IBUNB("UNBILOP")=IBUNB("UNBILOP")+IBXX
154 S IBUNB("ENCNTRS")=IBUNB("ENCNTRS")+1
155 ;
156 I $G(IBXTRACT) S IB(7)=IB(7)+1,IB(8)=IB(8)+IBXX ; For DM extract.
157 ;
158PRCQ Q
159 ;
160NOOE ; - If there is no encounter, look for add/edits or registrations.
161 ; Output: IBQUIT will be set to 1 if the visit is non-billable.
162 ; *Pre-set variable IBQUIT required.
163 N IBDATA,IBSC,IBSDV,IBXX,IBZERR
164 ;
165 ; - Check if for a visit at the visit date/time.
166 S IBXX=$$EXOE^SDOE(DFN,IBDT,IBDT,"","IBZERR")
167 I IBXX D CKENC^IBTUBOU(IBXX,"",.IBQUIT) G NOOEQ
168 ;
169 ; - Find next add/edit stop code encounter after IBDT.
170 D SCAN^IBTUBOU(DFN,IBDT,.IBQUERY)
171 ;
172NOOEQ Q
173 ;
174SETUB ; Set array elements for the detail report.
175 ; Array element format:
176 ; NON-MRA:
177 ; ^TMP($J,"IBTUB-OPT",NAME@@DFN,DATE,IBX)=bill status^claim type
178 ; ^TMP($J,"IBTUB-OPT",NAME@@DFN,DATE,IBX,CPT no)=inst rate^prof rate
179 ; MRA:
180 ; ^TMP($J,"IBTUB-OPT_MRA",NAME@@DFN,DATE,IBX,CPT no)=1 if MRA req
181 ;
182 N IBCTF,IBCPTNM
183 I $S($G(IBINMRA):1,1:'$O(IBCPT("MRA",""))) S ^TMP($J,"IBTUB-OPT",IBNAME_"@@"_DFN,IBDAY,IBX)=IBNCF
184 I $G(IBINMRA),$O(IBCPT("MRA","")) S ^TMP($J,"IBTUB-OPT_MRA",IBNAME_"@@"_DFN,IBDAY,IBX)=1
185 G:'IBDET SETUBQ
186 I $D(IBCPT) S IBXX=0 F S IBXX=$O(IBCPT(IBXX)) Q:'IBXX D
187 . S IBCPTNM=$$CODEC^ICPTCOD(IBXX) I IBCPTNM=-1 S IBCPTNM="UNK"
188 . S IBCTF=$S($G(IBCPT(IBXX,1)):"I",1:"")
189 . S IBCTF=$S($G(IBCPT(IBXX,2)):$S(IBCTF="I":"I,P",1:"P"),1:IBCTF)
190 . I $S($G(IBINMRA):1,1:'$O(IBCPT("MRA",""))) S ^TMP($J,"IBTUB-OPT",IBNAME_"@@"_DFN,IBDAY,IBX,IBCPTNM)=+$G(IBCPT(IBXX,1))_U_+$G(IBCPT(IBXX,2))_U_IBCTF
191 . I $G(IBINMRA) S:$G(IBCPT("MRA",IBXX)) ^TMP($J,"IBTUB-OPT_MRA",IBNAME_"@@"_DFN,IBDAY,IBX,IBCPTNM)=1
192 ;
193SETUBQ Q
Note: See TracBrowser for help on using the repository browser.