IBTODD.m

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