IBOHLD2 ;ALB/CJM - REPORT OR HELD CATC CHARGES ;MAR 6,1991
;;Version 2.0 ; INTEGRATED BILLING ;; 21-MAR-94
REPORT ;
N IBQUIT,IBPAGE,IBNOW,IBLINE,IBCRT,IBBOT,DFN,IBNAME,IBN
S IBCRT=0,IBBOT=6,IBQUIT=0 I $E(IOST,1,2)="C-" S IBCRT=1,IBBOT=2
S IBLINE="",$P(IBLINE,"=",86)="||",IBLINE=IBLINE_$E(IBLINE,1,45)
D NOW^%DTC S Y=X X ^DD("DD") S IBNOW=Y
I IBCRT W @IOF
LOOP ;
S IBPAGE=1 D HEADER Q:IBQUIT
S IBNAME="" F S IBNAME=$O(^TMP($J,"HOLD",IBNAME)) Q:IBNAME=""!(IBQUIT) S DFN=0 F S DFN=$O(^TMP($J,"HOLD",IBNAME,DFN)) Q:'DFN!(IBQUIT) D PRNTPAT Q:IBQUIT S IBN=0 F S IBN=$O(^TMP($J,"HOLD",IBNAME,DFN,IBN)) Q:'IBN!(IBQUIT) D
.D PRNTCHG,PRNTBILL:'IBQUIT
Q
PRNTBILL ; prints bills for a charge
N IB,IB0,IBSTAT,IBCHG,IBPD,C,Y,I,IBT
D:$Y-IBBOT+1>IOSL HEADER Q:IBQUIT
S IB="" F I=1:1 S IB=$O(^TMP($J,"HOLD",IBNAME,DFN,IBN,IB)) W:'IB&(I<2) ?85,"||",! D:$Y+IBBOT>IOSL HEADER Q:'IB!(IBQUIT) D
.W ?85,"||"
.S IB0=$G(^DGCR(399,IB,0)) Q:IB0=""
.W ?88,$P(IB0,"^",1) ; bill #
.S IBSTAT=$$STA^PRCAFN(IB)
.W:+IBSTAT>0 ?97,$E($P(IBSTAT,"^",2),1,14)
.S IBT=$J((+^DGCR(399,IB,"U1")-$P(^("U1"),"^",2)),9,2)
.W ?112,IBT ; total charges
.S IBPD=$$TPR^PRCAFN(IB) S:IBPD<0 IBPD="" S IBPD=$J(IBPD,9,2) W ?123,IBPD,! D:$Y+IBBOT>IOSL HEADER
Q
PRNTPAT ; prints patient data
N VAERR,VADM,IBSSN D DEM^VADPT S:'VAERR IBSSN=VA("BID") ; pt id,brief
D:$Y+IBBOT>IOSL HEADER Q:IBQUIT
W $E(IBNAME,1,20),?22,IBSSN
Q
PRNTCHG ; prints a charge
N IBACT,IBTYPE,IBBILL,IBFR,IBTO,IBCHG,IBND
S IBND=$G(^IB(IBN,0))
; action id
S IBACT=+IBND
; type
S IBTYPE=$P(IBND,"^",3),IBTYPE=$E($P($G(^IBE(350.1,IBTYPE,0)),"^",1),4,7)
; bill #
S IBBILL=$P($P(IBND,"^",11),"-",2)
; from date
S IBFR=$$DAT1^IBOUTL($P(IBND,"^",14))
; to date
S IBTO=$$DAT1^IBOUTL($P(IBND,"^",15))
; charge$
S IBCHG=$J(+$P(IBND,"^",7),9,2)
W ?29,IBACT,?39,IBTYPE,?46,IBBILL,?55,IBFR,?66,IBTO,?75,IBCHG
Q
Q:IBQUIT
I IBCRT,$Y>1 D Q:IBQUIT
.F Q:$Y>(IOSL-1) W !
.N T R " Press RETURN to continue",T:DTIME I '$T!(T["^") S IBQUIT=1 Q
I IBPAGE>1 W !,@IOF
W ?53,"CATEGORY C CHARGES ON HOLD",?110,IBNOW," PAGE ",IBPAGE,!,"HELD CHARGES",?87,"CORRESPONDING THIRD PARTY BILLS",!,IBLINE
W !,"Name",?22,"Pt.ID",?29,"ActionID",?39,"Type",?46,"Bill#",?55,"From",?66,"To",?78,"Charge",?85,"||",?88,"Bill#",?97,"AR-Status",?115,"Charge",?128,"Paid"
W !,IBLINE,!
S IBPAGE=IBPAGE+1
Q
IBOHLD2 ;ALB/CJM - REPORT OR HELD CATC CHARGES ;MAR 6,1991
+1 ;;Version 2.0 ; INTEGRATED BILLING ;; 21-MAR-94
REPORT ;
+1 NEW IBQUIT,IBPAGE,IBNOW,IBLINE,IBCRT,IBBOT,DFN,IBNAME,IBN
+2 SET IBCRT=0
SET IBBOT=6
SET IBQUIT=0
IF $EXTRACT(IOST,1,2)="C-"
SET IBCRT=1
SET IBBOT=2
+3 SET IBLINE=""
SET $PIECE(IBLINE,"=",86)="||"
SET IBLINE=IBLINE_$EXTRACT(IBLINE,1,45)
+4 DO NOW^%DTC
SET Y=X
XECUTE ^DD("DD")
SET IBNOW=Y
+5 IF IBCRT
WRITE @IOF
LOOP ;
+1 SET IBPAGE=1
DO HEADER
IF IBQUIT
QUIT
+2 SET IBNAME=""
FOR
SET IBNAME=$ORDER(^TMP($JOB,"HOLD",IBNAME))
IF IBNAME=""!(IBQUIT)
QUIT
SET DFN=0
FOR
SET DFN=$ORDER(^TMP($JOB,"HOLD",IBNAME,DFN))
IF 'DFN!(IBQUIT)
QUIT
DO PRNTPAT
IF IBQUIT
QUIT
SET IBN=0
FOR
SET IBN=$ORDER(^TMP($JOB,"HOLD",IBNAME,DFN,IBN))
IF 'IBN!(IBQUIT)
QUIT
Begin DoDot:1
+3 DO PRNTCHG
IF 'IBQUIT
DO PRNTBILL
End DoDot:1
+4 QUIT
PRNTBILL ; prints bills for a charge
+1 NEW IB,IB0,IBSTAT,IBCHG,IBPD,C,Y,I,IBT
+2 IF $Y-IBBOT+1>IOSL
DO HEADER
IF IBQUIT
QUIT
+3 SET IB=""
FOR I=1:1
SET IB=$ORDER(^TMP($JOB,"HOLD",IBNAME,DFN,IBN,IB))
IF 'IB&(I<2)
WRITE ?85,"||",!
IF $Y+IBBOT>IOSL
DO HEADER
IF 'IB!(IBQUIT)
QUIT
Begin DoDot:1
+4 WRITE ?85,"||"
+5 SET IB0=$GET(^DGCR(399,IB,0))
IF IB0=""
QUIT
+6 ; bill #
WRITE ?88,$PIECE(IB0,"^",1)
+7 SET IBSTAT=$$STA^PRCAFN(IB)
+8 IF +IBSTAT>0
WRITE ?97,$EXTRACT($PIECE(IBSTAT,"^",2),1,14)
+9 SET IBT=$JUSTIFY((+^DGCR(399,IB,"U1")-$PIECE(^("U1"),"^",2)),9,2)
+10 ; total charges
WRITE ?112,IBT
+11 SET IBPD=$$TPR^PRCAFN(IB)
IF IBPD<0
SET IBPD=""
SET IBPD=$JUSTIFY(IBPD,9,2)
WRITE ?123,IBPD,!
IF $Y+IBBOT>IOSL
DO HEADER
End DoDot:1
+12 QUIT
PRNTPAT ; prints patient data
+1 ; pt id,brief
NEW VAERR,VADM,IBSSN
DO DEM^VADPT
IF 'VAERR
SET IBSSN=VA("BID")
+2 IF $Y+IBBOT>IOSL
DO HEADER
IF IBQUIT
QUIT
+3 WRITE $EXTRACT(IBNAME,1,20),?22,IBSSN
+4 QUIT
PRNTCHG ; prints a charge
+1 NEW IBACT,IBTYPE,IBBILL,IBFR,IBTO,IBCHG,IBND
+2 SET IBND=$GET(^IB(IBN,0))
+3 ; action id
+4 SET IBACT=+IBND
+5 ; type
+6 SET IBTYPE=$PIECE(IBND,"^",3)
SET IBTYPE=$EXTRACT($PIECE($GET(^IBE(350.1,IBTYPE,0)),"^",1),4,7)
+7 ; bill #
+8 SET IBBILL=$PIECE($PIECE(IBND,"^",11),"-",2)
+9 ; from date
+10 SET IBFR=$$DAT1^IBOUTL($PIECE(IBND,"^",14))
+11 ; to date
+12 SET IBTO=$$DAT1^IBOUTL($PIECE(IBND,"^",15))
+13 ; charge$
+14 SET IBCHG=$JUSTIFY(+$PIECE(IBND,"^",7),9,2)
+15 WRITE ?29,IBACT,?39,IBTYPE,?46,IBBILL,?55,IBFR,?66,IBTO,?75,IBCHG
+16 QUIT
+1 IF IBQUIT
QUIT
+2 IF IBCRT
IF $Y>1
Begin DoDot:1
+3 FOR
IF $Y>(IOSL-1)
QUIT
WRITE !
+4 NEW T
READ " Press RETURN to continue",T:DTIME
IF '$TEST!(T["^")
SET IBQUIT=1
QUIT
End DoDot:1
IF IBQUIT
QUIT
+5 IF IBPAGE>1
WRITE !,@IOF
+6 WRITE ?53,"CATEGORY C CHARGES ON HOLD",?110,IBNOW," PAGE ",IBPAGE,!,"HELD CHARGES",?87,"CORRESPONDING THIRD PARTY BILLS",!,IBLINE
+7 WRITE !,"Name",?22,"Pt.ID",?29,"ActionID",?39,"Type",?46,"Bill#",?55,"From",?66,"To",?78,"Charge",?85,"||",?88,"Bill#",?97,"AR-Status",?115,"Charge",?128,"Paid"
+8 WRITE !,IBLINE,!
+9 SET IBPAGE=IBPAGE+1
+10 QUIT
