Changeset 636 for FOIAVistA/tag/r/INTEGRATED_BILLING-IB-PRQ--IBD--IBQ--PRQS/IBCEOB.m

Timestamp:

Dec 4, 2009, 8:26:01 PM (14 years ago)

Author:

George Lilly

Message:

WorldVistAEHR overlayed on FOIAVistA

Location:

FOIAVistA/tag/r

Files:

• . (copied) (copied from FOIAVistA/trunk/r )
• INTEGRATED_BILLING-IB-PRQ--IBD--IBQ--PRQS/IBCEOB.m (modified) (8 diffs)

FOIAVistA/tag/r/INTEGRATED_BILLING-IB-PRQ--IBD--IBQ--PRQS/IBCEOB.m

@@ -1 +1 @@
 IBCEOB ;ALB/TMP - 835 EDI EOB MESSAGE PROCESSING ;20-JAN-99
- ;;2.0;INTEGRATED BILLING;**137,135,265,155,377**;21-MAR-94;Build 23
- ;;Per VHA Directive 2004-038, this routine should not be modified.
- ;
+ ;;2.0;INTEGRATED BILLING;**137,135,265,155**;21-MAR-94
  Q
  ;
@@ -24 +22 @@
  ; Duplicate EOB Check
  S IBFILE="^IBA(364.2,"_IBTDA_",2)"
- I $$DUP(IBFILE,X) D DELMSG^IBCESRV2(IBTDA) G UPDQ
+ I $$DUP(IBFILE,X) G UPDQ
  ;
  I '$$LOCK^IBCEM(IBTDA) G UPDQ ;Lock msg file 364.2
@@ -50 +48 @@
 5(IB0,IBEGBL,IBEOB) ; Record '05'
  ;
- N IBOK,DA,DR,DIE,X,Y
+ N IBOK,IBBULL,DA,DR,DIE,X,Y
  K IBZDATA
  S DR=";",IBOK=1
  S DIE="^IBM(361.1,",DA=IBEOB
  ;
- I $P(IB0,U,9) S DR=DR_"1.1///"_$$DATE^IBCEU($P(IB0,U,9))_";"         ; statement start date
- I $P(IB0,U,10) S DR=DR_"1.11///"_$$DATE^IBCEU($P(IB0,U,10))_";"      ; statement end date
+ S IBBULL=""
+ I $$UPDNM^IBCEOB00(IBEOB,IB0,.IBBULL,.DR)!$$UPDID^IBCEOB00(IBEOB,IB0,.IBBULL,.DR) D  ; New insured's name and/or HIC # found
+ . D CHGBULL^IBCEOB3(IBEOB,IBBULL) ;Send a bulletin reporting change
+ ;
+ I $P(IB0,U,9) S DR=DR_"1.1///"_$$DATE^IBCEU($P(IB0,U,9))_";"
+ I $P(IB0,U,10) S DR=DR_"1.11///"_$$DATE^IBCEU($P(IB0,U,10))_";"
  S DR=$P(DR,";",2,$L(DR,";")-1)
  I DR'="" D ^DIE S IBOK=$D(Y)=0
  I 'IBOK S ^TMP(IBEGBL,$J,+$O(^TMP(IBEGBL,$J,""),-1)+1)="Bad record 5 data"
  Q IBOK
- ;
-6(IB0,IBEGBL,IBEOB) ; Record '06' - corrected patient name and/or ID#
- ; This data is not going to be filed into file 361.1 so the value of this function will always be a 1 so as to
- ; not interrupt the filing process of the EOB/MRA data into file 361.1.
- ;
- ; perform overall integrity checks on the incoming 06 record.  If anything is out of place, don't update anything
- ; and report the problem and get out.
- NEW CLM,SITE,IBM,IBIFN,IBIFN1,DFN,SEQ,DIE,DA,DR
- S DIE=361.1,DA=IBEOB,DR="61.01////^S X=IB0" D ^DIE    ; archive the raw 06 record data
- S CLM=$P(IB0,U,2),SITE=+CLM,CLM=$P(CLM,"-",2) I CLM="" D MSG(IBEOB,"The claim# in piece 2 is invalid.") G Q6
- S IBM=$G(^IBM(361.1,IBEOB,0))
- I $P(IBM,U,4)'=1 D MSG(IBEOB,"This is a non-Medicare EOB.") G Q6
- S IBIFN=+$P(IBM,U,1)                    ; claim# from MRA
- S IBIFN1=+$O(^DGCR(399,"B",CLM,""))     ; claim# from 06 record
- I IBIFN'=IBIFN1 D MSG(IBEOB,"Claim mismatch error."_IBIFN_","_IBIFN1_","_CLM_".") G Q6
- I $P($$SITE^VASITE,U,3)'=SITE D MSG(IBEOB,"Invalid station# mismatch."_$P($$SITE^VASITE,U,3)_","_SITE_".") G Q6
- S SEQ=$$COBN^IBCEF(IBIFN)               ; current payer sequence# on claim
- I '$$WNRBILL^IBEFUNC(IBIFN,SEQ) D MSG(IBEOB,"The current payer on this claim is not MEDICARE (WNR).") G Q6
- S DFN=+$P($G(^DGCR(399,IBIFN,0)),U,2)   ; patient ien
- I 'DFN D MSG(IBEOB,"The patient DFN cannot be determined.") G Q6
- ;
- D UPD^IBCEOB01(IB0,IBEOB,IBIFN,DFN,SEQ)     ; update patient insurance policy data
- ;
-Q6 ; exit point for $$6 function
- Q 1
  ;
 10(IB0,IBEGBL,IBEOB) ; Record '10'
@@ -106 +83 @@
  ;
 15(IB0,IBEGBL,IBEOB) ; Record '15'
- ; Moved due to space constraints
-Q15 Q $$15^IBCEOB00(IB0,IBEGBL,IBEOB)
+ ;
+ N A,IBOK
+ ;
+ 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"
+ ;
+ 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
  ;
 17(IB0,IBEGBL,IBEOB) ; Record '17'
@@ -117 +114 @@
  ;
 20(IB0,IBEGBL,IBEOB) ; Record '20'
- ; Moved due to space constraints
-Q20 Q $$20^IBCEOB00(IB0,IBEGBL,IBEOB)
+ ;
+ 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)
  ;
 30(IB0,IBEGBL,IBEOB) ; Record '30'
@@ -157 +186 @@
  D 45^IBCEOB0(IB0,IBEOB,.IBOK)
  Q $G(IBOK)
- ;
-MSG(IBEOB,MSG) ; procedure to file message into field 6.03
- ; Results of processing of the "06" record type
- N DIE,DA,DR,Z
- S DIE=361.1,DA=+$G(IBEOB)
- I $G(MSG)="" G MSGX
- S Z=$P($G(^IBM(361.1,DA,6)),U,3)    ; already existing message
- I Z'="" S MSG=Z_"  "_MSG            ; append new message to existing message
- S MSG=$E(MSG,1,190)
- S DR="6.03///^S X=MSG"
- D ^DIE
-MSGX ;
- Q
  ;
 DOLLAR(X) ; Convert value in X to dollar format XXX.XX
@@ -182 +198 @@
  ; IBFILE = array reference of raw EOB data
  ;
- N DIC,DA,DR,DO,DD,DLAYGO,Y,REVSTAT,BS,MMI
+ N DIC,DA,DR,DO,DD,DLAYGO,Y,REVSTAT,BS
  F  L +^IBM(361.1,0):10 Q:$T
  ;
@@ -188 +204 @@
  S BS=$P($G(^DGCR(399,X,0)),U,13)   ; bill status
  S REVSTAT=$S(BS=7:9,BS=3:3,BS=4:3,1:0)
- S MMI=$$NET^XMRENT(IBMNUM)         ; MailMan header info
  S DIC(0)="L",DIC="^IBM(361.1,",DLAYGO=361.1
  S DIC("DR")=".16////"_REVSTAT_";.17////0"_";100.02////"_IBMNUM_$S('$G(IBAR):";.19////"_+IBTBILL_";100.01////"_IBBATCH,1:"")
- S DIC("DR")=DIC("DR")_";100.05////"_$$CHKSUM^IBCEMU1(IBFILE)_";62.01////^S X=MMI"
+ S DIC("DR")=DIC("DR")_";100.05////"_$$CHKSUM^IBCEMU1(IBFILE)
  D FILE^DICN
  L -^IBM(361.1,0)