IBOBL ;ALB/AAS - LIST ALL BILLS FOR AN EPISODE OF CARE ; 25-MAY-90
;;Version 2.0 ; INTEGRATED BILLING ;; 21-MAR-94
;
;MAP TO DGCROBL
;
% S U="^"
;
ASK ;
;***
;I $D(XRT0) S:'$D(XRTN) XRTN="IBOBL" D T1^%ZOSV ;stop rt clock
;S XRTL=$ZU(0),XRTN="IBOBL-1" D T0^%ZOSV ;start rt clock
;
S DIC="^DGCR(399,",DIC(0)="AEMQZ" D ^DIC K DIC Q:Y<1 S DGIFN=+Y,DGIFN1=$P(Y(0),"^",17),DFN=$P(Y(0),"^",2),DGEVDT=$P(Y(0),"^",3) G:+DGIFN1<1 END
;
DEV ; -- ask device
S %ZIS="QM" D ^%ZIS G:POP END
I $D(IO("Q")) K IO("Q") D G END
.S ZTRTN="START^IBOBL",ZTSAVE("DFN")="",ZTSAVE("DG*")="",ZTDESC="IB - List all Bills for an Episode"
.D ^%ZTLOAD K ZTSK D HOME^%ZIS
;
U IO
;
;***
;I $D(XRT0) S:'$D(XRTN) XRTN="IBOBL" D T1^%ZOSV ;stop rt clock
START ;entry from DQing
;***
;S XRTL=$ZU(0),XRTN="IBOBL-2" D T0^%ZOSV ;start rt clock
S Y=DGEVDT X ^DD("DD") S DGEVDT=Y,IBQUIT=0,DGLINE="",$P(DGLINE,"-",IOM)="",DGPAG=0 S X="NOW",%DT="T" D ^%DT X ^DD("DD") S DGDATE=Y D HDR1
;
LOOP S IBIFN=""
F I=0:0 S IBIFN=$O(^DGCR(399,"AC",DGIFN1,IBIFN)) Q:'IBIFN!(IBQUIT) D ONE I $D(^DGCR(399,"AC",IBIFN)),IBIFN'=DGIFN1 D LOOP2
D PAUSE:'IBQUIT G END
;
;print bills who's primary bill field point to secondary bill for this episode
LOOP2 S IBIFN2=IBIFN,IBIFN="",DGIFN2=DGIFN1,DGIFN1=IBIFN2
F J=0:0 S IBIFN=$O(^DGCR(399,"AC",DGIFN1,IBIFN)) Q:'IBIFN!(IBQUIT) D ONE
S DGIFN=DGIFN2,IBIFN=IBIFN2
Q
ONE D GVAR^IBCBB
D:($Y>(IOSL-5)) HDR Q:IBQUIT
W !,IBBNO,?12,$S(IBAT']"":"",$D(^DGCR(399.3,IBAT,0)):$P(^(0),"^"),1:"")
W ?34,$S(IBCL=1:"INPATIENT",IBCL=2:"HUMANITARIAN (INPT.).",IBCL=3:"OUTPATIENT",IBCL=4:"HUMANITARIAN (OPT.)",1:""),?57
F I=IBEVDT,IBFDT,IBTDT W $E(I,4,5)_"/"_$E(I,6,7)_"/"_$E(I,2,3)," "
W $S(IBST=1:"ENTERED/NOT REV.",IBST=2:"REVIEWED",IBST=3:"AUTHORIZED",IBST=4:"PRINTED",IBST=7:"CANCELLED",1:"")
W ?112,$P("NON-PAYMENT/ZERO^ADMIT - DISCHARGE^INTERIM - FIRST^INTERIM - CONTINUING^INTERIM - LAST^LATE CHARGE(S) ONLY^ADJUSTMENT OF PRIOR^REPLACEMENT OF PRIOR","^",(IBTF+1))
W !?4,"PAYOR: ",$S(IBWHO="i":"Insurance Co.",IBWHO="p":"Patient",1:"Institution")," - "
S DGPAYOR="UNKNOWN"
I IBWHO="i",+IBNDM,$D(^DIC(36,+IBNDM,0)) S DGPAYOR=$P(^(0),"^")
I IBWHO="o",$P(IBNDM,"^",11),$D(^DIC(11,$P(IBNDM,"^",11),0)) S DGPAYOR=$P(^(0),"^")
I IBWHO="p",+DFN,$D(^DPT(DFN,0)) S DGPAYOR=$P(^(0),"^")
W DGPAYOR K DGPAYOR
Q
;
HDR I $E(IOST,1,2)["C-" D PAUSE Q:IBQUIT
HDR1 I $E(IOST,1,2)["C-"!(DGPAG) W @IOF
S DGPAG=DGPAG+1 W "LIST OF ALL BILLS FOR AN EPISODE OF CARE",?(IOM-30),DGDATE," PAGE ",DGPAG
W !,"FOR PATIENT: ",$P(^DPT(DFN,0),"^")," EVENT DATE: ",DGEVDT
W !?68,"STATEMENT STATEMENT"
W !,"BILL NO. RATE TYPE CLASSIFICATION EVENT DATE FROM DATE TO DATE STATUS TIMEFRAME OF BILL"
W !,DGLINE
Q
PAUSE S IBX1="" R:$E(IOST,1,2)["C-" !,"Enter ""^"" to quit display, return to continue",IBX1:DTIME S IBQUIT=$S(IBX1["^":1,1:0) Q
;
END ;
;***
;I $D(XRT0) S:'$D(XRTN) XRTN="IBOBL" D T1^%ZOSV ;stop rt clock
I $D(ZTQUEUED) S ZTREQ="@" Q
D END^IBCBB1
K %DT,DGIFN,DGIFN1,IBIFN1,IBQUIT,IBX1,IBCNT,DFN,IBIFN,DGDATE,DGEVDT,DGLINE,DGPAG,^UTILITY($J)
D ^%ZISC G ASK
IBOBL ;ALB/AAS - LIST ALL BILLS FOR AN EPISODE OF CARE ; 25-MAY-90
+1 ;;Version 2.0 ; INTEGRATED BILLING ;; 21-MAR-94
+2 ;
+3 ;MAP TO DGCROBL
+4 ;
% SET U="^"
+1 ;
ASK ;
+1 ;***
+2 ;I $D(XRT0) S:'$D(XRTN) XRTN="IBOBL" D T1^%ZOSV ;stop rt clock
+3 ;S XRTL=$ZU(0),XRTN="IBOBL-1" D T0^%ZOSV ;start rt clock
+4 ;
+5 SET DIC="^DGCR(399,"
SET DIC(0)="AEMQZ"
DO ^DIC
KILL DIC
IF Y<1
QUIT
SET DGIFN=+Y
SET DGIFN1=$PIECE(Y(0),"^",17)
SET DFN=$PIECE(Y(0),"^",2)
SET DGEVDT=$PIECE(Y(0),"^",3)
IF +DGIFN1<1
GOTO END
+6 ;
DEV ; -- ask device
+1 SET %ZIS="QM"
DO ^%ZIS
IF POP
GOTO END
+2 IF $DATA(IO("Q"))
KILL IO("Q")
Begin DoDot:1
+3 SET ZTRTN="START^IBOBL"
SET ZTSAVE("DFN")=""
SET ZTSAVE("DG*")=""
SET ZTDESC="IB - List all Bills for an Episode"
+4 DO ^%ZTLOAD
KILL ZTSK
DO HOME^%ZIS
End DoDot:1
GOTO END
+5 ;
+6 USE IO
+7 ;
+8 ;***
+9 ;I $D(XRT0) S:'$D(XRTN) XRTN="IBOBL" D T1^%ZOSV ;stop rt clock
START ;entry from DQing
+1 ;***
+2 ;S XRTL=$ZU(0),XRTN="IBOBL-2" D T0^%ZOSV ;start rt clock
+3 SET Y=DGEVDT
XECUTE ^DD("DD")
SET DGEVDT=Y
SET IBQUIT=0
SET DGLINE=""
SET $PIECE(DGLINE,"-",IOM)=""
SET DGPAG=0
SET X="NOW"
SET %DT="T"
DO ^%DT
XECUTE ^DD("DD")
SET DGDATE=Y
DO HDR1
+4 ;
LOOP SET IBIFN=""
+1 FOR I=0:0
SET IBIFN=$ORDER(^DGCR(399,"AC",DGIFN1,IBIFN))
IF 'IBIFN!(IBQUIT)
QUIT
DO ONE
IF $DATA(^DGCR(399,"AC",IBIFN))
IF IBIFN'=DGIFN1
DO LOOP2
+2 IF 'IBQUIT
DO PAUSE
GOTO END
+3 ;
+4 ;print bills who's primary bill field point to secondary bill for this episode
LOOP2 SET IBIFN2=IBIFN
SET IBIFN=""
SET DGIFN2=DGIFN1
SET DGIFN1=IBIFN2
+1 FOR J=0:0
SET IBIFN=$ORDER(^DGCR(399,"AC",DGIFN1,IBIFN))
IF 'IBIFN!(IBQUIT)
QUIT
DO ONE
+2 SET DGIFN=DGIFN2
SET IBIFN=IBIFN2
+3 QUIT
ONE DO GVAR^IBCBB
+1 IF ($Y>(IOSL-5))
DO HDR
IF IBQUIT
QUIT
+2 WRITE !,IBBNO,?12,$SELECT(IBAT']"":"",$DATA(^DGCR(399.3,IBAT,0)):$PIECE(^(0),"^"),1:"")
+3 WRITE ?34,$SELECT(IBCL=1:"INPATIENT",IBCL=2:"HUMANITARIAN (INPT.).",IBCL=3:"OUTPATIENT",IBCL=4:"HUMANITARIAN (OPT.)",1:""),?57
+4 FOR I=IBEVDT,IBFDT,IBTDT
WRITE $EXTRACT(I,4,5)_"/"_$EXTRACT(I,6,7)_"/"_$EXTRACT(I,2,3)," "
+5 WRITE $SELECT(IBST=1:"ENTERED/NOT REV.",IBST=2:"REVIEWED",IBST=3:"AUTHORIZED",IBST=4:"PRINTED",IBST=7:"CANCELLED",1:"")
+6 WRITE ?112,$PIECE("NON-PAYMENT/ZERO^ADMIT - DISCHARGE^INTERIM - FIRST^INTERIM - CONTINUING^INTERIM - LAST^LATE CHARGE(S) ONLY^ADJUSTMENT OF PRIOR^REPLACEMENT OF PRIOR","^",(IBTF+1))
+7 WRITE !?4,"PAYOR: ",$SELECT(IBWHO="i":"Insurance Co.",IBWHO="p":"Patient",1:"Institution")," - "
+8 SET DGPAYOR="UNKNOWN"
+9 IF IBWHO="i"
IF +IBNDM
IF $DATA(^DIC(36,+IBNDM,0))
SET DGPAYOR=$PIECE(^(0),"^")
+10 IF IBWHO="o"
IF $PIECE(IBNDM,"^",11)
IF $DATA(^DIC(11,$PIECE(IBNDM,"^",11),0))
SET DGPAYOR=$PIECE(^(0),"^")
+11 IF IBWHO="p"
IF +DFN
IF $DATA(^DPT(DFN,0))
SET DGPAYOR=$PIECE(^(0),"^")
+12 WRITE DGPAYOR
KILL DGPAYOR
+13 QUIT
+14 ;
HDR IF $EXTRACT(IOST,1,2)["C-"
DO PAUSE
IF IBQUIT
QUIT
HDR1 IF $EXTRACT(IOST,1,2)["C-"!(DGPAG)
WRITE @IOF
+1 SET DGPAG=DGPAG+1
WRITE "LIST OF ALL BILLS FOR AN EPISODE OF CARE",?(IOM-30),DGDATE," PAGE ",DGPAG
+2 WRITE !,"FOR PATIENT: ",$PIECE(^DPT(DFN,0),"^")," EVENT DATE: ",DGEVDT
+3 WRITE !?68,"STATEMENT STATEMENT"
+4 WRITE !,"BILL NO. RATE TYPE CLASSIFICATION EVENT DATE FROM DATE TO DATE STATUS TIMEFRAME OF BILL"
+5 WRITE !,DGLINE
+6 QUIT
PAUSE SET IBX1=""
IF $EXTRACT(IOST,1,2)["C-"
READ !,"Enter ""^"" to quit display, return to continue",IBX1:DTIME
SET IBQUIT=$SELECT(IBX1["^":1,1:0)
QUIT
+1 ;
END ;
+1 ;***
+2 ;I $D(XRT0) S:'$D(XRTN) XRTN="IBOBL" D T1^%ZOSV ;stop rt clock
+3 IF $DATA(ZTQUEUED)
SET ZTREQ="@"
QUIT
+4 DO END^IBCBB1
+5 KILL %DT,DGIFN,DGIFN1,IBIFN1,IBQUIT,IBX1,IBCNT,DFN,IBIFN,DGDATE,DGEVDT,DGLINE,DGPAG,^UTILITY($JOB)
+6 DO ^%ZISC
GOTO ASK
