IBOBL ;ALB/ARH - LIST ALL BILLS FOR AN EPISODE OF CARE ; 25-MAY-90
;;2.0;INTEGRATED BILLING;**80,106**;21-MAR-94
;
EN ;get parameters then run the report
D HOME^%ZIS N IBASK,IBCANC,IBX W !!,"Episode of Care Bill List:",!,"--------------------------"
W !,"Enter a Bill Number to get a list of all bills that match the selected bill's",!,"event date or any of it's outpatient visit dates."
W !,"Enter a Patient Name and Episode Date to get a list of all bills for a patient",!,"that have either that date as the event date or as an outpatient visit date."
W !,"This report also includes bills related as continuing episodes of care."
;
S IBASK=$$PB^IBJTU2 Q:IBASK'>0 W !
I +IBASK=1 S IBX=$$GETDT^IBCRU1("","Episode Date") Q:IBX'?7N S IBASK=IBASK_U_IBX W !
S IBADDCPT=$$CPT Q:IBADDCPT<0
S IBCANC=$$CANC Q:IBCANC<0 W !
;
DEV ;get the device
W !,"Report requires 132 columns."
S %ZIS="QM",%ZIS("A")="OUTPUT DEVICE: " D ^%ZIS G:POP EXIT
I $D(IO("Q")) S ZTRTN="RPT^IBOBL",ZTDESC="Episode of Care Bill List",ZTSAVE("IB*")="" D ^%ZTLOAD K IO("Q") G EXIT
U IO
;
RPT ;find, save, and print the data that satisfies the search parameters
;entry point for tasked jobs
;
K ^TMP($J,"IBOBL") I '$G(IBASK) G EXIT
;
D FIND
D PRINT
;
EXIT ;clean up and quit
K ^TMP($J,"IBOBL"),IBASK,IBADDCPT,IBCANC,IBX Q:$D(ZTQUEUED)
D ^%ZISC
Q
;
FIND ; compile list of all related bills
N IBIFN,IB0,DFN,IBEPDT,IBX
;
; compile list of related bills based on event date and opt visit dates of selected bill
I +IBASK=2 S IBIFN=+$P(IBASK,U,2),IB0=$G(^DGCR(399,IBIFN,0)) D
. S DFN=$P(IB0,U,2),IBEPDT=$P(IB0,U,3) D FIND1(DFN,IBEPDT)
. S IBX=0 F S IBX=$O(^DGCR(399,+IBIFN,"OP",IBX)) Q:'IBX D
.. S IBEPDT=+$G(^DGCR(399,+IBIFN,"OP",IBX,0)) Q:'IBEPDT D FIND1(DFN,IBEPDT)
;
; compile list of related bills based on selected patient and episode date
I +IBASK=1 S DFN=$P(IBASK,U,2),IBEPDT=$P(IBASK,U,3) D FIND1(DFN,IBEPDT)
;
D FIND2 ; compile list of bills based on Primary Bill link with bills already found
Q
;
FIND1(DFN,IBEPDT) ; find all bills for a patient with a specific event date or opt visit date
N IBX,IBIFN,IBDT S IBEPDT=IBEPDT\1
;
; find all bills for patient with episode date as outpatient visit date
S IBDT=IBEPDT-.0001 F S IBDT=$O(^DGCR(399,"AOPV",DFN,IBDT)) Q:((IBDT\1)'=IBEPDT) D
. S IBIFN=0 F S IBIFN=$O(^DGCR(399,"AOPV",DFN,IBDT,IBIFN)) Q:'IBIFN D
.. S IBX=$G(^DGCR(399,IBIFN,0)) I IBX="" Q
.. S ^TMP($J,"IBOBL","BILL",IBIFN)=""
.. I +$P(IBX,U,17) S ^TMP($J,"IBOBL","BILL",+$P(IBX,U,17))=""
;
; find all bills for patient with episode date as Event Date
S IBDT=IBEPDT-.00001 F S IBDT=$O(^DGCR(399,"D",IBDT)) Q:((IBDT\1)'=IBEPDT) D
. S IBIFN=0 F S IBIFN=$O(^DGCR(399,"D",IBDT,IBIFN)) Q:'IBIFN D
.. S IBX=$G(^DGCR(399,IBIFN,0)) I $P(IBX,U,2)'=DFN Q
.. S ^TMP($J,"IBOBL","BILL",IBIFN)=""
.. I +$P(IBX,U,17) S ^TMP($J,"IBOBL","BILL",+$P(IBX,U,17))=""
;
Q
;
FIND2 ; compile list of related bills based on Primary Bill of bills already found
N IBBILL,IBIFN,IBX
S IBBILL=0 F S IBBILL=$O(^TMP($J,"IBOBL","BILL",IBBILL)) Q:'IBBILL D
. S IBIFN=0 F S IBIFN=$O(^DGCR(399,"AC",IBBILL,IBIFN)) Q:'IBIFN D
.. S IBX=$G(^DGCR(399,IBIFN,0)) I IBX="" Q
.. S ^TMP($J,"IBOBL","BILL",IBIFN)=""
Q
;
PRINT ;print the report from the temp sort file to the appropriate device
N IBPGN,IBQUIT,IBLN,IBHDR1,IBHDR2,IBIFN
S IBPGN=0,IBQUIT=0 D HDRLNS,HDR Q:IBQUIT
;
S IBIFN=0 F S IBIFN=$O(^TMP($J,"IBOBL","BILL",IBIFN)) Q:'IBIFN D Q:$$LNCHK(2)
. I '$G(IBCANC),$P($G(^DGCR(399,+IBIFN,0)),U,13)=7 Q
. D PRTLN(IBIFN,IBADDCPT)
;
I 'IBQUIT D PAUSE
Q
;
PRTLN(IBIFN,IBADDCPT) ; print one bill with all it's CPTs
N IB0,IBU,IBM,IBMP,IBX,IBCPT S IBLN=IBLN+1
S IB0=$G(^DGCR(399,+$G(IBIFN),0)) Q:IB0="" S IBU=$G(^DGCR(399,IBIFN,"U"))
S IBM=$G(^DGCR(399,IBIFN,"M")),IBMP=$G(^DGCR(399,IBIFN,"MP"))
W !,$P(IB0,U,1),?12,$P($G(^DGCR(399.3,+$P(IB0,U,7),0)),U,4) S IBX=$P(IB0,U,5)
W ?24,$S(IBX=1:"INPT",IBX=2:"INPT-H",IBX=3:"OPT",IBX=4:"OPT-H",1:"") S IBX=$P(IB0,U,27)
W ?32,$S(IBX=1:"INST",IBX=2:"PROF",1:"")
W ?39,$$DATE(+$P(IB0,U,3)),?49,$$DATE(+IBU),?59,$$DATE(+$P(IBU,U,2))
W ?70,$P($$ARSTATA^IBJTU4(IBIFN),U,2) S IBX=$P(IB0,U,21)
W ?75,$S(IBX="P":"PRIM",IBX="S":"SEC",IBX="T":"TER",IBX="A":"PAT",1:"") S IBX=$P(IB0,U,11)
W ?82,$E($S(IBX="i":$P($G(^DIC(36,+IBMP,0)),U,1),IBX="o":$P($G(^DIC(4,+$P(IBM,U,11),0)),U,1),IBX="p":$P($G(^DPT(+$P(IB0,U,2),0)),U,1),1:""),1,23)
W ?107,$J(+$P($$BILL^RCJIBFN2(IBIFN),U,1),10,2)
;
I 'IBADDCPT W ! Q
;
S IBX=0 F S IBX=$O(^DGCR(399,IBIFN,"CP",IBX)) Q:'IBX D
. S IBCPT=$P($G(^DGCR(399,IBIFN,"CP",IBX,0)),U,1) I IBCPT["ICPT" S IBCPT(+IBCPT)=+$G(IBCPT(+IBCPT))+1
;
S IBCPT="" F S IBCPT=$O(IBCPT(IBCPT)) Q:'IBCPT D Q:$$LNCHK(1)
. S IBX=+IBCPT(IBCPT) W ?120,$P($$CPT^ICPTCOD(+IBCPT),U,2),?127,$S(IBX'=1:"("_IBX_")",1:""),! S IBLN=IBLN+1
;
Q
;
HDR ;print the report header
N IBNOW,IBI
S IBQUIT=$$STOP Q:IBQUIT S IBPGN=IBPGN+1,IBLN=7
S IBNOW=$$FMTE^XLFDT($$NOW^XLFDT),IBNOW=$P(IBNOW,"@",1)_" "_$P($P(IBNOW,"@",2),":",1,2)
I IBPGN>1!($E(IOST,1,2)["C-") W @IOF
;
W !,IBHDR1,?(IOM-30),IBNOW,?(IOM-8),"PAGE ",IBPGN,!,IBHDR2
W !,"BILL #",?12,"RATE",?24,"CLASSIFICATION",?39,"EVENT",?49,"FROM",?59,"TO",?70,"AR",?75,"COB",?82,"PAYER",?112,"TOTAL",?120,"CPT'S",!
S IBI="",$P(IBI,"-",IOM+1)="" W IBI
W !
Q
;
HDRLNS ; set up header lines
N DFN,IBX S DFN=0
S IBHDR1="EPISODE OF CARE BILL LIST FOR "
I +IBASK=1 S IBHDR1=IBHDR1_$P($G(^DPT(+$P(IBASK,U,2),0)),U,1)_" ON "_$$DATE(+$P(IBASK,U,3)) S DFN=+$P(IBASK,U,2)
I +IBASK=2 S IBX=$G(^DGCR(399,+$P(IBASK,U,2),0)),IBHDR1=IBHDR1_$P(IBX,U,1) S DFN=+$P(IBX,U,2)
S IBX=$G(^DPT(DFN,0)) S IBHDR2=$P(IBX,U,1)_$J("",10)_$E(IBX)_$P($$PT^IBEFUNC(DFN),U,3)_$J("",10)_"DOB: "_$$DATE($P(IBX,U,3))
Q
;
DATE(X) ;
Q $E(X,4,5)_"/"_$E(X,6,7)_"/"_$E(X,2,3)
;
LNCHK(LNS) ; check if new page is needed
I 'IBQUIT,IBLN>(IOSL-LNS) D PAUSE I 'IBQUIT D HDR
Q IBQUIT
;
PAUSE ;pause at end of screen if beeing displayed on a terminal
Q:$E(IOST,1,2)'["C-" N DIR,DUOUT,DTOUT,DIRUT
S DIR(0)="E" D ^DIR K DIR
I $D(DUOUT)!($D(DIRUT)) S IBQUIT=1
Q
;
STOP() ;determine if user has requested the queued report to stop
I $D(ZTQUEUED),$$S^%ZTLOAD S ZTSTOP=1 K ZTREQ I +$G(IBPGN) W !,"***TASK STOPPED BY USER***"
Q +$G(ZTSTOP)
;
CPT() ; return true if include bills CPT procedures
N IBX,DIR,DTOUT,DUOUT,DIRUT,X,Y S IBX=0
S DIR("?")="Enter either 'Y' or 'N'. Enter 'Y' if you want the CPT procedures for each bill included in the report."
S DIR("A")="Include CPT Procedures",DIR(0)="Y",DIR("B")="No" D ^DIR K DIR S:Y=1 IBX=1 I $D(DIRUT) S IBX=-1
Q IBX
;
CANC() ; return true if include canceled bills
N IBX,DIR,DTOUT,DUOUT,DIRUT,X,Y S IBX=0
S DIR("?")="Enter either 'Y' or 'N'. Enter 'Y' if you want cancelled bills included in the report."
S DIR("A")="Include Cancelled Bills",DIR(0)="Y",DIR("B")="No" D ^DIR K DIR S:Y=1 IBX=1 I $D(DIRUT) S IBX=-1
Q IBX
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HIBOBL 7033 printed Apr 09, 2024@21:24:35 Page 2
IBOBL ;ALB/ARH - LIST ALL BILLS FOR AN EPISODE OF CARE ; 25-MAY-90
+1 ;;2.0;INTEGRATED BILLING;**80,106**;21-MAR-94
+2 ;
EN ;get parameters then run the report
+1 DO HOME^%ZIS
NEW IBASK,IBCANC,IBX
WRITE !!,"Episode of Care Bill List:",!,"--------------------------"
+2 WRITE !,"Enter a Bill Number to get a list of all bills that match the selected bill's",!,"event date or any of it's outpatient visit dates."
+3 WRITE !,"Enter a Patient Name and Episode Date to get a list of all bills for a patient",!,"that have either that date as the event date or as an outpatient visit date."
+4 WRITE !,"This report also includes bills related as continuing episodes of care."
+5 ;
+6 SET IBASK=$$PB^IBJTU2
if IBASK'>0
QUIT
WRITE !
+7 IF +IBASK=1
SET IBX=$$GETDT^IBCRU1("","Episode Date")
if IBX'?7N
QUIT
SET IBASK=IBASK_U_IBX
WRITE !
+8 SET IBADDCPT=$$CPT
if IBADDCPT<0
QUIT
+9 SET IBCANC=$$CANC
if IBCANC<0
QUIT
WRITE !
+10 ;
DEV ;get the device
+1 WRITE !,"Report requires 132 columns."
+2 SET %ZIS="QM"
SET %ZIS("A")="OUTPUT DEVICE: "
DO ^%ZIS
if POP
GOTO EXIT
+3 IF $DATA(IO("Q"))
SET ZTRTN="RPT^IBOBL"
SET ZTDESC="Episode of Care Bill List"
SET ZTSAVE("IB*")=""
DO ^%ZTLOAD
KILL IO("Q")
GOTO EXIT
+4 USE IO
+5 ;
RPT ;find, save, and print the data that satisfies the search parameters
+1 ;entry point for tasked jobs
+2 ;
+3 KILL ^TMP($JOB,"IBOBL")
IF '$GET(IBASK)
GOTO EXIT
+4 ;
+5 DO FIND
+6 DO PRINT
+7 ;
EXIT ;clean up and quit
+1 KILL ^TMP($JOB,"IBOBL"),IBASK,IBADDCPT,IBCANC,IBX
if $DATA(ZTQUEUED)
QUIT
+2 DO ^%ZISC
+3 QUIT
+4 ;
FIND ; compile list of all related bills
+1 NEW IBIFN,IB0,DFN,IBEPDT,IBX
+2 ;
+3 ; compile list of related bills based on event date and opt visit dates of selected bill
+4 IF +IBASK=2
SET IBIFN=+$PIECE(IBASK,U,2)
SET IB0=$GET(^DGCR(399,IBIFN,0))
Begin DoDot:1
+5 SET DFN=$PIECE(IB0,U,2)
SET IBEPDT=$PIECE(IB0,U,3)
DO FIND1(DFN,IBEPDT)
+6 SET IBX=0
FOR
SET IBX=$ORDER(^DGCR(399,+IBIFN,"OP",IBX))
if 'IBX
QUIT
Begin DoDot:2
+7 SET IBEPDT=+$GET(^DGCR(399,+IBIFN,"OP",IBX,0))
if 'IBEPDT
QUIT
DO FIND1(DFN,IBEPDT)
End DoDot:2
End DoDot:1
+8 ;
+9 ; compile list of related bills based on selected patient and episode date
+10 IF +IBASK=1
SET DFN=$PIECE(IBASK,U,2)
SET IBEPDT=$PIECE(IBASK,U,3)
DO FIND1(DFN,IBEPDT)
+11 ;
+12 ; compile list of bills based on Primary Bill link with bills already found
DO FIND2
+13 QUIT
+14 ;
FIND1(DFN,IBEPDT) ; find all bills for a patient with a specific event date or opt visit date
+1 NEW IBX,IBIFN,IBDT
SET IBEPDT=IBEPDT\1
+2 ;
+3 ; find all bills for patient with episode date as outpatient visit date
+4 SET IBDT=IBEPDT-.0001
FOR
SET IBDT=$ORDER(^DGCR(399,"AOPV",DFN,IBDT))
if ((IBDT\1)'=IBEPDT)
QUIT
Begin DoDot:1
+5 SET IBIFN=0
FOR
SET IBIFN=$ORDER(^DGCR(399,"AOPV",DFN,IBDT,IBIFN))
if 'IBIFN
QUIT
Begin DoDot:2
+6 SET IBX=$GET(^DGCR(399,IBIFN,0))
IF IBX=""
QUIT
+7 SET ^TMP($JOB,"IBOBL","BILL",IBIFN)=""
+8 IF +$PIECE(IBX,U,17)
SET ^TMP($JOB,"IBOBL","BILL",+$PIECE(IBX,U,17))=""
End DoDot:2
End DoDot:1
+9 ;
+10 ; find all bills for patient with episode date as Event Date
+11 SET IBDT=IBEPDT-.00001
FOR
SET IBDT=$ORDER(^DGCR(399,"D",IBDT))
if ((IBDT\1)'=IBEPDT)
QUIT
Begin DoDot:1
+12 SET IBIFN=0
FOR
SET IBIFN=$ORDER(^DGCR(399,"D",IBDT,IBIFN))
if 'IBIFN
QUIT
Begin DoDot:2
+13 SET IBX=$GET(^DGCR(399,IBIFN,0))
IF $PIECE(IBX,U,2)'=DFN
QUIT
+14 SET ^TMP($JOB,"IBOBL","BILL",IBIFN)=""
+15 IF +$PIECE(IBX,U,17)
SET ^TMP($JOB,"IBOBL","BILL",+$PIECE(IBX,U,17))=""
End DoDot:2
End DoDot:1
+16 ;
+17 QUIT
+18 ;
FIND2 ; compile list of related bills based on Primary Bill of bills already found
+1 NEW IBBILL,IBIFN,IBX
+2 SET IBBILL=0
FOR
SET IBBILL=$ORDER(^TMP($JOB,"IBOBL","BILL",IBBILL))
if 'IBBILL
QUIT
Begin DoDot:1
+3 SET IBIFN=0
FOR
SET IBIFN=$ORDER(^DGCR(399,"AC",IBBILL,IBIFN))
if 'IBIFN
QUIT
Begin DoDot:2
+4 SET IBX=$GET(^DGCR(399,IBIFN,0))
IF IBX=""
QUIT
+5 SET ^TMP($JOB,"IBOBL","BILL",IBIFN)=""
End DoDot:2
End DoDot:1
+6 QUIT
+7 ;
PRINT ;print the report from the temp sort file to the appropriate device
+1 NEW IBPGN,IBQUIT,IBLN,IBHDR1,IBHDR2,IBIFN
+2 SET IBPGN=0
SET IBQUIT=0
DO HDRLNS
DO HDR
if IBQUIT
QUIT
+3 ;
+4 SET IBIFN=0
FOR
SET IBIFN=$ORDER(^TMP($JOB,"IBOBL","BILL",IBIFN))
if 'IBIFN
QUIT
Begin DoDot:1
+5 IF '$GET(IBCANC)
IF $PIECE($GET(^DGCR(399,+IBIFN,0)),U,13)=7
QUIT
+6 DO PRTLN(IBIFN,IBADDCPT)
End DoDot:1
if $$LNCHK(2)
QUIT
+7 ;
+8 IF 'IBQUIT
DO PAUSE
+9 QUIT
+10 ;
PRTLN(IBIFN,IBADDCPT) ; print one bill with all it's CPTs
+1 NEW IB0,IBU,IBM,IBMP,IBX,IBCPT
SET IBLN=IBLN+1
+2 SET IB0=$GET(^DGCR(399,+$GET(IBIFN),0))
if IB0=""
QUIT
SET IBU=$GET(^DGCR(399,IBIFN,"U"))
+3 SET IBM=$GET(^DGCR(399,IBIFN,"M"))
SET IBMP=$GET(^DGCR(399,IBIFN,"MP"))
+4 WRITE !,$PIECE(IB0,U,1),?12,$PIECE($GET(^DGCR(399.3,+$PIECE(IB0,U,7),0)),U,4)
SET IBX=$PIECE(IB0,U,5)
+5 WRITE ?24,$SELECT(IBX=1:"INPT",IBX=2:"INPT-H",IBX=3:"OPT",IBX=4:"OPT-H",1:"")
SET IBX=$PIECE(IB0,U,27)
+6 WRITE ?32,$SELECT(IBX=1:"INST",IBX=2:"PROF",1:"")
+7 WRITE ?39,$$DATE(+$PIECE(IB0,U,3)),?49,$$DATE(+IBU),?59,$$DATE(+$PIECE(IBU,U,2))
+8 WRITE ?70,$PIECE($$ARSTATA^IBJTU4(IBIFN),U,2)
SET IBX=$PIECE(IB0,U,21)
+9 WRITE ?75,$SELECT(IBX="P":"PRIM",IBX="S":"SEC",IBX="T":"TER",IBX="A":"PAT",1:"")
SET IBX=$PIECE(IB0,U,11)
+10 WRITE ?82,$EXTRACT($SELECT(IBX="i":$PIECE($GET(^DIC(36,+IBMP,0)),U,1),IBX="o":$PIECE($GET(^DIC(4,+$PIECE(IBM,U,11),0)),U,1),IBX="p":$PIECE($GET(^DPT(+$PIECE(IB0,U,2),0)),U,1),1:""),1,23)
+11 WRITE ?107,$JUSTIFY(+$PIECE($$BILL^RCJIBFN2(IBIFN),U,1),10,2)
+12 ;
+13 IF 'IBADDCPT
WRITE !
QUIT
+14 ;
+15 SET IBX=0
FOR
SET IBX=$ORDER(^DGCR(399,IBIFN,"CP",IBX))
if 'IBX
QUIT
Begin DoDot:1
+16 SET IBCPT=$PIECE($GET(^DGCR(399,IBIFN,"CP",IBX,0)),U,1)
IF IBCPT["ICPT"
SET IBCPT(+IBCPT)=+$GET(IBCPT(+IBCPT))+1
End DoDot:1
+17 ;
+18 SET IBCPT=""
FOR
SET IBCPT=$ORDER(IBCPT(IBCPT))
if 'IBCPT
QUIT
Begin DoDot:1
+19 SET IBX=+IBCPT(IBCPT)
WRITE ?120,$PIECE($$CPT^ICPTCOD(+IBCPT),U,2),?127,$SELECT(IBX'=1:"("_IBX_")",1:""),!
SET IBLN=IBLN+1
End DoDot:1
if $$LNCHK(1)
QUIT
+20 ;
+21 QUIT
+22 ;
HDR ;print the report header
+1 NEW IBNOW,IBI
+2 SET IBQUIT=$$STOP
if IBQUIT
QUIT
SET IBPGN=IBPGN+1
SET IBLN=7
+3 SET IBNOW=$$FMTE^XLFDT($$NOW^XLFDT)
SET IBNOW=$PIECE(IBNOW,"@",1)_" "_$PIECE($PIECE(IBNOW,"@",2),":",1,2)
+4 IF IBPGN>1!($EXTRACT(IOST,1,2)["C-")
WRITE @IOF
+5 ;
+6 WRITE !,IBHDR1,?(IOM-30),IBNOW,?(IOM-8),"PAGE ",IBPGN,!,IBHDR2
+7 WRITE !,"BILL #",?12,"RATE",?24,"CLASSIFICATION",?39,"EVENT",?49,"FROM",?59,"TO",?70,"AR",?75,"COB",?82,"PAYER",?112,"TOTAL",?120,"CPT'S",!
+8 SET IBI=""
SET $PIECE(IBI,"-",IOM+1)=""
WRITE IBI
+9 WRITE !
+10 QUIT
+11 ;
HDRLNS ; set up header lines
+1 NEW DFN,IBX
SET DFN=0
+2 SET IBHDR1="EPISODE OF CARE BILL LIST FOR "
+3 IF +IBASK=1
SET IBHDR1=IBHDR1_$PIECE($GET(^DPT(+$PIECE(IBASK,U,2),0)),U,1)_" ON "_$$DATE(+$PIECE(IBASK,U,3))
SET DFN=+$PIECE(IBASK,U,2)
+4 IF +IBASK=2
SET IBX=$GET(^DGCR(399,+$PIECE(IBASK,U,2),0))
SET IBHDR1=IBHDR1_$PIECE(IBX,U,1)
SET DFN=+$PIECE(IBX,U,2)
+5 SET IBX=$GET(^DPT(DFN,0))
SET IBHDR2=$PIECE(IBX,U,1)_$JUSTIFY("",10)_$EXTRACT(IBX)_$PIECE($$PT^IBEFUNC(DFN),U,3)_$JUSTIFY("",10)_"DOB: "_$$DATE($PIECE(IBX,U,3))
+6 QUIT
+7 ;
DATE(X) ;
+1 QUIT $EXTRACT(X,4,5)_"/"_$EXTRACT(X,6,7)_"/"_$EXTRACT(X,2,3)
+2 ;
LNCHK(LNS) ; check if new page is needed
+1 IF 'IBQUIT
IF IBLN>(IOSL-LNS)
DO PAUSE
IF 'IBQUIT
DO HDR
+2 QUIT IBQUIT
+3 ;
PAUSE ;pause at end of screen if beeing displayed on a terminal
+1 if $EXTRACT(IOST,1,2)'["C-"
QUIT
NEW DIR,DUOUT,DTOUT,DIRUT
+2 SET DIR(0)="E"
DO ^DIR
KILL DIR
+3 IF $DATA(DUOUT)!($DATA(DIRUT))
SET IBQUIT=1
+4 QUIT
+5 ;
STOP() ;determine if user has requested the queued report to stop
+1 IF $DATA(ZTQUEUED)
IF $$S^%ZTLOAD
SET ZTSTOP=1
KILL ZTREQ
IF +$GET(IBPGN)
WRITE !,"***TASK STOPPED BY USER***"
+2 QUIT +$GET(ZTSTOP)
+3 ;
CPT() ; return true if include bills CPT procedures
+1 NEW IBX,DIR,DTOUT,DUOUT,DIRUT,X,Y
SET IBX=0
+2 SET DIR("?")="Enter either 'Y' or 'N'. Enter 'Y' if you want the CPT procedures for each bill included in the report."
+3 SET DIR("A")="Include CPT Procedures"
SET DIR(0)="Y"
SET DIR("B")="No"
DO ^DIR
KILL DIR
if Y=1
SET IBX=1
IF $DATA(DIRUT)
SET IBX=-1
+4 QUIT IBX
+5 ;
CANC() ; return true if include canceled bills
+1 NEW IBX,DIR,DTOUT,DUOUT,DIRUT,X,Y
SET IBX=0
+2 SET DIR("?")="Enter either 'Y' or 'N'. Enter 'Y' if you want cancelled bills included in the report."
+3 SET DIR("A")="Include Cancelled Bills"
SET DIR(0)="Y"
SET DIR("B")="No"
DO ^DIR
KILL DIR
if Y=1
SET IBX=1
IF $DATA(DIRUT)
SET IBX=-1
+4 QUIT IBX
