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

IBOA31.m

Go to the documentation of this file. 
  1. IBOA31 ;ALB/AAS - PRINT ALL BILLS FOR A PATIENT ;04/18/90
  1.  ;;2.0;INTEGRATED BILLING;**95,199,433,451,669**;21-MAR-94;Build 20
  1.  ;;Per VHA Directive 2004-038, this routine should not be modified.
  1.  ;
  1.  ;MAP TO DGCRA31
  1. EN ;
  1.  ;***
  1.  ;I $D(XRT0) S:'$D(XRTN) XRTN="IBOA31" D T1^%ZOSV ;stop rt clock
  1.  ;S XRTL=$ZU(0),XRTN="IBOA31-1" D T0^%ZOSV ;start rt clock
  1.  N DPTNOFZY,IBFTP,IBTODAY,IBEXCEL,IBSTDT,IBENDDT,IBIVDT
  1.  ;
  1.  ;Initialize the today variable
  1.  D NOW^%DTC S IBTODAY=%\1
  1.  ;
  1.  S DPTNOFZY=1  ;Suppress PATIENT file fuzzy lookups
  1.  S DIC="^DPT(",DIC(0)="AEQMN" D ^DIC K DIC Q:Y<1  S DFN=+Y
  1.  S DIR(0)="Y",DIR("A")="Include Pharmacy Co-Pay charges on this report",DIR("B")="NO"
  1.  S DIR("?",1)="    Enter:  'Y'  -  To include Pharmacy Co-pay charges on this report"
  1.  S DIR("?",2)="            'N'  -  To exclude Pharmacy Co-pay charges on this report"
  1.  S DIR("?")="            '^'  -  To select a new patient"
  1.  D ^DIR K DIR G:$D(DIRUT) END S IBIBRX=Y
  1.  ;
  1.  ;Screen on Bill Type (1st party or 3rd Party)
  1.  K Y
  1.  S DIR(0)="S^F:FIRST PARTY;T:THIRD PARTY;B:BOTH",DIR("A")="(F)irst Party Bills,(T)hird Party Bills, or (B)oth on this report",DIR("B")="B"
  1.  S DIR("?",1)="    Enter:  'F'  -  To include only First Party Bills (Patient Copays) on this report"
  1.  S DIR("?",2)="            'T'  -  To include only Third Party Bills (Insurance Billing) on this report"
  1.  S DIR("?",3)="            'B'  -  To include Both First and Third Party Bills on this report"
  1.  S DIR("?")="            '^'  -  To select a new patient"
  1.  D ^DIR K DIR G:$D(DIRUT) END S IBFTP=Y
  1.  ;
  1.  ;from Date of service Prompt
  1.  K Y
  1.  S DIR(0)="DA^2900101::EX",DIR("A")="Enter Starting Date of Care: "
  1.  D ^DIR K DIR G:$D(DIRUT) END S IBSTDT=Y
  1.  ;
  1.  ;To date of service Prompt
  1.  K Y
  1.  S DIR(0)="DA^"_IBSTDT_":"_IBTODAY_":EX"
  1.  S DIR("A")="Enter Ending Date of Care: "
  1.  S DIR("B")=$$FMTE^XLFDT(IBTODAY)
  1.  D ^DIR K DIR G:$D(DIRUT) END S IBENDDT=Y
  1.  K Y
  1.  ;
  1.  ;Excel Prompt?
  1.  S IBEXCEL=$$GETEXCEL^IBUCMM I IBEXCEL=-1 G END
  1.  I IBEXCEL D PRTEXCEL^IBUCMM
  1.  ;
  1.  I 'IBEXCEL W !,"You will need a 132 column printer for this report."
  1.  S %ZIS="QM" D ^%ZIS G:POP ENQ
  1.  I $D(IO("Q")) K IO("Q") D  G ENQ
  1.  .S ZTDESC="IB - PRINT ALL BILLS FOR A PATIENT",ZTRTN="DQ^IBOA31",ZTSAVE("DFN")="",ZTSAVE("IB*")=""
  1.  .D ^%ZTLOAD K ZTSK D HOME^%ZIS
  1.  ;
  1.  ;***
  1.  ;I $D(XRT0) S:'$D(XRTN) XRTN="IBOA31" D T1^%ZOSV ;stop rt clock
  1. DQ ;
  1.  ;***
  1.  ;S XRTL=$ZU(0),XRTN="IBOA31-2" D T0^%ZOSV ;start rt clock
  1.  U IO S IBPAG=0 D NOW^%DTC S Y=% X ^DD("DD") S IBNOW=Y,$P(IBLINE,"-",IOM+1)=""
  1.  S IBQUIT=0,IBN=$$PT^IBEFUNC(DFN)
  1.  D:IBFTP'="F" UTIL^IBCA3
  1.  D:IBFTP'="T" UTIL^IBOA32
  1.  I '$D(^UTILITY($J)) W !,"No Bills On File for ",$P(IBN,"^"),"  SSN: ",$P(IBN,"^",2),"." G ENQ
  1.  D HDR1 S (IBDT,IBIFN)=""
  1.  ; - loop through all bills
  1.  F  S IBDT=$O(^UTILITY($J,IBDT)) Q:IBDT=""!(IBQUIT)  D
  1.  . ;IB*2.0*669 added start/end date filter. Also added EXCEL output option
  1.  . S IBIVDT=-1*IBDT
  1.  . I (IBIVDT>IBENDDT)!(IBIVDT<IBSTDT) Q      ;Convert Date to a positive date number
  1.  . F  S IBIFN=$O(^UTILITY($J,IBDT,IBIFN)) Q:IBIFN=""!(IBQUIT)  D
  1.  . . ;I IBEXCEL D XCELOPT Q  
  1.  . . D @($S($E(IBIFN,$L(IBIFN))="X":"^IBOA32",1:"ONE"))
  1.  D:'IBQUIT PAUSE
  1. ENQ W ! G END
  1.  ;
  1. ONE D GVAR^IBCBB
  1.  I 'IBEXCEL,($Y>(IOSL-5)) D HDR Q:IBQUIT
  1.  ; IB*2.0*451 - get 1st/3rd party payment EEOB indicator and add to bill when applicable
  1.  S IBIFN=+$O(^DGCR(399,"B",IBBNO,0)),IBPFLAG=$$EEOB(IBIFN)
  1.  I 'IBEXCEL D
  1.  . W !,$G(IBPFLAG)_IBBNO,?9,$$DAT1^IBOUTL($P(IBNDS,"^",12)),?19,$P($G(^DGCR(399.3,+IBAT,0)),"^")
  1.  . W ?38,$E($S(IBCL=1:"INPATIENT",IBCL=2:"HUMANIT. (INPT)",IBCL=3:"OUTPATIENT",IBCL=4:"HUMANIT. (OPT)",1:""),1,14),?55
  1.  . F I=$S(IBCL<3!('$O(^DGCR(399,IBIFN,"OP",0))):IBEVDT,1:$O(^DGCR(399,IBIFN,"OP",0))),IBFDT,IBTDT W $S(I]"":$$DAT1^IBOUTL(I)_"  ",1:"          ")
  1.  . S X=+$$TPR^PRCAFN(IBIFN) W $J($S(X<0:0,1:X),8,2)
  1.  . W ?95,$S(IBST=1:"ENTERED/NOT REV.",IBST=2:"REVIEWED",IBST=3:"AUTHORIZED",IBST=4:"PRINTED",IBST=7:"CANCELLED",1:"")
  1.  . W ?112,$P("NON-PAYMENT/ZERO^ADMIT - DISCHARGE^INTERIM - FIRST^INTERIM - CONTINUING^INTERIM - LAST^LATE CHARGE(S) ONLY^ADJUSTMENT OF PRIOR^REPLACEMENT OF PRIOR","^",(IBTF+1))
  1.  . ; - print remaining outpatient visit dates
  1.  . S IBOPD=$O(^DGCR(399,IBIFN,"OP",0)) Q:'IBOPD
  1.  . F  S IBOPD=$O(^DGCR(399,IBIFN,"OP",IBOPD)) Q:'IBOPD  D  Q:IBQUIT
  1.  . . D:($Y>(IOSL-5)) HDR Q:IBQUIT  W !?55,$$DAT1^IBOUTL(IBOPD)
  1.  I IBEXCEL D
  1.  . W !,$G(IBPFLAG)_IBBNO,U,$$DAT1^IBOUTL($P(IBNDS,"^",12)),U,$P($G(^DGCR(399.3,+IBAT,0)),"^")
  1.  . W U,$E($S(IBCL=1:"INPATIENT",IBCL=2:"HUMANIT. (INPT)",IBCL=3:"OUTPATIENT",IBCL=4:"HUMANIT. (OPT)",1:""),1,14),U
  1.  . F I=$S(IBCL<3!('$O(^DGCR(399,IBIFN,"OP",0))):IBEVDT,1:$O(^DGCR(399,IBIFN,"OP",0))),IBFDT,IBTDT W $S(I]"":$$DAT1^IBOUTL(I)_"^",1:"^")
  1.  . S X=+$$TPR^PRCAFN(IBIFN) W X
  1.  . W U,$S(IBST=1:"ENTERED/NOT REV.",IBST=2:"REVIEWED",IBST=3:"AUTHORIZED",IBST=4:"PRINTED",IBST=7:"CANCELLED",1:"")
  1.  . W U,$P("NON-PAYMENT/ZERO^ADMIT - DISCHARGE^INTERIM - FIRST^INTERIM - CONTINUING^INTERIM - LAST^LATE CHARGE(S) ONLY^ADJUSTMENT OF PRIOR^REPLACEMENT OF PRIOR","^",(IBTF+1))
  1.  . ; - print remaining outpatient visit dates
  1.  . S IBOPD=$O(^DGCR(399,IBIFN,"OP",0)) Q:'IBOPD
  1.  . F  S IBOPD=$O(^DGCR(399,IBIFN,"OP",IBOPD)) Q:'IBOPD  D  Q:IBQUIT
  1.  . . D:($Y>(IOSL-5)) HDR Q:IBQUIT
  1.  . . W !,$G(IBPFLAG)_IBBNO,U,$$DAT1^IBOUTL($P(IBNDS,"^",12)),U,$P($G(^DGCR(399.3,+IBAT,0)),"^")
  1.  . . W U,$E($S(IBCL=1:"INPATIENT",IBCL=2:"HUMANIT. (INPT)",IBCL=3:"OUTPATIENT",IBCL=4:"HUMANIT. (OPT)",1:""),1,14),U
  1.  . . W $$DAT1^IBOUTL(IBOPD)
  1.  Q
  1.  ;
  1.  ;IB*2.0*669 reformatted HDR and HDR1 to work with EXCEL
  1. HDR I $E(IOST,1,2)["C-" D PAUSE Q:IBQUIT
  1. HDR1 S IBPAG=IBPAG+1 W:$E(IOST,1,2)["C-"!(IBPAG>1) @IOF
  1.  ;Screen output
  1.  I 'IBEXCEL D  Q
  1.  . W "List of all Bills for ",$P(IBN,"^"),"  SSN: ",$P(IBN,"^",2),"  ",?(IOM-31),IBNOW,"  PAGE ",IBPAG
  1.  . W !,"BILL",?10,"DATE",?55,"DATE OF",?64,"STATEMENT  STATEMENT   AMOUNT"
  1.  . W !,"NO.      PRINTED   ACTION/RATE TYPE   CLASSIFICATION   CARE   "
  1.  . W $S(IBIBRX=1:"  FR/FL DT   TO/RL DT",1:"  FROM DATE  TO DATE")
  1.  . W "  COLLECTED  STATUS          TIMEFRAME OF BILL"
  1.  . W !,IBLINE
  1.  . W:IBIBRX !,?53,"'*' = outpt visit on same day as Rx fill date",!,IBLINE
  1.  ; Otherwise, Excel Output
  1.  W "List of all Bills for ",$P(IBN,"^"),"^SSN: ",$P(IBN,"^",2),U,IBNOW,U,"PAGE ",IBPAG
  1.  W !,"BILL NO.",U,"DATE PRINTED",U,"ACTION/RATE TYPE",U,"CLASSIFICATION",U,"DATE OF CARE"
  1.  W:'IBIBRX U,"STATEMENT FROM DATE",U,"STATEMENT TO DATE"
  1.  W:IBIBRX U,"STATEMENT FR/FL DT",U,"STATEMENT TO/RL DT"
  1.  W U,"AMOUNT COLLECTED",U,"STATUS",U,"TIMEFRAME OF BILL"
  1.  W:IBIBRX !,"'*' = outpt visit on same day as Rx fill date"
  1.  Q
  1.  ;
  1. PAUSE S IBX1="" R:$E(IOST,1,2)["C-" !!!,"Enter ""^"" to quit, or return to continue",IBX1:DTIME S IBQUIT=$S(IBX1["^":1,1:0) Q
  1.  ;
  1. END K ^UTILITY($J)
  1.  ;***
  1.  ;I $D(XRT0) S:'$D(XRTN) XRTN="IBOA31" D T1^%ZOSV ;stop rt clock
  1.  I $D(ZTQUEUED) S ZTREQ="@" Q
  1.  D END^IBCBB1
  1.  K IBIFN1,IBQUIT,IBX1,IBDT,IBCNT,IBN,DFN,IBIFN,IBLINE,IBNOW,IBPAG,IBOPD,IBIBRX,DIRUT,DUOUT,DTOUT,X,Y
  1.  K IBRDT,IBRF,IBRX,IBFTP,IBTODAY,IBEXCEL,IBSTDT,IBENDDT,IBIVDT
  1.  D ^%ZISC G EN
  1.  ;
  1. EEOB(IBIFN) ; --
  1.  ; IB*2.0*451 - find an EOB payment for bill
  1.  ; IBIFN is the IEN of the bill # in file #399 and must be valid
  1.  ; check the EOB type in file #361.1 and exclude MRA type (Medicare). Otherwise return
  1.  ; the EEOB indicator '%' if payment activity was found in file #361.1
  1.  N IBPFLAG,IBVAL,Z
  1.  I $G(IBIFN)=0 Q ""
  1.  I '$O(^IBM(361.1,"B",IBIFN,0)) Q ""  ; no entry here
  1.  I $P($G(^DGCR(399,IBIFN,0)),"^",13)=1 Q ""  ;avoid 'ENTERED/NOT REVIEWED' status
  1.  ; handle both single and multiple bill entries in file #361.1
  1.  S Z=0 F  S Z=$O(^IBM(361.1,"B",IBIFN,Z)) Q:'Z  D  Q:$G(IBPFLAG)="%"
  1.  . S IBVAL=$G(^IBM(361.1,Z,0))
  1.  . S IBPFLAG=$S($P(IBVAL,"^",4)=1:"",$P(IBVAL,"^",4)=0:"%",1:"")
  1.  Q IBPFLAG  ; EEOB indicator for either 1st or 3rd party payment on bill
  1.  ;
  1. XCELOPT ; Control routine to print the report in Excel Format
  1.  ;
  1.  D @($S($E(IBIFN,$L(IBIFN))="X":"XCELCPY",1:"XCELONE"))
  1.  Q
  1.  ;
  1. XCELONE ; print the Third Party Data in Excel Format
  1.  Q
  1.  ;
  1. XCELCPY ; print the First Party Data in Excel Format
  1.  Q
  1.  ;