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

IBINRPT.m

Go to the documentation of this file. 
  1. IBINRPT ;YMG/EDE -  AI/AN (MEGABUS Act) Copay Exemption Report ;NOV 23 2021
  1.  ;;2.0;INTEGRATED BILLING;**716,782**;21-MAR-94;Build 9
  1.  ;;Per VA Directive 6402, this routine should not be modified.
  1.  ;
  1.  ; Reference to FILE #2 in ICR #7300
  1.  ;
  1.  Q
  1.  ;
  1. EN ; entry point
  1.  N EXCEL,IBEND,IBSTART,QUIT
  1.  N POP,ZTDESC,ZTRTN,ZTSAVE,ZTSK,%ZIS
  1.  K ^TMP("IBINRPT",$J)
  1.  W !!,"AI/AN Verified Copay Exemption Report",!
  1.  ; ask for dates
  1.  S QUIT=0 D ASKDT I QUIT Q
  1.  ; export to Excel?
  1.  S EXCEL=$$GETEXCEL^IBUCMM() I EXCEL<0 Q
  1.  I EXCEL D PRTEXCEL^IBUCMM()
  1.  I 'EXCEL 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="AI/AN Verified Copay Exemption Report",ZTRTN="COMPILE^IBINRPT"
  1.  .S ZTSAVE("EXCEL")="",ZTSAVE("IBEND")="",ZTSAVE("IBSTART")="",ZTSAVE("ZTREQ")="@"  ; IB*2.0*782
  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.  Q
  1.  ;
  1. COMPILE ; compile report
  1.  N IBBLNO,IBCHRG,IBCHTYPE,IBDATA,IBDFN,IBFR,IBGRP,IBIEN,IBIENS,IBINDTM,IBINFLG,IBINSTDT,IBNM,IBPID,IBSTATNM,IBTO,Z
  1.  S IBINDTM=IBSTART-.001 F  S IBINDTM=$O(^DPT("AINC",IBINDTM)) Q:'IBINDTM!($P(IBINDTM,".")>IBEND)  D
  1.  .S IBDFN=0 F  S IBDFN=$O(^DPT("AINC",IBINDTM,IBDFN)) Q:'IBDFN  D
  1.  ..S Z=$$INDGET^IBINUT1(IBDFN)
  1.  ..S IBINFLG=$P(Z,U)  ; AI/AN self-identification flag (Y/N)
  1.  ..S IBINSTDT=$P(Z,U,2)  ; AI/AN self-identification start date
  1.  ..S IBIEN=0 F  S IBIEN=$O(^IB("C",IBDFN,IBIEN)) Q:'IBIEN  D
  1.  ...S IBDATA=^IB(IBIEN,0)  ; file 350 node 0
  1.  ...S IBTO=+$P(IBDATA,U,15)  ; "Bill To" date
  1.  ...I '$$INDCHKDT^IBINUT1(IBTO,IBINSTDT) Q  ; bill timeframe is not covered by exemption
  1.  ...S IBIENS=IBIEN_","  ; IB*2.0*782
  1.  ...S IBSTATNM=$$GET1^DIQ(350,IBIENS,.05,"E")  ; bill status (350/.05) - external
  1.  ...; check bill status
  1.  ...I IBINFLG'="Y" Q
  1.  ...I IBINFLG="Y","^BILLED^HOLD - RATE^HOLD - REVIEW^ON HOLD^"'[(U_IBSTATNM_U) Q
  1.  ...S IBCHTYPE=$P(IBDATA,U,3) Q:IBCHTYPE=""  ; charge type (350/.03)
  1.  ...S IBGRP=$P(^IBE(350.1,IBCHTYPE,0),U,11) I IBGRP=7!(IBGRP=9) Q  ; quit if LTC or Tricare charge
  1.  ...Q:$$GET1^DIQ(350.1,IBCHTYPE,.05,"E")'="NEW"
  1.  ...S IBBLNO=$P(IBDATA,U,11)  ; bill #
  1.  ...S Z=$$PATID(IBDFN),IBPID=$P(Z,U),IBNM=$P(Z,U,2)  ; patient id and name
  1.  ...S IBCHRG=$P(IBDATA,U,7)  ; bill amount (350/.07)
  1.  ...S IBFR=$P(IBDATA,U,14)  ; "Bill From" date
  1.  ...S ^TMP("IBINRPT",$J,IBDFN,IBIEN)=IBNM_U_IBPID_U_IBINSTDT_U_IBBLNO_U_IBCHTYPE_U_IBSTATNM_U_IBFR_U_IBTO_U_IBCHRG
  1.  ...S ^TMP("IBINRPT",$J,"IDX",IBNM,IBDFN)=""
  1.  ...Q
  1.  ..Q
  1.  .Q
  1.  D PRINT
  1.  K ^TMP("IBINRPT",$J)
  1.  Q
  1.  ;
  1. PRINT ; print report
  1.  N EXTDT,IBCHRG,IBCHTYPE,IBDATA,IBDFN,IBNM,LN,PAGE,QUIT
  1.  U IO
  1.  S (PAGE,QUIT)=0
  1.  S EXTDT=$$FMTE^XLFDT(DT)
  1.  I EXCEL D
  1.  .W !,"AI/AN Verified Copay Exemption Report",U,EXTDT,U,$$FMTE^XLFDT(IBSTART),"-",$$FMTE^XLFDT(IBEND)
  1.  .W !,"Name^ID^AI/AN Start date^Bill #^Charge type^Bill status^Bill From date^Bill To Date^Bill amount"
  1.  .Q
  1.  I 'EXCEL D
  1.  .I $E(IOST,1,2)["C-",'$D(ZTQUEUED) W @IOF
  1.  .D HDR
  1.  .Q
  1.  I '$D(^TMP("IBINRPT",$J)) D  Q
  1.  .I EXCEL W !!,"No records found." Q
  1.  .W !!,$$CJ^XLFSTR("No records found.",132)
  1.  .I PAGE>0,'$D(ZTQUEUED) W ! D PAUSE W @IOF
  1.  .Q
  1.  S IBNM="" F  S IBNM=$O(^TMP("IBINRPT",$J,"IDX",IBNM)) Q:IBNM=""!QUIT  D
  1.  .S IBDFN="" F  S IBDFN=$O(^TMP("IBINRPT",$J,"IDX",IBNM,IBDFN)) Q:IBDFN=""!QUIT  D
  1.  ..S IBIEN="" F  S IBIEN=$O(^TMP("IBINRPT",$J,IBDFN,IBIEN)) Q:IBIEN=""!QUIT  D
  1.  ...S IBDATA=^TMP("IBINRPT",$J,IBDFN,IBIEN)
  1.  ...S IBCHTYPE=$$GET1^DIQ(350.1,$P(IBDATA,U,5),.01,"E")
  1.  ...S IBCHRG=$FN($P(IBDATA,U,9),"",2)
  1.  ...I EXCEL D  Q
  1.  ....W !,$P(IBDATA,U),U,$P(IBDATA,U,2),U,$$FMTE^XLFDT($P(IBDATA,U,3),"2Z"),U,$P(IBDATA,U,4),U,IBCHTYPE,U,$P(IBDATA,U,6),U
  1.  ....W $$FMTE^XLFDT($P(IBDATA,U,7),"2DZ"),U,$$FMTE^XLFDT($P(IBDATA,U,8),"2DZ"),U,IBCHRG  ; IB*2.0*782
  1.  ....Q
  1.  ...S LN=LN+1
  1.  ...W !,$E($P(IBDATA,U),1,25),?27,$P(IBDATA,U,2),?34,$$FMTE^XLFDT($P(IBDATA,U,3),"2Z"),?45,$$CJ^XLFSTR($P(IBDATA,U,4),12),?58
  1.  ...W $E(IBCHTYPE,1,12),?72,$$CJ^XLFSTR($P(IBDATA,U,6),13),?88,$$FMTE^XLFDT($P(IBDATA,U,7),"2DZ"),?99,$$FMTE^XLFDT($P(IBDATA,U,8),"2DZ"),?107  ; IB*2.0*782
  1.  ...W $$CJ^XLFSTR("$"_IBCHRG,11)  ; IB*2.0*782
  1.  ...I LN>(IOSL-3) D HDR I QUIT Q
  1.  ...Q
  1.  ..Q
  1.  .Q
  1.  I PAGE>0,'$D(ZTQUEUED),'QUIT W !!,$$CJ^XLFSTR("End of report.",132) D PAUSE W @IOF
  1.  Q
  1.  ;
  1. HDR ; print header
  1.  I PAGE>0,'$D(ZTQUEUED) D PAUSE W @IOF I $G(QUIT) Q
  1.  S PAGE=PAGE+1,LN=7
  1.  W !,"AI/AN Verified Copay Exemption Report",?66,EXTDT,?119,"Page: ",PAGE
  1.  W !,"AI/AN Change dates: ",$$FMTE^XLFDT(IBSTART)," - ",$$FMTE^XLFDT(IBEND)
  1.  W !
  1.  W !,"                                   AI/AN                                                Bill From  Bill To    Bill "
  1.  W !,"Name                        ID   Start Date  Bill #       Charge Type    Bill Status      Date      Date     Amount"
  1.  W ! D DASH(132)
  1.  Q
  1.  ;
  1. DASH(LEN) ; print line of dashes
  1.  N DASH
  1.  S $P(DASH,"-",LEN+1)="" W DASH
  1.  Q
  1.  ;
  1. PATID(DFN) ; returns Id for a given patient
  1.  ;
  1.  ; DFN - patient's DFN
  1.  ;
  1.  ; returns [first letter of the last name]_[last 4 digits of the SSN for a given patient] ^ patient name, or "" if unable to get the Id
  1.  ;
  1.  N IBNM,VADM
  1.  I +$G(DFN)'>0 Q ""
  1.  D DEM^VADPT
  1.  S IBNM=VADM(1)
  1.  Q $E(IBNM,1)_$P($P(VADM(2),U,2),"-",3)_U_IBNM
  1.  ;
  1. ASKDT ; prompt for start and end dates
  1.  ;
  1.  ; sets IBSTART and IBEND vars to start date and end date respectively, sets QUIT=1 on user exit
  1.  ;
  1.  N DIR,DUOUT,DTOUT,DIRUT,X,Y
  1.  S DIR(0)="DA^3220105:"_DT_":EX"  ; IB*2.0*782
  1.  S DIR("A")="Start with AI/AN change date: "
  1.  S DIR("B")=$$FMTE^XLFDT($$FMADD^XLFDT(DT,-7),"1D")
  1.  S DIR("?",2)="   Please enter a valid start date."  ; IB*2.0*782
  1.  S DIR("?",1)="   This date must not precede 01/05/22."  ; IB*2.0*782
  1.  S DIR("?")="   This date must not be in the future."  ; IB*2.0*782
  1.  D ^DIR
  1.  I $D(DIRUT) S QUIT=1 G ASKDTX
  1.  S IBSTART=Y
  1.  ; End date
  1. ASKDT1 ;
  1.  S DIR(0)="DA^"_IBSTART_":"_DT_":EX"  ; IB*2.0*782
  1.  S DIR("A")="  End with AI/AN change date: "
  1.  S DIR("B")=$$FMTE^XLFDT($$FMADD^XLFDT(DT),"1D")
  1.  S DIR("?",2)="   Please enter a valid end date."  ; IB*2.0*782
  1.  S DIR("?",1)="   This date must not precede the start date entered above."  ; IB*2.0*782
  1.  S DIR("?")="   This date must not be in the future."  ; IB*2.0*782
  1.  D ^DIR
  1.  I $D(DIRUT) S QUIT=1 G ASKDTX
  1.  S IBEND=Y
  1.  ;
  1. ASKDTX ; dates prompt exit point
  1.  Q
  1.  ;
  1. PAUSE    ; "Type <Enter> to continue" prompt
  1.  N DIR,DUOUT,DTOUT,DIRUT,X,Y
  1.  S DIR(0)="E" D ^DIR
  1.  I $D(DIRUT) S QUIT=1
  1.  W !
  1.  Q