IBTOSUM1 ;ALB/AAS - CLAIMS TRACKING BILLING INFORMATION PRINT ; 29-OCT-93
;;2.0;INTEGRATED BILLING;**23,52,118**;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,U,4),0))
I $P(IBETYP,U,2)>65 Q ; Is a patient/other/ins. verification call.
I $P(IBETYP,U,2)=60 S IBCNT(81)=IBCNT(81)+1 Q ; Initial appeals.
I $P(IBETYP,U,2)=65 S IBCNT(82)=IBCNT(82)+1 Q ; Subsequent appeals.
I $P(IBTRCD,U,19)'=10 Q ; Must be completed to include in report.
S IBSPEC=$$SPEC(IBTRC),IBBBS=$$BBS(+IBSPEC)
S IBRATE=$$RATE(IBBBS,+IBTRCD)
S IBPCNT(IBTRN,+$P(^IBT(356.2,+IBTRC,1),U,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)),U,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,U,2):$P(IBCDT,U,2),1:IBEDT)))
.I '$D(IBDCNT(IBTRN))#2 S IBDCNT(IBTRN)=IBMAX
.I 'IBTALL S IBDAY=$$DAY^IBTUTL3(+$P(IBTRCD,U,12),+$P(IBTRCD,U,13),IBTRN)
.I IBTALL S IBDAY=$$DAY^IBTUTL3(+IBCDT,$S($P(IBCDT,U,2):$P(IBCDT,U,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)),U,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,U,2):$P(IBCDT,U,2),1:IBEDT)))
.I '$D(IBDCNT(IBTRN))#2 S IBDCNT(IBTRN)=IBMAX
.I 'IBTALL S IBDAY=$$DAY^IBTUTL3(+$P(IBTRCD,U,15),+$P(IBTRCD,U,16),IBTRN)
.I IBTALL S IBDAY=$$DAY^IBTUTL3(+IBCDT,$S($P(IBCDT,U,2):$P(IBCDT,U,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,$P(IBCNT(IBNOD),U)=$P(IBCNT(IBNOD),U)+1
.S $P(IBCNT(IBNOD),U,2)=$P(IBCNT(IBNOD),U,2)+$P(IBPEND,U,2)
.S $P(IBCNT(IBNOD,+IBSPEC),U)=+$G(IBCNT(IBNOD,+IBSPEC))+1
.S $P(IBCNT(IBNOD,+IBSPEC),U,2)=$P($G(IBCNT(IBNOD,+IBSPEC)),U,2)+$P(IBPEND,U,2)
;
Q
;
ACTION(IBTRC) ; - Compute action code for a review.
Q $P($G(^IBE(356.7,+$P($G(^IBT(356.2,+$G(IBTRC),0)),U,11),0)),U,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),U,5)
S IBTRN=$P($G(^IBT(356.2,+IBTRC,0)),U,2),IBCDT=$$CDT^IBTODD1(IBTRN)
I VAINDT,+IBCDT,VAINDT<(+IBCDT) S VAINDT=IBCDT+.2359
I VAINDT,+$P(IBCDT,U,2),VAINDT>$P(IBCDT,U,2) S VAINDT=$P(IBCDT,U,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)),U,2),0)),U,5)
I X'="" S X=+$$MCCRUTL^IBCRU1(X,5)
Q X
;
RATE(IBBBS,IBDT) ; - Compute daily bed section rate for date.
N IBAMT,IBCS
S IBAMT=0 I '$G(IBBBS)!('$G(IBDT)) G RATEQ
S IBCS=+$$CSN^IBCRU3("TL-INPT (INCLUSIVE)"),IBDT=IBDT\1
I +IBCS S IBAMT=+$$ITCHG^IBCRCI(IBCS,IBBBS,IBDT)
RATEQ Q IBAMT
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HIBTOSUM1 3718 printed Dec 13, 2024@02:27:23 Page 2
IBTOSUM1 ;ALB/AAS - CLAIMS TRACKING BILLING INFORMATION PRINT ; 29-OCT-93
+1 ;;2.0;INTEGRATED BILLING;**23,52,118**;21-MAR-94
+2 ;
REV ; - Count reviews.
+1 DO CHK^IBTOSUM2
IF $GET(ZTSTOP)
QUIT
+2 ;
+3 ; - Count review for same period.
+4 SET IBDT=IBBDT-.000000001
+5 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
+6 ;
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,U,4),0))
+4 ; Is a patient/other/ins. verification call.
IF $PIECE(IBETYP,U,2)>65
QUIT
+5 ; Initial appeals.
IF $PIECE(IBETYP,U,2)=60
SET IBCNT(81)=IBCNT(81)+1
QUIT
+6 ; Subsequent appeals.
IF $PIECE(IBETYP,U,2)=65
SET IBCNT(82)=IBCNT(82)+1
QUIT
+7 ; Must be completed to include in report.
IF $PIECE(IBTRCD,U,19)'=10
QUIT
+8 SET IBSPEC=$$SPEC(IBTRC)
SET IBBBS=$$BBS(+IBSPEC)
+9 SET IBRATE=$$RATE(IBBBS,+IBTRCD)
+10 SET IBPCNT(IBTRN,+$PIECE(^IBT(356.2,+IBTRC,1),U,5))=""
+11 ; Count of total reviews done.
SET IBCNT(5)=$GET(IBCNT(5))+1
+12 SET IBCNT(5,+IBSPEC)=$GET(IBCNT(5,+IBSPEC))+1
+13 SET IBAC=+$$ACTION(IBTRC)
SET IBDAY=0
+14 IF IBAC=10
Begin DoDot:1
+15 ; Approved all days.
SET IBTALL=+$PIECE($GET(^IBT(356.2,IBTRC,1)),U,8)
+16 SET IBCDT=$$CDT^IBTODD1(IBTRN)
+17 SET IBMAX=$SELECT($DATA(IBDCNT(IBTRN))#2:IBDCNT(IBTRN),1:$$DAY^IBTUTL3(+IBCDT,$SELECT($PIECE(IBCDT,U,2):$PIECE(IBCDT,U,2),1:IBEDT)))
+18 IF '$DATA(IBDCNT(IBTRN))#2
SET IBDCNT(IBTRN)=IBMAX
+19 IF 'IBTALL
SET IBDAY=$$DAY^IBTUTL3(+$PIECE(IBTRCD,U,12),+$PIECE(IBTRCD,U,13),IBTRN)
+20 IF IBTALL
SET IBDAY=$$DAY^IBTUTL3(+IBCDT,$SELECT($PIECE(IBCDT,U,2):$PIECE(IBCDT,U,2),1:DT),IBTRN)
+21 IF IBDAY>IBMAX
SET IBDAY=IBMAX
+22 ; Count can't excede total days.
SET IBDCNT(IBTRN)=IBDCNT(IBTRN)-IBDAY
End DoDot:1
+23 IF IBAC=20
Begin DoDot:1
+24 ; Denied all days.
SET IBTALL=+$PIECE($GET(^IBT(356.2,IBTRC,1)),U,7)
+25 SET IBCDT=$$CDT^IBTODD1(IBTRN)
+26 SET IBMAX=$SELECT($DATA(IBDCNT(IBTRN))#2:IBDCNT(IBTRN),1:$$DAY^IBTUTL3(+IBCDT,$SELECT($PIECE(IBCDT,U,2):$PIECE(IBCDT,U,2),1:IBEDT)))
+27 IF '$DATA(IBDCNT(IBTRN))#2
SET IBDCNT(IBTRN)=IBMAX
+28 IF 'IBTALL
SET IBDAY=$$DAY^IBTUTL3(+$PIECE(IBTRCD,U,15),+$PIECE(IBTRCD,U,16),IBTRN)
+29 IF IBTALL
SET IBDAY=$$DAY^IBTUTL3(+IBCDT,$SELECT($PIECE(IBCDT,U,2):$PIECE(IBCDT,U,2),1:DT),IBTRN)
+30 IF IBDAY>IBMAX
SET IBDAY=$SELECT(IBMAX<0:0,1:IBMAX)
+31 ; Count can't excede total days.
SET IBDCNT(IBTRN)=IBDCNT(IBTRN)-IBDAY
End DoDot:1
+32 SET IBCNT(IBAC)=$GET(IBCNT(IBAC))+IBDAY
SET IBCNT(IBAC,+IBSPEC)=$GET(IBCNT(IBAC,+IBSPEC))+IBDAY
+33 SET IBCNT(IBAC+1)=$GET(IBCNT(IBAC+1))+(IBDAY*IBRATE)
+34 SET IBCNT(IBAC+1,+IBSPEC)=$GET(IBCNT(IBAC+1,+IBSPEC))+(IBDAY*IBRATE)
+35 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
+36 SET IBNOD=IBPEND+30
SET $PIECE(IBCNT(IBNOD),U)=$PIECE(IBCNT(IBNOD),U)+1
+37 SET $PIECE(IBCNT(IBNOD),U,2)=$PIECE(IBCNT(IBNOD),U,2)+$PIECE(IBPEND,U,2)
+38 SET $PIECE(IBCNT(IBNOD,+IBSPEC),U)=+$GET(IBCNT(IBNOD,+IBSPEC))+1
+39 SET $PIECE(IBCNT(IBNOD,+IBSPEC),U,2)=$PIECE($GET(IBCNT(IBNOD,+IBSPEC)),U,2)+$PIECE(IBPEND,U,2)
End DoDot:1
+40 ;
+41 QUIT
+42 ;
ACTION(IBTRC) ; - Compute action code for a review.
+1 QUIT $PIECE($GET(^IBE(356.7,+$PIECE($GET(^IBT(356.2,+$GET(IBTRC),0)),U,11),0)),U,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),U,5)
+3 SET IBTRN=$PIECE($GET(^IBT(356.2,+IBTRC,0)),U,2)
SET IBCDT=$$CDT^IBTODD1(IBTRN)
+4 IF VAINDT
IF +IBCDT
IF VAINDT<(+IBCDT)
SET VAINDT=IBCDT+.2359
+5 IF VAINDT
IF +$PIECE(IBCDT,U,2)
IF VAINDT>$PIECE(IBCDT,U,2)
SET VAINDT=$PIECE(IBCDT,U,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)),U,2),0)),U,5)
+3 IF X'=""
SET X=+$$MCCRUTL^IBCRU1(X,5)
+4 QUIT X
+5 ;
RATE(IBBBS,IBDT) ; - Compute daily bed section rate for date.
+1 NEW IBAMT,IBCS
+2 SET IBAMT=0
IF '$GET(IBBBS)!('$GET(IBDT))
GOTO RATEQ
+3 SET IBCS=+$$CSN^IBCRU3("TL-INPT (INCLUSIVE)")
SET IBDT=IBDT\1
+4 IF +IBCS
SET IBAMT=+$$ITCHG^IBCRCI(IBCS,IBBBS,IBDT)
RATEQ QUIT IBAMT
