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  Sep 23, 2025@20:03:36                                                                                                                                                                                                     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