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

IBCEMU1.m

Go to the documentation of this file.
  1. IBCEMU1 ;ALB/DSM - IB MRA Utility ;26-MAR-2003
  1. ;;2.0;INTEGRATED BILLING;**135,155,432,718,727,743**;21-MAR-94;Build 18
  1. ;;Per VA Directive 6402, this routine should not be modified.
  1. ;
  1. MRAUSR() ;; Function
  1. ; Returns IEN (Internal Entry Number) from file #200 for
  1. ; the Bill Authorizer of acceptable MRA secondary claims,
  1. ; namely, AUTHORIZER,IB MRA
  1. ;
  1. ; Output: -1 if record not on file
  1. ; IEN if record is on file
  1. ;
  1. N DIC,X,Y
  1. S DIC(0)="MO",DIC="^VA(200,",X="AUTHORIZER,IB MRA"
  1. ; call FM lookup utility
  1. D ^DIC
  1. ; if record is already on file, return IEN
  1. ; else return -1
  1. Q +Y
  1. ;
  1. ;
  1. MRA(IBIFN) ; Utility driver procedure - this is what gets called
  1. I $$MRAEXIST(IBIFN) D PRINTMRA(IBIFN)
  1. MRAX ;
  1. Q
  1. ;
  1. ;
  1. MRAEXIST(IBIFN) ; This function determines if any MRA exists for the
  1. ; passed bill (IBIFN).
  1. ;
  1. ; This function is called from the IB package as well as the AR package.
  1. ;
  1. ; This function returns a true value (1) under the following
  1. ; conditions:
  1. ;
  1. ; - The current payer sequence is secondary or tertiary for the bill
  1. ; - Medicare WNR is a payer on the bill
  1. ; - At least one MRA EOB is on file for the bill
  1. ; - Medicare is primary, bill is 2nd/3rd
  1. ; - or, Medicare is secondary, bill is 3rd
  1. ;
  1. NEW OK,IBCOB,PRIMBILL
  1. S IBIFN=+$G(IBIFN)
  1. S OK=0
  1. I '$D(^DGCR(399,IBIFN,0)) G MRAEX ; Check for valid bill
  1. S IBCOB=$$COBN^IBCEF(IBIFN) ; Current payer sequence
  1. I IBCOB=1 G MRAEX ; Must be secondary or tert
  1. I '$$MCRONBIL^IBEFUNC(IBIFN) G MRAEX ; Medicare not on bill
  1. ;
  1. ; If bill is secondary and Medicare is primary, then we know the bill#
  1. I IBCOB=2,$$WNRBILL^IBEFUNC(IBIFN,1) S OK=$$CHK(IBIFN) G MRAEX
  1. ;
  1. ; Similarly if bill is tert and Medicare is 2nd, then we know the bill#
  1. I IBCOB=3,$$WNRBILL^IBEFUNC(IBIFN,2) S OK=$$CHK(IBIFN) G MRAEX
  1. ;
  1. ; If bill is tert and Medicare is first, then we have to get the bill#
  1. I IBCOB=3,$$WNRBILL^IBEFUNC(IBIFN,1) D G MRAEX
  1. . S PRIMBILL=+$P($G(^DGCR(399,IBIFN,"M1")),U,5)
  1. . I PRIMBILL S OK=$$CHK(PRIMBILL)
  1. . Q
  1. ;
  1. MRAEX ;
  1. Q OK
  1. ;
  1. CHK(IBIFN) ; This function returns 1 if there is at least 1 MRA EOB for
  1. ; this bill# in file 361.1.
  1. NEW OK,IEN
  1. S (OK,IEN)=0
  1. F S IEN=$O(^IBM(361.1,"B",+$G(IBIFN),IEN)) Q:'IEN D Q:OK
  1. . I $P($G(^IBM(361.1,IEN,0)),U,4)=1 S OK=1 Q
  1. . Q
  1. CHKX ;
  1. Q OK
  1. ;
  1. ;
  1. PRINTMRA(IBIFN) ; This procedure is called when the user is printing bills
  1. ; and we know that one or more MRA's exist for this bill. We ask the
  1. ; user if the MRA(s) should be printed at this time too.
  1. ;
  1. NEW CNT,DIR,X,Y,DTOUT,DUOUT,DIRUT,DIROUT
  1. S IBIFN=+$G(IBIFN) I 'IBIFN G PRMRAX
  1. S CNT=$$MRACNT(IBIFN) I 'CNT G PRMRAX
  1. ;
  1. S DIR(0)="YO",DIR("B")="YES"
  1. S DIR("A",1)="There is an MRA associated with this bill."
  1. S DIR("A")="Do you want to print this MRA now"
  1. I CNT>1 D
  1. . S DIR("A",1)="There are "_CNT_" MRA's associated with this bill."
  1. . S DIR("A")="Do you want to print these MRA's now"
  1. . Q
  1. S DIR("?")="Please answer Yes or No. If you answer Yes, then you will be asked to supply the output device and all MRA's associated with this bill will then be printed."
  1. W !!
  1. D ^DIR K DIR
  1. I 'Y G PRMRAX
  1. ;
  1. ; At this point, the user wants to print the MRA's
  1. D MRA^IBCEMRAA(IBIFN)
  1. ;
  1. PRMRAX ;
  1. Q
  1. ;
  1. ;
  1. MRACNT(IBIFN,IBMRANOT) ; This function counts up the number of MRA EOB's in file ;WCJ IB*2.0*432
  1. ; 361.1 for this bill#
  1. NEW CNT,IEN
  1. S (CNT,IEN)=0
  1. F S IEN=$O(^IBM(361.1,"B",+$G(IBIFN),IEN)) Q:'IEN D
  1. . I $P($G(^IBM(361.1,IEN,0)),U,4)'=$S($G(IBMRANOT):0,1:1) Q ;WCJ IB*2.0*432
  1. . S CNT=CNT+1
  1. . Q
  1. MRACNTX ;
  1. Q CNT
  1. ;
  1. ;WCJ;IB727;adding a parameter to return IB361.1 IENs of these split MRA's
  1. ;SPLTMRA(IBIFN) ; This function returns the number of Split MRA's for a
  1. SPLTMRA(IBIFN,IBMRARET) ; This function returns the number of Split MRA's for a
  1. ; given bill#.
  1. ; IBIFN = claim number
  1. ; IBMRARET = if passed in, return the 361.1 IENs
  1. ;
  1. NEW NUM,IEN
  1. S (NUM,IEN)=0
  1. ; S IEN=$O(^IBM(361.1,"B",+$G(IBIFN),IEN)) Q:'IEN I $$SPLIT(IEN) S NUM=NUM+1 ;WCJ;IB727;
  1. F S IEN=$O(^IBM(361.1,"B",+$G(IBIFN),IEN)) Q:'IEN I $$SPLIT(IEN) S NUM=NUM+1 S IBMRARET(IEN)="" ;WCJ;IB727;
  1. SPLTX ;
  1. Q NUM
  1. ;
  1. SPLIT(IBEOB) ; This function returns whether or not the given EOB is a
  1. ; split EOB as indicated in the claim level remark code.
  1. ; Check the remittance advice remark codes looking for code MA15. This
  1. ; code indicates that the claim has been separated to expedite
  1. ; handling. This means that this is an incomplete EOB.
  1. ;
  1. NEW SPLIT,IBM3,IBM5,PCE,REMC
  1. S SPLIT=0,IBEOB=+$G(IBEOB)
  1. S IBM3=$G(^IBM(361.1,IBEOB,3))
  1. S IBM5=$G(^IBM(361.1,IBEOB,5))
  1. F PCE=3:1:7 S REMC=$P(IBM3,U,PCE) I REMC="MA15" S SPLIT=1 Q
  1. I SPLIT G SPLITX
  1. F PCE=1:1:5 S REMC=$P(IBM5,U,PCE) I REMC="MA15" S SPLIT=1 Q
  1. ;WCJ;IB*2.0*718;check new field for potential split
  1. I 'SPLIT,$$GET1^DIQ(361.1,IBEOB_",",.22,"I") S SPLIT=1
  1. ;
  1. SPLITX ;
  1. Q SPLIT
  1. ;
  1. SPLIT2(IBEOB,IBALLORONE) ; All lines Covered? aka SPLIT2
  1. ;
  1. ; This was written because a medicare claims processor couldn't follow simple agreed upon instructions.
  1. ; They were supposed to send an MA15 whenever an MRA was split, but they didn't.
  1. ; Consequently, VistA was sending out secondary claims with MRAs that only covered part of the original claim - an X12 violation
  1. ;
  1. ; This function is passed an MRA.
  1. ; depending on the second parameter
  1. ; It either
  1. ; a) gets all the MRAs like it (same claim/payer #) and compares the lines on the claim to the lines in the MRAs
  1. ; to make sure every line is accounted for.
  1. ; or
  1. ; b) checks only the one passed into see if it covers all
  1. ;
  1. ; Passed in:
  1. ; IBEOB = the ien of the EOB entry in file 361.1
  1. ; also passed IBALLORONE - 1 checks just the IBEOB passed in
  1. ; anything else (or nothing) checks all the EOBS for the same claim number and payer sequence
  1. ;
  1. ; Returns -1 Couldn't tell (bad data?)
  1. ; 0 All lines not covered
  1. ; 1 All lines covered
  1. ;
  1. N IBIFN,IBFT,IBZDATA,IBLOOP,RESULT
  1. N IBLOOPEOB,IBLINE,IBFT,IBZDATA,IBLINE,IBPAYSEQ
  1. N IBXSAVE,IBXARRAY,IBXARRY,IBXERR,IBRC,IBMRAF ; output formatter set these. want this to be self-cleaning so added here.
  1. ;
  1. S RESULT=-1
  1. I '+$G(IBEOB) Q RESULT ; no EOB sent in - off to a bad start
  1. ;
  1. ; gotta be an MRA cause that's all we allow to be split so far
  1. Q:$$GET1^DIQ(361.1,IBEOB_",",.04,"I")'=1 RESULT
  1. ;
  1. ; must be PROCESSED or DENIED
  1. Q:".1.2."'[("."_$$GET1^DIQ(361.1,IBEOB_",",.13,"I")_".") RESULT
  1. ;
  1. ; filing errors - can't check ;WCJ;IB718;v21}
  1. I $D(^IBM(361.1,IBEOB,"ERR")) Q RESULT
  1. ;
  1. ; no lines returned so nothing to check if it's partial
  1. I '$D(^IBM(361.1,IBEOB,15)) Q RESULT ;WCJ;IB718;v21}
  1. ;
  1. ; get File 399 CLAIM #
  1. S IBIFN=$$GET1^DIQ(361.1,IBEOB_",",.01,"I")
  1. I '+IBIFN Q RESULT
  1. I $$INPAT^IBCEF(IBIFN,1),$$INSPRF^IBCEF(IBIFN) Q RESULT ;logic does not work for inpatient institutional as they return at the claim level ;WCJ;IB718;v21
  1. ;
  1. ; call the appropriate OUTPUT FORMATTER FUNCTION to determine how many lines went out
  1. ; first get the form type
  1. S IBFT=$$GET1^DIQ(399,IBIFN_",",.19,"I")
  1. I 'IBFT Q RESULT
  1. ;
  1. ; only 3 valid form types but you already know that
  1. I ".2.3.7."'[("."_IBFT_".") Q RESULT
  1. ;
  1. I IBFT=3 D F^IBCEF("N-UB-04 SERVICE LINE (EDI)","IBZDATA",,IBIFN)
  1. I IBFT=2 D F^IBCEF("N-HCFA 1500 SERVICE LINE (EDI)","IBZDATA",,IBIFN)
  1. I IBFT=7 D F^IBCEF("N-HCFA SERVICE LINE CALLABLE","IBZDATA",,IBIFN)
  1. ;
  1. ; get payer sequence from the EOB
  1. S IBPAYSEQ=$$GET1^DIQ(361.1,IBEOB_",",.15,"I")
  1. I '+IBPAYSEQ Q RESULT
  1. ;
  1. S RESULT=1
  1. I '+$O(IBZDATA(0)) Q RESULT ; no lines on the claim so technically they are all covered
  1. ;
  1. ; gets all the EOBs for that bill number
  1. S IBLOOPEOB=0
  1. F S IBLOOPEOB=$O(^IBM(361.1,"B",IBIFN,IBLOOPEOB)) Q:'IBLOOPEOB D Q:RESULT=-1
  1. . I $G(IBALLORONE)=1,IBLOOPEOB'=IBEOB Q ; only want to see if this one EOB fully covers claim
  1. . Q:$$GET1^DIQ(361.1,IBLOOPEOB_",",.04,"I")'=1 ; remember, only MRAs
  1. . Q:".1.2."'[("."_$$GET1^DIQ(361.1,IBLOOPEOB_",",.13,"I")_".") ; must be PROCESSED or DENIED
  1. . Q:$$GET1^DIQ(361.1,IBLOOPEOB_",",.15,"I")'=IBPAYSEQ ; must be for same payer seq as EOB passed in
  1. . ;WCJ;IB743;wrong variable as it kept checking the same EOB for filing errors
  1. .; I $D(^IBM(361.1,IBEOB,"ERR")) S RESULT=-1 Q ; filing errors, can't tell
  1. . I $D(^IBM(361.1,IBLOOPEOB,"ERR")) S RESULT=-1 Q ; filing errors, can't tell
  1. . S IBLINE=0
  1. . F S IBLINE=$O(IBZDATA(IBLINE)) Q:'IBLINE D
  1. .. I $D(^IBM(361.1,IBLOOPEOB,15,"AC",IBLINE)) K IBZDATA(IBLINE) ; remove the lines local array that are in an acceptable MRA
  1. ;
  1. ; This will be set if there were filing errors in any of the MRAs since you can't tell what processed
  1. I RESULT=-1 Q RESULT
  1. ;
  1. ; and voila
  1. ; if all lines are covered then there shouldn't be any left in the array
  1. ;
  1. Q:'$O(IBZDATA(0)) RESULT
  1. ;
  1. Q 0 ; no dice, we have lines left
  1. ;
  1. ;
  1. EOBLST(IBEOB) ; Standard FileMan lister code for entries in the EOB file
  1. ; Input parameter IBEOB is the IEN into file 361.1
  1. ; This can be used by setting DIC("W")="D EOBLST^IBCEMU1(Y)" prior
  1. ; to FileMan lister calls.
  1. ;
  1. NEW IBM,IBIFN,IB,PATNAME,INSCO,SEQ
  1. NEW EOBDT,EOBTYP,CLMSTAT
  1. S IBM=$G(^IBM(361.1,IBEOB,0))
  1. S IBIFN=+IBM
  1. S IB=$G(^DGCR(399,IBIFN,0))
  1. S PATNAME=$P($G(^DPT(+$P(IB,U,2),0)),U,1)
  1. S INSCO=" "_$$EXTERNAL^DILFD(361.1,.02,,$P(IBM,U,2))
  1. S SEQ=$E($$EXTERNAL^DILFD(361.1,.15,,$P(IBM,U,15)),1,3)
  1. S EOBDT=" "_$$FMTE^XLFDT($P($P(IBM,U,6),".",1),"2Z")
  1. S EOBTYP=" "_$P("EOB^MRA",U,$P(IBM,U,4)+1)
  1. S CLMSTAT=" "_$$EXTERNAL^DILFD(361.1,.13,"",$P(IBM,U,13))
  1. W $E(PATNAME,1,19)," (",$E(SEQ),")",$E(INSCO,1,17),?56,EOBDT
  1. W ?66,EOBTYP,?70,CLMSTAT
  1. EOBLSTX ;
  1. Q
  1. ;
  1. SEL(IBIFN,MRAONLY,IBDA) ; Function to display and allow user selection
  1. ; of an EOB/MRA on file in 361.1 for the given bill.
  1. ;
  1. ; Input: IBIFN - internal bill number (required)
  1. ; MRAONLY - 1 if only MRA EOB's should be included here
  1. ; IBDA - list entry number of user selection (optional)
  1. ;
  1. ; Function Value: IEN to file 361.1 or nil if no selection made
  1. ;
  1. NEW IBEOB,EOBDATE,COUNT,IEN,IBM,INSCO,SEQ,EOBDT,EOBTYP,CLMSTAT,LIST
  1. NEW J,A,DIR,X,Y,DTOUT,DUOUT,DIRUT,DIROUT,IBM1
  1. S IBEOB="",IBIFN=+$G(IBIFN),EOBDATE=0,COUNT=0,IBDA=+$G(IBDA)
  1. F S EOBDATE=$O(^IBM(361.1,"ABD",IBIFN,EOBDATE)) Q:'EOBDATE D
  1. . S IEN=0
  1. . F S IEN=$O(^IBM(361.1,"ABD",IBIFN,EOBDATE,IEN)) Q:'IEN D
  1. .. S IBM=$G(^IBM(361.1,IEN,0))
  1. .. I '$G(IBMRANOT),$G(MRAONLY),'$P(IBM,U,4) Q ; mra only check
  1. .. I $G(IBMRANOT),$G(MRAONLY),$P(IBM,U,4) Q ; EOB only check
  1. .. S INSCO=$$EXTERNAL^DILFD(361.1,.02,,$P(IBM,U,2))
  1. .. S SEQ=$E($$EXTERNAL^DILFD(361.1,.15,,$P(IBM,U,15)),1)
  1. .. S EOBDT=$$FMTE^XLFDT($P($P(IBM,U,6),".",1),"2Z")
  1. .. S EOBTYP=$P("EOB^MRA",U,$P(IBM,U,4)+1)
  1. .. S CLMSTAT=$$EXTERNAL^DILFD(361.1,.13,"",$P(IBM,U,13))
  1. .. S COUNT=COUNT+1
  1. .. S LIST(COUNT)=IEN_U_SEQ_U_INSCO_U_EOBDT_U_EOBTYP_U_CLMSTAT
  1. .. Q
  1. . Q
  1. ;
  1. I 'COUNT G SELX ; no mra/eob data found
  1. ;
  1. ; Display mra/eob data
  1. S J="EOB's/MRA's"
  1. ;I $G(MRAONLY) S J="MRA's"
  1. S:$G(IBMRANOT)'=1 J="MRA's"
  1. I COUNT>1 W !!,"The selected bill has multiple ",J," on file. Please choose one."
  1. W !!?7,"#",?11,"Seq",?17,"Insurance Company",?40,"EOB Date"
  1. W ?51,"Type",?57,"Claim Status"
  1. F J=1:1:COUNT S A=LIST(J) D
  1. . W !?5,$J(J,3),?11,"(",$P(A,U,2),")",?17,$E($P(A,U,3),1,20)
  1. . W ?40,$P(A,U,4),?51,$P(A,U,5),?57,$P(A,U,6)
  1. . Q
  1. ;
  1. ; User Selection
  1. W ! S DIR(0)="NO^1:"_COUNT,DIR("A")="Select an EOB/MRA"
  1. ;I $G(MRAONLY) S DIR("A")="Select an MRA"
  1. S:$G(IBMRANOT)'=1 DIR("A")="Select an MRA"
  1. D ^DIR K DIR
  1. I 'Y G SELX ; no selection made
  1. S IBEOB=+$G(LIST(Y))
  1. ;
  1. ; At this point we need to update the scratch globals with this
  1. ; EOB specific data
  1. S IBM=$G(^IBM(361.1,IBEOB,0)) I IBM="" G SELX
  1. S IBM1=$G(^IBM(361.1,IBEOB,1))
  1. ;
  1. I IBDA,$P($G(^TMP("IBCECOB",$J,IBDA)),U,2)=IBIFN D
  1. . S $P(^TMP("IBCECOB",$J,IBDA),U,3)=$P(IBM,U,19) ; ptr 364
  1. . S $P(^TMP("IBCECOB",$J,IBDA),U,4)=IBEOB ; 361.1 ien
  1. . Q
  1. ;
  1. I IBDA,$D(^TMP("IBCECOB1",$J,IBDA)) D
  1. . S $P(^TMP("IBCECOB1",$J,IBDA),U,10)=IBEOB ; 361.1 ien
  1. . S $P(^TMP("IBCECOB1",$J,IBDA),U,13)=$P(IBM,U,6) ; eob paid date
  1. . S $P(^TMP("IBCECOB1",$J,IBDA),U,15)=$P(IBM,U,19) ; ptr 364
  1. . S $P(^TMP("IBCECOB1",$J,IBDA),U,16)=$P(IBM,U,15) ; ins seq
  1. . S $P(^TMP("IBCECOB1",$J,IBDA),U,17)=$P(IBM1,U,1) ; payer paid amt
  1. . Q
  1. SELX ;
  1. Q IBEOB
  1. ;
  1. ;
  1. CHKSUM(IBARRAY) ; Incoming 835 checksum calculation
  1. ; This function calculates the checksum of the raw 835 data from
  1. ; the data in array IBARRAY. This is done to prevent duplicates.
  1. ; Input parameter IBARRAY is the array reference where the data exists
  1. ; at @IBARRAY@(n,0) where n is a sequential #
  1. ; For file 364.2, IBARRAY = "^IBA(364.2,IBIEN,2)" where IBIEN = the ien
  1. ; of the entry in file 364.2 being evaluated
  1. ;
  1. NEW Y,LN,DATA,IBREC,POS,EOBFLG
  1. S Y=0,EOBFLG=0
  1. S LN=0
  1. F S LN=$O(@IBARRAY@(LN)) Q:'LN D
  1. . S DATA=$$EXT($G(@IBARRAY@(LN,0))) Q:DATA=""
  1. . S IBREC=$P(DATA,U,1)
  1. . I IBREC="835EOB"!(IBREC="835ERA") S EOBFLG=1 Q ; set the EOB flag
  1. . I IBREC<1 Q ; rec# too low
  1. . I IBREC'<99 Q ; rec# too high
  1. . F POS=1:1:$L(DATA) S Y=Y+($A(DATA,POS)*POS)
  1. . Q
  1. ;
  1. I 'EOBFLG S Y=0 ; if this array is not an 835
  1. Q Y
  1. ;
  1. EXT(DATA) ; Extracts from the text in DATA if the text contains
  1. ; "##RAW DATA: "
  1. Q $S(DATA["##RAW DATA: ":$P(DATA,"##RAW DATA: ",2,99),1:DATA)
  1. ;