IBTOUR1 ;ALB/AAS - CLAIMS TRACKING UR/ACTIVITY REPORT ; 27-OCT-93
;;Version 2.0 ; INTEGRATED BILLING ;; 21-MAR-94
;
% ;
; ibcnt(1) = total count of admissions
; ibcnt(2) = total count of insured admissions
; ibcnt(3,0) = total count of billable admissions
; ibcnt(3,n) = count of non-billable admissions by reason (n)
; ibcnt(4) = count of admissions requiring reviews
; ibcnt(5) = admissions with pre-cert and follow-up
; ibcnt(6) = no pre-cert but active monitoring required
; ibcnt(7) = new closed cases = discharged, or no next rev. date, or ur not required
; ibcnt(7,0) = new cases closed, billable
; ibcnt(7,1) = new cases closed, not billable
; ibcnt(8) = new cases open (not closed)
;
; ibcnt(9) = previous case (find in REV), adm prior to begin date
; ibcnt(9,0) = cases closed billable
; ibcnt(9,1) = cases closed non-billable
; ibcnt(9,2) = previous cases still open
;
; ^tmp($j,"ibtour", $s(pt. name/specialty/review date) ,pt. name,sort3,ibtrc)=^ibt(ibtrc,0)
; ^tmp($j,"ibtour1",specialty)=days approved, days denied, $approved, $denied)
;
BLD ; -- build data
;initialize summary array
F I=1:1:11 S IBCNT(I)=0 I I=7!(I=9) F J=0:1:2 S IBCNT(I,J)=0
F I=40:1:52 S IBCNT(I)=0 I I=45 F J=1:1:3 S IBCNT(I,J)=0
;
D ADM
D:IBSORT'="H" IREV^IBTOUR2,ISUB
D:IBSORT'="I" HREV^IBTOUR2,HSUB^IBTOUR5
Q
;
ADM ; -- count admission
D CHK^IBTOSUM2 I $G(ZTSTOP) Q
S IBDT=IBBDT-.000000001
F S IBDT=$O(^DGPM("AMV1",IBDT)) Q:'IBDT!(IBDT>(IBEDT+.24)) D
.S DFN=0 F S DFN=$O(^DGPM("AMV1",IBDT,DFN)) Q:'DFN D
..S DGPM=0 F S DGPM=$O(^DGPM("AMV1",IBDT,DFN,DGPM)) Q:'DGPM D
...S IBCNT(1)=IBCNT(1)+1 ; count of admissions
...S IBTRN=$O(^IBT(356,"AD",DGPM,0))
...Q:'IBTRN
...S IBTRND=$G(^IBT(356,+IBTRN,0))
...Q:'$P(IBTRND,"^",20)
...S X=$P($G(^IBT(356,+IBTRN,1)),"^",7) I X>3 S IBCNT(4)=IBCNT(4)+1,^TMP($J,"IBTOUR0",IBTRN)=IBTRN ;reviews required
...I X="",$P(IBTRND,"^",24),'$P(IBTRND,"^",19) S IBCNT(4)=IBCNT(4)+1,^TMP($J,"IBTOUR0",IBTRN)=IBTRN
...;
...S IBINS=$$INSURED^IBCNS1(DFN,IBDT) I IBINS S IBCNT(2)=IBCNT(2)+1 ; count of insured admissions
...I IBINS S IBCNT(3,+$P(IBTRND,"^",19))=$G(IBCNT(3,+$P(IBTRND,"^",19)))+1 ;count of NOT Billable by reason billable
Q
;
ISUB ; -- count subtotals for cases reviewed
N IBTRN,IBCLOS,DGPM,IBTPREV
S IBTRN="" F S IBTRN=$O(^TMP($J,"IBTOUR0",IBTRN)) Q:'IBTRN D
.S IBTRND=$G(^IBT(356,+IBTRN,0))
.Q:'$P(IBTRND,"^",20) ;inactive case
.Q:$P(IBTRND,"^",8) ;rx fill, don't count
.S DGPM=$P($G(^IBT(356,+IBTRN,0)),"^",5)
.S IBCLOS=$$CLOSED(DGPM,IBTRN)
.S IBTPREV=0 I $P($G(^IBT(356,+IBTRN,0)),"^",6)<IBBDT S IBTPREV=1
.I $P(IBTRND,"^",4) S IBCNT(10)=IBCNT(10)+1
.D CASE
.Q
Q
;
CASE ; -- figure out case summary
N I,J,IBPRE,IBFOL
I IBTPREV D PREV
S (IBFOL,IBPRE)=0
I $O(^IBT(356.2,"APRE",IBTRN))'="" S IBPRE=1 ; is precert number
S IBPCODE=$O(^IBE(356.11,"ACODE",10,0)) ; precert tracking type
S IBCCODE=$O(^IBE(356.11,"ACODE",30,0)) ; cont. stay tracking type
;
I 'IBPRE S IBTRC=$O(^IBT(356.2,"ATRTP",IBTRN,IBPCODE,0)) I IBTRC,$P($G(^IBT(356.2,+IBTRC,0)),"^",19)=10 S IBPRE=1
;
S IBX=$P($G(^IBT(356,+IBTRN,1)),"^",7) I 'IBX D
.I $O(^IBT(356.2,"ATRTP",IBTRN,IBCCODE,0)) S IBFOL=1
.I IBPRE,IBFOL S IBCNT(5)=IBCNT(5)+1 ; adm with precert and follow up
.I 'IBPRE,IBFOL S IBCNT(6)=IBCNT(6)+1 ; adm w/o precert but cont. monitor
I IBX>4 S IBCNT(5)=IBCNT(5)+1
I IBX=4 S IBCNT(6)=IBCNT(6)=1
;
I IBCLOS S IBCNT(7,$S($P(IBTRND,"^",19):1,1:0))=IBCNT(7,$S($P(IBTRND,"^",19):1,1:0))+1,IBCNT(7)=IBCNT(7)+1
;
I 'IBTPREV S IBX=$P($G(^IBT(356,+IBTRN,1)),"^",7) I IBX,IBX<4 S IBCNT(4)=IBCNT(4)+1 ; new case rev not required, but done.
;
I 'IBCLOS,'IBTPREV S IBCNT(8)=IBCNT(8)+1 ;new cases still open
I '$P(IBTRND,"^",5),$P(^IBE(356.6,+$P(IBTRND,"^",18),0),"^",8)=5 S IBCNT(11)=IBCNT(11)+1
CASEQ Q
;
CLOSED(DGPM,IBTRN) ; -- is case closed
N IBI,IBJ,IBCLOSE
S IBCLOSE=0
I $P($G(^DGPM(+DGPM,0)),"^",17) S IBCLOSE=1 G CLOSEDQ ; - discharged
I '$P($G(^IBT(356,+IBTRN,0)),"^",24) S IBCLOSE=1 G CLOSEDQ ; ur no longer required
;
; -- see if any reviews are still pending
S IBCLOSE=1,IBI=0 F S IBI=$O(^IBT(356.2,"C",+IBTRN,IBI)) Q:'IBI I $P(^IBT(356.2,IBI,0),"^",24)>IBEDT S IBCLOSE=0 Q
;
CLOSEDQ Q IBCLOSE
;
PREV ; -- previous case
Q:'$G(IBTPREV)
I $P(IBTRND,"^",4)!($P(IBTRND,"^",8))!($P(IBTRND,"^",9)) Q ; only count previous admissions
S IBCNT(9)=IBCNT(9)+1 ; number of previous cases
I 'IBCLOS S IBCNT(9,2)=IBCNT(9,2)+1 ; still open
I IBCLOS S IBCNT(9,$S($P(IBTRND,"^",19):1,1:0))=IBCNT(9,$S($P(IBTRND,"^",19):1,1:0))+1 ;closed and billable or not
Q
IBTOUR1 ;ALB/AAS - CLAIMS TRACKING UR/ACTIVITY REPORT ; 27-OCT-93
+1 ;;Version 2.0 ; INTEGRATED BILLING ;; 21-MAR-94
+2 ;
% ;
+1 ; ibcnt(1) = total count of admissions
+2 ; ibcnt(2) = total count of insured admissions
+3 ; ibcnt(3,0) = total count of billable admissions
+4 ; ibcnt(3,n) = count of non-billable admissions by reason (n)
+5 ; ibcnt(4) = count of admissions requiring reviews
+6 ; ibcnt(5) = admissions with pre-cert and follow-up
+7 ; ibcnt(6) = no pre-cert but active monitoring required
+8 ; ibcnt(7) = new closed cases = discharged, or no next rev. date, or ur not required
+9 ; ibcnt(7,0) = new cases closed, billable
+10 ; ibcnt(7,1) = new cases closed, not billable
+11 ; ibcnt(8) = new cases open (not closed)
+12 ;
+13 ; ibcnt(9) = previous case (find in REV), adm prior to begin date
+14 ; ibcnt(9,0) = cases closed billable
+15 ; ibcnt(9,1) = cases closed non-billable
+16 ; ibcnt(9,2) = previous cases still open
+17 ;
+18 ; ^tmp($j,"ibtour", $s(pt. name/specialty/review date) ,pt. name,sort3,ibtrc)=^ibt(ibtrc,0)
+19 ; ^tmp($j,"ibtour1",specialty)=days approved, days denied, $approved, $denied)
+20 ;
BLD ; -- build data
+1 ;initialize summary array
+2 FOR I=1:1:11
SET IBCNT(I)=0
IF I=7!(I=9)
FOR J=0:1:2
SET IBCNT(I,J)=0
+3 FOR I=40:1:52
SET IBCNT(I)=0
IF I=45
FOR J=1:1:3
SET IBCNT(I,J)=0
+4 ;
+5 DO ADM
+6 IF IBSORT'="H"
DO IREV^IBTOUR2
DO ISUB
+7 IF IBSORT'="I"
DO HREV^IBTOUR2
DO HSUB^IBTOUR5
+8 QUIT
+9 ;
ADM ; -- count admission
+1 DO CHK^IBTOSUM2
IF $GET(ZTSTOP)
QUIT
+2 SET IBDT=IBBDT-.000000001
+3 FOR
SET IBDT=$ORDER(^DGPM("AMV1",IBDT))
IF 'IBDT!(IBDT>(IBEDT+.24))
QUIT
Begin DoDot:1
+4 SET DFN=0
FOR
SET DFN=$ORDER(^DGPM("AMV1",IBDT,DFN))
IF 'DFN
QUIT
Begin DoDot:2
+5 SET DGPM=0
FOR
SET DGPM=$ORDER(^DGPM("AMV1",IBDT,DFN,DGPM))
IF 'DGPM
QUIT
Begin DoDot:3
+6 ; count of admissions
SET IBCNT(1)=IBCNT(1)+1
+7 SET IBTRN=$ORDER(^IBT(356,"AD",DGPM,0))
+8 IF 'IBTRN
QUIT
+9 SET IBTRND=$GET(^IBT(356,+IBTRN,0))
+10 IF '$PIECE(IBTRND,"^",20)
QUIT
+11 ;reviews required
SET X=$PIECE($GET(^IBT(356,+IBTRN,1)),"^",7)
IF X>3
SET IBCNT(4)=IBCNT(4)+1
SET ^TMP($JOB,"IBTOUR0",IBTRN)=IBTRN
+12 IF X=""
IF $PIECE(IBTRND,"^",24)
IF '$PIECE(IBTRND,"^",19)
SET IBCNT(4)=IBCNT(4)+1
SET ^TMP($JOB,"IBTOUR0",IBTRN)=IBTRN
+13 ;
+14 ; count of insured admissions
SET IBINS=$$INSURED^IBCNS1(DFN,IBDT)
IF IBINS
SET IBCNT(2)=IBCNT(2)+1
+15 ;count of NOT Billable by reason billable
IF IBINS
SET IBCNT(3,+$PIECE(IBTRND,"^",19))=$GET(IBCNT(3,+$PIECE(IBTRND,"^",19)))+1
End DoDot:3
End DoDot:2
End DoDot:1
+16 QUIT
+17 ;
ISUB ; -- count subtotals for cases reviewed
+1 NEW IBTRN,IBCLOS,DGPM,IBTPREV
+2 SET IBTRN=""
FOR
SET IBTRN=$ORDER(^TMP($JOB,"IBTOUR0",IBTRN))
IF 'IBTRN
QUIT
Begin DoDot:1
+3 SET IBTRND=$GET(^IBT(356,+IBTRN,0))
+4 ;inactive case
IF '$PIECE(IBTRND,"^",20)
QUIT
+5 ;rx fill, don't count
IF $PIECE(IBTRND,"^",8)
QUIT
+6 SET DGPM=$PIECE($GET(^IBT(356,+IBTRN,0)),"^",5)
+7 SET IBCLOS=$$CLOSED(DGPM,IBTRN)
+8 SET IBTPREV=0
IF $PIECE($GET(^IBT(356,+IBTRN,0)),"^",6)<IBBDT
SET IBTPREV=1
+9 IF $PIECE(IBTRND,"^",4)
SET IBCNT(10)=IBCNT(10)+1
+10 DO CASE
+11 QUIT
End DoDot:1
+12 QUIT
+13 ;
CASE ; -- figure out case summary
+1 NEW I,J,IBPRE,IBFOL
+2 IF IBTPREV
DO PREV
+3 SET (IBFOL,IBPRE)=0
+4 ; is precert number
IF $ORDER(^IBT(356.2,"APRE",IBTRN))'=""
SET IBPRE=1
+5 ; precert tracking type
SET IBPCODE=$ORDER(^IBE(356.11,"ACODE",10,0))
+6 ; cont. stay tracking type
SET IBCCODE=$ORDER(^IBE(356.11,"ACODE",30,0))
+7 ;
+8 IF 'IBPRE
SET IBTRC=$ORDER(^IBT(356.2,"ATRTP",IBTRN,IBPCODE,0))
IF IBTRC
IF $PIECE($GET(^IBT(356.2,+IBTRC,0)),"^",19)=10
SET IBPRE=1
+9 ;
+10 SET IBX=$PIECE($GET(^IBT(356,+IBTRN,1)),"^",7)
IF 'IBX
Begin DoDot:1
+11 IF $ORDER(^IBT(356.2,"ATRTP",IBTRN,IBCCODE,0))
SET IBFOL=1
+12 ; adm with precert and follow up
IF IBPRE
IF IBFOL
SET IBCNT(5)=IBCNT(5)+1
+13 ; adm w/o precert but cont. monitor
IF 'IBPRE
IF IBFOL
SET IBCNT(6)=IBCNT(6)+1
End DoDot:1
+14 IF IBX>4
SET IBCNT(5)=IBCNT(5)+1
+15 IF IBX=4
SET IBCNT(6)=IBCNT(6)=1
+16 ;
+17 IF IBCLOS
SET IBCNT(7,$SELECT($PIECE(IBTRND,"^",19):1,1:0))=IBCNT(7,$SELECT($PIECE(IBTRND,"^",19):1,1:0))+1
SET IBCNT(7)=IBCNT(7)+1
+18 ;
+19 ; new case rev not required, but done.
IF 'IBTPREV
SET IBX=$PIECE($GET(^IBT(356,+IBTRN,1)),"^",7)
IF IBX
IF IBX<4
SET IBCNT(4)=IBCNT(4)+1
+20 ;
+21 ;new cases still open
IF 'IBCLOS
IF 'IBTPREV
SET IBCNT(8)=IBCNT(8)+1
+22 IF '$PIECE(IBTRND,"^",5)
IF $PIECE(^IBE(356.6,+$PIECE(IBTRND,"^",18),0),"^",8)=5
SET IBCNT(11)=IBCNT(11)+1
CASEQ QUIT
+1 ;
CLOSED(DGPM,IBTRN) ; -- is case closed
+1 NEW IBI,IBJ,IBCLOSE
+2 SET IBCLOSE=0
+3 ; - discharged
IF $PIECE($GET(^DGPM(+DGPM,0)),"^",17)
SET IBCLOSE=1
GOTO CLOSEDQ
+4 ; ur no longer required
IF '$PIECE($GET(^IBT(356,+IBTRN,0)),"^",24)
SET IBCLOSE=1
GOTO CLOSEDQ
+5 ;
+6 ; -- see if any reviews are still pending
+7 SET IBCLOSE=1
SET IBI=0
FOR
SET IBI=$ORDER(^IBT(356.2,"C",+IBTRN,IBI))
IF 'IBI
QUIT
IF $PIECE(^IBT(356.2,IBI,0),"^",24)>IBEDT
SET IBCLOSE=0
QUIT
+8 ;
CLOSEDQ QUIT IBCLOSE
+1 ;
PREV ; -- previous case
+1 IF '$GET(IBTPREV)
QUIT
+2 ; only count previous admissions
IF $PIECE(IBTRND,"^",4)!($PIECE(IBTRND,"^",8))!($PIECE(IBTRND,"^",9))
QUIT
+3 ; number of previous cases
SET IBCNT(9)=IBCNT(9)+1
+4 ; still open
IF 'IBCLOS
SET IBCNT(9,2)=IBCNT(9,2)+1
+5 ;closed and billable or not
IF IBCLOS
SET IBCNT(9,$SELECT($PIECE(IBTRND,"^",19):1,1:0))=IBCNT(9,$SELECT($PIECE(IBTRND,"^",19):1,1:0))+1
+6 QUIT
