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

IBCEOB00.m

Go to the documentation of this file. 
  1. 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
  1.  ;;Per VA Directive 6402, this routine should not be modified.
  1.  Q
  1.  ;
  1. RCRU(IBZDATA,IB0,IBLN) ; Revenue Code Roll-up procedure check -
  1.  ; Total up outbound line items by revenue code and compare with
  1.  ; incoming EOB 40 record to see if it has been rolled up
  1.  ;
  1.  ; IBZDATA - UB output formatter array, passed by reference
  1.  ; IB0     - 40 record data
  1.  ; IBLN    - output parameter, passed by reference
  1.  ;
  1.  NEW Z,LN,REV,UN,CH,RUD,RUD2,UCH,MRAUCH
  1.  I $P(IB0,U,4)="" G RCRUX
  1.  S IBLN="",Z=0
  1.  F  S Z=$O(IBZDATA(Z)) Q:'Z  S LN=IBZDATA(Z) D
  1.  . S REV=$P(LN,U,1),UN=$P(LN,U,4),CH=$P(LN,U,5),UCH=+$P(LN,U,3)
  1.  . I REV="" Q
  1.  . ;
  1.  . S RUD=$G(RUD(REV))                 ; roll up data array for rev code
  1.  . S $P(RUD,U,1)=$P(RUD,U,1)+CH       ; total charges
  1.  . S $P(RUD,U,2)=$P(RUD,U,2)+UN       ; total units
  1.  . S $P(RUD,U,3)=$P(RUD,U,3)+1        ; total line items
  1.  . S RUD(REV)=RUD
  1.  . S RUD(REV,Z)=""
  1.  . ;
  1.  . S RUD2=$G(RUD2(REV,UCH))           ; roll up data array for rev code
  1.  . S $P(RUD2,U,1)=$P(RUD2,U,1)+CH     ; total charges
  1.  . S $P(RUD2,U,2)=$P(RUD2,U,2)+UN     ; total units
  1.  . S $P(RUD2,U,3)=$P(RUD2,U,3)+1      ; total line items
  1.  . S RUD2(REV,UCH)=RUD2
  1.  . S RUD2(REV,UCH,Z)=""
  1.  . ;
  1.  . Q
  1.  ;
  1.  I '$D(RUD),'$D(RUD2) G RCRUX
  1.  ;
  1.  ; delete the revenue code roll-up, if only 1 line item.
  1.  S REV=""     ; this is not a roll up situation
  1.  F  S REV=$O(RUD(REV)) Q:REV=""  I $P(RUD(REV),U,3)=1 KILL RUD(REV)
  1.  ;
  1.  S (REV,UCH)=""
  1.  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)
  1.  ;
  1.  I '$D(RUD),'$D(RUD2) G RCRUX
  1.  ;
  1.  S RUD=$G(RUD($P(IB0,U,4)))      ; compare with 40 record data
  1.  I RUD="" G RCRU2                ; make sure it exists
  1.  I $P(RUD,U,1)'=+$$DOLLAR^IBCEOB($P(IB0,U,15)) G RCRU2    ; charges
  1.  I $P(RUD,U,2)'=$P(IB0,U,16) G RCRU2                      ; units
  1.  S IBLN=$O(RUD($P(IB0,U,4),""))  ; use the first line# found
  1.  G RCRUX
  1.  ;
  1. RCRU2 ; check roll-up data by rev code and unit charge
  1.  S MRAUCH=0
  1.  I $P(IB0,U,16) S MRAUCH=+$$DOLLAR^IBCEOB($P(IB0,U,15))/$P(IB0,U,16)
  1.  S RUD2=$G(RUD2($P(IB0,U,4),MRAUCH))     ; compare with 40 record data
  1.  I RUD2="" G RCRUX                       ; make sure it exists
  1.  I $P(RUD2,U,1)'=+$$DOLLAR^IBCEOB($P(IB0,U,15)) G RCRUX   ; charges
  1.  I $P(RUD2,U,2)'=$P(IB0,U,16) G RCRUX                     ; units
  1.  S IBLN=$O(RUD2($P(IB0,U,4),MRAUCH,""))  ; use the first line# found
  1.  ;
  1. RCRUX ;
  1.  Q
  1.  ;
  1. ICN(IBEOB,ICN,COBN,IBOK) ; File the 835 ICN into the Bill
  1.  ;
  1.  ; Input parameters
  1.  ;   IBEOB - ien to file 361.1
  1.  ;   ICN   - the ICN# from the 835 transmission
  1.  ;   COBN  - the insurance sequence#
  1.  ;
  1.  ; Output parameter
  1.  ;   IBOK  - returns as 0 if we get a filing error here
  1.  ;
  1.  ; The field in file 399 depends on the current payer sequence
  1.  ;     399,453 - primary ICN
  1.  ;     399,454 - secondary ICN
  1.  ;     399,455 - tertiary ICN
  1.  ;
  1.  NEW IBIFN,FIELD,D,D0,DA,DI,DIC,DIE,DQ,DR,X,Y
  1.  S IBEOB=+$G(IBEOB),COBN=+$G(COBN)
  1.  I 'IBEOB!'COBN G ICNX
  1.  S IBIFN=+$P($G(^IBM(361.1,IBEOB,0)),U,1)
  1.  I '$D(^DGCR(399,IBIFN)) G ICNX
  1.  I $G(ICN)="" G ICNX
  1.  I '$F(".1.2.3.","."_COBN_".") G ICNX
  1.  ;
  1.  S FIELD=452+COBN
  1.  S DIE=399,DA=IBIFN,DR=FIELD_"////"_ICN D ^DIE
  1.  S IBOK=($D(Y)=0)
  1.  I 'IBOK S ^TMP(IBEGBL,$J,+$O(^TMP(IBEGBL,$J,""),-1)+1)="Error in filing the ICN into the Bill/Claims file"
  1. ICNX ;
  1.  Q
  1.  ;
  1. 15(IB0,IBEGBL,IBEOB) ; Record '15'
  1.  ;
  1.  N A,IBOK
  1.  ;
  1.  ;IB*2.0*521/ZEB Added piece 11/field 2.06 for HPID
  1.  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"
  1.  ;
  1.  S IBOK=$$STORE^IBCEOB1(A,IB0,IBEOB)
  1.  I 'IBOK S ^TMP(IBEGBL,$J,+$O(^TMP(IBEGBL,$J,""),-1)+1)="Bad record 15 data" G Q15
  1.  ;
  1.  ; For Medicare MRA's only:
  1.  ; If the Covered Amount is present (15 record, piece 3), then file
  1.  ; a claim level adjustment with Group code=OA, Reason code=AB3.
  1.  ;
  1.  I $P($G(^IBM(361.1,IBEOB,0)),U,4)=1,+$P(IB0,U,3) D
  1.  . N IB20
  1.  . S IB20=20_U_$P(IB0,U,2)_U_"OA"_U_"AB3"_U_$P(IB0,U,3)_U_"0000000000"
  1.  . S IB20=IB20_U_"Covered Amount"
  1.  . S IBOK=$$20(IB20,IBEGBL,IBEOB)
  1.  . 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"
  1.  . K ^TMP($J,20)
  1.  . Q
  1.  ;
  1. Q15 Q IBOK
  1.  ;
  1. 20(IB0,IBEGBL,IBEOB) ; Record '20'
  1.  ;
  1.  N A,LEVEL,IBGRP,IBDA,IBOK
  1.  ;
  1.  S IBGRP=$P(IB0,U,3)
  1.  I IBGRP'="" S ^TMP($J,20)=IBGRP
  1.  I IBGRP="" S IBGRP=$G(^TMP($J,20))
  1.  I IBGRP="" S ^TMP(IBEGBL,$J,+$O(^TMP(IBEGBL,$J,""),-1)+1)="Missing claim level adjustment group code" G Q20
  1.  ;
  1.  S IBDA(1)=$O(^IBM(361.1,IBEOB,10,"B",IBGRP,0))
  1.  ;
  1.  I 'IBDA(1) D  ;Needs a new entry at group level
  1.  . N X,Y,DA,DD,DO,DIC,DLAYGO
  1.  . S DIC="^IBM(361.1,"_IBEOB_",10,",DIC(0)="L",DLAYGO=361.11,DA(1)=IBEOB
  1.  . S DIC("P")=$$GETSPEC^IBEFUNC(361.1,10)
  1.  . S X=IBGRP
  1.  . D FILE^DICN K DIC,DO,DD,DLAYGO
  1.  . I Y<0 K IBDA S ^TMP(IBEGBL,$J,+$O(^TMP(IBEGBL,$J,""),-1)+1)="Adjustment group code could not be added" Q
  1.  . S IBDA(1)=+Y
  1.  ;
  1.  I $G(IBDA(1)) D  ;Add a new entry at the reason code level
  1.  . S DIC="^IBM(361.1,"_IBEOB_",10,"_IBDA(1)_",1,",DIC(0)="L",DLAYGO=361.111,DA(2)=IBEOB,DA(1)=IBDA(1)
  1.  . S DIC("P")=$$GETSPEC^IBEFUNC(361.11,1)
  1.  . S X=$P(IB0,U,4)
  1.  . D FILE^DICN K DIC,DO,DD,DLAYGO
  1.  . I Y<0 K IBDA S ^TMP(IBEGBL,$J,+$O(^TMP(IBEGBL,$J,""),-1)+1)="Adjustment reason code could not be added" Q
  1.  . S IBDA=+Y
  1.  ;
  1.  I $G(IBDA) D
  1.  . S LEVEL=10,LEVEL("DIE")="^IBM(361.1,"_IBEOB_",10,"_IBDA(1)_",1,"
  1.  . S LEVEL(0)=IBDA,LEVEL(1)=IBDA(1),LEVEL(2)=IBEOB
  1.  . S A="5;.02;1;0;0^6;.03;0;1;1^7;.04;0;1;0"
  1.  . S IBOK=$$STORE^IBCEOB1(A,IB0,IBEOB,.LEVEL)
  1.  . I 'IBOK S ^TMP(IBEGBL,$J,+$O(^TMP(IBEGBL,$J,""),-1)+1)="Bad adjustment reason code ("_$P(IB0,U,4)_") data" Q
  1. Q20 Q $G(IBOK)
  1.  ;
  1. 35(IB0,IBEGBL,IBEOB) ; Record '35'
  1.  ;
  1.  N A,IBOK
  1.  ;
  1.  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"
  1.  ;
  1.  S IBOK=$$STORE^IBCEOB1(A,IB0,IBEOB)
  1.  I 'IBOK S ^TMP(IBEGBL,$J,+$O(^TMP(IBEGBL,$J,""),-1)+1)="Bad MEDICARE Inpt Adjudication data"
  1. Q35 Q $G(IBOK)
  1.  ;
  1. 37(IB0,IBEGBL,IBEOB) ; Record '37'
  1.  ;
  1.  N IBOK,IBCT
  1.  S IBCT=$G(^TMP($J,37))+1
  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
  1.  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"
  1.  S IBOK=$$STORE^IBCEOB1(A,IB0,IBEOB)
  1.  I 'IBOK S ^TMP(IBEGBL,$J,+$O(^TMP(IBEGBL,$J,""),-1)+1)="Bad Medicare Claim Level Adjudication Remarks data"
  1.  ;
  1.  ; 4/22/03 - esg - If claim level remark code MA15 is reported, then
  1.  ;         this is a split EOB and we need to change the REVIEW STATUS
  1.  ;         of this EOB to be ACCEPTED-INTERIM EOB.
  1.  ;
  1.  I $P(IB0,U,4)["MA15" D
  1.  . N DA,DIE,DR,DIC
  1.  . S DA=IBEOB,DIE=361.1,DR=".16////2" D ^DIE S IBOK=($D(Y)=0)
  1.  . I 'IBOK S ^TMP(IBEGBL,$J,+$O(^TMP(IBEGBL,$J,""),-1)+1)="Split EOB, but review status was not updated correctly"
  1.  . Q
  1.  ;
  1. Q37 S ^TMP($J,37)=$G(^TMP($J,37))+1 ; Saves the # of entries for 37 records
  1.  Q $G(IBOK)
  1.  ;
  1.  ;
  1. DET40(IB0,ARRAY,ERRCOD) ; Format important details of record 40 for error
  1.  ; IB0 = data on 40 record (some pieces pre-formatted)
  1.  ;  ARRAY(n)=formatted line is returned if passed by ref
  1.  N Q,IBBNDL
  1.  S IBBNDL=$S($P(IB0,U,10)'="":1,1:0)   ; Determine if Bundled or Not Bundled.
  1.  ;
  1.  S ARRAY(1)="Payer reported the following was billed to them via the Claim (837):"
  1.  S ARRAY(2)="Proc/Rev CD: "
  1.  ; If this is a Procedure Code mismatch and there is nothing in piece 10 show "UNK" otherwise show the mismatched Procedure Code.
  1.  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)))
  1.  S ARRAY(2)=ARRAY(2)_" Mods:"
  1.  I $P(IB0,U,11)="" D
  1.  . ; If there is nothing in piece 11 and this is a modified mismatch, show the value from the comparison checking that occurred.
  1.  . I +ERRCOD=5 S ARRAY(2)=ARRAY(2)_$P(ERRCOD,U,2) Q
  1.  . ; If there is nothing in piece 11 and this is not a modifier mismatch, show what is in piece 5-8 
  1.  . 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:"")
  1.  I $P(IB0,U,11)'="" D
  1.  . 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:"")
  1.  S $E(ARRAY(2),37)="Chg: "_$J($P(IB0,U,15)/100,"",2)
  1.  S $E(ARRAY(2),64)="Units:"_$S($P(IB0,U,16):$P(IB0,U,16),1:"")
  1.  S ARRAY(3)="Payer reported the following was used for adjudication via the EEOB (835):"
  1.  S ARRAY(4)="Proc/Rev CD: "_$P(IB0,U,3)_" Mods:"
  1.  I 'IBBNDL D     ; If not bundled.
  1.  . I $P(IB0,U,5)="" S ARRAY(4)=ARRAY(4)_"UNK" Q   ; If no modifiers found, show "UNK" for Unknown.
  1.  . 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:"")
  1.  I IBBNDL D      ; If bundled.
  1.  . I $P(IB0,U,11)="" S ARRAY(4)=ARRAY(4)_"UNK" Q   ; If no modifiers found, show "UNK" for Unknown.
  1.  . 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:"")
  1.  S $E(ARRAY(4),37)="Amt Pd: "_$J($P(IB0,U,17)/100,"",2)
  1.  S $E(ARRAY(4),64)="Cov Units:"_$S($P(IB0,U,18):$P(IB0,U,18)/100,1:1)
  1.  S ARRAY(5)="  "
  1.  Q
  1.  ;
  1. DET4X(RECID,IB0,ARRAY) ; Format important details of record 41-46 for error
  1.  ; RECID = 41,42,45,46
  1.  ; IB0 = data on RECID record
  1.  ;  ARRAY(n)=formatted line is returned if passed by ref
  1.  N CT,Q
  1.  I RECID=41 D  Q
  1.  . S ARRAY(1)="    Allowed Amt: "_$J($P(IB0,U,3)/100,"",2)_"  Per Diem Amt: "_$J($P(IB0,U,4)/100,"",2)
  1.  ;
  1.  I RECID=42 D  Q
  1.  . S ARRAY(1)="    Line Item Remark Code: "_$P(IB0,U,3)
  1.  . 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)
  1.  ;
  1.  I RECID=45 D
  1.  . 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)
  1.  . 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)
  1.  ;
  1.  I RECID=46 D
  1.  . S ARRAY(1)="    Payer Policy Reference: "_$P(IB0,U,3)
  1.  Q
  1.  ; 
  1. FDT(X) ; Format date in X (YYYYMMDD) to MM/DD/YYYY
  1.  S:X'="" X=$E(X,5,6)_"/"_$E(X,7,8)_"/"_$E(X,1,4)
  1.  Q X
  1.  ;