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

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

initial load of FOIAVistA 6/30/08 version
File size: 7.8 KB
Line 
1IBCEMSR1 ;WOIFO/AAT - MRA STATISTICS REPORT CONT. ;09/03/04
2 ;;2.0;INTEGRATED BILLING;**155,348,349**;21-MAR-94;Build 46
3 ;;Per VHA Directive 2004-038, this routine should not be modified.
4 ;
5 Q
6 ;
7 ; Report header
8HDR N IBI
9 S IBPAGE=IBPAGE+1
10 W @IOF,"MRA Statistics Report for period covering "_$$DAT(IBBDT)_" thru "_$$DAT(IBEDT)," ",?100,$$DAT(DT)," Page ",IBPAGE
11 W ! F IBI=1:1:$S($G(IOM):IOM,1:130) W "-"
12 Q
13 ;
14REPORT N IBDVN,IBCLERK,IBPAGE,IBTU,IBTH
15 S IBPAGE=0
16 D HDR
17 I '$D(@REF) W !,"No data meet the criteria." Q
18 I 'IBSUM S IBDVN="" F S IBDVN=$O(@REF@(IBDVN)) Q:IBDVN="" D Q:IBQ
19 . D CHKP Q:IBQ W !,"DIVISION: ",IBDVN
20 . S IBCLERK="A" F S IBCLERK=$O(@REF@(IBDVN,IBCLERK)) Q:IBCLERK="" D Q:IBQ
21 . . D DETAILS
22 Q:IBQ
23 ; Summary section
24 D:'IBSUM HDR W !,"SUMMARY"
25 S IBDVN="" F S IBDVN=$O(@REF@(IBDVN)) Q:IBDVN="" D Q:IBQ
26 . D CHKP Q:IBQ W !,"DIVISION: ",IBDVN
27 . D SUMMARY
28 Q
29 ;
30DETAILS ; Print Details
31 N REFU,REFU,IBTXT,IBNU,IBNH,IBTU,IBTH
32 ;
33 S REFU=$NA(@REF@(IBDVN,IBCLERK,3))
34 S REFH=$NA(@REF@(IBDVN,IBCLERK,2))
35 ;
36 D CHKP Q:IBQ W !,"CLERK: ",IBCLERK
37 D CHKP Q:IBQ W !?7,"Primary UB-04 MRA Requests",?67,"Primary CMS-1500 MRA Requests"
38 D CHKP Q:IBQ W !?7,"--------------------------",?67,"-----------------------------"
39 S IBTXT="Total number of MRA Requests:"
40 D CHKP Q:IBQ W !?7,IBTXT,?50,$J(+$G(@REFU@("ALL")),5),?67,IBTXT,?110,$J(+$G(@REFH@("ALL")),5)
41 S IBTXT="Number of unique MRA Requests:",IBTU=+$G(@REFU@("TOT")),IBTH=+$G(@REFH@("TOT"))
42 D CHKP Q:IBQ W !?7,IBTXT,?50,$J(IBTU,5),?67,IBTXT,?110,$J(IBTH,5)
43 S IBTXT="Requests with no response:",IBNU=+$G(@REFU@("NON")),IBNH=+$G(@REFH@("NON"))
44 D CHKP Q:IBQ W !?7,IBTXT,?50,$J(IBNU,5),?67,IBTXT,?110,$J(IBNH,5)
45 S IBTXT="Requests with final rejection:",IBNU=+$G(@REFU@("REJF")),IBNH=+$G(@REFH@("REJF"))
46 D CHKP Q:IBQ W !?7,IBTXT,?50,$J(IBNU,5),?67,IBTXT,?110,$J(IBNH,5)
47 ;
48 S IBTXT="Requests with returned MRA:",IBNU=+$G(@REFU@("MRA")),IBNH=+$G(@REFH@("MRA"))
49 D CHKP Q:IBQ W !?7,IBTXT,?50,$J(IBNU,5),?67,IBTXT,?110,$J(IBNH,5)
50 S IBTXT="Processed MRA:"
51 D CHKP Q:IBQ W !?14,IBTXT,?35,$J($G(@REFU@("MRA"))-$G(@REFU@("MRAD")),5),?74,IBTXT,?90,$J($G(@REFH@("MRA"))-$G(@REFH@("MRAD")),5)
52 S IBTXT="Denied MRA:"
53 D CHKP Q:IBQ W !?14,IBTXT,?35,$J(+$G(@REFU@("MRAD")),5),?74,IBTXT,?90,$J(+$G(@REFH@("MRAD")),5)
54 D CHKP Q:IBQ W !
55 ;
56 D SECONDRY Q:IBQ
57 D CHKP Q:IBQ W !
58 Q
59 ;
60SUMMARY ;Print summary
61 N REFU,REFH,IBTXT,IBNU,IBNH,IBTU,IBTH
62 ;
63 S REFU=$NA(@REF@(IBDVN,0,3))
64 S REFH=$NA(@REF@(IBDVN,0,2))
65 ;
66 D CHKP Q:IBQ W !?7,"Primary UB-04 MRA Requests",?67,"Primary CMS-1500 MRA Requests"
67 D CHKP Q:IBQ W !?7,"--------------------------",?67,"-----------------------------"
68 S IBTXT="Total number of MRA Requests:",IBTU=+$G(@REFU@("ALL")),IBTH=+$G(@REFH@("ALL"))
69 D CHKP Q:IBQ W !?7,IBTXT,?50,$J(IBTU,5),?67,IBTXT,?110,$J(IBTH,5)
70 S IBTXT="Percent Resubmitted:",IBNU=+$G(@REFU@("ALLR")),IBNH=+$G(@REFH@("ALLR"))
71 D CHKP Q:IBQ W !?14,IBTXT,?50,$$%(IBNU,IBTU),?74,IBTXT,?110,$$%(IBNH,IBTH)
72 S IBTXT="Percent Cancelled/Copied:",IBNU=+$G(@REFU@("ALLC")),IBNH=+$G(@REFH@("ALLC"))
73 D CHKP Q:IBQ W !?14,IBTXT,?50,$$%(IBNU,IBTU),?74,IBTXT,?110,$$%(IBNH,IBTH)
74 S IBTXT="Number of unique MRA Requests:",IBTU=+$G(@REFU@("TOT")),IBTH=+$G(@REFH@("TOT"))
75 D CHKP Q:IBQ W !?7,IBTXT,?50,$J(IBTU,5),?67,IBTXT,?110,$J(IBTH,5)
76 S IBTXT="Requests with no response:",IBNU=+$G(@REFU@("NON")),IBNH=+$G(@REFH@("NON"))
77 D CHKP Q:IBQ W !?7,IBTXT,?50,$J(IBNU,5),?67,IBTXT,?110,$J(IBNH,5)
78 S IBTXT="Requests with final rejection:",IBNU=+$G(@REFU@("REJF")),IBNH=+$G(@REFH@("REJF"))
79 D CHKP Q:IBQ W !?7,IBTXT,?50,$J(IBNU,5),?67,IBTXT,?110,$J(IBNH,5)
80 S IBTXT="Percent with final rejection:"
81 D CHKP Q:IBQ W !?14,IBTXT,?50,$$%(IBNU,IBTU),?74,IBTXT,?110,$$%(IBNH,IBTH)
82 S IBTXT="Requests with returned MRA:",IBTU=+$G(@REFU@("MRA")),IBTH=+$G(@REFH@("MRA"))
83 D CHKP Q:IBQ W !?7,IBTXT,?50,$J(IBTU,5),?67,IBTXT,?110,$J(IBTH,5)
84 S IBTXT="Processed MRA:",IBNU=IBTU-$G(@REFU@("MRAD")),IBNH=IBTH-$G(@REFH@("MRAD"))
85 D CHKP Q:IBQ W !?7,IBTXT,?50,$J(IBNU,5),?67,IBTXT,?110,$J(IBNH,5)
86 S IBTXT="Denied MRA:"
87 D CHKP Q:IBQ W !?7,IBTXT,?50,$J(+$G(@REFU@("MRAD")),5),?67,IBTXT,?110,$J(+$G(@REFH@("MRAD")),5)
88 S IBTXT="Percent Processed MRA:"
89 D CHKP Q:IBQ W !?14,IBTXT,?50,$$%(IBNU,IBTU),?74,IBTXT,?110,$$%(IBNH,IBTH)
90 D CHKP Q:IBQ W !
91 ;
92 D SECONDRY Q:IBQ
93 S IBTXT="Percent Unique Req to Secondary:"
94 D CHKP Q:IBQ W !?7,IBTXT,?50,$J($$%(+$G(@REFU@("SEC")),+$G(@REFU@("TOT"))),5),?67,IBTXT,?110,$J($$%(+$G(@REFH@("SEC")),+$G(@REFH@("TOT"))),5)
95 S IBTXT="Percent Auto-Generated:"
96 D CHKP Q:IBQ W !?14,IBTXT,?50,$J($$%($G(@REFU@("AT"))+$G(@REFU@("AP")),+$G(@REFU@("TOT"))),5),?67,IBTXT,?110,$J($$%($G(@REFH@("AT"))+$G(@REFH@("AP")),+$G(@REFH@("TOT"))),5)
97 S IBTXT="Percent Manually-Processed:"
98 D CHKP Q:IBQ W !?14,IBTXT,?50,$J($$%($G(@REFU@("MT"))+$G(@REFU@("MP")),+$G(@REFU@("TOT"))),5),?67,IBTXT,?110,$J($$%($G(@REFH@("MT"))+$G(@REFH@("MP")),+$G(@REFH@("TOT"))),5)
99 ;
100 D CHKP Q:IBQ W !
101 Q
102 ;
103SECONDRY ; Print 2ndary claims info
104 D CHKP Q:IBQ W !?7,"Secondary UB-04 claims",?67,"Secondary CMS-1500 claims"
105 D CHKP Q:IBQ W !?7,"----------------------",?67,"-------------------------"
106 S IBTXT="Authorized (not yet printed):"
107 D CHKP Q:IBQ W !?7,IBTXT,?50,$J(+$G(@REFU@("AUT")),5),?67,IBTXT,?110,$J(+$G(@REFH@("AUT")),5)
108 ;
109 S IBTXT="Auto-generated to print:"
110 D CHKP Q:IBQ W !?7,IBTXT,?50,$J(+$G(@REFU@("AP")),5),?67,IBTXT,?110,$J(+$G(@REFH@("AP")),5)
111 S IBTXT="Total Primary Charges:"
112 D CHKP Q:IBQ W !?14,IBTXT,?45,$J(+$G(@REFU@("AP1")),10,2),?74,IBTXT,?105,$J(+$G(@REFH@("AP1")),10,2)
113 S IBTXT="Unreimb'd Medicare Exp:"
114 D CHKP Q:IBQ W !?14,IBTXT,?45,$J(+$G(@REFU@("AP2")),10,2),?74,IBTXT,?105,$J(+$G(@REFH@("AP2")),10,2)
115 S IBTXT="Total Secondary Charges:"
116 D CHKP Q:IBQ W !?14,IBTXT,?45,$J(+$G(@REFU@("AP3")),10,2),?74,IBTXT,?105,$J(+$G(@REFH@("AP3")),10,2)
117 ;
118 S IBTXT="Auto-generated to transmit:"
119 D CHKP Q:IBQ W !?7,IBTXT,?50,$J(+$G(@REFU@("AT")),5),?67,IBTXT,?110,$J(+$G(@REFH@("AT")),5)
120 S IBTXT="Total Primary Charges:"
121 D CHKP Q:IBQ W !?14,IBTXT,?45,$J(+$G(@REFU@("AT1")),10,2),?74,IBTXT,?105,$J(+$G(@REFH@("AT1")),10,2)
122 S IBTXT="Unreimb'd Medicare Exp:"
123 D CHKP Q:IBQ W !?14,IBTXT,?45,$J(+$G(@REFU@("AT2")),10,2),?74,IBTXT,?105,$J(+$G(@REFH@("AT2")),10,2)
124 S IBTXT="Total Secondary Charges:"
125 D CHKP Q:IBQ W !?14,IBTXT,?45,$J(+$G(@REFU@("AT3")),10,2),?74,IBTXT,?105,$J(+$G(@REFH@("AT3")),10,2)
126 ;
127 S IBTXT="Manually processed to print:"
128 D CHKP Q:IBQ W !?7,IBTXT,?50,$J(+$G(@REFU@("MP")),5),?67,IBTXT,?110,$J(+$G(@REFH@("MP")),5)
129 S IBTXT="Total Primary Charges:"
130 D CHKP Q:IBQ W !?14,IBTXT,?45,$J(+$G(@REFU@("MP1")),10,2),?74,IBTXT,?105,$J(+$G(@REFH@("MP1")),10,2)
131 S IBTXT="Unreimb'd Medicare Exp:"
132 D CHKP Q:IBQ W !?14,IBTXT,?45,$J(+$G(@REFU@("MP2")),10,2),?74,IBTXT,?105,$J(+$G(@REFH@("MP2")),10,2)
133 S IBTXT="Total Secondary Charges:"
134 D CHKP Q:IBQ W !?14,IBTXT,?45,$J(+$G(@REFU@("MP3")),10,2),?74,IBTXT,?105,$J(+$G(@REFH@("MP3")),10,2)
135 ;
136 S IBTXT="Manually processed to transmit:"
137 D CHKP Q:IBQ W !?7,IBTXT,?50,$J(+$G(@REFU@("MT")),5),?67,IBTXT,?110,$J(+$G(@REFH@("MT")),5)
138 S IBTXT="Total Primary Charges:"
139 D CHKP Q:IBQ W !?14,IBTXT,?45,$J(+$G(@REFU@("MT1")),10,2),?74,IBTXT,?105,$J(+$G(@REFH@("MT1")),10,2)
140 S IBTXT="Unreimb'd Medicare Exp:"
141 D CHKP Q:IBQ W !?14,IBTXT,?45,$J(+$G(@REFU@("MT2")),10,2),?74,IBTXT,?105,$J(+$G(@REFH@("MT2")),10,2)
142 S IBTXT="Total Secondary Charges:"
143 D CHKP Q:IBQ W !?14,IBTXT,?45,$J(+$G(@REFU@("MT3")),10,2),?74,IBTXT,?105,$J(+$G(@REFH@("MT3")),10,2)
144 Q
145 ;
146 ;
147%(VALUE,TOTAL) ;Percentage
148 I 'TOTAL Q $J("0%",6)
149 Q $J($J(VALUE*100/TOTAL,3,0)_"%",6)
150 ;
151CHKP ;Check for EOP
152 I $Y>(IOSL-4) D:IBSCR PAUSE Q:IBQ D HDR
153 Q
154 ;
155PAUSE ;
156 N X U IO(0) W !!,"Press RETURN to continue, '^' to exit:" R X:DTIME S:'$T X="^" S:X["^" IBQ=2
157 U IO
158 Q
159 ;
160PAUSE2 ;
161 N X U IO(0) W !!,"Press RETURN to continue:" R X:DTIME S:'$T X="^" S:X["^" IBQ=2
162 U IO
163 Q
164 ;
165DAT(X) ;Convert FM date to displayable (mm/dd/yy) format.
166 N DATE,YR
167 I $G(X) S YR=$E(X,2,3)
168 I $G(X) S DATE=$S(X:$E(X,4,5)_"/"_$E(X,6,7)_"/"_YR,1:"")
169 Q $G(DATE)
170 ;
Note: See TracBrowser for help on using the repository browser.