IBTOSUM2 ;ALB/AAS - CLAIMS TRACKING BILLING INFORMATION PRINT ; 29-OCT-93
;;2.0;INTEGRATED BILLING;**118**;21-MAR-94
;
PRINT ; - Print the report.
K X,X2,X3
D HDR,MAIN,PENAL
I $O(IBCNT(3,0)) D RNB
I $O(IBCNT(10,0)) D APPROV
I $O(IBCNT(20,0)) D DENIAL
Q
;
MAIN ; - Print main body of report.
S IBPER(1)=$J($S('IBCNT(2):0,1:IBCNT(2)/IBCNT(1)*100),0,2)
S IBPER(2)=$J($S('IBCNT(3,0):0,1:+IBCNT(3,0)/IBCNT(1)*100),0,2)
S IBPER(3)=$J($S('IBCNT(4):0,1:IBCNT(4)/IBCNT(1)*100),0,2)
S IBPER(4)=$J($S('IBCNT(99):0,1:IBCNT(99)/IBCNT(1)*100),0,2)
S IBPER(5)=$J($S('IBCNT(13):0,1:IBCNT(13)/IBCNT(1)*100),0,2)
W !?((IOM/2)-16),"Total ",$S(IBSORT="A":"Admissions",1:"Discharges"),": ",$J(IBCNT(1),11)
W !?((IOM/2)-31),"Total ",$S(IBSORT="A":"Admissions",1:"Discharges")," with Insurance: ",$J(IBCNT(2),11)," (",IBPER(1),"%)"
W !?((IOM/2)-25),"Total Billable ",$S(IBSORT="A":"Admissions",1:"Discharges"),": ",$J(+$G(IBCNT(3,0)),11)," (",IBPER(2),"%)"
;
W !?((IOM/2)-34),"Total ",$S(IBSORT="A":"Admissions",1:"Discharges")," Requiring Reviews: ",$J(IBCNT(4),11)," (",IBPER(3),"%)"
W !?((IOM/2)-25),"Total ",$S(IBSORT="A":"Admissions",1:"Discharges")," Reviewed: ",$J(IBCNT(99),11)," (",IBPER(4),"%)"
W !?((IOM/2)-39),"Total ",$S(IBSORT="A":"Admissions",1:"Discharges")," Reviewed-Multi Carrier: ",$J(IBCNT(13),11)," (",IBPER(5),"%)"
;
I $E(IOST,1,2)="C-" W ! D PAUSE^VALM1 Q:$D(DIRUT) W @IOF
;
W !!?((IOM/2)-18),"Total Reviews Done: ",$J(IBCNT(5),11)
W !?((IOM/2)-23),"Number of Days Approved: ",$J(IBCNT(10),11)
S X=IBCNT(11),X2="0$" D COMMA^%DTC
W !?((IOM/2)-39),"Amount Collectible Approved for Billing: ",X
;
W !!?((IOM/2)-21),"Number of Days Denied: ",$J(IBCNT(20),11)
S X=IBCNT(21),X2="0$" D COMMA^%DTC
W !?((IOM/2)-25),"Amount Denied for Billing: ",X
;
W !!?((IOM/2)-20),"Total Cases Appealed: ",$J(IBCNT(80),11)
W !?((IOM/2)-25),"Number of Initial Appeals: ",$J(IBCNT(81),11)
W !?((IOM/2)-28),"Number of Subsequent Appeals: ",$J(IBCNT(82),11)
;
Q
;
PENAL ; -- penalty codes; variable; external form
; 1; IBCNT(31); NO PRE ADMISSION CERTIFICATION
; 2; IBCNT(32); UNTIMELY PRE ADMISSION CERTIFICATION
; 3; IBCNT(33); VA A NON-PROVIDER
;
W !!!?((IOM/2)-14),"Penalty Report: Number of cases Dollars"
W !?((IOM/2)-14),"--------------- ------------------------------------"
W !?((IOM/2)-30),"No Pre Admission Certification: ",$J($P(IBCNT(31),U),10)," " S X=+$P(IBCNT(31),U,2),X3=9,X2="0$" D COMMA^%DTC W X
W !?((IOM/2)-36),"Untimely Pre Admission Certification: ",$J($P(IBCNT(32),U),10)," " S X=+$P(IBCNT(32),U,2),X3=9,X2="0$" D COMMA^%DTC W X
W !?((IOM/2)-17),"VA a Non-Provider: ",$J($P(IBCNT(33),U),10)," " S X=+$P(IBCNT(33),U,2),X3=9,X2="0$" D COMMA^%DTC W X
Q
;
RNB ; -- print reasons not billable
D CNT(3)
W !!!?((IOM/2)-26),"Reason Not Billable Report: Reason Count"
W !?((IOM/2)-26),"--------------------------- ------------------------------------"
S I=0 F S I=$O(IBCNT(3,I)) Q:'I D
.W !?((IOM/2)+3),$E($P($G(^IBE(356.8,+I,0)),U),1,20)
.W ?((IOM/2)+24),$J(IBCNT(3,I),6)
.W " (",$J(IBCNT(3,I)/IBCNT(3,"NB")*100,0,2),"%)"
;
W !?((IOM/2)+23),"-------"
W !?((IOM/2)+3),"Total:",?((IOM/2)+23),$J(IBCNT(3,"NB"),7)
Q
;
;
DENIAL ; -- print days denied by specialty
D CNT(20)
W !!!?((IOM/2)-24),"Days Denied by Specialty: Specialty No. Days Dollars"
W !?((IOM/2)-24),"------------------------- ------------------------------------"
S I=0 F S I=$O(IBCNT(20,I)) Q:'I D
.W !?((IOM/2)+3),$E($P($G(^DIC(45.7,+I,0)),U)_" ",1,16)
.W ?((IOM/2)+20)," ",$J(IBCNT(20,I),6)
.S X=IBCNT(21,I),X2="0$" D COMMA^%DTC
.W ?((IOM/2)+30)," ",X
Q
;
;
APPROV ; -- print days approved by specialty
D CNT(10)
W !!!?((IOM/2)-26),"Days Approved by Specialty: Specialty No. Days Dollars"
W !?((IOM/2)-26),"--------------------------- ------------------------------------"
S I=0 F S I=$O(IBCNT(10,I)) Q:'I D
.W !?((IOM/2)+3),$E($P($G(^DIC(45.7,+I,0)),U)_" ",1,16)
.W ?((IOM/2)+20)," ",$J(IBCNT(10,I),6)
.S X=IBCNT(11,I),X2="0$" D COMMA^%DTC
.W ?((IOM/2)+30)," ",X
;
Q
;
HDR ; -- print report header
W:$E(IOST,1,2)["C-"!(IBPAG>0) @IOF
W !?((IOM-22)/2),"MCCR/UR SUMMARY REPORT"
W !?((IOM-3)/2),"for"
D SITE^IBAUTL S IBSNM=$S($D(^DIC(4,IBFAC,0)):$P(^(0),U),1:"")
W !?((IOM-($L(IBSNM)+6))/2),IBSNM_" ("_IBSITE_")"
W !!?((IOM-14)/2),"for "_$S(IBSORT="A":"Admissions",1:"Discharges")
W !?(IOM-18/2),"From: " S Y=IBBDT D DT^DIQ
W !?((IOM-16)/2)," To: " S Y=IBEDT D DT^DIQ
W !!?(IOM-26/2),"Date Printed: ",IBHDT
S IBPAG=IBPAG+1 W !?(IOM-8/2),"Page: ",IBPAG
W !?(IOM-26/2),"--------------------------",!!
Q
;
CHK ; -- check task man stop flag
I $D(ZTQUEUED),$$S^%ZTLOAD S ZTSTOP=1 D HDR W !!,"....task stopped at user request."
Q
;
CNT(N) ; -- see if enought room on page for list
Q:'$G(N)
S (IBC,I)=0 F S I=$O(IBCNT(N,I)) Q:'I S IBC=IBC+1
I IOSL<($Y+IBC+3),$E(IOST,1,2)="C-" D PAUSE^VALM1 S:$D(DIRUT) IBQUIT=1 W:'IBQUIT @IOF Q
I IOSL<($Y+IBC+3) D HDR
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HIBTOSUM2 5172 printed Dec 13, 2024@02:27:24 Page 2
IBTOSUM2 ;ALB/AAS - CLAIMS TRACKING BILLING INFORMATION PRINT ; 29-OCT-93
+1 ;;2.0;INTEGRATED BILLING;**118**;21-MAR-94
+2 ;
PRINT ; - Print the report.
+1 KILL X,X2,X3
+2 DO HDR
DO MAIN
DO PENAL
+3 IF $ORDER(IBCNT(3,0))
DO RNB
+4 IF $ORDER(IBCNT(10,0))
DO APPROV
+5 IF $ORDER(IBCNT(20,0))
DO DENIAL
+6 QUIT
+7 ;
MAIN ; - Print main body of report.
+1 SET IBPER(1)=$JUSTIFY($SELECT('IBCNT(2):0,1:IBCNT(2)/IBCNT(1)*100),0,2)
+2 SET IBPER(2)=$JUSTIFY($SELECT('IBCNT(3,0):0,1:+IBCNT(3,0)/IBCNT(1)*100),0,2)
+3 SET IBPER(3)=$JUSTIFY($SELECT('IBCNT(4):0,1:IBCNT(4)/IBCNT(1)*100),0,2)
+4 SET IBPER(4)=$JUSTIFY($SELECT('IBCNT(99):0,1:IBCNT(99)/IBCNT(1)*100),0,2)
+5 SET IBPER(5)=$JUSTIFY($SELECT('IBCNT(13):0,1:IBCNT(13)/IBCNT(1)*100),0,2)
+6 WRITE !?((IOM/2)-16),"Total ",$SELECT(IBSORT="A":"Admissions",1:"Discharges"),": ",$JUSTIFY(IBCNT(1),11)
+7 WRITE !?((IOM/2)-31),"Total ",$SELECT(IBSORT="A":"Admissions",1:"Discharges")," with Insurance: ",$JUSTIFY(IBCNT(2),11)," (",IBPER(1),"%)"
+8 WRITE !?((IOM/2)-25),"Total Billable ",$SELECT(IBSORT="A":"Admissions",1:"Discharges"),": ",$JUSTIFY(+$GET(IBCNT(3,0)),11)," (",IBPER(2),"%)"
+9 ;
+10 WRITE !?((IOM/2)-34),"Total ",$SELECT(IBSORT="A":"Admissions",1:"Discharges")," Requiring Reviews: ",$JUSTIFY(IBCNT(4),11)," (",IBPER(3),"%)"
+11 WRITE !?((IOM/2)-25),"Total ",$SELECT(IBSORT="A":"Admissions",1:"Discharges")," Reviewed: ",$JUSTIFY(IBCNT(99),11)," (",IBPER(4),"%)"
+12 WRITE !?((IOM/2)-39),"Total ",$SELECT(IBSORT="A":"Admissions",1:"Discharges")," Reviewed-Multi Carrier: ",$JUSTIFY(IBCNT(13),11)," (",IBPER(5),"%)"
+13 ;
+14 IF $EXTRACT(IOST,1,2)="C-"
WRITE !
DO PAUSE^VALM1
if $DATA(DIRUT)
QUIT
WRITE @IOF
+15 ;
+16 WRITE !!?((IOM/2)-18),"Total Reviews Done: ",$JUSTIFY(IBCNT(5),11)
+17 WRITE !?((IOM/2)-23),"Number of Days Approved: ",$JUSTIFY(IBCNT(10),11)
+18 SET X=IBCNT(11)
SET X2="0$"
DO COMMA^%DTC
+19 WRITE !?((IOM/2)-39),"Amount Collectible Approved for Billing: ",X
+20 ;
+21 WRITE !!?((IOM/2)-21),"Number of Days Denied: ",$JUSTIFY(IBCNT(20),11)
+22 SET X=IBCNT(21)
SET X2="0$"
DO COMMA^%DTC
+23 WRITE !?((IOM/2)-25),"Amount Denied for Billing: ",X
+24 ;
+25 WRITE !!?((IOM/2)-20),"Total Cases Appealed: ",$JUSTIFY(IBCNT(80),11)
+26 WRITE !?((IOM/2)-25),"Number of Initial Appeals: ",$JUSTIFY(IBCNT(81),11)
+27 WRITE !?((IOM/2)-28),"Number of Subsequent Appeals: ",$JUSTIFY(IBCNT(82),11)
+28 ;
+29 QUIT
+30 ;
PENAL ; -- penalty codes; variable; external form
+1 ; 1; IBCNT(31); NO PRE ADMISSION CERTIFICATION
+2 ; 2; IBCNT(32); UNTIMELY PRE ADMISSION CERTIFICATION
+3 ; 3; IBCNT(33); VA A NON-PROVIDER
+4 ;
+5 WRITE !!!?((IOM/2)-14),"Penalty Report: Number of cases Dollars"
+6 WRITE !?((IOM/2)-14),"--------------- ------------------------------------"
+7 WRITE !?((IOM/2)-30),"No Pre Admission Certification: ",$JUSTIFY($PIECE(IBCNT(31),U),10)," "
SET X=+$PIECE(IBCNT(31),U,2)
SET X3=9
SET X2="0$"
DO COMMA^%DTC
WRITE X
+8 WRITE !?((IOM/2)-36),"Untimely Pre Admission Certification: ",$JUSTIFY($PIECE(IBCNT(32),U),10)," "
SET X=+$PIECE(IBCNT(32),U,2)
SET X3=9
SET X2="0$"
DO COMMA^%DTC
WRITE X
+9 WRITE !?((IOM/2)-17),"VA a Non-Provider: ",$JUSTIFY($PIECE(IBCNT(33),U),10)," "
SET X=+$PIECE(IBCNT(33),U,2)
SET X3=9
SET X2="0$"
DO COMMA^%DTC
WRITE X
+10 QUIT
+11 ;
RNB ; -- print reasons not billable
+1 DO CNT(3)
+2 WRITE !!!?((IOM/2)-26),"Reason Not Billable Report: Reason Count"
+3 WRITE !?((IOM/2)-26),"--------------------------- ------------------------------------"
+4 SET I=0
FOR
SET I=$ORDER(IBCNT(3,I))
if 'I
QUIT
Begin DoDot:1
+5 WRITE !?((IOM/2)+3),$EXTRACT($PIECE($GET(^IBE(356.8,+I,0)),U),1,20)
+6 WRITE ?((IOM/2)+24),$JUSTIFY(IBCNT(3,I),6)
+7 WRITE " (",$JUSTIFY(IBCNT(3,I)/IBCNT(3,"NB")*100,0,2),"%)"
End DoDot:1
+8 ;
+9 WRITE !?((IOM/2)+23),"-------"
+10 WRITE !?((IOM/2)+3),"Total:",?((IOM/2)+23),$JUSTIFY(IBCNT(3,"NB"),7)
+11 QUIT
+12 ;
+13 ;
DENIAL ; -- print days denied by specialty
+1 DO CNT(20)
+2 WRITE !!!?((IOM/2)-24),"Days Denied by Specialty: Specialty No. Days Dollars"
+3 WRITE !?((IOM/2)-24),"------------------------- ------------------------------------"
+4 SET I=0
FOR
SET I=$ORDER(IBCNT(20,I))
if 'I
QUIT
Begin DoDot:1
+5 WRITE !?((IOM/2)+3),$EXTRACT($PIECE($GET(^DIC(45.7,+I,0)),U)_" ",1,16)
+6 WRITE ?((IOM/2)+20)," ",$JUSTIFY(IBCNT(20,I),6)
+7 SET X=IBCNT(21,I)
SET X2="0$"
DO COMMA^%DTC
+8 WRITE ?((IOM/2)+30)," ",X
End DoDot:1
+9 QUIT
+10 ;
+11 ;
APPROV ; -- print days approved by specialty
+1 DO CNT(10)
+2 WRITE !!!?((IOM/2)-26),"Days Approved by Specialty: Specialty No. Days Dollars"
+3 WRITE !?((IOM/2)-26),"--------------------------- ------------------------------------"
+4 SET I=0
FOR
SET I=$ORDER(IBCNT(10,I))
if 'I
QUIT
Begin DoDot:1
+5 WRITE !?((IOM/2)+3),$EXTRACT($PIECE($GET(^DIC(45.7,+I,0)),U)_" ",1,16)
+6 WRITE ?((IOM/2)+20)," ",$JUSTIFY(IBCNT(10,I),6)
+7 SET X=IBCNT(11,I)
SET X2="0$"
DO COMMA^%DTC
+8 WRITE ?((IOM/2)+30)," ",X
End DoDot:1
+9 ;
+10 QUIT
+11 ;
HDR ; -- print report header
+1 if $EXTRACT(IOST,1,2)["C-"!(IBPAG>0)
WRITE @IOF
+2 WRITE !?((IOM-22)/2),"MCCR/UR SUMMARY REPORT"
+3 WRITE !?((IOM-3)/2),"for"
+4 DO SITE^IBAUTL
SET IBSNM=$SELECT($DATA(^DIC(4,IBFAC,0)):$PIECE(^(0),U),1:"")
+5 WRITE !?((IOM-($LENGTH(IBSNM)+6))/2),IBSNM_" ("_IBSITE_")"
+6 WRITE !!?((IOM-14)/2),"for "_$SELECT(IBSORT="A":"Admissions",1:"Discharges")
+7 WRITE !?(IOM-18/2),"From: "
SET Y=IBBDT
DO DT^DIQ
+8 WRITE !?((IOM-16)/2)," To: "
SET Y=IBEDT
DO DT^DIQ
+9 WRITE !!?(IOM-26/2),"Date Printed: ",IBHDT
+10 SET IBPAG=IBPAG+1
WRITE !?(IOM-8/2),"Page: ",IBPAG
+11 WRITE !?(IOM-26/2),"--------------------------",!!
+12 QUIT
+13 ;
CHK ; -- check task man stop flag
+1 IF $DATA(ZTQUEUED)
IF $$S^%ZTLOAD
SET ZTSTOP=1
DO HDR
WRITE !!,"....task stopped at user request."
+2 QUIT
+3 ;
CNT(N) ; -- see if enought room on page for list
+1 if '$GET(N)
QUIT
+2 SET (IBC,I)=0
FOR
SET I=$ORDER(IBCNT(N,I))
if 'I
QUIT
SET IBC=IBC+1
+3 IF IOSL<($Y+IBC+3)
IF $EXTRACT(IOST,1,2)="C-"
DO PAUSE^VALM1
if $DATA(DIRUT)
SET IBQUIT=1
if 'IBQUIT
WRITE @IOF
QUIT
+4 IF IOSL<($Y+IBC+3)
DO HDR
+5 QUIT
