- 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 Feb 18, 2025@23:53:45 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
