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