IBMHRPT ;EDE/YMG - Mental Health Copay Exemption Report; 05/04/2023
;;2.0;INTEGRATED BILLING;**784**;21-MAR-94;Build 8
;;Per VA Directive 6402, this routine should not be modified.
;
Q
EN ; entry point
N IBCANC,IBDIVS,IBEDT,IBEXCEL,IBFREE,IBSDT,IBSORT,Z
N POP,ZTDESC,ZTRTN,ZTSAVE,ZTSK,%ZIS
K ^TMP("IBMHRPT",$J)
I '$$ASKDIV(.IBDIVS) Q ; filter by division
S Z=$$ASKDT() I 'Z Q ; date range
S IBSDT=$P(Z,U),IBEDT=$P(Z,U,2)
S IBCANC=$$ASKCANC() I IBCANC=-1 Q
S IBFREE=$$ASKFREE() I IBFREE=-1 Q
S IBSORT=$$ASKSORT() I IBSORT=-1 Q
S IBEXCEL=$$GETEXCEL^IBUCMM() I IBEXCEL<0 Q
I IBEXCEL D PRTEXCEL^IBUCMM()
I 'IBEXCEL W !!,"This report requires 132 column display.",!
; ask for device
K IOP,IO("Q")
S %ZIS="MQ",%ZIS("B")="",POP=0 D ^%ZIS Q:POP
I $D(IO("Q")) D Q ; queued report
.S ZTDESC="Mental Health Copay Exemption Report",ZTRTN="COMPILE^IBMHRPT"
.S (ZTSAVE("IBCANC"),ZTSAVE("IBDIVS"),ZTSAVE("IBSDT"),ZTSAVE("IBEDT"),ZTSAVE("IBEXCEL"),ZTSAVE("IBFREE"),ZTSAVE("IBSORT"))=""
.S ZTSAVE("ZTREQ")="@"
.D ^%ZTLOAD,HOME^%ZIS
.I $G(ZTSK) W !!,"Report compilation has started with task# ",ZTSK,".",! D PAUSE
.Q
D COMPILE
K ^TMP("IBMHRPT",$J)
D ^%ZISC
Q
;
COMPILE ; compile report
N CNT,IBATYP,IBBILL,IBDATA,IBDFN,IBDIV,IBDIVNM,IBDT,IBENC,IBEVDT,IBFVSTS,IBIDX,IBIEN,IBOK,IBPATN,IBSTA,IBSTAT,IBSTR,IENS,Z
S (CNT,IBDFN)=0 F S IBDFN=$O(^IB("AFDT",IBDFN)) Q:'IBDFN D
.S IBDT=-(IBEDT+.01) F S IBDT=$O(^IB("AFDT",IBDFN,IBDT)) Q:'IBDT!(IBDT>(-IBSDT)) D
..S IBEVDT=-IBDT
..S IBFVSTS=$$NUMVSTCK^IBECEAMH(IBDFN,IBEVDT)
..I 'IBFREE,'IBFVSTS Q ; skip patients with no free visits remaining
..S IBIEN=0 F S IBIEN=$O(^IB("AFDT",IBDFN,IBDT,IBIEN)) Q:'IBIEN D
...S CNT=CNT+1 I '$D(ZTQUEUED),'(CNT#100) W "."
...S IENS=IBIEN_"," D GETS^DIQ(350,IENS,".02:.05;.07;.11;.13;.17;.2","IE","IBDATA")
...S IBDIV=+IBDATA(350,IENS,.13,"I")
...I 'IBDIVS,$G(IBDIVS(IBDIV))="" Q ; not selected division
...S IBATYP=IBDATA(350,IENS,.03,"E") I IBATYP'["OPT" Q ; not an outpatient charge
...S IBSTAT=IBDATA(350,IENS,.05,"E") I 'IBCANC,IBSTAT="CANCELLED" Q ; skip cancelled bills
...S IBOK=$$ISCDCANC^IBECEAMH(IBIEN)
...I 'IBOK S Z=$P(IBDATA(350,IENS,.04,"I"),";") S:$P(Z,":")="409.68" IBENC=$P(Z,":",2),IBOK=$$OECHK^IBECEAMH(IBENC,IBEVDT)
...I 'IBOK Q ; not eligible for Cleland-Dole
...S IBSTA=$$STA^XUAF4(IBDIV) I $L(+IBSTA)=$L(IBSTA) S IBSTA=IBSTA_" "
...S IBDIVNM=$$NAME^XUAF4(IBDIV)
...S IBBILL=IBDATA(350,IENS,.11,"E")
...S IBPATN=IBDATA(350,IENS,.02,"E")
...S IBSTR=IBSTA_" "_IBDIVNM_U_IBPATN_U_IBEVDT_U_IBBILL_U_IBATYP_U_IBSTAT_U_IBDATA(350,IENS,.2,"E")
...S IBSTR=IBSTR_U_IBDATA(350,IENS,.07,"E")_U_$S(IBFVSTS:"Y",1:"N")
...S ^TMP("IBMHRPT",$J,CNT)=IBSTR
...S IBIDX=$S(IBSORT="P":IBPATN,IBSORT="S":IBEVDT,1:IBSTA)
...S ^TMP("IBMHRPT",$J,"IDX",IBIDX,CNT)=""
...Q
..Q
.Q
D PRINT
Q
;
PRINT ; print report
N EXTDT,LN,IBDATA,IBEVDT,IBIDX,PAGE,QUIT
U IO
S (PAGE,QUIT)=0
S EXTDT=$$FMTE^XLFDT(DT)
I IBEXCEL D
.W !,"Mental Health Copay Exemption Report^",EXTDT
.W !,$$FLTRSTR(),U,$$SORTSTR()
.W !,"Div^Patient Name^Date Of Service^Bill #^Copay Type^IB Status^Stop^Amt^Free?"
.Q
I 'IBEXCEL D
.I $E(IOST,1,2)["C-",'$D(ZTQUEUED) W @IOF
.D HDR
.Q
I '$D(^TMP("IBMHRPT",$J)) D Q
.I IBEXCEL W !!,"No records found." Q
.W !!,$$CJ^XLFSTR("No records found.",132)
.Q
S IBIDX="" F S IBIDX=$O(^TMP("IBMHRPT",$J,"IDX",IBIDX)) Q:IBIDX="" D Q:$G(QUIT)
.S CNT=0 F S CNT=$O(^TMP("IBMHRPT",$J,"IDX",IBIDX,CNT)) Q:'CNT D Q:$G(QUIT)
..S IBDATA=^TMP("IBMHRPT",$J,CNT)
..S IBEVDT=$$FMTE^XLFDT($P(IBDATA,U,3),"2DZ")
..I IBEXCEL D Q
...W !,$P(IBDATA,U),U,$P(IBDATA,U,2),U,IBEVDT,U,$P(IBDATA,U,4),U,$P(IBDATA,U,5),U,$P(IBDATA,U,6),U,$P(IBDATA,U,7),U,"$",$FN($P(IBDATA,U,8),"",0),U,$P(IBDATA,U,9)
...Q
..S LN=LN+1
..W !,$E($P(IBDATA,U),1,20),?21,$P(IBDATA,U,2),?52,IBEVDT,?61,$P(IBDATA,U,4),?75,$E($P(IBDATA,U,5),1,20),?96,$E($P(IBDATA,U,6),1,20),?117,$P(IBDATA,U,7),?121
..W "$",$FN($P(IBDATA,U,8),"",0),?130,$P(IBDATA,U,9)
..I LN>(IOSL-3) D HDR
..Q
.Q
I '$G(QUIT),'$D(ZTQUEUED),'IBEXCEL W !!,$$CJ^XLFSTR("End of report.",132) D PAUSE
Q
;
HDR ; print header
N DASH
I PAGE>0,'$D(ZTQUEUED) D PAUSE W @IOF I $G(QUIT) Q
S $P(DASH,"-",133)=""
S PAGE=PAGE+1,LN=4
W !,"Mental Health Copay Exemption Report",?66,EXTDT,?120,"Page: ",PAGE
W !,$$FLTRSTR(),";",$$SORTSTR()
W !,"Div Patient Name DoS Bill # Type Status Stop Amt Free"
W !,DASH
Q
;
ASKDT() ; prompt for start and end dates
;
; returns "start date^end date" on success, 0 on user exit / timeout
;
N MHSDT,SDT
N DIR,DUOUT,DTOUT,DIROUT,DIRUT,X,Y
;
S MHSDT=$$GET1^DIQ(350.9,"1,",71.03,"I")
S DIR(0)="DA^"_MHSDT_":"_DT_":EX"
S DIR("A")="Start with Date of Service: "
S DIR("?",1)=" Please enter a valid starting date of service."
S DIR("?",2)=" This date must not be in the future."
S DIR("?")=" This date must not precede "_$$EXTERNAL^DILFD(350.9,71.03,,MHSDT)_"."
D ^DIR I $D(DIRUT)!$D(DIROUT) Q 0
S SDT=Y
; End date
S DIR(0)="DA^"_SDT_"::EX"
S DIR("A")=" End with Date of Service: "
S DIR("?",1)=" Please enter a valid ending date of service."
S DIR("?")=" This date must not precede the starting date entered above."
D ^DIR I $D(DIRUT)!$D(DIROUT) Q 0
Q SDT_U_Y
;
ASKDIV(DIVS) ; prompt for division(s)
;
; DIVS - array of selected divisions, passed by reference
;
; returns 1 on success, 0 on user exit / timeout
;
; sets DIVS = 1 for all divisions, 0 for selected divisions
; DIVS(file 4 ien) = division name (only for selected divisions)
;
N DIC,VAUTDV,VAUTNI,VAUTSTR,VAUTVB
S DIC=4,VAUTNI=0,VAUTSTR="division",VAUTVB="VAUTDV" D FIRST^VAUTOMA
I 'VAUTDV,$O(VAUTDV(""))="" Q 0
M DIVS=VAUTDV
Q 1
;
ASKSORT() ; display "sort by" prompt
;
; returns P for patient, S for date of service, D for division, -1 for user exit / timeout
;
N DIR,DUOUT,DTOUT,DIROUT,DIRUT,X,Y
S DIR(0)="SA^P:Patient;S:Date of Service;D:Division"
S DIR("A")="Sort By (P)atient, Date of (S)ervice or (D)ivision: "
D ^DIR I $D(DIRUT)!$D(DTOUT)!$D(DUOUT)!$D(DIROUT) Q -1
Q Y
;
FLTRSTR() ; returns "Filtered by" string to print
Q "Filtered by: "_$S('IBDIVS:"Division",1:"No filter")
;
SORTSTR() ; returns "Sorted by" string to print
Q "Sorted by: "_$S(IBSORT="P":"Patient",IBSORT="S":"Date of Service",1:"Division")
;
PAUSE ; "Press Return to Continue" prompt
N DIR,DUOUT,DTOUT,DIROUT,DIRUT,X,Y
W !
S DIR(0)="E" D ^DIR
I $D(DIRUT) S QUIT=1
W !
Q
;
ASKCANC() ; display "include cancelled bills" prompt
;
; returns 1 for "yes", 0 for "no", or -1 for user exit / timeout
;
N X,Y,DTOUT,DUOUT,DIR,DIROUT,DIRUT
W !
S DIR("A")="Do you want to include cancelled bills? (Y/N): "
S DIR(0)="YA"
D ^DIR
I $D(DIRUT)!$D(DTOUT)!$D(DUOUT)!$D(DIROUT) Q -1
Q $S(+Y=1:1,1:0)
;
ASKFREE() ; display "include free visits" prompt
;
; returns 1 for "yes", 0 for "no", or -1 for user exit / timeout
;
N X,Y,DTOUT,DUOUT,DIR,DIROUT,DIRUT
W !
S DIR("A")="Do you want to include patients with no remaining free MH visits? (Y/N): "
S DIR(0)="YA"
D ^DIR
I $D(DIRUT)!$D(DTOUT)!$D(DUOUT)!$D(DIROUT) Q -1
Q $S(+Y=1:1,1:0)
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HIBMHRPT 7328 printed Oct 16, 2024@18:25:06 Page 2
IBMHRPT ;EDE/YMG - Mental Health Copay Exemption Report; 05/04/2023
+1 ;;2.0;INTEGRATED BILLING;**784**;21-MAR-94;Build 8
+2 ;;Per VA Directive 6402, this routine should not be modified.
+3 ;
+4 QUIT
EN ; entry point
+1 NEW IBCANC,IBDIVS,IBEDT,IBEXCEL,IBFREE,IBSDT,IBSORT,Z
+2 NEW POP,ZTDESC,ZTRTN,ZTSAVE,ZTSK,%ZIS
+3 KILL ^TMP("IBMHRPT",$JOB)
+4 ; filter by division
IF '$$ASKDIV(.IBDIVS)
QUIT
+5 ; date range
SET Z=$$ASKDT()
IF 'Z
QUIT
+6 SET IBSDT=$PIECE(Z,U)
SET IBEDT=$PIECE(Z,U,2)
+7 SET IBCANC=$$ASKCANC()
IF IBCANC=-1
QUIT
+8 SET IBFREE=$$ASKFREE()
IF IBFREE=-1
QUIT
+9 SET IBSORT=$$ASKSORT()
IF IBSORT=-1
QUIT
+10 SET IBEXCEL=$$GETEXCEL^IBUCMM()
IF IBEXCEL<0
QUIT
+11 IF IBEXCEL
DO PRTEXCEL^IBUCMM()
+12 IF 'IBEXCEL
WRITE !!,"This report requires 132 column display.",!
+13 ; ask for device
+14 KILL IOP,IO("Q")
+15 SET %ZIS="MQ"
SET %ZIS("B")=""
SET POP=0
DO ^%ZIS
if POP
QUIT
+16 ; queued report
IF $DATA(IO("Q"))
Begin DoDot:1
+17 SET ZTDESC="Mental Health Copay Exemption Report"
SET ZTRTN="COMPILE^IBMHRPT"
+18 SET (ZTSAVE("IBCANC"),ZTSAVE("IBDIVS"),ZTSAVE("IBSDT"),ZTSAVE("IBEDT"),ZTSAVE("IBEXCEL"),ZTSAVE("IBFREE"),ZTSAVE("IBSORT"))=""
+19 SET ZTSAVE("ZTREQ")="@"
+20 DO ^%ZTLOAD
DO HOME^%ZIS
+21 IF $GET(ZTSK)
WRITE !!,"Report compilation has started with task# ",ZTSK,".",!
DO PAUSE
+22 QUIT
End DoDot:1
QUIT
+23 DO COMPILE
+24 KILL ^TMP("IBMHRPT",$JOB)
+25 DO ^%ZISC
+26 QUIT
+27 ;
COMPILE ; compile report
+1 NEW CNT,IBATYP,IBBILL,IBDATA,IBDFN,IBDIV,IBDIVNM,IBDT,IBENC,IBEVDT,IBFVSTS,IBIDX,IBIEN,IBOK,IBPATN,IBSTA,IBSTAT,IBSTR,IENS,Z
+2 SET (CNT,IBDFN)=0
FOR
SET IBDFN=$ORDER(^IB("AFDT",IBDFN))
if 'IBDFN
QUIT
Begin DoDot:1
+3 SET IBDT=-(IBEDT+.01)
FOR
SET IBDT=$ORDER(^IB("AFDT",IBDFN,IBDT))
if 'IBDT!(IBDT>(-IBSDT))
QUIT
Begin DoDot:2
+4 SET IBEVDT=-IBDT
+5 SET IBFVSTS=$$NUMVSTCK^IBECEAMH(IBDFN,IBEVDT)
+6 ; skip patients with no free visits remaining
IF 'IBFREE
IF 'IBFVSTS
QUIT
+7 SET IBIEN=0
FOR
SET IBIEN=$ORDER(^IB("AFDT",IBDFN,IBDT,IBIEN))
if 'IBIEN
QUIT
Begin DoDot:3
+8 SET CNT=CNT+1
IF '$DATA(ZTQUEUED)
IF '(CNT#100)
WRITE "."
+9 SET IENS=IBIEN_","
DO GETS^DIQ(350,IENS,".02:.05;.07;.11;.13;.17;.2","IE","IBDATA")
+10 SET IBDIV=+IBDATA(350,IENS,.13,"I")
+11 ; not selected division
IF 'IBDIVS
IF $GET(IBDIVS(IBDIV))=""
QUIT
+12 ; not an outpatient charge
SET IBATYP=IBDATA(350,IENS,.03,"E")
IF IBATYP'["OPT"
QUIT
+13 ; skip cancelled bills
SET IBSTAT=IBDATA(350,IENS,.05,"E")
IF 'IBCANC
IF IBSTAT="CANCELLED"
QUIT
+14 SET IBOK=$$ISCDCANC^IBECEAMH(IBIEN)
+15 IF 'IBOK
SET Z=$PIECE(IBDATA(350,IENS,.04,"I"),";")
if $PIECE(Z,"
SET IBENC=$PIECE(Z,":",2)
SET IBOK=$$OECHK^IBECEAMH(IBENC,IBEVDT)
+16 ; not eligible for Cleland-Dole
IF 'IBOK
QUIT
+17 SET IBSTA=$$STA^XUAF4(IBDIV)
IF $LENGTH(+IBSTA)=$LENGTH(IBSTA)
SET IBSTA=IBSTA_" "
+18 SET IBDIVNM=$$NAME^XUAF4(IBDIV)
+19 SET IBBILL=IBDATA(350,IENS,.11,"E")
+20 SET IBPATN=IBDATA(350,IENS,.02,"E")
+21 SET IBSTR=IBSTA_" "_IBDIVNM_U_IBPATN_U_IBEVDT_U_IBBILL_U_IBATYP_U_IBSTAT_U_IBDATA(350,IENS,.2,"E")
+22 SET IBSTR=IBSTR_U_IBDATA(350,IENS,.07,"E")_U_$SELECT(IBFVSTS:"Y",1:"N")
+23 SET ^TMP("IBMHRPT",$JOB,CNT)=IBSTR
+24 SET IBIDX=$SELECT(IBSORT="P":IBPATN,IBSORT="S":IBEVDT,1:IBSTA)
+25 SET ^TMP("IBMHRPT",$JOB,"IDX",IBIDX,CNT)=""
+26 QUIT
End DoDot:3
+27 QUIT
End DoDot:2
+28 QUIT
End DoDot:1
+29 DO PRINT
+30 QUIT
+31 ;
PRINT ; print report
+1 NEW EXTDT,LN,IBDATA,IBEVDT,IBIDX,PAGE,QUIT
+2 USE IO
+3 SET (PAGE,QUIT)=0
+4 SET EXTDT=$$FMTE^XLFDT(DT)
+5 IF IBEXCEL
Begin DoDot:1
+6 WRITE !,"Mental Health Copay Exemption Report^",EXTDT
+7 WRITE !,$$FLTRSTR(),U,$$SORTSTR()
+8 WRITE !,"Div^Patient Name^Date Of Service^Bill #^Copay Type^IB Status^Stop^Amt^Free?"
+9 QUIT
End DoDot:1
+10 IF 'IBEXCEL
Begin DoDot:1
+11 IF $EXTRACT(IOST,1,2)["C-"
IF '$DATA(ZTQUEUED)
WRITE @IOF
+12 DO HDR
+13 QUIT
End DoDot:1
+14 IF '$DATA(^TMP("IBMHRPT",$JOB))
Begin DoDot:1
+15 IF IBEXCEL
WRITE !!,"No records found."
QUIT
+16 WRITE !!,$$CJ^XLFSTR("No records found.",132)
+17 QUIT
End DoDot:1
QUIT
+18 SET IBIDX=""
FOR
SET IBIDX=$ORDER(^TMP("IBMHRPT",$JOB,"IDX",IBIDX))
if IBIDX=""
QUIT
Begin DoDot:1
+19 SET CNT=0
FOR
SET CNT=$ORDER(^TMP("IBMHRPT",$JOB,"IDX",IBIDX,CNT))
if 'CNT
QUIT
Begin DoDot:2
+20 SET IBDATA=^TMP("IBMHRPT",$JOB,CNT)
+21 SET IBEVDT=$$FMTE^XLFDT($PIECE(IBDATA,U,3),"2DZ")
+22 IF IBEXCEL
Begin DoDot:3
+23 WRITE !,$PIECE(IBDATA,U),U,$PIECE(IBDATA,U,2),U,IBEVDT,U,$PIECE(IBDATA,U,4),U,$PIECE(IBDATA,U,5),U,$PIECE(IBDATA,U,6),U,$PIECE(IBDATA,U,7),U,"$",$FNUMBER($PIECE(IBDATA,U,8),"",0),U,$PIECE(IBDATA,U,9)
+24 QUIT
End DoDot:3
QUIT
+25 SET LN=LN+1
+26 WRITE !,$EXTRACT($PIECE(IBDATA,U),1,20),?21,$PIECE(IBDATA,U,2),?52,IBEVDT,?61,$PIECE(IBDATA,U,4),?75,$EXTRACT($PIECE(IBDATA,U,5),1,20),?96,$EXTRACT($PIECE(IBDATA,U,6),1,20),?117,$PIECE(IBDATA,U,7),?121
+27 WRITE "$",$FNUMBER($PIECE(IBDATA,U,8),"",0),?130,$PIECE(IBDATA,U,9)
+28 IF LN>(IOSL-3)
DO HDR
+29 QUIT
End DoDot:2
if $GET(QUIT)
QUIT
+30 QUIT
End DoDot:1
if $GET(QUIT)
QUIT
+31 IF '$GET(QUIT)
IF '$DATA(ZTQUEUED)
IF 'IBEXCEL
WRITE !!,$$CJ^XLFSTR("End of report.",132)
DO PAUSE
+32 QUIT
+33 ;
HDR ; print header
+1 NEW DASH
+2 IF PAGE>0
IF '$DATA(ZTQUEUED)
DO PAUSE
WRITE @IOF
IF $GET(QUIT)
QUIT
+3 SET $PIECE(DASH,"-",133)=""
+4 SET PAGE=PAGE+1
SET LN=4
+5 WRITE !,"Mental Health Copay Exemption Report",?66,EXTDT,?120,"Page: ",PAGE
+6 WRITE !,$$FLTRSTR(),";",$$SORTSTR()
+7 WRITE !,"Div Patient Name DoS Bill # Type Status Stop Amt Free"
+8 WRITE !,DASH
+9 QUIT
+10 ;
ASKDT() ; prompt for start and end dates
+1 ;
+2 ; returns "start date^end date" on success, 0 on user exit / timeout
+3 ;
+4 NEW MHSDT,SDT
+5 NEW DIR,DUOUT,DTOUT,DIROUT,DIRUT,X,Y
+6 ;
+7 SET MHSDT=$$GET1^DIQ(350.9,"1,",71.03,"I")
+8 SET DIR(0)="DA^"_MHSDT_":"_DT_":EX"
+9 SET DIR("A")="Start with Date of Service: "
+10 SET DIR("?",1)=" Please enter a valid starting date of service."
+11 SET DIR("?",2)=" This date must not be in the future."
+12 SET DIR("?")=" This date must not precede "_$$EXTERNAL^DILFD(350.9,71.03,,MHSDT)_"."
+13 DO ^DIR
IF $DATA(DIRUT)!$DATA(DIROUT)
QUIT 0
+14 SET SDT=Y
+15 ; End date
+16 SET DIR(0)="DA^"_SDT_"::EX"
+17 SET DIR("A")=" End with Date of Service: "
+18 SET DIR("?",1)=" Please enter a valid ending date of service."
+19 SET DIR("?")=" This date must not precede the starting date entered above."
+20 DO ^DIR
IF $DATA(DIRUT)!$DATA(DIROUT)
QUIT 0
+21 QUIT SDT_U_Y
+22 ;
ASKDIV(DIVS) ; prompt for division(s)
+1 ;
+2 ; DIVS - array of selected divisions, passed by reference
+3 ;
+4 ; returns 1 on success, 0 on user exit / timeout
+5 ;
+6 ; sets DIVS = 1 for all divisions, 0 for selected divisions
+7 ; DIVS(file 4 ien) = division name (only for selected divisions)
+8 ;
+9 NEW DIC,VAUTDV,VAUTNI,VAUTSTR,VAUTVB
+10 SET DIC=4
SET VAUTNI=0
SET VAUTSTR="division"
SET VAUTVB="VAUTDV"
DO FIRST^VAUTOMA
+11 IF 'VAUTDV
IF $ORDER(VAUTDV(""))=""
QUIT 0
+12 MERGE DIVS=VAUTDV
+13 QUIT 1
+14 ;
ASKSORT() ; display "sort by" prompt
+1 ;
+2 ; returns P for patient, S for date of service, D for division, -1 for user exit / timeout
+3 ;
+4 NEW DIR,DUOUT,DTOUT,DIROUT,DIRUT,X,Y
+5 SET DIR(0)="SA^P:Patient;S:Date of Service;D:Division"
+6 SET DIR("A")="Sort By (P)atient, Date of (S)ervice or (D)ivision: "
+7 DO ^DIR
IF $DATA(DIRUT)!$DATA(DTOUT)!$DATA(DUOUT)!$DATA(DIROUT)
QUIT -1
+8 QUIT Y
+9 ;
FLTRSTR() ; returns "Filtered by" string to print
+1 QUIT "Filtered by: "_$SELECT('IBDIVS:"Division",1:"No filter")
+2 ;
SORTSTR() ; returns "Sorted by" string to print
+1 QUIT "Sorted by: "_$SELECT(IBSORT="P":"Patient",IBSORT="S":"Date of Service",1:"Division")
+2 ;
PAUSE ; "Press Return to Continue" prompt
+1 NEW DIR,DUOUT,DTOUT,DIROUT,DIRUT,X,Y
+2 WRITE !
+3 SET DIR(0)="E"
DO ^DIR
+4 IF $DATA(DIRUT)
SET QUIT=1
+5 WRITE !
+6 QUIT
+7 ;
ASKCANC() ; display "include cancelled bills" prompt
+1 ;
+2 ; returns 1 for "yes", 0 for "no", or -1 for user exit / timeout
+3 ;
+4 NEW X,Y,DTOUT,DUOUT,DIR,DIROUT,DIRUT
+5 WRITE !
+6 SET DIR("A")="Do you want to include cancelled bills? (Y/N): "
+7 SET DIR(0)="YA"
+8 DO ^DIR
+9 IF $DATA(DIRUT)!$DATA(DTOUT)!$DATA(DUOUT)!$DATA(DIROUT)
QUIT -1
+10 QUIT $SELECT(+Y=1:1,1:0)
+11 ;
ASKFREE() ; display "include free visits" prompt
+1 ;
+2 ; returns 1 for "yes", 0 for "no", or -1 for user exit / timeout
+3 ;
+4 NEW X,Y,DTOUT,DUOUT,DIR,DIROUT,DIRUT
+5 WRITE !
+6 SET DIR("A")="Do you want to include patients with no remaining free MH visits? (Y/N): "
+7 SET DIR(0)="YA"
+8 DO ^DIR
+9 IF $DATA(DIRUT)!$DATA(DTOUT)!$DATA(DUOUT)!$DATA(DIROUT)
QUIT -1
+10 QUIT $SELECT(+Y=1:1,1:0)
