- IBTODD1 ;ALB/AAS - CLAIMS TRACKING DENIED DAYS REPORT ; 27-OCT-93
- ;;Version 2.0 ; INTEGRATED BILLING ;; 21-MAR-94
- ;
- % I '$D(DT) D DT^DICRW
- PRINT ; -- print data
- ; -- ^tmp($j,"ibtodd",primary sort,secondary sort,ibtrc)=DFN ^ attending ^ treating specialty ^ service ^ billing bed section ^ billing rate
- ;
- K IBCNT
- I 'IBSUM D HDR
- I 'IBSUM,$O(^TMP($J,"IBTODD",""))="" W !!,"No Denials Found in Date Range." G PRINTQ
- ;
- S IBI="",IBISV=""
- F S IBI=$O(^TMP($J,"IBTODD",IBI)) Q:IBI=""!(IBQUIT) D
- .I IBSORT'="P",IBISV'=IBI D SUBT^IBTODD
- .S IBISV=IBI
- .D SUBH^IBTODD(IBI) S IBJ="" F S IBJ=$O(^TMP($J,"IBTODD",IBI,IBJ)) Q:IBJ=""!(IBQUIT) D
- ..S IBTRC=""
- ..F S IBTRC=$O(^TMP($J,"IBTODD",IBI,IBJ,IBTRC)) Q:IBTRC=""!(IBQUIT) S IBDATA=^(IBTRC) D ONE
- I 'IBSUM D SUBT^IBTODD
- D SUM
- ;
- PRINTQ Q
- ;
- ONE ; -- print one entry
- ; -- ^tmp($j,"ibtodd",primary sort,secondary sort,ibtrc)=DFN ^ attending ^ treating specialty ^ service ^ billing bed section ^ billing rate
- ;
- S IBAPL=$$APPEAL(IBTRC)
- D CNTS
- S IBTALL=+$P($G(^IBT(356.2,+IBTRC,1)),"^",7) ;entire admission denied
- Q:IBSUM
- ;
- I IOSL<($Y+4) D HDR
- S DFN=+IBDATA 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($P(IBTRCD,"^",2))
- W ?38,$$DAT1^IBOUTL(+IBCDT\1) W:$P(IBCDT,"^",2) " to"
- W ?50,$J($P(IBDATA,"^",2),8)
- I IBTALL W ?64,"ALL"
- I 'IBTALL W ?64,$$DAT1^IBOUTL($P(IBTRCD,"^",15),"2P") W:$P(IBTRCD,"^",16) " to"
- I IBTALL!('$P(IBTRCD,"^",16)) W " (",$P(IBDATA,"^",7),")"
- K IBDEN,IBC S IBDEN=0,IBC=0
- F S IBDEN=$O(^IBT(356.2,+IBTRC,12,IBDEN)) Q:'IBDEN S IBC=IBC+1,IBC(IBC)=^(IBDEN,0)
- W:$G(IBC(1)) ?78,$E($$EXPAND^IBTRE(356.212,.01,+IBC(1)),1,25)
- W ?110,$S(+$P(IBAPL,"^",2):"YES",1:"NO")
- W ?117,$J(+IBAPL,8)
- ;
- ;
- L2 W !?38,$$DAT1^IBOUTL($P(IBCDT,"^",2)\1,"2P")
- W ?64,$$DAT1^IBOUTL($P(IBTRCD,"^",16),"2P")
- I 'IBTALL,$P(IBTRCD,"^",16) W " (",$P(IBDATA,"^",7),")"
- W ?78,$E($$EXPAND^IBTRE(356.212,.01,$G(IBC(2))),1,25)
- ;
- I $O(IBC(2)) S IBDEN=2 F S IBDEN=$O(IBC(IBDEN)) Q:'IBDEN W !?78,$E($$EXPAND^IBTRE(356.212,.01,$G(IBC(IBDEN))),1,25)
- ONEQ W !
- Q
- ;
- 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
- W !!,?35,"Number",?50,"Days",?65,"Amount",?80,"Days won",?100,"Maximum"
- W !,"Service",?35,"Denials",?50,"Denied",?65,"Denied",?80,"on Appeal",?100,"Billing Rate"
- W !,$TR($J(" ",IOM)," ","-")
- ;
- I $O(^TMP($J,"IBTODD",""))="" W !!,"No Denials Found in Date Range." G SUMQ
- ;
- S IBSERV="" F S IBSERV=$O(IBCNT(IBSERV)) Q:IBSERV="" D
- .W !,$$EXPAND^IBTRE(42.4,3,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)
- SUMQ ;
- Q
- ;
- CNTS ; -- develop summary data
- S IBSERV=$P(IBDATA,"^",4)
- I IBSERV="" S IBSERV="UNKNOWN"
- S:'$D(IBCNT(IBSERV)) IBCNT(IBSERV)=""
- S $P(IBCNT(IBSERV),"^")=$P(IBCNT(IBSERV),"^")+$P(IBDATA,"^",7)
- S $P(IBCNT(IBSERV),"^",2)=$P(IBCNT(IBSERV),"^",2)+($P(IBDATA,"^",7)*$P(IBDATA,"^",6))
- S $P(IBCNT(IBSERV),"^",3)=$P(IBCNT(IBSERV),"^",3)+1
- S $P(IBCNT(IBSERV),"^",4)=$P(IBCNT(IBSERV),"^",4)+$G(IBAPL)
- S:$P(IBCNT(IBSERV),"^",6)<$P(IBDATA,"^",6) $P(IBCNT(IBSERV),"^",6)=$P(IBDATA,"^",6)
- S IBSUBT=$G(IBSUBT)+$P(IBDATA,"^",7)
- S IBTOTL=$G(IBTOTL)+$P(IBDATA,"^",7)
- 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 !,"MCCR/UR DENIED DAYS Report for Reviews Dated ",$$FMTE^XLFDT(IBBDT),$S(IBBDT'=IBEDT:" to "_$$FMTE^XLFDT(IBEDT),1:"")," "
- W ?(IOM-33),"Page ",IBPAG," ",IBHDT
- W !!,?38,"Dates of",?64,"Dates",?117,"Days Approved"
- W !,"Patient",?25,"Pt. ID",?38,"Care",?50,"Attending",?64,"Denied",?78,"Denial Reason",?105,"Appealed",?117,"on Appeal"
- W !,$TR($J(" ",IOM)," ","-")
- Q
- ;
- CDT(IBTRN) ; -- compute dates of care
- N X,Y S X=$G(^IBT(356,+IBTRN,0)),Y=""
- I $P(X,"^",5) S DGPM=$G(^DGPM($P(X,"^",5),0)) D
- .S Y=+DGPM
- .I $P(DGPM,"^",17) S Y=Y_"^"_+$G(^DGPM($P(DGPM,"^",17),0))
- I 'Y S Y=$P(X,"^",6)
- Q Y
- ;
- APPEAL(IBTRC) ; -- Find appeals
- N X,Y,IBAPEAL,IBTRN,IBTRSV S (Y,X)=0
- S IBTRSV=IBTRC
- S IBTRC=0 F S IBTRC=$O(^IBT(356.2,"AP",+IBTRSV,IBTRC)) Q:'IBTRC S Y=1,X=X+$$AP(IBTRC)
- ;
- Q X_"^"_Y
- ;
- AP(IBTRC) ; -- count days approved
- N X,Y,Z
- S (X,Z)=0
- F S X=$O(^IBT(356.2,+IBTRC,14,X)) Q:'X S Y=$G(^(X,0)),Z=Z+$$FMDIFF^XLFDT($P(Y,"^",2),+Y)+1
- Q Z
- IBTODD1 ;ALB/AAS - CLAIMS TRACKING DENIED DAYS REPORT ; 27-OCT-93
- +1 ;;Version 2.0 ; INTEGRATED BILLING ;; 21-MAR-94
- +2 ;
- % IF '$DATA(DT)
- DO DT^DICRW
- PRINT ; -- print data
- +1 ; -- ^tmp($j,"ibtodd",primary sort,secondary sort,ibtrc)=DFN ^ attending ^ treating specialty ^ service ^ billing bed section ^ billing rate
- +2 ;
- +3 KILL IBCNT
- +4 IF 'IBSUM
- DO HDR
- +5 IF 'IBSUM
- IF $ORDER(^TMP($JOB,"IBTODD",""))=""
- WRITE !!,"No Denials Found in Date Range."
- GOTO PRINTQ
- +6 ;
- +7 SET IBI=""
- SET IBISV=""
- +8 FOR
- SET IBI=$ORDER(^TMP($JOB,"IBTODD",IBI))
- IF IBI=""!(IBQUIT)
- QUIT
- Begin DoDot:1
- +9 IF IBSORT'="P"
- IF IBISV'=IBI
- DO SUBT^IBTODD
- +10 SET IBISV=IBI
- +11 DO SUBH^IBTODD(IBI)
- SET IBJ=""
- FOR
- SET IBJ=$ORDER(^TMP($JOB,"IBTODD",IBI,IBJ))
- IF IBJ=""!(IBQUIT)
- QUIT
- Begin DoDot:2
- +12 SET IBTRC=""
- +13 FOR
- SET IBTRC=$ORDER(^TMP($JOB,"IBTODD",IBI,IBJ,IBTRC))
- IF IBTRC=""!(IBQUIT)
- QUIT
- SET IBDATA=^(IBTRC)
- DO ONE
- End DoDot:2
- End DoDot:1
- +14 IF 'IBSUM
- DO SUBT^IBTODD
- +15 DO SUM
- +16 ;
- PRINTQ QUIT
- +1 ;
- ONE ; -- print one entry
- +1 ; -- ^tmp($j,"ibtodd",primary sort,secondary sort,ibtrc)=DFN ^ attending ^ treating specialty ^ service ^ billing bed section ^ billing rate
- +2 ;
- +3 SET IBAPL=$$APPEAL(IBTRC)
- +4 DO CNTS
- +5 ;entire admission denied
- SET IBTALL=+$PIECE($GET(^IBT(356.2,+IBTRC,1)),"^",7)
- +6 IF IBSUM
- QUIT
- +7 ;
- +8 IF IOSL<($Y+4)
- DO HDR
- +9 SET DFN=+IBDATA
- DO PID^VADPT
- +10 SET IBTRCD=$GET(^IBT(356.2,+IBTRC,0))
- L1 WRITE !,$EXTRACT($PIECE(^DPT(DFN,0),"^"),1,22),?25,VA("PID")
- +1 SET IBCDT=$$CDT($PIECE(IBTRCD,"^",2))
- +2 WRITE ?38,$$DAT1^IBOUTL(+IBCDT\1)
- IF $PIECE(IBCDT,"^",2)
- WRITE " to"
- +3 WRITE ?50,$JUSTIFY($PIECE(IBDATA,"^",2),8)
- +4 IF IBTALL
- WRITE ?64,"ALL"
- +5 IF 'IBTALL
- WRITE ?64,$$DAT1^IBOUTL($PIECE(IBTRCD,"^",15),"2P")
- IF $PIECE(IBTRCD,"^",16)
- WRITE " to"
- +6 IF IBTALL!('$PIECE(IBTRCD,"^",16))
- WRITE " (",$PIECE(IBDATA,"^",7),")"
- +7 KILL IBDEN,IBC
- SET IBDEN=0
- SET IBC=0
- +8 FOR
- SET IBDEN=$ORDER(^IBT(356.2,+IBTRC,12,IBDEN))
- IF 'IBDEN
- QUIT
- SET IBC=IBC+1
- SET IBC(IBC)=^(IBDEN,0)
- +9 IF $GET(IBC(1))
- WRITE ?78,$EXTRACT($$EXPAND^IBTRE(356.212,.01,+IBC(1)),1,25)
- +10 WRITE ?110,$SELECT(+$PIECE(IBAPL,"^",2):"YES",1:"NO")
- +11 WRITE ?117,$JUSTIFY(+IBAPL,8)
- +12 ;
- +13 ;
- L2 WRITE !?38,$$DAT1^IBOUTL($PIECE(IBCDT,"^",2)\1,"2P")
- +1 WRITE ?64,$$DAT1^IBOUTL($PIECE(IBTRCD,"^",16),"2P")
- +2 IF 'IBTALL
- IF $PIECE(IBTRCD,"^",16)
- WRITE " (",$PIECE(IBDATA,"^",7),")"
- +3 WRITE ?78,$EXTRACT($$EXPAND^IBTRE(356.212,.01,$GET(IBC(2))),1,25)
- +4 ;
- +5 IF $ORDER(IBC(2))
- SET IBDEN=2
- FOR
- SET IBDEN=$ORDER(IBC(IBDEN))
- IF 'IBDEN
- QUIT
- WRITE !?78,$EXTRACT($$EXPAND^IBTRE(356.212,.01,$GET(IBC(IBDEN))),1,25)
- ONEQ WRITE !
- +1 QUIT
- +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 WRITE !!,?35,"Number",?50,"Days",?65,"Amount",?80,"Days won",?100,"Maximum"
- +8 WRITE !,"Service",?35,"Denials",?50,"Denied",?65,"Denied",?80,"on Appeal",?100,"Billing Rate"
- +9 WRITE !,$TRANSLATE($JUSTIFY(" ",IOM)," ","-")
- +10 ;
- +11 IF $ORDER(^TMP($JOB,"IBTODD",""))=""
- WRITE !!,"No Denials Found in Date Range."
- GOTO SUMQ
- +12 ;
- +13 SET IBSERV=""
- FOR
- SET IBSERV=$ORDER(IBCNT(IBSERV))
- IF IBSERV=""
- QUIT
- Begin DoDot:1
- +14 WRITE !,$$EXPAND^IBTRE(42.4,3,IBSERV)
- +15 WRITE ?32,$JUSTIFY($PIECE(IBCNT(IBSERV),"^",3),8)
- +16 WRITE ?46,$JUSTIFY(+IBCNT(IBSERV),8)
- +17 SET X=$PIECE(IBCNT(IBSERV),"^",2)
- SET X2="0$"
- DO COMMA^%DTC
- WRITE ?60,X
- +18 WRITE ?81,$JUSTIFY($PIECE(IBCNT(IBSERV),"^",4),6)
- +19 SET X=$PIECE(IBCNT(IBSERV),"^",6)
- SET X2="0$"
- DO COMMA^%DTC
- WRITE ?95,X
- End DoDot:1
- +20 ;
- +21 WRITE !?48,"--------",!,?48,$JUSTIFY(IBTOTL,6)
- SUMQ ;
- +1 QUIT
- +2 ;
- CNTS ; -- develop summary data
- +1 SET IBSERV=$PIECE(IBDATA,"^",4)
- +2 IF IBSERV=""
- SET IBSERV="UNKNOWN"
- +3 IF '$DATA(IBCNT(IBSERV))
- SET IBCNT(IBSERV)=""
- +4 SET $PIECE(IBCNT(IBSERV),"^")=$PIECE(IBCNT(IBSERV),"^")+$PIECE(IBDATA,"^",7)
- +5 SET $PIECE(IBCNT(IBSERV),"^",2)=$PIECE(IBCNT(IBSERV),"^",2)+($PIECE(IBDATA,"^",7)*$PIECE(IBDATA,"^",6))
- +6 SET $PIECE(IBCNT(IBSERV),"^",3)=$PIECE(IBCNT(IBSERV),"^",3)+1
- +7 SET $PIECE(IBCNT(IBSERV),"^",4)=$PIECE(IBCNT(IBSERV),"^",4)+$GET(IBAPL)
- +8 IF $PIECE(IBCNT(IBSERV),"^",6)<$PIECE(IBDATA,"^",6)
- SET $PIECE(IBCNT(IBSERV),"^",6)=$PIECE(IBDATA,"^",6)
- +9 SET IBSUBT=$GET(IBSUBT)+$PIECE(IBDATA,"^",7)
- +10 SET IBTOTL=$GET(IBTOTL)+$PIECE(IBDATA,"^",7)
- +11 QUIT
- +12 ;
- 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 !,"MCCR/UR DENIED DAYS Report for Reviews Dated ",$$FMTE^XLFDT(IBBDT),$SELECT(IBBDT'=IBEDT:" to "_$$FMTE^XLFDT(IBEDT),1:"")," "
- +6 WRITE ?(IOM-33),"Page ",IBPAG," ",IBHDT
- +7 WRITE !!,?38,"Dates of",?64,"Dates",?117,"Days Approved"
- +8 WRITE !,"Patient",?25,"Pt. ID",?38,"Care",?50,"Attending",?64,"Denied",?78,"Denial Reason",?105,"Appealed",?117,"on Appeal"
- +9 WRITE !,$TRANSLATE($JUSTIFY(" ",IOM)," ","-")
- +10 QUIT
- +11 ;
- CDT(IBTRN) ; -- compute dates of care
- +1 NEW X,Y
- SET X=$GET(^IBT(356,+IBTRN,0))
- SET Y=""
- +2 IF $PIECE(X,"^",5)
- SET DGPM=$GET(^DGPM($PIECE(X,"^",5),0))
- Begin DoDot:1
- +3 SET Y=+DGPM
- +4 IF $PIECE(DGPM,"^",17)
- SET Y=Y_"^"_+$GET(^DGPM($PIECE(DGPM,"^",17),0))
- End DoDot:1
- +5 IF 'Y
- SET Y=$PIECE(X,"^",6)
- +6 QUIT Y
- +7 ;
- APPEAL(IBTRC) ; -- Find appeals
- +1 NEW X,Y,IBAPEAL,IBTRN,IBTRSV
- SET (Y,X)=0
- +2 SET IBTRSV=IBTRC
- +3 SET IBTRC=0
- FOR
- SET IBTRC=$ORDER(^IBT(356.2,"AP",+IBTRSV,IBTRC))
- IF 'IBTRC
- QUIT
- SET Y=1
- SET X=X+$$AP(IBTRC)
- +4 ;
- +5 QUIT X_"^"_Y
- +6 ;
- AP(IBTRC) ; -- count days approved
- +1 NEW X,Y,Z
- +2 SET (X,Z)=0
- +3 FOR
- SET X=$ORDER(^IBT(356.2,+IBTRC,14,X))
- IF 'X
- QUIT
- SET Y=$GET(^(X,0))
- SET Z=Z+$$FMDIFF^XLFDT($PIECE(Y,"^",2),+Y)+1
- +4 QUIT Z
