| [613] | 1 | IBCEMU2 ;ALB/DSM - IB MRA Utility ;01-MAY-2003
|
|---|
| 2 | ;;2.0;INTEGRATED BILLING;**155,320,349**;21-MAR-94;Build 46
|
|---|
| 3 | ;;Per VHA Directive 2004-038, this routine should not be modified.
|
|---|
| 4 | ;
|
|---|
| 5 | Q
|
|---|
| 6 | ;
|
|---|
| 7 | QMRA ; This is a background procedure that is spun off of the IB BATCH
|
|---|
| 8 | ; Print option. This process scans a queue in ^XTMP("IBMRA"_#,$J) and checks
|
|---|
| 9 | ; each Bill to see if a printable MRA exist, if so, prints them. MRA's print
|
|---|
| 10 | ; on the device associated with the 'Bill Addendum' Form Type.
|
|---|
| 11 | ; This process doesn't interact with users.
|
|---|
| 12 | ;
|
|---|
| 13 | ; IB*2*320: MCS - Resubmit by Print produces a scratch global also
|
|---|
| 14 | ; ^XTMP("IBCFP6",$J,.... for MRA's to print here
|
|---|
| 15 | ;
|
|---|
| 16 | ; Input:
|
|---|
| 17 | ; IBJ = $J of starting job
|
|---|
| 18 | ; IBFTP = "IBMRA"_# (ien of form type) or "IBCFP6"
|
|---|
| 19 | ;
|
|---|
| 20 | N IBS1,IBS2,IBS3,IBIFN,IBQ,IBPGN
|
|---|
| 21 | S (IBS1,IBIFN,IBQ)=0
|
|---|
| 22 | F S IBS1=$O(^XTMP(IBFTP,IBJ,IBS1)) Q:IBS1="" D I IBQ Q
|
|---|
| 23 | . S IBS2=0 F S IBS2=$O(^XTMP(IBFTP,IBJ,IBS1,IBS2)) Q:IBS2="" D I IBQ Q
|
|---|
| 24 | . . S IBS3=0 F S IBS3=$O(^XTMP(IBFTP,IBJ,IBS1,IBS2,IBS3)) Q:IBS3="" D I IBQ Q
|
|---|
| 25 | . . . S IBIFN=0 F S IBIFN=$O(^XTMP(IBFTP,IBJ,IBS1,IBS2,IBS3,IBIFN)) Q:IBIFN="" D I $$STOP S IBQ=1 Q
|
|---|
| 26 | . . . . I $$MRAEXIST^IBCEMU1(IBIFN) D PROC^IBCEMRAA W @IOF ;must have IBIFN set
|
|---|
| 27 | K ^XTMP(IBFTP,IBJ) S ZTREQ="@"
|
|---|
| 28 | Q ;QMRA
|
|---|
| 29 | ;
|
|---|
| 30 | STOP() ;determine if user has requested the queued report to stop
|
|---|
| 31 | I $D(ZTQUEUED),$$S^%ZTLOAD S ZTSTOP=1 K ZTREQ I +$G(IBPGN) W !,"***TASK STOPPED BY USER***"
|
|---|
| 32 | Q +$G(ZTSTOP)
|
|---|
| 33 | ;
|
|---|
| 34 | ;
|
|---|
| 35 | STAT(IBIFN,STATUS,MRAONLY) ; Update the review status in the EOB file
|
|---|
| 36 | ; This procedure updates field .16 in file 361.1 for all EOB's for
|
|---|
| 37 | ; the given bill#
|
|---|
| 38 | ;
|
|---|
| 39 | ; IBIFN - Internal Bill# (required)
|
|---|
| 40 | ; STATUS - Internal Value of the Review Status field (required)
|
|---|
| 41 | ; MRAONLY - Optional Flag with a default of 0 if not passed in
|
|---|
| 42 | ; 1:only update MRA EOB's for this bill
|
|---|
| 43 | ; 0:update all EOB's for this bill
|
|---|
| 44 | ;
|
|---|
| 45 | NEW RESULT,IBEOB,IBM
|
|---|
| 46 | NEW DIE,DA,DR,D,D0,DI,DIC,DICR,DIG,DIH,DISYS,DIU,DIV,DIW,DQ,DIERR,X,Y
|
|---|
| 47 | S IBIFN=+$G(IBIFN),STATUS=$G(STATUS)
|
|---|
| 48 | S MRAONLY=$G(MRAONLY,0)
|
|---|
| 49 | ;
|
|---|
| 50 | I '$D(^IBM(361.1,"B",IBIFN)) G STATX ; no EOB's for this bill
|
|---|
| 51 | D CHK^DIE(361.1,.16,,STATUS,.RESULT)
|
|---|
| 52 | I RESULT="^" G STATX ; invalid status passed in
|
|---|
| 53 | ;
|
|---|
| 54 | S IBEOB=0 ; loop thru all EOB's for the bill
|
|---|
| 55 | F S IBEOB=$O(^IBM(361.1,"B",IBIFN,IBEOB)) Q:'IBEOB D
|
|---|
| 56 | . S IBM=$G(^IBM(361.1,IBEOB,0))
|
|---|
| 57 | . I $P(IBM,U,16)=STATUS Q ; no change
|
|---|
| 58 | . I MRAONLY,'$P(IBM,U,4) Q ; skip because of parameter
|
|---|
| 59 | . S DIE=361.1,DA=IBEOB,DR=".16////"_STATUS D ^DIE
|
|---|
| 60 | . Q
|
|---|
| 61 | ;
|
|---|
| 62 | STATX ;
|
|---|
| 63 | Q
|
|---|
| 64 | ;
|
|---|
| 65 | MRAWL(IBIFN) ; Do any MRA EOB's for this bill appear on the worklist?
|
|---|
| 66 | ;
|
|---|
| 67 | ; This function returns 1 if at least one MRA EOB for the given bill
|
|---|
| 68 | ; appears on the MRA management worklist. Otherwise, this function
|
|---|
| 69 | ; returns 0.
|
|---|
| 70 | ;
|
|---|
| 71 | NEW OK,IBEOB
|
|---|
| 72 | S OK=0,IBIFN=+$G(IBIFN)
|
|---|
| 73 | I '$D(^IBM(361.1,"B",IBIFN)) G MRAWLX ; no EOB's for this bill
|
|---|
| 74 | S IBEOB=0 ; loop thru all EOB's for the bill
|
|---|
| 75 | F S IBEOB=$O(^IBM(361.1,"B",IBIFN,IBEOB)) Q:'IBEOB D Q:OK
|
|---|
| 76 | . I $$ELIG^IBCECOB1(IBEOB) S OK=1
|
|---|
| 77 | . Q
|
|---|
| 78 | MRAWLX ;
|
|---|
| 79 | Q OK
|
|---|
| 80 | ;
|
|---|
| 81 | TXSTS(IBIFN,IB364,REJFLG,IBZ) ; Claim transmission status information
|
|---|
| 82 | ; Input IBIFN - required
|
|---|
| 83 | ; IB364 - optional (defaults to most recent transmission#)
|
|---|
| 84 | ; Output REJFLG (pass by reference) - 1/0 flag if any rejection status
|
|---|
| 85 | ; messages on file
|
|---|
| 86 | ; IBZ (pass by reference) - array of information
|
|---|
| 87 | ;
|
|---|
| 88 | NEW IEN,SMCNT,SEV,BCH,BCHD0,BCHD1
|
|---|
| 89 | S REJFLG=0 K IBZ
|
|---|
| 90 | S IBIFN=+$G(IBIFN) I 'IBIFN G TXSTSX
|
|---|
| 91 | S IB364=+$G(IB364)
|
|---|
| 92 | I 'IB364 S IB364=$$LAST364^IBCEF4(IBIFN) I 'IB364 G TXSTSX
|
|---|
| 93 | I $P($G(^IBA(364,IB364,0)),U,1)'=IBIFN G TXSTSX
|
|---|
| 94 | S IEN=0,SMCNT=0
|
|---|
| 95 | F S IEN=$O(^IBM(361,"AERR",IB364,IEN)) Q:'IEN D
|
|---|
| 96 | . S SMCNT=SMCNT+1
|
|---|
| 97 | . S SEV=$P($G(^IBM(361,IEN,0)),U,3) ; status message severity
|
|---|
| 98 | . I SEV="R" S REJFLG=1
|
|---|
| 99 | . Q
|
|---|
| 100 | S BCH=+$P($G(^IBA(364,IB364,0)),U,2) ; batch ien
|
|---|
| 101 | S BCHD0=$G(^IBA(364.1,BCH,0))
|
|---|
| 102 | S BCHD1=$G(^IBA(364.1,BCH,1))
|
|---|
| 103 | S IBZ("DATE LAST SENT")=$P(BCHD1,U,3)
|
|---|
| 104 | S IBZ("NUMBER OF STATUS MESSAGES")=SMCNT
|
|---|
| 105 | S IBZ("BATCH NUMBER")=$P(BCHD0,U,1)
|
|---|
| 106 | S IBZ("TRANSMISSION STATUS")=$P($G(^IBA(364,IB364,0)),U,3)
|
|---|
| 107 | TXSTSX ;
|
|---|
| 108 | Q
|
|---|
| 109 | ;
|
|---|
| 110 | MRACALC(IBEOB,IBIFN,AR,PRCASV) ; Calculates Two Amounts:
|
|---|
| 111 | ; Unreimbursable Medicare Expense and Medicare Contract Adjustment
|
|---|
| 112 | ; Amount for a given EOB.
|
|---|
| 113 | ;
|
|---|
| 114 | ; Input IBIFN= ien of Claim file 399 - Required
|
|---|
| 115 | ; IBEOB= ien of EOB file 361.1 - Required
|
|---|
| 116 | ; AR= Flag indicating this was called from AR function
|
|---|
| 117 | ; Input/Output PRCASV= array with the two calculated values
|
|---|
| 118 | ; PRCASV("MEDURE")=Unreimbursable Medicare Expense
|
|---|
| 119 | ; PRCASV("MEDCA")=Medicare Contract Adjustment Amount
|
|---|
| 120 | ;
|
|---|
| 121 | ; For multiple EOB's, add up the calculated values across EOB's
|
|---|
| 122 | ;
|
|---|
| 123 | N I,LNLVL,EOBADJ,IBCOBN,INPAT,FRMTYP
|
|---|
| 124 | ;
|
|---|
| 125 | S FRMTYP=$$FT^IBCEF(IBIFN) ;Form Type 2=1500; 3=UB
|
|---|
| 126 | S INPAT=$$INPAT^IBCEF(IBIFN) ;Inpat/Outpat Flag
|
|---|
| 127 | S AR=$G(AR,0) ;initialize AR flag
|
|---|
| 128 | F I=0,1,2 S IBEOB(I)=$G(^IBM(361.1,IBEOB,I))
|
|---|
| 129 | I $P(IBEOB(0),U,4)'=1 Q ;make sure it's an MRA
|
|---|
| 130 | S IBCOBN=$$COBN^IBCEF(IBIFN) ;get current bill sequence
|
|---|
| 131 | ; Make sure we're on the right insurance sequence when AR flag is on
|
|---|
| 132 | I AR I $P(IBEOB(0),U,15)'=(IBCOBN-1) Q
|
|---|
| 133 | ;
|
|---|
| 134 | ; Unreimburseable Medicare Expense (same calc regardless of form type)
|
|---|
| 135 | ; For multiple EOB's, add up the amounts across EOB's
|
|---|
| 136 | S PRCASV("MEDURE")=$G(PRCASV("MEDURE"))+IBEOB(1)
|
|---|
| 137 | ;
|
|---|
| 138 | ; Handle CMS-1500 Form Type Next:
|
|---|
| 139 | I FRMTYP=2 D MEDCARE(IBEOB,.PRCASV) Q
|
|---|
| 140 | ;
|
|---|
| 141 | ; Handle UB Form Type Next:
|
|---|
| 142 | ; If Inpatient Calculate from Claim level data
|
|---|
| 143 | I INPAT D Q ;
|
|---|
| 144 | . K EOBADJ M EOBADJ=^IBM(361.1,IBEOB,10)
|
|---|
| 145 | . S PRCASV("MEDCA")=$G(PRCASV("MEDCA"))+$$CALCMCA(.EOBADJ)
|
|---|
| 146 | ;
|
|---|
| 147 | ; If Outpatient Calculate from Service Line level data
|
|---|
| 148 | D MEDCARE(IBEOB,.PRCASV)
|
|---|
| 149 | Q ;MRACALC
|
|---|
| 150 | ;
|
|---|
| 151 | MEDCARE(IBEOB,PRCASV) ; If Outpatient Calculate from Service Line level data
|
|---|
| 152 | N LNLVL,EOBADJ
|
|---|
| 153 | S LNLVL=0
|
|---|
| 154 | F S LNLVL=$O(^IBM(361.1,IBEOB,15,LNLVL)) Q:'LNLVL D ;
|
|---|
| 155 | . K EOBADJ
|
|---|
| 156 | . M EOBADJ=^IBM(361.1,IBEOB,15,LNLVL,1)
|
|---|
| 157 | . ; Total up the Medicare Contract Adjustment across ALL Service Lines
|
|---|
| 158 | . S PRCASV("MEDCA")=$G(PRCASV("MEDCA"))+$$CALCMCA(.EOBADJ)
|
|---|
| 159 | Q ;MEDCARE
|
|---|
| 160 | ;
|
|---|
| 161 | CALCMCA(EOBADJ) ; FUNCTION - Calculate Medicare Contract Adjustment
|
|---|
| 162 | ; Sums up Amounts on ALL Reason Codes under ALL Group Codes = 'CO' and
|
|---|
| 163 | ; returns that value (which is Medicare Contract Adjustment).
|
|---|
| 164 | ;
|
|---|
| 165 | ; Input EOBADJ = Array of Group Codes & Reason Codes from either the Claim
|
|---|
| 166 | ; Level (10) or Service Line Level (15) of EOB file (#361.1)
|
|---|
| 167 | ; Output returns Medicare Contract Adjustment
|
|---|
| 168 | ;
|
|---|
| 169 | N GRPLVL,RSNLVL,RSNAMT,MCA
|
|---|
| 170 | S (GRPLVL,MCA)=0
|
|---|
| 171 | F S GRPLVL=$O(EOBADJ(GRPLVL)) Q:'GRPLVL D ;
|
|---|
| 172 | . I $P($G(EOBADJ(GRPLVL,0)),U)'="CO" Q
|
|---|
| 173 | . S RSNLVL=0
|
|---|
| 174 | . F S RSNLVL=$O(EOBADJ(GRPLVL,1,RSNLVL)) Q:'RSNLVL D ;
|
|---|
| 175 | . . S RSNAMT=$P($G(EOBADJ(GRPLVL,1,RSNLVL,0)),U,2)
|
|---|
| 176 | . . S MCA=MCA+RSNAMT
|
|---|
| 177 | Q MCA ;CALCMCA
|
|---|
| 178 | ;
|
|---|
| 179 | ALLOWED(IBEOB) ; Returns Total Allowed Amount by summing up all Allowed Amounts
|
|---|
| 180 | ; from Line Level Adjustment
|
|---|
| 181 | ; Input: IBEOB = ien of EOB file (361.1)
|
|---|
| 182 | ;
|
|---|
| 183 | N LNLVL,LNLVLD,ALWD,TOTALWD
|
|---|
| 184 | S (LNLVL,TOTALWD)=0
|
|---|
| 185 | F S LNLVL=$O(^IBM(361.1,IBEOB,15,LNLVL)) Q:'LNLVL S LNLVLD=^(LNLVL,0) D
|
|---|
| 186 | . S ALWD=$P(LNLVLD,U,13),TOTALWD=TOTALWD+ALWD ; Allowed Amount
|
|---|
| 187 | Q TOTALWD ;ALLOWED
|
|---|
| 188 | ;
|
|---|
| 189 | MRATYPE(BILL,ARDATE) ; Function - determines the MRA Receivable Type for a Third
|
|---|
| 190 | ; Party Receivable. This is accomplished by comparing DATE MRA FIRST ACTIVATED
|
|---|
| 191 | ; with AR Activation Date for the Bill.
|
|---|
| 192 | ;
|
|---|
| 193 | ; Input BILL= ien of a given Bill Number (Required)
|
|---|
| 194 | ; ARDATE= Date Account Receivable was Activated - date only (Required)
|
|---|
| 195 | ;
|
|---|
| 196 | ; Output - Possible Types:
|
|---|
| 197 | ; 1 = Pre-MRA implementation
|
|---|
| 198 | ; 2 = Post MRA Medicare Receivable
|
|---|
| 199 | ; 3 = Post MRA non-Medicare Receivable
|
|---|
| 200 | ;
|
|---|
| 201 | N MRADTACT,MRAMT
|
|---|
| 202 | I '$G(ARDATE)!'$G(BILL) Q 1
|
|---|
| 203 | ;
|
|---|
| 204 | ; get DATE MRA FIRST ACTIVATED at site
|
|---|
| 205 | S MRADTACT=$$MRADTACT()
|
|---|
| 206 | ;
|
|---|
| 207 | ; MRA not Activated at site
|
|---|
| 208 | I MRADTACT="" Q 1 ;MRATYPE
|
|---|
| 209 | ;
|
|---|
| 210 | ; Bill from pre-MRA implementation era
|
|---|
| 211 | I ARDATE<MRADTACT Q 1 ;MRATYPE
|
|---|
| 212 | ;
|
|---|
| 213 | ; Post-MRA Medicare bill; get Medicare amounts
|
|---|
| 214 | S MRAMT=$G(^PRCA(430,BILL,13))
|
|---|
| 215 | ; check Medicare Contractual Adjustment Amount
|
|---|
| 216 | I $P(MRAMT,U,1) Q 2 ;MRATYPE
|
|---|
| 217 | ; check Medicare Unreimburseable Amout
|
|---|
| 218 | I $P(MRAMT,U,2) Q 2 ;MRATYPE
|
|---|
| 219 | ; check if bill is a Medicare one
|
|---|
| 220 | I $$MRAEXIST^IBCEMU1(BILL) Q 2 ;MRATYPE
|
|---|
| 221 | ; check if bill is a Medicare Supplemental one
|
|---|
| 222 | I $P($$CRIT^IBRFN2(BILL),U)=2 Q 2 ;MRATYPE
|
|---|
| 223 | ;
|
|---|
| 224 | ; all others are Post-MRA non-Medicare bills
|
|---|
| 225 | Q 3 ;MRATYPE
|
|---|
| 226 | ;
|
|---|
| 227 | MRADTACT() ; Function - returns DATE MRA FIRST ACTIVATED at site
|
|---|
| 228 | Q $P($G(^IBE(350.9,1,8)),U,13)
|
|---|
| 229 | ;
|
|---|
