IBTOSUM1 ;ALB/AAS - CLAIMS TRACKING BILLING INFORMATION PRINT ; 29-OCT-93
;;Version 2.0 ; INTEGRATED BILLING ;; 21-MAR-94
;
REV ; -- count reviews
D CHK^IBTOSUM2 I $G(ZTSTOP) Q
; -- count review for same period
S IBDT=IBBDT-.000000001
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
;
RCNT ; -- process each review
N IBDAY,IBETYP,IBAC,IBNOD,IBTALL,IBPEND
S IBTRCD=$G(^IBT(356.2,+IBTRC,0))
S IBETYP=$G(^IBE(356.11,+$P(IBTRCD,"^",4),0))
I $P(IBETYP,"^",2)>65 Q ;is a patient, other or an ins. verification call
;
I $P(IBETYP,"^",2)=60 D Q ; count initial appeals and quit
.S IBCNT(81)=IBCNT(81)+1
;
I $P(IBETYP,"^",2)=65 D Q ; count subsequent appeals and quit
.S IBCNT(82)=IBCNT(82)+1
;
I $P(IBTRCD,"^",19)'=10 Q ;must be completed to included in report
;
S IBSPEC=$$SPEC(IBTRC)
S IBBBS=$$BBS(+IBSPEC)
S IBRATE=$$RATE(IBBBS,+IBTRCD)
;
S IBPCNT(IBTRN,+$P(^IBT(356.2,+IBTRC,1),"^",5))=""
S IBCNT(5)=$G(IBCNT(5))+1 ;count of total reviews done
S IBCNT(5,+IBSPEC)=$G(IBCNT(5,+IBSPEC))+1
S IBAC=+$$ACTION(IBTRC),IBDAY=0
;
I IBAC=10 D
.S IBTALL=+$P($G(^IBT(356.2,IBTRC,1)),"^",8) ;approved all days
.S IBCDT=$$CDT^IBTODD1(IBTRN)
.S IBMAX=$S($D(IBDCNT(IBTRN))#2:IBDCNT(IBTRN),1:$$DAY^IBTUTL3(+IBCDT,$S($P(IBCDT,"^",2):$P(IBCDT,"^",2),1:IBEDT))) ; max days approved for a visit
.I '$D(IBDCNT(IBTRN))#2 S IBDCNT(IBTRN)=IBMAX
.I 'IBTALL S IBDAY=$$DAY^IBTUTL3(+$P(IBTRCD,"^",12),+$P(IBTRCD,"^",13),IBTRN)
.I IBTALL S IBDAY=$$DAY^IBTUTL3(+IBCDT,$S($P(IBCDT,"^",2):$P(IBCDT,"^",2),1:DT),IBTRN)
.I IBDAY>IBMAX S IBDAY=IBMAX
.S IBDCNT(IBTRN)=IBDCNT(IBTRN)-IBDAY ;count can't excede total days
;
I IBAC=20 D
.S IBTALL=+$P($G(^IBT(356.2,IBTRC,1)),"^",7) ;denied all days
.S IBCDT=$$CDT^IBTODD1(IBTRN)
.S IBMAX=$S($D(IBDCNT(IBTRN))#2:IBDCNT(IBTRN),1:$$DAY^IBTUTL3(+IBCDT,$S($P(IBCDT,"^",2):$P(IBCDT,"^",2),1:IBEDT))) ; max days approved for a visit
.I '$D(IBDCNT(IBTRN))#2 S IBDCNT(IBTRN)=IBMAX
.I 'IBTALL S IBDAY=$$DAY^IBTUTL3(+$P(IBTRCD,"^",15),+$P(IBTRCD,"^",16),IBTRN)
.I IBTALL S IBDAY=$$DAY^IBTUTL3(+IBCDT,$S($P(IBCDT,"^",2):$P(IBCDT,"^",2),1:DT),IBTRN)
.I IBDAY>IBMAX S IBDAY=$S(IBMAX<0:0,1:IBMAX)
.S IBDCNT(IBTRN)=IBDCNT(IBTRN)-IBDAY ;count can't excede total days
;
S IBCNT(IBAC)=$G(IBCNT(IBAC))+IBDAY,IBCNT(IBAC,+IBSPEC)=$G(IBCNT(IBAC,+IBSPEC))+IBDAY
S IBCNT(IBAC+1)=$G(IBCNT(IBAC+1))+(IBDAY*IBRATE)
S IBCNT(IBAC+1,+IBSPEC)=$G(IBCNT(IBAC+1,+IBSPEC))+(IBDAY*IBRATE)
I IBAC=30 S IBPEN=0 F S IBPEN=$O(^IBT(356.2,+IBTRC,13,IBPEN)) Q:'IBPEN S IBPEND=$G(^(IBPEN,0)) D
.S IBNOD=IBPEND+30
.S $P(IBCNT(IBNOD),"^",1)=$P(IBCNT(IBNOD),"^",1)+1
.S $P(IBCNT(IBNOD),"^",2)=$P(IBCNT(IBNOD),"^",2)+$P(IBPEND,"^",2)
.S $P(IBCNT(IBNOD,+IBSPEC),"^",1)=+$G(IBCNT(IBNOD,+IBSPEC))+1
.S $P(IBCNT(IBNOD,+IBSPEC),"^",2)=$P($G(IBCNT(IBNOD,+IBSPEC)),"^",2)+$P(IBPEND,"^",2)
.Q
Q
;
ACTION(IBTRC) ; -- compute action code for a review
Q $P($G(^IBE(356.7,+$P($G(^IBT(356.2,+$G(IBTRC),0)),"^",11),0)),"^",3)
;
SPEC(IBTRC) ; -- compute treating specialty on review date
N VAERR,VAIN,VAINDT,X,Y,I,J,DFN,IBTRN,IBCDT
S VAINDT=+$G(^IBT(356.2,+IBTRC,0))+.2359,DFN=$P(^(0),"^",5)
S IBTRN=$P($G(^IBT(356.2,+IBTRC,0)),"^",2),IBCDT=$$CDT^IBTODD1(IBTRN)
I VAINDT,+IBCDT,VAINDT<(+IBCDT) S VAINDT=IBCDT+.2359
I VAINDT,+$P(IBCDT,"^",2),VAINDT>$P(IBCDT,"^",2) S VAINDT=$P(IBCDT,"^",2)\1
D:DFN INP^VADPT
Q $G(VAIN(3))
;
BBS(IBSPEC) ; -- compute billing bedsection from specialty
N X
S X=$P($G(^DIC(42.4,+$P($G(^DIC(45.7,+$G(IBSPEC),0)),"^",2),0)),"^",5)
I X'="" S X=$O(^DGCR(399.1,"B",X,0))
Q X
;
RATE(IBBBS,IBDT) ; -- compute daily bed section rate for date
N DGREV,DGBR,IBIDT,DGBRN,DGFND,IBCHK,X,IBAMT
S IBAMT=0 I '$G(IBBBS)!('$G(IBDT)) G RATEQ
D SETREV
RATEQ Q IBAMT
;
SETREV ; -- find current active revenue codes for bedsection
S (IBAMT,DGREV,DGBR)=0,IBIDT=-(IBDT+.01) K DGFND
F S IBIDT=$O(^DGCR(399.5,"AIVDT",IBBBS,IBIDT)) Q:'IBIDT!($D(DGFND)) D
. F S DGREV=$O(^DGCR(399.5,"AIVDT",IBBBS,IBIDT,DGREV)) Q:'DGREV D
.. F S DGBR=$O(^DGCR(399.5,"AIVDT",IBBBS,IBIDT,DGREV,DGBR)) Q:'DGBR D CHKREV I IBCHK S IBAMT=IBAMT+X
Q
CHKREV ; -- check if billing rate (dgbr) is active and starndard.
S IBCHK=0,X=0
S DGBRN=^DGCR(399.5,DGBR,0) I '$P(DGBRN,"^",5) Q ;quit if inactive
I +$P(DGBRN,"^",7) Q ;quit if non-standard rate
;
; -- use cat c rate as total for tortuously liable rates
I $P(DGBRN,U,6)["c" S:'$D(DGFND) DGFND="" S IBCHK=1
;
S X=$P(^DGCR(399.5,DGBR,0),"^",4)
Q
IBTOSUM1 ;ALB/AAS - CLAIMS TRACKING BILLING INFORMATION PRINT ; 29-OCT-93
+1 ;;Version 2.0 ; INTEGRATED BILLING ;; 21-MAR-94
+2 ;
REV ; -- count reviews
+1 DO CHK^IBTOSUM2
IF $GET(ZTSTOP)
QUIT
+2 ; -- count review for same period
+3 SET IBDT=IBBDT-.000000001
+4 FOR
SET IBDT=$ORDER(^IBT(356.2,"B",IBDT))
IF 'IBDT!(IBDT>(IBEDT+.24))
QUIT
SET IBTRC=0
FOR
SET IBTRC=$ORDER(^IBT(356.2,"B",IBDT,IBTRC))
IF 'IBTRC
QUIT
DO RCNT
+5 ;
RCNT ; -- process each review
+1 NEW IBDAY,IBETYP,IBAC,IBNOD,IBTALL,IBPEND
+2 SET IBTRCD=$GET(^IBT(356.2,+IBTRC,0))
+3 SET IBETYP=$GET(^IBE(356.11,+$PIECE(IBTRCD,"^",4),0))
+4 ;is a patient, other or an ins. verification call
IF $PIECE(IBETYP,"^",2)>65
QUIT
+5 ;
+6 ; count initial appeals and quit
IF $PIECE(IBETYP,"^",2)=60
Begin DoDot:1
+7 SET IBCNT(81)=IBCNT(81)+1
End DoDot:1
QUIT
+8 ;
+9 ; count subsequent appeals and quit
IF $PIECE(IBETYP,"^",2)=65
Begin DoDot:1
+10 SET IBCNT(82)=IBCNT(82)+1
End DoDot:1
QUIT
+11 ;
+12 ;must be completed to included in report
IF $PIECE(IBTRCD,"^",19)'=10
QUIT
+13 ;
+14 SET IBSPEC=$$SPEC(IBTRC)
+15 SET IBBBS=$$BBS(+IBSPEC)
+16 SET IBRATE=$$RATE(IBBBS,+IBTRCD)
+17 ;
+18 SET IBPCNT(IBTRN,+$PIECE(^IBT(356.2,+IBTRC,1),"^",5))=""
+19 ;count of total reviews done
SET IBCNT(5)=$GET(IBCNT(5))+1
+20 SET IBCNT(5,+IBSPEC)=$GET(IBCNT(5,+IBSPEC))+1
+21 SET IBAC=+$$ACTION(IBTRC)
SET IBDAY=0
+22 ;
+23 IF IBAC=10
Begin DoDot:1
+24 ;approved all days
SET IBTALL=+$PIECE($GET(^IBT(356.2,IBTRC,1)),"^",8)
+25 SET IBCDT=$$CDT^IBTODD1(IBTRN)
+26 ; max days approved for a visit
SET IBMAX=$SELECT($DATA(IBDCNT(IBTRN))#2:IBDCNT(IBTRN),1:$$DAY^IBTUTL3(+IBCDT,$SELECT($PIECE(IBCDT,"^",2):$PIECE(IBCDT,"^",2),1:IBEDT)))
+27 IF '$DATA(IBDCNT(IBTRN))#2
SET IBDCNT(IBTRN)=IBMAX
+28 IF 'IBTALL
SET IBDAY=$$DAY^IBTUTL3(+$PIECE(IBTRCD,"^",12),+$PIECE(IBTRCD,"^",13),IBTRN)
+29 IF IBTALL
SET IBDAY=$$DAY^IBTUTL3(+IBCDT,$SELECT($PIECE(IBCDT,"^",2):$PIECE(IBCDT,"^",2),1:DT),IBTRN)
+30 IF IBDAY>IBMAX
SET IBDAY=IBMAX
+31 ;count can't excede total days
SET IBDCNT(IBTRN)=IBDCNT(IBTRN)-IBDAY
End DoDot:1
+32 ;
+33 IF IBAC=20
Begin DoDot:1
+34 ;denied all days
SET IBTALL=+$PIECE($GET(^IBT(356.2,IBTRC,1)),"^",7)
+35 SET IBCDT=$$CDT^IBTODD1(IBTRN)
+36 ; max days approved for a visit
SET IBMAX=$SELECT($DATA(IBDCNT(IBTRN))#2:IBDCNT(IBTRN),1:$$DAY^IBTUTL3(+IBCDT,$SELECT($PIECE(IBCDT,"^",2):$PIECE(IBCDT,"^",2),1:IBEDT)))
+37 IF '$DATA(IBDCNT(IBTRN))#2
SET IBDCNT(IBTRN)=IBMAX
+38 IF 'IBTALL
SET IBDAY=$$DAY^IBTUTL3(+$PIECE(IBTRCD,"^",15),+$PIECE(IBTRCD,"^",16),IBTRN)
+39 IF IBTALL
SET IBDAY=$$DAY^IBTUTL3(+IBCDT,$SELECT($PIECE(IBCDT,"^",2):$PIECE(IBCDT,"^",2),1:DT),IBTRN)
+40 IF IBDAY>IBMAX
SET IBDAY=$SELECT(IBMAX<0:0,1:IBMAX)
+41 ;count can't excede total days
SET IBDCNT(IBTRN)=IBDCNT(IBTRN)-IBDAY
End DoDot:1
+42 ;
+43 SET IBCNT(IBAC)=$GET(IBCNT(IBAC))+IBDAY
SET IBCNT(IBAC,+IBSPEC)=$GET(IBCNT(IBAC,+IBSPEC))+IBDAY
+44 SET IBCNT(IBAC+1)=$GET(IBCNT(IBAC+1))+(IBDAY*IBRATE)
+45 SET IBCNT(IBAC+1,+IBSPEC)=$GET(IBCNT(IBAC+1,+IBSPEC))+(IBDAY*IBRATE)
+46 IF IBAC=30
SET IBPEN=0
FOR
SET IBPEN=$ORDER(^IBT(356.2,+IBTRC,13,IBPEN))
IF 'IBPEN
QUIT
SET IBPEND=$GET(^(IBPEN,0))
Begin DoDot:1
+47 SET IBNOD=IBPEND+30
+48 SET $PIECE(IBCNT(IBNOD),"^",1)=$PIECE(IBCNT(IBNOD),"^",1)+1
+49 SET $PIECE(IBCNT(IBNOD),"^",2)=$PIECE(IBCNT(IBNOD),"^",2)+$PIECE(IBPEND,"^",2)
+50 SET $PIECE(IBCNT(IBNOD,+IBSPEC),"^",1)=+$GET(IBCNT(IBNOD,+IBSPEC))+1
+51 SET $PIECE(IBCNT(IBNOD,+IBSPEC),"^",2)=$PIECE($GET(IBCNT(IBNOD,+IBSPEC)),"^",2)+$PIECE(IBPEND,"^",2)
+52 QUIT
End DoDot:1
+53 QUIT
+54 ;
ACTION(IBTRC) ; -- compute action code for a review
+1 QUIT $PIECE($GET(^IBE(356.7,+$PIECE($GET(^IBT(356.2,+$GET(IBTRC),0)),"^",11),0)),"^",3)
+2 ;
SPEC(IBTRC) ; -- compute treating specialty on review date
+1 NEW VAERR,VAIN,VAINDT,X,Y,I,J,DFN,IBTRN,IBCDT
+2 SET VAINDT=+$GET(^IBT(356.2,+IBTRC,0))+.2359
SET DFN=$PIECE(^(0),"^",5)
+3 SET IBTRN=$PIECE($GET(^IBT(356.2,+IBTRC,0)),"^",2)
SET IBCDT=$$CDT^IBTODD1(IBTRN)
+4 IF VAINDT
IF +IBCDT
IF VAINDT<(+IBCDT)
SET VAINDT=IBCDT+.2359
+5 IF VAINDT
IF +$PIECE(IBCDT,"^",2)
IF VAINDT>$PIECE(IBCDT,"^",2)
SET VAINDT=$PIECE(IBCDT,"^",2)\1
+6 IF DFN
DO INP^VADPT
+7 QUIT $GET(VAIN(3))
+8 ;
BBS(IBSPEC) ; -- compute billing bedsection from specialty
+1 NEW X
+2 SET X=$PIECE($GET(^DIC(42.4,+$PIECE($GET(^DIC(45.7,+$GET(IBSPEC),0)),"^",2),0)),"^",5)
+3 IF X'=""
SET X=$ORDER(^DGCR(399.1,"B",X,0))
+4 QUIT X
+5 ;
RATE(IBBBS,IBDT) ; -- compute daily bed section rate for date
+1 NEW DGREV,DGBR,IBIDT,DGBRN,DGFND,IBCHK,X,IBAMT
+2 SET IBAMT=0
IF '$GET(IBBBS)!('$GET(IBDT))
GOTO RATEQ
+3 DO SETREV
RATEQ QUIT IBAMT
+1 ;
SETREV ; -- find current active revenue codes for bedsection
+1 SET (IBAMT,DGREV,DGBR)=0
SET IBIDT=-(IBDT+.01)
KILL DGFND
+2 FOR
SET IBIDT=$ORDER(^DGCR(399.5,"AIVDT",IBBBS,IBIDT))
IF 'IBIDT!($DATA(DGFND))
QUIT
Begin DoDot:1
+3 FOR
SET DGREV=$ORDER(^DGCR(399.5,"AIVDT",IBBBS,IBIDT,DGREV))
IF 'DGREV
QUIT
Begin DoDot:2
+4 FOR
SET DGBR=$ORDER(^DGCR(399.5,"AIVDT",IBBBS,IBIDT,DGREV,DGBR))
IF 'DGBR
QUIT
DO CHKREV
IF IBCHK
SET IBAMT=IBAMT+X
End DoDot:2
End DoDot:1
+5 QUIT
CHKREV ; -- check if billing rate (dgbr) is active and starndard.
+1 SET IBCHK=0
SET X=0
+2 ;quit if inactive
SET DGBRN=^DGCR(399.5,DGBR,0)
IF '$PIECE(DGBRN,"^",5)
QUIT
+3 ;quit if non-standard rate
IF +$PIECE(DGBRN,"^",7)
QUIT
+4 ;
+5 ; -- use cat c rate as total for tortuously liable rates
+6 IF $PIECE(DGBRN,U,6)["c"
IF '$DATA(DGFND)
SET DGFND=""
SET IBCHK=1
+7 ;
+8 SET X=$PIECE(^DGCR(399.5,DGBR,0),"^",4)
+9 QUIT
