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

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

initial load of WorldVistAEHR

File size: 4.7 KB
Line 
1IBJDU1 ;ALB/CPM - UTILIZATION WORKLOAD REPORT ; 24-DEC-96
2 ;;Version 2.0 ; INTEGRATED BILLING ;**69**; 21-MAR-94
3 ;
4EN ; Option entry point.
5 ;
6 W !!,"This report provides a measure of the number of Insurance Reviews"
7 W !,"which are conducted in the Medical Center.",!
8 ;
9 D DATE^IBOUTL I IBBDT=""!(IBEDT="") G ENQ
10 ;
11 W !!,"This report only requires an 80 column printer."
12 ;
13 W !!," Note: This report may take a while to run."
14 W !?10,"You should queue this report to run after normal business hours.",!
15 ;
16 ; - select a device
17 S %ZIS="QM" D ^%ZIS G:POP ENQ
18 I $D(IO("Q")) D G ENQ
19 .S ZTRTN="DQ^IBJDU1",ZTDESC="IB - UTILIZATION WORKLOAD REPORT"
20 .F I="IBBDT","IBEDT" S ZTSAVE(I)=""
21 .D ^%ZTLOAD
22 .W !!,$S($D(ZTSK):"This job has been queued. The task number is "_ZTSK_".",1:"Unable to queue this job.")
23 .K ZTSK,IO("Q") D HOME^%ZIS
24 ;
25 U IO
26 ;
27DQ ; Tasked entry point.
28 ;
29 K IB F I=1:1:10 S IB(I)=0
30 ;
31 ; - count admissions within the user-specified date range
32 S IBDT=IBBDT-.000000001,IBQ=0
33 F S IBDT=$O(^DGPM("AMV1",IBDT)) Q:'IBDT!(IBDT>(IBEDT+.24)) D Q:IBQ
34 .S DFN=0 F S DFN=$O(^DGPM("AMV1",IBDT,DFN)) Q:'DFN D Q:IBQ
35 ..S IBPM=0 F S IBPM=$O(^DGPM("AMV1",IBDT,DFN,IBPM)) Q:'IBPM D Q:IBQ
36 ...;
37 ...I IBPM#100=0 S IBQ=$$STOP^IBOUTL("Utilization Workload Report") Q:IBQ
38 ...;
39 ...S IB(1)=IB(1)+1 ; total admissions
40 ...;
41 ...Q:'$$INSURED^IBCNS1(DFN,IBDT)
42 ...;
43 ...S IB(2)=IB(2)+1 ; insured admissions
44 ...D ELIG^VADPT
45 ...I VAEL(3) S IB(3)=IB(3)+1 Q ; insured SC admissions
46 ...S IB(4)=IB(4)+1 ; insured NSC admissions
47 ;
48 I IBQ G ENQ
49 ;
50 ; - count insurance reviews
51 K ^TMP("IBJDU1",$J)
52 S IBDT=IBBDT-.000000001
53 F S IBDT=$O(^IBT(356.2,"B",IBDT)) Q:'IBDT!(IBDT>(IBEDT+.9)) D Q:IBQ
54 .S IBTRC=0 F S IBTRC=$O(^IBT(356.2,"B",IBDT,IBTRC)) Q:'IBTRC D Q:IBQ
55 ..;
56 ..I IBTRC#100=0 S IBQ=$$STOP^IBOUTL("Utilization Workload Report") Q:IBQ
57 ..;
58 ..S IBTRCD=$G(^IBT(356.2,+IBTRC,0)) Q:IBTRCD=""
59 ..S IBTRN=$P(IBTRCD,"^",2)
60 ..Q:$P(IBTRCD,"^",19)<10 ; review is not complete
61 ..Q:'IBTRN ; no corresponding CT entry
62 ..S IBPM=$P($G(^IBT(356,IBTRN,0)),"^",5)
63 ..Q:'IBPM ; review not for an admission
64 ..;
65 ..; - get contact type
66 ..S IBRTY=$P($G(^IBE(356.11,+$P(IBTRCD,"^",4),0)),"^",2)
67 ..;
68 ..; - appeals
69 ..I IBRTY=60!(IBRTY=65) D Q
70 ...I '$D(^TMP("IBJDU1",$J,IBTRN)) S ^(IBTRN)="",IB(10)=IB(10)+1
71 ..;
72 ..; - admission reviews
73 ..I IBRTY=10!(IBRTY=15)!(IBRTY=20) D Q
74 ...S IB(5)=IB(5)+1
75 ...;
76 ...; - count reviews where the entire admission was denied
77 ...Q:'$P($G(^IBT(356.2,IBTRC,1)),"^",7)
78 ...;
79 ...S IB(7)=IB(7)+1
80 ...S X=$G(^DGPM(IBPM,0)),Y=+$G(^DGPM(+$P(X,"^",17),0))\1
81 ...S:'Y Y=DT
82 ...S IB(9)=IB(9)+$$FMDIFF^XLFDT(Y,+X\1)
83 ..;
84 ..; - continued stay reviews
85 ..I IBRTY=30 D
86 ...S IB(6)=IB(6)+1
87 ...;
88 ...; - look at denials
89 ...Q:$P($G(^IBE(356.7,+$P(IBTRCD,"^",11),1)),"^",3)'=20
90 ...S IB(8)=IB(8)+1
91 ...S X=$P(IBTRCD,"^",15),Y=$P(IBTRCD,"^",16) S:'Y Y=X
92 ...I X S IB(9)=IB(9)+$$FMDIFF^XLFDT(Y,X)+1
93 ;
94 I IBQ G ENQ
95 ;
96 ; - print the reports
97 S (IBPAG,IBQ)=0 D NOW^%DTC S IBRUN=$$DAT2^IBOUTL(%)
98 D SUM
99 ;
100ENQ K ^TMP("IBJDU1",$J)
101 I $D(ZTQUEUED) S ZTREQ="@" G ENQ1
102 ;
103 D ^%ZISC
104ENQ1 K IB,IBQ,IBBDT,IBEDT,IBDT,IBPM,IBPAG,IBRUN,IBTRC,IBTRCD,IBTRN,IBRTY
105 K %,%ZIS,DFN,IBPERI,IBPERS,POP,X,Y,VA,VAERR,VAEL,ZTDESC,ZTRTN,ZTSAVE
106 Q
107 ;
108 ;
109 ;
110SUM ; Print the Summary Report.
111 I $E(IOST,1,2)="C-" W @IOF,*13
112 ;
113 ; - print overall summary header
114 W !!?30,"UTILIZATION WORKLOAD"
115 W !?33,"SUMMARY REPORT"
116 W !!?22,"For Reviews from ",$$DAT1^IBOUTL(IBBDT)," - ",$$DAT1^IBOUTL(IBEDT)
117 W !!?24,"Run Date: ",IBRUN
118 W !?24,$$DASH(31),!!
119 ;
120 ; - print overall summary statistics
121 S IBPERI=$S('IB(1):0,1:$J(IB(2)/IB(1)*100,0,2))
122 S IBPERS=$S('IB(2):0,1:$J(IB(3)/IB(2)*100,0,2))
123 W ?21,"Total Number of Admissions:",?60,$J(IB(1),7)
124 W !?6,"Total Number of Admissions with Insurance:",?60,$J(IB(2),7)," (",IBPERI,"%)"
125 W !?39,"SC:",?60,$J(IB(3),7)," (",IBPERS,"%)"
126 W !?38,"NSC:",?60,$J(IB(4),7)," (",$J(100-IBPERS,0,2),"%)"
127 ;
128 W !!?7,"Total Number of Admission Reviews completed"
129 W !?9,"on Insurance Patients (including pre-certifications):",?65,$J(IB(5),7)
130 W !?13,"Total Number of Continued Stay Reviews completed:",?65,$J(IB(6),7)
131 W !?5,"Total Number of Admission Denials by Insurance Companies:",?65,$J(IB(7),7)
132 W !,"Total Number of Continued Stay Denials by Insurance Companies:",?65,$J(IB(8),7)
133 W !?11,"Total Number of days denied by Insurance Companies:",?65,$J(IB(9),7)
134 W !?31,"Total Number of Appealed Cases:",?65,$J(IB(10),7)
135 ;
136 D PAUSE
137 Q
138 ;
139DASH(X) ; Return a dashed line.
140 Q $TR($J("",X)," ","=")
141 ;
142PAUSE ; Page break
143 Q:$E(IOST,1,2)'="C-"
144 N IBX,DIR,DIRUT,DUOUT,DTOUT,DIROUT,X,Y
145 F IBX=$Y:1:(IOSL-3) W !
146 S DIR(0)="E" D ^DIR I $D(DIRUT)!($D(DUOUT)) S IBQ=1
147 Q
Note: See TracBrowser for help on using the repository browser.