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

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

initial load of WorldVistAEHR

File size: 4.0 KB
Line 
1IBTOSUM ;ALB/AAS - CLAIMS TRACKING BILLING INFORMATION PRINT ; 29-OCT-93
2 ;;2.0;INTEGRATED BILLING;**118,133,217**;21-MAR-94
3 ;
4% I '$D(DT) D DT^DICRW
5 W !!,"MCCR/UR Summary Report",!!
6 S IBQUIT=0
7 ;
8SORT ; - Print either by admissions or discharges.
9 N DIR
10 S DIR(0)="SOBA^A:Admissions;D:Discharges"
11 S DIR("A")="Print Report By [A]dmissions [D]ischarges: "
12 S DIR("B")="D"
13 S DIR("?",1)="This summary report may be prepared by either Admissions or Discharges."
14 S DIR("?",2)="If you choose by discharge the report will contain information on all"
15 S DIR("?",3)="claims tracking information for the discharges that fall in the date"
16 S DIR("?",4)="Range. That is, all reviews for discharges found in the date range"
17 S DIR("?",5)="will be included in the report. If you choose by Admissions all"
18 S DIR("?",6)="reviews found in the date range will be included but the reviews"
19 S DIR("?",7)="may be for cases not related to the admissions."
20 S DIR("?",8)=" "
21 S DIR("?")="If you want to know the total reviews done during a date range sort by admissions. If you want to know the total reviews done on the discharges for a date range sort by Discharges"
22 D ^DIR K DIR
23 S IBSORT=Y I "AD"'[Y!($D(DIRUT)) G END
24 ;
25 ; - Get date range.
26 W ! D DATE^IBOUTL I IBBDT=""!(IBEDT="") G END
27 ;
28DEV ; - Select device, run option.
29 W ! S %ZIS="QM" D ^%ZIS G:POP END
30 I $D(IO("Q")) D G END
31 .S ZTRTN="RPT^IBTOSUM",ZTSAVE("IB*")=""
32 .S ZTDESC="IB - MCCR/UR Summary Report" D ^%ZTLOAD K IO("Q"),ZTSK
33 .D HOME^%ZIS
34 U IO
35 ;
36RPT ; - Entry point from taskman/Store data in ^TMP($J,"IBTOSUM",n).
37 ;
38 I $G(IBXTRACT) D E^IBJDE(11,1) ; Change extract status.
39 ;
40 K ^TMP($J)
41 S IBQUIT=0,IBPAG=0,Y=DT D D^DIQ S IBHDT=Y
42 F I=0:1:13,20,21,80,81,82,99,30:1:34 S IBCNT(I)=0
43 S IBCNT(3,0)=0
44 I IBSORT="A" D ADM
45 I IBSORT="D" D DIS
46 D CHK^IBTOSUM2 I $G(ZTSTOP) G END
47 ;
48 ; - Extract summary data, if necessary.
49 I $G(IBXTRACT) S IBCNT(3,0)=+$G(IBCNT(3,0)) D E^IBJDE(11,0) G END1
50 ;
51 D PRINT^IBTOSUM2
52 ;
53END ; - Clean up.
54 W ! I $D(IBCNT(1)),$E(IOST,1,2)="C-" D PAUSE^VALM1
55 ;
56END1 K ^TMP($J) I $D(ZTQUEUED) S ZTREQ="@" Q
57 D ^%ZISC
58 K X,X1,X2,X3,Y,%ZIS,POP,DA,DIRUT,DUOUT,IBRATE,IBBBS,IBSORT,IBC,IBPCNT
59 K IBDCNT,IBMAX,IBCDT,IBDT,IBBDT,IBEDT,IBQUIT,IBPAG,IBHDT,IBCNT,IBSPEC
60 K IBINS,IBAC,IBPEN,IBPEND,IBTRN,IBTRND,IBTRC,IBTRCD,DFN,DGPM,IBNOD,IBDAY
61 K IBFAC,IBSITE,IBSNM,I,J
62 Q
63 ;
64ADM ; - Count admissions.
65 D CHK^IBTOSUM2 I $G(ZTSTOP) Q
66 S IBDT=IBBDT-.000000001
67 F S IBDT=$O(^DGPM("AMV1",IBDT)) Q:'IBDT!(IBDT>(IBEDT+.24)) D
68 .S DFN=0 F S DFN=$O(^DGPM("AMV1",IBDT,DFN)) Q:'DFN D
69 ..S DA=0 F S DA=$O(^DGPM("AMV1",IBDT,DFN,DA)) Q:'DA D PROC
70 ;
71 Q
72 ;
73DIS ; - Count discharges.
74 D CHK^IBTOSUM2 I $G(ZTSTOP) Q
75 S IBDT=IBBDT-.000000001
76 F S IBDT=$O(^DGPM("AMV3",IBDT)) Q:'IBDT!(IBDT>(IBEDT+.24)) D
77 .S DFN=0 F S DFN=$O(^DGPM("AMV3",IBDT,DFN)) Q:'DFN D
78 ..S DA=0 F S DA=$O(^DGPM("AMV3",IBDT,DFN,DA)) Q:'DA D PROC
79 ;
80 Q
81 ;
82PROC ; - Process each admission or discharge.
83 S DGPM=+$P($G(^DGPM(DA,0)),U,14)
84 S IBCNT(1)=IBCNT(1)+1 ; Admissions or discharges.
85 S IBTRN=$O(^IBT(356,"AD",DGPM,0)) I 'IBTRN Q
86 S IBTRND=$G(^IBT(356,+IBTRN,0)) ;W !,IBTRND
87 I '$P(IBTRND,U,20) Q ; Must be an active visit.
88 I '$$INSURED^IBCNS1(DFN,IBDT) Q ; Must be insured for visit to count.
89 S IBCNT(2)=IBCNT(2)+1 ; Insured admissions or discharges.
90 S IBCNT(3,+$P(IBTRND,U,19))=$G(IBCNT(3,+$P(IBTRND,U,19)))+1 ; Billables.
91 I $P(IBTRND,U,19) S IBCNT(3,"NB")=$G(IBCNT(3,"NB"))+1
92 S X=$P($G(^IBT(356,+IBTRN,1)),U,7) I X>3 S IBCNT(4)=IBCNT(4)+1
93 I X="",$P(IBTRND,U,24),'$P(IBTRND,U,19) S IBCNT(4)=IBCNT(4)+1
94 I $$APPEAL(IBTRN) S IBCNT(80)=IBCNT(80)+1
95 ;
96 K IBDCNT,IBPCNT S IBTRC=0
97 F S IBTRC=$O(^IBT(356.2,"C",IBTRN,IBTRC)) Q:'IBTRC D RCNT^IBTOSUM1
98 I $D(IBPCNT(IBTRN)) S IBCNT(99)=IBCNT(99)+1
99 I $O(IBPCNT(IBTRN,+$O(IBPCNT(IBTRN,0)))) S IBCNT(13)=IBCNT(13)+1
100 Q
101 ;
102APPEAL(IBTRN) ; - Was this case appealed?
103 N A,X
104 S A=0 I 'IBTRN G APPEALQ
105 S X=$O(^IBE(356.11,"ACODE",60,0)) ; Initial appeal.
106 I $O(^IBT(356.2,"ATRTP",IBTRN,X,0)) S A=1 G APPEALQ
107 S X=$O(^IBE(356.11,"ACODE",65,0)) ; Subsequent appeal.
108 I $O(^IBT(356.2,"ATRTP",IBTRN,X,0)) S A=1 G APPEALQ
109APPEALQ Q A
Note: See TracBrowser for help on using the repository browser.