IBTODD ;ALB/AAS - CLAIMS TRACKING DENIED DAYS REPORT ; 27-OCT-93
;;2.0;INTEGRATED BILLING;**32,458,730**;21-MAR-94;Build 83
;
% I '$D(DT) D DT^DICRW
W !!,"Denied Days Report",!!
;
S IBSORT="P",IBSELECT="1,2,3,4,"
N DIR
S DIR("?")="Answer YES if you only want to print a summary or answer NO if you want a detailed listing plus the summary."
S DIR(0)="Y",DIR("A")="Print Summary Only",DIR("B")="YES" D ^DIR K DIR
I $D(DIRUT) G END
S IBSUM=Y
G:IBSUM DATE
;
; -- ask what types of care to include
D TYPE^IBTODD2 I IBSELECT<1 G END
;
; -- ask how they want inpatient sorted
I IBSELECT[1 D SORT^IBTODD2 I IBSORT<0 G END
;
DATE ; -- select date range
W ! D DATE^IBOUTL
I IBBDT=""!(IBEDT="") G END
;
DEV ; -- select device, run option
W !
I 'IBSUM W !!,"You will need a 132 column printer for this report!",!
S %ZIS="QM" D ^%ZIS G:POP END
I $D(IO("Q")) S ZTRTN="DQ^IBTODD",ZTSAVE("IB*")="",ZTDESC="IB - Denied Days Report" D ^%ZTLOAD K IO("Q"),ZTSK D HOME^%ZIS G END
;
U IO
D DQ G END
Q
;
END ; -- Clean up
W ! K ^TMP($J,"IBTODD")
I $D(ZTQUEUED) S ZTREQ="@" Q
D ^%ZISC
K I,J,X,X2,Y,DFN,%ZIS,DGPM,VA,IBI,IBJ,IBTRN,IBTRND,IBTRND1,IBPAG,IBHDT,IBDISDT,IBETYP,IBQUIT,IBTAG,IBTRC,IBTRCD,IBDEN,IBDAY,IBTALL,IBADM,IBDISCH,IBMAX
K IBAPL,IBBBS,IBBDT,IBC,IBCDT,IBCNT,IBDT,IBD,IBDATA,IBEDT,IBNAM,IBPRIM,IBPROV,IBRATE,IBSECN,IBSERV,IBSORT,IBSPEC,IBSUM,IBSUBT,IBTOTL,IBCNTO,IBEVNTYP,IBISV,IBSELECT
D KVAR^VADPT
Q
DQ ; -- entry print from taskman
K ^TMP($J,"IBTODD") F I=1:1 S J=$P(IBSELECT,",",I) Q:'J S ^TMP($J,"IBTODD",J)=""
S X=132 X ^%ZOSF("RM")
S IBPAG=0,IBHDT=$$HTE^XLFDT($H,1),IBQUIT=0
S IBDEN=$O(^IBE(356.7,"ACODE",20,0))
D BLD,PRINT^IBTODD1
I $D(ZTQUEUED) G END
Q
;
BLD ; -- sort through data and build array to print from
;
S IBTRC=0
F S IBTRC=$O(^IBT(356.2,"ACT",IBDEN,IBTRC)) Q:'IBTRC D
.N IBDAY S IBTRCD=$G(^IBT(356.2,+IBTRC,0))
.S IBTRN=$P(IBTRCD,"^",2),IBTRND=$G(^IBT(356,+IBTRN,0))
.Q:'$P(IBTRCD,"^",19) ; review is inactive
.Q:'$P(IBTRND,"^",20) ; parent CT entry is inactive
.S IBEVNTYP=$P(IBTRND,U,18) S:IBEVNTYP=5 IBEVNTYP=1
. ;
.I IBEVNTYP=1,IBSELECT[1 D Q
..S IBDDB=$P(IBTRCD,"^",15),IBDDE=$P(IBTRCD,"^",16)
..S IBTALL=$P($G(^IBT(356.2,+IBTRC,1)),"^",7)
..S IBLOSI=$$LOS(IBTRN) ; admissions length of stay
..I IBDDB,IBDDE Q:(IBDDB>IBEDT)!(IBDDE<IBBDT) D
...I IBDDB<IBBDT S IBDDB=IBBDT ; chk days denied in correct range
...I IBDDE>IBEDT S IBDDE=IBEDT
...S IBDAY=$$FMDIFF^XLFDT(IBDDE,IBDDB)+1 ; cals total denied days
..; if no days denied "to" and "from" and episode in range
..I (IBTALL),('$D(IBDAY)) S IBCDT=$$CDT^IBTODD1(IBTRN) D STRIP Q:('+IBCDT!(+IBCDT>IBEDT)) D
...;Q:'$P(IBTRND,U,5) ; quit if no link between ct and dgpm
...I '$P(IBCDT,U,2) S $P(IBCDT,U,2)=$$FMADD^XLFDT($P(IBCDT,U,1),1) ; unlinked all to event dt+1 los
...; if the care date is >the report range there is no discharge add 1
...I '$P(IBCDT,U,2)!($P(IBCDT,U,2)>IBEDT) S $P(IBCDT,U,2)=$$FMADD^XLFDT(IBEDT,1)
...I +IBCDT<IBBDT S $P(IBCDT,U,1)=IBBDT
...S IBDAY=$$FMDIFF^XLFDT($P(IBCDT,U,2),$P(IBCDT,U,1))
..I IBLOSI=1,$G(IBDAY)=0 S IBDAY=1 ; get one day stays
..Q:$G(IBDAY)<1
..S DFN=$P(IBTRCD,"^",5),IBNAM=$P($G(^DPT(+DFN,0)),"^") Q:IBNAM=""
..S IBD=$$PROV(DFN,IBTRCD,IBTRND,IBTALL),IBPROV=+IBD,IBSPEC=$P(IBD,"^",2),IBSERV=$P(IBD,"^",3)
..;S IBBBS=$$BBS^IBTOSUM1($P(IBD,"^",2))
..;S IBRATE=$$RATE^IBTOSUM1(IBBBS,+IBTRCD)
..S IBRATE=$$AMOUNT^IBJDB21(1,IBTRN) ; get events charge
..I +IBLOSI,+IBRATE S IBRATE=(IBRATE/IBLOSI)*IBDAY ; calculate amount for days denied
..D SET
.;
.I IBEVNTYP'=1,IBSELECT[IBEVNTYP D Q
..S IBDDB=$P(IBTRND,"^",6)
..Q:(IBDDB<IBBDT)!(IBDDB>IBEDT)
..S DFN=$P(IBTRCD,"^",5),IBNAM=$P($G(^DPT(+DFN,0)),"^") Q:IBNAM=""
..S IBPROV=0,IBSPEC=0,IBSERV=$S(IBEVNTYP=2:"OUTPATIENT",IBEVNTYP=3:"PROSTHETICS",IBEVNTYP=4:"PRESCRIPTION",1:"UNKNOWN")
..S IBDAY=1,IBRATE=$$AMOUNT^IBJDB21(IBEVNTYP,IBTRN) ; get events charge
..D SET
K IBTRN,IBTRND,IBTRCD,DFN,IBDDB,IBDDE,IBCDT,IBLOSI
Q
;
SET ; -- set array to print from
; -- ^tmp($j,"ibtodd",evnt typ,primary sort,secondary sort,ibtrc)=DFN ^ attending ^ treating specialty ^ service ^ ^ billing rate^ no. days denied
S IBPRIM=$S(IBSORT="P":IBNAM,IBSORT="A":IBPROV,1:IBSERV)
S IBSECN=$S(IBSORT="P":IBPROV,1:IBNAM)
I IBEVNTYP'=1 S IBPRIM=IBNAM,IBSECN=IBDDB
S:IBPRIM="" IBPRIM="UNKNOWN" S:IBSECN="" IBSECN="UNKNOWN"
S ^TMP($J,"IBTODD",IBEVNTYP,IBPRIM,IBSECN,IBTRC)=DFN_"^"_IBPROV_"^"_IBSPEC_"^"_IBSERV_"^^"_IBRATE_"^"_IBDAY
Q
;
PROV(DFN,IBTRCD,IBTRND,IBTALL) ; Find attending/serv/spec during the denied period
; Input: DFN -- Pointer to the patient in file #2
; IBTRCD -- Zeroth node of insurance review in file #356.2
; IBTRND -- Zeroth node of parent CT entry in file #356
; IBTALL -- 1=> deny entire admission
; Output: 1^2^3, where 1 => pointer to attending in file #200
; 2 => pointer to treating spec. in file #45.7
; 3 => service abbr. code
;
N I,J,X,Y,DGPM,IBD,VA200,VAIN,VAIP,VAERR
;
; - determine date/time to calculate attending/serv/spec
S DGPM=+$P(IBTRND,"^",5),IBD=+$G(^DGPM(DGPM,0))
S:'IBD IBD=$P(IBTRND,"^",6)
I IBTALL S Y=IBD
I 'IBTALL D
.I $P(IBTRCD,"^",16)>$P(IBTRCD,"^",15) S Y=$P(IBTRCD,"^",15)_.2359 Q
.I $P(IBTRCD,"^",15)=(IBD\1) S Y=IBD Q
.S VAIP("D")=$P(IBTRCD,"^",15) D IN5^VADPT
.I +VAIP(16,1)\1=$P(IBTRCD,"^",15) S Y=+VAIP(16,1) Q
.S Y=$P(IBTRCD,"^",15)
S VA200="",VAINDT=Y D INP^VADPT
;
S X=+VAIN(11)
S Y=$G(^IBT(356.94,+$O(^IBT(356.94,"ATP",+DGPM,1,0)),0))
S:$P(Y,"^",3) X=$P(Y,"^",3)
PROVQ Q X_"^"_+VAIN(3)_"^"_$P($G(^DIC(42.4,+$P($G(^DIC(45.7,+$G(VAIN(3)),0)),"^",2),0)),"^",3)
;
STRIP ; -- strip time from dates (if report run same day time could produce incorrect results)
S $P(IBCDT,U,1)=$P(IBCDT,".",1),$P(IBCDT,U,2)=$P($P(IBCDT,U,2),".",1) Q
;
LOS(IBTRN) ; compute admissions length of stay
N X,Y,DGPM,BEG,END,LOS S X=$G(^IBT(356,+$G(IBTRN),0)),LOS=0,Y=0
I $P(X,"^",5) S DGPM=$G(^DGPM($P(X,"^",5),0)) D
. S BEG=+DGPM,END=DT
. I $P(DGPM,"^",17) S END=+$G(^DGPM($P(DGPM,"^",17),0))
. S LOS=$$FMDIFF^XLFDT(END,BEG)
. I (BEG\1)=(END\1) S LOS=1
I +LOS S Y=+LOS
Q Y
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HIBTODD 6301 printed Apr 09, 2024@21:38:28 Page 2
IBTODD ;ALB/AAS - CLAIMS TRACKING DENIED DAYS REPORT ; 27-OCT-93
+1 ;;2.0;INTEGRATED BILLING;**32,458,730**;21-MAR-94;Build 83
+2 ;
% IF '$DATA(DT)
DO DT^DICRW
+1 WRITE !!,"Denied Days Report",!!
+2 ;
+3 SET IBSORT="P"
SET IBSELECT="1,2,3,4,"
+4 NEW DIR
+5 SET DIR("?")="Answer YES if you only want to print a summary or answer NO if you want a detailed listing plus the summary."
+6 SET DIR(0)="Y"
SET DIR("A")="Print Summary Only"
SET DIR("B")="YES"
DO ^DIR
KILL DIR
+7 IF $DATA(DIRUT)
GOTO END
+8 SET IBSUM=Y
+9 if IBSUM
GOTO DATE
+10 ;
+11 ; -- ask what types of care to include
+12 DO TYPE^IBTODD2
IF IBSELECT<1
GOTO END
+13 ;
+14 ; -- ask how they want inpatient sorted
+15 IF IBSELECT[1
DO SORT^IBTODD2
IF IBSORT<0
GOTO END
+16 ;
DATE ; -- select date range
+1 WRITE !
DO DATE^IBOUTL
+2 IF IBBDT=""!(IBEDT="")
GOTO END
+3 ;
DEV ; -- select device, run option
+1 WRITE !
+2 IF 'IBSUM
WRITE !!,"You will need a 132 column printer for this report!",!
+3 SET %ZIS="QM"
DO ^%ZIS
if POP
GOTO END
+4 IF $DATA(IO("Q"))
SET ZTRTN="DQ^IBTODD"
SET ZTSAVE("IB*")=""
SET ZTDESC="IB - Denied Days Report"
DO ^%ZTLOAD
KILL IO("Q"),ZTSK
DO HOME^%ZIS
GOTO END
+5 ;
+6 USE IO
+7 DO DQ
GOTO END
+8 QUIT
+9 ;
END ; -- Clean up
+1 WRITE !
KILL ^TMP($JOB,"IBTODD")
+2 IF $DATA(ZTQUEUED)
SET ZTREQ="@"
QUIT
+3 DO ^%ZISC
+4 KILL I,J,X,X2,Y,DFN,%ZIS,DGPM,VA,IBI,IBJ,IBTRN,IBTRND,IBTRND1,IBPAG,IBHDT,IBDISDT,IBETYP,IBQUIT,IBTAG,IBTRC,IBTRCD,IBDEN,IBDAY,IBTALL,IBADM,IBDISCH,IBMAX
+5 KILL IBAPL,IBBBS,IBBDT,IBC,IBCDT,IBCNT,IBDT,IBD,IBDATA,IBEDT,IBNAM,IBPRIM,IBPROV,IBRATE,IBSECN,IBSERV,IBSORT,IBSPEC,IBSUM,IBSUBT,IBTOTL,IBCNTO,IBEVNTYP,IBISV,IBSELECT
+6 DO KVAR^VADPT
+7 QUIT
DQ ; -- entry print from taskman
+1 KILL ^TMP($JOB,"IBTODD")
FOR I=1:1
SET J=$PIECE(IBSELECT,",",I)
if 'J
QUIT
SET ^TMP($JOB,"IBTODD",J)=""
+2 SET X=132
XECUTE ^%ZOSF("RM")
+3 SET IBPAG=0
SET IBHDT=$$HTE^XLFDT($HOROLOG,1)
SET IBQUIT=0
+4 SET IBDEN=$ORDER(^IBE(356.7,"ACODE",20,0))
+5 DO BLD
DO PRINT^IBTODD1
+6 IF $DATA(ZTQUEUED)
GOTO END
+7 QUIT
+8 ;
BLD ; -- sort through data and build array to print from
+1 ;
+2 SET IBTRC=0
+3 FOR
SET IBTRC=$ORDER(^IBT(356.2,"ACT",IBDEN,IBTRC))
if 'IBTRC
QUIT
Begin DoDot:1
+4 NEW IBDAY
SET IBTRCD=$GET(^IBT(356.2,+IBTRC,0))
+5 SET IBTRN=$PIECE(IBTRCD,"^",2)
SET IBTRND=$GET(^IBT(356,+IBTRN,0))
+6 ; review is inactive
if '$PIECE(IBTRCD,"^",19)
QUIT
+7 ; parent CT entry is inactive
if '$PIECE(IBTRND,"^",20)
QUIT
+8 SET IBEVNTYP=$PIECE(IBTRND,U,18)
if IBEVNTYP=5
SET IBEVNTYP=1
+9 ;
+10 IF IBEVNTYP=1
IF IBSELECT[1
Begin DoDot:2
+11 SET IBDDB=$PIECE(IBTRCD,"^",15)
SET IBDDE=$PIECE(IBTRCD,"^",16)
+12 SET IBTALL=$PIECE($GET(^IBT(356.2,+IBTRC,1)),"^",7)
+13 ; admissions length of stay
SET IBLOSI=$$LOS(IBTRN)
+14 IF IBDDB
IF IBDDE
if (IBDDB>IBEDT)!(IBDDE<IBBDT)
QUIT
Begin DoDot:3
+15 ; chk days denied in correct range
IF IBDDB<IBBDT
SET IBDDB=IBBDT
+16 IF IBDDE>IBEDT
SET IBDDE=IBEDT
+17 ; cals total denied days
SET IBDAY=$$FMDIFF^XLFDT(IBDDE,IBDDB)+1
End DoDot:3
+18 ; if no days denied "to" and "from" and episode in range
+19 IF (IBTALL)
IF ('$DATA(IBDAY))
SET IBCDT=$$CDT^IBTODD1(IBTRN)
DO STRIP
if ('+IBCDT!(+IBCDT>IBEDT))
QUIT
Begin DoDot:3
+20 ;Q:'$P(IBTRND,U,5) ; quit if no link between ct and dgpm
+21 ; unlinked all to event dt+1 los
IF '$PIECE(IBCDT,U,2)
SET $PIECE(IBCDT,U,2)=$$FMADD^XLFDT($PIECE(IBCDT,U,1),1)
+22 ; if the care date is >the report range there is no discharge add 1
+23 IF '$PIECE(IBCDT,U,2)!($PIECE(IBCDT,U,2)>IBEDT)
SET $PIECE(IBCDT,U,2)=$$FMADD^XLFDT(IBEDT,1)
+24 IF +IBCDT<IBBDT
SET $PIECE(IBCDT,U,1)=IBBDT
+25 SET IBDAY=$$FMDIFF^XLFDT($PIECE(IBCDT,U,2),$PIECE(IBCDT,U,1))
End DoDot:3
+26 ; get one day stays
IF IBLOSI=1
IF $GET(IBDAY)=0
SET IBDAY=1
+27 if $GET(IBDAY)<1
QUIT
+28 SET DFN=$PIECE(IBTRCD,"^",5)
SET IBNAM=$PIECE($GET(^DPT(+DFN,0)),"^")
if IBNAM=""
QUIT
+29 SET IBD=$$PROV(DFN,IBTRCD,IBTRND,IBTALL)
SET IBPROV=+IBD
SET IBSPEC=$PIECE(IBD,"^",2)
SET IBSERV=$PIECE(IBD,"^",3)
+30 ;S IBBBS=$$BBS^IBTOSUM1($P(IBD,"^",2))
+31 ;S IBRATE=$$RATE^IBTOSUM1(IBBBS,+IBTRCD)
+32 ; get events charge
SET IBRATE=$$AMOUNT^IBJDB21(1,IBTRN)
+33 ; calculate amount for days denied
IF +IBLOSI
IF +IBRATE
SET IBRATE=(IBRATE/IBLOSI)*IBDAY
+34 DO SET
End DoDot:2
QUIT
+35 ;
+36 IF IBEVNTYP'=1
IF IBSELECT[IBEVNTYP
Begin DoDot:2
+37 SET IBDDB=$PIECE(IBTRND,"^",6)
+38 if (IBDDB<IBBDT)!(IBDDB>IBEDT)
QUIT
+39 SET DFN=$PIECE(IBTRCD,"^",5)
SET IBNAM=$PIECE($GET(^DPT(+DFN,0)),"^")
if IBNAM=""
QUIT
+40 SET IBPROV=0
SET IBSPEC=0
SET IBSERV=$SELECT(IBEVNTYP=2:"OUTPATIENT",IBEVNTYP=3:"PROSTHETICS",IBEVNTYP=4:"PRESCRIPTION",1:"UNKNOWN")
+41 ; get events charge
SET IBDAY=1
SET IBRATE=$$AMOUNT^IBJDB21(IBEVNTYP,IBTRN)
+42 DO SET
End DoDot:2
QUIT
End DoDot:1
+43 KILL IBTRN,IBTRND,IBTRCD,DFN,IBDDB,IBDDE,IBCDT,IBLOSI
+44 QUIT
+45 ;
SET ; -- set array to print from
+1 ; -- ^tmp($j,"ibtodd",evnt typ,primary sort,secondary sort,ibtrc)=DFN ^ attending ^ treating specialty ^ service ^ ^ billing rate^ no. days denied
+2 SET IBPRIM=$SELECT(IBSORT="P":IBNAM,IBSORT="A":IBPROV,1:IBSERV)
+3 SET IBSECN=$SELECT(IBSORT="P":IBPROV,1:IBNAM)
+4 IF IBEVNTYP'=1
SET IBPRIM=IBNAM
SET IBSECN=IBDDB
+5 if IBPRIM=""
SET IBPRIM="UNKNOWN"
if IBSECN=""
SET IBSECN="UNKNOWN"
+6 SET ^TMP($JOB,"IBTODD",IBEVNTYP,IBPRIM,IBSECN,IBTRC)=DFN_"^"_IBPROV_"^"_IBSPEC_"^"_IBSERV_"^^"_IBRATE_"^"_IBDAY
+7 QUIT
+8 ;
PROV(DFN,IBTRCD,IBTRND,IBTALL) ; Find attending/serv/spec during the denied period
+1 ; Input: DFN -- Pointer to the patient in file #2
+2 ; IBTRCD -- Zeroth node of insurance review in file #356.2
+3 ; IBTRND -- Zeroth node of parent CT entry in file #356
+4 ; IBTALL -- 1=> deny entire admission
+5 ; Output: 1^2^3, where 1 => pointer to attending in file #200
+6 ; 2 => pointer to treating spec. in file #45.7
+7 ; 3 => service abbr. code
+8 ;
+9 NEW I,J,X,Y,DGPM,IBD,VA200,VAIN,VAIP,VAERR
+10 ;
+11 ; - determine date/time to calculate attending/serv/spec
+12 SET DGPM=+$PIECE(IBTRND,"^",5)
SET IBD=+$GET(^DGPM(DGPM,0))
+13 if 'IBD
SET IBD=$PIECE(IBTRND,"^",6)
+14 IF IBTALL
SET Y=IBD
+15 IF 'IBTALL
Begin DoDot:1
+16 IF $PIECE(IBTRCD,"^",16)>$PIECE(IBTRCD,"^",15)
SET Y=$PIECE(IBTRCD,"^",15)_.2359
QUIT
+17 IF $PIECE(IBTRCD,"^",15)=(IBD\1)
SET Y=IBD
QUIT
+18 SET VAIP("D")=$PIECE(IBTRCD,"^",15)
DO IN5^VADPT
+19 IF +VAIP(16,1)\1=$PIECE(IBTRCD,"^",15)
SET Y=+VAIP(16,1)
QUIT
+20 SET Y=$PIECE(IBTRCD,"^",15)
End DoDot:1
+21 SET VA200=""
SET VAINDT=Y
DO INP^VADPT
+22 ;
+23 SET X=+VAIN(11)
+24 SET Y=$GET(^IBT(356.94,+$ORDER(^IBT(356.94,"ATP",+DGPM,1,0)),0))
+25 if $PIECE(Y,"^",3)
SET X=$PIECE(Y,"^",3)
PROVQ QUIT X_"^"_+VAIN(3)_"^"_$PIECE($GET(^DIC(42.4,+$PIECE($GET(^DIC(45.7,+$GET(VAIN(3)),0)),"^",2),0)),"^",3)
+1 ;
STRIP ; -- strip time from dates (if report run same day time could produce incorrect results)
+1 SET $PIECE(IBCDT,U,1)=$PIECE(IBCDT,".",1)
SET $PIECE(IBCDT,U,2)=$PIECE($PIECE(IBCDT,U,2),".",1)
QUIT
+2 ;
LOS(IBTRN) ; compute admissions length of stay
+1 NEW X,Y,DGPM,BEG,END,LOS
SET X=$GET(^IBT(356,+$GET(IBTRN),0))
SET LOS=0
SET Y=0
+2 IF $PIECE(X,"^",5)
SET DGPM=$GET(^DGPM($PIECE(X,"^",5),0))
Begin DoDot:1
+3 SET BEG=+DGPM
SET END=DT
+4 IF $PIECE(DGPM,"^",17)
SET END=+$GET(^DGPM($PIECE(DGPM,"^",17),0))
+5 SET LOS=$$FMDIFF^XLFDT(END,BEG)
+6 IF (BEG\1)=(END\1)
SET LOS=1
End DoDot:1
+7 IF +LOS
SET Y=+LOS
+8 QUIT Y
