IBOHLD1.m

IBOHLD1	;ALB/CJM -  REPORT OF CHARGES ON HOLD ;MARCH 3 1992

	;;Version 2.0 ; INTEGRATED BILLING ;; 21-MAR-94

MAIN	;

	N IBQUIT S IBQUIT=0

QUEUED	; entry point if queued

	;***

	;S XRTL=$ZU(0),XRTN="IBOHLD1-2" D T0^%ZOSV ;start rt clock

	K ^TMP($J)

	D:'$G(IBQUIT) DEVICE D:'$G(IBQUIT) CHRGS,REPORT^IBOHLD2

	D EXIT

	;***

	;I $D(XRT0) S:'$D(XRTN) XRTN="IBOHLD1" D T1^%ZOSV ;stop rt clock

	Q

EXIT	;

	K ^TMP($J)

	I $D(ZTQUEUED) S ZTREQ="@" Q

	D ^%ZISC

	Q

DEVICE	;

	I $D(ZTQUEUED) Q

	W !!,*7,"*** Margin width of this output is 132 ***"

	W !,"*** This output should be queued ***"

	S %ZIS="QM" D ^%ZIS I POP S IBQUIT=1 Q

	I $D(IO("Q")) S ZTRTN="QUEUED^IBOHLD1",ZTIO=ION,ZTDESC="HELD CHARGES REPORT" D ^%ZTLOAD W !,$S($D(ZTSK):"REQUEST QUEUED TASK="_ZTSK,1:"REQUEST CANCELLED") D HOME^%ZIS K ZTSK S IBQUIT=1 Q

	U IO

	Q

	; indexes records that should be included in report

	;

CHRGS	; charges on hold

	N IBN,DFN,IBNAME,IBND

	S DFN=0 F  S DFN=$O(^IB("AH",DFN)) Q:'DFN  D PAT S IBN=0 F  S IBN=$O(^IB("AH",DFN,IBN)) Q:'IBN  D

	.S IBND=$G(^IB(IBN,0)) Q:'IBND

	.S ^TMP($J,"HOLD",IBNAME,DFN,IBN)=""

	.D BILLS

	Q

PAT	; patient name

	N VAERR,VADM D DEM^VADPT I VAERR K VADM

	S IBNAME=$G(VADM(1)) S:IBNAME="" IBNAME=" "

	Q

BILLS	; find bills for charges on hold

	N IBFR,IBT,IBATYPE,IBTO

	S IBATYPE=$S($P($G(^IBE(350.1,+$P(IBND,"^",3),0)),"^")["OPT":"O",1:"I")

	S IBFR=$P(IBND,"^",14),IBTO=$P(IBND,"^",15)

	I IBATYPE="I" D

	.D INP

	E  D OTP

	Q

INP	; inpatient bills

	N IBEV,IBBILL,IBT,X,IBEND,IBOK

	S IBEV=$P(IBND,"^",16) Q:'IBEV  ; parent event

	S IBEV=($P($G(^IB(IBEV,0)),"^",17)\1) Q:'IBEV  ; date of parent event

	S X1=IBEV,X2=1 D C^%DTC S IBEND=X

	S IBT=(IBEV-.0001) F  S IBT=$O(^DGCR(399,"D",IBT)) Q:'IBT!(IBT'<IBEND)  S IBBILL=0 F  S IBBILL=$O(^DGCR(399,"D",IBT,IBBILL)) Q:IBBILL=""  D

	.D INPTCK

	.I IBOK S ^TMP($J,"HOLD",IBNAME,DFN,IBN,IBBILL)=""

	Q

	;

INPTCK	; does bill belong to charge? returns IBOK=0 if no

	N IBBILL0,IBBILLU

	S IBBILL0=$G(^DGCR(399,IBBILL,0)),IBBILLU=$G(^("U"))

	S IBOK=1

CK1	; for same patient?

	I DFN=$P(IBBILL0,"^",2)

	S IBOK=$T

	Q:'IBOK

CK2	; same type- inp or opt?

	N B S B=$S(+$P(IBBILL0,"^",5)<3:"I",1:"O")

	I B=IBATYPE

	S IBOK=$T

	Q:'IBOK

CK3	; overlap in date range?

	N F,T

	S F=+IBBILLU,T=$P(IBBILLU,"^",2)

	I (IBTO<F)!(IBFR>T)

	S IBOK='$T

	Q:'IBOK

CK4	; insurance bill?

	I $P(IBBILL0,"^",11)="i"

	S IBOK=$T

	Q

OTP	; outpatient bills

	N X,IBV,IBBILL,IBOK,IBBILL0

	S IBV=(IBFR\1)-.0001 F  S IBV=$O(^DGCR(399,"AOPV",DFN,IBV)) Q:'IBV!(IBV>IBTO)  S IBBILL=0 D

	.F  S IBBILL=$O(^DGCR(399,"AOPV",DFN,IBV,IBBILL)) Q:('IBBILL)  D

	..Q:$D(^TMP($J,"HOLD",IBNAME,DFN,IBN,IBBILL))

	..S IBBILL0=$G(^DGCR(399,IBBILL,0)) D CK4 Q:'IBOK

	..S ^TMP($J,"HOLD",IBNAME,DFN,IBN,IBBILL)=""

	Q

IBOHLD1   ;ALB/CJM -  REPORT OF CHARGES ON HOLD ;MARCH 3 1992

 +1       ;;Version 2.0 ; INTEGRATED BILLING ;; 21-MAR-94

MAIN      ;

 +1        NEW IBQUIT

           SET IBQUIT=0

QUEUED    ; entry point if queued

 +1       ;***

 +2       ;S XRTL=$ZU(0),XRTN="IBOHLD1-2" D T0^%ZOSV ;start rt clock

 +3        KILL ^TMP($JOB)

 +4        IF '$GET(IBQUIT)

               DO DEVICE

           IF '$GET(IBQUIT)

               DO CHRGS

               DO REPORT^IBOHLD2

 +5        DO EXIT

 +6       ;***

 +7       ;I $D(XRT0) S:'$D(XRTN) XRTN="IBOHLD1" D T1^%ZOSV ;stop rt clock

 +8        QUIT 

EXIT      ;

 +1        KILL ^TMP($JOB)

 +2        IF $DATA(ZTQUEUED)

               SET ZTREQ="@"

               QUIT 

 +3        DO ^%ZISC

 +4        QUIT 

DEVICE    ;

 +1        IF $DATA(ZTQUEUED)

               QUIT 

 +2        WRITE !!,*7,"*** Margin width of this output is 132 ***"

 +3        WRITE !,"*** This output should be queued ***"

 +4        SET %ZIS="QM"

           DO ^%ZIS

           IF POP

               SET IBQUIT=1

               QUIT 

 +5        IF $DATA(IO("Q"))

               SET ZTRTN="QUEUED^IBOHLD1"

               SET ZTIO=ION

               SET ZTDESC="HELD CHARGES REPORT"

               DO ^%ZTLOAD

               WRITE !,$SELECT($DATA(ZTSK):"REQUEST QUEUED TASK="_ZTSK,1:"REQUEST CANCELLED")

               DO HOME^%ZIS

               KILL ZTSK

               SET IBQUIT=1

               QUIT 

 +6        USE IO

 +7        QUIT 

 +8       ; indexes records that should be included in report

 +9       ;

CHRGS     ; charges on hold

 +1        NEW IBN,DFN,IBNAME,IBND

 +2        SET DFN=0

           FOR 

               SET DFN=$ORDER(^IB("AH",DFN))

               IF 'DFN

                   QUIT 

               DO PAT

               SET IBN=0

               FOR 

                   SET IBN=$ORDER(^IB("AH",DFN,IBN))

                   IF 'IBN

                       QUIT 

                   Begin DoDot:1

 +3                    SET IBND=$GET(^IB(IBN,0))

                       IF 'IBND

                           QUIT 

 +4                    SET ^TMP($JOB,"HOLD",IBNAME,DFN,IBN)=""

 +5                    DO BILLS

                   End DoDot:1

 +6        QUIT 

PAT       ; patient name

 +1        NEW VAERR,VADM

           DO DEM^VADPT

           IF VAERR

               KILL VADM

 +2        SET IBNAME=$GET(VADM(1))

           IF IBNAME=""

               SET IBNAME=" "

 +3        QUIT 

BILLS     ; find bills for charges on hold

 +1        NEW IBFR,IBT,IBATYPE,IBTO

 +2        SET IBATYPE=$SELECT($PIECE($GET(^IBE(350.1,+$PIECE(IBND,"^",3),0)),"^")["OPT":"O",1:"I")

 +3        SET IBFR=$PIECE(IBND,"^",14)

           SET IBTO=$PIECE(IBND,"^",15)

 +4        IF IBATYPE="I"

               Begin DoDot:1

 +5                DO INP

               End DoDot:1

 +6       IF '$TEST

               DO OTP

 +7        QUIT 

INP       ; inpatient bills

 +1        NEW IBEV,IBBILL,IBT,X,IBEND,IBOK

 +2       ; parent event

           SET IBEV=$PIECE(IBND,"^",16)

           IF 'IBEV

               QUIT 

 +3       ; date of parent event

           SET IBEV=($PIECE($GET(^IB(IBEV,0)),"^",17)\1)

           IF 'IBEV

               QUIT 

 +4        SET X1=IBEV

           SET X2=1

           DO C^%DTC

           SET IBEND=X

 +5        SET IBT=(IBEV-.0001)

           FOR 

               SET IBT=$ORDER(^DGCR(399,"D",IBT))

               IF 'IBT!(IBT'<IBEND)

                   QUIT 

               SET IBBILL=0

               FOR 

                   SET IBBILL=$ORDER(^DGCR(399,"D",IBT,IBBILL))

                   IF IBBILL=""

                       QUIT 

                   Begin DoDot:1

 +6                    DO INPTCK

 +7                    IF IBOK

                           SET ^TMP($JOB,"HOLD",IBNAME,DFN,IBN,IBBILL)=""

                   End DoDot:1

 +8        QUIT 

 +9       ;

INPTCK    ; does bill belong to charge? returns IBOK=0 if no

 +1        NEW IBBILL0,IBBILLU

 +2        SET IBBILL0=$GET(^DGCR(399,IBBILL,0))

           SET IBBILLU=$GET(^("U"))

 +3        SET IBOK=1

CK1       ; for same patient?

 +1        IF DFN=$PIECE(IBBILL0,"^",2)

 +2        SET IBOK=$TEST

 +3        IF 'IBOK

               QUIT 

CK2       ; same type- inp or opt?

 +1        NEW B

           SET B=$SELECT(+$PIECE(IBBILL0,"^",5)<3:"I",1:"O")

 +2        IF B=IBATYPE

 +3        SET IBOK=$TEST

 +4        IF 'IBOK

               QUIT 

CK3       ; overlap in date range?

 +1        NEW F,T

 +2        SET F=+IBBILLU

           SET T=$PIECE(IBBILLU,"^",2)

 +3        IF (IBTO<F)!(IBFR>T)

 +4        SET IBOK='$TEST

 +5        IF 'IBOK

               QUIT 

CK4       ; insurance bill?

 +1        IF $PIECE(IBBILL0,"^",11)="i"

 +2        SET IBOK=$TEST

 +3        QUIT 

OTP       ; outpatient bills

 +1        NEW X,IBV,IBBILL,IBOK,IBBILL0

 +2        SET IBV=(IBFR\1)-.0001

           FOR 

               SET IBV=$ORDER(^DGCR(399,"AOPV",DFN,IBV))

               IF 'IBV!(IBV>IBTO)

                   QUIT 

               SET IBBILL=0

               Begin DoDot:1

 +3                FOR 

                       SET IBBILL=$ORDER(^DGCR(399,"AOPV",DFN,IBV,IBBILL))

                       IF ('IBBILL)

                           QUIT 

                       Begin DoDot:2

 +4                        IF $DATA(^TMP($JOB,"HOLD",IBNAME,DFN,IBN,IBBILL))

                               QUIT 

 +5                        SET IBBILL0=$GET(^DGCR(399,IBBILL,0))

                           DO CK4

                           IF 'IBOK

                               QUIT 

 +6                        SET ^TMP($JOB,"HOLD",IBNAME,DFN,IBN,IBBILL)=""

                       End DoDot:2

               End DoDot:1

 +7        QUIT