IBTODD1 ;ALB/AAS - CLAIMS TRACKING DENIED DAYS REPORT ; 27-OCT-93
;;2.0;INTEGRATED BILLING;**32,458**;21-MAR-94;Build 4
;
% I '$D(DT) D DT^DICRW
PRINT ; -- print data
; -- ^tmp($j,"ibtodd",event type,primary sort,secondary sort,ibtrc)=DFN ^ attending ^ treating specialty ^ service ^ ^ billing rate
;
K IBCNT,IBEVNTYP,IBCNTO
;
S IBEVNTYP=0 F S IBEVNTYP=$O(^TMP($J,"IBTODD",IBEVNTYP)) Q:'IBEVNTYP!(IBQUIT) D
.I 'IBSUM D HDR
.I 'IBSUM,$O(^TMP($J,"IBTODD",IBEVNTYP,""))="" W !!,"No Denials Found in Date Range." Q
.S IBI="",IBISV=""
.F S IBI=$O(^TMP($J,"IBTODD",IBEVNTYP,IBI)) Q:IBI=""!(IBQUIT) D
..I IBSORT'="P",IBISV'=IBI D SUBT^IBTODD2
..S IBISV=IBI D SUBH^IBTODD2(IBI) Q:IBQUIT
..S IBJ="" F S IBJ=$O(^TMP($J,"IBTODD",IBEVNTYP,IBI,IBJ)) Q:IBJ=""!(IBQUIT) D
...S IBTRC=""
...F S IBTRC=$O(^TMP($J,"IBTODD",IBEVNTYP,IBI,IBJ,IBTRC)) Q:IBTRC=""!(IBQUIT) S IBDATA=^(IBTRC) D ONE
.I 'IBSUM D SUBT^IBTODD2
;
I IBQUIT G PRINTQ
D SUM^IBTODD2
;
PRINTQ Q
;
ONE ; -- print one entry
; -- ^tmp($j,"ibtodd",event type,primary sort,secondary sort,ibtrc)=DFN ^ attending ^ treating specialty ^ service ^ ^ 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+6) D HDR,SUBH^IBTODD2(IBI)
S DFN=+IBDATA D PID^VADPT
S IBTRCD=$G(^IBT(356.2,+IBTRC,0))
I IBEVNTYP'=1 G LO
;
L1 W !,$E($P(^DPT(DFN,0),"^"),1,19),?22,VA("BID")
S IBCDT=$$CDT($P(IBTRCD,"^",2))
W ?28,$$DAT1^IBOUTL(+IBCDT\1) W:$P(IBCDT,"^",2) " to"
W ?40,$J($P(IBDATA,"^",2),8)
I IBTALL W ?54,"ALL"
I 'IBTALL W ?54,$$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)) ?68,$E($$EXPAND^IBTRE(356.212,.01,+IBC(1)),1,25)
W ?98,$S(+$P(IBAPL,"^",2):"YES",1:"NO")
W ?103,$J(+IBAPL,8)
W ?116,$E($$EXPAND^IBTRE(42.4,3,$P(IBDATA,"^",4)),1,4) W:$P(IBDATA,"^",4)="" "UNKN"
W ?120,$$CHRG(+$P(IBDATA,"^",6))
;
;
L2 W !?28,$$DAT1^IBOUTL($P(IBCDT,"^",2)\1,"2P")
W ?54,$$DAT1^IBOUTL($P(IBTRCD,"^",16),"2P")
I 'IBTALL,$P(IBTRCD,"^",16) W " (",$P(IBDATA,"^",7),")"
W ?68,$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 !?70,$E($$EXPAND^IBTRE(356.212,.01,$G(IBC(IBDEN))),1,25)
ONEQ W !
Q
;
LO ; -- print one line for non-inpatient
W !,$E($P(^DPT(DFN,0),"^"),1,19),?22,VA("BID")
S IBCDT=$P($G(^IBT(356,+$P(IBTRCD,U,2),0)),U,6)
W ?28,$$FMTE^XLFDT(+IBCDT,2)
W ?50,$P(IBTRCD,"^",26)
W ?78,$S(+$P(IBAPL,"^",2):"YES",1:"NO")
W ?88,$S(+IBAPL:"YES",1:"NO")
W ?98,$$CHRG(+$P(IBDATA,"^",6))
Q
;
;
CNTS ; -- develop summary data
S IBSERV=$P(IBDATA,"^",4)
I IBSERV="" S IBSERV="UNKNOWN"
S IBSUBT=$G(IBSUBT)+$P(IBDATA,"^",7)
;
I IBEVNTYP=1 D
.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,"^",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 IBTOTL=$G(IBTOTL)+$P(IBDATA,"^",7)
;
I IBEVNTYP'=1 D
.S:'$D(IBCNTO(IBSERV)) IBCNTO(IBSERV)=""
.S $P(IBCNTO(IBSERV),"^",2)=$P(IBCNTO(IBSERV),"^",2)+$P(IBDATA,"^",6)
.S $P(IBCNTO(IBSERV),"^",3)=$P(IBCNTO(IBSERV),"^",3)+1
.S $P(IBCNTO(IBSERV),"^",4)=$P(IBCNTO(IBSERV),"^",4)+$P($G(IBAPL),U,2)
.S $P(IBCNTO(IBSERV),"^",5)=$P(IBCNTO(IBSERV),"^",5)+$G(IBAPL)
Q
;
HDR ; -- Print header for billing report
Q:IBQUIT N IBEVO S IBEVO=$P($G(^IBE(356.6,+IBEVNTYP,0))," ",1)
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 "_IBEVO_" Denials Dated ",$$FMTE^XLFDT(IBBDT),$S(IBBDT'=IBEDT:" to "_$$FMTE^XLFDT(IBEDT),1:"")," "
W ?(IOM-33),"Page ",IBPAG," ",IBHDT
I $G(IBEVNTYP)'=1 G HDRO
W !!,?28,"Dates of",?54,"Dates",?103,"Days Approved"
W !,"Patient",?22,"PtID",?28,"Care",?40,"Attending",?54,"Denied",?68,"Denial Reason",?94,"Appealed",?105,"on Appeal",?116,"SRVS",?125,"Amount"
W !,$TR($J(" ",IOM)," ","-")
Q
;
HDRO ; -- Print Header for non-Inpatient denials
W !!,"Patient",?22,"PtID",?28,"Episode Date",?50,"Outpatient Treatment",?75,"Appealed",?85,"Approved",?103,"Amount"
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,AP,EV
S (X,Z)=0
S AP=$G(^IBT(356.2,+IBTRC,0)),EV=+$P($G(^IBT(356,+$P(AP,U,2),0)),U,18)
I EV>1,EV<5,+$P(AP,U,29),+$P(AP,U,29)'=2 S Z=1
I 'Z 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
;
CHRG(D) ; return charge for output
N X,X2 S X=+$G(D),X2="0$" D COMMA^%DTC
Q X
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HIBTODD1 5394 printed Apr 09, 2024@21:09:41 Page 2
IBTODD1 ;ALB/AAS - CLAIMS TRACKING DENIED DAYS REPORT ; 27-OCT-93
+1 ;;2.0;INTEGRATED BILLING;**32,458**;21-MAR-94;Build 4
+2 ;
% IF '$DATA(DT)
DO DT^DICRW
PRINT ; -- print data
+1 ; -- ^tmp($j,"ibtodd",event type,primary sort,secondary sort,ibtrc)=DFN ^ attending ^ treating specialty ^ service ^ ^ billing rate
+2 ;
+3 KILL IBCNT,IBEVNTYP,IBCNTO
+4 ;
+5 SET IBEVNTYP=0
FOR
SET IBEVNTYP=$ORDER(^TMP($JOB,"IBTODD",IBEVNTYP))
if 'IBEVNTYP!(IBQUIT)
QUIT
Begin DoDot:1
+6 IF 'IBSUM
DO HDR
+7 IF 'IBSUM
IF $ORDER(^TMP($JOB,"IBTODD",IBEVNTYP,""))=""
WRITE !!,"No Denials Found in Date Range."
QUIT
+8 SET IBI=""
SET IBISV=""
+9 FOR
SET IBI=$ORDER(^TMP($JOB,"IBTODD",IBEVNTYP,IBI))
if IBI=""!(IBQUIT)
QUIT
Begin DoDot:2
+10 IF IBSORT'="P"
IF IBISV'=IBI
DO SUBT^IBTODD2
+11 SET IBISV=IBI
DO SUBH^IBTODD2(IBI)
if IBQUIT
QUIT
+12 SET IBJ=""
FOR
SET IBJ=$ORDER(^TMP($JOB,"IBTODD",IBEVNTYP,IBI,IBJ))
if IBJ=""!(IBQUIT)
QUIT
Begin DoDot:3
+13 SET IBTRC=""
+14 FOR
SET IBTRC=$ORDER(^TMP($JOB,"IBTODD",IBEVNTYP,IBI,IBJ,IBTRC))
if IBTRC=""!(IBQUIT)
QUIT
SET IBDATA=^(IBTRC)
DO ONE
End DoDot:3
End DoDot:2
+15 IF 'IBSUM
DO SUBT^IBTODD2
End DoDot:1
+16 ;
+17 IF IBQUIT
GOTO PRINTQ
+18 DO SUM^IBTODD2
+19 ;
PRINTQ QUIT
+1 ;
ONE ; -- print one entry
+1 ; -- ^tmp($j,"ibtodd",event type,primary sort,secondary sort,ibtrc)=DFN ^ attending ^ treating specialty ^ service ^ ^ 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+6)
DO HDR
DO SUBH^IBTODD2(IBI)
+9 SET DFN=+IBDATA
DO PID^VADPT
+10 SET IBTRCD=$GET(^IBT(356.2,+IBTRC,0))
+11 IF IBEVNTYP'=1
GOTO LO
+12 ;
L1 WRITE !,$EXTRACT($PIECE(^DPT(DFN,0),"^"),1,19),?22,VA("BID")
+1 SET IBCDT=$$CDT($PIECE(IBTRCD,"^",2))
+2 WRITE ?28,$$DAT1^IBOUTL(+IBCDT\1)
if $PIECE(IBCDT,"^",2)
WRITE " to"
+3 WRITE ?40,$JUSTIFY($PIECE(IBDATA,"^",2),8)
+4 IF IBTALL
WRITE ?54,"ALL"
+5 IF 'IBTALL
WRITE ?54,$$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 ?68,$EXTRACT($$EXPAND^IBTRE(356.212,.01,+IBC(1)),1,25)
+10 WRITE ?98,$SELECT(+$PIECE(IBAPL,"^",2):"YES",1:"NO")
+11 WRITE ?103,$JUSTIFY(+IBAPL,8)
+12 WRITE ?116,$EXTRACT($$EXPAND^IBTRE(42.4,3,$PIECE(IBDATA,"^",4)),1,4)
if $PIECE(IBDATA,"^",4)=""
WRITE "UNKN"
+13 WRITE ?120,$$CHRG(+$PIECE(IBDATA,"^",6))
+14 ;
+15 ;
L2 WRITE !?28,$$DAT1^IBOUTL($PIECE(IBCDT,"^",2)\1,"2P")
+1 WRITE ?54,$$DAT1^IBOUTL($PIECE(IBTRCD,"^",16),"2P")
+2 IF 'IBTALL
IF $PIECE(IBTRCD,"^",16)
WRITE " (",$PIECE(IBDATA,"^",7),")"
+3 WRITE ?68,$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 !?70,$EXTRACT($$EXPAND^IBTRE(356.212,.01,$GET(IBC(IBDEN))),1,25)
ONEQ WRITE !
+1 QUIT
+2 ;
LO ; -- print one line for non-inpatient
+1 WRITE !,$EXTRACT($PIECE(^DPT(DFN,0),"^"),1,19),?22,VA("BID")
+2 SET IBCDT=$PIECE($GET(^IBT(356,+$PIECE(IBTRCD,U,2),0)),U,6)
+3 WRITE ?28,$$FMTE^XLFDT(+IBCDT,2)
+4 WRITE ?50,$PIECE(IBTRCD,"^",26)
+5 WRITE ?78,$SELECT(+$PIECE(IBAPL,"^",2):"YES",1:"NO")
+6 WRITE ?88,$SELECT(+IBAPL:"YES",1:"NO")
+7 WRITE ?98,$$CHRG(+$PIECE(IBDATA,"^",6))
+8 QUIT
+9 ;
+10 ;
CNTS ; -- develop summary data
+1 SET IBSERV=$PIECE(IBDATA,"^",4)
+2 IF IBSERV=""
SET IBSERV="UNKNOWN"
+3 SET IBSUBT=$GET(IBSUBT)+$PIECE(IBDATA,"^",7)
+4 ;
+5 IF IBEVNTYP=1
Begin DoDot:1
+6 if '$DATA(IBCNT(IBSERV))
SET IBCNT(IBSERV)=""
+7 SET $PIECE(IBCNT(IBSERV),"^")=$PIECE(IBCNT(IBSERV),"^")+$PIECE(IBDATA,"^",7)
+8 SET $PIECE(IBCNT(IBSERV),"^",2)=$PIECE(IBCNT(IBSERV),"^",2)+$PIECE(IBDATA,"^",6)
+9 SET $PIECE(IBCNT(IBSERV),"^",3)=$PIECE(IBCNT(IBSERV),"^",3)+1
+10 SET $PIECE(IBCNT(IBSERV),"^",4)=$PIECE(IBCNT(IBSERV),"^",4)+$GET(IBAPL)
+11 ;S:$P(IBCNT(IBSERV),"^",6)<$P(IBDATA,"^",6) $P(IBCNT(IBSERV),"^",6)=$P(IBDATA,"^",6)
+12 SET IBTOTL=$GET(IBTOTL)+$PIECE(IBDATA,"^",7)
End DoDot:1
+13 ;
+14 IF IBEVNTYP'=1
Begin DoDot:1
+15 if '$DATA(IBCNTO(IBSERV))
SET IBCNTO(IBSERV)=""
+16 SET $PIECE(IBCNTO(IBSERV),"^",2)=$PIECE(IBCNTO(IBSERV),"^",2)+$PIECE(IBDATA,"^",6)
+17 SET $PIECE(IBCNTO(IBSERV),"^",3)=$PIECE(IBCNTO(IBSERV),"^",3)+1
+18 SET $PIECE(IBCNTO(IBSERV),"^",4)=$PIECE(IBCNTO(IBSERV),"^",4)+$PIECE($GET(IBAPL),U,2)
+19 SET $PIECE(IBCNTO(IBSERV),"^",5)=$PIECE(IBCNTO(IBSERV),"^",5)+$GET(IBAPL)
End DoDot:1
+20 QUIT
+21 ;
HDR ; -- Print header for billing report
+1 if IBQUIT
QUIT
NEW IBEVO
SET IBEVO=$PIECE($GET(^IBE(356.6,+IBEVNTYP,0))," ",1)
+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 "_IBEVO_" Denials Dated ",$$FMTE^XLFDT(IBBDT),$SELECT(IBBDT'=IBEDT:" to "_$$FMTE^XLFDT(IBEDT),1:"")," "
+6 WRITE ?(IOM-33),"Page ",IBPAG," ",IBHDT
+7 IF $GET(IBEVNTYP)'=1
GOTO HDRO
+8 WRITE !!,?28,"Dates of",?54,"Dates",?103,"Days Approved"
+9 WRITE !,"Patient",?22,"PtID",?28,"Care",?40,"Attending",?54,"Denied",?68,"Denial Reason",?94,"Appealed",?105,"on Appeal",?116,"SRVS",?125,"Amount"
+10 WRITE !,$TRANSLATE($JUSTIFY(" ",IOM)," ","-")
+11 QUIT
+12 ;
HDRO ; -- Print Header for non-Inpatient denials
+1 WRITE !!,"Patient",?22,"PtID",?28,"Episode Date",?50,"Outpatient Treatment",?75,"Appealed",?85,"Approved",?103,"Amount"
+2 WRITE !,$TRANSLATE($JUSTIFY(" ",IOM)," ","-")
+3 QUIT
+4 ;
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,AP,EV
+2 SET (X,Z)=0
+3 SET AP=$GET(^IBT(356.2,+IBTRC,0))
SET EV=+$PIECE($GET(^IBT(356,+$PIECE(AP,U,2),0)),U,18)
+4 IF EV>1
IF EV<5
IF +$PIECE(AP,U,29)
IF +$PIECE(AP,U,29)'=2
SET Z=1
+5 IF 'Z
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
+6 QUIT Z
+7 ;
CHRG(D) ; return charge for output
+1 NEW X,X2
SET X=+$GET(D)
SET X2="0$"
DO COMMA^%DTC
+2 QUIT X
