- Timestamp:
- Dec 4, 2009, 12:11:15 AM (14 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
WorldVistAEHR/trunk/r/ACCOUNTS_RECEIVABLE-PRCA-PRY-RC/RCDPESR2.m
r613 r623 1 RCDPESR2 ;ALB/TMK - Server auto-upd - EDI Lockbox ;06/03/02 2 ;;4.5;Accounts Receivable;**173,216,208,230,252**;Mar 20, 1995;Build 63 3 ;;Per VHA Directive 2004-038, this routine should not be modified. 4 ; IA 4042 (IBCEOB) 5 ; 6 TASKERA(RCTDA) ; Task to upd ERA 7 ; RCTDA = ien 344.5 8 N ZTDTH,ZTUCI,ZTSAVE,ZTIO,ZTDESC,ZTRTN,ZTSK,DIE,DR,DA 9 S (ZTSAVE("DT"),ZTSAVE("U"),ZTSAVE("DUZ"))="",ZTSAVE("ZTREQ")="@",ZTRTN="NEWERA^RCDPESR2("_RCTDA_",0)",ZTDTH=$H,ZTIO="" 10 D ^%ZTLOAD 11 Q 12 ; 13 NEWERA(RCTDA,RCREFILE) ;Tasked 14 ; Add new EOB's to IB & ERA tot rec to AR 15 ; RCTDA = ien 344.5 16 ; RCREFILE = 1: re-filing rec via exc proc 17 N RCDUPERR,RCPAYER,RCRTOT,RCE,RCEC,RCERR,RCR1,RCADJ,DIE,DR,DA,Z,Q 18 S ZTREQ="@" 19 K ^TMP($J,"RCDPERA") 20 L +^RCY(344.5,RCTDA):5 21 I $D(ZTQUEUED) S DIE="^RCY(344.5,",DA=RCTDA,DR=".05////"_ZTSK_";.04////1" D ^DIE 22 I $P($G(^RCY(344.5,RCTDA,0)),U,5),'$G(RCREFILE) S DIE="^RCY(344.5,",DA=RCTDA,DR=".1////4;.08///1" D ^DIE 23 S RCR1=$P($G(^RCY(344.5,RCTDA,0)),U,7),RCPAYER=$P($G(^RCY(344.5,RCTDA,3)),U) 24 S RCRTOT=$S(RCR1:RCR1,1:$$ERATOT^RCDPESR6(RCTDA,.RCERR)) ; ERA rec 25 S RCDUPERR=$S($G(RCERR)="DUP"!($G(RCERR(1))=-2):$G(RCERR(1)),1:0) K RCERR(1) 26 I RCRTOT,'RCR1 S DIE="^RCY(344.5,",DR=".07////"_RCRTOT,DA=RCTDA D ^DIE 27 D:RCDUPERR'=-2 UPDEOB(RCTDA,5,$S('$G(RCREFILE):RCDUPERR,1:-1)) ; Add EOB det to IB 28 I RCRTOT D UPDCON^RCDPESR6(RCRTOT),UPDADJ^RCDPESR6(RCRTOT),UPD3444^RCDPESR6(.RCRTOT) ; Bills added 344.41 29 I RCRTOT,RCTDA S DIE="^RCY(344.5,",DR=".08////0;.1///@",DA=RCTDA D ^DIE 30 I 'RCRTOT D G QNEW 31 .I RCDUPERR Q:'RCTDA D S RCTDA="" Q 32 ..I RCDUPERR=-2 D BULLERA^RCDPESR0("D",RCTDA,$P($G(^RCY(344.5,RCTDA,0)),U,11),"EDI LBOX - DUPLICATE ERA NOT FILED "_$E(RCPAYER,1,20),.RCERR,0) 33 ..D TEMPDEL^RCDPESR1(RCTDA) 34 .S RCE(1)=$$FMTE^XLFDT($$NOW^XLFDT(),2)_" An error occurred while storing ERA data.",RCE(2)="No totals data was stored for this ERA record"_$S('$G(RCREFILE):" and an",1:" on this re-file attempt.") 35 .S RCE(3)=$S('$G(RCREFILE):"ERA transmission exception was created.",1:"") 36 .D WP^DIE(344.5,RCTDA_",",5,"A","RCE") 37 .S DIE="^RCY(344.5,",DA=RCTDA,DR=".07///@;.08////1;.1////1" D ^DIE 38 .K RCERR 39 .S RCERR(1)=$$FMTE^XLFDT($$NOW^XLFDT(),2)_" The ERA data could not be stored. The AR receipt",RCERR(2)=" for this data must be created/processed manually for the bills included" 40 .S RCERR(3)=" in this ERA."_$S('$G(RCREFILE):"",1:" This error occurred during a refile attempt."),RCERR(4)=" " 41 .D BULLERA^RCDPESR0("DF",RCTDA,$P($G(^RCY(344.5,RCTDA,0)),U,11),"EDI LBOX - TOTALS FILE EXCEPTION "_$E(RCPAYER,1,20),.RCERR,0) 42 .K RCERR 43 I $$ADJ^RCDPEU(RCRTOT,.RCADJ) D ;Bulletin adjs 44 .S RCEC=$$ADJERR^RCDPESR3(.RCERR) 45 .I RCADJ'=2 S RCEC=RCEC+1,RCERR(RCEC)=" THERE ARE ERA LEVEL ADJUSTMENT(S)",RCEC=RCEC+1,RCERR(RCEC)=" " 46 .I RCADJ'=1 S RCEC=RCEC+1,RCERR(RCEC)=" THE FOLLOWING BILL(S) HAVE RETRACTIONS:" D 47 ..S (Q,Z)=0 S Z=0 F S Z=$O(RCADJ(RCRTOT,Z)) Q:'Z S:'Q RCEC=RCEC+1,RCERR(RCEC)=" " S Q=Q+1,RCERR(RCEC)=RCERR(RCEC)_" "_RCADJ(RCRTOT,Z) S:Q=4 Q=0 48 ..S RCEC=RCEC+1,RCERR(RCEC)=" " 49 .D BULLERA^RCDPESR0("D",RCTDA,$P($G(^RCY(344.5,RCTDA,0)),U,11),"EDI LBOX - ERA HAS ADJ/TAKEBACKS "_$E(RCPAYER,1,20),.RCERR,0) 50 ; 51 QNEW I RCTDA,'$P($G(^RCY(344.5,RCTDA,0)),U,8) D TEMPDEL^RCDPESR1(RCTDA) S RCTDA="" 52 I RCTDA,$P($G(^RCY(344.5,RCTDA,0)),U)'="" S DIE="^RCY(344.5,",DR=".04////0;.05///@"_$S('$G(RCR1)&$G(RCRTOT):";.07////"_RCRTOT,1:""),DA=RCTDA D ^DIE 53 K ^TMP($J,"RCDPERA") 54 I RCTDA L -^RCY(344.5,RCTDA) 55 Q 56 ; 57 UPDEOB(RCTDA,RCFILE,DUP) ;Upd 361.1 from ERA msg in 344.5 or .4 58 ;RCTDA = ien ERA msg in 344.5 or ;subfile in 344.4 59 ;RCFILE = 4 file 344.4, 5 if 344.5 60 ;DUP = msg # if dup msg, but not same # or -1 if same msg # 61 ;Returned for each bill in ERA: 62 ;^TMP($J,"RCDPEOB",n)=Bill ien^AR bill#^SrvDt 63 ;^TMP($J,"RCDPEOB",n,"EOB")=EOB ien^amt pd^ins co ptr^rev flg^EEOB pn^amtbld^^^^BPNPI^RNPI^ETQual^LN^FN 64 ;^TMP($J,"RCDPEOB","ADJ",x)=adj rec ('02') 65 ;Also: 66 ;^TMP($J,"RCDPEOB","HDR")=hdr rec from txmn 67 ;^TMP($J,"RCDPEOB","CONTACT")=ERA contact rec ('01') 68 ; 69 N RCGBL,RC,RC0,RCCT,RCCT1,RCEOB,RCBILL,RCDPBNPI,RCMNUM,RCIFN,RCIB,RCERR,RCSTAR,RCET,RCX,RCXMG,Z,Q,DA,DR,DIE,RCPAYER,RCFILED,RCEOBD,RCNOUPD,REFORM,RCSD,RCERR1,C5 70 K ^TMP($J,"RCDP-EOB"),^TMP("RCDPERR-EOB",$J) 71 ; 72 S RCPAYER="",RCFILED=1,RCNOUPD=0 73 I RCFILE=5 D 74 .S RCGBL=$NA(^RCY(344.5,RCTDA,2)) 75 .S RCMNUM=+$G(^RCY(344.5,RCTDA,0)),RCXMG=$P($G(^(0)),U,11) 76 .I $G(DUP) S RCNOUPD=$S(DUP>0:+DUP,1:RCXMG) 77 .S ^TMP($J,"RCDPEOB","HDR")=$G(^RCY(344.5,RCTDA,2,1,0)) 78 .I $P(^TMP($J,"RCDPEOB","HDR"),U)["XFR",'$P($G(^RCY(344.5,RCTDA,0)),U,14) D 79 ..D SENDACK^RCDPESR5(RCTDA,1) 80 ..S DR=".14////1",DIE="^RCY(344.5,",DA=RCTDA D ^DIE 81 ; 82 I RCFILE=4 D 83 .S RCGBL=$NA(^RCY(344.4,+RCTDA,1,+$P(RCTDA,";",2),1)) 84 .S RCMNUM=$P($G(^RCY(344.4,+RCTDA,0)),U,12),RCXMG=$P($G(^(0)),U,12) 85 .S ^TMP($J,"RCDPEOB","HDR")=$G(^RCY(344.4,+RCTDA,1,+$P(RCTDA,";",2),1,1,0)) 86 ; 87 S RCPAYER=$P($G(^TMP($J,"RCDPEOB","HDR")),U,6) 88 S RCDPBNPI=$P($G(^TMP($J,"RCDPEOB","HDR")),U,18) 89 ; 90 ;srv dates 91 S RCSD=$NA(^TMP($J,"RCSRVDT")) K @RCSD 92 S RC=1,C5=0 93 F S RC=$O(@RCGBL@(RC)) Q:'RC S RC0=$G(^(RC,0)) D 94 .I RC0<5 Q 95 .I +RC0=5 S C5=RC Q 96 .I +RC0=40,$P(RC0,U,2)?1.7N,C5,'$D(@RCSD@(C5)) S @RCSD@(C5)=$P(RC0,U,19) ;serv date 97 ; 98 S RC=1,(RCCT,RCCT1,RCX,REFORM)=0,RCBILL="" 99 S RCERR1=$NA(^TMP("RCERR1",$J)) K @RCERR1 100 F S RC=$O(@RCGBL@(RC)) Q:'RC S RC0=$G(^(RC,0)) D 101 .I RCFILE=5,+RC0=1 D Q 102 ..S ^TMP($J,"RCDPEOB","CONTACT")=RC0 103 .; 104 .I RCFILE=5,+RC0=2 D Q 105 ..S RCX=RCX+1,^TMP($J,"RCDPEOB","ADJ",RCX)=RC0 106 .; 107 .I +RC0=5 S RCCT=RCCT+1,RCCT1=0 D 108 ..S REFORM=0 109 ..S Z=$$BILL^RCDPESR1($P(RC0,U,2),$G(@RCSD@(RC)),.RCIB) 110 ..I Z S RCBILL=$P($G(^PRCA(430,Z,0)),U) I RCBILL'="",RCBILL'=$P(RC0,U,2) S REFORM=1,$P(RC0,U,2)=RCBILL 111 ..S RCBILL=$P(RC0,U,2) 112 ..S Z=$S(Z>0:$S($G(RCIB):Z,1:-1),1:-1) 113 ..S ^TMP($J,"RCDP-EOB",RCCT,0)=Z_U_RCBILL_U_$G(@RCSD@(RC)) 114 ..S $P(^TMP($J,"RCDPEOB",RCCT,"EOB"),U,5)=$P(RC0,U,3)_","_$P(RC0,U,4)_" "_$P(RC0,U,5) ;Save pt nm 115 ..I Z>0 S Q=+$P($G(^PRCA(430,Z,0)),U,9) I $P($G(^RCD(340,Q,0)),U)["DIC(36," S $P(^TMP($J,"RCDPEOB",RCCT,"EOB"),U,3)=+^RCD(340,Q,0) ;Save ins co 116 .; 117 .I +RC0>5,REFORM S $P(RC0,U,2)=RCBILL ; 118 .I +RC0=10 D ;Save amt pd/billed, rev flg 119 ..S $P(^TMP($J,"RCDPEOB",RCCT,"EOB"),U,2)=$S(+$P(RC0,U,11):$J($P(RC0,U,11)/100,"",2),1:0),$P(^TMP($J,"RCDPEOB",RCCT,"EOB"),U,6)=$J($P(RC0,U,11),"",2) 120 ..I $P(RC0,U,6)="Y"!($P(RC0,U,7)=22) S $P(^TMP($J,"RCDPEOB",RCCT,"EOB"),U,4)=1 121 ..S $P(^TMP($J,"RCDPEOB",RCCT,"EOB"),U,10,14)=RCDPBNPI_U_$P(RC0,U,16,19) 122 .I RCBILL=$P(RC0,U,2) S RCCT1=RCCT1+1,^TMP($J,"RCDP-EOB",RCCT,RCCT1,0)=RC0 123 ; 124 S RCSTAR=$TR($J("",15)," ","*"),RCET=RCSTAR_"ERROR/WARNING EEOB DETAIL SEQ #" 125 S RCCT=0 F S RCCT=$O(^TMP($J,"RCDP-EOB",RCCT)) Q:'RCCT S RCIFN=+$G(^(RCCT,0)),RCBILL=$P($G(^(0)),U,2),^TMP($J,"RCDPEOB",RCCT)=$G(^TMP($J,"RCDP-EOB",RCCT,0)) D 126 .S RCEOB=-1,RCEOBD="" 127 .I $S(RCIFN>0:$P(^PRCA(430.3,+$P($G(^PRCA(430,+RCIFN,0)),U,8),0),U,3)'=102,RCIFN'>0&($G(DUP)'>0):1,1:0) D 128 ..S @RCERR1@(RCCT)=" ",@RCERR1@(RCCT,1)=RCET_RCCT_RCSTAR 129 ..S @RCERR1@(RCCT,2)="Bill "_RCBILL_" is"_$S(RCIFN>0:" not in an ACTIVE status in your A/R",1:"n't valid/wasn't found so its detail wasn't stored in IB") 130 ..S:RCFILE=5 @RCERR1@(RCCT,"*")=@RCERR1@(RCCT,2) 131 ..S @RCERR1@(RCCT,3)=" The reported amount paid on this bill was: "_$P(^TMP($J,"RCDPEOB",RCCT,"EOB"),U,2) 132 ..I RCIFN'>0 D 133 ...S @RCERR1@(RCCT,4)=" If the bill is not for your site, it must be transferred to the" 134 ...S @RCERR1@(RCCT,5)=" correct site and manually adjusted in your AR." 135 ...S @RCERR1@(RCCT,6)=" You can perform this transfer using EDI Lockbox ERA/EEOB exception process." 136 ...S @RCERR1@(RCCT,7)=" " 137 ..D DISP1^RCDPESR5(RCCT,1) 138 ..S Q=0 F S Q=$O(^TMP($J,"RCDP-EOB",RCCT,Q)) Q:'Q S ^TMP($J,"RCDPEOB",RCCT,Q)=$G(^TMP($J,"RCDP-EOB",RCCT,Q,0)) 139 ..S ^TMP($J,"RCDPEOB",RCCT)=^TMP($J,"RCDP-EOB",RCCT,0) M ^TMP($J,"RCDPEOB",RCCT,"ERR")=@RCERR1@(RCCT) 140 ..I RCFILE=5 D ;Store err if trans-in failed 141 ...N RCE,RC,DIE,X,Y,DA,DR 142 ...S RCE(1)=$$FMTE^XLFDT($$NOW^XLFDT(),2)_" "_$G(@RCERR1@(RCCT,"*")) 143 ...S RCE(2)=" ",RCFILED=0 144 ...D WP^DIE(344.5,RCTDA_",",5,"A","RCE") 145 .I RCIFN>0 D 146 ..N RCDUPEOB,RCALLDUP 147 ..;Chk rec exists 148 ..S RCDUPEOB=0 149 ..S RCEOB=$$DUP^RCDPESR3(RCMNUM,RCIFN,$P($G(^TMP($J,"RCDPEOB",RCCT,"EOB")),U,2),$P($G(^TMP($J,"RCDPEOB",RCCT,"EOB")),U,6)) ;Same msg for update? 150 ..I RCEOB,$P(RCEOB,U,2) S RCEOB=0 ;If chksum exists, let below check it 151 ..S ^TMP($J,"RCDP-EOB",RCCT,.5,0)="835ERA" ;Needed - checksum 152 ..S RCALLDUP=$$DUP^IBCEOB("^TMP("_$J_",""RCDP-EOB"","_RCCT_")",RCIFN) 153 ..I $S(RCALLDUP:1,RCEOB:$G(DUP)'>0,1:0) D 154 ...S RCDUPEOB=1 155 ...D DUPREC^RCDPESR6(RCET,RCCT,RCSTAR,RCFILE,RCALLDUP,RCEOB,RCBILL,.RCDUPEOB) 156 ...S:RCALLDUP RCEOBD=RCALLDUP 157 ..;Add stub to 361.1 158 ..I 'RCDUPEOB S RCEOB=+$$ADD3611^IBCEOB(RCMNUM,"","",RCIFN,1,"^TMP("_$J_",""RCDP-EOB"","_RCCT_")") ;IA 4042 159 ..K ^TMP($J,"RCDP-EOB",RCCT,.5,0) 160 ..I RCEOB<0 D:$G(DUP)'>0 Q 161 ...S @RCERR1@(RCCT)=" ",^(RCCT,1)=RCET_RCCT_RCSTAR,RCFILED=0 162 ...S @RCERR1@(RCCT,2)="Error - EEOB detail not added to IB for bill "_RCBILL,$P(^TMP($J,"RCDPEOB",RCCT,"EOB"),U)="" 163 ...S:RCFILE=5 @RCERR1@(RCCT,"*")=@RCERR1@(RCCT,2) 164 ...D DISP1^RCDPESR5(RCCT,1) 165 ...S Q=0 F S Q=$O(^TMP($J,"RCDP-EOB",RCCT,Q)) Q:'Q S ^TMP($J,"RCDPEOB",RCCT,Q)=$G(^TMP($J,"RCDP-EOB",RCCT,Q,0)) 166 ...S ^TMP($J,"RCDPEOB",RCCT)=^TMP($J,"RCDP-EOB",RCCT,0) M ^TMP($J,"RCDPEOB",RCCT,"ERR")=@RCERR1@(RCCT) 167 ..;Upd 361.1, needs ^TMP($J,"RCDPEOB","HDR" and $J,"RCDP-EOB" 168 ..I RCDUPEOB'<0 S RCNOUPD=0 D UPD3611^IBCEOB(RCEOB,RCCT,1) 169 ..;errors in ^TMP("RCDPERR-EOB",$J 170 ..I $O(^TMP("RCDPERR-EOB",$J,0)) D ERRUPD^IBCEOB(RCEOB,"RCDPERR-EOB") 171 ..S $P(^TMP($J,"RCDPEOB",RCCT,"EOB"),U)=$S('$G(RCEOBD):RCEOB,1:RCEOBD) 172 .K ^TMP("RCDPERR-EOB",$J) 173 ; 174 I RCNOUPD D DUPERA^RCDPESR3($G(DUP),RCNOUPD) 175 I $O(@RCERR1@("")) D BULLS^RCDPESR3(RCFILE,RCTDA,$S(RCNOUPD:RCNOUPD,1:$G(DUP)),$G(RCXMG)) 176 K ^TMP("RCDPERR-EOB",$J),^TMP($J,"RCDP-EOB"),@RCERR1,@RCSD 177 D CLEAN^DILF 178 Q 1 RCDPESR2 ;ALB/TMK - Server auto-upd - EDI Lockbox ;06/03/02 2 ;;4.5;Accounts Receivable;**173,216,208,230**;Mar 20, 1995 3 ;;Per VHA Directive 10-93-142, this routine should not be modified. 4 ; IA 4042 (IBCEOB) 5 ; 6 TASKERA(RCTDA) ; Task to upd ERA 7 ; RCTDA = ien 344.5 8 N ZTDTH,ZTUCI,ZTSAVE,ZTIO,ZTDESC,ZTRTN,ZTSK,DIE,DR,DA 9 S (ZTSAVE("DT"),ZTSAVE("U"),ZTSAVE("DUZ"))="",ZTSAVE("ZTREQ")="@",ZTRTN="NEWERA^RCDPESR2("_RCTDA_",0)",ZTDTH=$H,ZTIO="" 10 D ^%ZTLOAD 11 Q 12 ; 13 NEWERA(RCTDA,RCREFILE) ;Tasked 14 ; Add new EOB's to IB & ERA tot rec to AR 15 ; RCTDA = ien 344.5 16 ; RCREFILE = 1: re-filing rec via exc proc 17 N RCDUPERR,RCPAYER,RCRTOT,RCE,RCEC,RCERR,RCR1,RCADJ,DIE,DR,DA,Z,Q 18 S ZTREQ="@" 19 K ^TMP($J,"RCDPERA") 20 L +^RCY(344.5,RCTDA):5 21 I $D(ZTQUEUED) S DIE="^RCY(344.5,",DA=RCTDA,DR=".05////"_ZTSK_";.04////1" D ^DIE 22 I $P($G(^RCY(344.5,RCTDA,0)),U,5),'$G(RCREFILE) S DIE="^RCY(344.5,",DA=RCTDA,DR=".1////4;.08///1" D ^DIE 23 S RCR1=$P($G(^RCY(344.5,RCTDA,0)),U,7),RCPAYER=$P($G(^RCY(344.5,RCTDA,3)),U) 24 S RCRTOT=$S(RCR1:RCR1,1:$$ERATOT^RCDPESR6(RCTDA,.RCERR)) ; ERA rec 25 S RCDUPERR=$S($G(RCERR)="DUP"!($G(RCERR(1))=-2):$G(RCERR(1)),1:0) K RCERR(1) 26 I RCRTOT,'RCR1 S DIE="^RCY(344.5,",DR=".07////"_RCRTOT,DA=RCTDA D ^DIE 27 D:RCDUPERR'=-2 UPDEOB(RCTDA,5,$S('$G(RCREFILE):RCDUPERR,1:-1)) ; Add EOB det to IB 28 I RCRTOT D UPDCON^RCDPESR6(RCRTOT),UPDADJ^RCDPESR6(RCRTOT),UPD3444^RCDPESR6(.RCRTOT) ; Bills added 344.41 29 I RCRTOT,RCTDA S DIE="^RCY(344.5,",DR=".08////0;.1///@",DA=RCTDA D ^DIE 30 I 'RCRTOT D G QNEW 31 .I RCDUPERR Q:'RCTDA D S RCTDA="" Q 32 ..I RCDUPERR=-2 D BULLERA^RCDPESR0("D",RCTDA,$P($G(^RCY(344.5,RCTDA,0)),U,11),"EDI LBOX - DUPLICATE ERA NOT FILED "_$E(RCPAYER,1,20),.RCERR,0) 33 ..D TEMPDEL^RCDPESR1(RCTDA) 34 .S RCE(1)=$$FMTE^XLFDT($$NOW^XLFDT(),2)_" An error occurred while storing ERA data.",RCE(2)="No totals data was stored for this ERA record"_$S('$G(RCREFILE):" and an",1:" on this re-file attempt.") 35 .S RCE(3)=$S('$G(RCREFILE):"ERA transmission exception was created.",1:"") 36 .D WP^DIE(344.5,RCTDA_",",5,"A","RCE") 37 .S DIE="^RCY(344.5,",DA=RCTDA,DR=".07///@;.08////1;.1////1" D ^DIE 38 .K RCERR 39 .S RCERR(1)=$$FMTE^XLFDT($$NOW^XLFDT(),2)_" The ERA data could not be stored. The AR receipt",RCERR(2)=" for this data must be created/processed manually for the bills included" 40 .S RCERR(3)=" in this ERA."_$S('$G(RCREFILE):"",1:" This error occurred during a refile attempt."),RCERR(4)=" " 41 .D BULLERA^RCDPESR0("DF",RCTDA,$P($G(^RCY(344.5,RCTDA,0)),U,11),"EDI LBOX - TOTALS FILE EXCEPTION "_$E(RCPAYER,1,20),.RCERR,0) 42 .K RCERR 43 I $$ADJ^RCDPEU(RCRTOT,.RCADJ) D ;Bulletin adjs 44 .S RCEC=$$ADJERR^RCDPESR3(.RCERR) 45 .I RCADJ'=2 S RCEC=RCEC+1,RCERR(RCEC)=" THERE ARE ERA LEVEL ADJUSTMENT(S)",RCEC=RCEC+1,RCERR(RCEC)=" " 46 .I RCADJ'=1 S RCEC=RCEC+1,RCERR(RCEC)=" THE FOLLOWING BILL(S) HAVE RETRACTIONS:" D 47 ..S (Q,Z)=0 S Z=0 F S Z=$O(RCADJ(RCRTOT,Z)) Q:'Z S:'Q RCEC=RCEC+1,RCERR(RCEC)=" " S Q=Q+1,RCERR(RCEC)=RCERR(RCEC)_" "_RCADJ(RCRTOT,Z) S:Q=4 Q=0 48 ..S RCEC=RCEC+1,RCERR(RCEC)=" " 49 .D BULLERA^RCDPESR0("D",RCTDA,$P($G(^RCY(344.5,RCTDA,0)),U,11),"EDI LBOX - ERA HAS ADJ/TAKEBACKS "_$E(RCPAYER,1,20),.RCERR,0) 50 ; 51 QNEW I RCTDA,'$P($G(^RCY(344.5,RCTDA,0)),U,8) D TEMPDEL^RCDPESR1(RCTDA) S RCTDA="" 52 I RCTDA,$P($G(^RCY(344.5,RCTDA,0)),U)'="" S DIE="^RCY(344.5,",DR=".04////0;.05///@"_$S('$G(RCR1)&$G(RCRTOT):";.07////"_RCRTOT,1:""),DA=RCTDA D ^DIE 53 K ^TMP($J,"RCDPERA") 54 I RCTDA L -^RCY(344.5,RCTDA) 55 Q 56 ; 57 UPDEOB(RCTDA,RCFILE,DUP) ;Upd 361.1 from ERA msg in 344.5 or .4 58 ; RCTDA = ien ERA msg in 344.5 or ;subfile in 344.4 59 ; RCFILE = 4 file 344.4, 5 if 344.5 60 ; DUP = msg # if dup msg, but not same # or -1 if same msg # 61 ;Returned for each bill in ERA: 62 ; ^TMP($J,"RCDPEOB",n)=Bill ien^AR bill#^Service Date 63 ; ^TMP($J,"RCDPEOB",n,"EOB")=EOB ien^amt pd^ins co ptr^reversal flag^pt name on EEOB^amt billed 64 ; ^TMP($J,"RCDPEOB","ADJ",x)=adj rec ('02') 65 ;Also: 66 ; ^TMP($J,"RCDPEOB","HDR")=hdr rec from txmn 67 ; ^TMP($J,"RCDPEOB","CONTACT")=ERA contact rec ('01') 68 ; 69 N RCGBL,RC,RC0,RCCT,RCCT1,RCEOB,RCBILL,RCMNUM,RCIFN,RCIB,RCERR,RCSTAR,RCET,RCX,RCXMG,Z,Q,DA,DR,DIE,RCPAYER,RCFILED,RCEOBD,RCNOUPD,REFORM,RCSD,RCERR1,C5 70 K ^TMP($J,"RCDP-EOB"),^TMP("RCDPERR-EOB",$J) 71 ; 72 S RCPAYER="",RCFILED=1,RCNOUPD=0 73 I RCFILE=5 D 74 .S RCGBL=$NA(^RCY(344.5,RCTDA,2)) 75 .S RCMNUM=+$G(^RCY(344.5,RCTDA,0)),RCXMG=$P($G(^(0)),U,11) 76 .I $G(DUP) S RCNOUPD=$S(DUP>0:+DUP,1:RCXMG) 77 .S ^TMP($J,"RCDPEOB","HDR")=$G(^RCY(344.5,RCTDA,2,1,0)) 78 .I $P(^TMP($J,"RCDPEOB","HDR"),U)["XFR",'$P($G(^RCY(344.5,RCTDA,0)),U,14) D 79 ..D SENDACK^RCDPESR5(RCTDA,1) 80 ..S DR=".14////1",DIE="^RCY(344.5,",DA=RCTDA D ^DIE 81 ; 82 I RCFILE=4 D 83 .S RCGBL=$NA(^RCY(344.4,+RCTDA,1,+$P(RCTDA,";",2),1)) 84 .S RCMNUM=$P($G(^RCY(344.4,+RCTDA,0)),U,12),RCXMG=$P($G(^(0)),U,12) 85 .S ^TMP($J,"RCDPEOB","HDR")=$G(^RCY(344.4,+RCTDA,1,+$P(RCTDA,";",2),1,1,0)) 86 ; 87 S RCPAYER=$P($G(^TMP($J,"RCDPEOB","HDR")),U,6) 88 ; 89 ;srv dates 90 S RCSD=$NA(^TMP($J,"RCSRVDT")) K @RCSD 91 S RC=1,C5=0 92 F S RC=$O(@RCGBL@(RC)) Q:'RC S RC0=$G(^(RC,0)) D 93 .I RC0<5 Q 94 .I +RC0=5 S C5=RC Q 95 .I +RC0=40,$P(RC0,U,2)?1.7N,C5,'$D(@RCSD@(C5)) S @RCSD@(C5)=$P(RC0,U,19) ;serv date 96 ; 97 S RC=1,(RCCT,RCCT1,RCX,REFORM)=0,RCBILL="" 98 S RCERR1=$NA(^TMP("RCERR1",$J)) K @RCERR1 99 F S RC=$O(@RCGBL@(RC)) Q:'RC S RC0=$G(^(RC,0)) D 100 .I RCFILE=5,+RC0=1 D Q 101 ..S ^TMP($J,"RCDPEOB","CONTACT")=RC0 102 .; 103 .I RCFILE=5,+RC0=2 D Q 104 ..S RCX=RCX+1,^TMP($J,"RCDPEOB","ADJ",RCX)=RC0 105 .; 106 .I +RC0=5 S RCCT=RCCT+1,RCCT1=0 D 107 ..S REFORM=0 108 ..S Z=$$BILL^RCDPESR1($P(RC0,U,2),$G(@RCSD@(RC)),.RCIB) 109 ..I Z S RCBILL=$P($G(^PRCA(430,Z,0)),U) I RCBILL'="",RCBILL'=$P(RC0,U,2) S REFORM=1,$P(RC0,U,2)=RCBILL 110 ..S RCBILL=$P(RC0,U,2) 111 ..S Z=$S(Z>0:$S($G(RCIB):Z,1:-1),1:-1) 112 ..S ^TMP($J,"RCDP-EOB",RCCT,0)=Z_U_RCBILL_U_$G(@RCSD@(RC)) 113 ..S $P(^TMP($J,"RCDPEOB",RCCT,"EOB"),U,5)=$P(RC0,U,3)_","_$P(RC0,U,4)_" "_$P(RC0,U,5) ;Save pt nm 114 ..I Z>0 S Q=+$P($G(^PRCA(430,Z,0)),U,9) I $P($G(^RCD(340,Q,0)),U)["DIC(36," S $P(^TMP($J,"RCDPEOB",RCCT,"EOB"),U,3)=+^RCD(340,Q,0) ;Save ins co 115 .; 116 .I +RC0>5,REFORM S $P(RC0,U,2)=RCBILL ; 117 .I +RC0=10 D ;Save amt pd/billed, rev flg 118 ..S $P(^TMP($J,"RCDPEOB",RCCT,"EOB"),U,2)=$S(+$P(RC0,U,11):$J($P(RC0,U,11)/100,"",2),1:0),$P(^TMP($J,"RCDPEOB",RCCT,"EOB"),U,6)=$J($P(RC0,U,11),"",2) 119 ..I $P(RC0,U,6)="Y"!($P(RC0,U,7)=22) S $P(^TMP($J,"RCDPEOB",RCCT,"EOB"),U,4)=1 120 .I RCBILL=$P(RC0,U,2) S RCCT1=RCCT1+1,^TMP($J,"RCDP-EOB",RCCT,RCCT1,0)=RC0 121 ; 122 S RCSTAR=$TR($J("",15)," ","*"),RCET=RCSTAR_"ERROR/WARNING EEOB DETAIL SEQ #" 123 S RCCT=0 F S RCCT=$O(^TMP($J,"RCDP-EOB",RCCT)) Q:'RCCT S RCIFN=+$G(^(RCCT,0)),RCBILL=$P($G(^(0)),U,2),^TMP($J,"RCDPEOB",RCCT)=$G(^TMP($J,"RCDP-EOB",RCCT,0)) D 124 .S RCEOB=-1,RCEOBD="" 125 .I $S(RCIFN>0:$P(^PRCA(430.3,+$P($G(^PRCA(430,+RCIFN,0)),U,8),0),U,3)'=102,RCIFN'>0&($G(DUP)'>0):1,1:0) D 126 ..S @RCERR1@(RCCT)=" ",@RCERR1@(RCCT,1)=RCET_RCCT_RCSTAR 127 ..S @RCERR1@(RCCT,2)="Bill "_RCBILL_" is"_$S(RCIFN>0:" not in an ACTIVE status in your A/R",1:"n't valid/wasn't found so its detail wasn't stored in IB") 128 ..S:RCFILE=5 @RCERR1@(RCCT,"*")=@RCERR1@(RCCT,2) 129 ..S @RCERR1@(RCCT,3)=" The reported amount paid on this bill was: "_$P(^TMP($J,"RCDPEOB",RCCT,"EOB"),U,2) 130 ..I RCIFN'>0 D 131 ...S @RCERR1@(RCCT,4)=" If the bill is not for your site, it must be transferred to the" 132 ...S @RCERR1@(RCCT,5)=" correct site and manually adjusted in your AR." 133 ...S @RCERR1@(RCCT,6)=" You can perform this transfer using EDI Lockbox ERA/EEOB exception process." 134 ...S @RCERR1@(RCCT,7)=" " 135 ..D DISP1^RCDPESR5(RCCT,1) 136 ..S Q=0 F S Q=$O(^TMP($J,"RCDP-EOB",RCCT,Q)) Q:'Q S ^TMP($J,"RCDPEOB",RCCT,Q)=$G(^TMP($J,"RCDP-EOB",RCCT,Q,0)) 137 ..S ^TMP($J,"RCDPEOB",RCCT)=^TMP($J,"RCDP-EOB",RCCT,0) M ^TMP($J,"RCDPEOB",RCCT,"ERR")=@RCERR1@(RCCT) 138 ..I RCFILE=5 D ;Store err if trans-in failed 139 ...N RCE,RC,DIE,X,Y,DA,DR 140 ...S RCE(1)=$$FMTE^XLFDT($$NOW^XLFDT(),2)_" "_$G(@RCERR1@(RCCT,"*")) 141 ...S RCE(2)=" ",RCFILED=0 142 ...D WP^DIE(344.5,RCTDA_",",5,"A","RCE") 143 .I RCIFN>0 D 144 ..N RCDUPEOB,RCALLDUP 145 ..;Chk rec exists 146 ..S RCDUPEOB=0 147 ..S RCEOB=$$DUP^RCDPESR3(RCMNUM,RCIFN,$P($G(^TMP($J,"RCDPEOB",RCCT,"EOB")),U,2),$P($G(^TMP($J,"RCDPEOB",RCCT,"EOB")),U,6)) ;Same msg for update? 148 ..I RCEOB,$P(RCEOB,U,2) S RCEOB=0 ;If chksum exists, let below check it 149 ..S ^TMP($J,"RCDP-EOB",RCCT,.5,0)="835ERA" ;Needed - checksum 150 ..S RCALLDUP=$$DUP^IBCEOB("^TMP("_$J_",""RCDP-EOB"","_RCCT_")",RCIFN) 151 ..I $S(RCALLDUP:1,RCEOB:$G(DUP)'>0,1:0) D 152 ...S RCDUPEOB=1 153 ...D DUPREC^RCDPESR6(RCET,RCCT,RCSTAR,RCFILE,RCALLDUP,RCEOB,RCBILL,.RCDUPEOB) 154 ...S:RCALLDUP RCEOBD=RCALLDUP 155 ..;Add stub to 361.1 156 ..I 'RCDUPEOB S RCEOB=+$$ADD3611^IBCEOB(RCMNUM,"","",RCIFN,1,"^TMP("_$J_",""RCDP-EOB"","_RCCT_")") ;IA 4042 157 ..K ^TMP($J,"RCDP-EOB",RCCT,.5,0) 158 ..I RCEOB<0 D:$G(DUP)'>0 Q 159 ...S @RCERR1@(RCCT)=" ",^(RCCT,1)=RCET_RCCT_RCSTAR,RCFILED=0 160 ...S @RCERR1@(RCCT,2)="Error - EEOB detail not added to IB for bill "_RCBILL,$P(^TMP($J,"RCDPEOB",RCCT,"EOB"),U)="" 161 ...S:RCFILE=5 @RCERR1@(RCCT,"*")=@RCERR1@(RCCT,2) 162 ...D DISP1^RCDPESR5(RCCT,1) 163 ...S Q=0 F S Q=$O(^TMP($J,"RCDP-EOB",RCCT,Q)) Q:'Q S ^TMP($J,"RCDPEOB",RCCT,Q)=$G(^TMP($J,"RCDP-EOB",RCCT,Q,0)) 164 ...S ^TMP($J,"RCDPEOB",RCCT)=^TMP($J,"RCDP-EOB",RCCT,0) M ^TMP($J,"RCDPEOB",RCCT,"ERR")=@RCERR1@(RCCT) 165 ..;Upd 361.1, needs ^TMP($J,"RCDPEOB","HDR" and $J,"RCDP-EOB" 166 ..I RCDUPEOB'<0 S RCNOUPD=0 D UPD3611^IBCEOB(RCEOB,RCCT,1) 167 ..;errors in ^TMP("RCDPERR-EOB",$J 168 ..I $O(^TMP("RCDPERR-EOB",$J,0)) D ERRUPD^IBCEOB(RCEOB,"RCDPERR-EOB") 169 ..S $P(^TMP($J,"RCDPEOB",RCCT,"EOB"),U)=$S('$G(RCEOBD):RCEOB,1:RCEOBD) 170 .K ^TMP("RCDPERR-EOB",$J) 171 ; 172 I RCNOUPD D DUPERA^RCDPESR3($G(DUP),RCNOUPD) 173 I $O(@RCERR1@("")) D BULLS^RCDPESR3(RCFILE,RCTDA,$S(RCNOUPD:RCNOUPD,1:$G(DUP)),$G(RCXMG)) 174 K ^TMP("RCDPERR-EOB",$J),^TMP($J,"RCDP-EOB"),@RCERR1,@RCSD 175 D CLEAN^DILF 176 Q
Note:
See TracChangeset
for help on using the changeset viewer.
