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

IBMHRPT.m

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