| [613] | 1 | IBCEMSR ;WOIFO/AAT - MRA STATISTICS REPORT ;09/03/04
|
|---|
| 2 | ;;2.0;INTEGRATED BILLING;**155,288,294,349**;21-MAR-94;Build 46
|
|---|
| 3 | ;;Per VHA Directive 2004-038, this routine should not be modified.
|
|---|
| 4 | ;
|
|---|
| 5 | EN ;
|
|---|
| 6 | N IBQ,IBDIV,IBBDT,IBEDT,IBSUM,IBSCR
|
|---|
| 7 | W !!,"Report requires 132 Columns"
|
|---|
| 8 | S IBQ=0 ; quit flag
|
|---|
| 9 | ; Prompts to the user:
|
|---|
| 10 | D DIV Q:IBQ ; Division(s)
|
|---|
| 11 | D SUM Q:IBQ ; Summary only?
|
|---|
| 12 | W !!,"Normal processing time for a MRA is 10-12 days. If you select a date range of"
|
|---|
| 13 | W !,"less than 2 weeks, do not expect to have received many MRAs."
|
|---|
| 14 | D DTR Q:IBQ ; From-To date range
|
|---|
| 15 | D DEVICE Q:IBQ
|
|---|
| 16 | D RUN
|
|---|
| 17 | Q
|
|---|
| 18 | ;
|
|---|
| 19 | DIV N DIC,DIR,DIRUT,Y
|
|---|
| 20 | W ! S DIR("B")="ALL",DIR("A")="Run this report for All divisions or Selected Divisions: "
|
|---|
| 21 | S DIR(0)="SA^ALL:All divisions;S:Selected divisions" D ^DIR
|
|---|
| 22 | I $D(DIRUT) S IBQ=1 Q
|
|---|
| 23 | S IBDIV=Y Q:Y="ALL"
|
|---|
| 24 | ; Collect divisions
|
|---|
| 25 | F D Q:Y'>0
|
|---|
| 26 | . W ! S DIC("A")="Division: ",DIC=40.8,DIC(0)="AEQM" D ^DIC
|
|---|
| 27 | . I $D(DIRUT) S IBQ=1 Q
|
|---|
| 28 | . I Y'>0 Q
|
|---|
| 29 | . S IBDIV(+Y)=""
|
|---|
| 30 | I $O(IBDIV(""))="" S IBQ=1 Q ; None selected
|
|---|
| 31 | Q
|
|---|
| 32 | ;
|
|---|
| 33 | DTR ;date range
|
|---|
| 34 | N %DT,Y
|
|---|
| 35 | S (IBBDT,IBEDT)=DT
|
|---|
| 36 | S %DT="AEX"
|
|---|
| 37 | S %DT("A")="Start with MRA Request Transmission Date: " ; No default,%DT("B")="TODAY"
|
|---|
| 38 | W ! D ^%DT K %DT
|
|---|
| 39 | I Y<0 S IBQ=1 Q
|
|---|
| 40 | S IBBDT=+Y
|
|---|
| 41 | S %DT="AEX"
|
|---|
| 42 | S %DT("A")="Go to MRA Request Transmission Date: ",%DT("B")="TODAY"
|
|---|
| 43 | D ^%DT K %DT
|
|---|
| 44 | I Y<0 S IBQ=1 Q
|
|---|
| 45 | S IBEDT=+Y
|
|---|
| 46 | Q
|
|---|
| 47 | ;
|
|---|
| 48 | SUM N DIR,DIRUT,Y
|
|---|
| 49 | W ! S DIR("B")="YES",DIR("A")="Do you want to print a summary only? "
|
|---|
| 50 | S DIR(0)="YA" D ^DIR
|
|---|
| 51 | I $D(DIRUT) S IBQ=1 Q
|
|---|
| 52 | S IBSUM=+Y
|
|---|
| 53 | Q
|
|---|
| 54 | ;
|
|---|
| 55 | DEVICE N %ZIS,IOP,ZTSK,ZTRTN,ZTIO,ZTDESC,ZTSAVE,POP
|
|---|
| 56 | K IO("Q")
|
|---|
| 57 | S %ZIS="QM"
|
|---|
| 58 | W ! D ^%ZIS
|
|---|
| 59 | I POP S IBQ=1 Q
|
|---|
| 60 | S IBSCR=$S($E($G(IOST),1,2)="C-":1,1:0)
|
|---|
| 61 | ;
|
|---|
| 62 | I $D(IO("Q")) D S IBQ=1
|
|---|
| 63 | . S ZTRTN="RUN^IBCEMSR"
|
|---|
| 64 | . S ZTIO=ION
|
|---|
| 65 | . S ZTSAVE("IB*")=""
|
|---|
| 66 | . S ZTDESC="IB MRA STATISTICS REPORT"
|
|---|
| 67 | . D ^%ZTLOAD
|
|---|
| 68 | . W !,$S($D(ZTSK):"REQUEST QUEUED TASK="_ZTSK,1:"REQUEST CANCELLED")
|
|---|
| 69 | . D HOME^%ZIS
|
|---|
| 70 | U IO
|
|---|
| 71 | Q
|
|---|
| 72 | ;
|
|---|
| 73 | ;
|
|---|
| 74 | RUN N REF
|
|---|
| 75 | S REF=$NA(^TMP($J,"IBCEMSR"))
|
|---|
| 76 | K @REF
|
|---|
| 77 | D COLLECT ; Collect the data in ^TMP
|
|---|
| 78 | U IO
|
|---|
| 79 | D REPORT^IBCEMSR1
|
|---|
| 80 | I 'IBSCR W !,@IOF
|
|---|
| 81 | D ^%ZISC
|
|---|
| 82 | K @REF
|
|---|
| 83 | Q
|
|---|
| 84 | ;
|
|---|
| 85 | COLLECT ; Collect Information
|
|---|
| 86 | ; Input: IBDIV, IBBDT,IBEDT
|
|---|
| 87 | N IBDT,IBBAT,IBTRAN,IBZ,MRAUSR,NUMDIV,IBDV,ALLDIV
|
|---|
| 88 | S IBDV=0 F NUMDIV=0:1 S IBDV=$O(IBDIV(IBDV)) Q:'IBDV
|
|---|
| 89 | S ALLDIV=" "
|
|---|
| 90 | I IBDIV="ALL" S ALLDIV=" *** ALL DIVISIONS ***"
|
|---|
| 91 | I NUMDIV>1 S ALLDIV=" *** ALL SELECTED DIVISIONS ***"
|
|---|
| 92 | ;
|
|---|
| 93 | S MRAUSR=$$MRAUSR^IBCEMU1() ;Auto-authorizer
|
|---|
| 94 | S IBDT=IBBDT-.000001
|
|---|
| 95 | F S IBDT=$O(^IBA(364.1,"ALT",IBDT)) Q:'IBDT Q:IBDT\1>IBEDT D
|
|---|
| 96 | . S IBBAT=0 F S IBBAT=$O(^IBA(364.1,"ALT",IBDT,IBBAT)) Q:'IBBAT D
|
|---|
| 97 | .. S IBTRAN=0 F S IBTRAN=$O(^IBA(364,"C",IBBAT,IBTRAN)) Q:'IBTRAN D
|
|---|
| 98 | ... S IBZ=$G(^IBA(364,IBTRAN,0)) Q:IBZ=""
|
|---|
| 99 | ... N IBIFN,IBSTAT,IBSEQ,IBBILZ,IBBILST,IBFORM,IBCLERK,IBDV,IBDVN,REFX,REFS,REFT,REFTX,MRACNT,IBREJECT
|
|---|
| 100 | ... S IBIFN=+IBZ
|
|---|
| 101 | ... I '$P($G(^DGCR(399,IBIFN,"S")),U,7) Q ; no MRA request
|
|---|
| 102 | ... S IBSTAT=$P(IBZ,U,3)
|
|---|
| 103 | ... S IBSEQ=$P(IBZ,U,8) Q:"T"[IBSEQ
|
|---|
| 104 | ... I '$$WNRBILL^IBEFUNC(IBIFN,IBSEQ) Q ; payer sequence must be Medicare for this transmission
|
|---|
| 105 | ... S IBBILZ=$G(^DGCR(399,IBIFN,0))
|
|---|
| 106 | ... S IBBILST=$P(IBBILZ,U,13)
|
|---|
| 107 | ... S IBFORM=+$P(IBBILZ,U,19)
|
|---|
| 108 | ... I IBFORM'=2,IBFORM'=3 Q ; not 1500 or UB
|
|---|
| 109 | ... S IBCLERK=+$P($G(^DGCR(399,IBIFN,"S")),U,8) ; Who requested MRA?
|
|---|
| 110 | ... S IBCLERK=$P($G(^VA(200,IBCLERK,0)),U)
|
|---|
| 111 | ... S:IBCLERK="" IBCLERK="UNKNOWN"
|
|---|
| 112 | ... S IBDV=+$P(IBBILZ,U,22) ; Default division
|
|---|
| 113 | ... S IBDVN=$P($G(^DG(40.8,IBDV,0)),U) ; Div name
|
|---|
| 114 | ... S:IBDVN="" IBDVN="UNKNOWN"
|
|---|
| 115 | ... I IBDIV'="ALL",'$D(IBDIV(IBDV)) Q ;Division filter
|
|---|
| 116 | ... I 'IBSUM S REFX=$NA(@REF@(IBDVN,IBCLERK,IBFORM)) I NUMDIV'=1 S REFTX=$NA(@REF@(ALLDIV,IBCLERK,IBFORM)) ; all divisions detail
|
|---|
| 117 | ... S REFS=$NA(@REF@(IBDVN,0,IBFORM)) ; Summary by division
|
|---|
| 118 | ... I NUMDIV'=1 S REFT=$NA(@REF@(ALLDIV,0,IBFORM)) ; all divisions
|
|---|
| 119 | ... D TXSTS^IBCEMU2(IBIFN,IBTRAN,.IBREJECT) ; rejected?
|
|---|
| 120 | ... S MRACNT=$$MRACNT^IBCEMU1(IBIFN) ; how many MRAs?
|
|---|
| 121 | ... D INC("ALL") ; total no of requests
|
|---|
| 122 | ... I IBSTAT="C" D INC("ALLC") ;cancelled
|
|---|
| 123 | ... I IBSTAT="R" D INC("ALLR") ;resubmitted
|
|---|
| 124 | ... I '$D(@REFS@("TOT",IBIFN)) S ^(IBIFN)="" D INC("TOT") ;unique requests
|
|---|
| 125 | ... ;no response?
|
|---|
| 126 | ... I 'IBREJECT,'MRACNT,'$D(@REFS@("NON",IBIFN)) S ^(IBIFN)="" D INC("NON")
|
|---|
| 127 | ... ;final reject?
|
|---|
| 128 | ... I 'MRACNT,IBREJECT,'$D(@REFS@("REJF",IBIFN)),IBTRAN=$$LAST364^IBCEF4(IBIFN) D
|
|---|
| 129 | .... S @REFS@("REJF",IBIFN)="" D INC("REJF")
|
|---|
| 130 | .... ; MRA?
|
|---|
| 131 | ... I MRACNT,'$D(@REFS@("MRA",IBIFN)) S ^(IBIFN)="" D
|
|---|
| 132 | .... D INC("MRA")
|
|---|
| 133 | .... I $$DENIED(IBIFN) D INC("MRAD")
|
|---|
| 134 | ... ;any secondary claims?
|
|---|
| 135 | ... D SECOND
|
|---|
| 136 | Q
|
|---|
| 137 | ;
|
|---|
| 138 | INC(NODE,VALUE) ;Increase the respective value in ^TMP
|
|---|
| 139 | I 'IBSUM D
|
|---|
| 140 | . S @REFX@(NODE)=$G(@REFX@(NODE))+$G(VALUE,1)
|
|---|
| 141 | . I $D(REFTX) S @REFTX@(NODE)=$G(@REFTX@(NODE))+$G(VALUE,1)
|
|---|
| 142 | . Q
|
|---|
| 143 | S @REFS@(NODE)=$G(@REFS@(NODE))+$G(VALUE,1)
|
|---|
| 144 | I $D(REFT) S @REFT@(NODE)=$G(@REFT@(NODE))+$G(VALUE,1)
|
|---|
| 145 | Q
|
|---|
| 146 | ;
|
|---|
| 147 | DENIED(IBIFN) ;MRA requests denied?
|
|---|
| 148 | ; 361.1 for this bill#
|
|---|
| 149 | ; if at least one request is 'processed' - MRA is NOT DENIED
|
|---|
| 150 | N IBDEN,IEN,IBZ
|
|---|
| 151 | S IBDEN=1
|
|---|
| 152 | S IEN=0 F S IEN=$O(^IBM(361.1,"B",+$G(IBIFN),IEN)) Q:'IEN D Q:'IBDEN
|
|---|
| 153 | . S IBZ=$G(^IBM(361.1,IEN,0))
|
|---|
| 154 | . I $P(IBZ,U,4)'=1 Q ; only MEDICARE
|
|---|
| 155 | . I $P(IBZ,U,13)=1 S IBDEN=0
|
|---|
| 156 | Q IBDEN
|
|---|
| 157 | ;
|
|---|
| 158 | SECOND ;Secondary claims
|
|---|
| 159 | N IBAUT,IBTX,IBCBPS,IBNEXT,IBBILS,IBTOT,IBUNR,IB2ND,IBNODE
|
|---|
| 160 | I $D(@REFS@("SEC",IBIFN)) Q ; Already included
|
|---|
| 161 | S IBCBPS=$P(IBBILZ,U,21) ; current bill sequence
|
|---|
| 162 | S IBNEXT=$S(IBSEQ="S":"T",1:"S") ;Next (after MRA) sequence
|
|---|
| 163 | I IBCBPS'=IBNEXT Q
|
|---|
| 164 | ; Number of unique sec claims
|
|---|
| 165 | S @REFS@("SEC",IBIFN)=""
|
|---|
| 166 | D INC("SEC")
|
|---|
| 167 | S IBBILS=$G(^DGCR(399,IBIFN,"S")) Q:'$P(IBBILS,U,10) ; Not even authorized
|
|---|
| 168 | ; Authorized but not yet printed?
|
|---|
| 169 | I $P(IBBILS,U,10),'$P(IBBILS,U,13) D Q
|
|---|
| 170 | . I +$$TXMT^IBCEF4(IBIFN)'=1 D INC("AUT") ; Exclude transmittable
|
|---|
| 171 | ; Check the field 'AUTHORIZER'
|
|---|
| 172 | S IBAUT=($P(IBBILS,U,11)=MRAUSR) ; Auto-authorized?
|
|---|
| 173 | S IBTX=$$TRANSM(IBIFN,IBNEXT) ; Transmitted? (present in 364?)
|
|---|
| 174 | I IBAUT,IBTX S IBNODE="AT" ; Auto-gen Tx
|
|---|
| 175 | I 'IBAUT,IBTX S IBNODE="MT" ; Manually Tx
|
|---|
| 176 | I IBAUT,'IBTX S IBNODE="AP" ; Auto-gen Prn
|
|---|
| 177 | I 'IBAUT,'IBTX S IBNODE="MP" ; Manually Prn
|
|---|
| 178 | ;
|
|---|
| 179 | ;Calculate amounts
|
|---|
| 180 | S IBTOT=+$G(^DGCR(399,IBIFN,"U1"))
|
|---|
| 181 | S IBUNR=$P($G(^PRCA(430,IBIFN,13)),U,2) ; Medicare Unreimbursable
|
|---|
| 182 | S IB2ND=$$PREOBTOT^IBCEU0(IBIFN)
|
|---|
| 183 | D INC(IBNODE)
|
|---|
| 184 | D INC(IBNODE_"1",IBTOT)
|
|---|
| 185 | D INC(IBNODE_"2",IBUNR)
|
|---|
| 186 | D INC(IBNODE_"3",IB2ND)
|
|---|
| 187 | Q
|
|---|
| 188 | ;
|
|---|
| 189 | TRANSM(IBIFN,IBSEQ) ;was the claim ever transmitted?
|
|---|
| 190 | ; Does the claim present in 364?
|
|---|
| 191 | N RES,IBI
|
|---|
| 192 | S RES=0
|
|---|
| 193 | S IBI="" F S IBI=$O(^IBA(364,"B",IBIFN,IBI),-1) Q:IBI="" D Q:RES
|
|---|
| 194 | . I $P($G(^IBA(364,IBI,0)),U,8)=IBSEQ S RES=1
|
|---|
| 195 | Q RES
|
|---|
| 196 | ;
|
|---|
