IBOHDT1 ;ALB/EMG - REPORT OF CHARGES ON HOLD > 60 DAYS-CONT ;FEB 18 1997
;;2.0;INTEGRATED BILLING;**70,95,347,452,618**;21-MAR-94;Build 61
;;Per VHA Directive 2004-038, this routine should not be modified.
;
REPORT ;
N IBQUIT,IBPAGE,IBNOW,IBLINE,IBCRT,IBBOT,DFN,IBNAME,IBATYPE,IBN,X
S IBCRT=0,IBBOT=6,IBQUIT=0 I $E(IOST,1,2)="C-" S IBCRT=1,IBBOT=4
S IBLINE="",$P(IBLINE,"=",96)="||",IBLINE=IBLINE_$E(IBLINE,1,32)
S IBNOW=$$FMTE^XLFDT($$NOW^XLFDT)
I IBCRT W @IOF
LOOP ;
S IBPAGE=1 D HEADER Q:IBQUIT
S IBNAME="" F S IBNAME=$O(^TMP($J,"HOLD",IBNAME)) Q:IBNAME="" S DFN=0 F S DFN=$O(^TMP($J,"HOLD",IBNAME,DFN)) Q:DFN="" D PRNTPAT Q:IBQUIT S IBATYPE="" F S IBATYPE=$O(^TMP($J,"HOLD",IBNAME,DFN,IBATYPE)) Q:IBATYPE="" D
.S IBN=0 F S IBN=$O(^TMP($J,"HOLD",IBNAME,DFN,IBATYPE,IBN)) Q:'IBN!(IBQUIT) D
..D PRNTCHG,PRNTBILL:'IBQUIT
Q
PRNTBILL ; prints bills for a charge
N IB,IB0,IBSTAT,IBCHG,IBPD,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,IBATYPE,IBN,IB)) W:'IB&(I<2) ?90,"||",! D:$Y+IBBOT>IOSL HEADER Q:'IB!(IBQUIT) D
.W ?95,"||"
.S IB0=$G(^DGCR(399,IB,0)) Q:IB0=""
.W ?98,$P(IB0,"^",1) ; bill #
.S IBSTAT=$$STA^PRCAFN(IB)
.W:+IBSTAT>0 ?106,$E($P(IBSTAT,"^",2),1,3)
.S IBT=$J((+^DGCR(399,IB,"U1")-$P(^("U1"),"^",2)),9,2)
.W ?113,IBT ; total charges
.S IBPD=$$TPR^PRCAFN(IB) S:IBPD<0 IBPD="" S IBPD=$J(IBPD,9,2) W ?122,IBPD,! D:$Y+IBBOT>IOSL HEADER
Q
PRNTPAT ; prints patient data
N VAERR,VADM,IBSSN D DEM^VADPT S:'VAERR IBNAME=$G(VADM(1)),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,IBND1,IBDAY,IBOHDT,X1,X2
N IBRX,IBRXN,IBRF,IBRDT,IBX,IENS,IBECME
S IBND=$G(^IB(IBN,0))
S IBND1=$G(^IB(IBN,1))
S (IBRX,IBRXN,IBRF,IBRDT,IBX,IBECME)=0
; action id
S IBACT=+IBND
; type
; Patch IB*2.0*618 - added community care - action types to DAYS ON HOLD report
S IBTYPE=$P(IBND,"^",3),IBTYPE=$P($G(^IBE(350.1,IBTYPE,0)),"^",1)
S IBTYPE=$$IBACTYPE^IBOHLD2(IBTYPE)
; end of Patch IB*2.0*618
; bill #
; S IBBILL=$P($P(IBND,"^",11),"-",2)
;
; rx info
I $P(IBND,"^",4)["52:" D
. S IBRXN=$P($P(IBND,"^",4),":",2) ; Rx ien
. S IBRX=$P($P(IBND,"^",8),"-") ; external Rx#
. S IBRF=$P($P(IBND,"^",4),":",3) ; fill# or 0 for original fill
. S IBECME=$P($$CLAIM^BPSBUTL(+IBRXN,+IBRF),U,6) ; ecme# DBIA 4719
. I IBRF S IENS=+IBRF,IBRDT=$$SUBFILE^IBRXUTL(+IBRXN,+IENS,52,.01) ; refill date
. I 'IBRF S IENS=+IBRXN,IBRDT=$$FILE^IBRXUTL(IENS,22) ; fill date
. Q
;
S IBX=$$APPT^IBCU3(IBRDT,DFN)
; from/fill date
S IBFR=$$DAT1^IBOUTL($S(+IBRXN>0:IBRDT,1:$P(IBND,"^",14)))
; to date
S IBTO=$$DAT1^IBOUTL($S($P(IBND,"^",15)'="":$P(IBND,"^",15),1:$P(IBND1,"^",2)))
; on hold date
S IBOHDT=$$DAT1^IBOUTL($P(IBND1,"^",6))
; number of days on hold
S X1=DT,X2=$P(IBND1,"^",6) D ^%DTC S IBDAY=$J(X,7)
; charge$
S IBCHG=$J(+$P(IBND,"^",7),9,2)
W ?29,IBACT,?40,IBTYPE W:IBRX>0 ?46,"Rx #: "_IBRX_$S(IBRF>0:"("_IBRF_")",1:""),?68,$S(IBECME:"ECME #: "_IBECME,1:""),?95,"||",!
W:IBX=1 ?45,"*"
W ?46,IBFR,?55,IBTO,?66,IBOHDT,?77,IBDAY,?86,IBCHG
Q
Q:IBQUIT
I IBCRT,$Y>1 D Q:IBQUIT
.F Q:$Y>(IOSL-3) W !
.N T R " Press RETURN to continue",T:DTIME I '$T!(T["^") S IBQUIT=1 Q
I IBPAGE>1 W !,@IOF
W ?53,"CHARGES ON HOLD LONGER THAN "_IBNUM_" DAYS",?110,IBNOW," PAGE ",IBPAGE,!,"HELD CHARGES",?98,"CORRESPONDING THIRD PARTY BILLS",!,IBLINE
W !,?46,"From/",?55,"To/",?66,"On Hold",?77,"# Days",?95,"||",?105,"AR"
W !,"Name",?22,"Pt.ID",?29,"Act.ID",?40,"Type",?46,"Fill Dt",?55,"Rls Dt",?66,"Date",?77,"On Hold",?89,"Charge",?95,"||",?98,"Bill#",?105,"Status",?113,"Charge",?125,"Paid"
W !,IBLINE,!
W ?44,"'*' = outpt visit on same day as Rx fill date",?95,"||",!,IBLINE,!
S IBPAGE=IBPAGE+1
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HIBOHDT1 3986 printed Dec 13, 2024@02:25:34 Page 2
IBOHDT1 ;ALB/EMG - REPORT OF CHARGES ON HOLD > 60 DAYS-CONT ;FEB 18 1997
+1 ;;2.0;INTEGRATED BILLING;**70,95,347,452,618**;21-MAR-94;Build 61
+2 ;;Per VHA Directive 2004-038, this routine should not be modified.
+3 ;
REPORT ;
+1 NEW IBQUIT,IBPAGE,IBNOW,IBLINE,IBCRT,IBBOT,DFN,IBNAME,IBATYPE,IBN,X
+2 SET IBCRT=0
SET IBBOT=6
SET IBQUIT=0
IF $EXTRACT(IOST,1,2)="C-"
SET IBCRT=1
SET IBBOT=4
+3 SET IBLINE=""
SET $PIECE(IBLINE,"=",96)="||"
SET IBLINE=IBLINE_$EXTRACT(IBLINE,1,32)
+4 SET IBNOW=$$FMTE^XLFDT($$NOW^XLFDT)
+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=""
QUIT
SET DFN=0
FOR
SET DFN=$ORDER(^TMP($JOB,"HOLD",IBNAME,DFN))
if DFN=""
QUIT
DO PRNTPAT
if IBQUIT
QUIT
SET IBATYPE=""
FOR
SET IBATYPE=$ORDER(^TMP($JOB,"HOLD",IBNAME,DFN,IBATYPE))
if IBATYPE=""
QUIT
Begin DoDot:1
+3 SET IBN=0
FOR
SET IBN=$ORDER(^TMP($JOB,"HOLD",IBNAME,DFN,IBATYPE,IBN))
if 'IBN!(IBQUIT)
QUIT
Begin DoDot:2
+4 DO PRNTCHG
if 'IBQUIT
DO PRNTBILL
End DoDot:2
End DoDot:1
+5 QUIT
PRNTBILL ; prints bills for a charge
+1 NEW IB,IB0,IBSTAT,IBCHG,IBPD,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,IBATYPE,IBN,IB))
if 'IB&(I<2)
WRITE ?90,"||",!
if $Y+IBBOT>IOSL
DO HEADER
if 'IB!(IBQUIT)
QUIT
Begin DoDot:1
+4 WRITE ?95,"||"
+5 SET IB0=$GET(^DGCR(399,IB,0))
if IB0=""
QUIT
+6 ; bill #
WRITE ?98,$PIECE(IB0,"^",1)
+7 SET IBSTAT=$$STA^PRCAFN(IB)
+8 if +IBSTAT>0
WRITE ?106,$EXTRACT($PIECE(IBSTAT,"^",2),1,3)
+9 SET IBT=$JUSTIFY((+^DGCR(399,IB,"U1")-$PIECE(^("U1"),"^",2)),9,2)
+10 ; total charges
WRITE ?113,IBT
+11 SET IBPD=$$TPR^PRCAFN(IB)
if IBPD<0
SET IBPD=""
SET IBPD=$JUSTIFY(IBPD,9,2)
WRITE ?122,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 IBNAME=$GET(VADM(1))
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,IBND1,IBDAY,IBOHDT,X1,X2
+2 NEW IBRX,IBRXN,IBRF,IBRDT,IBX,IENS,IBECME
+3 SET IBND=$GET(^IB(IBN,0))
+4 SET IBND1=$GET(^IB(IBN,1))
+5 SET (IBRX,IBRXN,IBRF,IBRDT,IBX,IBECME)=0
+6 ; action id
+7 SET IBACT=+IBND
+8 ; type
+9 ; Patch IB*2.0*618 - added community care - action types to DAYS ON HOLD report
+10 SET IBTYPE=$PIECE(IBND,"^",3)
SET IBTYPE=$PIECE($GET(^IBE(350.1,IBTYPE,0)),"^",1)
+11 SET IBTYPE=$$IBACTYPE^IBOHLD2(IBTYPE)
+12 ; end of Patch IB*2.0*618
+13 ; bill #
+14 ; S IBBILL=$P($P(IBND,"^",11),"-",2)
+15 ;
+16 ; rx info
+17 IF $PIECE(IBND,"^",4)["52:"
Begin DoDot:1
+18 ; Rx ien
SET IBRXN=$PIECE($PIECE(IBND,"^",4),":",2)
+19 ; external Rx#
SET IBRX=$PIECE($PIECE(IBND,"^",8),"-")
+20 ; fill# or 0 for original fill
SET IBRF=$PIECE($PIECE(IBND,"^",4),":",3)
+21 ; ecme# DBIA 4719
SET IBECME=$PIECE($$CLAIM^BPSBUTL(+IBRXN,+IBRF),U,6)
+22 ; refill date
IF IBRF
SET IENS=+IBRF
SET IBRDT=$$SUBFILE^IBRXUTL(+IBRXN,+IENS,52,.01)
+23 ; fill date
IF 'IBRF
SET IENS=+IBRXN
SET IBRDT=$$FILE^IBRXUTL(IENS,22)
+24 QUIT
End DoDot:1
+25 ;
+26 SET IBX=$$APPT^IBCU3(IBRDT,DFN)
+27 ; from/fill date
+28 SET IBFR=$$DAT1^IBOUTL($SELECT(+IBRXN>0:IBRDT,1:$PIECE(IBND,"^",14)))
+29 ; to date
+30 SET IBTO=$$DAT1^IBOUTL($SELECT($PIECE(IBND,"^",15)'="":$PIECE(IBND,"^",15),1:$PIECE(IBND1,"^",2)))
+31 ; on hold date
+32 SET IBOHDT=$$DAT1^IBOUTL($PIECE(IBND1,"^",6))
+33 ; number of days on hold
+34 SET X1=DT
SET X2=$PIECE(IBND1,"^",6)
DO ^%DTC
SET IBDAY=$JUSTIFY(X,7)
+35 ; charge$
+36 SET IBCHG=$JUSTIFY(+$PIECE(IBND,"^",7),9,2)
+37 WRITE ?29,IBACT,?40,IBTYPE
if IBRX>0
WRITE ?46,"Rx #: "_IBRX_$SELECT(IBRF>0:"("_IBRF_")",1:""),?68,$SELECT(IBECME:"ECME #: "_IBECME,1:""),?95,"||",!
+38 if IBX=1
WRITE ?45,"*"
+39 WRITE ?46,IBFR,?55,IBTO,?66,IBOHDT,?77,IBDAY,?86,IBCHG
+40 QUIT
+1 if IBQUIT
QUIT
+2 IF IBCRT
IF $Y>1
Begin DoDot:1
+3 FOR
if $Y>(IOSL-3)
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,"CHARGES ON HOLD LONGER THAN "_IBNUM_" DAYS",?110,IBNOW," PAGE ",IBPAGE,!,"HELD CHARGES",?98,"CORRESPONDING THIRD PARTY BILLS",!,IBLINE
+7 WRITE !,?46,"From/",?55,"To/",?66,"On Hold",?77,"# Days",?95,"||",?105,"AR"
+8 WRITE !,"Name",?22,"Pt.ID",?29,"Act.ID",?40,"Type",?46,"Fill Dt",?55,"Rls Dt",?66,"Date",?77,"On Hold",?89,"Charge",?95,"||",?98,"Bill#",?105,"Status",?113,"Charge",?125,"Paid"
+9 WRITE !,IBLINE,!
+10 WRITE ?44,"'*' = outpt visit on same day as Rx fill date",?95,"||",!,IBLINE,!
+11 SET IBPAGE=IBPAGE+1
+12 QUIT
