IBTOUR4 ;ALB/AAS - CLAIMS TRACKING UR ACTIVITY REPORT ; 27-OCT-93
;;Version 2.0 ; INTEGRATED BILLING ;; 21-MAR-94
;
% I '$D(DT) D DT^DICRW
INS ; -- print data
; -- ^tmp($j,"ibtour",primary sort,secondary sort,patient, ibtrc)=ibtrcd
;
N IBCNT
D HDR
I $O(^TMP($J,"IBTOUR",""))="" W !!,"No Insurance Reviews Found in Date Range." G PRINTQ
;
S IBH="" F S IBH=$O(^TMP($J,"IBTOUR",IBH)) Q:IBH=""!(IBQUIT) D
.D SUBHDR^IBTOUR5
.S IBI="" F S IBI=$O(^TMP($J,"IBTOUR",IBH,IBI)) Q:IBI=""!(IBQUIT) D
..D SSUBHDR^IBTOUR5
..S IBJ="" F S IBJ=$O(^TMP($J,"IBTOUR",IBH,IBI,IBJ)) Q:IBJ=""!(IBQUIT) D
...S IBTRC="" F S IBTRC=$O(^TMP($J,"IBTOUR",IBH,IBI,IBJ,IBTRC)) Q:IBTRC=""!(IBQUIT) S IBTRCD=^(IBTRC) D ONE
;
PRINTQ I 'IBQUIT,$E(IOST,1,2)="C-" D PAUSE^VALM1 I $D(DIRUT) S IBQUIT=1
Q
;
ONE ; -- print one entry
; -- ^tmp($j,"ibtour",primary sort,secondary sort,ibtrc)=^IBT(IBTRC)
;
S IBAPL=$$APPEAL^IBTODD1(IBTRC)
;
I IOSL<($Y+4) D HDR Q:IBQUIT
S DFN=+$P(IBTRCD,"^",5) D PID^VADPT
S IBTRCD=$G(^IBT(356.2,+IBTRC,0))
L1 W !,$E($P(^DPT(DFN,0),"^"),1,22),?25,VA("PID")
S IBCDT=$$CDT^IBTODD1($P(IBTRCD,"^",2))
W ?38,$$DAT1^IBOUTL(+IBCDT\1) W:$P(IBCDT,"^",2) " to"
W ?50,$P($G(^IBE(356.11,+$P(IBTRCD,"^",4),0)),"^",3) ;review type abbrev
W ?64,$$DAT1^IBOUTL(+IBTRCD) ;review date
W ?78,$E($$EXPAND^IBTRE(356.2,.08,$P(IBTRCD,"^",8)),1,20) ; ins co
W ?100,$E($$EXPAND^IBTRE(356.2,.11,$P(IBTRCD,"^",11)),1,10) ;ins co action
W ?112,$E($$EXPAND^IBTRE(356.2,1.04,$P($G(^IBT(356.2,+IBTRC,1)),"^",4)),1,19) ; last reviewer
;
L2 W !?38,$$DAT1^IBOUTL($P(IBCDT,"^",2)\1,"2P")
Q
;
HDR ; -- Print header for billing report
Q:IBQUIT
I $E(IOST,1,2)="C-",IBPAG D PAUSE^VALM1 I $D(DIRUT) S IBQUIT=1 Q
I $E(IOST,1,2)="C-"!(IBPAG) W @IOF
S IBPAG=IBPAG+1
W !,"UR Insurance Review Activity Report",?(IOM-33),"Page ",IBPAG," ",IBHDT
W !,"For Insurance Reviews Dated ",$$DAT1^IBOUTL(IBBDT)," to ",$$DAT1^IBOUTL(IBEDT)
W !!,?38,"Dates of",?64,"Review"
W !,"Patient",?25,"Pt. ID",?38,"Care",?50,"Review Type",?64,"Date",?78,"Ins. Co.",?100," Action",?112,"Last Reviewer"
W !,$TR($J(" ",IOM)," ","-")
Q
;
HOSP ; -- print hospital report
N IBCNT
D HHDR
I $O(^TMP($J,"IBTOUR3",""))="" W !!,"No Hospital Reviews Found in Date Range." G HOSPQ
;
S IBH="" F S IBH=$O(^TMP($J,"IBTOUR3",IBH)) Q:IBH=""!(IBQUIT) D
.D SUBHDR^IBTOUR5
.S IBI="" F S IBI=$O(^TMP($J,"IBTOUR3",IBH,IBI)) Q:IBI=""!(IBQUIT) D
..D SSUBHDR^IBTOUR5
..S IBJ="" F S IBJ=$O(^TMP($J,"IBTOUR3",IBH,IBI,IBJ)) Q:IBJ=""!(IBQUIT) D
...S IBTRN="" F S IBTRN=$O(^TMP($J,"IBTOUR3",IBH,IBI,IBJ,IBTRN)) Q:IBTRN=""!(IBQUIT) S IBDATA=^(IBTRN) D HOSPONE
;
HOSPQ I 'IBQUIT,$E(IOST,1,2)="C-" D PAUSE^VALM1 I $D(DIRUT) S IBQUIT=1
Q
;
HOSPONE ; -print one case line
I IOSL<($Y+4) D HHDR Q:IBQUIT
S IBTRND=$G(^IBT(356,+IBTRN,0))
S DFN=+$P(IBTRND,"^",2) D PID^VADPT
HL1 W !,$E($P(^DPT(DFN,0),"^"),1,22),?25,VA("PID")
S IBCDT=$$CDT^IBTODD1(IBTRN)
W ?38,$$DAT1^IBOUTL(+IBCDT\1) W:$P(IBCDT,"^",2) " to"
S TYPE="" I $P(IBTRND,"^",25) S TYPE="RANDOM"
I $P(IBTRND,"^",26) S:$L(TYPE) TYPE=TYPE_"/" S TYPE=TYPE_$$EXPAND^IBTRE(356,.26,$P(IBTRND,"^",26))
I $P(IBTRND,"^",27) S:$L(TYPE) TYPE=TYPE_"/LOCAL"
W ?51,TYPE
W ?70,$S($P(IBDATA,"^"):"YES",$P(IBDATA,"^")=0:"NO",1:"")
W ?84,$J($P(IBDATA,"^",2),8)
W ?98,$J($P(IBDATA,"^",3),8)
;
W ?112,$E($$EXPAND^IBTRE(356,1.05,$P($G(^IBT(356,+IBTRN,1)),"^",5)),1,19) ; last reviewer
;
HL2 I $P(IBCDT,"^",2)'="" W !?38,$$DAT1^IBOUTL($P(IBCDT,"^",2)\1,"2P")
W ! Q
;
HHDR ; -- hospital review header
Q:IBQUIT
I $E(IOST,1,2)="C-",IBPAG D PAUSE^VALM1 I $D(DIRUT) S IBQUIT=1 Q
I $E(IOST,1,2)="C-"!(IBPAG) W @IOF
S IBPAG=IBPAG+1
W !,"UR Hospital Review Activity Report",?(IOM-33),"Page ",IBPAG," ",IBHDT
W !,"For Hospital Reviews Dated ",$$DAT1^IBOUTL(IBBDT)," to ",$$DAT1^IBOUTL(IBEDT)
W !!,?38,"Dates of",?69,"Admission",?84,"Days Met",?98,"Days Not Met"
W !,"Patient",?25,"Pt. ID",?38,"Care",?51,"Review Type",?69,"Met Criteria",?84,"Criteria",?98,"Criteria",?112,"Assigned Reviewer"
W !,$TR($J(" ",IOM)," ","-")
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HIBTOUR4 4132 printed Sep 23, 2025@20:03:50 Page 2
IBTOUR4 ;ALB/AAS - CLAIMS TRACKING UR ACTIVITY REPORT ; 27-OCT-93
+1 ;;Version 2.0 ; INTEGRATED BILLING ;; 21-MAR-94
+2 ;
% IF '$DATA(DT)
DO DT^DICRW
INS ; -- print data
+1 ; -- ^tmp($j,"ibtour",primary sort,secondary sort,patient, ibtrc)=ibtrcd
+2 ;
+3 NEW IBCNT
+4 DO HDR
+5 IF $ORDER(^TMP($JOB,"IBTOUR",""))=""
WRITE !!,"No Insurance Reviews Found in Date Range."
GOTO PRINTQ
+6 ;
+7 SET IBH=""
FOR
SET IBH=$ORDER(^TMP($JOB,"IBTOUR",IBH))
if IBH=""!(IBQUIT)
QUIT
Begin DoDot:1
+8 DO SUBHDR^IBTOUR5
+9 SET IBI=""
FOR
SET IBI=$ORDER(^TMP($JOB,"IBTOUR",IBH,IBI))
if IBI=""!(IBQUIT)
QUIT
Begin DoDot:2
+10 DO SSUBHDR^IBTOUR5
+11 SET IBJ=""
FOR
SET IBJ=$ORDER(^TMP($JOB,"IBTOUR",IBH,IBI,IBJ))
if IBJ=""!(IBQUIT)
QUIT
Begin DoDot:3
+12 SET IBTRC=""
FOR
SET IBTRC=$ORDER(^TMP($JOB,"IBTOUR",IBH,IBI,IBJ,IBTRC))
if IBTRC=""!(IBQUIT)
QUIT
SET IBTRCD=^(IBTRC)
DO ONE
End DoDot:3
End DoDot:2
End DoDot:1
+13 ;
PRINTQ IF 'IBQUIT
IF $EXTRACT(IOST,1,2)="C-"
DO PAUSE^VALM1
IF $DATA(DIRUT)
SET IBQUIT=1
+1 QUIT
+2 ;
ONE ; -- print one entry
+1 ; -- ^tmp($j,"ibtour",primary sort,secondary sort,ibtrc)=^IBT(IBTRC)
+2 ;
+3 SET IBAPL=$$APPEAL^IBTODD1(IBTRC)
+4 ;
+5 IF IOSL<($Y+4)
DO HDR
if IBQUIT
QUIT
+6 SET DFN=+$PIECE(IBTRCD,"^",5)
DO PID^VADPT
+7 SET IBTRCD=$GET(^IBT(356.2,+IBTRC,0))
L1 WRITE !,$EXTRACT($PIECE(^DPT(DFN,0),"^"),1,22),?25,VA("PID")
+1 SET IBCDT=$$CDT^IBTODD1($PIECE(IBTRCD,"^",2))
+2 WRITE ?38,$$DAT1^IBOUTL(+IBCDT\1)
if $PIECE(IBCDT,"^",2)
WRITE " to"
+3 ;review type abbrev
WRITE ?50,$PIECE($GET(^IBE(356.11,+$PIECE(IBTRCD,"^",4),0)),"^",3)
+4 ;review date
WRITE ?64,$$DAT1^IBOUTL(+IBTRCD)
+5 ; ins co
WRITE ?78,$EXTRACT($$EXPAND^IBTRE(356.2,.08,$PIECE(IBTRCD,"^",8)),1,20)
+6 ;ins co action
WRITE ?100,$EXTRACT($$EXPAND^IBTRE(356.2,.11,$PIECE(IBTRCD,"^",11)),1,10)
+7 ; last reviewer
WRITE ?112,$EXTRACT($$EXPAND^IBTRE(356.2,1.04,$PIECE($GET(^IBT(356.2,+IBTRC,1)),"^",4)),1,19)
+8 ;
L2 WRITE !?38,$$DAT1^IBOUTL($PIECE(IBCDT,"^",2)\1,"2P")
+1 QUIT
+2 ;
HDR ; -- Print header for billing report
+1 if IBQUIT
QUIT
+2 IF $EXTRACT(IOST,1,2)="C-"
IF IBPAG
DO PAUSE^VALM1
IF $DATA(DIRUT)
SET IBQUIT=1
QUIT
+3 IF $EXTRACT(IOST,1,2)="C-"!(IBPAG)
WRITE @IOF
+4 SET IBPAG=IBPAG+1
+5 WRITE !,"UR Insurance Review Activity Report",?(IOM-33),"Page ",IBPAG," ",IBHDT
+6 WRITE !,"For Insurance Reviews Dated ",$$DAT1^IBOUTL(IBBDT)," to ",$$DAT1^IBOUTL(IBEDT)
+7 WRITE !!,?38,"Dates of",?64,"Review"
+8 WRITE !,"Patient",?25,"Pt. ID",?38,"Care",?50,"Review Type",?64,"Date",?78,"Ins. Co.",?100," Action",?112,"Last Reviewer"
+9 WRITE !,$TRANSLATE($JUSTIFY(" ",IOM)," ","-")
+10 QUIT
+11 ;
HOSP ; -- print hospital report
+1 NEW IBCNT
+2 DO HHDR
+3 IF $ORDER(^TMP($JOB,"IBTOUR3",""))=""
WRITE !!,"No Hospital Reviews Found in Date Range."
GOTO HOSPQ
+4 ;
+5 SET IBH=""
FOR
SET IBH=$ORDER(^TMP($JOB,"IBTOUR3",IBH))
if IBH=""!(IBQUIT)
QUIT
Begin DoDot:1
+6 DO SUBHDR^IBTOUR5
+7 SET IBI=""
FOR
SET IBI=$ORDER(^TMP($JOB,"IBTOUR3",IBH,IBI))
if IBI=""!(IBQUIT)
QUIT
Begin DoDot:2
+8 DO SSUBHDR^IBTOUR5
+9 SET IBJ=""
FOR
SET IBJ=$ORDER(^TMP($JOB,"IBTOUR3",IBH,IBI,IBJ))
if IBJ=""!(IBQUIT)
QUIT
Begin DoDot:3
+10 SET IBTRN=""
FOR
SET IBTRN=$ORDER(^TMP($JOB,"IBTOUR3",IBH,IBI,IBJ,IBTRN))
if IBTRN=""!(IBQUIT)
QUIT
SET IBDATA=^(IBTRN)
DO HOSPONE
End DoDot:3
End DoDot:2
End DoDot:1
+11 ;
HOSPQ IF 'IBQUIT
IF $EXTRACT(IOST,1,2)="C-"
DO PAUSE^VALM1
IF $DATA(DIRUT)
SET IBQUIT=1
+1 QUIT
+2 ;
HOSPONE ; -print one case line
+1 IF IOSL<($Y+4)
DO HHDR
if IBQUIT
QUIT
+2 SET IBTRND=$GET(^IBT(356,+IBTRN,0))
+3 SET DFN=+$PIECE(IBTRND,"^",2)
DO PID^VADPT
HL1 WRITE !,$EXTRACT($PIECE(^DPT(DFN,0),"^"),1,22),?25,VA("PID")
+1 SET IBCDT=$$CDT^IBTODD1(IBTRN)
+2 WRITE ?38,$$DAT1^IBOUTL(+IBCDT\1)
if $PIECE(IBCDT,"^",2)
WRITE " to"
+3 SET TYPE=""
IF $PIECE(IBTRND,"^",25)
SET TYPE="RANDOM"
+4 IF $PIECE(IBTRND,"^",26)
if $LENGTH(TYPE)
SET TYPE=TYPE_"/"
SET TYPE=TYPE_$$EXPAND^IBTRE(356,.26,$PIECE(IBTRND,"^",26))
+5 IF $PIECE(IBTRND,"^",27)
if $LENGTH(TYPE)
SET TYPE=TYPE_"/LOCAL"
+6 WRITE ?51,TYPE
+7 WRITE ?70,$SELECT($PIECE(IBDATA,"^"):"YES",$PIECE(IBDATA,"^")=0:"NO",1:"")
+8 WRITE ?84,$JUSTIFY($PIECE(IBDATA,"^",2),8)
+9 WRITE ?98,$JUSTIFY($PIECE(IBDATA,"^",3),8)
+10 ;
+11 ; last reviewer
WRITE ?112,$EXTRACT($$EXPAND^IBTRE(356,1.05,$PIECE($GET(^IBT(356,+IBTRN,1)),"^",5)),1,19)
+12 ;
HL2 IF $PIECE(IBCDT,"^",2)'=""
WRITE !?38,$$DAT1^IBOUTL($PIECE(IBCDT,"^",2)\1,"2P")
+1 WRITE !
QUIT
+2 ;
HHDR ; -- hospital review header
+1 if IBQUIT
QUIT
+2 IF $EXTRACT(IOST,1,2)="C-"
IF IBPAG
DO PAUSE^VALM1
IF $DATA(DIRUT)
SET IBQUIT=1
QUIT
+3 IF $EXTRACT(IOST,1,2)="C-"!(IBPAG)
WRITE @IOF
+4 SET IBPAG=IBPAG+1
+5 WRITE !,"UR Hospital Review Activity Report",?(IOM-33),"Page ",IBPAG," ",IBHDT
+6 WRITE !,"For Hospital Reviews Dated ",$$DAT1^IBOUTL(IBBDT)," to ",$$DAT1^IBOUTL(IBEDT)
+7 WRITE !!,?38,"Dates of",?69,"Admission",?84,"Days Met",?98,"Days Not Met"
+8 WRITE !,"Patient",?25,"Pt. ID",?38,"Care",?51,"Review Type",?69,"Met Criteria",?84,"Criteria",?98,"Criteria",?112,"Assigned Reviewer"
+9 WRITE !,$TRANSLATE($JUSTIFY(" ",IOM)," ","-")
+10 QUIT
