IBTOSUM2 ;ALB/AAS - CLAIMS TRACKING BILLING INFORMATION PRINT ; 29-OCT-93
;;Version 2.0 ; INTEGRATED BILLING ;; 21-MAR-94
;
PRINT ; -- print the report
K X,X2,X3
D HDR,MAIN
D 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
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)
W !?((IOM/2)-25),"Total Billable ",$S(IBSORT="A":"Admissions",1:"Discharges"),": ",$J(+$G(IBCNT(3,0)),11)
;
W !?((IOM/2)-34),"Total ",$S(IBSORT="A":"Admissions",1:"Discharges")," Requiring Reviews: ",$J(IBCNT(4),11)
W !?((IOM/2)-25),"Total ",$S(IBSORT="A":"Admissions",1:"Discharges")," Reviewed: ",$J(IBCNT(99),11)
W !?((IOM/2)-40),"Total ",$S(IBSORT="A":"Admissions",1:"Discharges")," Reviewed, Multi Carrier: ",$J(IBCNT(13),11)
;
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),"^"),10)," " S X=+$P(IBCNT(31),"^",2),X3=9,X2="0$" D COMMA^%DTC W X
W !?((IOM/2)-36),"Untimely Pre Admission Certification: ",$J($P(IBCNT(32),"^"),10)," " S X=+$P(IBCNT(32),"^",2),X3=9,X2="0$" D COMMA^%DTC W X
W !?((IOM/2)-17),"VA a Non-Provider: ",$J($P(IBCNT(33),"^"),10)," " S X=+$P(IBCNT(33),"^",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)),"^")_" ",1,27)
.W ?((IOM/2)+30)," ",$J(IBCNT(3,I),8)
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)),"^")_" ",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)),"^")_" ",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),"^"),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
IBTOSUM2 ;ALB/AAS - CLAIMS TRACKING BILLING INFORMATION PRINT ; 29-OCT-93
+1 ;;Version 2.0 ; INTEGRATED BILLING ;; 21-MAR-94
+2 ;
PRINT ; -- print the report
+1 KILL X,X2,X3
+2 DO HDR
DO MAIN
+3 DO PENAL
+4 IF $ORDER(IBCNT(3,0))
DO RNB
+5 IF $ORDER(IBCNT(10,0))
DO APPROV
+6 IF $ORDER(IBCNT(20,0))
DO DENIAL
+7 QUIT
+8 ;
MAIN ; -- print main body of report
+1 WRITE !?((IOM/2)-16),"Total ",$SELECT(IBSORT="A":"Admissions",1:"Discharges"),": ",$JUSTIFY(IBCNT(1),11)
+2 WRITE !?((IOM/2)-31),"Total ",$SELECT(IBSORT="A":"Admissions",1:"Discharges")," with Insurance: ",$JUSTIFY(IBCNT(2),11)
+3 WRITE !?((IOM/2)-25),"Total Billable ",$SELECT(IBSORT="A":"Admissions",1:"Discharges"),": ",$JUSTIFY(+$GET(IBCNT(3,0)),11)
+4 ;
+5 WRITE !?((IOM/2)-34),"Total ",$SELECT(IBSORT="A":"Admissions",1:"Discharges")," Requiring Reviews: ",$JUSTIFY(IBCNT(4),11)
+6 WRITE !?((IOM/2)-25),"Total ",$SELECT(IBSORT="A":"Admissions",1:"Discharges")," Reviewed: ",$JUSTIFY(IBCNT(99),11)
+7 WRITE !?((IOM/2)-40),"Total ",$SELECT(IBSORT="A":"Admissions",1:"Discharges")," Reviewed, Multi Carrier: ",$JUSTIFY(IBCNT(13),11)
+8 ;
+9 IF $EXTRACT(IOST,1,2)="C-"
WRITE !
DO PAUSE^VALM1
IF $DATA(DIRUT)
QUIT
WRITE @IOF
+10 ;
+11 WRITE !!?((IOM/2)-18),"Total Reviews Done: ",$JUSTIFY(IBCNT(5),11)
+12 WRITE !?((IOM/2)-23),"Number of Days Approved: ",$JUSTIFY(IBCNT(10),11)
+13 SET X=IBCNT(11)
SET X2="0$"
DO COMMA^%DTC
+14 WRITE !?((IOM/2)-39),"Amount Collectible Approved for Billing: ",X
+15 ;
+16 WRITE !!?((IOM/2)-21),"Number of Days Denied: ",$JUSTIFY(IBCNT(20),11)
+17 SET X=IBCNT(21)
SET X2="0$"
DO COMMA^%DTC
+18 WRITE !?((IOM/2)-25),"Amount Denied for Billing: ",X
+19 ;
+20 WRITE !!?((IOM/2)-20),"Total Cases Appealed: ",$JUSTIFY(IBCNT(80),11)
+21 WRITE !?((IOM/2)-25),"Number of Initial Appeals: ",$JUSTIFY(IBCNT(81),11)
+22 WRITE !?((IOM/2)-28),"Number of Subsequent Appeals: ",$JUSTIFY(IBCNT(82),11)
+23 ;
+24 QUIT
+25 ;
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),"^"),10)," "
SET X=+$PIECE(IBCNT(31),"^",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),"^"),10)," "
SET X=+$PIECE(IBCNT(32),"^",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),"^"),10)," "
SET X=+$PIECE(IBCNT(33),"^",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)),"^")_" ",1,27)
+6 WRITE ?((IOM/2)+30)," ",$JUSTIFY(IBCNT(3,I),8)
End DoDot:1
+7 QUIT
+8 ;
+9 ;
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)),"^")_" ",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)),"^")_" ",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),"^"),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
