source: WorldVistAEHR/trunk/r/INTEGRATED_BILLING-IB-PRQ--IBD--IBQ--PRQS/IBTOSUM1.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: 3.6 KB
Line 
1IBTOSUM1 ;ALB/AAS - CLAIMS TRACKING BILLING INFORMATION PRINT ; 29-OCT-93
2 ;;2.0;INTEGRATED BILLING;**23,52,118**;21-MAR-94
3 ;
4REV ; - Count reviews.
5 D CHK^IBTOSUM2 I $G(ZTSTOP) Q
6 ;
7 ; - Count review for same period.
8 S IBDT=IBBDT-.000000001
9 F S IBDT=$O(^IBT(356.2,"B",IBDT)) Q:'IBDT!(IBDT>(IBEDT+.24)) S IBTRC=0 F S IBTRC=$O(^IBT(356.2,"B",IBDT,IBTRC)) Q:'IBTRC D RCNT
10 ;
11RCNT ; - Process each review.
12 N IBDAY,IBETYP,IBAC,IBNOD,IBTALL,IBPEND
13 S IBTRCD=$G(^IBT(356.2,+IBTRC,0))
14 S IBETYP=$G(^IBE(356.11,+$P(IBTRCD,U,4),0))
15 I $P(IBETYP,U,2)>65 Q ; Is a patient/other/ins. verification call.
16 I $P(IBETYP,U,2)=60 S IBCNT(81)=IBCNT(81)+1 Q ; Initial appeals.
17 I $P(IBETYP,U,2)=65 S IBCNT(82)=IBCNT(82)+1 Q ; Subsequent appeals.
18 I $P(IBTRCD,U,19)'=10 Q ; Must be completed to include in report.
19 S IBSPEC=$$SPEC(IBTRC),IBBBS=$$BBS(+IBSPEC)
20 S IBRATE=$$RATE(IBBBS,+IBTRCD)
21 S IBPCNT(IBTRN,+$P(^IBT(356.2,+IBTRC,1),U,5))=""
22 S IBCNT(5)=$G(IBCNT(5))+1 ; Count of total reviews done.
23 S IBCNT(5,+IBSPEC)=$G(IBCNT(5,+IBSPEC))+1
24 S IBAC=+$$ACTION(IBTRC),IBDAY=0
25 I IBAC=10 D
26 .S IBTALL=+$P($G(^IBT(356.2,IBTRC,1)),U,8) ; Approved all days.
27 .S IBCDT=$$CDT^IBTODD1(IBTRN)
28 .S IBMAX=$S($D(IBDCNT(IBTRN))#2:IBDCNT(IBTRN),1:$$DAY^IBTUTL3(+IBCDT,$S($P(IBCDT,U,2):$P(IBCDT,U,2),1:IBEDT)))
29 .I '$D(IBDCNT(IBTRN))#2 S IBDCNT(IBTRN)=IBMAX
30 .I 'IBTALL S IBDAY=$$DAY^IBTUTL3(+$P(IBTRCD,U,12),+$P(IBTRCD,U,13),IBTRN)
31 .I IBTALL S IBDAY=$$DAY^IBTUTL3(+IBCDT,$S($P(IBCDT,U,2):$P(IBCDT,U,2),1:DT),IBTRN)
32 .I IBDAY>IBMAX S IBDAY=IBMAX
33 .S IBDCNT(IBTRN)=IBDCNT(IBTRN)-IBDAY ; Count can't excede total days.
34 I IBAC=20 D
35 .S IBTALL=+$P($G(^IBT(356.2,IBTRC,1)),U,7) ; Denied all days.
36 .S IBCDT=$$CDT^IBTODD1(IBTRN)
37 .S IBMAX=$S($D(IBDCNT(IBTRN))#2:IBDCNT(IBTRN),1:$$DAY^IBTUTL3(+IBCDT,$S($P(IBCDT,U,2):$P(IBCDT,U,2),1:IBEDT)))
38 .I '$D(IBDCNT(IBTRN))#2 S IBDCNT(IBTRN)=IBMAX
39 .I 'IBTALL S IBDAY=$$DAY^IBTUTL3(+$P(IBTRCD,U,15),+$P(IBTRCD,U,16),IBTRN)
40 .I IBTALL S IBDAY=$$DAY^IBTUTL3(+IBCDT,$S($P(IBCDT,U,2):$P(IBCDT,U,2),1:DT),IBTRN)
41 .I IBDAY>IBMAX S IBDAY=$S(IBMAX<0:0,1:IBMAX)
42 .S IBDCNT(IBTRN)=IBDCNT(IBTRN)-IBDAY ; Count can't excede total days.
43 S IBCNT(IBAC)=$G(IBCNT(IBAC))+IBDAY,IBCNT(IBAC,+IBSPEC)=$G(IBCNT(IBAC,+IBSPEC))+IBDAY
44 S IBCNT(IBAC+1)=$G(IBCNT(IBAC+1))+(IBDAY*IBRATE)
45 S IBCNT(IBAC+1,+IBSPEC)=$G(IBCNT(IBAC+1,+IBSPEC))+(IBDAY*IBRATE)
46 I IBAC=30 S IBPEN=0 F S IBPEN=$O(^IBT(356.2,+IBTRC,13,IBPEN)) Q:'IBPEN S IBPEND=$G(^(IBPEN,0)) D
47 .S IBNOD=IBPEND+30,$P(IBCNT(IBNOD),U)=$P(IBCNT(IBNOD),U)+1
48 .S $P(IBCNT(IBNOD),U,2)=$P(IBCNT(IBNOD),U,2)+$P(IBPEND,U,2)
49 .S $P(IBCNT(IBNOD,+IBSPEC),U)=+$G(IBCNT(IBNOD,+IBSPEC))+1
50 .S $P(IBCNT(IBNOD,+IBSPEC),U,2)=$P($G(IBCNT(IBNOD,+IBSPEC)),U,2)+$P(IBPEND,U,2)
51 ;
52 Q
53 ;
54ACTION(IBTRC) ; - Compute action code for a review.
55 Q $P($G(^IBE(356.7,+$P($G(^IBT(356.2,+$G(IBTRC),0)),U,11),0)),U,3)
56 ;
57SPEC(IBTRC) ; - Compute treating specialty on review date.
58 N VAERR,VAIN,VAINDT,X,Y,I,J,DFN,IBTRN,IBCDT
59 S VAINDT=+$G(^IBT(356.2,+IBTRC,0))+.2359,DFN=$P(^(0),U,5)
60 S IBTRN=$P($G(^IBT(356.2,+IBTRC,0)),U,2),IBCDT=$$CDT^IBTODD1(IBTRN)
61 I VAINDT,+IBCDT,VAINDT<(+IBCDT) S VAINDT=IBCDT+.2359
62 I VAINDT,+$P(IBCDT,U,2),VAINDT>$P(IBCDT,U,2) S VAINDT=$P(IBCDT,U,2)\1
63 D:DFN INP^VADPT
64 Q $G(VAIN(3))
65 ;
66BBS(IBSPEC) ; - Compute billing bedsection from specialty.
67 N X
68 S X=$P($G(^DIC(42.4,+$P($G(^DIC(45.7,+$G(IBSPEC),0)),U,2),0)),U,5)
69 I X'="" S X=+$$MCCRUTL^IBCRU1(X,5)
70 Q X
71 ;
72RATE(IBBBS,IBDT) ; - Compute daily bed section rate for date.
73 N IBAMT,IBCS
74 S IBAMT=0 I '$G(IBBBS)!('$G(IBDT)) G RATEQ
75 S IBCS=+$$CSN^IBCRU3("TL-INPT (INCLUSIVE)"),IBDT=IBDT\1
76 I +IBCS S IBAMT=+$$ITCHG^IBCRCI(IBCS,IBBBS,IBDT)
77RATEQ Q IBAMT
Note: See TracBrowser for help on using the repository browser.