source: FOIAVistA/trunk/r/E_CLAIMS_MGMT_ENGINE-BPS/BPSRPT5.m@ 635

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

initial load of FOIAVistA 6/30/08 version

File size: 9.4 KB
Line 
1BPSRPT5 ;BHAM ISC/BEE - ECME REPORTS ;14-FEB-05
2 ;;1.0;E CLAIMS MGMT ENGINE;**1,3,5**;JUN 2004;Build 45
3 ;;Per VHA Directive 2004-038, this routine should not be modified.
4 ;
5 Q
6 ;
7 ;Routine to Display the Reports
8 ;
9 ;Print Report Line 1
10 ;
11 ; Input Variables -> BPRTYPE,BPDIV,BPGRPLAN,BPDFN,BPRX,BPREF,BPX,BPSRTDT,BPBIL,BPINS
12 ; BPCOLL,BPEXCEL
13 ;
14WRLINE1(BPRTYPE,BPREC,BPDIV,BPGRPLAN,BPDFN,BPRX,BPREF,BPX,BPSRTDT,BPBIL,BPINS,BPCOLL,BPEXCEL) ;
15 ;
16 ;Excel Output
17 I $G(BPEXCEL) D WRLINE1^BPSRPT8(BPRTYPE,.BPREC,BPDIV,BPGRPLAN,BPDFN,BPRX,BPREF,BPX,BPSRTDT,BPBIL,BPINS,BPCOLL) Q
18 ;
19 ;Report Output
20 ;
21 W !,$$PATNAME^BPSRPT6(BPDFN)
22 W ?27,"("_$$SSN4^BPSRPT6(BPDFN)_")"
23 W ?35,$$RXNUM^BPSRPT6(BPRX)_$$COPAY^BPSRPT6(BPRX)
24 W ?47,BPREF,"/",$$ECMENUM^BPSRPT1($P(BPX,U,3))
25 ;
26 I (BPRTYPE=1)!(BPRTYPE=4) D Q
27 . W ?68,$$DATTIM^BPSRPT1(BPSRTDT)
28 . W ?78,$J(BPBIL,10,2),?100,$J(BPINS,10,2),?122,$S(BPCOLL]"":$J(BPCOLL,10,2),1:"")
29 ;
30 I BPRTYPE=2 D Q
31 . W ?68,$$DATTIM^BPSRPT1(BPSRTDT)
32 . W ?78,$$DATTIM^BPSRPT1(+BPX)
33 . W ?91,$$MWC^BPSRPT6(BPRX,BPREF)
34 . W ?94,$$RTBCKNAM^BPSRPT1($$RTBCK^BPSRPT1($P(BPX,U,3)))
35 . W ?98,$$RXSTATUS^BPSRPT6($P(BPX,U,3))
36 . W ?101,$S($P(BPX,U):"/RL",1:"/NR")
37 I BPRTYPE=3 D Q
38 . W ?68,$$DATTIM^BPSRPT1(BPSRTDT)
39 . W ?100,$J(BPBIL,10,2),?122,$J(BPINS,10,2)
40 ;
41 I BPRTYPE=5 D Q
42 . W ?60,$$DATTIM^BPSRPT1($$TRANDT^BPSRPT2($P(BPX,U,3),1))
43 . W ?78,$$TTYPE^BPSRPT7($P(BPX,U,4),$P(BPX,U,5))
44 . W ?95,$$RESPONSE^BPSRPT7($P(BPX,U,4),$P(BPX,U,5))
45 ;
46 I BPRTYPE=7 D Q
47 . W ?65,$$MWC^BPSRPT6(BPRX,BPREF)
48 . W ?68,$$RTBCKNAM^BPSRPT1($$RTBCK^BPSRPT1($P(BPX,U,3)))
49 . W ?72,$$RXSTATUS^BPSRPT6($P(BPX,U,3))
50 . W ?75,$S($P(BPX,U):"/RL",1:"/NR")
51 . W ?79,$S($P(BPX,U,13):"REJ",1:"")
52 . W ?87,$$DRGNAM^BPSRPT6($P(BPX,U,14),30)
53 . W ?118,$$GETNDC^BPSRPT6(BPRX,BPREF)
54 Q
55 ;
56 ;Print Report Line 2
57 ;
58 ; Input Variables -> BPRTYPE,BPX,BPRX,BPREF,BPBIL,BPGRPLAN,BPEXCEL
59 ;
60WRLINE2(BPRTYPE,BPREC,BPX,BPRX,BPREF,BPBIL,BPGRPLAN,BPEXCEL,BPICNT) ;
61 ;
62 ;Excel Output
63 I $G(BPEXCEL) D WRLINE2^BPSRPT8(BPRTYPE,.BPREC,BPX,BPRX,BPREF,BPBIL,BPGRPLAN) Q
64 ;
65 ;Report Output
66 I (BPRTYPE=1)!(BPRTYPE=4) D Q
67 . W !,?4,$$DRGNAM^BPSRPT6($P(BPX,U,14),27),?32,$$GETNDC^BPSRPT6(BPRX,BPREF)
68 . I BPRTYPE=1 W ?47,$$DATTIM^BPSRPT1(+BPX)
69 . W ?68,$$MWC^BPSRPT6(BPRX,BPREF)
70 . W ?71,$$RTBCKNAM^BPSRPT1($$RTBCK^BPSRPT1($P(BPX,U,3)))
71 . W ?75,$$RXSTATUS^BPSRPT6($P(BPX,U,3))
72 . W ?78,$S($P(BPX,U):"/RL",1:"/NR")
73 . W ?82,$S($P(BPX,U,13):"REJ",1:"")
74 . I BPRTYPE=1 W ?122,$J($$BILL^BPSRPT6(BPRX,BPREF),10)
75 ;
76 I BPRTYPE=2 D Q
77 . W !,?3,$E($$CRDHLDID^BPSRPT2(+$P(BPX,U,3)),3,23)
78 . W ?31,$E($$GRPID^BPSRPT2(+$P(BPX,U,3)),3,10)
79 . W ?41,$J(BPBIL,10,2)
80 . W ?54,$$QTY^BPSRPT6($P(BPX,U,3))
81 . W ?61,$$GETNDC^BPSRPT6(BPRX,BPREF)
82 . W ?82,$$DRGNAM^BPSRPT6($P(BPX,U,14),32)
83 ;
84 I BPRTYPE=3 D Q
85 . W !,?4,$$DRGNAM^BPSRPT6($P(BPX,U,14),32)
86 . W ?41,$$GETNDC^BPSRPT6(BPRX,BPREF)
87 . W ?68,$$MWC^BPSRPT6(BPRX,BPREF)
88 . W ?71,$$RTBCKNAM^BPSRPT1($$RTBCK^BPSRPT1($P(BPX,U,3)))
89 . W ?74,$$RXSTATUS^BPSRPT6($P(BPX,U,3))
90 . W ?77,$S($P(BPX,U):"/RL",1:"/NR")
91 . W ?81,$S($P(BPX,U,13):"REJ",1:"")
92 ;
93 I BPRTYPE=5 D Q
94 . W !,?4,$$DRGNAM^BPSRPT6($P(BPX,U,14),23)
95 . W ?28,$$GETNDC^BPSRPT6(BPRX,BPREF)
96 . W ?47,$$MWC^BPSRPT6(BPRX,BPREF)
97 . W ?50,$$RTBCKNAM^BPSRPT1($$RTBCK^BPSRPT1($P(BPX,U,3)))
98 . W ?53,$$RXSTATUS^BPSRPT6($P(BPX,U,3))
99 . W ?56,$S($P(BPX,U):"/RL",1:"/NR")
100 . W ?60,$S($P(BPX,U,13):"REJ",1:"")
101 . I $P(BPGRPLAN,U,2)]"" W ?69,$E($P(BPGRPLAN,U,2),1,30)
102 . W ?122,$J($$ELAPSE^BPSRPT6($P(BPX,U,3)),10)
103 ;
104 I BPRTYPE=7 D Q
105 . W !,?3,$E($$CRDHLDID^BPSRPT2(+$P(BPX,U,3)),3,23)
106 . W ?31,$E($$GRPID^BPSRPT2(+$P(BPX,U,3)),3,10)
107 . W ?41,$$DATTIM^BPSRPT1(+$$CLOSEDT^BPSRPT2(+$P(BPX,U,3)))
108 . N BPCLBY S BPCLBY=$E($$CLSBY^BPSRPT6(+$P(BPX,U,3)),1,25) S:BPCLBY="" BPCLBY="BLANK"
109 . W ?59,BPCLBY S BPCNT(BPCLBY)=$G(BPCNT(BPCLBY))+1,BPGCNT(BPCLBY)=$G(BPGCNT(BPCLBY))+1,BPICNT(BPCLBY)=$G(BPICNT(BPCLBY))+1
110 . W ?87,$E($P($$CLRSN^BPSRPT7(+$P(BPX,U,3)),U,2),1,30)
111 Q
112 ;
113 ;Print Report Line 3
114 ;
115 ; Input Variables -> BPRTYPE,BPX,BPEXCEL
116 ;
117WRLINE3(BPRTYPE,BPREC,BPX,BPEXCEL) N BP59
118 S BP59=+$P(BPX,U,3)
119 ;
120 ;Excel Output
121 I $G(BPEXCEL) D WRLINE3^BPSRPT8(BPRTYPE,.BPREC,BPX) Q
122 ;
123 ;Report Output
124 I BPRTYPE=4 D
125 . S NP=$$CHKP(1) Q:BPQ
126 . ;Released On
127 . W !,?6,$$DATTIM^BPSRPT1(+BPX)
128 . ;Method
129 . I $$AUTOREV^BPSRPT1(BP59) W ?22,"AUTO/"
130 . E W ?22,"REGULAR/"
131 . ;Return Status
132 . I $P(BPX,U,15)["ACCEPTED" W "ACCEPTED/"
133 . E W "REJECTED/"
134 . ;Reason
135 . W $$RVSRSN^BPSRPT7(+$P(BPX,U,3))
136 ;
137 Q
138 ;
139 ;Display the Report
140 ;
141 ; Input Variables -> REF,BPEXCEL,BPSCR,BPRPTNAM,BPSUMDET,BPPAGE
142 ;
143REPORT(REF,BPEXCEL,BPSCR,BPRPTNAM,BPSUMDET,BPPAGE) N BPBIL,BPBLINE,BPCOLL,BPDFN,BPDIV,BPELTM,BPGELTM,BPGBIL,BPGINS,BPGCOLL,BPGCNT,BPGRPLAN,BPINS,BPLINES,BPREC,BPREF,BPRX,BPSRTDT,BPSTATUS,BPTBIL,BPTCOLL,BPTINS,BPX,BPSGTOT,NP,BPSDATA
144 I '$D(@REF) D HDR^BPSRPT7(BPRTYPE,BPRPTNAM,.BPPAGE) W !,"No data meets the criteria." G XREPORT
145 S (BPGBIL,BPGINS,BPGCOLL,BPGCNT,BPGELTM)=0
146 S BPDIV="" F S BPDIV=$O(@REF@(BPDIV)) Q:BPDIV="" D Q:BPQ
147 .S BPGRPLAN=0 D HDR^BPSRPT7(BPRTYPE,BPRPTNAM,.BPPAGE)
148 .N BPCNT S (BPTBIL,BPTINS,BPTCOLL,BPCNT,BPELTM)=0
149 .F S BPGRPLAN=$O(@REF@(BPDIV,BPGRPLAN)) Q:BPGRPLAN="" D Q:BPQ
150 .. I BPSUMDET=0 D WRPLAN(BPGRPLAN) Q:BPQ
151 .. S BPBLINE="" ;Reset Blank Line Indicator
152 .. N BPSCLM,BPREC,BPTOT,BPIBIL,BPICNT,BPICOL,BPIINS
153 .. S (BPIBIL,BPICNT,BPICOL,BPIINS)=0
154 .. S BPDFN="" F S BPDFN=$O(@REF@(BPDIV,BPGRPLAN,BPDFN)) Q:BPDFN="" D Q:BPQ
155 ... S BPSRTDT="" F S BPSRTDT=$O(@REF@(BPDIV,BPGRPLAN,BPDFN,BPSRTDT)) Q:BPSRTDT="" D Q:BPQ
156 .... S BPRX="" F S BPRX=$O(@REF@(BPDIV,BPGRPLAN,BPDFN,BPSRTDT,BPRX)) Q:BPRX="" D Q:BPQ
157 ..... S BPREF="" F S BPREF=$O(@REF@(BPDIV,BPGRPLAN,BPDFN,BPSRTDT,BPRX,BPREF)) Q:BPREF="" D Q:BPQ
158 ...... S BPX=@REF@(BPDIV,BPGRPLAN,BPDFN,BPSRTDT,BPRX,BPREF)
159 ...... S BPCNT=BPCNT+1,BPGCNT=BPGCNT+1,BPICNT=BPICNT+1
160 ...... I BPRTYPE=5 D
161 ....... S BPELTM=BPELTM+$$ELAPSE^BPSRPT6($P(BPX,U,3))
162 ....... S BPGELTM=BPGELTM+$$ELAPSE^BPSRPT6($P(BPX,U,3))
163 ...... S BPBIL=$$BILLED^BPSRPT7($P(BPX,U,3)),BPTBIL=BPTBIL+BPBIL,BPGBIL=BPGBIL+BPBIL,BPIBIL=BPIBIL+BPBIL
164 ...... S BPINS=$$INSPAID^BPSRPT2($P(BPX,U,3)),BPTINS=BPTINS+BPINS,BPGINS=BPGINS+BPINS,BPIINS=BPIINS+BPINS
165 ...... S BPCOLL=$$COLLECTD^BPSRPT6(BPRX,BPREF),BPTCOLL=BPTCOLL+BPCOLL,BPGCOLL=BPGCOLL+BPCOLL,BPICOL=BPICOL+BPCOLL
166 ...... I BPRTYPE=6 D Q
167 .......S BPSTATUS=$P(BPX,U,7)
168 .......I BPSTATUS["REJECT" S $P(BPSCLM(BPSRTDT),U,3)=$P($G(BPSCLM(BPSRTDT)),U,3)+BPBIL
169 .......I BPSTATUS["PAYABLE" S $P(BPSCLM(BPSRTDT),U,4)=$P($G(BPSCLM(BPSRTDT)),U,4)+BPBIL
170 .......S $P(BPSCLM(BPSRTDT),U,2)=$P($G(BPSCLM(BPSRTDT)),U,2)+BPBIL
171 .......S $P(BPSCLM(BPSRTDT),U,5)=$P($G(BPSCLM(BPSRTDT)),U,5)+BPINS
172 .......S $P(BPSCLM(BPSRTDT),U)=$P($G(BPSCLM(BPSRTDT)),U)+1
173 ...... ;
174 ...... ;Display Detail Section
175 ...... Q:BPSUMDET=1
176 ...... S BPREC="" ;Reset Excel Display Variable
177 ...... I 'BPEXCEL,BPRTYPE=1,BPBLINE=1 S NP=$$CHKP(2) Q:BPQ I BPBLINE=1 W ! ;Print blank line
178 ...... S NP=$$CHKP(1) Q:BPQ D WRLINE1(BPRTYPE,.BPREC,BPDIV,BPGRPLAN,BPDFN,BPRX,BPREF,BPX,BPSRTDT,BPBIL,BPINS,BPCOLL,BPEXCEL)
179 ...... S NP=$$CHKP(1) Q:BPQ D WRLINE2(BPRTYPE,.BPREC,BPX,BPRX,BPREF,BPBIL,BPGRPLAN,BPEXCEL,.BPICNT)
180 ...... D WRLINE3(BPRTYPE,.BPREC,BPX,BPEXCEL)
181 ...... I (",2,7,")[BPRTYPE,'BPEXCEL D Q:BPQ
182 ....... D COMMENT(+$P(BPX,U,3)) Q:BPQ
183 ....... S NP=$$CHKP(1) Q:BPQ
184 ....... W !,?10,"Claim ID: ",$$CLAIMID^BPSRPT2(+$P(BPX,U,3))
185 ....... N BPSARR,BPRJCNT,BPZZ S BPRJCNT=$$REJTEXT^BPSRPT2(+$P(BPX,U,3),.BPSARR)
186 ....... F BPZZ=1:1:BPRJCNT S NP=$$CHKP(1) Q:BPQ W !,?10,BPSARR(BPZZ) Q:BPQ
187 ...... I 'BPEXCEL,BPRTYPE=1 S BPBLINE=1 ;Set Blank Line Display Indicator
188 .. I BPRTYPE=6 D PTBDT^BPSRPT7(BPDIV,BPSUMDET,.BPSCLM,.BPSGTOT)
189 .. I 'BPQ,(",1,2,3,4,7,")[BPRTYPE,'BPEXCEL S NP=$$CHKP(5) Q:BPQ D ITOT^BPSRPT8(BPRTYPE,BPDIV,BPGRPLAN,BPIBIL,BPIINS,BPICOL,.BPICNT)
190 .I 'BPEXCEL,'BPQ,BPRTYPE'=6 S NP=$$CHKP(5) Q:BPQ D TOTALS^BPSRPT7(BPRTYPE,BPDIV,BPTBIL,BPTINS,BPTCOLL,.BPCNT,BPELTM)
191 .I 'BPEXCEL,'BPQ,$O(@REF@(BPDIV))]"" D:$G(BPSCR) PAUSE^BPSRPT1 Q:BPQ
192 ;
193 ;Print Grand Totals
194 I 'BPEXCEL D
195 .I 'BPQ,BPRTYPE=6 D PGTOT6^BPSRPT7($G(BPSGTOT))
196 .I 'BPQ,BPRTYPE'=6 S NP=$$CHKP(5) Q:BPQ D PGTOT^BPSRPT7(BPRTYPE,BPGBIL,BPGINS,BPGCOLL,.BPGCNT,BPGELTM)
197 ;
198XREPORT Q
199 ;
200 ;Display Comments
201 ;
202 ;Input Variable: BP59 - Lookup to BPS TRANSACTION (#59)
203 ;
204COMMENT(BP59) N CNODE,I,J,NP
205 S I="" F S I=$O(^BPST(BP59,11,"B",I),-1) Q:'I D Q:BPQ
206 .S NP=$$CHKP(1) Q:BPQ
207 .S J=$O(^BPST(BP59,11,"B",I,"")) Q:J=""
208 .S CNODE=$G(^BPST(BP59,11,J,0))
209 .W !,?10,$$DATTIM^BPSRPT1(+$P($P(CNODE,U),"."))," - ",$P(CNODE,U,3)
210 Q
211 ;
212 ;Display the Insurance
213 ;
214 ; Input Variable -> BPSDATA -> if 0, skip page check
215 ; BPEXCEL -> 1 - Print to Excel/0 Regular Display
216 ;
217WRPLAN(BPGRPLAN) N INS,NP
218 ;
219 I BPSUMDET'=0 Q
220 I BPEXCEL Q
221 ;
222 ;Skip for Recent Transactions and Totals by Date Reports
223 I BPRTYPE=5!(BPRTYPE=6) Q
224 ;
225 I $G(BPSDATA) S NP=$$CHKP(5) Q:BPQ!NP
226 ;
227 ;Get and display the Insurance Name
228 S INS=$E(BPGRPLAN,1,90)
229 I INS]"" D
230 .D ULINE("-")
231 .W !,INS
232 .D ULINE("-")
233 Q
234 ;
235 ;Check for End of Page
236 ;
237 ; Input variables -> BPLINES -> Number of lines from bottom
238 ; BPEXCEL -> 1 - Print to Excel/0 Regular Display
239 ; Output variable -> BPSDATA -> 0 -> New screen, no data displayed yet
240 ; 1 -> Data displayed on current screen
241 ;
242CHKP(BPLINES) Q:$G(BPEXCEL) 0
243 S BPLINES=BPLINES+1
244 I $G(BPSCR) S BPLINES=BPLINES+2
245 I $G(BPSCR),'$G(BPSDATA) S BPSDATA=1 Q 0
246 S BPSDATA=1
247 I $Y>(IOSL-BPLINES) D:$G(BPSCR) PAUSE^BPSRPT1 Q:$G(BPQ) 0 D HDR^BPSRPT7(BPRTYPE,BPRPTNAM,.BPPAGE) Q 1
248 Q 0
249 ;
250 ;Print one line of characters
251 ;
252ULINE(X) N I
253 W ! F I=1:1:132 W $G(X,"-")
254 Q
Note: See TracBrowser for help on using the repository browser.