IBCAPP1 ;ALB/WCJ - Claims Auto Processing Utilities;27-AUG-10
;;2.0;INTEGRATED BILLING;**432,447**;21-MAR-94;Build 80
;;Per VHA Directive 2004-038, this routine should not be modified.
G AWAY
AWAY Q
;
; Borrowed heavily from the Medicare auto processing
CRIT(IBIFN,IBEOB) ; Function to determine if a claim meets the criteria for auto-authorization and
; secondary/tertiary claim submission for NON MEDICARE claims
;
; Input: IBIFN - internal entry number for an entry in 399
; IBEOB - by reference to it can be returned
; Output: This function returns a pieced string
; [1] 0 or 1, EOB meets criteria
; [2] error message if the first piece is 0
;
; The IB system shall automatically generate a non-Medicare secondary/tertiary claim to the next payer on
; the claim when all services lines on the previous EOB(s) meet the following criteria:
;
; Adjustment group code of CO is associated with one of the following reason codes:
; A2; B6; 42; 45; 102; 104; 118; 131; 23; 232; 44; 59; 94; 97; or 10
; Patient Responsibility group code of PR is associated with one of the following reason codes:
; 1; 2; or 66
; The sum of the deductible, coinsurance and co-payment amounts is greater than $0.00
; The claim status is Approved; and
; The CLP02 equals one of the following:1; 2; or 3
N IB0,IBCT,IBI,IBILLCNT,IBPTRESP,IBSHEOB,REASON,Z,ERR
S OK=0,REASON="Unknown",IBEOB=0
;
; Check the parameter value (Make sure this bad boy is turned on).
I '+IBIFN S REASON="IB807:Need to pass in an internal claim number" G CRITX
;
; Check the parameter value (Make sure this baby is turned on).
I '$P($G(^IBE(350.9,1,8)),U,17) S REASON="IB800:Automatic EOB Processing parameter is turned off. File 350.9, Field 8.17." G CRITX
;
; Quit if we don't have any EOBs
I '$D(^IBM(361.1,"B",IBIFN)),'$D(^IBM(361.1,"C",IBIFN)) S REASON="IB801:No EOB Data Found" G CRITX
;
; Let's go get us some EOBs
S IBCT=0,IBI=0
F S IBI=$O(^IBM(361.1,"B",IBIFN,IBI)) Q:'IBI D
. S IB0=$G(^IBM(361.1,IBI,0))
. Q:IB0=""
. Q:$P(IB0,U,4)'=0 ; do not care about MRAs, only EOBs
. S Z=+$O(^IBM(361.1,IBI,8,0))
. I '$O(^IBM(361.1,IBI,8,Z)) S IBCT=IBCT+1,IBSHEOB(IBI)=0 ; Entire EOB belongs to the bill
;
S IBI=0
F S IBI=$O(^IBM(361.1,"C",IBIFN,IBI)) Q:'IBI D
. S IB0=$G(^IBM(361.1,IBI,0))
. Q:IB0=""
. Q:$P(IB0,U,4)'=0 ; do not care about MRAs, only EOBs
. I '$D(IBSHEOB(IBI)) S IBCT=IBCT+1 ; don't count it twice
. S IBSHEOB(IBI)=1 ; EOB has been reapportioned at the site
;
I '$D(IBSHEOB) S ERR=1,REASON="IB801:No EOB Data Found" G CRITX
I $G(IBCT)>1 S ERR=1,REASON="IB802:Multiple EOBs found for this claim" G CRITX
;
; only one EOB
S ERR=0
S IBEOB=$O(IBSHEOB(0))
;
I $D(^IBM(361.1,IBEOB,"ERR")) S REASON="IB803:EOB Filing Errors" G CRITX
;
S IB0=$G(^IBM(361.1,IBEOB,0))
I $P(IB0,U,13)'=1 S REASON="IB804:Claim Status must be PROCESSED" G CRITX
;
; If this EOB is a split EOB, then don't allow it
I $$SPLIT^IBCEMU1(IBEOB) S REASON="IB805:Claim level remark code MA15 received. Multiple EOBs." G CRITX
;
; More than one claim on this EOB
S Z=0 F S Z=$O(^IBM(361.1,IBEOB,8,Z)) Q:'Z I $P($G(^IBM(361.1,IBEOB,8,Z,0)),U,3)'=IBIFN S REASON="IB809:EOB Split to more claims" G CRITX
;
; Call the function that checks the claim level and/or line level
; adjustments for this EOB
I '$$CAS(IBEOB,"B",.REASON) S REASON="IB808:Failed adjustment criteria selection" G CRITX ; "B" for both
;
; Make sure the balance remaining amount is greater than $0 IB*2.0*447
S IBPTRESP=$$TOT^IBCECOB2(IBIFN,1)
I IBPTRESP'>0 S REASON="IB806:Balance remaining dollar amount is less than or equal to $0" G CRITX
;
; At this point, we're OK
S OK=1,REASON=""
;
CRITX ;
;
Q OK_U_REASON
;
;
CAS(IBEOB,ADJFLAG,REASON) ; This function determines if the EOB
; adjustment group codes and reason codes from file 361.1 (either
; claim level or line level or both) meet the criteria for auto-
; authorization and secondary claim submission.
;
; Input Parameters
; IBEOB - ien of entry in file 361.1
; ADJFLAG - adjustment flag
; "C" - look at claim level adjustments only
; "L" - look at line level adjustments only
; "B" - look at both claim and line level adjustments
; Output Parameter
; REASON - error message describing why it failed
;
; Function Value is either 0 or 1, indicating if it passed the criteria
;
NEW EOBADJ,OK,OKCOMBO,PATRESP,STOP,LNIEN
;
S IBEOB=+$G(IBEOB)
S ADJFLAG=$G(ADJFLAG,"B") ; default is "B" if not passed in
D BUILD ; build the array of OK group/reason combinations
S PATRESP=0 ; patient responsibility flag (default false)
S STOP=0 ; Stop flag
S OK=0 ; OK flag (function value)
S REASON="" ; error reason text
;
; claim level adjustments
I $F(".C.B.","."_ADJFLAG_".") D
. KILL EOBADJ
. M EOBADJ=^IBM(361.1,IBEOB,10)
. D ADJCHK
. Q
;
; Get out if the claim level adjustments failed
I STOP G CASX
;
; line level adjustments
I $F(".L.B.","."_ADJFLAG_".") D
. S LNIEN=0
. F S LNIEN=$O(^IBM(361.1,IBEOB,15,LNIEN)) Q:'LNIEN D Q:STOP
.. KILL EOBADJ
.. M EOBADJ=^IBM(361.1,IBEOB,15,LNIEN,1)
.. D ADJCHK
.. Q
. Q
;
; Get out if the line level adjustments failed
I STOP G CASX
;
; Get out if there was no patient responsibility adjustments found
I 'PATRESP S REASON="No Patient Responsibility Adjustments found" G CASX
;
; At this point, we're OK
S OK=1,REASON=""
CASX ;
Q OK
;
;
ADJCHK ; This procedure checks the adjustments for this EOB. The group codes
; and reason codes are in the EOBADJ array structures from file 361.1.
;
; Variables STOP and REASON will be returned on an error
; Variable PATRESP will be returned if a valid PR adjustment found
;
NEW ADJIEN,GROUP,RSNIEN,RSNCODE
S ADJIEN=0
F S ADJIEN=$O(EOBADJ(ADJIEN)) Q:'ADJIEN D Q:STOP
. S GROUP=$P($G(EOBADJ(ADJIEN,0)),U,1)
. I GROUP="LQ" Q ; line level remark code kludge: 42 rec [3]
. I GROUP="" S GROUP="<Undefined>"
. I '$D(OKCOMBO(GROUP)) S STOP=1,REASON="Unacceptable Claim Adjustment Group Code: "_GROUP Q
. S RSNIEN=0
. F S RSNIEN=$O(EOBADJ(ADJIEN,1,RSNIEN)) Q:'RSNIEN D Q:STOP
.. S RSNCODE=$P($G(EOBADJ(ADJIEN,1,RSNIEN,0)),U,1)
.. ;
.. ; Ignore some special adjustment data that is filed with the MRA
.. I GROUP="PR",RSNCODE="AAA" Q ; Allowed Amount: 41 rec [3]
.. I GROUP="OA",RSNCODE="AB3" Q ; Covered Amount: 15 rec [3]
.. ;
.. I RSNCODE="" S RSNCODE="<Undefined>"
.. I '$D(OKCOMBO(GROUP,RSNCODE)) S STOP=1,REASON="Unacceptable Reason Code ("_RSNCODE_") for Claim Adjustment Group Code ("_GROUP_")" Q
.. ;
.. ; Set the flag if the group is PR
.. I GROUP="PR" S PATRESP=1
.. Q
. Q
ADJCHKX ;
Q
;
;
BUILD ; This procedure builds the OKCOMBO array which identifies which
; combinations of group codes and reason codes are acceptable
;
NEW LN,LINE,GROUP,RSNLST,R,RSN
KILL OKCOMBO
F LN=1:1 D Q:$P(LINE,";",4)=""&$D(OKCOMBO)
. S LINE=$T(OKCOMBO+LN)
. S GROUP=$P(LINE,";",3) Q:GROUP=""
. S RSNLST=$P(LINE,";",4) Q:RSNLST=""
. F R=1:1:$L(RSNLST,",") D
.. S RSN=$P(RSNLST,",",R) Q:RSN=""
.. S OKCOMBO(GROUP,RSN)=""
.. Q
. Q
BUILDX ;
Q
;
;
OKCOMBO ; This section lists OK combinations of adjustment category group codes
; and associated reason codes.
; The format is as follows - semi-colon delimiter
; [3] Adjustment category (group code)
; [4] List of acceptable reason codes - comma delimiter
;
;;CO;A2,B6,42,45,102,104,118,131,23,232,44,59,94,97,10
;;PR;1,2,66
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HIBCAPP1 7767 printed Apr 09, 2024@21:29:29 Page 2
IBCAPP1 ;ALB/WCJ - Claims Auto Processing Utilities;27-AUG-10
+1 ;;2.0;INTEGRATED BILLING;**432,447**;21-MAR-94;Build 80
+2 ;;Per VHA Directive 2004-038, this routine should not be modified.
+3 GOTO AWAY
AWAY QUIT
+1 ;
+2 ; Borrowed heavily from the Medicare auto processing
CRIT(IBIFN,IBEOB) ; Function to determine if a claim meets the criteria for auto-authorization and
+1 ; secondary/tertiary claim submission for NON MEDICARE claims
+2 ;
+3 ; Input: IBIFN - internal entry number for an entry in 399
+4 ; IBEOB - by reference to it can be returned
+5 ; Output: This function returns a pieced string
+6 ; [1] 0 or 1, EOB meets criteria
+7 ; [2] error message if the first piece is 0
+8 ;
+9 ; The IB system shall automatically generate a non-Medicare secondary/tertiary claim to the next payer on
+10 ; the claim when all services lines on the previous EOB(s) meet the following criteria:
+11 ;
+12 ; Adjustment group code of CO is associated with one of the following reason codes:
+13 ; A2; B6; 42; 45; 102; 104; 118; 131; 23; 232; 44; 59; 94; 97; or 10
+14 ; Patient Responsibility group code of PR is associated with one of the following reason codes:
+15 ; 1; 2; or 66
+16 ; The sum of the deductible, coinsurance and co-payment amounts is greater than $0.00
+17 ; The claim status is Approved; and
+18 ; The CLP02 equals one of the following:1; 2; or 3
+19 NEW IB0,IBCT,IBI,IBILLCNT,IBPTRESP,IBSHEOB,REASON,Z,ERR
+20 SET OK=0
SET REASON="Unknown"
SET IBEOB=0
+21 ;
+22 ; Check the parameter value (Make sure this bad boy is turned on).
+23 IF '+IBIFN
SET REASON="IB807:Need to pass in an internal claim number"
GOTO CRITX
+24 ;
+25 ; Check the parameter value (Make sure this baby is turned on).
+26 IF '$PIECE($GET(^IBE(350.9,1,8)),U,17)
SET REASON="IB800:Automatic EOB Processing parameter is turned off. File 350.9, Field 8.17."
GOTO CRITX
+27 ;
+28 ; Quit if we don't have any EOBs
+29 IF '$DATA(^IBM(361.1,"B",IBIFN))
IF '$DATA(^IBM(361.1,"C",IBIFN))
SET REASON="IB801:No EOB Data Found"
GOTO CRITX
+30 ;
+31 ; Let's go get us some EOBs
+32 SET IBCT=0
SET IBI=0
+33 FOR
SET IBI=$ORDER(^IBM(361.1,"B",IBIFN,IBI))
if 'IBI
QUIT
Begin DoDot:1
+34 SET IB0=$GET(^IBM(361.1,IBI,0))
+35 if IB0=""
QUIT
+36 ; do not care about MRAs, only EOBs
if $PIECE(IB0,U,4)'=0
QUIT
+37 SET Z=+$ORDER(^IBM(361.1,IBI,8,0))
+38 ; Entire EOB belongs to the bill
IF '$ORDER(^IBM(361.1,IBI,8,Z))
SET IBCT=IBCT+1
SET IBSHEOB(IBI)=0
End DoDot:1
+39 ;
+40 SET IBI=0
+41 FOR
SET IBI=$ORDER(^IBM(361.1,"C",IBIFN,IBI))
if 'IBI
QUIT
Begin DoDot:1
+42 SET IB0=$GET(^IBM(361.1,IBI,0))
+43 if IB0=""
QUIT
+44 ; do not care about MRAs, only EOBs
if $PIECE(IB0,U,4)'=0
QUIT
+45 ; don't count it twice
IF '$DATA(IBSHEOB(IBI))
SET IBCT=IBCT+1
+46 ; EOB has been reapportioned at the site
SET IBSHEOB(IBI)=1
End DoDot:1
+47 ;
+48 IF '$DATA(IBSHEOB)
SET ERR=1
SET REASON="IB801:No EOB Data Found"
GOTO CRITX
+49 IF $GET(IBCT)>1
SET ERR=1
SET REASON="IB802:Multiple EOBs found for this claim"
GOTO CRITX
+50 ;
+51 ; only one EOB
+52 SET ERR=0
+53 SET IBEOB=$ORDER(IBSHEOB(0))
+54 ;
+55 IF $DATA(^IBM(361.1,IBEOB,"ERR"))
SET REASON="IB803:EOB Filing Errors"
GOTO CRITX
+56 ;
+57 SET IB0=$GET(^IBM(361.1,IBEOB,0))
+58 IF $PIECE(IB0,U,13)'=1
SET REASON="IB804:Claim Status must be PROCESSED"
GOTO CRITX
+59 ;
+60 ; If this EOB is a split EOB, then don't allow it
+61 IF $$SPLIT^IBCEMU1(IBEOB)
SET REASON="IB805:Claim level remark code MA15 received. Multiple EOBs."
GOTO CRITX
+62 ;
+63 ; More than one claim on this EOB
+64 SET Z=0
FOR
SET Z=$ORDER(^IBM(361.1,IBEOB,8,Z))
if 'Z
QUIT
IF $PIECE($GET(^IBM(361.1,IBEOB,8,Z,0)),U,3)'=IBIFN
SET REASON="IB809:EOB Split to more claims"
GOTO CRITX
+65 ;
+66 ; Call the function that checks the claim level and/or line level
+67 ; adjustments for this EOB
+68 ; "B" for both
IF '$$CAS(IBEOB,"B",.REASON)
SET REASON="IB808:Failed adjustment criteria selection"
GOTO CRITX
+69 ;
+70 ; Make sure the balance remaining amount is greater than $0 IB*2.0*447
+71 SET IBPTRESP=$$TOT^IBCECOB2(IBIFN,1)
+72 IF IBPTRESP'>0
SET REASON="IB806:Balance remaining dollar amount is less than or equal to $0"
GOTO CRITX
+73 ;
+74 ; At this point, we're OK
+75 SET OK=1
SET REASON=""
+76 ;
CRITX ;
+1 ;
+2 QUIT OK_U_REASON
+3 ;
+4 ;
CAS(IBEOB,ADJFLAG,REASON) ; This function determines if the EOB
+1 ; adjustment group codes and reason codes from file 361.1 (either
+2 ; claim level or line level or both) meet the criteria for auto-
+3 ; authorization and secondary claim submission.
+4 ;
+5 ; Input Parameters
+6 ; IBEOB - ien of entry in file 361.1
+7 ; ADJFLAG - adjustment flag
+8 ; "C" - look at claim level adjustments only
+9 ; "L" - look at line level adjustments only
+10 ; "B" - look at both claim and line level adjustments
+11 ; Output Parameter
+12 ; REASON - error message describing why it failed
+13 ;
+14 ; Function Value is either 0 or 1, indicating if it passed the criteria
+15 ;
+16 NEW EOBADJ,OK,OKCOMBO,PATRESP,STOP,LNIEN
+17 ;
+18 SET IBEOB=+$GET(IBEOB)
+19 ; default is "B" if not passed in
SET ADJFLAG=$GET(ADJFLAG,"B")
+20 ; build the array of OK group/reason combinations
DO BUILD
+21 ; patient responsibility flag (default false)
SET PATRESP=0
+22 ; Stop flag
SET STOP=0
+23 ; OK flag (function value)
SET OK=0
+24 ; error reason text
SET REASON=""
+25 ;
+26 ; claim level adjustments
+27 IF $FIND(".C.B.","."_ADJFLAG_".")
Begin DoDot:1
+28 KILL EOBADJ
+29 MERGE EOBADJ=^IBM(361.1,IBEOB,10)
+30 DO ADJCHK
+31 QUIT
End DoDot:1
+32 ;
+33 ; Get out if the claim level adjustments failed
+34 IF STOP
GOTO CASX
+35 ;
+36 ; line level adjustments
+37 IF $FIND(".L.B.","."_ADJFLAG_".")
Begin DoDot:1
+38 SET LNIEN=0
+39 FOR
SET LNIEN=$ORDER(^IBM(361.1,IBEOB,15,LNIEN))
if 'LNIEN
QUIT
Begin DoDot:2
+40 KILL EOBADJ
+41 MERGE EOBADJ=^IBM(361.1,IBEOB,15,LNIEN,1)
+42 DO ADJCHK
+43 QUIT
End DoDot:2
if STOP
QUIT
+44 QUIT
End DoDot:1
+45 ;
+46 ; Get out if the line level adjustments failed
+47 IF STOP
GOTO CASX
+48 ;
+49 ; Get out if there was no patient responsibility adjustments found
+50 IF 'PATRESP
SET REASON="No Patient Responsibility Adjustments found"
GOTO CASX
+51 ;
+52 ; At this point, we're OK
+53 SET OK=1
SET REASON=""
CASX ;
+1 QUIT OK
+2 ;
+3 ;
ADJCHK ; This procedure checks the adjustments for this EOB. The group codes
+1 ; and reason codes are in the EOBADJ array structures from file 361.1.
+2 ;
+3 ; Variables STOP and REASON will be returned on an error
+4 ; Variable PATRESP will be returned if a valid PR adjustment found
+5 ;
+6 NEW ADJIEN,GROUP,RSNIEN,RSNCODE
+7 SET ADJIEN=0
+8 FOR
SET ADJIEN=$ORDER(EOBADJ(ADJIEN))
if 'ADJIEN
QUIT
Begin DoDot:1
+9 SET GROUP=$PIECE($GET(EOBADJ(ADJIEN,0)),U,1)
+10 ; line level remark code kludge: 42 rec [3]
IF GROUP="LQ"
QUIT
+11 IF GROUP=""
SET GROUP="<Undefined>"
+12 IF '$DATA(OKCOMBO(GROUP))
SET STOP=1
SET REASON="Unacceptable Claim Adjustment Group Code: "_GROUP
QUIT
+13 SET RSNIEN=0
+14 FOR
SET RSNIEN=$ORDER(EOBADJ(ADJIEN,1,RSNIEN))
if 'RSNIEN
QUIT
Begin DoDot:2
+15 SET RSNCODE=$PIECE($GET(EOBADJ(ADJIEN,1,RSNIEN,0)),U,1)
+16 ;
+17 ; Ignore some special adjustment data that is filed with the MRA
+18 ; Allowed Amount: 41 rec [3]
IF GROUP="PR"
IF RSNCODE="AAA"
QUIT
+19 ; Covered Amount: 15 rec [3]
IF GROUP="OA"
IF RSNCODE="AB3"
QUIT
+20 ;
+21 IF RSNCODE=""
SET RSNCODE="<Undefined>"
+22 IF '$DATA(OKCOMBO(GROUP,RSNCODE))
SET STOP=1
SET REASON="Unacceptable Reason Code ("_RSNCODE_") for Claim Adjustment Group Code ("_GROUP_")"
QUIT
+23 ;
+24 ; Set the flag if the group is PR
+25 IF GROUP="PR"
SET PATRESP=1
+26 QUIT
End DoDot:2
if STOP
QUIT
+27 QUIT
End DoDot:1
if STOP
QUIT
ADJCHKX ;
+1 QUIT
+2 ;
+3 ;
BUILD ; This procedure builds the OKCOMBO array which identifies which
+1 ; combinations of group codes and reason codes are acceptable
+2 ;
+3 NEW LN,LINE,GROUP,RSNLST,R,RSN
+4 KILL OKCOMBO
+5 FOR LN=1:1
Begin DoDot:1
+6 SET LINE=$TEXT(OKCOMBO+LN)
+7 SET GROUP=$PIECE(LINE,";",3)
if GROUP=""
QUIT
+8 SET RSNLST=$PIECE(LINE,";",4)
if RSNLST=""
QUIT
+9 FOR R=1:1:$LENGTH(RSNLST,",")
Begin DoDot:2
+10 SET RSN=$PIECE(RSNLST,",",R)
if RSN=""
QUIT
+11 SET OKCOMBO(GROUP,RSN)=""
+12 QUIT
End DoDot:2
+13 QUIT
End DoDot:1
if $PIECE(LINE,";",4)=""&$DATA(OKCOMBO)
QUIT
BUILDX ;
+1 QUIT
+2 ;
+3 ;
OKCOMBO ; This section lists OK combinations of adjustment category group codes
+1 ; and associated reason codes.
+2 ; The format is as follows - semi-colon delimiter
+3 ; [3] Adjustment category (group code)
+4 ; [4] List of acceptable reason codes - comma delimiter
+5 ;
+6 ;;CO;A2,B6,42,45,102,104,118,131,23,232,44,59,94,97,10
+7 ;;PR;1,2,66
+8 ;
