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

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

initial load of FOIAVistA 6/30/08 version
File size: 7.0 KB
Line 
1IBCNSMR ;ALB/AAS - MEDICARE BILLS ; 02-SEPT-97
2 ;;2.0;INTEGRATED BILLING;**92,240**;21-MAR-94
3 ;
4% G RPRT^IBCNSMRA
5 ;
6DQ ; -- entry point from task manager
7 N I,J,X,Y,IBINSCO,INSCO,NODE,CNT,IBI,IBINSNM,IBNM
8 S IBQUIT=0
9 K ^TMP("IB-MRA",$J),^TMP("IB-MRA-CNT",$J)
10 ;
11 S I=0
12 F S I=$O(^IBE(350.9,1,99,I)) Q:'I S INSCO(+$G(^IBE(350.9,1,99,I,0)))=""
13 ;
14 S IBI=0
15 F S IBI=$O(^DGCR(399,IBI)) Q:'IBI!(IBQUIT) D
16 .S IBQUIT=$$STOP Q:IBQUIT
17 .S IBINSCO="" K NODE
18 .S NODE(0)=$G(^DGCR(399,IBI,0)) Q:NODE(0)=""
19 .S NODE("C")=$G(^DGCR(399,IBI,"C"))
20 .S NODE("M")=$G(^DGCR(399,IBI,"M")) Q:NODE("M")=""
21 .S NODE("U")=$G(^DGCR(399,IBI,"U")) Q:NODE("U")=""
22 .I $D(INSCO(+NODE("M"))) S IBINSCO=+NODE("M")
23 .I 'IBINSCO,$D(INSCO(+$P(NODE("M"),"^",2))) S IBINSCO=$P(NODE("M"),"^",2)
24 .I 'IBINSCO,$D(INSCO(+$P(NODE("M"),"^",3))) S IBINSCO=$P(NODE("M"),"^",3)
25 .I IBINSCO S IBINSNM=$P($G(^DIC(36,IBINSCO,0)),"^") D BLDDATA
26 ;
27 I 'IBQUIT D PRINT^IBCNSMR0
28 G END^IBCNSMRA
29END Q
30 ;
31BLDDATA ; -- for each bill sent to a selected ins. co. build temp node
32 N X,YEAR,TYPE,TYPENO,PROC,DIAG,ORGAMNT,BOTH,IBSTAT,DFN,ALIVE,ARSTAT,IBQUIT,RXBILL,PROSBILL,BILLNO,LOCCARE,RATETYP,RN,WHO,TIMEFRM,TOTPAID,REFGC,DATEPR
33 S IBQUIT=0
34 S BILLNO=$P(NODE(0),"^")
35 S YEAR=$E(+NODE("U"),2,3)
36 S TYPENO=$P(NODE(0),"^",5)
37 S TYPE=$S(TYPENO<3:"INPATIENT",1:"OUTPATIENT")
38 S PROC=$$PROC(IBI)
39 S DIAG=$$DIAG(IBI)
40 S IBSTAT=$P(NODE(0),"^",13)
41 S ARSTAT=$$STA^PRCAFN(IBI)
42 S DFN=$P(NODE(0),"^",2)
43 S ALIVE=$S(+$G(^DPT(DFN,.35)):"DEAD",1:"ALIVE")
44 S ORGAMNT=$$ORI^PRCAFN(IBI)
45 S LOCCARE=$P(NODE(0),"^",4)
46 S WHO=$P(NODE(0),"^",11)
47 S RATETYP=$P(NODE(0),"^",7)
48 S RN=$P($G(^DGCR(399.3,+RATETYP,0)),"^")
49 S TIMEFRM=$P(NODE(0),"^",6)
50 S TOTPAID=$$TPR^PRCAFN(IBI)
51 S REFGC=$P($G(^PRCA(430,IBI,6)),"^",4)'=""
52 S DATEPR=$P($G(^DGCR(399,IBI,"S")),"^",12)
53 S BOTH="NONE"
54 S RXBILL=0
55 S PROSBILL=0
56 I $O(^IBA(362.4,"AIFN"_IBI,"")) S RXBILL=1
57 I $O(^IBA(362.5,"AIFN"_IBI,"")) S PROSBILL=1
58 D COUNT
59 D:'IBQUIT SET
60 Q
61 ;
62COUNT ; -- set totals for all ins, and by ins co.
63 S CNT=$G(CNT)+1
64 S CNT(0)=$G(CNT(0))+ORGAMNT
65 S CNT(3,IBINSNM)=$G(CNT(3,IBINSNM))+1
66 S CNT(3,IBINSNM,0)=$G(CNT(3,IBINSNM,0))+ORGAMNT
67 I TYPE="INPATIENT" D
68 .S CNT("IN")=$G(CNT("IN"))+1
69 .S CNT("IN",0)=$G(CNT("IN",0))+ORGAMNT
70 .I TOTPAID>0 D
71 ..S CNT("IN",1)=$G(CNT("IN",1))+1
72 ..S CNT("IN",2)=$G(CNT("IN",2))+TOTPAID
73 I TYPE="OUTPATIENT" D
74 .S CNT("OP")=$G(CNT("OP"))+1
75 .S CNT("OP",0)=$G(CNT("OP",0))+ORGAMNT
76 .I TOTPAID>0 D
77 ..S CNT("OP",1)=$G(CNT("OP",1))+1
78 ..S CNT("OP",2)=$G(CNT("OP",2))+TOTPAID
79 I TOTPAID>0 D
80 .S CNT(1)=$G(CNT(1))+1
81 .S CNT(2)=$G(CNT(2))+TOTPAID
82 .S CNT(3,IBINSNM,1)=$G(CNT(3,IBINSNM,1))+1
83 .S CNT(3,IBINSNM,2)=$G(CNT(3,IBINSNM,2))+TOTPAID
84 ;
85 ;I ALIVE'="ALIVE" D ; decided to keep dead patients in the report 10/28/97
86 ;.S CNT("A")=$G(CNT("A"))+1
87 ;.S CNT("A",0)=$G(CNT("A",0))+ORGAMNT
88 ;.;S IBQUIT=1
89 ;.I TOTPAID>0 D
90 ;..S CNT("A",1)=$G(CNT("A",1))+1
91 ;..S CNT("A",2)=$G(CNT("A",2))+TOTPAID
92 ;
93 I DIAG="YES"&(PROC="NO") D
94 .S BOTH="DIAG"
95 .S IBQUIT=1
96 .S CNT("D")=$G(CNT("D"))+1
97 .S CNT("D",0)=$G(CNT("D",0))+ORGAMNT
98 .I TOTPAID>0 D
99 ..S CNT("D",1)=$G(CNT("D",1))+1
100 ..S CNT("D",2)=$G(CNT("D",2))+TOTPAID
101 ;
102 I PROC="YES"&(DIAG="NO") D
103 .S BOTH="PROC"
104 .S IBQUIT=1
105 .S CNT("P")=$G(CNT("P"))+1
106 .S CNT("P",0)=$G(CNT("P",0))+ORGAMNT
107 .I TOTPAID>0 D
108 ..S CNT("P",1)=$G(CNT("P",1))+1
109 ..S CNT("P",2)=$G(CNT("P",2))+TOTPAID
110 ;
111 I PROC="YES"&(DIAG="YES") D
112 .S BOTH="BOTH"
113 .S CNT("B")=$G(CNT("B"))+1
114 .S CNT("B",0)=$G(CNT("B",0))+ORGAMNT
115 .I TOTPAID>0 D
116 ..S CNT("B",1)=$G(CNT("B",1))+1
117 ..S CNT("B",2)=$G(CNT("B",2))+TOTPAID
118 ;
119 I BOTH="NONE" D
120 .S CNT("N")=$G(CNT("N"))+1
121 .S CNT("N",0)=$G(CNT("N",0))+ORGAMNT
122 .I TOTPAID>0 D
123 ..S CNT("N",1)=$G(CNT("N",1))+1
124 ..S CNT("N",2)=$G(CNT("N",2))+TOTPAID
125 ;
126 I BOTH'="BOTH" S IBQUIT=1
127 ;
128 I IBSTAT=7,+ARSTAT=210 D ;bill canceled before completion
129 .S CNT("C")=$G(CNT("C"))+1
130 .S CNT("C",0)=$G(CNT("C",0))+ORGAMNT
131 .S IBQUIT=1
132 .I TOTPAID>0 D
133 ..S CNT("C",1)=$G(CNT("C",1))+1
134 ..S CNT("C",2)=$G(CNT("C",2))+TOTPAID
135 ;
136 I TYPENO=2!(TYPENO=4) D
137 .S CNT("T")=$G(CNT("T"))+1
138 .S CNT("T",0)=$G(CNT("T",0))+ORGAMNT
139 .S IBQUIT=1
140 .I TOTPAID>0 D
141 ..S CNT("T",1)=$G(CNT("T",1))+1
142 ..S CNT("T",2)=$G(CNT("T",2))+TOTPAID
143 ;
144 I WHO'="i" D
145 .S CNT("W")=$G(CNT("W"))+1
146 .S CNT("W",0)=$G(CNT("W",0))+ORGAMNT
147 .S IBQUIT=1
148 .I TOTPAID>0 D
149 ..S CNT("W",1)=$G(CNT("W",1))+1
150 ..S CNT("W",2)=$G(CNT("W",2))+TOTPAID
151 ;
152 I DATEPR="",IBSTAT<3 D
153 .S CNT("F")=$G(CNT("F"))+1
154 .S CNT("F",0)=$G(CNT("F",0))+ORGAMNT
155 .S IBQUIT=1
156 .I TOTPAID>0 D
157 ..S CNT("F",1)=$G(CNT("F",1))+1
158 ..S CNT("F",2)=$G(CNT("F",2))+TOTPAID
159 ;
160 I $G(RXBILL) D
161 .S CNT("X")=$G(CNT("X"))+1
162 .S CNT("X",0)=$G(CNT("X",0))+ORGAMNT
163 .S IBQUIT=1
164 .I TOTPAID>0 D
165 ..S CNT("X",1)=$G(CNT("X",1))+1
166 ..S CNT("X",2)=$G(CNT("X",2))+TOTPAID
167 ;
168 I $G(PROSBILL) D
169 .S CNT("Z")=$G(CNT("Z"))+1
170 .S CNT("Z",0)=$G(CNT("Z",0))+ORGAMNT
171 .S IBQUIT=1
172 .I TOTPAID>0 D
173 ..S CNT("Z",1)=$G(CNT("Z",1))+1
174 ..S CNT("Z",2)=$G(CNT("Z",2))+TOTPAID
175 ;
176 I $S(RN["MEANS":1,RN["DENTAL":1,RN["TORT":1,RN["TRICARE":1,RN["CHAMPVA":1,RN["MEDICARE":1,RN["WORKERS":1,RN["CRIME":1,RN["SHARING":1,1:0) D
177 .S CNT("R")=$G(CNT("R"))+1
178 .S CNT("R",0)=$G(CNT("R",0))+ORGAMNT
179 .S IBQUIT=1
180 .I TOTPAID>0 D
181 ..S CNT("R",1)=$G(CNT("R",1))+1
182 ..S CNT("R",2)=$G(CNT("R",2))+TOTPAID
183 Q
184 ;
185PROC(IBI) ; -- does bill have any procedures
186 N PROC
187 S PROC="NO"
188 I $O(^DGCR(399,IBI,"CP",0)) S PROC="YES"
189 I +NODE("C")!($P(NODE("C"),"^",4))!($P(NODE("C"),"^",7)) S PROC="YES"
190 Q PROC
191 ;
192DIAG(IBI) ; -- does bill have any diagnosis
193 N DIAG
194 S DIAG="NO"
195 I $O(^IBA(362.3,"AIFN"_IBI,0)) S DIAG="YES"
196 I $P(NODE("C"),"^",10)!($P(NODE("C"),"^",14)) S DIAG="YES"
197 Q DIAG
198 ;
199SET ; -- set up tmp global
200 S CNT("M")=$G(CNT("M"))+1,CNT("M",0)=$G(CNT("M",0))+ORGAMNT
201 I REFGC D
202 .S CNT("M",4)=$G(CNT("M",4))+1
203 .S CNT("M",5)=$G(CNT("M",5))+ORGAMNT
204 .I TOTPAID>0 D
205 ..S CNT("M",6)=$G(CNT("M",6))+1
206 ..S CNT("M",7)=$G(CNT("M",7))+TOTPAID
207 I TOTPAID>0 D
208 .S CNT("M",1)=$G(CNT("M",1))+1
209 .S CNT("M",2)=$G(CNT("M",2))+TOTPAID
210 I TYPE="INPATIENT" D
211 .S CNT("M","IN")=$G(CNT("M","IN"))+1
212 .S CNT("M","IN",0)=$G(CNT("M","IN",0))+ORGAMNT
213 .I TOTPAID>0 D
214 ..S CNT("M","IN",1)=$G(CNT("M","IN",1))+1
215 ..S CNT("M","IN",2)=$G(CNT("M","IN",2))+TOTPAID
216 I TYPE="OUTPATIENT" D
217 .S CNT("M","OP")=$G(CNT("M","OP"))+1
218 .S CNT("M","OP",0)=$G(CNT("M","OP",0))+ORGAMNT
219 .I TOTPAID>0 D
220 ..S CNT("M","OP",1)=$G(CNT("M","OP",1))+1
221 ..S CNT("M","OP",2)=$G(CNT("M","OP",2))+TOTPAID
222 ;
223 S ^TMP("IB-MRA",$J,+$G(IBINSCO),+$G(YEAR),$G(TYPE,"UNKNOWN"),BOTH,$G(ARSTAT,"UNKNOWN"),+$G(IBSTAT),IBI)=BILLNO_"^"_DFN
224 ;
225 S ^TMP("IB-MRA-CNT",$J,IBINSCO,YEAR,TYPE,BOTH,ARSTAT,IBSTAT)=(+$G(^TMP("IB-MRA-CNT",$J,IBINSCO,YEAR,TYPE,BOTH,ARSTAT,IBSTAT))+1)
226 ;
227 S ^TMP("IB-MRA-CNT",$J,IBINSCO,YEAR,TYPE,BOTH,ARSTAT,IBSTAT,0)=+$G(^TMP("IB-MRA-CNT",$J,IBINSCO,YEAR,TYPE,BOTH,ARSTAT,IBSTAT,0))+ORGAMNT
228 ;
229 I TOTPAID>0 D
230 .S ^TMP("IB-MRA-CNT",$J,IBINSCO,YEAR,TYPE,BOTH,ARSTAT,IBSTAT,1)=+$G(^TMP("IB-MRA-CNT",$J,IBINSCO,YEAR,TYPE,BOTH,ARSTAT,IBSTAT,1))+1
231 .S ^TMP("IB-MRA-CNT",$J,IBINSCO,YEAR,TYPE,BOTH,ARSTAT,IBSTAT,2)=+$G(^TMP("IB-MRA-CNT",$J,IBINSCO,YEAR,TYPE,BOTH,ARSTAT,IBSTAT,2))+TOTPAID
232 Q
233 ;
234STOP() ; -- determine if user requested task to stop
235 I $D(ZTQUEUED),$$S^%ZTLOAD S ZTSTOP=1 K ZTREQ
236 Q +$G(ZTSTOP)
Note: See TracBrowser for help on using the repository browser.