Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: IBMHVRP

IBMHVRP.m

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