source: WorldVistAEHR/trunk/r/INTEGRATED_BILLING-IB-PRQ--IBD--IBQ--PRQS/IBTOSUM2.m@ 949

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

initial load of WorldVistAEHR
File size: 4.9 KB
Line 
1IBTOSUM2 ;ALB/AAS - CLAIMS TRACKING BILLING INFORMATION PRINT ; 29-OCT-93
2 ;;2.0;INTEGRATED BILLING;**118**;21-MAR-94
3 ;
4PRINT ; - Print the report.
5 K X,X2,X3
6 D HDR,MAIN,PENAL
7 I $O(IBCNT(3,0)) D RNB
8 I $O(IBCNT(10,0)) D APPROV
9 I $O(IBCNT(20,0)) D DENIAL
10 Q
11 ;
12MAIN ; - Print main body of report.
13 S IBPER(1)=$J($S('IBCNT(2):0,1:IBCNT(2)/IBCNT(1)*100),0,2)
14 S IBPER(2)=$J($S('IBCNT(3,0):0,1:+IBCNT(3,0)/IBCNT(1)*100),0,2)
15 S IBPER(3)=$J($S('IBCNT(4):0,1:IBCNT(4)/IBCNT(1)*100),0,2)
16 S IBPER(4)=$J($S('IBCNT(99):0,1:IBCNT(99)/IBCNT(1)*100),0,2)
17 S IBPER(5)=$J($S('IBCNT(13):0,1:IBCNT(13)/IBCNT(1)*100),0,2)
18 W !?((IOM/2)-16),"Total ",$S(IBSORT="A":"Admissions",1:"Discharges"),": ",$J(IBCNT(1),11)
19 W !?((IOM/2)-31),"Total ",$S(IBSORT="A":"Admissions",1:"Discharges")," with Insurance: ",$J(IBCNT(2),11)," (",IBPER(1),"%)"
20 W !?((IOM/2)-25),"Total Billable ",$S(IBSORT="A":"Admissions",1:"Discharges"),": ",$J(+$G(IBCNT(3,0)),11)," (",IBPER(2),"%)"
21 ;
22 W !?((IOM/2)-34),"Total ",$S(IBSORT="A":"Admissions",1:"Discharges")," Requiring Reviews: ",$J(IBCNT(4),11)," (",IBPER(3),"%)"
23 W !?((IOM/2)-25),"Total ",$S(IBSORT="A":"Admissions",1:"Discharges")," Reviewed: ",$J(IBCNT(99),11)," (",IBPER(4),"%)"
24 W !?((IOM/2)-39),"Total ",$S(IBSORT="A":"Admissions",1:"Discharges")," Reviewed-Multi Carrier: ",$J(IBCNT(13),11)," (",IBPER(5),"%)"
25 ;
26 I $E(IOST,1,2)="C-" W ! D PAUSE^VALM1 Q:$D(DIRUT) W @IOF
27 ;
28 W !!?((IOM/2)-18),"Total Reviews Done: ",$J(IBCNT(5),11)
29 W !?((IOM/2)-23),"Number of Days Approved: ",$J(IBCNT(10),11)
30 S X=IBCNT(11),X2="0$" D COMMA^%DTC
31 W !?((IOM/2)-39),"Amount Collectible Approved for Billing: ",X
32 ;
33 W !!?((IOM/2)-21),"Number of Days Denied: ",$J(IBCNT(20),11)
34 S X=IBCNT(21),X2="0$" D COMMA^%DTC
35 W !?((IOM/2)-25),"Amount Denied for Billing: ",X
36 ;
37 W !!?((IOM/2)-20),"Total Cases Appealed: ",$J(IBCNT(80),11)
38 W !?((IOM/2)-25),"Number of Initial Appeals: ",$J(IBCNT(81),11)
39 W !?((IOM/2)-28),"Number of Subsequent Appeals: ",$J(IBCNT(82),11)
40 ;
41 Q
42 ;
43PENAL ; -- penalty codes; variable; external form
44 ; 1; IBCNT(31); NO PRE ADMISSION CERTIFICATION
45 ; 2; IBCNT(32); UNTIMELY PRE ADMISSION CERTIFICATION
46 ; 3; IBCNT(33); VA A NON-PROVIDER
47 ;
48 W !!!?((IOM/2)-14),"Penalty Report: Number of cases Dollars"
49 W !?((IOM/2)-14),"--------------- ------------------------------------"
50 W !?((IOM/2)-30),"No Pre Admission Certification: ",$J($P(IBCNT(31),U),10)," " S X=+$P(IBCNT(31),U,2),X3=9,X2="0$" D COMMA^%DTC W X
51 W !?((IOM/2)-36),"Untimely Pre Admission Certification: ",$J($P(IBCNT(32),U),10)," " S X=+$P(IBCNT(32),U,2),X3=9,X2="0$" D COMMA^%DTC W X
52 W !?((IOM/2)-17),"VA a Non-Provider: ",$J($P(IBCNT(33),U),10)," " S X=+$P(IBCNT(33),U,2),X3=9,X2="0$" D COMMA^%DTC W X
53 Q
54 ;
55RNB ; -- print reasons not billable
56 D CNT(3)
57 W !!!?((IOM/2)-26),"Reason Not Billable Report: Reason Count"
58 W !?((IOM/2)-26),"--------------------------- ------------------------------------"
59 S I=0 F S I=$O(IBCNT(3,I)) Q:'I D
60 .W !?((IOM/2)+3),$E($P($G(^IBE(356.8,+I,0)),U),1,20)
61 .W ?((IOM/2)+24),$J(IBCNT(3,I),6)
62 .W " (",$J(IBCNT(3,I)/IBCNT(3,"NB")*100,0,2),"%)"
63 ;
64 W !?((IOM/2)+23),"-------"
65 W !?((IOM/2)+3),"Total:",?((IOM/2)+23),$J(IBCNT(3,"NB"),7)
66 Q
67 ;
68 ;
69DENIAL ; -- print days denied by specialty
70 D CNT(20)
71 W !!!?((IOM/2)-24),"Days Denied by Specialty: Specialty No. Days Dollars"
72 W !?((IOM/2)-24),"------------------------- ------------------------------------"
73 S I=0 F S I=$O(IBCNT(20,I)) Q:'I D
74 .W !?((IOM/2)+3),$E($P($G(^DIC(45.7,+I,0)),U)_" ",1,16)
75 .W ?((IOM/2)+20)," ",$J(IBCNT(20,I),6)
76 .S X=IBCNT(21,I),X2="0$" D COMMA^%DTC
77 .W ?((IOM/2)+30)," ",X
78 Q
79 ;
80 ;
81APPROV ; -- print days approved by specialty
82 D CNT(10)
83 W !!!?((IOM/2)-26),"Days Approved by Specialty: Specialty No. Days Dollars"
84 W !?((IOM/2)-26),"--------------------------- ------------------------------------"
85 S I=0 F S I=$O(IBCNT(10,I)) Q:'I D
86 .W !?((IOM/2)+3),$E($P($G(^DIC(45.7,+I,0)),U)_" ",1,16)
87 .W ?((IOM/2)+20)," ",$J(IBCNT(10,I),6)
88 .S X=IBCNT(11,I),X2="0$" D COMMA^%DTC
89 .W ?((IOM/2)+30)," ",X
90 ;
91 Q
92 ;
93HDR ; -- print report header
94 W:$E(IOST,1,2)["C-"!(IBPAG>0) @IOF
95 W !?((IOM-22)/2),"MCCR/UR SUMMARY REPORT"
96 W !?((IOM-3)/2),"for"
97 D SITE^IBAUTL S IBSNM=$S($D(^DIC(4,IBFAC,0)):$P(^(0),U),1:"")
98 W !?((IOM-($L(IBSNM)+6))/2),IBSNM_" ("_IBSITE_")"
99 W !!?((IOM-14)/2),"for "_$S(IBSORT="A":"Admissions",1:"Discharges")
100 W !?(IOM-18/2),"From: " S Y=IBBDT D DT^DIQ
101 W !?((IOM-16)/2)," To: " S Y=IBEDT D DT^DIQ
102 W !!?(IOM-26/2),"Date Printed: ",IBHDT
103 S IBPAG=IBPAG+1 W !?(IOM-8/2),"Page: ",IBPAG
104 W !?(IOM-26/2),"--------------------------",!!
105 Q
106 ;
107CHK ; -- check task man stop flag
108 I $D(ZTQUEUED),$$S^%ZTLOAD S ZTSTOP=1 D HDR W !!,"....task stopped at user request."
109 Q
110 ;
111CNT(N) ; -- see if enought room on page for list
112 Q:'$G(N)
113 S (IBC,I)=0 F S I=$O(IBCNT(N,I)) Q:'I S IBC=IBC+1
114 I IOSL<($Y+IBC+3),$E(IOST,1,2)="C-" D PAUSE^VALM1 S:$D(DIRUT) IBQUIT=1 W:'IBQUIT @IOF Q
115 I IOSL<($Y+IBC+3) D HDR
116 Q
Note: See TracBrowser for help on using the repository browser.