IBMHVRP ;EDE/YMG - Mental Health Visit Summary/Detail Report; 09/13/2023
;;2.0;INTEGRATED BILLING;**760**;21-MAR-94;Build 25
;;Per VA Directive 6402, this routine should not be modified.
;
Q
;
EN ; entry point
N IBBDT,IBSD,IBEDT,IBEXCEL,IBCA
N POP,ZTDESC,ZTRTN,ZTSAVE,ZTSK,%ZIS
;
W !
D DATE I IBBDT<0 Q
W !!
; Ask the user if they want a detailed or summary version of the report
S IBSD=$$GETPRMPT("SD") I IBSD=-1 Q
; Ask the user if they want to report on visits at their site only or all sites
S IBCA=$$GETPRMPT("CA") I IBCA=-1 Q
S IBEXCEL=$$GETEXCEL() I IBEXCEL=-1 Q
I IBEXCEL D PRTEXCEL
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 Visit Summary/Detail Report",ZTRTN="COMPILE^IBMHVRP"
.S (ZTSAVE("IBCA"),ZTSAVE("IBBDT"),ZTSAVE("IBEDT"),ZTSAVE("IBEXCEL"),ZTSAVE("IBSD"))=""
.S ZTSAVE("ZTREQ")="@"
.D ^%ZTLOAD,HOME^%ZIS
.I $G(ZTSK) W !!,"Report compilation has started with task# ",ZTSK,".",! D PAUSE(0)
.Q
D COMPILE
D ^%ZISC
Q
;
COMPILE ; compile report
N IBNEW,IBLP,IBIEN,IBDATA,IBDFN,IBFAC,IBSITE,IBSTAT,IBYR,IBMN,IBCSITE,IBCTX
K ^TMP($J,"IBMHVRP"),^TMP($J,"IBMHVRPNM")
;
; Get the current site's ID, and then re-initializing IBSITE for future use.
D SITE^IBAUTL S IBCSITE=IBSITE,IBSITE=""
; Initialize loop to start date
S IBLP=0 ;initial starting value
S:+$G(IBBDT)>0 IBLP=+$G(IBBDT)-1 ; use beginning date if defined
; Loop through the "VD" index to gather
F S IBLP=$O(^IBMH(351.83,"VD",IBLP)) Q:'IBLP Q:IBLP>IBEDT D
.S IBIEN=0 F S IBIEN=$O(^IBMH(351.83,"VD",IBLP,IBIEN)) Q:'IBIEN D
..S IBNEW=0
..S IBDATA=$G(^IBMH(351.83,IBIEN,0)),IBYR=$E(IBLP,1,3)+1700,IBMN=$E(IBLP,1,5)
..I (IBCA="C"),($P(IBDATA,U,2)'=IBCSITE) Q
..S IBDFN=$P(IBDATA,U),IBSITE=$P(IBDATA,U,2),IBSTAT=$P(IBDATA,U,4),IBCTX=IBSTAT+1
..S IBNM=$$GET1^DIQ(2,IBDFN_",",.01,"E") Q:IBNM=""
..; # visits by a patient in a given month (for the total and the code)
..S:'$D(^TMP($J,"IBMHVRP",IBYR,IBMN,IBNM,IBDFN)) IBNEW=1
..S $P(^TMP($J,"IBMHVRP",IBYR,IBMN,IBNM,IBDFN),U)=+$P($G(^TMP($J,"IBMHVRP",IBYR,IBMN,IBNM,IBDFN)),U)+1
..S $P(^TMP($J,"IBMHVRP",IBYR,IBMN,IBNM,IBDFN),U,IBCTX)=+$P($G(^TMP($J,"IBMHVRP",IBYR,IBMN,IBNM,IBDFN)),U,IBCTX)+1
..; # visits in a given month
..S $P(^TMP($J,"IBMHVRP",IBYR,IBMN),U)=+$P($G(^TMP($J,"IBMHVRP",IBYR,IBMN)),U)+1
..S $P(^TMP($J,"IBMHVRP",IBYR,IBMN),U,IBCTX)=+$P($G(^TMP($J,"IBMHVRP",IBYR,IBMN)),U,IBCTX)+1
..S:IBNEW $P(^TMP($J,"IBMHVRP",IBYR,IBMN),U,6)=+$P($G(^TMP($J,"IBMHVRP",IBYR,IBMN)),U,6)+1
..; # visits in a given year
..S $P(^TMP($J,"IBMHVRP",IBYR),U)=+$P($G(^TMP($J,"IBMHVRP",IBYR)),U)+1
..S $P(^TMP($J,"IBMHVRP",IBYR),U,IBCTX)=+$P($G(^TMP($J,"IBMHVRP",IBYR)),U,IBCTX)+1
..I '$D(^TMP($J,"IBMHVRPNM",IBDFN)) D
...S ^TMP($J,"IBMHVRPNM",IBDFN)=""
...S ^TMP($J,"IBMHVRPNM")=$G(^TMP($J,"IBMHVRPNM"))+1
D PRINT
K ^TMP($J,"IBMHVRP"),^TMP($J,"IBMHVRPNM")
Q
;
PRINT ; print report
N IBLINE,IBPAG,IBTOT,IBY,IBCHG,IBMON,IBYR
N IBDTH,IBTOT,IBTOTF,IBTOTC,IBTOTN,IBTOTV,IBQUIT
U IO
S IBDTH=$$FMTE^XLFDT($E($$NOW^XLFDT(),1,12))
S IBLINE="",$P(IBLINE,"=",IOM+1)="",(IBPAG,IBTOT,IBTOTC,IBTOTF,IBTOTN,IBTOTV,IBQUIT,IBCHG)=0
D:'IBEXCEL HDR
D:IBEXCEL EXHDR
I '$D(^TMP($J,"IBMHVRP")) W !!,"No Mental Health Visits found within the specified period" D:'$D(ZTQUEUED)&'IBEXCEL PAUSE(1) Q
; - first, print detail lines
F IBMON=$E(IBBDT,1,5):1:$E(IBEDT,1,5) D Q:IBQUIT
.D:'$D(ZTQUEUED)&'IBEXCEL CHKSTOP Q:IBQUIT
.S IBYR=$E(IBMON,1,3)+1700
.S IBY=$G(^TMP($J,"IBMHVRP",IBYR,IBMON)) Q:$G(IBY)=""
.;If EXCEL Output, display with ^ delim
.I IBEXCEL W !,$$MON($E(IBMON,4,5))_" "_(1700+$E(IBMON,1,3)),U,+$P(IBY,U,1),U,+$P(IBY,U,2),U,+$P(IBY,U,3),U,+$P(IBY,U,4),U,+$P(IBY,U,5),U,+$P(IBY,U,6)
.; Otherwise print in screen format
.I 'IBEXCEL D
..W !,$$MON($E(IBMON,4,5)),?10,1700+$E(IBMON,1,3)
..W ?34,$J(+$P(IBY,U,1),5) ;# visits
..W ?43,$J(+$P(IBY,U,2),5) ;# free visits
..W ?52,$J(+$P(IBY,U,3),5) ;# charged Visits
..W ?62,$J(+$P(IBY,U,4),5) ;# not counted Visits
..W ?72,$J(+$P(IBY,U,5),5) ;# visit only Visits
..W ?83,$J(+$P(IBY,U,6),5) ;# # Unique Patients
..Q
.S IBTOT=IBTOT+$P(IBY,U,1),IBTOTF=IBTOTF+$P(IBY,U,2),IBTOTC=IBTOTC+$P(IBY,U,3),IBTOTN=IBTOTN+$P(IBY,U,4),IBTOTV=IBTOTV+$P(IBY,U,5)
.I IBSD="D" D PRDET(IBYR,IBMON)
.Q
Q:IBQUIT
D TOTALS
;Write Unique Patient Definition
W !!,"*The total unique patient number only counts a patient once for the period",!,"of the report."
I '$D(ZTQUEUED)&'IBEXCEL D PAUSE(1)
Q
;
PRDET(IBYR,IBMON) ; Print the details of the summary
;
N IBDFN,IBNM
S IBNM="" F S IBNM=$O(^TMP($J,"IBMHVRP",IBYR,IBMON,IBNM)) Q:IBNM="" D
.S IBDFN=0 F S IBDFN=$O(^TMP($J,"IBMHVRP",IBYR,IBMON,IBNM,IBDFN)) Q:'IBDFN D
..I '$D(ZTQUEUED)&'IBEXCEL D CHKSTOP Q:IBQUIT
..S IBDATA=$G(^TMP($J,"IBMHVRP",IBYR,IBMON,IBNM,IBDFN))
..; Excel Format
..I IBEXCEL D Q
...W !,$$GET1^DIQ(2,IBDFN_",",.01,"E"),U,+$P(IBDATA,U,1),U,+$P(IBDATA,U,2),U,+$P(IBDATA,U,3),U,+$P(IBDATA,U,4),U,+$P(IBDATA,U,5)
...Q
..;Screen format
..W !?3,$$GET1^DIQ(2,IBDFN_",",.01,"E")
..W ?34,$J(+$P(IBDATA,U,1),5)
..W ?43,$J(+$P(IBDATA,U,2),5) ;# free visits
..W ?52,$J(+$P(IBDATA,U,3),5) ;# charged Visits
..W ?62,$J(+$P(IBDATA,U,4),5) ;# Removed Visits
..W ?72,$J(+$P(IBDATA,U,5),5) ;# Visit On Visits
..Q
.Q
Q
;
TOTALS ; Print the totals.
N IBI,X
; Excel format
I IBEXCEL W !,"REPORT TOTALS",U,IBTOT,U,IBTOTF,U,IBTOTC,U,IBTOTN,U,IBTOTV,U,$G(^TMP($J,"IBMHVRPNM")) Q
; screen format
W ! F IBI=1:1:88 W "-"
W !,"REPORT TOTALS",?34,$J(IBTOT,5),?43,$J(IBTOTF,5),?52,$J(IBTOTC,5),?62,$J(IBTOTN,5),?72,$J(IBTOTV,5),?82,$J($G(^TMP($J,"IBMHVRPNM")),6)
Q
;
HDR ; Print header.
N IBI,IBHDR,IBH,IBH1,IBFACNM,IBH2
I $E(IOST,1,2)["C-"!(IBPAG) W @IOF,*13
S IBHDR=$S(IBSD="S":"SUMMARY",1:"DETAIL")
S IBH="MENTAL HEALTH VISIT TRACKING "_IBHDR_" REPORT"
S IBPAG=IBPAG+1 W ?(122-$L(IBH)\2),IBH
S IBH1="FOR ALL SITES"
I IBCA="C" D
.S IBFACNM=$$GET1^DIQ(4,IBFAC_",",.01,"E")
.S IBH1="FOR "_IBFACNM
W !,?(122-$L(IBH1)\2),IBH1
S IBH2="From "_$$FMTE^XLFDT(IBBDT,"2MZ")_" through "_$$FMTE^XLFDT(IBEDT,"2MZ")
W !,?(122-$L(IBH2)\2),IBH2
W ?IOM-36,IBDTH,?IOM-9,"Page: ",IBPAG
W !!,?33,"TOTAL",?60,"REMOVED",?71,"VISITS",?80,"UNIQUE"
W !," MONTH",?10,"YEAR",?33,"VISITS",?44,"FREE",?51,"BILLED",?60,"VISITS",?71,"ONLY",?80,"PATIENTS"
W ! F IBI=1:1:88 W "-"
Q
;
EXHDR ; Print Excel version of the header.
W !,"MONTH/YEAR",U,"TOTAL VISITS",U,"FREE",U,"BILLED",U,"REMOVED VISITS",U,"VISITS ONLY",U,"UNIQUE PATIENTS"
Q
;
MON(IBMON) I (IBMON<1)!(IBMON>12) Q ""
Q $P("JANUARY FEBRUARY MARCH APRIL MAY JUNE JULY AUGUST SEPTEMBER OCTOBER NOVEMBER DECEMBER"," ",IBMON)
;
CHKSTOP I $Y>(IOSL-5) D PAUSE(0) Q:IBQUIT D HDR
Q
; Ask begin/end dates, with default values
; Input: none
; Output: IBBDT,IBEDT - begin/end dates
DATE N IBNOW
S IBNOW=$$NOW^XLFDT()
DATAGN ;Loop entry point
S (IBBDT,IBEDT)=-1
; Get beginning date
S IBBDT=$$ASKDT("Start with DATE: ",$$FIRST(IBNOW))
I IBBDT<1 Q
; Get ending date
S IBEDT=$$ASKDT("Go to DATE: ",$$LAST(IBNOW))
I IBEDT<1 S IBBDT=-1 Q ;User cancelled
I IBEDT<IBBDT W !,"Ending date must follow start date!",! G DATAGN
Q
;
;Define the first day of the given month
FIRST(IBDT) S $E(IBDT,6,7)="01"
Q IBDT
;
;Define the last day of the given month
LAST(IBDT) N IBM,IBY
S IBY=$E(IBDT,1,3),IBM=+$E(IBDT,4,5)
S IBM=IBM+1 I IBM>12 S IBM=1,IBY=IBY+1
I $L(IBM)<2 S IBM="0"_IBM
Q $$FMADD^XLFDT(IBY_IBM_"01",-1)
;
; Input: prompt, default value (FM format)
; Output: date (FM) or -1, if cancelled
ASKDT(IBPRMT,IBDFLT) ;Date input
N DIR,Y,X,DIROUT,DIRUT
I $G(IBPRMT)'="" S DIR("A")=IBPRMT
I $G(IBDFLT)'="" S DIR("B")=$$FMTE^XLFDT(IBDFLT,"1D")
S DIR(0)="DA"
D ^DIR I $D(DIRUT) Q -1
W " (",$$FMTE^XLFDT(Y),")"
Q Y
;
;Ask the user some questions about what to report
GETPRMPT(IBPRMPT) ;
N X,Y,DTOUT,DUOUT,DIR,DIROUT,DIRUT
;
; Prompt Summary or Detail version
I $G(IBPRMPT)="SD" D
.S DIR("A")="(S)ummary or (D)etailed Report: "
.S DIR("B")="S"
.S DIR(0)="SA^S:SUMMARY;D:DETAILED"
.S DIR("?")="Select the type of report to Generate."
.Q
;
; Prompt Current or All Sites
I $G(IBPRMPT)="CA" D
.S DIR("A")="(C)urrent or (A)ll Sites: "
.S DIR(0)="SA^C:CURRENT;A:ALL SITES"
.S DIR("B")="A"
.S DIR("?")="Select C to run for your site only, otherwise, select A to report on all sites with Mental Health visits Tracked at this site."
.Q
;
D ^DIR K DIR
I $D(DTOUT)!$D(DUOUT)!($G(Y)="") Q -1
Q Y
;
;
GETEXCEL() ; Export the report to MS Excel?
; Function return values:
; 0 - User selected "No" at prompt.
; 1 - User selected "Yes" at prompt.
; ^ - User aborted.
; This function allows the user to indicate whether the report should be
; printed in a format that could easily be imported into an Excel
; spreadsheet. If the user wants to print in EXCEL format, the variable
; IBEXCEL will be set to '1', otherwise IBEXCEL will be set to '0' for "No"
; or "^" to abort.
;
N DIR,DIRUT,Y
S DIR(0)="Y"
S DIR("A")="Export the report to Microsoft Excel (Y/N)"
I $G(IBEXCEL)=1 S DIR("B")="YES"
E S DIR("B")="NO"
S DIR("?",1)="If you want to capture the output from this report in a format that"
S DIR("?",2)="could easily be imported into an Excel spreadsheet, then answer YES here."
S DIR("?")="If you want a normal report output, then answer NO here."
W !
D ^DIR
K DIR
I $D(DIRUT) Q -1 ; Abort
Q +Y
;
PRTEXCEL() ;Print the MS Excel instructions.
W !!?5,"Before continuing, please set up your terminal to capture the"
W !?5,"detail report data and save the detail report data in a text file"
W !?5,"to a local drive. This report may take a while to run."
W !!?5,"Note: To avoid undesired wrapping of the data saved to the file,"
W !?11,"please enter '0;256;99999' at the 'DEVICE:' prompt.",!
Q
;
PAUSE(IBEND) ;
;
; sets IBQUIT variable
;
Q:$E(IOST,1,2)'["C-"
N DIR,DIRUT,DTOUT,DUOUT,DIROUT,Y
W !!
S DIR(0)="E"
I $G(IBEND) S DIR("A")="End of the report. Enter RETURN to continue or '^' to exit"
D ^DIR K DIR I $G(DUOUT) S IBQUIT=1 W @IOF Q
I $G(IBEND) W @IOF
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HIBMHVRP 10429 printed Sep 15, 2024@21:48:34 Page 2
IBMHVRP ;EDE/YMG - Mental Health Visit Summary/Detail Report; 09/13/2023
+1 ;;2.0;INTEGRATED BILLING;**760**;21-MAR-94;Build 25
+2 ;;Per VA Directive 6402, this routine should not be modified.
+3 ;
+4 QUIT
+5 ;
EN ; entry point
+1 NEW IBBDT,IBSD,IBEDT,IBEXCEL,IBCA
+2 NEW POP,ZTDESC,ZTRTN,ZTSAVE,ZTSK,%ZIS
+3 ;
+4 WRITE !
+5 DO DATE
IF IBBDT<0
QUIT
+6 WRITE !!
+7 ; Ask the user if they want a detailed or summary version of the report
+8 SET IBSD=$$GETPRMPT("SD")
IF IBSD=-1
QUIT
+9 ; Ask the user if they want to report on visits at their site only or all sites
+10 SET IBCA=$$GETPRMPT("CA")
IF IBCA=-1
QUIT
+11 SET IBEXCEL=$$GETEXCEL()
IF IBEXCEL=-1
QUIT
+12 IF IBEXCEL
DO PRTEXCEL
+13 IF 'IBEXCEL
WRITE !!,"This report requires 132 column display.",!
+14 ; ask for device
+15 KILL IOP,IO("Q")
+16 SET %ZIS="MQ"
SET %ZIS("B")=""
SET POP=0
DO ^%ZIS
if POP
QUIT
+17 ; queued report
IF $DATA(IO("Q"))
Begin DoDot:1
+18 SET ZTDESC="Mental Health Visit Summary/Detail Report"
SET ZTRTN="COMPILE^IBMHVRP"
+19 SET (ZTSAVE("IBCA"),ZTSAVE("IBBDT"),ZTSAVE("IBEDT"),ZTSAVE("IBEXCEL"),ZTSAVE("IBSD"))=""
+20 SET ZTSAVE("ZTREQ")="@"
+21 DO ^%ZTLOAD
DO HOME^%ZIS
+22 IF $GET(ZTSK)
WRITE !!,"Report compilation has started with task# ",ZTSK,".",!
DO PAUSE(0)
+23 QUIT
End DoDot:1
QUIT
+24 DO COMPILE
+25 DO ^%ZISC
+26 QUIT
+27 ;
COMPILE ; compile report
+1 NEW IBNEW,IBLP,IBIEN,IBDATA,IBDFN,IBFAC,IBSITE,IBSTAT,IBYR,IBMN,IBCSITE,IBCTX
+2 KILL ^TMP($JOB,"IBMHVRP"),^TMP($JOB,"IBMHVRPNM")
+3 ;
+4 ; Get the current site's ID, and then re-initializing IBSITE for future use.
+5 DO SITE^IBAUTL
SET IBCSITE=IBSITE
SET IBSITE=""
+6 ; Initialize loop to start date
+7 ;initial starting value
SET IBLP=0
+8 ; use beginning date if defined
if +$GET(IBBDT)>0
SET IBLP=+$GET(IBBDT)-1
+9 ; Loop through the "VD" index to gather
+10 FOR
SET IBLP=$ORDER(^IBMH(351.83,"VD",IBLP))
if 'IBLP
QUIT
if IBLP>IBEDT
QUIT
Begin DoDot:1
+11 SET IBIEN=0
FOR
SET IBIEN=$ORDER(^IBMH(351.83,"VD",IBLP,IBIEN))
if 'IBIEN
QUIT
Begin DoDot:2
+12 SET IBNEW=0
+13 SET IBDATA=$GET(^IBMH(351.83,IBIEN,0))
SET IBYR=$EXTRACT(IBLP,1,3)+1700
SET IBMN=$EXTRACT(IBLP,1,5)
+14 IF (IBCA="C")
IF ($PIECE(IBDATA,U,2)'=IBCSITE)
QUIT
+15 SET IBDFN=$PIECE(IBDATA,U)
SET IBSITE=$PIECE(IBDATA,U,2)
SET IBSTAT=$PIECE(IBDATA,U,4)
SET IBCTX=IBSTAT+1
+16 SET IBNM=$$GET1^DIQ(2,IBDFN_",",.01,"E")
if IBNM=""
QUIT
+17 ; # visits by a patient in a given month (for the total and the code)
+18 if '$DATA(^TMP($JOB,"IBMHVRP",IBYR,IBMN,IBNM,IBDFN))
SET IBNEW=1
+19 SET $PIECE(^TMP($JOB,"IBMHVRP",IBYR,IBMN,IBNM,IBDFN),U)=+$PIECE($GET(^TMP($JOB,"IBMHVRP",IBYR,IBMN,IBNM,IBDFN)),U)+1
+20 SET $PIECE(^TMP($JOB,"IBMHVRP",IBYR,IBMN,IBNM,IBDFN),U,IBCTX)=+$PIECE($GET(^TMP($JOB,"IBMHVRP",IBYR,IBMN,IBNM,IBDFN)),U,IBCTX)+1
+21 ; # visits in a given month
+22 SET $PIECE(^TMP($JOB,"IBMHVRP",IBYR,IBMN),U)=+$PIECE($GET(^TMP($JOB,"IBMHVRP",IBYR,IBMN)),U)+1
+23 SET $PIECE(^TMP($JOB,"IBMHVRP",IBYR,IBMN),U,IBCTX)=+$PIECE($GET(^TMP($JOB,"IBMHVRP",IBYR,IBMN)),U,IBCTX)+1
+24 if IBNEW
SET $PIECE(^TMP($JOB,"IBMHVRP",IBYR,IBMN),U,6)=+$PIECE($GET(^TMP($JOB,"IBMHVRP",IBYR,IBMN)),U,6)+1
+25 ; # visits in a given year
+26 SET $PIECE(^TMP($JOB,"IBMHVRP",IBYR),U)=+$PIECE($GET(^TMP($JOB,"IBMHVRP",IBYR)),U)+1
+27 SET $PIECE(^TMP($JOB,"IBMHVRP",IBYR),U,IBCTX)=+$PIECE($GET(^TMP($JOB,"IBMHVRP",IBYR)),U,IBCTX)+1
+28 IF '$DATA(^TMP($JOB,"IBMHVRPNM",IBDFN))
Begin DoDot:3
+29 SET ^TMP($JOB,"IBMHVRPNM",IBDFN)=""
+30 SET ^TMP($JOB,"IBMHVRPNM")=$GET(^TMP($JOB,"IBMHVRPNM"))+1
End DoDot:3
End DoDot:2
End DoDot:1
+31 DO PRINT
+32 KILL ^TMP($JOB,"IBMHVRP"),^TMP($JOB,"IBMHVRPNM")
+33 QUIT
+34 ;
PRINT ; print report
+1 NEW IBLINE,IBPAG,IBTOT,IBY,IBCHG,IBMON,IBYR
+2 NEW IBDTH,IBTOT,IBTOTF,IBTOTC,IBTOTN,IBTOTV,IBQUIT
+3 USE IO
+4 SET IBDTH=$$FMTE^XLFDT($EXTRACT($$NOW^XLFDT(),1,12))
+5 SET IBLINE=""
SET $PIECE(IBLINE,"=",IOM+1)=""
SET (IBPAG,IBTOT,IBTOTC,IBTOTF,IBTOTN,IBTOTV,IBQUIT,IBCHG)=0
+6 if 'IBEXCEL
DO HDR
+7 if IBEXCEL
DO EXHDR
+8 IF '$DATA(^TMP($JOB,"IBMHVRP"))
WRITE !!,"No Mental Health Visits found within the specified period"
if '$DATA(ZTQUEUED)&'IBEXCEL
DO PAUSE(1)
QUIT
+9 ; - first, print detail lines
+10 FOR IBMON=$EXTRACT(IBBDT,1,5):1:$EXTRACT(IBEDT,1,5)
Begin DoDot:1
+11 if '$DATA(ZTQUEUED)&'IBEXCEL
DO CHKSTOP
if IBQUIT
QUIT
+12 SET IBYR=$EXTRACT(IBMON,1,3)+1700
+13 SET IBY=$GET(^TMP($JOB,"IBMHVRP",IBYR,IBMON))
if $GET(IBY)=""
QUIT
+14 ;If EXCEL Output, display with ^ delim
+15 IF IBEXCEL
WRITE !,$$MON($EXTRACT(IBMON,4,5))_" "_(1700+$EXTRACT(IBMON,1,3)),U,+$PIECE(IBY,U,1),U,+$PIECE(IBY,U,2),U,+$PIECE(IBY,U,3),U,+$PIECE(IBY,U,4),U,+$PIECE(IBY,U,5),U,+$PIECE(IBY,U,6)
+16 ; Otherwise print in screen format
+17 IF 'IBEXCEL
Begin DoDot:2
+18 WRITE !,$$MON($EXTRACT(IBMON,4,5)),?10,1700+$EXTRACT(IBMON,1,3)
+19 ;# visits
WRITE ?34,$JUSTIFY(+$PIECE(IBY,U,1),5)
+20 ;# free visits
WRITE ?43,$JUSTIFY(+$PIECE(IBY,U,2),5)
+21 ;# charged Visits
WRITE ?52,$JUSTIFY(+$PIECE(IBY,U,3),5)
+22 ;# not counted Visits
WRITE ?62,$JUSTIFY(+$PIECE(IBY,U,4),5)
+23 ;# visit only Visits
WRITE ?72,$JUSTIFY(+$PIECE(IBY,U,5),5)
+24 ;# # Unique Patients
WRITE ?83,$JUSTIFY(+$PIECE(IBY,U,6),5)
+25 QUIT
End DoDot:2
+26 SET IBTOT=IBTOT+$PIECE(IBY,U,1)
SET IBTOTF=IBTOTF+$PIECE(IBY,U,2)
SET IBTOTC=IBTOTC+$PIECE(IBY,U,3)
SET IBTOTN=IBTOTN+$PIECE(IBY,U,4)
SET IBTOTV=IBTOTV+$PIECE(IBY,U,5)
+27 IF IBSD="D"
DO PRDET(IBYR,IBMON)
+28 QUIT
End DoDot:1
if IBQUIT
QUIT
+29 if IBQUIT
QUIT
+30 DO TOTALS
+31 ;Write Unique Patient Definition
+32 WRITE !!,"*The total unique patient number only counts a patient once for the period",!,"of the report."
+33 IF '$DATA(ZTQUEUED)&'IBEXCEL
DO PAUSE(1)
+34 QUIT
+35 ;
PRDET(IBYR,IBMON) ; Print the details of the summary
+1 ;
+2 NEW IBDFN,IBNM
+3 SET IBNM=""
FOR
SET IBNM=$ORDER(^TMP($JOB,"IBMHVRP",IBYR,IBMON,IBNM))
if IBNM=""
QUIT
Begin DoDot:1
+4 SET IBDFN=0
FOR
SET IBDFN=$ORDER(^TMP($JOB,"IBMHVRP",IBYR,IBMON,IBNM,IBDFN))
if 'IBDFN
QUIT
Begin DoDot:2
+5 IF '$DATA(ZTQUEUED)&'IBEXCEL
DO CHKSTOP
if IBQUIT
QUIT
+6 SET IBDATA=$GET(^TMP($JOB,"IBMHVRP",IBYR,IBMON,IBNM,IBDFN))
+7 ; Excel Format
+8 IF IBEXCEL
Begin DoDot:3
+9 WRITE !,$$GET1^DIQ(2,IBDFN_",",.01,"E"),U,+$PIECE(IBDATA,U,1),U,+$PIECE(IBDATA,U,2),U,+$PIECE(IBDATA,U,3),U,+$PIECE(IBDATA,U,4),U,+$PIECE(IBDATA,U,5)
+10 QUIT
End DoDot:3
QUIT
+11 ;Screen format
+12 WRITE !?3,$$GET1^DIQ(2,IBDFN_",",.01,"E")
+13 WRITE ?34,$JUSTIFY(+$PIECE(IBDATA,U,1),5)
+14 ;# free visits
WRITE ?43,$JUSTIFY(+$PIECE(IBDATA,U,2),5)
+15 ;# charged Visits
WRITE ?52,$JUSTIFY(+$PIECE(IBDATA,U,3),5)
+16 ;# Removed Visits
WRITE ?62,$JUSTIFY(+$PIECE(IBDATA,U,4),5)
+17 ;# Visit On Visits
WRITE ?72,$JUSTIFY(+$PIECE(IBDATA,U,5),5)
+18 QUIT
End DoDot:2
+19 QUIT
End DoDot:1
+20 QUIT
+21 ;
TOTALS ; Print the totals.
+1 NEW IBI,X
+2 ; Excel format
+3 IF IBEXCEL
WRITE !,"REPORT TOTALS",U,IBTOT,U,IBTOTF,U,IBTOTC,U,IBTOTN,U,IBTOTV,U,$GET(^TMP($JOB,"IBMHVRPNM"))
QUIT
+4 ; screen format
+5 WRITE !
FOR IBI=1:1:88
WRITE "-"
+6 WRITE !,"REPORT TOTALS",?34,$JUSTIFY(IBTOT,5),?43,$JUSTIFY(IBTOTF,5),?52,$JUSTIFY(IBTOTC,5),?62,$JUSTIFY(IBTOTN,5),?72,$JUSTIFY(IBTOTV,5),?82,$JUSTIFY($GET(^TMP($JOB,"IBMHVRPNM")),6)
+7 QUIT
+8 ;
HDR ; Print header.
+1 NEW IBI,IBHDR,IBH,IBH1,IBFACNM,IBH2
+2 IF $EXTRACT(IOST,1,2)["C-"!(IBPAG)
WRITE @IOF,*13
+3 SET IBHDR=$SELECT(IBSD="S":"SUMMARY",1:"DETAIL")
+4 SET IBH="MENTAL HEALTH VISIT TRACKING "_IBHDR_" REPORT"
+5 SET IBPAG=IBPAG+1
WRITE ?(122-$LENGTH(IBH)\2),IBH
+6 SET IBH1="FOR ALL SITES"
+7 IF IBCA="C"
Begin DoDot:1
+8 SET IBFACNM=$$GET1^DIQ(4,IBFAC_",",.01,"E")
+9 SET IBH1="FOR "_IBFACNM
End DoDot:1
+10 WRITE !,?(122-$LENGTH(IBH1)\2),IBH1
+11 SET IBH2="From "_$$FMTE^XLFDT(IBBDT,"2MZ")_" through "_$$FMTE^XLFDT(IBEDT,"2MZ")
+12 WRITE !,?(122-$LENGTH(IBH2)\2),IBH2
+13 WRITE ?IOM-36,IBDTH,?IOM-9,"Page: ",IBPAG
+14 WRITE !!,?33,"TOTAL",?60,"REMOVED",?71,"VISITS",?80,"UNIQUE"
+15 WRITE !," MONTH",?10,"YEAR",?33,"VISITS",?44,"FREE",?51,"BILLED",?60,"VISITS",?71,"ONLY",?80,"PATIENTS"
+16 WRITE !
FOR IBI=1:1:88
WRITE "-"
+17 QUIT
+18 ;
EXHDR ; Print Excel version of the header.
+1 WRITE !,"MONTH/YEAR",U,"TOTAL VISITS",U,"FREE",U,"BILLED",U,"REMOVED VISITS",U,"VISITS ONLY",U,"UNIQUE PATIENTS"
+2 QUIT
+3 ;
MON(IBMON) IF (IBMON<1)!(IBMON>12)
QUIT ""
+1 QUIT $PIECE("JANUARY FEBRUARY MARCH APRIL MAY JUNE JULY AUGUST SEPTEMBER OCTOBER NOVEMBER DECEMBER"," ",IBMON)
+2 ;
CHKSTOP IF $Y>(IOSL-5)
DO PAUSE(0)
if IBQUIT
QUIT
DO HDR
+1 QUIT
+2 ; Ask begin/end dates, with default values
+3 ; Input: none
+4 ; Output: IBBDT,IBEDT - begin/end dates
DATE NEW IBNOW
+1 SET IBNOW=$$NOW^XLFDT()
DATAGN ;Loop entry point
+1 SET (IBBDT,IBEDT)=-1
+2 ; Get beginning date
+3 SET IBBDT=$$ASKDT("Start with DATE: ",$$FIRST(IBNOW))
+4 IF IBBDT<1
QUIT
+5 ; Get ending date
+6 SET IBEDT=$$ASKDT("Go to DATE: ",$$LAST(IBNOW))
+7 ;User cancelled
IF IBEDT<1
SET IBBDT=-1
QUIT
+8 IF IBEDT<IBBDT
WRITE !,"Ending date must follow start date!",!
GOTO DATAGN
+9 QUIT
+10 ;
+11 ;Define the first day of the given month
FIRST(IBDT) SET $EXTRACT(IBDT,6,7)="01"
+1 QUIT IBDT
+2 ;
+3 ;Define the last day of the given month
LAST(IBDT) NEW IBM,IBY
+1 SET IBY=$EXTRACT(IBDT,1,3)
SET IBM=+$EXTRACT(IBDT,4,5)
+2 SET IBM=IBM+1
IF IBM>12
SET IBM=1
SET IBY=IBY+1
+3 IF $LENGTH(IBM)<2
SET IBM="0"_IBM
+4 QUIT $$FMADD^XLFDT(IBY_IBM_"01",-1)
+5 ;
+6 ; Input: prompt, default value (FM format)
+7 ; Output: date (FM) or -1, if cancelled
ASKDT(IBPRMT,IBDFLT) ;Date input
+1 NEW DIR,Y,X,DIROUT,DIRUT
+2 IF $GET(IBPRMT)'=""
SET DIR("A")=IBPRMT
+3 IF $GET(IBDFLT)'=""
SET DIR("B")=$$FMTE^XLFDT(IBDFLT,"1D")
+4 SET DIR(0)="DA"
+5 DO ^DIR
IF $DATA(DIRUT)
QUIT -1
+6 WRITE " (",$$FMTE^XLFDT(Y),")"
+7 QUIT Y
+8 ;
+9 ;Ask the user some questions about what to report
GETPRMPT(IBPRMPT) ;
+1 NEW X,Y,DTOUT,DUOUT,DIR,DIROUT,DIRUT
+2 ;
+3 ; Prompt Summary or Detail version
+4 IF $GET(IBPRMPT)="SD"
Begin DoDot:1
+5 SET DIR("A")="(S)ummary or (D)etailed Report: "
+6 SET DIR("B")="S"
+7 SET DIR(0)="SA^S:SUMMARY;D:DETAILED"
+8 SET DIR("?")="Select the type of report to Generate."
+9 QUIT
End DoDot:1
+10 ;
+11 ; Prompt Current or All Sites
+12 IF $GET(IBPRMPT)="CA"
Begin DoDot:1
+13 SET DIR("A")="(C)urrent or (A)ll Sites: "
+14 SET DIR(0)="SA^C:CURRENT;A:ALL SITES"
+15 SET DIR("B")="A"
+16 SET DIR("?")="Select C to run for your site only, otherwise, select A to report on all sites with Mental Health visits Tracked at this site."
+17 QUIT
End DoDot:1
+18 ;
+19 DO ^DIR
KILL DIR
+20 IF $DATA(DTOUT)!$DATA(DUOUT)!($GET(Y)="")
QUIT -1
+21 QUIT Y
+22 ;
+23 ;
GETEXCEL() ; Export the report to MS Excel?
+1 ; Function return values:
+2 ; 0 - User selected "No" at prompt.
+3 ; 1 - User selected "Yes" at prompt.
+4 ; ^ - User aborted.
+5 ; This function allows the user to indicate whether the report should be
+6 ; printed in a format that could easily be imported into an Excel
+7 ; spreadsheet. If the user wants to print in EXCEL format, the variable
+8 ; IBEXCEL will be set to '1', otherwise IBEXCEL will be set to '0' for "No"
+9 ; or "^" to abort.
+10 ;
+11 NEW DIR,DIRUT,Y
+12 SET DIR(0)="Y"
+13 SET DIR("A")="Export the report to Microsoft Excel (Y/N)"
+14 IF $GET(IBEXCEL)=1
SET DIR("B")="YES"
+15 IF '$TEST
SET DIR("B")="NO"
+16 SET DIR("?",1)="If you want to capture the output from this report in a format that"
+17 SET DIR("?",2)="could easily be imported into an Excel spreadsheet, then answer YES here."
+18 SET DIR("?")="If you want a normal report output, then answer NO here."
+19 WRITE !
+20 DO ^DIR
+21 KILL DIR
+22 ; Abort
IF $DATA(DIRUT)
QUIT -1
+23 QUIT +Y
+24 ;
PRTEXCEL() ;Print the MS Excel instructions.
+1 WRITE !!?5,"Before continuing, please set up your terminal to capture the"
+2 WRITE !?5,"detail report data and save the detail report data in a text file"
+3 WRITE !?5,"to a local drive. This report may take a while to run."
+4 WRITE !!?5,"Note: To avoid undesired wrapping of the data saved to the file,"
+5 WRITE !?11,"please enter '0;256;99999' at the 'DEVICE:' prompt.",!
+6 QUIT
+7 ;
PAUSE(IBEND) ;
+1 ;
+2 ; sets IBQUIT variable
+3 ;
+4 if $EXTRACT(IOST,1,2)'["C-"
QUIT
+5 NEW DIR,DIRUT,DTOUT,DUOUT,DIROUT,Y
+6 WRITE !!
+7 SET DIR(0)="E"
+8 IF $GET(IBEND)
SET DIR("A")="End of the report. Enter RETURN to continue or '^' to exit"
+9 DO ^DIR
KILL DIR
IF $GET(DUOUT)
SET IBQUIT=1
WRITE @IOF
QUIT
+10 IF $GET(IBEND)
WRITE @IOF
+11 QUIT
