- 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 Apr 23, 2025@18:25:51 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
