IBCEOB0 ;ALB/TMP/PJH - 835 EDI EOB MSG PROCESSING ; 8/24/10 7:23pm
;;2.0;INTEGRATED BILLING;**135,280,155,431,488,516,633,727**;21-MAR-94;Build 34
;;Per VA Directive 6402, this routine should not be modified.
Q
;
LINE() ;Extract Provider Line Reference from 42 record
N SUB,NODE,VAL
S VAL="",SUB=IBA1 ; from loop in UPD3611^IBCEOB
;IB*2.0*516/TAZ - Quit when another RT 40 is encountered to prevent group of
;mismatched procedures
F S SUB=$O(@IBFILE@(SUB)) Q:SUB="" D Q:(+NODE>42)!(+NODE=40)
.S NODE=$G(@IBFILE@(SUB,0))
.S:NODE["RAW DATA" NODE=$P(NODE," ",3,99)
.;Q:+NODE'=42 S VAL=$P(NODE,U,5) ;WCJ;IB727;sometimes (always) only the first 42 record has piece 5 so grab the last one that is there.
.Q:+NODE'=42
.S:$P(NODE,U,5)]"" VAL=$P(NODE,U,5)
Q VAL
;
30(IB0,IBEOB,IBOK) ; Process record type 30 for EOB
; IB0 = the record being processed
; IBEOB = the ien of the EOB entry in file 361.1
; IBOK = Returned as 1 if record filed OK, 0 if error occurred
;
N A
S A="3;4.01;0;1;1^5;4.02;0;1;1^6;4.03;1;0;0^7;4.05;1;0;0^8;4.06;1;0;0^9;4.07;1;0;0^10;4.08;1;0;0^11;4.09;1;0;0^12;4.1;1;0;0^13;4.11;1;0;0^14;4.19;0;1;1"
;
S IBOK=$$STORE^IBCEOB1(A,IB0,IBEOB)
I 'IBOK S ^TMP(IBEGBL,$J,+$O(^TMP(IBEGBL,$J,""),-1)+1)="Bad MEDICARE Inpt Adjudication data"
Q30 Q
;
40(IB0,IBEOB,IBOK) ; Process record type 40 for EOB
; IB0 = the record being processed
; IBEOB = the ien of the EOB entry in file 361.1
; IBOK = Returned as 1 if record filed OK, 0 if error occurred
;
; IBZDATA is also assumed to exist or if not, it is created in FINDLN
;
N A,LEVEL,IBSEQ,IBDA,IBPC,IBLREF,IBIFN,Q,X,Y,DA,DD,DO,DIC,DLAYGO,PLREF,ERRCOD
K ^TMP($J,40) ; the entry # for corresponding 41, 42, and 45 records
;
S IBIFN=+$G(^IBM(361.1,IBEOB,0))
L +^IBM(361.1,IBEOB,15):0 I $T S IBSEQ=+$O(^IBM(361.1,IBEOB,15," "),-1)+1
I '$G(IBSEQ) S ^TMP(IBEGBL,$J,+$O(^TMP(IBEGBL,$J,""),-1)+1)="Record lock failure - could not acquire next service line number" G Q40
;
; Update the 40 record data a little bit (pieces 3/4/16)
I $P(IB0,U,21)="NU" S $P(IB0,U,4)=$P(IB0,U,3),$P(IB0,U,3)=""
S $P(IB0,U,16)=$S(+$P(IB0,U,16):$P(IB0,U,16)/100,1:+$P(IB0,U,18)/100)
I $P(IB0,U,4)?1.N S $P(IB0,U,4)=+$P(IB0,U,4)
;
; Find the line item from original bill for this adjustment
S PLREF=$S('HIPAA:$P(IB0,U,22),1:$$LINE()) ; old format from 40 record, new format from 42
S ERRCOD=0
S IBLREF=+$$FINDLN^IBCEOB1(IB0,IBEOB,.IBZDATA,+PLREF,.ERRCOD)
I 'IBLREF D G Q40
. N Z,Z0,CT,ETEXT
. S EFLAG=0,ETEXT=""
. ;;S ^TMP(IBEGBL,$J,+$O(^TMP(IBEGBL,$J,""),-1)+1)="Service line detail could not be matched to a billed item"
. S ^TMP(IBEGBL,$J,+$O(^TMP(IBEGBL,$J,""),-1)+1)=" "
. S ETEXT=$P("Revenue Code^Procedure Code^Amount of Units^Charge Amount^Procedure Code Modifier",U,+ERRCOD)
. I ETEXT="" S ETEXT="Data"
. S ^TMP(IBEGBL,$J,+$O(^TMP(IBEGBL,$J,""),-1)+1)=$$ERRTXT(ETEXT,IBEOB) ; IB*2.0*633
. S ^TMP(IBEGBL,$J,+$O(^TMP(IBEGBL,$J,""),-1)+1)=" "
. D DET40^IBCEOB00(IB0,.Z0,ERRCOD)
. S CT=+$O(^TMP(IBEGBL,$J,""),-1),Z=0 F S Z=$O(Z0(Z)) Q:'Z S CT=CT+1,^TMP(IBEGBL,$J,CT)=Z0(Z)
;
S DIC="^IBM(361.1,"_IBEOB_",15,",DIC(0)="L",DLAYGO=361.115,DA(1)=IBEOB
S X=IBSEQ
S DIC("DR")=".12////"_+IBLREF_$S($P(IBLREF,U,2)="":"",1:";.15////"_$P(IBLREF,U,2))_";.16////"_$$DATE^IBCEU($P(IB0,U,19))_$S($P(IB0,U,20):";.17////"_$$DATE^IBCEU($P(IB0,U,20)),1:"")
D FILE^DICN K DIC,DO,DD,DLAYGO ;Add a new LINE LEVEL ADJUSTMENT ('SVC')
I Y<0 S ^TMP(IBEGBL,$J,+$O(^TMP(IBEGBL,$J,""),-1)+1)="Could not add a LINE LEVEL ADJUSTMENT ("_IBSEQ_")" G Q40
;
L -^IBM(361.1,IBEOB,15)
;
S LEVEL=15.1,LEVEL(0)=+Y,LEVEL(1)=IBEOB,LEVEL("DIE")="^IBM(361.1,"_IBEOB_",15,"
S A="3;.04;0;0;0^4;.1;0;0;0^9;.09;0;0;0^17;.03;1;0;0^18;.11;0;1;D2^21;.18;0;0;0"
I '$P(IB0,U,18),$P(IB0,U,16) S $P(A,U,5)="16;.11;0;1;1"
I $$STORE^IBCEOB1(A,IB0,IBEOB,.LEVEL) S ^TMP($J,40)=LEVEL(0),IBOK=1
I '$G(IBOK) S ^TMP(IBEGBL,$J,+$O(^TMP(IBEGBL,$J,""),-1)+1)="Bad data for line level adjustment "_IBSEQ G Q40
;
; Store modifiers in multiple
S DIC="^IBM(361.1,"_IBEOB_",15,"_LEVEL(0)_",2,",DIC(0)="L",DLAYGO=361.1152,DA(2)=IBEOB,DA(1)=LEVEL(0)
F Q=5:1:8 S X=$P(IB0,U,Q) I X'="" D FILE^DICN K DO,DD I Y<0 S IBOK=0 Q
K DLAYGO,DIC,DR,DA
I '$G(IBOK) S ^TMP(IBEGBL,$J,+$O(^TMP(IBEGBL,$J,""),-1)+1)="Could not file modifier data for line level adjustment "_IBSEQ G Q40
Q40 Q
;
41(IB0,IBEOB,IBOK) ; Process record type 41 for EOB
; IB0 = the record being processed
; IBEOB = the ien of the EOB entry in file 361.1
; IBOK = Returned as 1 if record filed OK, 0 if error occurred
;
N DA,DR,DIE,X,Y,Z,Z0,CT
I '$G(^TMP($J,40)) D G Q41
. S ^TMP(IBEGBL,$J,+$O(^TMP(IBEGBL,$J,""),-1)+1)="Service line adjustment (EEOB Record 41) has no matching service line"
. D DET4X^IBCEOB00(41,IB0,.Z0)
. S CT=+$O(^TMP(IBEGBL,$J,""),-1),Z=0 F S Z=$O(Z0(Z)) Q:'Z S CT=CT+1,^TMP(IBEGBL,$J,CT)=Z0(Z)
;
S DR="",IBOK=1
S DA=+^TMP($J,40),DA(1)=IBEOB
S DIE="^IBM(361.1,"_DA(1)_",15,"
I +$P(IB0,U,3) S DR=".13///"_$$DOLLAR^IBCEOB($P(IB0,U,3))
I +$P(IB0,U,4) S DR=DR_$S(DR="":"",1:";")_".14///"_$$DOLLAR^IBCEOB($P(IB0,U,4))
I DR'="" D ^DIE S IBOK=($D(Y)=0)
I '$G(IBOK) S ^TMP(IBEGBL,$J,+$O(^TMP(IBEGBL,$J,""),-1)+1)="Mismatched data for service line adjustment-2 (EEOB Record 41)"
;
; For Medicare MRA's only:
; If the Allowed Amount field is present, then we need to file an
; adjustment: Group code PR, Reason code AAA, Amount, Quantity, and
; Reason Text. This is data normally found on the 45 record, so we're
; going to create our own "45" record and file it.
;
I $P($G(^IBM(361.1,IBEOB,0)),U,4)=1,+$P(IB0,U,3) D
. N IB45,IBSAV40
. S IB45=45_U_$P(IB0,U,2)_U_"PR"_U_"AAA"_U_$P(IB0,U,3)_U_"0000000001"
. S IB45=IB45_U_"Allowed Amount"
. S IBSAV40=$G(^TMP($J,40))
. D 45(IB45,IBEOB,.IBOK)
. S ^TMP($J,40)=IBSAV40
. I '$G(IBOK) S ^TMP(IBEGBL,$J,+$O(^TMP(IBEGBL,$J,""),-1)+1)="Could not file the PR-AAA adjustment for the Allowed Amount at line "_+^TMP($J,40)
. Q
;
Q41 Q
;
42(IB0,IBEOB,IBOK) ; Process record type 42 for EOB
; IB0 = the record being processed
; IBEOB = the ien of the EOB entry in file 361.1
; IBOK = Returned as 1 if record filed OK, 0 if error occurred
;
N DO,DD,DLAYGO,DIC,DA,X,Y,Z,Z0,CT
S IBOK=0
I '$G(^TMP($J,40)) D G Q42
. S ^TMP(IBEGBL,$J,+$O(^TMP(IBEGBL,$J,""),-1)+1)="Service line adjustment (EEOB Record 42) has no matching service line"
. D DET4X^IBCEOB00(42,IB0,.Z0)
. S CT=+$O(^TMP(IBEGBL,$J,""),-1),Z=0 F S Z=$O(Z0(Z)) Q:'Z S CT=CT+1,^TMP(IBEGBL,$J,CT)=Z0(Z)
;
K DO,DD,DLAYGO
S IBOK=1
S DA(1)=+^TMP($J,40),DA(2)=IBEOB
S X=+$O(^IBM(361.1,DA(2),15,DA(1),4," "),-1)+1,DIC="^IBM(361.1,"_DA(2)_",15,"_DA(1)_",4,",DIC(0)="L",DLAYGO=361.1154
S DIC("DR")=$S($P(IB0,U,3)'="":".02////"_$P(IB0,U,3),1:"")
I $P(IB0,U,4)'="" S:$L(DIC("DR")) DIC("DR")=DIC("DR")_";" S DIC("DR")=DIC("DR")_".03////"_$TR($P(IB0,U,4),";"," ")
D FILE^DICN K DO,DD,DLAYGO
I Y'>0 S IBOK=0
I '$G(IBOK) S ^TMP(IBEGBL,$J,+$O(^TMP(IBEGBL,$J,""),-1)+1)="Mismatched data for service line adjustment-3 (EEOB Record 42)"
;
; For Medicare MRA's only:
; Process and store the line level remark code as an LQ kludge line
; level adjustment.
;
I $P($G(^IBM(361.1,IBEOB,0)),U,4)=1,$P(IB0,U,3)'="" D
. N IB45,IBSAV40
. S IB45=45_U_$P(IB0,U,2)_U_"LQ"_U_$P(IB0,U,3)_U_0_U_0_U_$P(IB0,U,4)
. S IBSAV40=$G(^TMP($J,40))
. D 45(IB45,IBEOB,.IBOK)
. S ^TMP($J,40)=IBSAV40
. I '$G(IBOK) S ^TMP(IBEGBL,$J,+$O(^TMP(IBEGBL,$J,""),-1)+1)="Could not file the LQ-remark code adjustment at line "_+^TMP($J,40)
. Q
Q42 Q
;
45(IB0,IBEOB,IBOK) ; Process record type 45 for EOB
; IB0 = the record being processed
; IBEOB = the ien of the EOB entry in file 361.1
; IBOK = Returned as 1 if record filed OK, 0 if error occurred
;
N IBDA,LEVEL,A,Z0,CT,Z
I '$G(^TMP($J,40)) D G Q45
. S ^TMP(IBEGBL,$J,+$O(^TMP(IBEGBL,$J,""),-1)+1)="Service line adjustment (EEOB Record 45) has no matching service line"
. D DET4X^IBCEOB00(45,IB0,.Z0)
. S CT=+$O(^TMP(IBEGBL,$J,""),-1),Z=0 F S Z=$O(Z0(Z)) Q:'Z S CT=CT+1,^TMP(IBEGBL,$J,CT)=Z0(Z)
;
I $P(IB0,U,3)'="" S $P(^TMP($J,40),U,2)=$P(IB0,U,3)
I $P(IB0,U,3)="" S $P(IB0,U,3)=$P(^TMP($J,40),U,2)
I $P(IB0,U,3)="" S ^TMP(IBEGBL,$J,+$O(^TMP(IBEGBL,$J,""),-1)+1)="Service line adjustment (EEOB Record 45) is missing its group code" G Q45
;
S IBDA(2)=+^TMP($J,40)
S IBDA(1)=+$O(^IBM(361.1,IBEOB,15,IBDA(2),1,"B",$P(IB0,U,3),0))
;
I 'IBDA(1) D ;Needs a new entry at group level
. N X,Y,DA,DD,DO,DIC,DLAYGO
. S DIC="^IBM(361.1,"_IBEOB_",15,"_IBDA(2)_",1,",DIC(0)="L",DLAYGO=361.1151,DA(2)=IBEOB,DA(1)=IBDA(2)
. S DIC("P")=$$GETSPEC^IBEFUNC(361.115,1)
. S X=$P(IB0,U,3)
. D FILE^DICN K DIC,DO,DD,DLAYGO
. I Y<0 K IBDA S ^TMP(IBEGBL,$J,+$O(^TMP(IBEGBL,$J,""),-1)+1)="Could not add adjustment group code ("_$P(IB0,U,3)_") at line adjustment "_+^TMP($J,40) Q
. S IBDA(1)=+Y
;
;Add a new entry at the reason code level
I $G(IBDA(1)) D
. S DIC="^IBM(361.1,"_IBEOB_",15,"_IBDA(2)_",1,"_IBDA(1)_",1,",DIC(0)="L",DLAYGO=361.11511,DA(1)=IBDA(1),DA(2)=IBDA(2),DA(3)=IBEOB
. S DIC("P")=$$GETSPEC^IBEFUNC(361.1151,1)
. S X=$P(IB0,U,4)
. D FILE^DICN K DIC,DO,DD,DLAYGO
. I Y<0 K IBDA S ^TMP(IBEGBL,$J,+$O(^TMP(IBEGBL,$J,""),-1)+1)="Could not add reason code ("_$P(IB0,U,4)_") for adjustment group code ("_$P(IB0,U,3)_") at line adjustment "_+^TMP($J,40) Q
. S IBDA=+Y
;
I $G(IBDA) D
. S LEVEL=15,LEVEL("DIE")="^IBM(361.1,"_IBEOB_",15,"_IBDA(2)_",1,"_IBDA(1)_",1,"
. S LEVEL(0)=IBDA,LEVEL(1)=IBDA(1),LEVEL(2)=IBDA(2),LEVEL(3)=IBEOB
. S A="5;.02;1;0;0^6;.03;0;1;1^7;.04;0;1;0"
. S IBOK=$$STORE^IBCEOB1(A,IB0,IBEOB,.LEVEL)
. I 'IBOK S ^TMP(IBEGBL,$J,+$O(^TMP(IBEGBL,$J,""),-1)+1)="Mismatched data for reason code ("_$P(IB0,U,4)_"), adjustment group code ("_$P(IB0,U,3)_") at line adjustment "_+^TMP($J,40) Q
;
Q45 Q
;
46(IB0,IBEOB,IBOK) ; Process record type 46 for EOB
; IB0 = the record being processed
; IBEOB = the ien of the EOB entry in file 361.1
; IBOK = Returned as 1 if record filed OK, 0 if error occurred
;
S IBOK=0
N AGC,IBDA,LEVEL,A,Z0,CT,Z
I '$G(^TMP($J,40)) D G Q46
. S ^TMP(IBEGBL,$J,+$O(^TMP(IBEGBL,$J,""),-1)+1)="Service line adjustment (EEOB Record 46) has no matching service line"
. D DET4X^IBCEOB00(46,IB0,.Z0)
. ;S CT=+$O(^TMP(IBEGBL,$J,""),-1),Z=0 F S Z=$O(Z0(Z)) Q:'Z S CT=CT+1,^TMP(IBEGBL,$J,CT)=Z0(Z)
;
S AGC=$P(^TMP($J,40),U,2)
I AGC="" S ^TMP(IBEGBL,$J,+$O(^TMP(IBEGBL,$J,""),-1)+1)="Service line adjustment (EEOB Record 46) is missing its group code" G Q46
;
S IBDA(2)=+^TMP($J,40)
S IBDA(1)=+$O(^IBM(361.1,IBEOB,15,IBDA(2),1,"B",AGC,0))
;
;
;Add a new entry at the Payer Policy level
I $G(IBDA(1)) D
. S DIC="^IBM(361.1,"_IBEOB_",15,"_IBDA(2)_",1,"_IBDA(1)_",2,",DIC(0)="L",DLAYGO=361.11511,DA(1)=IBDA(1),DA(2)=IBDA(2),DA(3)=IBEOB
. S DIC("P")=$$GETSPEC^IBEFUNC(361.1151,1)
. S X=$P(IB0,U,3)
. D FILE^DICN K DIC,DO,DD,DLAYGO
. I Y<0 K IBDA S ^TMP(IBEGBL,$J,+$O(^TMP(IBEGBL,$J,""),-1)+1)="Could not add payer policy ("_$P(IB0,U,4)_") for adjustment group code ("_$P(IB0,U,3)_") at line adjustment "_+^TMP($J,40) Q
. S IBDA=+Y,IBOK=1
;
Q46 Q
;
; IB*2.0*633 - Begin modified code block
ERRTXT(X,IBEOB) ; Set error text based on circumstances
; Input - X = Standard Error message passed in
; IB0
; Returns modified error message text
N RETURN
S RETURN="Mismatched "_X_":"
I '$$EBILL(IBEOB) S RETURN="Claim was not Billed Electronically:"
Q RETURN
;
EBILL(IBEOB) ; Check If EOB was billed electronically
; Input : IBEOB = Internal entry number from file 361.1
; Returns : 1 - Billed electronically
; 0 - Not billed electronically
N IEN399,IEN364,STATUS
S IEN399=$$GET1^DIQ(361.1,IBEOB_",",.01,"I")
S IEN364=$O(^IBA(364,"B",+IEN399,0))
I 'IEN364 Q 0 ; No EDI TRANSMIT BILL
;
S STATUS=$$GET1^DIQ(364,IEN364,.03,"I")
I STATUS="E"!(STATUS="C") Q 0 ; Error or canceled
Q 1
; IB*2.0*633 - End modified code block
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HIBCEOB0 12066 printed Dec 13, 2024@02:11:18 Page 2
IBCEOB0 ;ALB/TMP/PJH - 835 EDI EOB MSG PROCESSING ; 8/24/10 7:23pm
+1 ;;2.0;INTEGRATED BILLING;**135,280,155,431,488,516,633,727**;21-MAR-94;Build 34
+2 ;;Per VA Directive 6402, this routine should not be modified.
+3 QUIT
+4 ;
LINE() ;Extract Provider Line Reference from 42 record
+1 NEW SUB,NODE,VAL
+2 ; from loop in UPD3611^IBCEOB
SET VAL=""
SET SUB=IBA1
+3 ;IB*2.0*516/TAZ - Quit when another RT 40 is encountered to prevent group of
+4 ;mismatched procedures
+5 FOR
SET SUB=$ORDER(@IBFILE@(SUB))
if SUB=""
QUIT
Begin DoDot:1
+6 SET NODE=$GET(@IBFILE@(SUB,0))
+7 if NODE["RAW DATA"
SET NODE=$PIECE(NODE," ",3,99)
+8 ;Q:+NODE'=42 S VAL=$P(NODE,U,5) ;WCJ;IB727;sometimes (always) only the first 42 record has piece 5 so grab the last one that is there.
+9 if +NODE'=42
QUIT
+10 if $PIECE(NODE,U,5)]""
SET VAL=$PIECE(NODE,U,5)
End DoDot:1
if (+NODE>42)!(+NODE=40)
QUIT
+11 QUIT VAL
+12 ;
30(IB0,IBEOB,IBOK) ; Process record type 30 for EOB
+1 ; IB0 = the record being processed
+2 ; IBEOB = the ien of the EOB entry in file 361.1
+3 ; IBOK = Returned as 1 if record filed OK, 0 if error occurred
+4 ;
+5 NEW A
+6 SET A="3;4.01;0;1;1^5;4.02;0;1;1^6;4.03;1;0;0^7;4.05;1;0;0^8;4.06;1;0;0^9;4.07;1;0;0^10;4.08;1;0;0^11;4.09;1;0;0^12;4.1;1;0;0^13;4.11;1;0;0^14;4.19;0;1;1"
+7 ;
+8 SET IBOK=$$STORE^IBCEOB1(A,IB0,IBEOB)
+9 IF 'IBOK
SET ^TMP(IBEGBL,$JOB,+$ORDER(^TMP(IBEGBL,$JOB,""),-1)+1)="Bad MEDICARE Inpt Adjudication data"
Q30 QUIT
+1 ;
40(IB0,IBEOB,IBOK) ; Process record type 40 for EOB
+1 ; IB0 = the record being processed
+2 ; IBEOB = the ien of the EOB entry in file 361.1
+3 ; IBOK = Returned as 1 if record filed OK, 0 if error occurred
+4 ;
+5 ; IBZDATA is also assumed to exist or if not, it is created in FINDLN
+6 ;
+7 NEW A,LEVEL,IBSEQ,IBDA,IBPC,IBLREF,IBIFN,Q,X,Y,DA,DD,DO,DIC,DLAYGO,PLREF,ERRCOD
+8 ; the entry # for corresponding 41, 42, and 45 records
KILL ^TMP($JOB,40)
+9 ;
+10 SET IBIFN=+$GET(^IBM(361.1,IBEOB,0))
+11 LOCK +^IBM(361.1,IBEOB,15):0
IF $TEST
SET IBSEQ=+$ORDER(^IBM(361.1,IBEOB,15," "),-1)+1
+12 IF '$GET(IBSEQ)
SET ^TMP(IBEGBL,$JOB,+$ORDER(^TMP(IBEGBL,$JOB,""),-1)+1)="Record lock failure - could not acquire next service line number"
GOTO Q40
+13 ;
+14 ; Update the 40 record data a little bit (pieces 3/4/16)
+15 IF $PIECE(IB0,U,21)="NU"
SET $PIECE(IB0,U,4)=$PIECE(IB0,U,3)
SET $PIECE(IB0,U,3)=""
+16 SET $PIECE(IB0,U,16)=$SELECT(+$PIECE(IB0,U,16):$PIECE(IB0,U,16)/100,1:+$PIECE(IB0,U,18)/100)
+17 IF $PIECE(IB0,U,4)?1.N
SET $PIECE(IB0,U,4)=+$PIECE(IB0,U,4)
+18 ;
+19 ; Find the line item from original bill for this adjustment
+20 ; old format from 40 record, new format from 42
SET PLREF=$SELECT('HIPAA:$PIECE(IB0,U,22),1:$$LINE())
+21 SET ERRCOD=0
+22 SET IBLREF=+$$FINDLN^IBCEOB1(IB0,IBEOB,.IBZDATA,+PLREF,.ERRCOD)
+23 IF 'IBLREF
Begin DoDot:1
+24 NEW Z,Z0,CT,ETEXT
+25 SET EFLAG=0
SET ETEXT=""
+26 ;;S ^TMP(IBEGBL,$J,+$O(^TMP(IBEGBL,$J,""),-1)+1)="Service line detail could not be matched to a billed item"
+27 SET ^TMP(IBEGBL,$JOB,+$ORDER(^TMP(IBEGBL,$JOB,""),-1)+1)=" "
+28 SET ETEXT=$PIECE("Revenue Code^Procedure Code^Amount of Units^Charge Amount^Procedure Code Modifier",U,+ERRCOD)
+29 IF ETEXT=""
SET ETEXT="Data"
+30 ; IB*2.0*633
SET ^TMP(IBEGBL,$JOB,+$ORDER(^TMP(IBEGBL,$JOB,""),-1)+1)=$$ERRTXT(ETEXT,IBEOB)
+31 SET ^TMP(IBEGBL,$JOB,+$ORDER(^TMP(IBEGBL,$JOB,""),-1)+1)=" "
+32 DO DET40^IBCEOB00(IB0,.Z0,ERRCOD)
+33 SET CT=+$ORDER(^TMP(IBEGBL,$JOB,""),-1)
SET Z=0
FOR
SET Z=$ORDER(Z0(Z))
if 'Z
QUIT
SET CT=CT+1
SET ^TMP(IBEGBL,$JOB,CT)=Z0(Z)
End DoDot:1
GOTO Q40
+34 ;
+35 SET DIC="^IBM(361.1,"_IBEOB_",15,"
SET DIC(0)="L"
SET DLAYGO=361.115
SET DA(1)=IBEOB
+36 SET X=IBSEQ
+37 SET DIC("DR")=".12////"_+IBLREF_$SELECT($PIECE(IBLREF,U,2)="":"",1:";.15////"_$PIECE(IBLREF,U,2))_";.16////"_$$DATE^IBCEU($PIECE(IB0,U,19))_$SELECT($PIECE(IB0,U,20):";.17////"_$$DATE^IBCEU($PIECE(IB0,U,20)),1:"")
+38 ;Add a new LINE LEVEL ADJUSTMENT ('SVC')
DO FILE^DICN
KILL DIC,DO,DD,DLAYGO
+39 IF Y<0
SET ^TMP(IBEGBL,$JOB,+$ORDER(^TMP(IBEGBL,$JOB,""),-1)+1)="Could not add a LINE LEVEL ADJUSTMENT ("_IBSEQ_")"
GOTO Q40
+40 ;
+41 LOCK -^IBM(361.1,IBEOB,15)
+42 ;
+43 SET LEVEL=15.1
SET LEVEL(0)=+Y
SET LEVEL(1)=IBEOB
SET LEVEL("DIE")="^IBM(361.1,"_IBEOB_",15,"
+44 SET A="3;.04;0;0;0^4;.1;0;0;0^9;.09;0;0;0^17;.03;1;0;0^18;.11;0;1;D2^21;.18;0;0;0"
+45 IF '$PIECE(IB0,U,18)
IF $PIECE(IB0,U,16)
SET $PIECE(A,U,5)="16;.11;0;1;1"
+46 IF $$STORE^IBCEOB1(A,IB0,IBEOB,.LEVEL)
SET ^TMP($JOB,40)=LEVEL(0)
SET IBOK=1
+47 IF '$GET(IBOK)
SET ^TMP(IBEGBL,$JOB,+$ORDER(^TMP(IBEGBL,$JOB,""),-1)+1)="Bad data for line level adjustment "_IBSEQ
GOTO Q40
+48 ;
+49 ; Store modifiers in multiple
+50 SET DIC="^IBM(361.1,"_IBEOB_",15,"_LEVEL(0)_",2,"
SET DIC(0)="L"
SET DLAYGO=361.1152
SET DA(2)=IBEOB
SET DA(1)=LEVEL(0)
+51 FOR Q=5:1:8
SET X=$PIECE(IB0,U,Q)
IF X'=""
DO FILE^DICN
KILL DO,DD
IF Y<0
SET IBOK=0
QUIT
+52 KILL DLAYGO,DIC,DR,DA
+53 IF '$GET(IBOK)
SET ^TMP(IBEGBL,$JOB,+$ORDER(^TMP(IBEGBL,$JOB,""),-1)+1)="Could not file modifier data for line level adjustment "_IBSEQ
GOTO Q40
Q40 QUIT
+1 ;
41(IB0,IBEOB,IBOK) ; Process record type 41 for EOB
+1 ; IB0 = the record being processed
+2 ; IBEOB = the ien of the EOB entry in file 361.1
+3 ; IBOK = Returned as 1 if record filed OK, 0 if error occurred
+4 ;
+5 NEW DA,DR,DIE,X,Y,Z,Z0,CT
+6 IF '$GET(^TMP($JOB,40))
Begin DoDot:1
+7 SET ^TMP(IBEGBL,$JOB,+$ORDER(^TMP(IBEGBL,$JOB,""),-1)+1)="Service line adjustment (EEOB Record 41) has no matching service line"
+8 DO DET4X^IBCEOB00(41,IB0,.Z0)
+9 SET CT=+$ORDER(^TMP(IBEGBL,$JOB,""),-1)
SET Z=0
FOR
SET Z=$ORDER(Z0(Z))
if 'Z
QUIT
SET CT=CT+1
SET ^TMP(IBEGBL,$JOB,CT)=Z0(Z)
End DoDot:1
GOTO Q41
+10 ;
+11 SET DR=""
SET IBOK=1
+12 SET DA=+^TMP($JOB,40)
SET DA(1)=IBEOB
+13 SET DIE="^IBM(361.1,"_DA(1)_",15,"
+14 IF +$PIECE(IB0,U,3)
SET DR=".13///"_$$DOLLAR^IBCEOB($PIECE(IB0,U,3))
+15 IF +$PIECE(IB0,U,4)
SET DR=DR_$SELECT(DR="":"",1:";")_".14///"_$$DOLLAR^IBCEOB($PIECE(IB0,U,4))
+16 IF DR'=""
DO ^DIE
SET IBOK=($DATA(Y)=0)
+17 IF '$GET(IBOK)
SET ^TMP(IBEGBL,$JOB,+$ORDER(^TMP(IBEGBL,$JOB,""),-1)+1)="Mismatched data for service line adjustment-2 (EEOB Record 41)"
+18 ;
+19 ; For Medicare MRA's only:
+20 ; If the Allowed Amount field is present, then we need to file an
+21 ; adjustment: Group code PR, Reason code AAA, Amount, Quantity, and
+22 ; Reason Text. This is data normally found on the 45 record, so we're
+23 ; going to create our own "45" record and file it.
+24 ;
+25 IF $PIECE($GET(^IBM(361.1,IBEOB,0)),U,4)=1
IF +$PIECE(IB0,U,3)
Begin DoDot:1
+26 NEW IB45,IBSAV40
+27 SET IB45=45_U_$PIECE(IB0,U,2)_U_"PR"_U_"AAA"_U_$PIECE(IB0,U,3)_U_"0000000001"
+28 SET IB45=IB45_U_"Allowed Amount"
+29 SET IBSAV40=$GET(^TMP($JOB,40))
+30 DO 45(IB45,IBEOB,.IBOK)
+31 SET ^TMP($JOB,40)=IBSAV40
+32 IF '$GET(IBOK)
SET ^TMP(IBEGBL,$JOB,+$ORDER(^TMP(IBEGBL,$JOB,""),-1)+1)="Could not file the PR-AAA adjustment for the Allowed Amount at line "_+^TMP($JOB,40)
+33 QUIT
End DoDot:1
+34 ;
Q41 QUIT
+1 ;
42(IB0,IBEOB,IBOK) ; Process record type 42 for EOB
+1 ; IB0 = the record being processed
+2 ; IBEOB = the ien of the EOB entry in file 361.1
+3 ; IBOK = Returned as 1 if record filed OK, 0 if error occurred
+4 ;
+5 NEW DO,DD,DLAYGO,DIC,DA,X,Y,Z,Z0,CT
+6 SET IBOK=0
+7 IF '$GET(^TMP($JOB,40))
Begin DoDot:1
+8 SET ^TMP(IBEGBL,$JOB,+$ORDER(^TMP(IBEGBL,$JOB,""),-1)+1)="Service line adjustment (EEOB Record 42) has no matching service line"
+9 DO DET4X^IBCEOB00(42,IB0,.Z0)
+10 SET CT=+$ORDER(^TMP(IBEGBL,$JOB,""),-1)
SET Z=0
FOR
SET Z=$ORDER(Z0(Z))
if 'Z
QUIT
SET CT=CT+1
SET ^TMP(IBEGBL,$JOB,CT)=Z0(Z)
End DoDot:1
GOTO Q42
+11 ;
+12 KILL DO,DD,DLAYGO
+13 SET IBOK=1
+14 SET DA(1)=+^TMP($JOB,40)
SET DA(2)=IBEOB
+15 SET X=+$ORDER(^IBM(361.1,DA(2),15,DA(1),4," "),-1)+1
SET DIC="^IBM(361.1,"_DA(2)_",15,"_DA(1)_",4,"
SET DIC(0)="L"
SET DLAYGO=361.1154
+16 SET DIC("DR")=$SELECT($PIECE(IB0,U,3)'="":".02////"_$PIECE(IB0,U,3),1:"")
+17 IF $PIECE(IB0,U,4)'=""
if $LENGTH(DIC("DR"))
SET DIC("DR")=DIC("DR")_";"
SET DIC("DR")=DIC("DR")_".03////"_$TRANSLATE($PIECE(IB0,U,4),";"," ")
+18 DO FILE^DICN
KILL DO,DD,DLAYGO
+19 IF Y'>0
SET IBOK=0
+20 IF '$GET(IBOK)
SET ^TMP(IBEGBL,$JOB,+$ORDER(^TMP(IBEGBL,$JOB,""),-1)+1)="Mismatched data for service line adjustment-3 (EEOB Record 42)"
+21 ;
+22 ; For Medicare MRA's only:
+23 ; Process and store the line level remark code as an LQ kludge line
+24 ; level adjustment.
+25 ;
+26 IF $PIECE($GET(^IBM(361.1,IBEOB,0)),U,4)=1
IF $PIECE(IB0,U,3)'=""
Begin DoDot:1
+27 NEW IB45,IBSAV40
+28 SET IB45=45_U_$PIECE(IB0,U,2)_U_"LQ"_U_$PIECE(IB0,U,3)_U_0_U_0_U_$PIECE(IB0,U,4)
+29 SET IBSAV40=$GET(^TMP($JOB,40))
+30 DO 45(IB45,IBEOB,.IBOK)
+31 SET ^TMP($JOB,40)=IBSAV40
+32 IF '$GET(IBOK)
SET ^TMP(IBEGBL,$JOB,+$ORDER(^TMP(IBEGBL,$JOB,""),-1)+1)="Could not file the LQ-remark code adjustment at line "_+^TMP($JOB,40)
+33 QUIT
End DoDot:1
Q42 QUIT
+1 ;
45(IB0,IBEOB,IBOK) ; Process record type 45 for EOB
+1 ; IB0 = the record being processed
+2 ; IBEOB = the ien of the EOB entry in file 361.1
+3 ; IBOK = Returned as 1 if record filed OK, 0 if error occurred
+4 ;
+5 NEW IBDA,LEVEL,A,Z0,CT,Z
+6 IF '$GET(^TMP($JOB,40))
Begin DoDot:1
+7 SET ^TMP(IBEGBL,$JOB,+$ORDER(^TMP(IBEGBL,$JOB,""),-1)+1)="Service line adjustment (EEOB Record 45) has no matching service line"
+8 DO DET4X^IBCEOB00(45,IB0,.Z0)
+9 SET CT=+$ORDER(^TMP(IBEGBL,$JOB,""),-1)
SET Z=0
FOR
SET Z=$ORDER(Z0(Z))
if 'Z
QUIT
SET CT=CT+1
SET ^TMP(IBEGBL,$JOB,CT)=Z0(Z)
End DoDot:1
GOTO Q45
+10 ;
+11 IF $PIECE(IB0,U,3)'=""
SET $PIECE(^TMP($JOB,40),U,2)=$PIECE(IB0,U,3)
+12 IF $PIECE(IB0,U,3)=""
SET $PIECE(IB0,U,3)=$PIECE(^TMP($JOB,40),U,2)
+13 IF $PIECE(IB0,U,3)=""
SET ^TMP(IBEGBL,$JOB,+$ORDER(^TMP(IBEGBL,$JOB,""),-1)+1)="Service line adjustment (EEOB Record 45) is missing its group code"
GOTO Q45
+14 ;
+15 SET IBDA(2)=+^TMP($JOB,40)
+16 SET IBDA(1)=+$ORDER(^IBM(361.1,IBEOB,15,IBDA(2),1,"B",$PIECE(IB0,U,3),0))
+17 ;
+18 ;Needs a new entry at group level
IF 'IBDA(1)
Begin DoDot:1
+19 NEW X,Y,DA,DD,DO,DIC,DLAYGO
+20 SET DIC="^IBM(361.1,"_IBEOB_",15,"_IBDA(2)_",1,"
SET DIC(0)="L"
SET DLAYGO=361.1151
SET DA(2)=IBEOB
SET DA(1)=IBDA(2)
+21 SET DIC("P")=$$GETSPEC^IBEFUNC(361.115,1)
+22 SET X=$PIECE(IB0,U,3)
+23 DO FILE^DICN
KILL DIC,DO,DD,DLAYGO
+24 IF Y<0
KILL IBDA
SET ^TMP(IBEGBL,$JOB,+$ORDER(^TMP(IBEGBL,$JOB,""),-1)+1)="Could not add adjustment group code ("_$PIECE(IB0,U,3)_") at line adjustment "_+^TMP($JOB,40)
QUIT
+25 SET IBDA(1)=+Y
End DoDot:1
+26 ;
+27 ;Add a new entry at the reason code level
+28 IF $GET(IBDA(1))
Begin DoDot:1
+29 SET DIC="^IBM(361.1,"_IBEOB_",15,"_IBDA(2)_",1,"_IBDA(1)_",1,"
SET DIC(0)="L"
SET DLAYGO=361.11511
SET DA(1)=IBDA(1)
SET DA(2)=IBDA(2)
SET DA(3)=IBEOB
+30 SET DIC("P")=$$GETSPEC^IBEFUNC(361.1151,1)
+31 SET X=$PIECE(IB0,U,4)
+32 DO FILE^DICN
KILL DIC,DO,DD,DLAYGO
+33 IF Y<0
KILL IBDA
SET ^TMP(IBEGBL,$JOB,+$ORDER(^TMP(IBEGBL,$JOB,""),-1)+1)="Could not add reason code ("_$PIECE(IB0,U,4)_") for adjustment group code ("_$PIECE(IB0,U,3)_") at line adjustment "_+^TMP($JOB,40)
QUIT
+34 SET IBDA=+Y
End DoDot:1
+35 ;
+36 IF $GET(IBDA)
Begin DoDot:1
+37 SET LEVEL=15
SET LEVEL("DIE")="^IBM(361.1,"_IBEOB_",15,"_IBDA(2)_",1,"_IBDA(1)_",1,"
+38 SET LEVEL(0)=IBDA
SET LEVEL(1)=IBDA(1)
SET LEVEL(2)=IBDA(2)
SET LEVEL(3)=IBEOB
+39 SET A="5;.02;1;0;0^6;.03;0;1;1^7;.04;0;1;0"
+40 SET IBOK=$$STORE^IBCEOB1(A,IB0,IBEOB,.LEVEL)
+41 IF 'IBOK
SET ^TMP(IBEGBL,$JOB,+$ORDER(^TMP(IBEGBL,$JOB,""),-1)+1)="Mismatched data for reason code ("_$PIECE(IB0,U,4)_"), adjustment group code ("_$PIECE(IB0,U,3)_") at line adjustment "_+^TMP($JOB,40)
QUIT
End DoDot:1
+42 ;
Q45 QUIT
+1 ;
46(IB0,IBEOB,IBOK) ; Process record type 46 for EOB
+1 ; IB0 = the record being processed
+2 ; IBEOB = the ien of the EOB entry in file 361.1
+3 ; IBOK = Returned as 1 if record filed OK, 0 if error occurred
+4 ;
+5 SET IBOK=0
+6 NEW AGC,IBDA,LEVEL,A,Z0,CT,Z
+7 IF '$GET(^TMP($JOB,40))
Begin DoDot:1
+8 SET ^TMP(IBEGBL,$JOB,+$ORDER(^TMP(IBEGBL,$JOB,""),-1)+1)="Service line adjustment (EEOB Record 46) has no matching service line"
+9 DO DET4X^IBCEOB00(46,IB0,.Z0)
+10 ;S CT=+$O(^TMP(IBEGBL,$J,""),-1),Z=0 F S Z=$O(Z0(Z)) Q:'Z S CT=CT+1,^TMP(IBEGBL,$J,CT)=Z0(Z)
End DoDot:1
GOTO Q46
+11 ;
+12 SET AGC=$PIECE(^TMP($JOB,40),U,2)
+13 IF AGC=""
SET ^TMP(IBEGBL,$JOB,+$ORDER(^TMP(IBEGBL,$JOB,""),-1)+1)="Service line adjustment (EEOB Record 46) is missing its group code"
GOTO Q46
+14 ;
+15 SET IBDA(2)=+^TMP($JOB,40)
+16 SET IBDA(1)=+$ORDER(^IBM(361.1,IBEOB,15,IBDA(2),1,"B",AGC,0))
+17 ;
+18 ;
+19 ;Add a new entry at the Payer Policy level
+20 IF $GET(IBDA(1))
Begin DoDot:1
+21 SET DIC="^IBM(361.1,"_IBEOB_",15,"_IBDA(2)_",1,"_IBDA(1)_",2,"
SET DIC(0)="L"
SET DLAYGO=361.11511
SET DA(1)=IBDA(1)
SET DA(2)=IBDA(2)
SET DA(3)=IBEOB
+22 SET DIC("P")=$$GETSPEC^IBEFUNC(361.1151,1)
+23 SET X=$PIECE(IB0,U,3)
+24 DO FILE^DICN
KILL DIC,DO,DD,DLAYGO
+25 IF Y<0
KILL IBDA
SET ^TMP(IBEGBL,$JOB,+$ORDER(^TMP(IBEGBL,$JOB,""),-1)+1)="Could not add payer policy ("_$PIECE(IB0,U,4)_") for adjustment group code ("_$PIECE(IB0,U,3)_") at line adjustment "_+^TMP($JOB,40)
QUIT
+26 SET IBDA=+Y
SET IBOK=1
End DoDot:1
+27 ;
Q46 QUIT
+1 ;
+2 ; IB*2.0*633 - Begin modified code block
ERRTXT(X,IBEOB) ; Set error text based on circumstances
+1 ; Input - X = Standard Error message passed in
+2 ; IB0
+3 ; Returns modified error message text
+4 NEW RETURN
+5 SET RETURN="Mismatched "_X_":"
+6 IF '$$EBILL(IBEOB)
SET RETURN="Claim was not Billed Electronically:"
+7 QUIT RETURN
+8 ;
EBILL(IBEOB) ; Check If EOB was billed electronically
+1 ; Input : IBEOB = Internal entry number from file 361.1
+2 ; Returns : 1 - Billed electronically
+3 ; 0 - Not billed electronically
+4 NEW IEN399,IEN364,STATUS
+5 SET IEN399=$$GET1^DIQ(361.1,IBEOB_",",.01,"I")
+6 SET IEN364=$ORDER(^IBA(364,"B",+IEN399,0))
+7 ; No EDI TRANSMIT BILL
IF 'IEN364
QUIT 0
+8 ;
+9 SET STATUS=$$GET1^DIQ(364,IEN364,.03,"I")
+10 ; Error or canceled
IF STATUS="E"!(STATUS="C")
QUIT 0
+11 QUIT 1
+12 ; IB*2.0*633 - End modified code block
