IBTODD ;ALB/AAS - CLAIMS TRACKING DENIED DAYS REPORT ; 27-OCT-93
;;Version 2.0 ; INTEGRATED BILLING ;; 21-MAR-94
;
% I '$D(DT) D DT^DICRW
W !!,"Denied Days Report",!!
;
S IBSORT="P"
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
;
SORT ; -- ask how they want it sorted
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)) 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
D KVAR^VADPT
Q
DQ ; -- entry print from taskman
K ^TMP($J,"IBTODD")
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 IBTRN,IBTRND,IBTRCD,DFN
.S IBTRCD=$G(^IBT(356.2,+IBTRC,0))
.S IBTALL=$P($G(^IBT(356.2,+IBTRC,1)),"^",7)
.I +IBTRCD<IBBDT!(+IBTRCD>(IBEDT+.9)) Q
.S IBTRN=$P(IBTRCD,"^",2),IBTRND=$G(^IBT(356,+IBTRN,0))
.I $P($G(^IBE(356.6,+$P(IBTRND,"^",18),0)),"^",3)'=1 Q ; not an admission type event
.S DFN=$P(IBTRCD,"^",5),IBNAM=$P($G(^DPT(+DFN,0)),"^") Q:IBNAM=""
.S IBD=$$PROV(IBTRC),IBPROV=+IBD,IBSPEC=$P(IBD,"^",2),IBSERV=$P(IBD,"^",3)
.S IBBBS=$$BBS^IBTOSUM1($P(IBD,"^",2))
.S IBRATE=$$RATE^IBTOSUM1(IBBBS,+IBTRCD)
.S IBMAX=$$DAY^IBTUTL3(IBBDT,IBEDT)+1
.S IBCDT=$$CDT^IBTODD1(IBTRN)
.I 'IBTALL S IBDAY=$$DAY^IBTUTL3(+$P(IBTRCD,"^",15),+$P(IBTRCD,"^",16),IBTRN)
.I IBTALL S IBDAY=$$DAY^IBTUTL3(+IBCDT,$S($P(IBCDT,"^",2):$P(IBCDT,"^",2),1:DT),IBTRN)
.I IBDAY>IBMAX S IBDAY=IBMAX
.D SET
Q
;
SET ; -- set array to print from
; -- ^tmp($j,"ibtodd",primary sort,secondary sort,ibtrc)=DFN ^ attending ^ treating specialty ^ service ^ billing bed section ^ billing rate^ no. days denied
S IBPRIM=$S(IBSORT="P":IBNAM,IBSORT="A":IBPROV,1:IBSERV)
S IBSECN=$S(IBSORT="P":IBPROV,1:IBNAM)
S:IBPRIM="" IBPRIM="UNKNOWN" S:IBSECN="" IBSECN="UNKNOWN"
S ^TMP($J,"IBTODD",IBPRIM,IBSECN,IBTRC)=DFN_"^"_IBPROV_"^"_IBSPEC_"^"_IBSERV_"^"_IBBBS_"^"_IBRATE_"^"_IBDAY
Q
;
PROV(IBTRC) ; -- find attending for an inpt. stay
N I,J,X,Y,DFN,DGPM,VA200,VAIN,VAERR
;
S VA200="",VAINDT=+$G(^IBT(356.2,+IBTRC,0)),DFN=$P($G(^(0)),"^",5) D INP^VADPT
I VAIN(1)="" S VAINDT=+$G(^DGPM(+$P($G(^IBT(356,+$P($G(^IBT(356.2,+IBTRC,0)),"^",2),0)),"^",5),0)) S VAINDT=$P(VAINDT,".")+.24 D INP^VADPT
;
S X=+VAIN(11)
S DGPM=$P($G(^IBT(356,+$P($G(^IBT(356.2,+IBTRC,0)),"^",2),0)),"^",5)
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)
;
Q
;
SUBH(Z) ; -- write sub header for report
; input z = subheader data
; requires ibsort = how report is sorted
N X S X=""
Q:IBSORT="P" ; no sub header if sorting by patient
I IBSORT="S" S X="Service: "_$$EXPAND^IBTRE(42.4,3,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 !?64,"------",!,?64,$J(IBSUBT,6)
SUBTQ S IBSUBT=0
Q
IBTODD ;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
+1 WRITE !!,"Denied Days Report",!!
+2 ;
+3 SET IBSORT="P"
+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 ;
SORT ; -- ask how they want it sorted
+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))
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
+6 DO KVAR^VADPT
+7 QUIT
DQ ; -- entry print from taskman
+1 KILL ^TMP($JOB,"IBTODD")
+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 IBTRN,IBTRND,IBTRCD,DFN
+5 SET IBTRCD=$GET(^IBT(356.2,+IBTRC,0))
+6 SET IBTALL=$PIECE($GET(^IBT(356.2,+IBTRC,1)),"^",7)
+7 IF +IBTRCD<IBBDT!(+IBTRCD>(IBEDT+.9))
QUIT
+8 SET IBTRN=$PIECE(IBTRCD,"^",2)
SET IBTRND=$GET(^IBT(356,+IBTRN,0))
+9 ; not an admission type event
IF $PIECE($GET(^IBE(356.6,+$PIECE(IBTRND,"^",18),0)),"^",3)'=1
QUIT
+10 SET DFN=$PIECE(IBTRCD,"^",5)
SET IBNAM=$PIECE($GET(^DPT(+DFN,0)),"^")
IF IBNAM=""
QUIT
+11 SET IBD=$$PROV(IBTRC)
SET IBPROV=+IBD
SET IBSPEC=$PIECE(IBD,"^",2)
SET IBSERV=$PIECE(IBD,"^",3)
+12 SET IBBBS=$$BBS^IBTOSUM1($PIECE(IBD,"^",2))
+13 SET IBRATE=$$RATE^IBTOSUM1(IBBBS,+IBTRCD)
+14 SET IBMAX=$$DAY^IBTUTL3(IBBDT,IBEDT)+1
+15 SET IBCDT=$$CDT^IBTODD1(IBTRN)
+16 IF 'IBTALL
SET IBDAY=$$DAY^IBTUTL3(+$PIECE(IBTRCD,"^",15),+$PIECE(IBTRCD,"^",16),IBTRN)
+17 IF IBTALL
SET IBDAY=$$DAY^IBTUTL3(+IBCDT,$SELECT($PIECE(IBCDT,"^",2):$PIECE(IBCDT,"^",2),1:DT),IBTRN)
+18 IF IBDAY>IBMAX
SET IBDAY=IBMAX
+19 DO SET
End DoDot:1
+20 QUIT
+21 ;
SET ; -- set array to print from
+1 ; -- ^tmp($j,"ibtodd",primary sort,secondary sort,ibtrc)=DFN ^ attending ^ treating specialty ^ service ^ billing bed section ^ 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 IBPRIM=""
SET IBPRIM="UNKNOWN"
IF IBSECN=""
SET IBSECN="UNKNOWN"
+5 SET ^TMP($JOB,"IBTODD",IBPRIM,IBSECN,IBTRC)=DFN_"^"_IBPROV_"^"_IBSPEC_"^"_IBSERV_"^"_IBBBS_"^"_IBRATE_"^"_IBDAY
+6 QUIT
+7 ;
PROV(IBTRC) ; -- find attending for an inpt. stay
+1 NEW I,J,X,Y,DFN,DGPM,VA200,VAIN,VAERR
+2 ;
+3 SET VA200=""
SET VAINDT=+$GET(^IBT(356.2,+IBTRC,0))
SET DFN=$PIECE($GET(^(0)),"^",5)
DO INP^VADPT
+4 IF VAIN(1)=""
SET VAINDT=+$GET(^DGPM(+$PIECE($GET(^IBT(356,+$PIECE($GET(^IBT(356.2,+IBTRC,0)),"^",2),0)),"^",5),0))
SET VAINDT=$PIECE(VAINDT,".")+.24
DO INP^VADPT
+5 ;
+6 SET X=+VAIN(11)
+7 SET DGPM=$PIECE($GET(^IBT(356,+$PIECE($GET(^IBT(356.2,+IBTRC,0)),"^",2),0)),"^",5)
+8 SET Y=$GET(^IBT(356.94,+$ORDER(^IBT(356.94,"ATP",+DGPM,1,0)),0))
+9 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 ;
+2 QUIT
+3 ;
SUBH(Z) ; -- write sub header for report
+1 ; input z = subheader data
+2 ; requires ibsort = how report is sorted
+3 NEW X
SET X=""
+4 ; no sub header if sorting by patient
IF IBSORT="P"
QUIT
+5 IF IBSORT="S"
SET X="Service: "_$$EXPAND^IBTRE(42.4,3,IBI)
+6 IF IBSORT="A"
SET X="Attending: "_IBI
+7 IF $LENGTH(X)
WRITE !!?15,X
+8 QUIT
+9 ;
SUBT ; -- write out sub totals, initialize variable
+1 IF '$GET(IBSUBT)
GOTO SUBTQ
+2 WRITE !?64,"------",!,?64,$JUSTIFY(IBSUBT,6)
SUBTQ SET IBSUBT=0
+1 QUIT
