IBTODD2 ;ALB/AAS - CLAIMS TRACKING DENIED DAYS REPORT ; 13-JUN-95
;;2.0;INTEGRATED BILLING;**32,458**;21-MAR-94;Build 4
;
SUM ; -- Print summary 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 !,"MCCR/UR DENIED DAYS Summary Report for Reviews Dated ",$$FMTE^XLFDT(IBBDT),$S(IBBDT'=IBEDT:" to "_$$FMTE^XLFDT(IBEDT),1:"")," "
W ?(IOM-33),"Page ",IBPAG," ",IBHDT
;
I $O(^TMP($J,"IBTODD",""))="" W !!,"No Denials Found in Date Range." G SUMQ
;
I $O(IBCNT(""))'="" D
.W !!,?35,"Number",?50,"Days",?65,"Amount",?80,"Days won"
.W !,"Service",?35,"Denials",?50,"Denied",?65,"Denied",?80,"on Appeal"
.W !,$TR($J(" ",IOM)," ","-")
.;
.S IBSERV="" F S IBSERV=$O(IBCNT(IBSERV)) Q:IBSERV="" D
..W !,$$EXPAND^IBTRE(42.4,3,IBSERV) I IBSERV="UNKNOWN" W IBSERV
..W ?32,$J($P(IBCNT(IBSERV),"^",3),8)
..W ?46,$J(+IBCNT(IBSERV),8)
..S X=$P(IBCNT(IBSERV),"^",2),X2="0$" D COMMA^%DTC W ?60,X
..W ?81,$J($P(IBCNT(IBSERV),"^",4),6)
..;S X=$P(IBCNT(IBSERV),"^",6),X2="0$" D COMMA^%DTC W ?95,X
.;
.W !?48,"--------",!,?48,$J(IBTOTL,6)
;
I $O(IBCNTO(""))'="" D
.W !!,?35,"Number",?65,"Amount",?91,"Appeals"
.W !,"Service",?35,"Denials",?65,"Denied",?81,"Appealed",?91,"Approved"
.W !,$TR($J(" ",IOM)," ","-")
.;
.S IBSERV="" F S IBSERV=$O(IBCNTO(IBSERV)) Q:IBSERV="" D
..W !,IBSERV
..W ?32,$J($P(IBCNTO(IBSERV),"^",3),8)
..S X=$P(IBCNTO(IBSERV),"^",2),X2="0$" D COMMA^%DTC W ?60,X
..W ?81,$J($P(IBCNTO(IBSERV),"^",4),6)
..W ?91,$J($P(IBCNTO(IBSERV),"^",5),6)
SUMQ ;
Q
;
;
SUBH(Z) ; -- write sub header for report
; input z = subheader data
; requires ibsort = how report is sorted
I IOSL<($Y+8) D HDR^IBTODD1 Q:IBQUIT
N X,Y S X=""
Q:IBSORT="P" ; no sub header if sorting by patient
Q:IBEVNTYP'=1 ; no sub header if not inpatient
I IBSORT="S" S Y=$$EXPAND^IBTRE(42.4,3,IBI) S X="Service: "_$S(Y'="":Y,1:IBI)
I IBSORT="A" S X="Attending: "_IBI
I $L(X) W !!?15,X
Q
;
SUBT ; -- write out sub totals, initialize variable
I '$G(IBSUBT) G SUBTQ
W !?54,"------",!,?54,$J(IBSUBT,6)
SUBTQ S IBSUBT=0
Q
;
;
SORT ; Ask for sort criteria.
W !!
S DIR(0)="SOBA^P:PATIENT;A:ATTENDING;S:SERVICE"
S DIR("A")="Print Report By [P]atient [A]ttending [S]ervice: "
S DIR("B")="P"
S DIR("?",1)="This report may be prepared by either Patient, Attending, or Service."
S DIR("?",2)=""
S DIR("?",3)=""
S DIR("?",4)=""
S DIR("?",5)=""
S DIR("?",6)=""
S DIR("?",7)=""
S DIR("?",8)=" "
S DIR("?")=""
D ^DIR K DIR
S IBSORT=Y I "PAS"'[Y!($D(DIRUT)) S IBSORT=-1
Q
;
TYPE ; Ask for the Type of Care to include, IBSELECT defined on exit
N IBPRT,IBEPS
S IBPRT="Choose denials for which types of care to print:"
S IBEPS(1)="INPATIENT",IBEPS(2)="OUTPATIENT",IBEPS(3)="PROSTHETICS",IBEPS(4)="PHARMACY",IBEPS(5)="ALL DENIALS"
S IBSELECT=$$MLTP^IBJD(IBPRT,.IBEPS,1)
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HIBTODD2 2966 printed Apr 09, 2024@21:25:30 Page 2
IBTODD2 ;ALB/AAS - CLAIMS TRACKING DENIED DAYS REPORT ; 13-JUN-95
+1 ;;2.0;INTEGRATED BILLING;**32,458**;21-MAR-94;Build 4
+2 ;
SUM ; -- Print summary 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 !,"MCCR/UR DENIED DAYS Summary Report for Reviews Dated ",$$FMTE^XLFDT(IBBDT),$SELECT(IBBDT'=IBEDT:" to "_$$FMTE^XLFDT(IBEDT),1:"")," "
+6 WRITE ?(IOM-33),"Page ",IBPAG," ",IBHDT
+7 ;
+8 IF $ORDER(^TMP($JOB,"IBTODD",""))=""
WRITE !!,"No Denials Found in Date Range."
GOTO SUMQ
+9 ;
+10 IF $ORDER(IBCNT(""))'=""
Begin DoDot:1
+11 WRITE !!,?35,"Number",?50,"Days",?65,"Amount",?80,"Days won"
+12 WRITE !,"Service",?35,"Denials",?50,"Denied",?65,"Denied",?80,"on Appeal"
+13 WRITE !,$TRANSLATE($JUSTIFY(" ",IOM)," ","-")
+14 ;
+15 SET IBSERV=""
FOR
SET IBSERV=$ORDER(IBCNT(IBSERV))
if IBSERV=""
QUIT
Begin DoDot:2
+16 WRITE !,$$EXPAND^IBTRE(42.4,3,IBSERV)
IF IBSERV="UNKNOWN"
WRITE IBSERV
+17 WRITE ?32,$JUSTIFY($PIECE(IBCNT(IBSERV),"^",3),8)
+18 WRITE ?46,$JUSTIFY(+IBCNT(IBSERV),8)
+19 SET X=$PIECE(IBCNT(IBSERV),"^",2)
SET X2="0$"
DO COMMA^%DTC
WRITE ?60,X
+20 WRITE ?81,$JUSTIFY($PIECE(IBCNT(IBSERV),"^",4),6)
+21 ;S X=$P(IBCNT(IBSERV),"^",6),X2="0$" D COMMA^%DTC W ?95,X
End DoDot:2
+22 ;
+23 WRITE !?48,"--------",!,?48,$JUSTIFY(IBTOTL,6)
End DoDot:1
+24 ;
+25 IF $ORDER(IBCNTO(""))'=""
Begin DoDot:1
+26 WRITE !!,?35,"Number",?65,"Amount",?91,"Appeals"
+27 WRITE !,"Service",?35,"Denials",?65,"Denied",?81,"Appealed",?91,"Approved"
+28 WRITE !,$TRANSLATE($JUSTIFY(" ",IOM)," ","-")
+29 ;
+30 SET IBSERV=""
FOR
SET IBSERV=$ORDER(IBCNTO(IBSERV))
if IBSERV=""
QUIT
Begin DoDot:2
+31 WRITE !,IBSERV
+32 WRITE ?32,$JUSTIFY($PIECE(IBCNTO(IBSERV),"^",3),8)
+33 SET X=$PIECE(IBCNTO(IBSERV),"^",2)
SET X2="0$"
DO COMMA^%DTC
WRITE ?60,X
+34 WRITE ?81,$JUSTIFY($PIECE(IBCNTO(IBSERV),"^",4),6)
+35 WRITE ?91,$JUSTIFY($PIECE(IBCNTO(IBSERV),"^",5),6)
End DoDot:2
End DoDot:1
SUMQ ;
+1 QUIT
+2 ;
+3 ;
SUBH(Z) ; -- write sub header for report
+1 ; input z = subheader data
+2 ; requires ibsort = how report is sorted
+3 IF IOSL<($Y+8)
DO HDR^IBTODD1
if IBQUIT
QUIT
+4 NEW X,Y
SET X=""
+5 ; no sub header if sorting by patient
if IBSORT="P"
QUIT
+6 ; no sub header if not inpatient
if IBEVNTYP'=1
QUIT
+7 IF IBSORT="S"
SET Y=$$EXPAND^IBTRE(42.4,3,IBI)
SET X="Service: "_$SELECT(Y'="":Y,1:IBI)
+8 IF IBSORT="A"
SET X="Attending: "_IBI
+9 IF $LENGTH(X)
WRITE !!?15,X
+10 QUIT
+11 ;
SUBT ; -- write out sub totals, initialize variable
+1 IF '$GET(IBSUBT)
GOTO SUBTQ
+2 WRITE !?54,"------",!,?54,$JUSTIFY(IBSUBT,6)
SUBTQ SET IBSUBT=0
+1 QUIT
+2 ;
+3 ;
SORT ; Ask for sort criteria.
+1 WRITE !!
+2 SET DIR(0)="SOBA^P:PATIENT;A:ATTENDING;S:SERVICE"
+3 SET DIR("A")="Print Report By [P]atient [A]ttending [S]ervice: "
+4 SET DIR("B")="P"
+5 SET DIR("?",1)="This report may be prepared by either Patient, Attending, or Service."
+6 SET DIR("?",2)=""
+7 SET DIR("?",3)=""
+8 SET DIR("?",4)=""
+9 SET DIR("?",5)=""
+10 SET DIR("?",6)=""
+11 SET DIR("?",7)=""
+12 SET DIR("?",8)=" "
+13 SET DIR("?")=""
+14 DO ^DIR
KILL DIR
+15 SET IBSORT=Y
IF "PAS"'[Y!($DATA(DIRUT))
SET IBSORT=-1
+16 QUIT
+17 ;
TYPE ; Ask for the Type of Care to include, IBSELECT defined on exit
+1 NEW IBPRT,IBEPS
+2 SET IBPRT="Choose denials for which types of care to print:"
+3 SET IBEPS(1)="INPATIENT"
SET IBEPS(2)="OUTPATIENT"
SET IBEPS(3)="PROSTHETICS"
SET IBEPS(4)="PHARMACY"
SET IBEPS(5)="ALL DENIALS"
+4 SET IBSELECT=$$MLTP^IBJD(IBPRT,.IBEPS,1)
+5 QUIT
