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
