IBCEOB00 ;ALB/ESG/PJH - 835 EDI EOB MSG PROCESSING CONT ;30-JUN-2003
;;2.0;INTEGRATED BILLING;**155,349,377,431,488,521**;21-MAR-94;Build 33
;;Per VA Directive 6402, this routine should not be modified.
Q
;
RCRU(IBZDATA,IB0,IBLN) ; Revenue Code Roll-up procedure check -
; Total up outbound line items by revenue code and compare with
; incoming EOB 40 record to see if it has been rolled up
;
; IBZDATA - UB output formatter array, passed by reference
; IB0 - 40 record data
; IBLN - output parameter, passed by reference
;
NEW Z,LN,REV,UN,CH,RUD,RUD2,UCH,MRAUCH
I $P(IB0,U,4)="" G RCRUX
S IBLN="",Z=0
F S Z=$O(IBZDATA(Z)) Q:'Z S LN=IBZDATA(Z) D
. S REV=$P(LN,U,1),UN=$P(LN,U,4),CH=$P(LN,U,5),UCH=+$P(LN,U,3)
. I REV="" Q
. ;
. S RUD=$G(RUD(REV)) ; roll up data array for rev code
. S $P(RUD,U,1)=$P(RUD,U,1)+CH ; total charges
. S $P(RUD,U,2)=$P(RUD,U,2)+UN ; total units
. S $P(RUD,U,3)=$P(RUD,U,3)+1 ; total line items
. S RUD(REV)=RUD
. S RUD(REV,Z)=""
. ;
. S RUD2=$G(RUD2(REV,UCH)) ; roll up data array for rev code
. S $P(RUD2,U,1)=$P(RUD2,U,1)+CH ; total charges
. S $P(RUD2,U,2)=$P(RUD2,U,2)+UN ; total units
. S $P(RUD2,U,3)=$P(RUD2,U,3)+1 ; total line items
. S RUD2(REV,UCH)=RUD2
. S RUD2(REV,UCH,Z)=""
. ;
. Q
;
I '$D(RUD),'$D(RUD2) G RCRUX
;
; delete the revenue code roll-up, if only 1 line item.
S REV="" ; this is not a roll up situation
F S REV=$O(RUD(REV)) Q:REV="" I $P(RUD(REV),U,3)=1 KILL RUD(REV)
;
S (REV,UCH)=""
F S REV=$O(RUD2(REV)) Q:REV="" F S UCH=$O(RUD2(REV,UCH)) Q:UCH="" I $P(RUD2(REV,UCH),U,3)=1 KILL RUD2(REV,UCH)
;
I '$D(RUD),'$D(RUD2) G RCRUX
;
S RUD=$G(RUD($P(IB0,U,4))) ; compare with 40 record data
I RUD="" G RCRU2 ; make sure it exists
I $P(RUD,U,1)'=+$$DOLLAR^IBCEOB($P(IB0,U,15)) G RCRU2 ; charges
I $P(RUD,U,2)'=$P(IB0,U,16) G RCRU2 ; units
S IBLN=$O(RUD($P(IB0,U,4),"")) ; use the first line# found
G RCRUX
;
RCRU2 ; check roll-up data by rev code and unit charge
S MRAUCH=0
I $P(IB0,U,16) S MRAUCH=+$$DOLLAR^IBCEOB($P(IB0,U,15))/$P(IB0,U,16)
S RUD2=$G(RUD2($P(IB0,U,4),MRAUCH)) ; compare with 40 record data
I RUD2="" G RCRUX ; make sure it exists
I $P(RUD2,U,1)'=+$$DOLLAR^IBCEOB($P(IB0,U,15)) G RCRUX ; charges
I $P(RUD2,U,2)'=$P(IB0,U,16) G RCRUX ; units
S IBLN=$O(RUD2($P(IB0,U,4),MRAUCH,"")) ; use the first line# found
;
RCRUX ;
Q
;
ICN(IBEOB,ICN,COBN,IBOK) ; File the 835 ICN into the Bill
;
; Input parameters
; IBEOB - ien to file 361.1
; ICN - the ICN# from the 835 transmission
; COBN - the insurance sequence#
;
; Output parameter
; IBOK - returns as 0 if we get a filing error here
;
; The field in file 399 depends on the current payer sequence
; 399,453 - primary ICN
; 399,454 - secondary ICN
; 399,455 - tertiary ICN
;
NEW IBIFN,FIELD,D,D0,DA,DI,DIC,DIE,DQ,DR,X,Y
S IBEOB=+$G(IBEOB),COBN=+$G(COBN)
I 'IBEOB!'COBN G ICNX
S IBIFN=+$P($G(^IBM(361.1,IBEOB,0)),U,1)
I '$D(^DGCR(399,IBIFN)) G ICNX
I $G(ICN)="" G ICNX
I '$F(".1.2.3.","."_COBN_".") G ICNX
;
S FIELD=452+COBN
S DIE=399,DA=IBIFN,DR=FIELD_"////"_ICN D ^DIE
S IBOK=($D(Y)=0)
I 'IBOK S ^TMP(IBEGBL,$J,+$O(^TMP(IBEGBL,$J,""),-1)+1)="Error in filing the ICN into the Bill/Claims file"
ICNX ;
Q
;
15(IB0,IBEGBL,IBEOB) ; Record '15'
;
N A,IBOK
;
;IB*2.0*521/ZEB Added piece 11/field 2.06 for HPID
S A="3;1.03;1;0;0^4;1.04;1;0;0^5;1.05;1;0;0^6;1.07;1;0;0^7;1.08;1;0;0^8;1.09;1;0;0^9;1.02;1;0;0^10;2.05;1;0;0^11;2.06;0;0;0"
;
S IBOK=$$STORE^IBCEOB1(A,IB0,IBEOB)
I 'IBOK S ^TMP(IBEGBL,$J,+$O(^TMP(IBEGBL,$J,""),-1)+1)="Bad record 15 data" G Q15
;
; For Medicare MRA's only:
; If the Covered Amount is present (15 record, piece 3), then file
; a claim level adjustment with Group code=OA, Reason code=AB3.
;
I $P($G(^IBM(361.1,IBEOB,0)),U,4)=1,+$P(IB0,U,3) D
. N IB20
. S IB20=20_U_$P(IB0,U,2)_U_"OA"_U_"AB3"_U_$P(IB0,U,3)_U_"0000000000"
. S IB20=IB20_U_"Covered Amount"
. S IBOK=$$20(IB20,IBEGBL,IBEOB)
. I 'IBOK S ^TMP(IBEGBL,$J,+$O(^TMP(IBEGBL,$J,""),-1)+1)="Could not file the OA-AB3 claim level adjustment for the Covered Amount"
. K ^TMP($J,20)
. Q
;
Q15 Q IBOK
;
20(IB0,IBEGBL,IBEOB) ; Record '20'
;
N A,LEVEL,IBGRP,IBDA,IBOK
;
S IBGRP=$P(IB0,U,3)
I IBGRP'="" S ^TMP($J,20)=IBGRP
I IBGRP="" S IBGRP=$G(^TMP($J,20))
I IBGRP="" S ^TMP(IBEGBL,$J,+$O(^TMP(IBEGBL,$J,""),-1)+1)="Missing claim level adjustment group code" G Q20
;
S IBDA(1)=$O(^IBM(361.1,IBEOB,10,"B",IBGRP,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_",10,",DIC(0)="L",DLAYGO=361.11,DA(1)=IBEOB
. S DIC("P")=$$GETSPEC^IBEFUNC(361.1,10)
. S X=IBGRP
. D FILE^DICN K DIC,DO,DD,DLAYGO
. I Y<0 K IBDA S ^TMP(IBEGBL,$J,+$O(^TMP(IBEGBL,$J,""),-1)+1)="Adjustment group code could not be added" Q
. S IBDA(1)=+Y
;
I $G(IBDA(1)) D ;Add a new entry at the reason code level
. S DIC="^IBM(361.1,"_IBEOB_",10,"_IBDA(1)_",1,",DIC(0)="L",DLAYGO=361.111,DA(2)=IBEOB,DA(1)=IBDA(1)
. S DIC("P")=$$GETSPEC^IBEFUNC(361.11,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)="Adjustment reason code could not be added" Q
. S IBDA=+Y
;
I $G(IBDA) D
. S LEVEL=10,LEVEL("DIE")="^IBM(361.1,"_IBEOB_",10,"_IBDA(1)_",1,"
. S LEVEL(0)=IBDA,LEVEL(1)=IBDA(1),LEVEL(2)=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)="Bad adjustment reason code ("_$P(IB0,U,4)_") data" Q
Q20 Q $G(IBOK)
;
35(IB0,IBEGBL,IBEOB) ; Record '35'
;
N A,IBOK
;
S A="3;4.12;1;0;0^4;4.13;1;0;0^5;4.14;0;1;1^6;4.15;1;0;0^7;4.16;1;0;0^8;4.17;1;0;0^9;4.18;1;0;0^10;4.04;1;0;0^11;3.01;0;1;1^12;3.02;1;0;0^13;3.08;1;0;0^14;3.09;1;0;0"
;
S IBOK=$$STORE^IBCEOB1(A,IB0,IBEOB)
I 'IBOK S ^TMP(IBEGBL,$J,+$O(^TMP(IBEGBL,$J,""),-1)+1)="Bad MEDICARE Inpt Adjudication data"
Q35 Q $G(IBOK)
;
37(IB0,IBEGBL,IBEOB) ; Record '37'
;
N IBOK,IBCT
S IBCT=$G(^TMP($J,37))+1
I IBCT>5 S ^TMP(IBEGBL,$J,+$O(^TMP(IBEGBL,$J,""),-1)+1)="Too many Medicare Claim Level Adjudication Remarks" G Q37 ; Max 5 allowed
S A="4;"_$S($P(IB0,U,3)="O":"3.0"_(IBCT+2),1:"5.0"_IBCT)_";0;0;0^5;5.0"_IBCT_"1;0;0;0"
S IBOK=$$STORE^IBCEOB1(A,IB0,IBEOB)
I 'IBOK S ^TMP(IBEGBL,$J,+$O(^TMP(IBEGBL,$J,""),-1)+1)="Bad Medicare Claim Level Adjudication Remarks data"
;
; 4/22/03 - esg - If claim level remark code MA15 is reported, then
; this is a split EOB and we need to change the REVIEW STATUS
; of this EOB to be ACCEPTED-INTERIM EOB.
;
I $P(IB0,U,4)["MA15" D
. N DA,DIE,DR,DIC
. S DA=IBEOB,DIE=361.1,DR=".16////2" D ^DIE S IBOK=($D(Y)=0)
. I 'IBOK S ^TMP(IBEGBL,$J,+$O(^TMP(IBEGBL,$J,""),-1)+1)="Split EOB, but review status was not updated correctly"
. Q
;
Q37 S ^TMP($J,37)=$G(^TMP($J,37))+1 ; Saves the # of entries for 37 records
Q $G(IBOK)
;
;
DET40(IB0,ARRAY,ERRCOD) ; Format important details of record 40 for error
; IB0 = data on 40 record (some pieces pre-formatted)
; ARRAY(n)=formatted line is returned if passed by ref
N Q,IBBNDL
S IBBNDL=$S($P(IB0,U,10)'="":1,1:0) ; Determine if Bundled or Not Bundled.
;
S ARRAY(1)="Payer reported the following was billed to them via the Claim (837):"
S ARRAY(2)="Proc/Rev CD: "
; If this is a Procedure Code mismatch and there is nothing in piece 10 show "UNK" otherwise show the mismatched Procedure Code.
S ARRAY(2)=ARRAY(2)_$S(+ERRCOD=2:$S($P(IB0,U,10)'="":$P(IB0,U,10),1:"UNK "),1:$S($P(IB0,U,10)'="":$P(IB0,U,10),1:$P(IB0,U,3)))
S ARRAY(2)=ARRAY(2)_" Mods:"
I $P(IB0,U,11)="" D
. ; If there is nothing in piece 11 and this is a modified mismatch, show the value from the comparison checking that occurred.
. I +ERRCOD=5 S ARRAY(2)=ARRAY(2)_$P(ERRCOD,U,2) Q
. ; If there is nothing in piece 11 and this is not a modifier mismatch, show what is in piece 5-8
. F Q=5:1:8 I $P(IB0,U,Q)'="" S ARRAY(2)=ARRAY(2)_$P(IB0,U,Q)_$S(Q=8:"",$P(IB0,U,Q+1)'="":",",1:"")
I $P(IB0,U,11)'="" D
. F Q=11:1:14 I $P(IB0,U,Q)'="" S ARRAY(2)=ARRAY(2)_$P(IB0,U,Q)_$S(Q=14:"",$P(IB0,U,Q+1)'="":",",1:"")
S $E(ARRAY(2),37)="Chg: "_$J($P(IB0,U,15)/100,"",2)
S $E(ARRAY(2),64)="Units:"_$S($P(IB0,U,16):$P(IB0,U,16),1:"")
S ARRAY(3)="Payer reported the following was used for adjudication via the EEOB (835):"
S ARRAY(4)="Proc/Rev CD: "_$P(IB0,U,3)_" Mods:"
I 'IBBNDL D ; If not bundled.
. I $P(IB0,U,5)="" S ARRAY(4)=ARRAY(4)_"UNK" Q ; If no modifiers found, show "UNK" for Unknown.
. F Q=5:1:8 I $P(IB0,U,Q)'="" S ARRAY(4)=ARRAY(4)_$P(IB0,U,Q)_$S(Q=8:"",$P(IB0,U,Q+1)'="":",",1:"")
I IBBNDL D ; If bundled.
. I $P(IB0,U,11)="" S ARRAY(4)=ARRAY(4)_"UNK" Q ; If no modifiers found, show "UNK" for Unknown.
. F Q=11:1:14 I $P(IB0,U,Q)'="" S ARRAY(4)=ARRAY(4)_$P(IB0,U,Q)_$S(Q=14:"",$P(IB0,U,Q+1)'="":",",1:"")
S $E(ARRAY(4),37)="Amt Pd: "_$J($P(IB0,U,17)/100,"",2)
S $E(ARRAY(4),64)="Cov Units:"_$S($P(IB0,U,18):$P(IB0,U,18)/100,1:1)
S ARRAY(5)=" "
Q
;
DET4X(RECID,IB0,ARRAY) ; Format important details of record 41-46 for error
; RECID = 41,42,45,46
; IB0 = data on RECID record
; ARRAY(n)=formatted line is returned if passed by ref
N CT,Q
I RECID=41 D Q
. S ARRAY(1)=" Allowed Amt: "_$J($P(IB0,U,3)/100,"",2)_" Per Diem Amt: "_$J($P(IB0,U,4)/100,"",2)
;
I RECID=42 D Q
. S ARRAY(1)=" Line Item Remark Code: "_$P(IB0,U,3)
. I $P(IB0,U,4)'="" S CT=1 F Q=0:80:190 I $E($P(IB0,U,4),Q+1,Q+80)'="" S CT=CT+1,ARRAY(CT)=$E($P(IB0,U,4),Q+1,Q+80)
;
I RECID=45 D
. S ARRAY(1)=" Adj Group Cd: "_$P(IB0,U,3)_" Reason Cd: "_$P(IB0,U,4)_" Amt: "_$J($P(IB0,U,5)/100,"",2)_" Quantity: "_+$P(IB0,U,6)
. I $P(IB0,U,7)'="" S CT=1 F Q=0:80:190 I $E($P(IB0,U,7),Q+1,Q+80)'="" S CT=CT+1,ARRAY(CT)=$E($P(IB0,U,7),Q+1,Q+80)
;
I RECID=46 D
. S ARRAY(1)=" Payer Policy Reference: "_$P(IB0,U,3)
Q
;
FDT(X) ; Format date in X (YYYYMMDD) to MM/DD/YYYY
S:X'="" X=$E(X,5,6)_"/"_$E(X,7,8)_"/"_$E(X,1,4)
Q X
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HIBCEOB00 10346 printed Apr 09, 2024@21:38:31 Page 2
IBCEOB00 ;ALB/ESG/PJH - 835 EDI EOB MSG PROCESSING CONT ;30-JUN-2003
+1 ;;2.0;INTEGRATED BILLING;**155,349,377,431,488,521**;21-MAR-94;Build 33
+2 ;;Per VA Directive 6402, this routine should not be modified.
+3 QUIT
+4 ;
RCRU(IBZDATA,IB0,IBLN) ; Revenue Code Roll-up procedure check -
+1 ; Total up outbound line items by revenue code and compare with
+2 ; incoming EOB 40 record to see if it has been rolled up
+3 ;
+4 ; IBZDATA - UB output formatter array, passed by reference
+5 ; IB0 - 40 record data
+6 ; IBLN - output parameter, passed by reference
+7 ;
+8 NEW Z,LN,REV,UN,CH,RUD,RUD2,UCH,MRAUCH
+9 IF $PIECE(IB0,U,4)=""
GOTO RCRUX
+10 SET IBLN=""
SET Z=0
+11 FOR
SET Z=$ORDER(IBZDATA(Z))
if 'Z
QUIT
SET LN=IBZDATA(Z)
Begin DoDot:1
+12 SET REV=$PIECE(LN,U,1)
SET UN=$PIECE(LN,U,4)
SET CH=$PIECE(LN,U,5)
SET UCH=+$PIECE(LN,U,3)
+13 IF REV=""
QUIT
+14 ;
+15 ; roll up data array for rev code
SET RUD=$GET(RUD(REV))
+16 ; total charges
SET $PIECE(RUD,U,1)=$PIECE(RUD,U,1)+CH
+17 ; total units
SET $PIECE(RUD,U,2)=$PIECE(RUD,U,2)+UN
+18 ; total line items
SET $PIECE(RUD,U,3)=$PIECE(RUD,U,3)+1
+19 SET RUD(REV)=RUD
+20 SET RUD(REV,Z)=""
+21 ;
+22 ; roll up data array for rev code
SET RUD2=$GET(RUD2(REV,UCH))
+23 ; total charges
SET $PIECE(RUD2,U,1)=$PIECE(RUD2,U,1)+CH
+24 ; total units
SET $PIECE(RUD2,U,2)=$PIECE(RUD2,U,2)+UN
+25 ; total line items
SET $PIECE(RUD2,U,3)=$PIECE(RUD2,U,3)+1
+26 SET RUD2(REV,UCH)=RUD2
+27 SET RUD2(REV,UCH,Z)=""
+28 ;
+29 QUIT
End DoDot:1
+30 ;
+31 IF '$DATA(RUD)
IF '$DATA(RUD2)
GOTO RCRUX
+32 ;
+33 ; delete the revenue code roll-up, if only 1 line item.
+34 ; this is not a roll up situation
SET REV=""
+35 FOR
SET REV=$ORDER(RUD(REV))
if REV=""
QUIT
IF $PIECE(RUD(REV),U,3)=1
KILL RUD(REV)
+36 ;
+37 SET (REV,UCH)=""
+38 FOR
SET REV=$ORDER(RUD2(REV))
if REV=""
QUIT
FOR
SET UCH=$ORDER(RUD2(REV,UCH))
if UCH=""
QUIT
IF $PIECE(RUD2(REV,UCH),U,3)=1
KILL RUD2(REV,UCH)
+39 ;
+40 IF '$DATA(RUD)
IF '$DATA(RUD2)
GOTO RCRUX
+41 ;
+42 ; compare with 40 record data
SET RUD=$GET(RUD($PIECE(IB0,U,4)))
+43 ; make sure it exists
IF RUD=""
GOTO RCRU2
+44 ; charges
IF $PIECE(RUD,U,1)'=+$$DOLLAR^IBCEOB($PIECE(IB0,U,15))
GOTO RCRU2
+45 ; units
IF $PIECE(RUD,U,2)'=$PIECE(IB0,U,16)
GOTO RCRU2
+46 ; use the first line# found
SET IBLN=$ORDER(RUD($PIECE(IB0,U,4),""))
+47 GOTO RCRUX
+48 ;
RCRU2 ; check roll-up data by rev code and unit charge
+1 SET MRAUCH=0
+2 IF $PIECE(IB0,U,16)
SET MRAUCH=+$$DOLLAR^IBCEOB($PIECE(IB0,U,15))/$PIECE(IB0,U,16)
+3 ; compare with 40 record data
SET RUD2=$GET(RUD2($PIECE(IB0,U,4),MRAUCH))
+4 ; make sure it exists
IF RUD2=""
GOTO RCRUX
+5 ; charges
IF $PIECE(RUD2,U,1)'=+$$DOLLAR^IBCEOB($PIECE(IB0,U,15))
GOTO RCRUX
+6 ; units
IF $PIECE(RUD2,U,2)'=$PIECE(IB0,U,16)
GOTO RCRUX
+7 ; use the first line# found
SET IBLN=$ORDER(RUD2($PIECE(IB0,U,4),MRAUCH,""))
+8 ;
RCRUX ;
+1 QUIT
+2 ;
ICN(IBEOB,ICN,COBN,IBOK) ; File the 835 ICN into the Bill
+1 ;
+2 ; Input parameters
+3 ; IBEOB - ien to file 361.1
+4 ; ICN - the ICN# from the 835 transmission
+5 ; COBN - the insurance sequence#
+6 ;
+7 ; Output parameter
+8 ; IBOK - returns as 0 if we get a filing error here
+9 ;
+10 ; The field in file 399 depends on the current payer sequence
+11 ; 399,453 - primary ICN
+12 ; 399,454 - secondary ICN
+13 ; 399,455 - tertiary ICN
+14 ;
+15 NEW IBIFN,FIELD,D,D0,DA,DI,DIC,DIE,DQ,DR,X,Y
+16 SET IBEOB=+$GET(IBEOB)
SET COBN=+$GET(COBN)
+17 IF 'IBEOB!'COBN
GOTO ICNX
+18 SET IBIFN=+$PIECE($GET(^IBM(361.1,IBEOB,0)),U,1)
+19 IF '$DATA(^DGCR(399,IBIFN))
GOTO ICNX
+20 IF $GET(ICN)=""
GOTO ICNX
+21 IF '$FIND(".1.2.3.","."_COBN_".")
GOTO ICNX
+22 ;
+23 SET FIELD=452+COBN
+24 SET DIE=399
SET DA=IBIFN
SET DR=FIELD_"////"_ICN
DO ^DIE
+25 SET IBOK=($DATA(Y)=0)
+26 IF 'IBOK
SET ^TMP(IBEGBL,$JOB,+$ORDER(^TMP(IBEGBL,$JOB,""),-1)+1)="Error in filing the ICN into the Bill/Claims file"
ICNX ;
+1 QUIT
+2 ;
15(IB0,IBEGBL,IBEOB) ; Record '15'
+1 ;
+2 NEW A,IBOK
+3 ;
+4 ;IB*2.0*521/ZEB Added piece 11/field 2.06 for HPID
+5 SET A="3;1.03;1;0;0^4;1.04;1;0;0^5;1.05;1;0;0^6;1.07;1;0;0^7;1.08;1;0;0^8;1.09;1;0;0^9;1.02;1;0;0^10;2.05;1;0;0^11;2.06;0;0;0"
+6 ;
+7 SET IBOK=$$STORE^IBCEOB1(A,IB0,IBEOB)
+8 IF 'IBOK
SET ^TMP(IBEGBL,$JOB,+$ORDER(^TMP(IBEGBL,$JOB,""),-1)+1)="Bad record 15 data"
GOTO Q15
+9 ;
+10 ; For Medicare MRA's only:
+11 ; If the Covered Amount is present (15 record, piece 3), then file
+12 ; a claim level adjustment with Group code=OA, Reason code=AB3.
+13 ;
+14 IF $PIECE($GET(^IBM(361.1,IBEOB,0)),U,4)=1
IF +$PIECE(IB0,U,3)
Begin DoDot:1
+15 NEW IB20
+16 SET IB20=20_U_$PIECE(IB0,U,2)_U_"OA"_U_"AB3"_U_$PIECE(IB0,U,3)_U_"0000000000"
+17 SET IB20=IB20_U_"Covered Amount"
+18 SET IBOK=$$20(IB20,IBEGBL,IBEOB)
+19 IF 'IBOK
SET ^TMP(IBEGBL,$JOB,+$ORDER(^TMP(IBEGBL,$JOB,""),-1)+1)="Could not file the OA-AB3 claim level adjustment for the Covered Amount"
+20 KILL ^TMP($JOB,20)
+21 QUIT
End DoDot:1
+22 ;
Q15 QUIT IBOK
+1 ;
20(IB0,IBEGBL,IBEOB) ; Record '20'
+1 ;
+2 NEW A,LEVEL,IBGRP,IBDA,IBOK
+3 ;
+4 SET IBGRP=$PIECE(IB0,U,3)
+5 IF IBGRP'=""
SET ^TMP($JOB,20)=IBGRP
+6 IF IBGRP=""
SET IBGRP=$GET(^TMP($JOB,20))
+7 IF IBGRP=""
SET ^TMP(IBEGBL,$JOB,+$ORDER(^TMP(IBEGBL,$JOB,""),-1)+1)="Missing claim level adjustment group code"
GOTO Q20
+8 ;
+9 SET IBDA(1)=$ORDER(^IBM(361.1,IBEOB,10,"B",IBGRP,0))
+10 ;
+11 ;Needs a new entry at group level
IF 'IBDA(1)
Begin DoDot:1
+12 NEW X,Y,DA,DD,DO,DIC,DLAYGO
+13 SET DIC="^IBM(361.1,"_IBEOB_",10,"
SET DIC(0)="L"
SET DLAYGO=361.11
SET DA(1)=IBEOB
+14 SET DIC("P")=$$GETSPEC^IBEFUNC(361.1,10)
+15 SET X=IBGRP
+16 DO FILE^DICN
KILL DIC,DO,DD,DLAYGO
+17 IF Y<0
KILL IBDA
SET ^TMP(IBEGBL,$JOB,+$ORDER(^TMP(IBEGBL,$JOB,""),-1)+1)="Adjustment group code could not be added"
QUIT
+18 SET IBDA(1)=+Y
End DoDot:1
+19 ;
+20 ;Add a new entry at the reason code level
IF $GET(IBDA(1))
Begin DoDot:1
+21 SET DIC="^IBM(361.1,"_IBEOB_",10,"_IBDA(1)_",1,"
SET DIC(0)="L"
SET DLAYGO=361.111
SET DA(2)=IBEOB
SET DA(1)=IBDA(1)
+22 SET DIC("P")=$$GETSPEC^IBEFUNC(361.11,1)
+23 SET X=$PIECE(IB0,U,4)
+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)="Adjustment reason code could not be added"
QUIT
+26 SET IBDA=+Y
End DoDot:1
+27 ;
+28 IF $GET(IBDA)
Begin DoDot:1
+29 SET LEVEL=10
SET LEVEL("DIE")="^IBM(361.1,"_IBEOB_",10,"_IBDA(1)_",1,"
+30 SET LEVEL(0)=IBDA
SET LEVEL(1)=IBDA(1)
SET LEVEL(2)=IBEOB
+31 SET A="5;.02;1;0;0^6;.03;0;1;1^7;.04;0;1;0"
+32 SET IBOK=$$STORE^IBCEOB1(A,IB0,IBEOB,.LEVEL)
+33 IF 'IBOK
SET ^TMP(IBEGBL,$JOB,+$ORDER(^TMP(IBEGBL,$JOB,""),-1)+1)="Bad adjustment reason code ("_$PIECE(IB0,U,4)_") data"
QUIT
End DoDot:1
Q20 QUIT $GET(IBOK)
+1 ;
35(IB0,IBEGBL,IBEOB) ; Record '35'
+1 ;
+2 NEW A,IBOK
+3 ;
+4 SET A="3;4.12;1;0;0^4;4.13;1;0;0^5;4.14;0;1;1^6;4.15;1;0;0^7;4.16;1;0;0^8;4.17;1;0;0^9;4.18;1;0;0^10;4.04;1;0;0^11;3.01;0;1;1^12;3.02;1;0;0^13;3.08;1;0;0^14;3.09;1;0;0"
+5 ;
+6 SET IBOK=$$STORE^IBCEOB1(A,IB0,IBEOB)
+7 IF 'IBOK
SET ^TMP(IBEGBL,$JOB,+$ORDER(^TMP(IBEGBL,$JOB,""),-1)+1)="Bad MEDICARE Inpt Adjudication data"
Q35 QUIT $GET(IBOK)
+1 ;
37(IB0,IBEGBL,IBEOB) ; Record '37'
+1 ;
+2 NEW IBOK,IBCT
+3 SET IBCT=$GET(^TMP($JOB,37))+1
+4 ; Max 5 allowed
IF IBCT>5
SET ^TMP(IBEGBL,$JOB,+$ORDER(^TMP(IBEGBL,$JOB,""),-1)+1)="Too many Medicare Claim Level Adjudication Remarks"
GOTO Q37
+5 SET A="4;"_$SELECT($PIECE(IB0,U,3)="O":"3.0"_(IBCT+2),1:"5.0"_IBCT)_";0;0;0^5;5.0"_IBCT_"1;0;0;0"
+6 SET IBOK=$$STORE^IBCEOB1(A,IB0,IBEOB)
+7 IF 'IBOK
SET ^TMP(IBEGBL,$JOB,+$ORDER(^TMP(IBEGBL,$JOB,""),-1)+1)="Bad Medicare Claim Level Adjudication Remarks data"
+8 ;
+9 ; 4/22/03 - esg - If claim level remark code MA15 is reported, then
+10 ; this is a split EOB and we need to change the REVIEW STATUS
+11 ; of this EOB to be ACCEPTED-INTERIM EOB.
+12 ;
+13 IF $PIECE(IB0,U,4)["MA15"
Begin DoDot:1
+14 NEW DA,DIE,DR,DIC
+15 SET DA=IBEOB
SET DIE=361.1
SET DR=".16////2"
DO ^DIE
SET IBOK=($DATA(Y)=0)
+16 IF 'IBOK
SET ^TMP(IBEGBL,$JOB,+$ORDER(^TMP(IBEGBL,$JOB,""),-1)+1)="Split EOB, but review status was not updated correctly"
+17 QUIT
End DoDot:1
+18 ;
Q37 ; Saves the # of entries for 37 records
SET ^TMP($JOB,37)=$GET(^TMP($JOB,37))+1
+1 QUIT $GET(IBOK)
+2 ;
+3 ;
DET40(IB0,ARRAY,ERRCOD) ; Format important details of record 40 for error
+1 ; IB0 = data on 40 record (some pieces pre-formatted)
+2 ; ARRAY(n)=formatted line is returned if passed by ref
+3 NEW Q,IBBNDL
+4 ; Determine if Bundled or Not Bundled.
SET IBBNDL=$SELECT($PIECE(IB0,U,10)'="":1,1:0)
+5 ;
+6 SET ARRAY(1)="Payer reported the following was billed to them via the Claim (837):"
+7 SET ARRAY(2)="Proc/Rev CD: "
+8 ; If this is a Procedure Code mismatch and there is nothing in piece 10 show "UNK" otherwise show the mismatched Procedure Code.
+9 SET ARRAY(2)=ARRAY(2)_$SELECT(+ERRCOD=2:$SELECT($PIECE(IB0,U,10)'="":$PIECE(IB0,U,10),1:"UNK "),1:$SELECT($PIECE(IB0,U,10)'="":$PIECE(IB0,U,10),1:$PIECE(IB0,U,3)))
+10 SET ARRAY(2)=ARRAY(2)_" Mods:"
+11 IF $PIECE(IB0,U,11)=""
Begin DoDot:1
+12 ; If there is nothing in piece 11 and this is a modified mismatch, show the value from the comparison checking that occurred.
+13 IF +ERRCOD=5
SET ARRAY(2)=ARRAY(2)_$PIECE(ERRCOD,U,2)
QUIT
+14 ; If there is nothing in piece 11 and this is not a modifier mismatch, show what is in piece 5-8
+15 FOR Q=5:1:8
IF $PIECE(IB0,U,Q)'=""
SET ARRAY(2)=ARRAY(2)_$PIECE(IB0,U,Q)_$SELECT(Q=8:"",$PIECE(IB0,U,Q+1)'="":",",1:"")
End DoDot:1
+16 IF $PIECE(IB0,U,11)'=""
Begin DoDot:1
+17 FOR Q=11:1:14
IF $PIECE(IB0,U,Q)'=""
SET ARRAY(2)=ARRAY(2)_$PIECE(IB0,U,Q)_$SELECT(Q=14:"",$PIECE(IB0,U,Q+1)'="":",",1:"")
End DoDot:1
+18 SET $EXTRACT(ARRAY(2),37)="Chg: "_$JUSTIFY($PIECE(IB0,U,15)/100,"",2)
+19 SET $EXTRACT(ARRAY(2),64)="Units:"_$SELECT($PIECE(IB0,U,16):$PIECE(IB0,U,16),1:"")
+20 SET ARRAY(3)="Payer reported the following was used for adjudication via the EEOB (835):"
+21 SET ARRAY(4)="Proc/Rev CD: "_$PIECE(IB0,U,3)_" Mods:"
+22 ; If not bundled.
IF 'IBBNDL
Begin DoDot:1
+23 ; If no modifiers found, show "UNK" for Unknown.
IF $PIECE(IB0,U,5)=""
SET ARRAY(4)=ARRAY(4)_"UNK"
QUIT
+24 FOR Q=5:1:8
IF $PIECE(IB0,U,Q)'=""
SET ARRAY(4)=ARRAY(4)_$PIECE(IB0,U,Q)_$SELECT(Q=8:"",$PIECE(IB0,U,Q+1)'="":",",1:"")
End DoDot:1
+25 ; If bundled.
IF IBBNDL
Begin DoDot:1
+26 ; If no modifiers found, show "UNK" for Unknown.
IF $PIECE(IB0,U,11)=""
SET ARRAY(4)=ARRAY(4)_"UNK"
QUIT
+27 FOR Q=11:1:14
IF $PIECE(IB0,U,Q)'=""
SET ARRAY(4)=ARRAY(4)_$PIECE(IB0,U,Q)_$SELECT(Q=14:"",$PIECE(IB0,U,Q+1)'="":",",1:"")
End DoDot:1
+28 SET $EXTRACT(ARRAY(4),37)="Amt Pd: "_$JUSTIFY($PIECE(IB0,U,17)/100,"",2)
+29 SET $EXTRACT(ARRAY(4),64)="Cov Units:"_$SELECT($PIECE(IB0,U,18):$PIECE(IB0,U,18)/100,1:1)
+30 SET ARRAY(5)=" "
+31 QUIT
+32 ;
DET4X(RECID,IB0,ARRAY) ; Format important details of record 41-46 for error
+1 ; RECID = 41,42,45,46
+2 ; IB0 = data on RECID record
+3 ; ARRAY(n)=formatted line is returned if passed by ref
+4 NEW CT,Q
+5 IF RECID=41
Begin DoDot:1
+6 SET ARRAY(1)=" Allowed Amt: "_$JUSTIFY($PIECE(IB0,U,3)/100,"",2)_" Per Diem Amt: "_$JUSTIFY($PIECE(IB0,U,4)/100,"",2)
End DoDot:1
QUIT
+7 ;
+8 IF RECID=42
Begin DoDot:1
+9 SET ARRAY(1)=" Line Item Remark Code: "_$PIECE(IB0,U,3)
+10 IF $PIECE(IB0,U,4)'=""
SET CT=1
FOR Q=0:80:190
IF $EXTRACT($PIECE(IB0,U,4),Q+1,Q+80)'=""
SET CT=CT+1
SET ARRAY(CT)=$EXTRACT($PIECE(IB0,U,4),Q+1,Q+80)
End DoDot:1
QUIT
+11 ;
+12 IF RECID=45
Begin DoDot:1
+13 SET ARRAY(1)=" Adj Group Cd: "_$PIECE(IB0,U,3)_" Reason Cd: "_$PIECE(IB0,U,4)_" Amt: "_$JUSTIFY($PIECE(IB0,U,5)/100,"",2)_" Quantity: "_+$PIECE(IB0,U,6)
+14 IF $PIECE(IB0,U,7)'=""
SET CT=1
FOR Q=0:80:190
IF $EXTRACT($PIECE(IB0,U,7),Q+1,Q+80)'=""
SET CT=CT+1
SET ARRAY(CT)=$EXTRACT($PIECE(IB0,U,7),Q+1,Q+80)
End DoDot:1
+15 ;
+16 IF RECID=46
Begin DoDot:1
+17 SET ARRAY(1)=" Payer Policy Reference: "_$PIECE(IB0,U,3)
End DoDot:1
+18 QUIT
+19 ;
FDT(X) ; Format date in X (YYYYMMDD) to MM/DD/YYYY
+1 if X'=""
SET X=$EXTRACT(X,5,6)_"/"_$EXTRACT(X,7,8)_"/"_$EXTRACT(X,1,4)
+2 QUIT X
+3 ;
