19. EPMO Open Source Coordination Office Redaction File Detail Report

Produced by Araxis Merge on 2/27/2019 2:32:58 PM Eastern Standard Time. See www.araxis.com for information about Merge. This report uses XHTML and CSS2, and is best viewed with a modern standards-compliant browser. For optimum results when printing this report, use landscape orientation and enable printing of background images and colours in your browser.

19.1 Files compared

# Location File Last Modified
1 MCCF_EDI_TAS_P2_PRCA_4_5_332.zip\MCCF_EDI_TAS_P2_PRCA_4_5_332\PRCA_4_5_332_IB_2_0_633.zip TAS ePay US809 SDD.docx Fri Jan 25 13:46:20 2019 UTC
2 MCCF_EDI_TAS_P2_PRCA_4_5_332.zip\MCCF_EDI_TAS_P2_PRCA_4_5_332\PRCA_4_5_332_IB_2_0_633.zip TAS ePay US809 SDD.docx Mon Feb 25 20:55:25 2019 UTC

19.2 Comparison summary

Description Between
Files 1 and 2
Text Blocks Lines
Unchanged 2 994
Changed 1 2
Inserted 0 0
Removed 0 0

19.3 Comparison options

Whitespace
Character case Differences in character case are significant
Line endings Differences in line endings (CR and LF characters) are ignored
CR/LF characters Not shown in the comparison detail

19.4 Active regular expressions

No regular expressions were active.

19.5 Comparison detail

  1   MCCF EDI T AS US809
  2   System Des ign Docume nt
  3   PRCA*4.5*X XX
  4  
  5  
  6  
  7  
  8   Department  of Vetera ns Affairs
  9   April 2018
  10   Version 1
  11   User Story  ID: US809
  12   User Story  Name:  Ne ed a listm anager (Wo rklist) sh owing all  ERAs that  were marke d as dupli cates
  13   Story
  14   As a...
  15   I want to. ..
  16   So that...
  17   ePay User
  18   Need a lis tmanager ( Worklist)  showing al l ERAs tha t were mar ked as dup licates, w ith the ab ility to m ark it as  NON duplic ate
  19    End users  can have  access to  all ERAs s ent to Vis tA decreas ing the de pendency o f VistA Pr oduct Supp ort to tro ubleshoot  duplicate  eRAs
  20  
  21   Conversati on (if des ired by de velopers)
  22   New workli st that di splays all  duplicate  ERAs that  are sent  in that do  not popul ate the ER A worklist .  Previou sly, these  duplicate s were del eted as pa rt of the  Nightly AR  Process
  23   What happe ns to the  ERA once t hey are de emed as du plicates?  They do no t load int o VistA.   Assumed dr opped; nee ds to be v alidated t hrough the  nightly p rocess.
  24  
  25   Summary:
  26   Changes to  the 835ER A Receiver s
  27   Currently  when 835ER A messages  from FSC  are sent t o the G.ML B mail gro up in Vist A the mess ages are p rocessed b y the mail  server op tion RCDPE  EDI LOCKB OX SERVER  and saved  in AR EDI  LOCKBOX ME SSAGES fil e #344.5.  If 835ERA  messages a re duplica tes of pri or transmi ssions, th e messages  are delet ed from fi le #344.5  and a noti fication o f duplicat e 835ERA t ransmissio n is sent  as a bulle tin to mai l group  G .RCDPE PAY MENTS EXCE PTIONS.
  28   This proce ss will be  changed s o that dup licate 835 ERA messag es are not  deleted f rom file # 344.5 but  instead ar e marked a s duplicat e transmis sions in f ile #344.5 . The 835E RA message s will rem ain in fil e #344.5 a nd will no t be proce ssed into  the ERA fi le #344.4  without us er interve ntion.
  29   The bullet in sent to  G.RCDPE P AYMENTS EX CEPTIONS a bout delet ed duplica tes will b e removed.
  30  
  31   New Duplic ate ERA Tr ansmission  Worklist
  32  
  33   A new menu  option ‘D uplicate E RA Transmi ssions’ wi ll provide  a worklis t option t o allow us ers to fil e or delet e 835ERA f lagged as  duplicate  transmissi ons in #34 4.5. The ‘ File Messa ge’ action  will tran sfer accep ted duplic ates from  file #344. 5 to the E RA file #3 44.4 in th e same fas hion as th e existing  Transmiss ion Except ion Workli st and als o removes  the messag e from the  duplicate s worklist . Delete a nd View ac tions will  work in t he same fa shion as t he equival ent option s in the e xisting Tr ansmission  Exception  Worklist.
  34  
  35   DUPLICATE  ERA TRANSM ISSION WOR KLIST  Mar  13, 2018@ 11:57:58        Page:        1      
  36                          DUPLICATE  835ERA ME SSAGES
  37    
  38   + #   Mess age ID             Ms g Typ  Dat e Received          M ail Msg #            
  39   2     3074 03                 ER A      MAR  22, 2017@ 13:02    3 07403                
  40       EXCEPT ION: SUMMA RY RECORD  STORE ERRO R                                          
  41         Paye r Name: AE TNA -CONTI NENTAL LIF E INSURANC E COMPANY  OF BRENTWO OD        
  42         Paye r ID:                                                                       
  43         Trac e #:                                                                        
  44         Date  Paid:      Total Amt  Paid: 0.0 0                                          
  45              *000002121 231                                                              
  46  
  47   +          Enter ?? f or more ac tions                                                 
  48       View/P rint Messa ge         Delete Mes sage             Exit
  49       File M essage                TPJI
  50   Select Act ion: Next  Screen//
  51  
  52   The 835ERA  receivers  will be m odified to  check if  the 835ERA  is flagge d as a dup licate in  file #344. 5 – this i dentifies  that the 8 35ERA is b eing filed  from the  new Duplic ate ERA Tr ansmission  Worklist  – and will  add a uni que ‘DUP’  suffix to  the TRACE  NUMBER of  the ERA cr eated in f ile #344.4  so that t he ERA is  no longer  be a dupli cate. In t he case of  triplicat e or furth er transmi ssions an  additional  numeric s uffix will  be added  to the TRA CE NUMBER.  If the re vised trac e number w ith suffix  is greate r than 50  characters  the origi nal trace  number wil l be trunc ated befor e adding t he suffix.  
  53  
  54   Changes to  Transmiss ion Except ions
  55  
  56   The existi ng Transmi ssion Exce ptions wor klist in t he [RCDPE  EXCEPTION  PROCESSING ] menu opt ion will b e modified  to exclud e 835ERA f lagged as  duplicates .
  57  
  58  
  59  
  60   Data Dicti onary Chan ges
  61   An new fie ld will be  added to  the AR EDI  LOCKBOX M ESSAGES fi le #344.5
  62   STANDARD D ATA DICTIO NARY #344. 5 -- AR ED I LOCKBOX  MESSAGES F ILE   3/13 /18    PAG
  63   E 1
  64   STORED IN  ^RCY(344.5   (79 ENTRIE S)     SITE: TEST : D NS . URL  UCI: VIST
  65   A,ROU                                                                (VERSIO N 4.5)   
  66  
  67   DATA           NAME                    GLOB AL         DATA
  68   ELEMENT        TITLE                   LOCA TION       TYPE
  69   ---------- ---------- ---------- ---------- ---------- ---------- ---------- ---------
  70  
  71   344.5,.15      DUPLIC ATE INDICA TOR    0;1 5 SET
  72  
  73                                      '0' FOR  NO; 
  74                                      '1' FOR  YES; 
  75                  LAST E DITED:       MAR 13,  2018 
  76                  DESCRI PTION:       This fie ld indicat es the inc oming 835  message
  77                                      is a dup licate tra nsmission.   
  78  
  79                  TECHNI CAL DESCR:   This fie ld is used  in 835 fi ling routi nes to
  80                                      overide  the duplic ate checks .
  81  
  82  
  83   Routines c hanges
  84   The follow ing existi ng routine s will be  modified:
  85   RCDPESR2 –  Mail Serv er
  86  
  87   The routin e will be  modified t o remove d eletion of  the dupli cate messa ge from fi le #344.5  (TEMPDEL^R CDPESR1) a nd instead  mark the  message as  a duplica te ERA usi ng the new  field #34 4.5, #.15.
  88  
  89   RCDPESR6 –  Mail Serv er and Fil e Message  options in  Transmiss ion Except ions/Dupli cate ERA W orklist
  90  
  91   The routin e will be  modified t o file dup licate ERA  from the  new Duplic ate ERA Wo rklist wit h a unique  trace num ber. The n ew trace n umber will  have a “- DUP” or “– DUP”_N suf fix.
  92  
  93   RCDPEX1 –  Transmissi on Excepti ons Workli st display
  94  
  95   This routi ne will be  modified  to include  a new ent ry point E N1^RCDPEX1  for the n ew RCDPE D UPLICATE E RA WORKLIS T menu opt ion. This  entry poin t will inv oke the ne w RCDPEX D UPLICATE E RA LIST de scribed un der Other  Components  below.
  96  
  97   The routin e will als o be modif ied to inc lude new e ntry point s INITD^RC DPEX1 and  HDR1^RCDPE X1 for the  new RCDPE X DUPLICAT E ERA LIST  list of d uplicate E RAs.
  98  
  99   The routin e will als o be modif ied to fil ter only T ransmissio n exceptio ns for the  Transmiss ion Except ion list a nd only Du plicate ER A for the  Duplicate  ERA list. 
  100   RCDPEX5 –  Duplicate  ERA Workli st actions
  101  
  102   This new r outine wil l contain  entry poin ts DEL^RCD PEX5, UPD^ RCDPEX5 an d VP^RCDPE X5 for the  new RCDPE X DUP EXCE PTION MENU  protocol  menu liste d below in  section 3 .
  103  
  104  
  105   Other comp onents
  106  
  107   A new menu  option RC DPE DUPLIC ATE ERA WO RKLIST wil l be added  to the ex isting RCD PE EDI LOC KBOX MENU  option. Th e menu opt ion will u se the new  entry poi nt EN1^RCD PEX1.
  108   A new list manager LI ST RCDPEX  DUPLICATE  ERA LIST w ill be a c lone of th e existing  RCDPEX EO B EXCEPTIO N LIST and  will use  existing p rotocols w ith a new  ENTRY CODE  routine I NITD^RCDPE X1 to buil d the list  of duplic ate ERAs a nd a new h eader rout ine HDR1^R CDPEX1.
  109  
  110   NAME: RCDP EX DUPLICA TE ERA LIS T          TYPE OF LI ST: PROTOC OL
  111     RIGHT MA RGIN: 80                         TOP MARGIN : 5
  112     BOTTOM M ARGIN: 19                        OK TO TRAN SPORT?: OK
  113     USE CURS OR CONTROL : YES
  114     ENTITY N AME: EDI L ockbox Dup licate ERA
  115     PROTOCOL  MENU: RCD PEX DUP EX CEPTION ME NU
  116     SCREEN T ITLE: DUPL ICATE ERA  TRANSMISSI ON WORKLIS T  
  117     ALLOWABL E NUMBER O F ACTIONS:  1         AUTOMATIC  DEFAULTS:  YES
  118     HIDDEN A CTION MENU : VALM HID DEN ACTION S
  119     ARRAY NA ME:  ^TMP( "RCDPEX-EO B",$J)
  120   ITEM NAME:  NUMBER                          COLUMN: 1
  121     WIDTH: 4                                  DISPLAY TE XT:   #
  122   ITEM NAME:  MSG_ID                          COLUMN: 7
  123     WIDTH: 2 0                                DISPLAY TE XT: Messag e ID
  124   ITEM NAME:  MSG_TYPE                        COLUMN: 29
  125     WIDTH: 7                                  DISPLAY TE XT: Msg Ty pe
  126   ITEM NAME:  REC_DATE                        COLUMN: 38
  127     WIDTH: 2 0                                DISPLAY TE XT: Date R eceived
  128   ITEM NAME:  MAIL MESS AGE #                 COLUMN: 60
  129     WIDTH: 1 7                                DISPLAY TE XT: Mail M sg #
  130     EXIT COD E: D FNL^R CDPEX1                HEADER COD E: D HDR1^ RCDPEX1
  131   ENTRY CODE : D INITD^ RCDPEX1
  132  
  133   A new prot ocol menu  RCDPEX DUP  EXCEPTION  MENU will  be create d for the  RCDPEX DUP LICATE ERA  LIST abov e.
  134  
  135   NAME: RCDP EX DUP EXC EPTION MEN U          TYPE: menu
  136    PACKAGE:  ACCOUNTS R ECEIVABLE
  137    DESCRIPTI ON:   This  is the ma in menu th at contain s the acti ons that c an be
  138    performed  manually  on a dupli cate ERA m essages.  
  139     COLUMN W IDTH: 26                         MNEMONIC W IDTH: 4
  140   ITEM: VALM  QUIT                            SEQUENCE:  100
  141     DISPLAY  NAME: Exit
  142   ITEM: RCDP EX DELETE  DUP MESSAG E          SEQUENCE:  30
  143   ITEM: RCDP EX FILE DU PLICATE ME SSAGE      SEQUENCE:  20
  144   ITEM: RCDP EX VIEW/PR INT DUP ME SSAGE      SEQUENCE:  10
  145   ITEM: RCDP E EOB WORK LIST TPJI             SEQUENCE:  35
  146     EXIT ACT ION: I $G( RCFASTXT)  S VALMBCK= "Q"
  147     HEADER:  D SHOW^VAL M                     MENU PROMP T: Select  Action: 
  148     
  149   New protoc ol actions  will be c reated for  the new p rotocol me nu RCDPEX  DUP EXCEPT ION MENU a bove.
  150  
  151   NAME: RCDP EX DELETE  DUP MESSAG E              ITEM T EXT: Delet e Message
  152     TYPE: ac tion                                 LOCK:  RCDPE ERA  EXCEPT                   
  153     PACKAGE:  ACCOUNTS  RECEIVABLE
  154    DESCRIPTI ON:   This  action al lows a use r to manua lly delete  a duplica te ERA  me ssage that   you eith er can't o r don't wa nt to cont inue throu gh the EDI  Lockbox m essage pro cess.  A b ulletin is  sent to a lert that  this actio n has been  taken.  
  155     ENTRY AC TION: D DE L^RCDPEX5              
  156  
  157  
  158   NAME: RCDP EX FILE DU PLICATE ME SSAGE      ITEM TEXT:  File Mess age
  159     TYPE: ac tion                             PACKAGE: A CCOUNTS RE CEIVABLE
  160    DESCRIPTI ON:   This  action al lows a use r to manua lly force  a duplicat e  
  161    ERA messa ge to proc ess throug h the EDI  Lockbox ER A/EOB file  process.   
  162     ENTRY AC TION: D UP D^RCDPEX5              
  163  
  164  
  165   NAME: RCDP EX VIEW/PR INT DUP ME SSAGE          ITEM T EXT: View/ Print Mess age
  166     TYPE: ac tion                             PACKAGE: A CCOUNTS RE CEIVABLE
  167    DESCRIPTI ON:   This  option al lows the u ser to vie w a duplic ate EDI Lo ckbox                    
  168    ERA messa ge.
  169    ENTRY ACT ION: D VP^ RCDPEX5
  170  
  171   Resolution  – Added C hanged Obj ects
  172  
  173   Routines
  174   Activities
  175   Routine Na me
  176   RCDPESR2
  177   Enhancemen t Category
  178    New
  179    Modify
  180    Delete
  181    No Change
  182   RTM
  183  
  184   Related Op tions
  185   RCDPE EDI  LOCKBOX SE RVER (G.ML B mail ser ver)
  186  
  187   Related Ro utines
  188   Routines “ Called By”
  189   Routines “ Called”   
  190  
  191   RCDPESR4
  192   RCDPEX
  193   RCDPEX31
  194    
  195      ^%ZTLOA D             
  196      $$VALEC ME^BPSUTIL 2  
  197      ^DIE                  
  198      WP^DIE                
  199      CLEAN^D ILF           
  200      $$ADD36 11^IBCEOB     
  201      $$DUP^I BCEOB         
  202      ERRUPD^ IBCEOB        
  203      UPD3611 ^IBCEOB       
  204      BULLERA ^RCDPESR0     
  205      $$BILL^ RCDPESR1      
  206      TEMPDEL ^RCDPESR1     
  207      $$DUP^R CDPESR3       
  208      BULLS^R CDPESR3       
  209      DUPERA^ RCDPESR3      
  210      DISP1^R CDPESR5       
  211      SENDACK ^RCDPESR5     
  212      $$ERATO T^RCDPESR6    
  213      DUPREC^ RCDPESR6      
  214      UPD3444 ^RCDPESR6     
  215      UPDADJ^ RCDPESR6      
  216      UPDCON^ RCDPESR6      
  217      $$FMTE^ XLFDT         
  218      $$NOW^X LFDT          
  219  
  220  
  221   Current Lo gic
  222   RCDPESR2 ; ALB/TMK/DW A - Server  auto-upd  - EDI Lock box ;Jun 0 6, 2014@19 :11:19 ;;4 .5;Account s Receivab le;**173,2 16,208,230 ,252,264,2 69,271,298 ,321**;Mar  20, 1995; Build 121  ;Per VA Di rective 64 02, this r outine sho uld not be  modified.  ; IA 4042  (IBCEOB)  ;Reference  to $$VALE CME^BPSUTI L2 support ed by IA#  6139 ;TASK ERA(RCTDA)  ; Task to  upd ERA ;  RCTDA = i en 344.5 N  ZTDTH,ZTU CI,ZTSAVE, ZTIO,ZTDES C,ZTRTN,ZT SK,DIE,DR, DA S (ZTSA VE("DT"),Z TSAVE("U") ,ZTSAVE("D UZ"))="",Z TSAVE("ZTR EQ")="@",Z TRTN="NEWE RA^RCDPESR 2("_RCTDA_ ",0)",ZTDT H=$H,ZTIO= "" D ^%ZTL OAD Q ;NEW ERA(RCTDA, RCREFILE)  ;Tasked ;  Add new EO B's to IB  & ERA tot  rec to AR  ; RCTDA =  ien 344.5  ; RCREFILE  = 1: re-f iling rec  via exc pr oc N RCDUP ERR,RCPAYE R,RCRTOT,R CE,RCEC,RC ERR,RCR1,R CADJ,DIE,D R,DA,Z,Q S  ZTREQ="@"  K ^TMP($J ,"RCDPERA" ) L +^RCY( 344.5,RCTD A):5 I $D( ZTQUEUED)  S DIE="^RC Y(344.5,", DA=RCTDA,D R=".05//// "_ZTSK_";. 04////1" D  ^DIE I $P ($G(^RCY(3 44.5,RCTDA ,0)),U,5), '$G(RCREFI LE) S DIE= "^RCY(344. 5,",DA=RCT DA,DR=".1/ ///4;.08// /1" D ^DIE  S RCR1=$P ($G(^RCY(3 44.5,RCTDA ,0)),U,7), RCPAYER=$P ($G(^RCY(3 44.5,RCTDA ,3)),U) S  RCRTOT=$S( RCR1:RCR1, 1:$$ERATOT ^RCDPESR6( RCTDA,.RCE RR)) ; ERA  rec S RCD UPERR=$S($ G(RCERR)=" DUP"!($G(R CERR(1))=- 2):$G(RCER R(1)),1:0)  K RCERR(1 ) I RCRTOT ,'RCR1 S D IE="^RCY(3 44.5,",DR= ".07////"_ RCRTOT,DA= RCTDA D ^D IE D:RCDUP ERR'=-2 UP DEOB(RCTDA ,5,$S('$G( RCREFILE): RCDUPERR,1 :-1)) ; Ad d EOB det  to IB I RC RTOT D UPD CON^RCDPES R6(RCRTOT) ,UPDADJ^RC DPESR6(RCR TOT),UPD34 44^RCDPESR 6(.RCRTOT)  ; Bills a dded 344.4 1 I RCRTOT ,RCTDA S D IE="^RCY(3 44.5,",DR= ".08////0; .1///@",DA =RCTDA D ^ DIE I 'RCR TOT D  G Q NEW .I RCD UPERR Q:'R CTDA  D  S  RCTDA=""  Q ..I RCDU PERR=-2 D  BULLERA^RC DPESR0("D" ,RCTDA,$P( $G(^RCY(34 4.5,RCTDA, 0)),U,11), "EDI LBOX  - DUPLICAT E ERA NOT  FILED "_$E (RCPAYER,1 ,20),.RCER R,0) ..D T EMPDEL^RCD PESR1(RCTD A) .S RCE( 1)=$$FMTE^ XLFDT($$NO W^XLFDT(), 2)_" An er ror occurr ed while s toring ERA  data.",RC E(2)="No t otals data  was store d for this  ERA recor d"_$S('$G( RCREFILE): " and an", 1:" on thi s re-file  attempt.")  .S RCE(3) =$S('$G(RC REFILE):"E RA transmi ssion exce ption was  created.", 1:"") .D W P^DIE(344. 5,RCTDA_", ",5,"A","R CE") .S DI E="^RCY(34 4.5,",DA=R CTDA,DR=". 07///@;.08 ////1;.1// //1" D ^DI E .K RCERR  .S RCERR( 1)=$$FMTE^ XLFDT($$NO W^XLFDT(), 2)_" The E RA data co uld not be  stored. T he AR rece ipt",RCERR (2)=" for  this data  must be cr eated/proc essed manu ally for t he bills i ncluded" . S RCERR(3) =" in this  ERA."_$S( '$G(RCREFI LE):"",1:"  This erro r occurred  during a  refile att empt."),RC ERR(4)=" "  .D BULLER A^RCDPESR0 ("DF",RCTD A,$P($G(^R CY(344.5,R CTDA,0)),U ,11),"EDI  LBOX - TOT ALS FILE E XCEPTION " _$E(RCPAYE R,1,20),.R CERR,0) .K  RCERR ;-- --- ; PRCA *4.5*298 -  MailMan m essage dis abled, log ic retaine d - 14 Feb  2014 ;I $ $ADJ^RCDPE U(RCRTOT,. RCADJ) D ; Bulletin a djs ;.S RC EC=$$ADJER R^RCDPESR3 (.RCERR) ; .I RCADJ'= 2 S RCEC=R CEC+1,RCER R(RCEC)="  THERE ARE  ERA LEVEL  ADJUSTMENT (S)",RCEC= RCEC+1,RCE RR(RCEC)="  " ;.I RCA DJ'=1 S RC EC=RCEC+1, RCERR(RCEC )=" THE FO LLOWING BI LL(S) HAVE  RETRACTIO NS:" D ;.. S (Q,Z)=0  S Z=0 F S  Z=$O(RCADJ (RCRTOT,Z) ) Q:'Z S:' Q RCEC=RCE C+1,RCERR( RCEC)=" "  S Q=Q+1,RC ERR(RCEC)= RCERR(RCEC )_" "_RCAD J(RCRTOT,Z ) S:Q=4 Q= 0 ;..S RCE C=RCEC+1,R CERR(RCEC) =" " ;.D B ULLERA^RCD PESR0("D", RCTDA,$P($ G(^RCY(344 .5,RCTDA,0 )),U,11)," EDI LBOX -  ERA HAS A DJ/TAKEBAC KS "_$E(RC PAYER,1,20 ),.RCERR,0 ) ;----- ; QNEW I RCT DA,'$P($G( ^RCY(344.5 ,RCTDA,0)) ,U,8) D TE MPDEL^RCDP ESR1(RCTDA ) S RCTDA= "" I RCTDA ,$P($G(^RC Y(344.5,RC TDA,0)),U) '="" S DIE ="^RCY(344 .5,",DR=". 04////0;.0 5///@"_$S( '$G(RCR1)& $G(RCRTOT) :";.07//// "_RCRTOT,1 :""),DA=RC TDA D ^DIE  K ^TMP($J ,"RCDPERA" ) I RCTDA  L -^RCY(34 4.5,RCTDA)  Q ;UPDEOB (RCTDA,RCF ILE,DUP) ; Upd 361.1  from ERA m sg in 344. 5 or .4 ;R CTDA = ien  ERA msg i n 344.5 or  ;subfile  in 344.4 ; RCFILE = 4  file 344. 4, 5 if 34 4.5 ;DUP =  msg # if  dup msg, b ut not sam e # or -1  if same ms g # ;Retur ned for ea ch bill in  ERA: ;^TM P($J,"RCDP EOB",n)=Bi ll ien^AR  bill#^SrvD t^ECME# ;^ TMP($J,"RC DPEOB",n," EOB")=EOB  ien^amt pd ^ins co pt r^rev flg^ EEOB pn^am tbld^^^^BP NPI^RNPI^E TQual^LN^F N ;^TMP($J ,"RCDPEOB" ,"ADJ",x)= adj rec (' 02') ;Also : ;^TMP($J ,"RCDPEOB" ,"HDR")=hd r rec from  txmn ;^TM P($J,"RCDP EOB","CONT ACT")=ERA  contact re c ('01') ;  ;N RCGBL, RC,RC0,RCC T,RCCT1,RC EOB,RCBILL ,RCDPBNPI, RCMNUM,RCI FN,RCIB,RC ERR,RCSTAR ,RCET,RCX, RCXMG,Z,Q, DA,DR,DIE  ;N RCPAYER ,RCFILED,R CEOBD,RCNO UPD,REFORM ,RCSD,RCER R1,C5,ECME NUM ; PRCA *4.5*321 -  re-ordere d newed fi elds and a dded RCSTA RT N C5,DA ,DIE,DR,EC MENUM,N,Q, RC,RC0,RCB ILL,RCCT,R CCT1,RCDPB NPI,RCEOB, RCEOBD,RCE RR N RCERR 1,RCET,RCF ILED,RCGBL ,RCIB,RCIF N,RCMNUM,R CNOUPD,RCP AYER,RCSD, RCSTAR,RCS TART N RCX ,RCXMG,REF ORM,X,Y,Z  K ^TMP($J, "RCDP-EOB" ),^TMP("RC DPERR-EOB" ,$J) ; S R CPAYER="", RCFILED=1, RCNOUPD=0  I RCFILE=5  D .S RCGB L=$NA(^RCY (344.5,RCT DA,2)) .S  RCMNUM=+$G (^RCY(344. 5,RCTDA,0) ),RCXMG=$P ($G(^(0)), U,11) .I $ G(DUP) S R CNOUPD=$S( DUP>0:+DUP ,1:RCXMG)  .S ^TMP($J ,"RCDPEOB" ,"HDR")=$G (^RCY(344. 5,RCTDA,2, 1,0)) .I $ P(^TMP($J, "RCDPEOB", "HDR"),U)[ "XFR",'$P( $G(^RCY(34 4.5,RCTDA, 0)),U,14)  D ..D SEND ACK^RCDPES R5(RCTDA,1 ) ..S DR=" .14////1", DIE="^RCY( 344.5,",DA =RCTDA D ^ DIE ; I RC FILE=4 D . S RCGBL=$N A(^RCY(344 .4,+RCTDA, 1,+$P(RCTD A,";",2),1 )) .S RCMN UM=$P($G(^ RCY(344.4, +RCTDA,0)) ,U,12),RCX MG=$P($G(^ (0)),U,12)  .S ^TMP($ J,"RCDPEOB ","HDR")=$ G(^RCY(344 .4,+RCTDA, 1,+$P(RCTD A,";",2),1 ,1,0)) ; S  RCPAYER=$ P($G(^TMP( $J,"RCDPEO B","HDR")) ,U,6) S RC DPBNPI=$P( $G(^TMP($J ,"RCDPEOB" ,"HDR")),U ,18) ; ;sr v dates S  RCSD=$NA(^ TMP($J,"RC SRVDT")) K  @RCSD S R CSTART=0 ;  PRCA*4.5* 321 N CP5  S CP5="",R C=1,C5=0 ; retrofit 2 64 into 26 9 F  S RC= $O(@RCGBL@ (RC)) Q:'R C  S RC0=$ G(^(RC,0))  D .I RC0< 5 Q .;Stat ement Star t Date - 0 5 Record i s mandator y .I +RC0= 5 S RCSTAR T=+$P(RC0, U,9) ; PRC A*4.5*321  .I +RC0=5  S C5=RC,CP 5=$P(RC0,U ,2) Q  ;re trofit 264  into 269  .; service  date for  possible E CME# match ing .; PRC A*4.3*321  BEGIN .I + RC0=40,$$V ALECME^BPS UTIL2(CP5) ,C5,'$D(@R CSD@(C5))  D . I $P(R C0,U,19) S  @RCSD@(C5 )=+$P(RC0, U,19) Q .  ; If servi ce date no t present  use statem ent start  date inste ad . S:RCS TART @RCSD @(C5)=RCST ART ; PRCA *4.5*321 E ND ; S RC= 1,(RCCT,RC CT1,RCX,RE FORM)=0,RC BILL="" S  RCERR1=$NA (^TMP("RCE RR1",$J))  K @RCERR1  F  S RC=$O (@RCGBL@(R C)) Q:'RC   S RC0=$G( ^(RC,0)) D  .I RCFILE =5,+RC0=1  D  Q ..S ^ TMP($J,"RC DPEOB","CO NTACT")=RC 0 .; .I RC FILE=5,+RC 0=2 D  Q . .S RCX=RCX +1,^TMP($J ,"RCDPEOB" ,"ADJ",RCX )=RC0 .I R CFILE=5,+R C0=3 D  Q   ; Adding  logic for  line type  03,Patch 2 69,DWA ..S  $P(^TMP($ J,"RCDPEOB ","ADJ",RC X),U,5)=$P (RC0,U,2)  .; .I +RC0 =5 S RCCT= RCCT+1,RCC T1=0 D ..S  REFORM=0, ECMENUM=""  I $$VALEC ME^BPSUTIL 2($P(RC0,U ,2)) S ECM ENUM=$P(RC 0,U,2) ..S  Z=$$BILL^ RCDPESR1($ P(RC0,U,2) ,$G(@RCSD@ (RC)),.RCI B) ; look  up claim i en by clai m# or by E CME# ..I Z  S RCBILL= $P($G(^PRC A(430,Z,0) ),U) I RCB ILL'="",RC BILL'=$P(R C0,U,2) S  REFORM=1,$ P(RC0,U,2) =RCBILL .. S RCBILL=$ P(RC0,U,2)  ..S Z=$S( Z>0:$S($G( RCIB):Z,1: -1),1:-1)  ..S ^TMP($ J,"RCDP-EO B",RCCT,0) =Z_U_RCBIL L_U_$G(@RC SD@(RC))_U _ECMENUM . .S $P(^TMP ($J,"RCDPE OB",RCCT," EOB"),U,5) =$P(RC0,U, 3)_","_$P( RC0,U,4)_"  "_$P(RC0, U,5) ;Save  pt nm ..I  Z>0 S Q=+ $P($G(^PRC A(430,Z,0) ),U,9) I $ P($G(^RCD( 340,Q,0)), U)["DIC(36 ," S $P(^T MP($J,"RCD PEOB",RCCT ,"EOB"),U, 3)=+^RCD(3 40,Q,0) ;S ave ins co  .; .I +RC 0>5,REFORM  S $P(RC0, U,2)=RCBIL L ; .I +RC 0=10 D  ;S ave amt pd /billed, r ev flg ..S  $P(^TMP($ J,"RCDPEOB ",RCCT,"EO B"),U,2)=$ S(+$P(RC0, U,11):$J($ P(RC0,U,11 )/100,"",2 ),1:0),$P( ^TMP($J,"R CDPEOB",RC CT,"EOB"), U,6)=$J($P (RC0,U,11) ,"",2) ..I  $P(RC0,U, 6)="Y"!($P (RC0,U,7)= 22) S $P(^ TMP($J,"RC DPEOB",RCC T,"EOB"),U ,4)=1 ..S  $P(^TMP($J ,"RCDPEOB" ,RCCT,"EOB "),U,10,14 )=RCDPBNPI _U_$P(RC0, U,16,19) . I +RC0=11  D  ; Save  Rendering  Provider i nformation  from new  style mess age ..S $P (^TMP($J," RCDPEOB",R CCT,"EOB") ,U,10,14)= RCDPBNPI_U _$P(RC0,U, 3,6) ..; E nd save of  Rendering  Provider  .I RCBILL= $P(RC0,U,2 ) S RCCT1= RCCT1+1,^T MP($J,"RCD P-EOB",RCC T,RCCT1,0) =RC0 ; S R CSTAR=$TR( $J("",15), " ","*"),R CET=RCSTAR _"ERROR/WA RNING EEOB  DETAIL SE Q #" S RCC T=0 F  S R CCT=$O(^TM P($J,"RCDP -EOB",RCCT )) Q:'RCCT   S RCIFN= +$G(^(RCCT ,0)),RCBIL L=$P($G(^( 0)),U,2),^ TMP($J,"RC DPEOB",RCC T)=$G(^TMP ($J,"RCDP- EOB",RCCT, 0)) D .S R CEOB=-1,RC EOBD="" .I  $S(RCIFN> 0:$P(^PRCA (430.3,+$P ($G(^PRCA( 430,+RCIFN ,0)),U,8), 0),U,3)'=1 02,RCIFN'> 0&($G(DUP) '>0):1,1:0 ) D ..S @R CERR1@(RCC T)=" ",@RC ERR1@(RCCT ,1)=RCET_R CCT_RCSTAR  ..S @RCER R1@(RCCT,2 )="Bill "_ RCBILL_" i s"_$S(RCIF N>0:" not  in an ACTI VE status  in your A/ R",1:"n't  valid/wasn 't found s o its deta il wasn't  stored in  IB") ..S:R CFILE=5 @R CERR1@(RCC T,"*")=@RC ERR1@(RCCT ,2) ..S @R CERR1@(RCC T,3)=" The  reported  amount pai d on this  bill was:  "_$P(^TMP( $J,"RCDPEO B",RCCT,"E OB"),U,2)  ..I RCIFN' >0 D ...S  @RCERR1@(R CCT,4)=" I f the bill  is not fo r your sit e, it must  be transf erred to t he" ...S @ RCERR1@(RC CT,5)=" co rrect site  and manua lly adjust ed in your  AR." ...S  @RCERR1@( RCCT,6)="  You can pe rform this  transfer  using EDI  Lockbox ER A/EEOB exc eption pro cess." ... S @RCERR1@ (RCCT,7)="  " ..D DIS P1^RCDPESR 5(RCCT,1)  ..S Q=0 F   S Q=$O(^T MP($J,"RCD P-EOB",RCC T,Q)) Q:'Q   S ^TMP($ J,"RCDPEOB ",RCCT,Q)= $G(^TMP($J ,"RCDP-EOB ",RCCT,Q,0 )) ..S ^TM P($J,"RCDP EOB",RCCT) =^TMP($J," RCDP-EOB", RCCT,0) M  ^TMP($J,"R CDPEOB",RC CT,"ERR")= @RCERR1@(R CCT) ..I R CFILE=5 D   ;Store er r if trans -in failed  ...N RCE, RC,DIE,X,Y ,DA,DR ... S RCE(1)=$ $FMTE^XLFD T($$NOW^XL FDT(),2)_"  "_$G(@RCE RR1@(RCCT, "*")) ...S  RCE(2)="  ",RCFILED= 0 ...D WP^ DIE(344.5, RCTDA_",", 5,"A","RCE ") .I RCIF N>0 D ..N  RCDUPEOB,R CALLDUP .. ;Chk rec e xists ..S  RCDUPEOB=0  ..S RCEOB =$$DUP^RCD PESR3(RCMN UM,RCIFN,$ P($G(^TMP( $J,"RCDPEO B",RCCT,"E OB")),U,2) ,$P($G(^TM P($J,"RCDP EOB",RCCT, "EOB")),U, 6)) ;Same  msg for up date? ..I  RCEOB,$P(R CEOB,U,2)  S RCEOB=0  ;If chksum  exists, l et below c heck it .. S ^TMP($J, "RCDP-EOB" ,RCCT,.5,0 )="835ERA"  ;Needed -  checksum  ..S RCALLD UP=$$DUP^I BCEOB("^TM P("_$J_"," "RCDP-EOB" ","_RCCT_" )",RCIFN)  ..I $S(RCA LLDUP:1,RC EOB:$G(DUP )'>0,1:0)  D ...S RCD UPEOB=1 .. .D DUPREC^ RCDPESR6(R CET,RCCT,R CSTAR,RCFI LE,RCALLDU P,RCEOB,RC BILL,.RCDU PEOB) ...S :RCALLDUP  RCEOBD=RCA LLDUP ..;A dd stub to  361.1 ..I  'RCDUPEOB  S RCEOB=+ $$ADD3611^ IBCEOB(RCM NUM,"","", RCIFN,1,"^ TMP("_$J_" ,""RCDP-EO B"","_RCCT _")") ;IA  4042 ..K ^ TMP($J,"RC DP-EOB",RC CT,.5,0) . .I RCEOB<0  D:$G(DUP) '>0 Q ...S  @RCERR1@( RCCT)=" ", ^(RCCT,1)= RCET_RCCT_ RCSTAR,RCF ILED=0 ... S @RCERR1@ (RCCT,2)=" Error - EE OB detail  not added  to IB for  bill "_RCB ILL,$P(^TM P($J,"RCDP EOB",RCCT, "EOB"),U)= "" ...S:RC FILE=5 @RC ERR1@(RCCT ,"*")=@RCE RR1@(RCCT, 2) ...D DI SP1^RCDPES R5(RCCT,1)  ...S Q=0  F  S Q=$O( ^TMP($J,"R CDP-EOB",R CCT,Q)) Q: 'Q  S ^TMP ($J,"RCDPE OB",RCCT,Q )=$G(^TMP( $J,"RCDP-E OB",RCCT,Q ,0)) ...S  ^TMP($J,"R CDPEOB",RC CT)=^TMP($ J,"RCDP-EO B",RCCT,0)  M ^TMP($J ,"RCDPEOB" ,RCCT,"ERR ")=@RCERR1 @(RCCT) .. ;Upd 361.1 , needs ^T MP($J,"RCD PEOB","HDR " and $J," RCDP-EOB"  ..I RCDUPE OB'<0 S RC NOUPD=0 D  UPD3611^IB CEOB(RCEOB ,RCCT,1) . .;errors i n ^TMP("RC DPERR-EOB" ,$J ..I $O (^TMP("RCD PERR-EOB", $J,0)) D E RRUPD^IBCE OB(RCEOB," RCDPERR-EO B") ..S $P (^TMP($J," RCDPEOB",R CCT,"EOB") ,U)=$S('$G (RCEOBD):R CEOB,1:RCE OBD) .K ^T MP("RCDPER R-EOB",$J)  ; I RCNOU PD D DUPER A^RCDPESR3 ($G(DUP),R CNOUPD) I  $O(@RCERR1 @("")) D B ULLS^RCDPE SR3(RCFILE ,RCTDA,$S( RCNOUPD:RC NOUPD,1:$G (DUP)),$G( RCXMG)) K  ^TMP("RCDP ERR-EOB",$ J),^TMP($J ,"RCDP-EOB "),@RCERR1 ,@RCSD D C LEAN^DILF  Q
  223  
  224   Modified L ogic (Chan ges are in  bold)
  225   RCDPESR2 ; ALB/TMK/DW A - Server  auto-upd  - EDI Lock box ;Jun 0 6, 2014@19 :11:19 ;;4 .5;Account s Receivab le;**173,2 16,208,230 ,252,264,2 69,271,298 ,321,XXX** ;Mar 20, 1 995;Build  121 ;Per V A Directiv e 6402, th is routine  should no t be modif ied. ; IA  4042 (IBCE OB) ;Refer ence to $$ VALECME^BP SUTIL2 sup ported by  IA# 6139 ; TASKERA(RC TDA) ; Tas k to upd E RA ; RCTDA  = ien 344 .5 N ZTDTH ,ZTUCI,ZTS AVE,ZTIO,Z TDESC,ZTRT N,ZTSK,DIE ,DR,DA S ( ZTSAVE("DT "),ZTSAVE( "U"),ZTSAV E("DUZ"))= "",ZTSAVE( "ZTREQ")=" @",ZTRTN=" NEWERA^RCD PESR2("_RC TDA_",0)", ZTDTH=$H,Z TIO="" D ^ %ZTLOAD Q  ;NEWERA(RC TDA,RCREFI LE) ;Taske d ; Add ne w EOB's to  IB & ERA  tot rec to  AR ; RCTD A = ien 34 4.5 ; RCRE FILE = 1:  re-filing  rec via ex c proc N R CDUPERR,RC PAYER,RCRT OT,RCE,RCE C,RCERR,RC R1,RCADJ,D IE,DR,DA,Z ,Q S ZTREQ ="@" K ^TM P($J,"RCDP ERA") L +^ RCY(344.5, RCTDA):5 I  $D(ZTQUEU ED) S DIE= "^RCY(344. 5,",DA=RCT DA,DR=".05 ////"_ZTSK _";.04//// 1" D ^DIE  I $P($G(^R CY(344.5,R CTDA,0)),U ,5),'$G(RC REFILE) S  DIE="^RCY( 344.5,",DA =RCTDA,DR= ".1////4;. 08///1" D  ^DIE S RCR 1=$P($G(^R CY(344.5,R CTDA,0)),U ,7),RCPAYE R=$P($G(^R CY(344.5,R CTDA,3)),U ) S RCRTOT =$S(RCR1:R CR1,1:$$ER ATOT^RCDPE SR6(RCTDA, .RCERR)) ;  ERA rec S  RCDUPERR= $S($G(RCER R)="DUP"!( $G(RCERR(1 ))=-2):$G( RCERR(1)), 1:0) K RCE RR(1) I RC RTOT,'RCR1  S DIE="^R CY(344.5," ,DR=".07// //"_RCRTOT ,DA=RCTDA  D ^DIE D:R CDUPERR'=- 2 UPDEOB(R CTDA,5,$S( '$G(RCREFI LE):RCDUPE RR,1:-1))  ; Add EOB  det to IB  I RCRTOT D  UPDCON^RC DPESR6(RCR TOT),UPDAD J^RCDPESR6 (RCRTOT),U PD3444^RCD PESR6(.RCR TOT) ; Bil ls added 3 44.41 I RC RTOT,RCTDA  S DIE="^R CY(344.5," ,DR=".08// //0;.1///@ ",DA=RCTDA  D ^DIE I  'RCRTOT D   G QNEW .I  RCDUPERR  Q:'RCTDA   D  S RCTDA ="" Q ..I  RCDUPERR=- 2 D  Q
  226    ... ;D BU LLERA^RCDP ESR0("D",R CTDA,$P($G (^RCY(344. 5,RCTDA,0) ),U,11),"E DI LBOX -  DUPLICATE  ERA NOT FI LED "_$E(R CPAYER,1,2 0),.RCERR, 0)
  227    ... S DIE ="^RCY(344 .5,",DA=RC TDA,DR=".1 5///1" D ^ DIE ..D TE MPDEL^RCDP ESR1(RCTDA ) .S RCE(1 )=$$FMTE^X LFDT($$NOW ^XLFDT(),2 )_" An err or occurre d while st oring ERA  data.",RCE (2)="No to tals data  was stored  for this  ERA record "_$S('$G(R CREFILE):"  and an",1 :" on this  re-file a ttempt.")  .S RCE(3)= $S('$G(RCR EFILE):"ER A transmis sion excep tion was c reated.",1 :"") .D WP ^DIE(344.5 ,RCTDA_"," ,5,"A","RC E") .S DIE ="^RCY(344 .5,",DA=RC TDA,DR=".0 7///@;.08/ ///1;.1/// /1" D ^DIE  .K RCERR  .S RCERR(1 )=$$FMTE^X LFDT($$NOW ^XLFDT(),2 )_" The ER A data cou ld not be  stored. Th e AR recei pt",RCERR( 2)=" for t his data m ust be cre ated/proce ssed manua lly for th e bills in cluded" .S  RCERR(3)= " in this  ERA."_$S(' $G(RCREFIL E):"",1:"  This error  occurred  during a r efile atte mpt."),RCE RR(4)=" "  .D BULLERA ^RCDPESR0( "DF",RCTDA ,$P($G(^RC Y(344.5,RC TDA,0)),U, 11),"EDI L BOX - TOTA LS FILE EX CEPTION "_ $E(RCPAYER ,1,20),.RC ERR,0) .K  RCERR ;--- -- ; PRCA* 4.5*298 -  MailMan me ssage disa bled, logi c retained  - 14 Feb  2014 ;I $$ ADJ^RCDPEU (RCRTOT,.R CADJ) D ;B ulletin ad js ;.S RCE C=$$ADJERR ^RCDPESR3( .RCERR) ;. I RCADJ'=2  S RCEC=RC EC+1,RCERR (RCEC)=" T HERE ARE E RA LEVEL A DJUSTMENT( S)",RCEC=R CEC+1,RCER R(RCEC)="  " ;.I RCAD J'=1 S RCE C=RCEC+1,R CERR(RCEC) =" THE FOL LOWING BIL L(S) HAVE  RETRACTION S:" D ;..S  (Q,Z)=0 S  Z=0 F S Z =$O(RCADJ( RCRTOT,Z))  Q:'Z S:'Q  RCEC=RCEC +1,RCERR(R CEC)=" " S  Q=Q+1,RCE RR(RCEC)=R CERR(RCEC) _" "_RCADJ (RCRTOT,Z)  S:Q=4 Q=0  ;..S RCEC =RCEC+1,RC ERR(RCEC)= " " ;.D BU LLERA^RCDP ESR0("D",R CTDA,$P($G (^RCY(344. 5,RCTDA,0) ),U,11),"E DI LBOX -  ERA HAS AD J/TAKEBACK S "_$E(RCP AYER,1,20) ,.RCERR,0)  ;----- ;Q NEW I RCTD A,'$P($G(^ RCY(344.5, RCTDA,0)), U,8) D TEM PDEL^RCDPE SR1(RCTDA)  S RCTDA=" " I RCTDA, $P($G(^RCY (344.5,RCT DA,0)),U)' ="" S DIE= "^RCY(344. 5,",DR=".0 4////0;.05 ///@"_$S(' $G(RCR1)&$ G(RCRTOT): ";.07////" _RCRTOT,1: ""),DA=RCT DA D ^DIE  K ^TMP($J, "RCDPERA")  I RCTDA L  -^RCY(344 .5,RCTDA)  Q ;UPDEOB( RCTDA,RCFI LE,DUP) ;U pd 361.1 f rom ERA ms g in 344.5  or .4 ;RC TDA = ien  ERA msg in  344.5 or  ;subfile i n 344.4 ;R CFILE = 4  file 344.4 , 5 if 344 .5 ;DUP =  msg # if d up msg, bu t not same  # or -1 i f same msg  # ;Return ed for eac h bill in  ERA: ;^TMP ($J,"RCDPE OB",n)=Bil l ien^AR b ill#^SrvDt ^ECME# ;^T MP($J,"RCD PEOB",n,"E OB")=EOB i en^amt pd^ ins co ptr ^rev flg^E EOB pn^amt bld^^^^BPN PI^RNPI^ET Qual^LN^FN  ;^TMP($J, "RCDPEOB", "ADJ",x)=a dj rec ('0 2') ;Also:  ;^TMP($J, "RCDPEOB", "HDR")=hdr  rec from  txmn ;^TMP ($J,"RCDPE OB","CONTA CT")=ERA c ontact rec  ('01') ;  ;N RCGBL,R C,RC0,RCCT ,RCCT1,RCE OB,RCBILL, RCDPBNPI,R CMNUM,RCIF N,RCIB,RCE RR,RCSTAR, RCET,RCX,R CXMG,Z,Q,D A,DR,DIE ; N RCPAYER, RCFILED,RC EOBD,RCNOU PD,REFORM, RCSD,RCERR 1,C5,ECMEN UM ; PRCA* 4.5*321 -  re-ordered  newed fie lds and ad ded RCSTAR T N C5,DA, DIE,DR,ECM ENUM,N,Q,R C,RC0,RCBI LL,RCCT,RC CT1,RCDPBN PI,RCEOB,R CEOBD,RCER R N RCERR1 ,RCET,RCFI LED,RCGBL, RCIB,RCIFN ,RCMNUM,RC NOUPD,RCPA YER,RCSD,R CSTAR,RCST ART N RCX, RCXMG,REFO RM,X,Y,Z K  ^TMP($J," RCDP-EOB") ,^TMP("RCD PERR-EOB", $J) ; S RC PAYER="",R CFILED=1,R CNOUPD=0 I  RCFILE=5  D .S RCGBL =$NA(^RCY( 344.5,RCTD A,2)) .S R CMNUM=+$G( ^RCY(344.5 ,RCTDA,0)) ,RCXMG=$P( $G(^(0)),U ,11) .I $G (DUP) S RC NOUPD=$S(D UP>0:+DUP, 1:RCXMG) . S ^TMP($J, "RCDPEOB", "HDR")=$G( ^RCY(344.5 ,RCTDA,2,1 ,0)) .I $P (^TMP($J," RCDPEOB"," HDR"),U)[" XFR",'$P($ G(^RCY(344 .5,RCTDA,0 )),U,14) D  ..D SENDA CK^RCDPESR 5(RCTDA,1)  ..S DR=". 14////1",D IE="^RCY(3 44.5,",DA= RCTDA D ^D IE ; I RCF ILE=4 D .S  RCGBL=$NA (^RCY(344. 4,+RCTDA,1 ,+$P(RCTDA ,";",2),1) ) .S RCMNU M=$P($G(^R CY(344.4,+ RCTDA,0)), U,12),RCXM G=$P($G(^( 0)),U,12)  .S ^TMP($J ,"RCDPEOB" ,"HDR")=$G (^RCY(344. 4,+RCTDA,1 ,+$P(RCTDA ,";",2),1, 1,0)) ; S  RCPAYER=$P ($G(^TMP($ J,"RCDPEOB ","HDR")), U,6) S RCD PBNPI=$P($ G(^TMP($J, "RCDPEOB", "HDR")),U, 18) ; ;srv  dates S R CSD=$NA(^T MP($J,"RCS RVDT")) K  @RCSD S RC START=0 ;  PRCA*4.5*3 21 N CP5 S  CP5="",RC =1,C5=0 ;r etrofit 26 4 into 269  F  S RC=$ O(@RCGBL@( RC)) Q:'RC   S RC0=$G (^(RC,0))  D .I RC0<5  Q .;State ment Start  Date - 05  Record is  mandatory  .I +RC0=5  S RCSTART =+$P(RC0,U ,9) ; PRCA *4.5*321 . I +RC0=5 S  C5=RC,CP5 =$P(RC0,U, 2) Q  ;ret rofit 264  into 269 . ; service  date for p ossible EC ME# matchi ng .; PRCA *4.3*321 B EGIN .I +R C0=40,$$VA LECME^BPSU TIL2(CP5), C5,'$D(@RC SD@(C5)) D  . I $P(RC 0,U,19) S  @RCSD@(C5) =+$P(RC0,U ,19) Q . ;  If servic e date not  present u se stateme nt start d ate instea d . S:RCST ART @RCSD@ (C5)=RCSTA RT ; PRCA* 4.5*321 EN D ; S RC=1 ,(RCCT,RCC T1,RCX,REF ORM)=0,RCB ILL="" S R CERR1=$NA( ^TMP("RCER R1",$J)) K  @RCERR1 F   S RC=$O( @RCGBL@(RC )) Q:'RC   S RC0=$G(^ (RC,0)) D  .I RCFILE= 5,+RC0=1 D   Q ..S ^T MP($J,"RCD PEOB","CON TACT")=RC0  .; .I RCF ILE=5,+RC0 =2 D  Q .. S RCX=RCX+ 1,^TMP($J, "RCDPEOB", "ADJ",RCX) =RC0 .I RC FILE=5,+RC 0=3 D  Q   ; Adding l ogic for l ine type 0 3,Patch 26 9,DWA ..S  $P(^TMP($J ,"RCDPEOB" ,"ADJ",RCX ),U,5)=$P( RC0,U,2) . ; .I +RC0= 5 S RCCT=R CCT+1,RCCT 1=0 D ..S  REFORM=0,E CMENUM=""  I $$VALECM E^BPSUTIL2 ($P(RC0,U, 2)) S ECME NUM=$P(RC0 ,U,2) ..S  Z=$$BILL^R CDPESR1($P (RC0,U,2), $G(@RCSD@( RC)),.RCIB ) ; look u p claim ie n by claim # or by EC ME# ..I Z  S RCBILL=$ P($G(^PRCA (430,Z,0)) ,U) I RCBI LL'="",RCB ILL'=$P(RC 0,U,2) S R EFORM=1,$P (RC0,U,2)= RCBILL ..S  RCBILL=$P (RC0,U,2)  ..S Z=$S(Z >0:$S($G(R CIB):Z,1:- 1),1:-1) . .S ^TMP($J ,"RCDP-EOB ",RCCT,0)= Z_U_RCBILL _U_$G(@RCS D@(RC))_U_ ECMENUM .. S $P(^TMP( $J,"RCDPEO B",RCCT,"E OB"),U,5)= $P(RC0,U,3 )_","_$P(R C0,U,4)_"  "_$P(RC0,U ,5) ;Save  pt nm ..I  Z>0 S Q=+$ P($G(^PRCA (430,Z,0)) ,U,9) I $P ($G(^RCD(3 40,Q,0)),U )["DIC(36, " S $P(^TM P($J,"RCDP EOB",RCCT, "EOB"),U,3 )=+^RCD(34 0,Q,0) ;Sa ve ins co  .; .I +RC0 >5,REFORM  S $P(RC0,U ,2)=RCBILL  ; .I +RC0 =10 D  ;Sa ve amt pd/ billed, re v flg ..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,"RC DPEOB",RCC T,"EOB"),U ,6)=$J($P( RC0,U,11), "",2) ..I  $P(RC0,U,6 )="Y"!($P( RC0,U,7)=2 2) S $P(^T MP($J,"RCD PEOB",RCCT ,"EOB"),U, 4)=1 ..S $ P(^TMP($J, "RCDPEOB", RCCT,"EOB" ),U,10,14) =RCDPBNPI_ U_$P(RC0,U ,16,19) .I  +RC0=11 D   ; Save R endering P rovider in formation  from new s tyle messa ge ..S $P( ^TMP($J,"R CDPEOB",RC CT,"EOB"), U,10,14)=R CDPBNPI_U_ $P(RC0,U,3 ,6) ..; En d save of  Rendering  Provider . I RCBILL=$ P(RC0,U,2)  S RCCT1=R CCT1+1,^TM P($J,"RCDP -EOB",RCCT ,RCCT1,0)= RC0 ; S RC STAR=$TR($ J("",15),"  ","*"),RC ET=RCSTAR_ "ERROR/WAR NING EEOB  DETAIL SEQ  #" S RCCT =0 F  S RC CT=$O(^TMP ($J,"RCDP- EOB",RCCT) ) Q:'RCCT   S RCIFN=+ $G(^(RCCT, 0)),RCBILL =$P($G(^(0 )),U,2),^T MP($J,"RCD PEOB",RCCT )=$G(^TMP( $J,"RCDP-E OB",RCCT,0 )) D .S RC EOB=-1,RCE OBD="" .I  $S(RCIFN>0 :$P(^PRCA( 430.3,+$P( $G(^PRCA(4 30,+RCIFN, 0)),U,8),0 ),U,3)'=10 2,RCIFN'>0 &($G(DUP)' >0):1,1:0)  D ..S @RC ERR1@(RCCT )=" ",@RCE RR1@(RCCT, 1)=RCET_RC CT_RCSTAR  ..S @RCERR 1@(RCCT,2) ="Bill "_R CBILL_" is "_$S(RCIFN >0:" not i n an ACTIV E status i n your A/R ",1:"n't v alid/wasn' t found so  its detai l wasn't s tored in I B") ..S:RC FILE=5 @RC ERR1@(RCCT ,"*")=@RCE RR1@(RCCT, 2) ..S @RC ERR1@(RCCT ,3)=" The  reported a mount paid  on this b ill was: " _$P(^TMP($ J,"RCDPEOB ",RCCT,"EO B"),U,2) . .I RCIFN'> 0 D ...S @ RCERR1@(RC CT,4)=" If  the bill  is not for  your site , it must  be transfe rred to th e" ...S @R CERR1@(RCC T,5)=" cor rect site  and manual ly adjuste d in your  AR." ...S  @RCERR1@(R CCT,6)=" Y ou can per form this  transfer u sing EDI L ockbox ERA /EEOB exce ption proc ess." ...S  @RCERR1@( RCCT,7)="  " ..D DISP 1^RCDPESR5 (RCCT,1) . .S Q=0 F   S Q=$O(^TM P($J,"RCDP -EOB",RCCT ,Q)) Q:'Q   S ^TMP($J ,"RCDPEOB" ,RCCT,Q)=$ G(^TMP($J, "RCDP-EOB" ,RCCT,Q,0) ) ..S ^TMP ($J,"RCDPE OB",RCCT)= ^TMP($J,"R CDP-EOB",R CCT,0) M ^ TMP($J,"RC DPEOB",RCC T,"ERR")=@ RCERR1@(RC CT) ..I RC FILE=5 D   ;Store err  if trans- in failed  ...N RCE,R C,DIE,X,Y, DA,DR ...S  RCE(1)=$$ FMTE^XLFDT ($$NOW^XLF DT(),2)_"  "_$G(@RCER R1@(RCCT," *")) ...S  RCE(2)=" " ,RCFILED=0  ...D WP^D IE(344.5,R CTDA_",",5 ,"A","RCE" ) .I RCIFN >0 D ..N R CDUPEOB,RC ALLDUP ..; Chk rec ex ists ..S R CDUPEOB=0  ..S RCEOB= $$DUP^RCDP ESR3(RCMNU M,RCIFN,$P ($G(^TMP($ J,"RCDPEOB ",RCCT,"EO B")),U,2), $P($G(^TMP ($J,"RCDPE OB",RCCT," EOB")),U,6 )) ;Same m sg for upd ate? ..I R CEOB,$P(RC EOB,U,2) S  RCEOB=0 ; If chksum  exists, le t below ch eck it ..S  ^TMP($J," RCDP-EOB", RCCT,.5,0) ="835ERA"  ;Needed -  checksum . .S RCALLDU P=$$DUP^IB CEOB("^TMP ("_$J_","" RCDP-EOB"" ,"_RCCT_") ",RCIFN) . .I $S(RCAL LDUP:1,RCE OB:$G(DUP) '>0,1:0) D  ...S RCDU PEOB=1 ... D DUPREC^R CDPESR6(RC ET,RCCT,RC STAR,RCFIL E,RCALLDUP ,RCEOB,RCB ILL,.RCDUP EOB) ...S: RCALLDUP R CEOBD=RCAL LDUP ..;Ad d stub to  361.1 ..I  'RCDUPEOB  S RCEOB=+$ $ADD3611^I BCEOB(RCMN UM,"","",R CIFN,1,"^T MP("_$J_", ""RCDP-EOB "","_RCCT_ ")") ;IA 4 042 ..K ^T MP($J,"RCD P-EOB",RCC T,.5,0) .. I RCEOB<0  D:$G(DUP)' >0 Q ...S  @RCERR1@(R CCT)=" ",^ (RCCT,1)=R CET_RCCT_R CSTAR,RCFI LED=0 ...S  @RCERR1@( RCCT,2)="E rror - EEO B detail n ot added t o IB for b ill "_RCBI LL,$P(^TMP ($J,"RCDPE OB",RCCT," EOB"),U)=" " ...S:RCF ILE=5 @RCE RR1@(RCCT, "*")=@RCER R1@(RCCT,2 ) ...D DIS P1^RCDPESR 5(RCCT,1)  ...S Q=0 F   S Q=$O(^ TMP($J,"RC DP-EOB",RC CT,Q)) Q:' Q  S ^TMP( $J,"RCDPEO B",RCCT,Q) =$G(^TMP($ J,"RCDP-EO B",RCCT,Q, 0)) ...S ^ TMP($J,"RC DPEOB",RCC T)=^TMP($J ,"RCDP-EOB ",RCCT,0)  M ^TMP($J, "RCDPEOB", RCCT,"ERR" )=@RCERR1@ (RCCT) ..; Upd 361.1,  needs ^TM P($J,"RCDP EOB","HDR"  and $J,"R CDP-EOB" . .I RCDUPEO B'<0 S RCN OUPD=0 D U PD3611^IBC EOB(RCEOB, RCCT,1) .. ;errors in  ^TMP("RCD PERR-EOB", $J ..I $O( ^TMP("RCDP ERR-EOB",$ J,0)) D ER RUPD^IBCEO B(RCEOB,"R CDPERR-EOB ") ..S $P( ^TMP($J,"R CDPEOB",RC CT,"EOB"), U)=$S('$G( RCEOBD):RC EOB,1:RCEO BD) .K ^TM P("RCDPERR -EOB",$J)  ; I RCNOUP D D DUPERA ^RCDPESR3( $G(DUP),RC NOUPD) I $ O(@RCERR1@ ("")) D BU LLS^RCDPES R3(RCFILE, RCTDA,$S(R CNOUPD:RCN OUPD,1:$G( DUP)),$G(R CXMG)) K ^ TMP("RCDPE RR-EOB",$J ),^TMP($J, "RCDP-EOB" ),@RCERR1, @RCSD D CL EAN^DILF Q
  228  
  229  
  230   Routines
  231   Activities
  232   Routine Na me
  233   RCDPESR6
  234   Enhancemen t Category
  235    New
  236    Modify
  237    Delete
  238    No Change
  239   RTM
  240  
  241   Related Op tions
  242   RCDPE EXCE PTION PROC ESSING (Tr ansmission  exception s)
  243   RCDPE DUPL ICATE ERA  WORKLIST ( Duplicate  ERA Workli st)
  244  
  245   Related Ro utines
  246   Routines “ Called By”
  247   Routines “ Called”   
  248  
  249   RCDPESR2
  250      $$VALEC ME^BPSUTIL 2  
  251      FILE^DI CN            
  252      ^DIE                  
  253      WP^DIE                
  254      ^DIK                  
  255      $$IENS^ DILF          
  256      $$REJEC T^IBNCPDPU    
  257      $$FMDT^ RCDPESR1      
  258      $$NOW^X LFDT          
  259      $$UP^XL FSTR          
  260      $$CHKDG T^XUSNPI      
  261  
  262  
  263   Current Lo gic
  264   RCDPESR6 ; ALB/TMK/DW A - Server  auto-upda te file 34 4.4 - EDI  Lockbox ;J un 06, 201 4@19:11:19  ;;4.5;Acc ounts Rece ivable;**1 73,214,208 ,230,252,2 69,271,298 ,321**;Mar  20, 1995; Build 121  ;Per VA Di rective 64 02, this r outine sho uld not be  modified.  ; ;Refere nce to $$V ALECME^BPS UTIL2 supp orted by I A# 6139 ;U PD3444(RCR TOT) ; Add  EOB detai l to list  in 344.41  for file 3 44.4 entry  RCRTOT ;  If passed  by referen ce, RCRTOT  is return ed = "" if  errors ;  N RC,RCCOM 1,RCCOM2,R CCT,RC1,RC 2,RCDPNM,R CEOB,RCNPI 1,RCNPI2,D A,DR,DO,DD ,DLAYGO,DI C,DIK,X,Y, Z S RC=0 F   S RC=$O( ^TMP($J,"R CDPEOB",RC )) Q:'RC   S RC1=$G(^ (RC)),RC2= $G(^(RC,"E OB")),RCEO B=+RC2 D   Q:'RCRTOT  . ; Update  344.41 wi th referen ce to this  record if  it doesn' t already  exist . I  RCEOB>0 Q: $D(^RCY(34 4.4,RCRTOT ,1,"AC",RC EOB,RC)) .  I RCEOB'> 0,$S($P(RC 1,U,2)'="" :$D(^RCY(3 44.4,RCRTO T,1,"AD",$ P(RC1,U,2) ,RC)),1:0)  Q . ; Dis regard ECM E reject r elated EEO Bs; ECME#  can be 7 d igits or 1 2 digits .  I RCEOB'> 0,'$P(RC2, U,2),$$VAL ECME^BPSUT IL2($P(RC1 ,U,2)),$$R EJECT^IBNC PDPU($P(RC 1,U,2),$P( RC1,U,3))  Q . ; . S  DA(1)=RCRT OT,X=RC,DI C="^RCY(34 4.4,"_DA(1 )_",1,",DI C(0)="L",D LAYGO=344. 41 . S DIC ("DR")=$S( $G(RCEOB)> 0:".02//// "_RCEOB,1: ".05////"_ $P(RC1,U,2 )_";.07/// /1") . I $ P(RC2,U,2) '="" S DIC ("DR")=DIC ("DR")_$S( $L(DIC("DR ")):";",1: "")_".03// /"_$P(RC2, U,2) ; amt  . I $P(RC 2,U,3)'=""  S DIC("DR ")=DIC("DR ")_$S($L(D IC("DR")): ";",1:"")_ ".04////"_ $P(RC2,U,3 ) ; ins co  . I $P(RC 2,U,4) S D IC("DR")=D IC("DR")_$ S($L(DIC(" DR")):";", 1:"")_".14 ////1" ; r eversal .  I $P(RC2,U ,5)'="" S  DIC("DR")= DIC("DR")_ $S($L(DIC( "DR")):";" ,1:"")_".1 5////^S X= $E($P(RC2, U,5),1,30) " ; Patien t name . ;  Process B illing Pro v NPI, Ren dering/Ser vicing NPI  & name .  S (RCCOM1, RCCOM2)=""  . S RCNPI 1=$P(RC2,U ,10),RCNPI 2=$P(RC2,U ,11) . I R CNPI1'="", '$$CHKDGT^ XUSNPI(RCN PI1) S RCC OM1="The B illing Pro vider NPI  received o n the 835  ("_$E(RCNP I1,1,10)_" ) is not a  valid for mat." . I  RCNPI2'="" ,'$$CHKDGT ^XUSNPI(RC NPI2) S RC COM2="The  "_$S($P(RC 2,U,12)=1: "Rendering ",1:"Servi cing")_" N PI receive d on the 8 35 ("_$E(R CNPI2,1,10 )_") is no t a valid  format." .  I RCCOM1= "" S DIC(" DR")=DIC(" DR")_";.18 ////^S X=$ P(RC2,U,10 )"  ;Billi ng Provide r NPI . I  RCCOM2=""  S DIC("DR" )=DIC("DR" )_";.19/// /^S X=$P(R C2,U,11)"   ;Renderin g Provider  NPI . S R CDPNM=$P(R C2,U,13) I  $P(RC2,U, 14)]"" S R CDPNM=RCDP NM_$S(RCDP NM]"":",", 1:"")_$P(R C2,U,14) .  S DIC("DR ")=DIC("DR ")_";.2/// /^S X=$P(R C2,U,12);. 21////^S X =RCDPNM"   ; Entity T ype Qualif ier ^ Last  name,Firs t Name . S  DIC("DR") =DIC("DR") _";.22//// ^S X=RCCOM 1;.23////^ S X=RCCOM2 "  ;Commen t on Billi ng provide r^comment  on renderi ng/servici ng provide r NPI . I  $$VALECME^ BPSUTIL2($ P(RC1,U,4) ) D .. S D IC("DR")=D IC("DR")_" ;.24////^S  X=$P(RC1, U,4)"  ;Ad d ECME num ber (if va lid) PRCA* 4.5*298 .  D FILE^DIC N K DO,DD, DLAYGO,DIC ,DIK . S R CCT=+Y . I  RCCT<0 D   Q .. S DA =RCRTOT,DI K="^RCY(34 4.4," D ^D IK .. S RC RTOT=0 . ;  If there  is no IB E OB record,  store the  raw data  in 344.411  . I RC1'> 0!(RCEOB'> 0) D .. N  RCDATA,RCC ,RCDA .. S  RCC=2,RCD ATA(1)=$G( ^TMP($J,"R CDPEOB","H DR")) .. ;  PRCA*4.5* 321 - use  RC in plac e of RCCT  to allow f or gaps in  ERA seque nce number s (due to  ECME rejec ts) .. S Z =0 F  S Z= $O(^TMP($J ,"RCDPEOB" ,RC,Z)) Q: 'Z  S RCC= RCC+1,RCDA TA(RCC)=$G (^TMP($J," RCDPEOB",R C,Z)) .. S  RCDA(1)=R CRTOT,RCDA =RCCT .. D  WP^DIE(34 4.41,$$IEN S^DILF(.RC DA),1,"A", "RCDATA")  Q ; ;ERATO T(RCTDA,RC ERR) ; Fil e ERA TOTA L rec in 3 44.4 from  entry RCTD A in 344.5  ; RCTDA =  ien file  344.5 ; Re turns: the  ien file  344.4 ; RC ERR if pas sed by ref erence, wi th error t ext ; RCER R(1)=dupli cated mess age N RCTY PE,RCDA,RC METH,RCTRA CE,RCID,RC DT,RCAMT,R CDUP,RCZ,R CX,RCPAYER ,DIE,DIK,D IC,DLAYGO, DD,DO,DR,D A,X,Y,Z0,Z 1 S (RCERR ,RCDA)=""  S RCZ=$G(^ RCY(344.5, RCTDA,2,1, 0)) S RCTY PE=$P(RCZ, U),RCTRACE =$P(RCZ,U, 8),RCID=$P (RCZ,U,7), RCPAYER=$P (RCZ,U,6), RCMETH=$P( RCZ,U,17)  ; Need hea der record  as first  entry in f ield I RCT YPE'["835E RA" S RCER R="No head er record  found in m essage. An  EEOB exce ption reco rd was cre ated" G ER ATOTQ ; S  RCDT=$$FMD T^RCDPESR1 ($P(RCZ,U, 9)),RCAMT= $J(($P(RCZ ,U,10)/100 ),0,2) ;El ec ERA's m ust have a  trace # a nd an ins  co id I RC TRACE=""!( RCID="") S  RCERR="Tr ace # or i ns ID miss ing on ERA  transacti on. An EEO B exceptio n record w as created ." G ERATO TQ ; Make  sure it's  not alread y there S  (RCDUP,Z1) =0 F  S Z1 =$O(^RCY(3 44.4,"ATRI DUP",$$UP^ XLFSTR(RCT RACE),$$UP ^XLFSTR(RC ID),Z1)) Q :'Z1  S Z0 =$G(^RCY(3 44.4,Z1,0) ) I $P(Z0, U,4)=RCDT, +$P(Z0,U,5 )=+RCAMT S  RCDUP=1 Q  ; I RCDUP ,$P(Z0,U,8 ) D  G ERA TOTQ ; Rec eipt alrea dy exists  - no updat e . S RCER R="This is  a duplica te ERA and  has alrea dy been po sted",RCER R(1)=-2 I  RCDUP S RC ERR="DUP", RCERR(1)=$ S($P(Z0,U, 12)'=$P($G (^RCY(344. 5,RCTDA,0) ),U,11):$P (Z0,U,12), 1:-1) G ER ATOTQ ; S  RCX=+$O(^R CY(344.4,"  "),-1) S  DIC(0)="L" ,DIC="^RCY (344.4,",D LAYGO=344. 4 S DIC("D R")=".02// //"_RCTRAC E_";.03/// /"_RCID_"; .04////"_R CDT_";.05/ ///"_RCAMT _";.06//// "_$P(RCZ,U ,6)_";.09/ ///0;.12// //"_$P($G( ^RCY(344.5 ,RCTDA,0)) ,U,11)_";. 07////"_$$ NOW^XLFDT( )_";.1//// 1" I RCMET H'="" S DI C("DR")=DI C("DR")_"; .15////"_R CMETH F RC X=RCX+1:1  L +^RCY(34 4.4,RCX,0) :1 I $T,'$ D(^RCY(344 .4,RCX,0))  S X=RCX Q  D FILE^DI CN K DO,DL AYGO,DD,DI C L -^RCY( 344.4,RCX, 0) S RCDA= $S(Y<0:"", 1:+Y) I 'R CDA D . S  RCERR="An  error was  encountere d that pre vented the  adding of  an ERA to tals recor d. An EEOB  exception  record wa s created. " ;ERATOTQ  Q RCDA ;U PDCON(RCRT OT) ; Add  contact in formation  to file 34 4.4 for an  ERA N DIE ,DA,DR,Z,Q ,X,Y,A,TYP E S Z=$G(^ TMP($J,"RC DPEOB","CO NTACT")) Q :$TR($P(Z, U,3,9),U)= "" S DA=RC RTOT,DIE=" ^RCY(344.4 ,",DR="" ;  ; If old  format do  I +$P($G(^ TMP($J,"RC DPEOB","HD R")),U,16) '>0 D . F  Q=2:1:8 S  DR=DR_$S(D R'="":";3. 0",1:"3.0" )_(Q-1)_"/ //"_$S($P( Z,U,Q)="": "@",1:"/"_ $P(Z,U,Q))  ; ; If ne w format ( 5010) do I  +$P($G(^T MP($J,"RCD PEOB","HDR ")),U,16)> 0 D . N CN T S CNT=0  . I $P(Z,U ,2)'="" S  DR="3.01// //"_$P(Z,U ,2) .I $P( Z,U,3)'=""  S DR=DR_$ S(DR'="":" ;3.02",1:" 3.02")_"// //"_$P(Z,U ,3)_";3.03 ////TE",CN T=CNT+1 .I  $P(Z,U,4) '="" D ..S :CNT=1 DR= DR_$S(DR'= "":";3.04" ,1:"3.04") _"////"_$P (Z,U,4)_"; 3.05////FX " ..S:CNT= 0 DR=DR_$S (DR'="":"; 3.02",1:"3 .02")_"/// /"_$P(Z,U, 4)_";3.03/ ///FX" ..S  CNT=CNT+1  .I $P(Z,U ,5)'="" D  ..S:CNT=2  DR=DR_$S(D R'="":";3. 06",1:"3.0 6")_"////" _$P(Z,U,5) _";3.07/// /EM" ..S:C NT=1 DR=DR _$S(DR'="" :";3.04",1 :"3.04")_" ////"_$P(Z ,U,5)_";3. 05////EM"  ..S:CNT=0  DR=DR_$S(D R'="":";3. 02",1:"3.0 2")_"////" _$P(Z,U,5) _";3.03/// /EM" . I $ P(Z,U,6)'= "" S DR=DR _$S(DR'="" :";5.01",1 :"5.01")_" ////"_$P(Z ,U,6) D ^D IE Q ;UPDA DJ(RCRTOT)  ; Add ERA  level adj  data to f ile 344.4  N Z,Z0,DA, DIC,DLAYGO ,DR,X,Y,DO ,DD ; Remo ve any alr eady there  S Z=0 F   S Z=$O(^RC Y(344.4,RC RTOT,2,Z))  Q:'Z  S D A(1)=RCRTO T,DA=Z D ^ DIK ; S Z= 0 F  S Z=$ O(^TMP($J, "RCDPEOB", "ADJ",Z))  Q:'Z  S Z0 =$G(^(Z))  D . S DIC( 0)="L",X=$ P(Z0,U,3)_ " ",DA(1)= RCRTOT,DIC ="^RCY(344 .4,"_DA(1) _",2,",DIC ("DR")=$S( $P(Z0,U,2) '="":".02/ ///"_$P(Z0 ,U,2),1:"" ) . S DIC( "DR")=DIC( "DR")_$S(D IC("DR")'= "":";",1:" ")_$S($P(Z 0,U,4)'="" :".03////" _$J(-$P(Z0 ,U,4)/100, "",2),1:"" ) . S DIC( "DR")=DIC( "DR")_$S(D IC("DR")'= "":";",1:" ")_$S($P(Z 0,U,5)'="" :".04////" _$P(Z0,U,5 ),1:""),DL AYGO=344.4 2 . S:$O(^ RCY(344.4, RCRTOT,2," B",X,0)) X =""""_X_"" "" . D FIL E^DICN K D IC,DO,DD Q  ;DUPREC(R CET,RCCT,R CSTAR,RCFI LE,RCALLDU P,RCEOB,RC BILL,RCDUP EOB) ; Ove rflow from  RCDPESR2  S ^TMP("RC ERR1",$J,R CCT)=" ",^ TMP("RCERR 1",$J,RCCT ,1)=RCET_R CCT_RCSTAR  S ^TMP("R CERR1",$J, RCCT,2)="( Warning):  EEOB detai l already  filed for  "_RCBILL_"  - "_$S(RC ALLDUP:"Du plicate no t stored", 1:"EEOB up dated"),^T MP("RCERR1 ",$J,RCCT, 3)=" " S:R CFILE=5 ^T MP("RCERR1 ",$J,RCCT, "*")=^TMP( "RCERR1",$ J,RCCT,2)  I RCALLDUP  S RCEOB=" ",RCDUPEOB =-1 Q S $P (^TMP($J," RCDPEOB",R CCT,"EOB") ,U)=RCEOB  Q ;
  265  
  266   Modified L ogic (Chan ges are in  bold)
  267   RCDPESR6 ; ALB/TMK/DW A - Server  auto-upda te file 34 4.4 - EDI  Lockbox ;J un 06, 201 4@19:11:19  ;;4.5;Acc ounts Rece ivable;**1 73,214,208 ,230,252,2 69,271,298 ,321,XXX** ;Mar 20, 1 995;Build  121 ;Per V A Directiv e 6402, th is routine  should no t be modif ied. ; ;Re ference to  $$VALECME ^BPSUTIL2  supported  by IA# 613 9 ;UPD3444 (RCRTOT) ;  Add EOB d etail to l ist in 344 .41 for fi le 344.4 e ntry RCRTO T ; If pas sed by ref erence, RC RTOT is re turned = " " if error s ; N RC,R CCOM1,RCCO M2,RCCT,RC 1,RC2,RCDP NM,RCEOB,R CNPI1,RCNP I2,DA,DR,D O,DD,DLAYG O,DIC,DIK, X,Y,Z S RC =0 F  S RC =$O(^TMP($ J,"RCDPEOB ",RC)) Q:' RC  S RC1= $G(^(RC)), RC2=$G(^(R C,"EOB")), RCEOB=+RC2  D  Q:'RCR TOT . ; Up date 344.4 1 with ref erence to  this recor d if it do esn't alre ady exist  . I RCEOB> 0 Q:$D(^RC Y(344.4,RC RTOT,1,"AC ",RCEOB,RC )) . I RCE OB'>0,$S($ P(RC1,U,2) '="":$D(^R CY(344.4,R CRTOT,1,"A D",$P(RC1, U,2),RC)), 1:0) Q . ;  Disregard  ECME reje ct related  EEOBs; EC ME# can be  7 digits  or 12 digi ts . I RCE OB'>0,'$P( RC2,U,2),$ $VALECME^B PSUTIL2($P (RC1,U,2)) ,$$REJECT^ IBNCPDPU($ P(RC1,U,2) ,$P(RC1,U, 3)) Q . ;  . S DA(1)= RCRTOT,X=R C,DIC="^RC Y(344.4,"_ DA(1)_",1, ",DIC(0)=" L",DLAYGO= 344.41 . S  DIC("DR") =$S($G(RCE OB)>0:".02 ////"_RCEO B,1:".05// //"_$P(RC1 ,U,2)_";.0 7////1") .  I $P(RC2, U,2)'="" S  DIC("DR") =DIC("DR") _$S($L(DIC ("DR")):"; ",1:"")_". 03///"_$P( RC2,U,2) ;  amt . I $ P(RC2,U,3) '="" S DIC ("DR")=DIC ("DR")_$S( $L(DIC("DR ")):";",1: "")_".04// //"_$P(RC2 ,U,3) ; in s co . I $ P(RC2,U,4)  S DIC("DR ")=DIC("DR ")_$S($L(D IC("DR")): ";",1:"")_ ".14////1"  ; reversa l . I $P(R C2,U,5)'=" " S DIC("D R")=DIC("D R")_$S($L( DIC("DR")) :";",1:"") _".15////^ S X=$E($P( RC2,U,5),1 ,30)" ; Pa tient name  . ; Proce ss Billing  Prov NPI,  Rendering /Servicing  NPI & nam e . S (RCC OM1,RCCOM2 )="" . S R CNPI1=$P(R C2,U,10),R CNPI2=$P(R C2,U,11) .  I RCNPI1' ="",'$$CHK DGT^XUSNPI (RCNPI1) S  RCCOM1="T he Billing  Provider  NPI receiv ed on the  835 ("_$E( RCNPI1,1,1 0)_") is n ot a valid  format."  . I RCNPI2 '="",'$$CH KDGT^XUSNP I(RCNPI2)  S RCCOM2=" The "_$S($ P(RC2,U,12 )=1:"Rende ring",1:"S ervicing") _" NPI rec eived on t he 835 ("_ $E(RCNPI2, 1,10)_") i s not a va lid format ." . I RCC OM1="" S D IC("DR")=D IC("DR")_" ;.18////^S  X=$P(RC2, U,10)"  ;B illing Pro vider NPI  . I RCCOM2 ="" S DIC( "DR")=DIC( "DR")_";.1 9////^S X= $P(RC2,U,1 1)"  ;Rend ering Prov ider NPI .  S RCDPNM= $P(RC2,U,1 3) I $P(RC 2,U,14)]""  S RCDPNM= RCDPNM_$S( RCDPNM]"": ",",1:"")_ $P(RC2,U,1 4) . S DIC ("DR")=DIC ("DR")_";. 2////^S X= $P(RC2,U,1 2);.21//// ^S X=RCDPN M"  ; Enti ty Type Qu alifier ^  Last name, First Name  . S DIC(" DR")=DIC(" DR")_";.22 ////^S X=R CCOM1;.23/ ///^S X=RC COM2"  ;Co mment on B illing pro vider^comm ent on ren dering/ser vicing pro vider NPI  . I $$VALE CME^BPSUTI L2($P(RC1, U,4)) D ..  S DIC("DR ")=DIC("DR ")_";.24// //^S X=$P( RC1,U,4)"   ;Add ECME  number (i f valid) P RCA*4.5*29 8 . D FILE ^DICN K DO ,DD,DLAYGO ,DIC,DIK .  S RCCT=+Y  . I RCCT< 0 D  Q ..  S DA=RCRTO T,DIK="^RC Y(344.4,"  D ^DIK ..  S RCRTOT=0  . ; If th ere is no  IB EOB rec ord, store  the raw d ata in 344 .411 . I R C1'>0!(RCE OB'>0) D . . N RCDATA ,RCC,RCDA  .. S RCC=2 ,RCDATA(1) =$G(^TMP($ J,"RCDPEOB ","HDR"))  .. ; PRCA* 4.5*321 -  use RC in  place of R CCT to all ow for gap s in ERA s equence nu mbers (due  to ECME r ejects) ..  S Z=0 F   S Z=$O(^TM P($J,"RCDP EOB",RC,Z) ) Q:'Z  S  RCC=RCC+1, RCDATA(RCC )=$G(^TMP( $J,"RCDPEO B",RC,Z))  .. S RCDA( 1)=RCRTOT, RCDA=RCCT  .. D WP^DI E(344.41,$ $IENS^DILF (.RCDA),1, "A","RCDAT A") Q ; ;E RATOT(RCTD A,RCERR) ;  File ERA  TOTAL rec  in 344.4 f rom entry  RCTDA in 3 44.5 ; RCT DA = ien f ile 344.5  ; Returns:  the ien f ile 344.4  ; RCERR if  passed by  reference , with err or text ;  RCERR(1)=d uplicated  message N  RCTYPE,RCD A,RCMETH,R CTRACE,RCI D,RCDT,RCA MT,RCDUP,R CZ,RCX,RCP AYER,RCFOR CE
  268    N DIE,DIK ,DIC,DLAYG O,DD,DO,DR ,DA,X,Y,Z0 ,Z1 S (RCE RR,RCDA)=" " S RCZ=$G (^RCY(344. 5,RCTDA,2, 1,0)) S RC TYPE=$P(RC Z,U),RCTRA CE=$P(RCZ, U,8),RCID= $P(RCZ,U,7 ),RCPAYER= $P(RCZ,U,6 ),RCMETH=$ P(RCZ,U,17 ) ; Need h eader reco rd as firs t entry in  field I R CTYPE'["83 5ERA" S RC ERR="No he ader recor d found in  message.  An EEOB ex ception re cord was c reated" G  ERATOTQ ;  S RCDT=$$F MDT^RCDPES R1($P(RCZ, U,9)),RCAM T=$J(($P(R CZ,U,10)/1 00),0,2) ; Elec ERA's  must have  a trace #  and an in s co id I  RCTRACE="" !(RCID="")  S RCERR=" Trace # or  ins ID mi ssing on E RA transac tion. An E EOB except ion record  was creat ed." G ERA TOTQ ; Mak e sure it' s not alre ady there  S (RCDUP,Z 1)=0 F  S  Z1=$O(^RCY (344.4,"AT RIDUP",$$U P^XLFSTR(R CTRACE),$$ UP^XLFSTR( RCID),Z1))  Q:'Z1  D   Q:RCDUP
  269    .S Z0=$G( ^RCY(344.4 ,Z1,0)) 
  270    .I $P(Z0, U,4)=RCDT, +$P(Z0,U,5 )=+RCAMT S  RCDUP=1 ;
  271    ; If ERA  has a rece ipt and is  being fil ed from Du plicate ER A Worklist  find a ne w
  272    ; unique  trace numb er for thi s payer/am ount/date  and overri de duplica te check
  273    S RCFORCE =+$$GET1^D IQ(344.5,R CTDA_”,”,. 15,”I”)
  274    I RCDUP,$ P(Z0,U,8), RCFORCE D
  275    .N RCCNT, RCNEW,RCTR ACE1
  276    .S RCDUP= 0 ; Forced  entry
  277    .S (RCNEW ,Z1)=0,RCT RACE1=$E(R CTRACE,1,4 6)_”-DUP”, RCCNT=1 
  278    . ;Find f irst unuse d suffix –  for same  payer, amo unt and da te
  279    . ;(allow s that tra ce# may be  re-used b y the paye r on diffe rent ERA)   .F  S Z1= $O(^RCY(34 4.4,"ATRID UP",$$UP^X LFSTR(RCTR ACE1),$$UP ^XLFSTR(RC ID),Z1)) Q :’Z1  D  Q :RCNEW
  280    .S Z0=$G( ^RCY(344.4 ,Z1,0)) 
  281    .I $P(Z0, U,4)=RCDT, +$P(Z0,U,5 )=+RCAMT S  RCTRACE1= $E(RCTRACE ,1,46-$L(R CCNT))_”-D UP”_RCCNT, RCCNT=RCCN T+1 Q
  282    .S RCNEW= 1 .;
  283    I RCDUP,$ P(Z0,U,8), ’RCFORCE D   G ERATOT Q ; Receip t already  exists - n o update .  S RCERR=" This is a  duplicate  ERA and ha s already  been poste d",RCERR(1 )=-2 I RCD UP S RCERR ="DUP",RCE RR(1)=$S($ P(Z0,U,12) '=$P($G(^R CY(344.5,R CTDA,0)),U ,11):$P(Z0 ,U,12),1:- 1) G ERATO TQ ; S RCX =+$O(^RCY( 344.4," ") ,-1) S DIC (0)="L",DI C="^RCY(34 4.4,",DLAY GO=344.4 S  DIC("DR") =".02////" _RCTRACE_" ;.03////"_ RCID_";.04 ////"_RCDT _";.05//// "_RCAMT_"; .06////"_$ P(RCZ,U,6) _";.09//// 0;.12////" _$P($G(^RC Y(344.5,RC TDA,0)),U, 11)_";.07/ ///"_$$NOW ^XLFDT()_" ;.1////1"  I RCMETH'= "" S DIC(" DR")=DIC(" DR")_";.15 ////"_RCME TH F RCX=R CX+1:1 L + ^RCY(344.4 ,RCX,0):1  I $T,'$D(^ RCY(344.4, RCX,0)) S  X=RCX Q D  FILE^DICN  K DO,DLAYG O,DD,DIC L  -^RCY(344 .4,RCX,0)  S RCDA=$S( Y<0:"",1:+ Y) I 'RCDA  D . S RCE RR="An err or was enc ountered t hat preven ted the ad ding of an  ERA total s record.  An EEOB ex ception re cord was c reated." ; ERATOTQ Q  RCDA ;UPDC ON(RCRTOT)  ; Add con tact infor mation to  file 344.4  for an ER A N DIE,DA ,DR,Z,Q,X, Y,A,TYPE S  Z=$G(^TMP ($J,"RCDPE OB","CONTA CT")) Q:$T R($P(Z,U,3 ,9),U)=""  S DA=RCRTO T,DIE="^RC Y(344.4,", DR="" ; ;  If old for mat do I + $P($G(^TMP ($J,"RCDPE OB","HDR") ),U,16)'>0  D . F Q=2 :1:8 S DR= DR_$S(DR'= "":";3.0", 1:"3.0")_( Q-1)_"///" _$S($P(Z,U ,Q)="":"@" ,1:"/"_$P( Z,U,Q)) ;  ; If new f ormat (501 0) do I +$ P($G(^TMP( $J,"RCDPEO B","HDR")) ,U,16)>0 D  . N CNT S  CNT=0 . I  $P(Z,U,2) '="" S DR= "3.01////" _$P(Z,U,2)  .I $P(Z,U ,3)'="" S  DR=DR_$S(D R'="":";3. 02",1:"3.0 2")_"////" _$P(Z,U,3) _";3.03/// /TE",CNT=C NT+1 .I $P (Z,U,4)'=" " D ..S:CN T=1 DR=DR_ $S(DR'="": ";3.04",1: "3.04")_"/ ///"_$P(Z, U,4)_";3.0 5////FX" . .S:CNT=0 D R=DR_$S(DR '="":";3.0 2",1:"3.02 ")_"////"_ $P(Z,U,4)_ ";3.03//// FX" ..S CN T=CNT+1 .I  $P(Z,U,5) '="" D ..S :CNT=2 DR= DR_$S(DR'= "":";3.06" ,1:"3.06") _"////"_$P (Z,U,5)_"; 3.07////EM " ..S:CNT= 1 DR=DR_$S (DR'="":"; 3.04",1:"3 .04")_"/// /"_$P(Z,U, 5)_";3.05/ ///EM" ..S :CNT=0 DR= DR_$S(DR'= "":";3.02" ,1:"3.02") _"////"_$P (Z,U,5)_"; 3.03////EM " . I $P(Z ,U,6)'=""  S DR=DR_$S (DR'="":"; 5.01",1:"5 .01")_"/// /"_$P(Z,U, 6) D ^DIE  Q ;UPDADJ( RCRTOT) ;  Add ERA le vel adj da ta to file  344.4 N Z ,Z0,DA,DIC ,DLAYGO,DR ,X,Y,DO,DD  ; Remove  any alread y there S  Z=0 F  S Z =$O(^RCY(3 44.4,RCRTO T,2,Z)) Q: 'Z  S DA(1 )=RCRTOT,D A=Z D ^DIK  ; S Z=0 F   S Z=$O(^ TMP($J,"RC DPEOB","AD J",Z)) Q:' Z  S Z0=$G (^(Z)) D .  S DIC(0)= "L",X=$P(Z 0,U,3)_" " ,DA(1)=RCR TOT,DIC="^ RCY(344.4, "_DA(1)_", 2,",DIC("D R")=$S($P( Z0,U,2)'=" ":".02//// "_$P(Z0,U, 2),1:"") .  S DIC("DR ")=DIC("DR ")_$S(DIC( "DR")'="": ";",1:"")_ $S($P(Z0,U ,4)'="":". 03////"_$J (-$P(Z0,U, 4)/100,"", 2),1:"") .  S DIC("DR ")=DIC("DR ")_$S(DIC( "DR")'="": ";",1:"")_ $S($P(Z0,U ,5)'="":". 04////"_$P (Z0,U,5),1 :""),DLAYG O=344.42 .  S:$O(^RCY (344.4,RCR TOT,2,"B", X,0)) X="" ""_X_""""  . D FILE^D ICN K DIC, DO,DD Q ;D UPREC(RCET ,RCCT,RCST AR,RCFILE, RCALLDUP,R CEOB,RCBIL L,RCDUPEOB ) ; Overfl ow from RC DPESR2 S ^ TMP("RCERR 1",$J,RCCT )=" ",^TMP ("RCERR1", $J,RCCT,1) =RCET_RCCT _RCSTAR S  ^TMP("RCER R1",$J,RCC T,2)="(War ning): EEO B detail a lready fil ed for "_R CBILL_" -  "_$S(RCALL DUP:"Dupli cate not s tored",1:" EEOB updat ed"),^TMP( "RCERR1",$ J,RCCT,3)= " " S:RCFI LE=5 ^TMP( "RCERR1",$ J,RCCT,"*" )=^TMP("RC ERR1",$J,R CCT,2) I R CALLDUP S  RCEOB="",R CDUPEOB=-1  Q S $P(^T MP($J,"RCD PEOB",RCCT ,"EOB"),U) =RCEOB Q ;
  284  
  285  
  286   Routines
  287   Activities
  288   Routine Na me
  289   RCDPEX1
  290   Enhancemen t Category
  291    New
  292    Modify
  293    Delete
  294    No Change
  295   RTM
  296  
  297   Related Op tions
  298   RCDPE EXCE PTION PROC ESSING (Tr ansmission  exception s)
  299   RCDPE DUPL ICATE ERA  WORKLIST ( Duplicate  ERA Workli st)
  300  
  301   Related Ro utines
  302   Routines “ Called By”
  303   Routines “ Called”   
  304  
  305   RCDPEX
  306   RCDPEWLP
  307      DT^DICR W             
  308      EN^DIQ1               
  309      ^DIR                  
  310      $$PAYRN G^RCDPEU1     
  311      $$RTYPE ^RCDPEU1      
  312      $$SELPA Y^RCDPEU1     
  313      EN^VALM               
  314      $$SETST R^VALM1       
  315      CLEAN^V ALM10         
  316  
  317   Current Lo gic
  318   RCDPEX1 ;A LB/TMK - E LECTRONIC  EOB MESSAG E EXCEPTIO NS PROCESS  ;Aug 14,  2014@15:07 :12 ;;4.5; Accounts R eceivable; **173,262, 298,304,32 6**;Mar 20 , 1995;Bui ld 104 ;;P er VA Dire ctive 6402 , this rou tine shoul d not be m odified. ; EN ; Main  entry poin t D DT^DIC RW N RCFAS TXT,RCDA,R CEXCTYP,RC INCEX,DIR, Y,X,RCPAR, RCPAY,RCQU IT,RCTYPE, XX ; Ask f or TRANSMI SSION exce ptions or  DATA excep tions S DI R("A")="DO  YOU WANT  TO SEE (T) RANSMISSIO N OR (D)AT A EXCEPTIO NS?: ",DIR ("B")="T", DIR(0)="SA O^T:TRANSM ISSION;D:D ATA" S DIR ("?",1)="T RANSMISSIO N EXCEPTIO NS INCLUDE  ANY PROBL EM ENCOUNT ERED WHEN  AN ERA/EEO B",DIR("?" ,2)=" IS R ECEIVED AT  THE SITE  AND BEFORE  IT IS STO RED PERMAN ENTLY IN V ISTA." S D IR("?",3)= " THIS INC LUDES PART IAL MESSAG E RECEIPTS , EXTRACT  PROBLEMS A ND EEOBs T HAT ",DIR( "?",4)=" W ERE TRANSF ERRED IN F ROM ANOTHE R SITE." S  DIR("?",5 )="DATA EX CEPTIONS I NCLUDE EEO B DETAIL R ECORDS FOR  SPECIFIC  BILLS THAT  CAN'T BE"  S DIR("?" ,6)=" FULL Y PROCESSE D INTO THE  VISTA SYS TEM. THIS  INCLUDES E EOB DETAIL  FOR",DIR( "?",7)=" C LAIMS THAT  NEED TO B E TRANSFER RED TO ANO THER SITE  OR WHOSE D ETAIL COUL D",DIR("?" )=" NOT BE  STORED IN  IB" D ^DI R K DIR I  Y=""!(Y="^ ") Q S RCE XCTYP=Y,RC QUIT=0 I R CEXCTYP="D " D  ; Inc lude excep tions for  MEDICAL, P HARMACY or  BOTH - PR CA*4.5*298  Filter qu estion for  medical,  pharmacy o r both . S  RCTYPE=$$ RTYPE^RCDP EU1("A") ;  PRCA*4.5* 326 Pick M EDICAL/PHA RMACY/TRIC ARE/ALL .  I RCTYPE=- 1 S RCQUIT =1 Q . ; .  S RCPAY=$ $PAYRNG^RC DPEU1() ;  PRCA*4.5*3 26 New pay er selecti on . I RCT YPE=-1 S R CQUIT=1 Q  . I RCPAY' ="A" D  ;  . . S RCPA R("TYPE")= RCTYPE,RCP AR("SELC") =RCPAY . .  S RCPAR(" DICA")="Se lect Insur ance Compa ny NAME: "  . . S XX= $$SELPAY^R CDPEU1(.RC PAR) . . I  XX=-1 S R CQUIT=1 ;  ; Exit if  the user a sks to exi t.  I RCQU IT Q ; ; T ransmissio n exceptio ns I RCEXC TYP="T" D  EN^VALM("R CDPEX EOB  EXCEPTION  LIST") I R CEXCTYP="D " D EN^VAL M("RCDPEX  EOB_SUM EX CEPTION LI ST") K RCF ASTXT,RCDA  Q ;INIT ;  -- set up  initial v ariables S  U="^",VAL MCNT=0,VAL MBG=1 D BL D Q ;REBLD  ; Set up  formatted  global ;BL D ; -- bui ld list of  messages  N DA,DR,RC SEQ,RCMSG, RCS,RCER,R CDPDATA,RC 0,TOOSOON, X,Z K ^TMP ("RCDPEX-E OB",$J),^T MP("RCDPEX -EOBDX",$J ) S (RCMSG ,RCSEQ,VAL MCNT)=0 ;  ; Extract  from 344.5  F  S RCMS G=$O(^RCY( 344.5,"AEX C",1,RCMSG )) Q:'RCMS G  S RC0=$ G(^(RCMSG, 0)) D . I  ($P(RC0,U, 3)\1)=DT S  TOOSOON=0  D  Q:TOOS OON .. ; I f partial  msg, allow  a day bef ore it's a n exceptio n .. I $P( RC0,U,10)= 2 Q . ; .  ; -- add t o list . ; Display me ssage id,  type, date  recorded,  exception , mail msg  # . S RCS EQ=RCSEQ+1  . S DR=". 01:.03;.1; .11",DA=RC MSG D DIQ3 445(DA,DR)  . S X=""  . S X=$$SE TSTR^VALM1 ($E(RCSEQ_ $J("",4),1 ,4)_" "_$G (RCDPDATA( 344.5,RCMS G,.01,"E") ),"",1,26)  . S X=$$S ETSTR^VALM 1(" "_$E($ G(RCDPDATA (344.5,RCM SG,.02,"I" )),4,6),X, 27,9) . S  X=$$SETSTR ^VALM1(" " _$G(RCDPDA TA(344.5,R CMSG,.03," E")),X,36, 22) . S X= $$SETSTR^V ALM1(" "_$ G(RCDPDATA (344.5,RCM SG,.11,"E" )),X,58,17 ) . D SET( X,344.5,RC MSG,RCSEQ)  . S X=$J( "",4)_"EXC EPTION: "_ $G(RCDPDAT A(344.5,RC MSG,.1,"E" )) . D SET (X,344.5,R CMSG,RCSEQ ) . S DR=1 ,DA=RCMSG  D DIQ3445( DA,DR) ; G et display  data . S  Z=0 F  S Z =$O(RCDPDA TA(344.5,R CMSG,1,Z))  Q:'Z  S X =$J("",6)_ RCDPDATA(3 44.5,RCMSG ,1,Z) D SE T(X,344.5, RCMSG,RCSE Q) ; I '$D (^TMP("RCD PEX-EOB",$ J)) S VALM CNT=2,^TMP ("RCDPEX-E OB",$J,1,0 )=" ",^TMP ("RCDPEX-E OB",$J,2,0 )=" There  Are No EEO B Exceptio n Records  On File" Q  ;FNL ; --  Clean up  list K ^TM P("RCDPEX- EOBDX",$J) ,^TMP("RCD PEU1",$J)  ; PRCA*4.5 *326 D CLE AN^VALM10  K RCFASTXT  Q ;SET(X, FILE,RCMSG ,RCSEQ) ;  -- set arr ays for EO B exceptio n records  ; X = the  data to se t into the  global S  VALMCNT=VA LMCNT+1,^T MP("RCDPEX -EOB",$J,V ALMCNT,0)= X S ^TMP(" RCDPEX-EOB ",$J,"IDX" ,VALMCNT,R CSEQ)="" S  ^TMP("RCD PEX-EOBDX" ,$J,RCSEQ) =VALMCNT_U _RCMSG_U_F ILE Q ;HDR  ; S VALMH DR(1)=$J(" ",21)_"ERA /EEOB MESS AGES WITH  EXCEPTION  CONDITIONS " S VALMHD R(2)=" " Q  ;DIQ3445( DA,DR) ; D IQ call to  retrieve  data for D R fields i n file 344 .5 N %I,D0 ,DIC,DIQ,D IQ2,YY K R CDPDATA(34 4.5) S DIQ (0)="EI",D IC="^RCY(3 44.5,",DIQ ="RCDPDATA " D EN^DIQ 1 Q ;DIQ34 44(DA,DR)  ; DIQ call  to retrie ve data fo r DR field s in file  344.4 N %I ,D0,DIC,DI Q,DIQ2,YY  K RCDPDATA (344.4) S  DIQ(0)="EI ",DIC="^RC Y(344.4,", DIQ="RCDPD ATA" D EN^ DIQ1 Q ;
  319  
  320   Modified L ogic (Chan ges are in  bold)
  321   RCDPEX1 ;A LB/TMK - E LECTRONIC  EOB MESSAG E EXCEPTIO NS PROCESS  ;Aug 14,  2014@15:07 :12 ;;4.5; Accounts R eceivable; **173,262, 298,304,32 6,XXX**;Ma r 20, 1995 ;Build 104  ;;Per VA  Directive  6402, this  routine s hould not  be modifie d. ;EN ; M ain entry  point D DT ^DICRW N R CFASTXT,RC DA,RCEXCTY P,RCINCEX, DIR,Y,X,RC PAR,RCPAY, RCQUIT,RCT YPE,XX ; A sk for TRA NSMISSION  exceptions  or DATA e xceptions  S DIR("A") ="DO YOU W ANT TO SEE  (T)RANSMI SSION OR ( D)ATA EXCE PTIONS?: " ,DIR("B")= "T",DIR(0) ="SAO^T:TR ANSMISSION ;D:DATA" S  DIR("?",1 )="TRANSMI SSION EXCE PTIONS INC LUDE ANY P ROBLEM ENC OUNTERED W HEN AN ERA /EEOB",DIR ("?",2)="  IS RECEIVE D AT THE S ITE AND BE FORE IT IS  STORED PE RMANENTLY  IN VISTA."  S DIR("?" ,3)=" THIS  INCLUDES  PARTIAL ME SSAGE RECE IPTS, EXTR ACT PROBLE MS AND EEO Bs THAT ", DIR("?",4) =" WERE TR ANSFERRED  IN FROM AN OTHER SITE ." S DIR(" ?",5)="DAT A EXCEPTIO NS INCLUDE  EEOB DETA IL RECORDS  FOR SPECI FIC BILLS  THAT CAN'T  BE" S DIR ("?",6)="  FULLY PROC ESSED INTO  THE VISTA  SYSTEM. T HIS INCLUD ES EEOB DE TAIL FOR", DIR("?",7) =" CLAIMS  THAT NEED  TO BE TRAN SFERRED TO  ANOTHER S ITE OR WHO SE DETAIL  COULD",DIR ("?")=" NO T BE STORE D IN IB" D  ^DIR K DI R I Y=""!( Y="^") Q S  RCEXCTYP= Y,RCQUIT=0  I RCEXCTY P="D" D  ;  Include e xceptions  for MEDICA L, PHARMAC Y or BOTH  - PRCA*4.5 *298 Filte r question  for medic al, pharma cy or both  . S RCTYP E=$$RTYPE^ RCDPEU1("A ") ; PRCA* 4.5*326 Pi ck MEDICAL /PHARMACY/ TRICARE/AL L . I RCTY PE=-1 S RC QUIT=1 Q .  ; . S RCP AY=$$PAYRN G^RCDPEU1( ) ; PRCA*4 .5*326 New  payer sel ection . I  RCTYPE=-1  S RCQUIT= 1 Q . I RC PAY'="A" D   ; . . S  RCPAR("TYP E")=RCTYPE ,RCPAR("SE LC")=RCPAY  . . S RCP AR("DICA") ="Select I nsurance C ompany NAM E: " . . S  XX=$$SELP AY^RCDPEU1 (.RCPAR) .  . I XX=-1  S RCQUIT= 1 ; ; Exit  if the us er asks to  exit.  I  RCQUIT Q ;  ; Transmi ssion exce ptions I R CEXCTYP="T " D EN^VAL M("RCDPEX  EOB EXCEPT ION LIST")  I RCEXCTY P="D" D EN ^VALM("RCD PEX EOB_SU M EXCEPTIO N LIST") K  RCFASTXT, RCDA Q ;
  322   EN1 ; Dupl icate ERA  Worklist
  323    D EN^VALM ("RCDPEX D UPLICATE E RA LIST")  K RCFASTXT ,RCDA Q
  324    ;
  325   INIT ; --  set up ini tial varia bles (RCDP EX EOB EXC EPTION LIS T) S U="^" ,VALMCNT=0 ,VALMBG=1  D BLD(“TRA NSMISSION” ) Q
  326    ;
  327   INITD ; --  set up in itial vari ables (RCD PEX DUPLIC ATE ERA LI ST) S U="^ ",VALMCNT= 0,VALMBG=1  D BLD(“DU PLICATE ER A”) Q ;REB LD ; Set u p formatte d global ; BLD(MODE)  ; -- build  list of m essages
  328    ; INPUT –  MODE = “T RANSMISSIO N” or “DUP LICATE ERA
  329    ; OUTPUT  - ^TMP(“RC DPEX-EOB”, $J) N DA,D R,RCDUP,RC SEQ,RCMSG, RCS,RCER,R CDPDATA,RC 0,TOOSOON, X,Z K ^TMP ("RCDPEX-E OB",$J),^T MP("RCDPEX -EOBDX",$J ) S (RCMSG ,RCSEQ,VAL MCNT)=0 ;  ; Extract  from 344.5  F  S RCMS G=$O(^RCY( 344.5,"AEX C",1,RCMSG )) Q:'RCMS G  S RC0=$ G(^(RCMSG, 0)) D . I  ($P(RC0,U, 3)\1)=DT S  TOOSOON=0  D  Q:TOOS OON .. ; I f partial  msg, allow  a day bef ore it's a n exceptio n .. I $P( RC0,U,10)= 2 Q . ;
  330    . ; Check  if messag e is on du plicate ER A worklist
  331    . S RCDUP =+$$GET1^D IQ(344.5,R CMSG_”,”)
  332    . ; Only  display me ssages rel evant to w orklist ty pe
  333    . I MODE= ”TRANSMISS ION”,RCDUP  Q
  334    . I MODE= ”DUPLICATE  ERA”,’RCD UP Q . ; - - add to l ist . ;Dis play messa ge id, typ e, date re corded, ex ception, m ail msg #  . S RCSEQ= RCSEQ+1 .  S DR=".01: .03;.1;.11 ",DA=RCMSG  D DIQ3445 (DA,DR) .  S X="" . S  X=$$SETST R^VALM1($E (RCSEQ_$J( "",4),1,4) _" "_$G(RC DPDATA(344 .5,RCMSG,. 01,"E"))," ",1,26) .  S X=$$SETS TR^VALM1("  "_$E($G(R CDPDATA(34 4.5,RCMSG, .02,"I")), 4,6),X,27, 9) . S X=$ $SETSTR^VA LM1(" "_$G (RCDPDATA( 344.5,RCMS G,.03,"E") ),X,36,22)  . S X=$$S ETSTR^VALM 1(" "_$G(R CDPDATA(34 4.5,RCMSG, .11,"E")), X,58,17) .  D SET(X,3 44.5,RCMSG ,RCSEQ) .  S X=$J("", 4)_"EXCEPT ION: "_$G( RCDPDATA(3 44.5,RCMSG ,.1,"E"))  . D SET(X, 344.5,RCMS G,RCSEQ) .  S DR=1,DA =RCMSG D D IQ3445(DA, DR) ; Get  display da ta . S Z=0  F  S Z=$O (RCDPDATA( 344.5,RCMS G,1,Z)) Q: 'Z  S X=$J ("",6)_RCD PDATA(344. 5,RCMSG,1, Z) D SET(X ,344.5,RCM SG,RCSEQ)  ; I '$D(^T MP("RCDPEX -EOB",$J))  S VALMCNT =2,^TMP("R CDPEX-EOB" ,$J,1,0)="  ",^TMP("R CDPEX-EOB" ,$J,2,0)="  There Are  No EEOB E xception R ecords On  File" Q ;F NL ; -- Cl ean up lis t K ^TMP(" RCDPEX-EOB DX",$J),^T MP("RCDPEU 1",$J) ; P RCA*4.5*32 6 D CLEAN^ VALM10 K R CFASTXT Q  ;SET(X,FIL E,RCMSG,RC SEQ) ; --  set arrays  for EOB e xception r ecords ; X  = the dat a to set i nto the gl obal S VAL MCNT=VALMC NT+1,^TMP( "RCDPEX-EO B",$J,VALM CNT,0)=X S  ^TMP("RCD PEX-EOB",$ J,"IDX",VA LMCNT,RCSE Q)="" S ^T MP("RCDPEX -EOBDX",$J ,RCSEQ)=VA LMCNT_U_RC MSG_U_FILE  Q ;HDR ;  S VALMHDR( 1)=$J("",2 1)_"ERA/EE OB MESSAGE S WITH EXC EPTION CON DITIONS" S  VALMHDR(2 )=" " Q
  335    ; 
  336   HDR1 ; S V ALMHDR(1)= $J("",21)_ "DUPLICATE  835ERA ME SSAGES" S  VALMHDR(2) =" " Q
  337    ;DIQ3445( DA,DR) ; D IQ call to  retrieve  data for D R fields i n file 344 .5 N %I,D0 ,DIC,DIQ,D IQ2,YY K R CDPDATA(34 4.5) S DIQ (0)="EI",D IC="^RCY(3 44.5,",DIQ ="RCDPDATA " D EN^DIQ 1 Q ;DIQ34 44(DA,DR)  ; DIQ call  to retrie ve data fo r DR field s in file  344.4 N %I ,D0,DIC,DI Q,DIQ2,YY  K RCDPDATA (344.4) S  DIQ(0)="EI ",DIC="^RC Y(344.4,", DIQ="RCDPD ATA" D EN^ DIQ1 Q ;
  338  
  339   Routines
  340   Activities
  341   Routine Na me
  342   RCDPEX5
  343   Enhancemen t Category
  344    New
  345    Modify
  346    Delete
  347    No Change
  348   RTM
  349  
  350   Related Op tions
  351   RCDPE DUPL ICATE ERA  WORKLIST ( Duplicate  ERA Workli st)
  352  
  353   Related Ro utines
  354   Routines “ Called By”
  355   Routines “ Called”   
  356  
  357   N/A
  358      ^%ZIS                 
  359      HOME^%Z IS            
  360      ^%ZISC                
  361      ^%ZTLOA D             
  362      $$S^%ZT LOAD          
  363      STAT^%Z TLOAD         
  364      $$GET1^ DID           
  365      ^DIE                  
  366      ^DIK                  
  367      GETS^DI Q             
  368      ^DIR                  
  369      DISP^RC DPESR0        
  370      SENDACK ^RCDPESR5     
  371      BLD^1          
  372      FULL^VA LM1           
  373      PAUSE^V ALM1          
  374      EN^VALM 2             
  375      $$FMTE^ XLFDT         
  376      $$NOW^X LFDT          
  377      SENDMSG ^XMXAPI       
  378  
  379   Current Lo gic
  380   N/A
  381  
  382   Modified L ogic (Chan ges are in  bold)
  383   RCDPEX5 ;A LB/TMK,DWA  - ELECTRO NIC EOB EX CEPTION PR OCESSING -  FILE 344. 5 ;Jun 06,  2014@19:1 1:19 ;;4.5 ;Accounts  Receivable ;**173,208 ,269,298,X XX**;Mar 2 0, 1995;Bu ild 121 ;P er VA Dire ctive 6402 , this rou tine shoul d not be m odified. Q  ;UPD ; Up date (File ) ERA msgs  manually  from DUPLI CATE excep tion list  for file 3 44.5 N RCD A,RCOK,RCT DA,ZTSK,RC TSK,RCTYP, RCU,RC0 D  FULL^VALM1  D SEL(.RC DA,1) S RC DA=$O(RCDA ("")) I RC DA="" G UP DQ S RCTDA =+RCDA(RCD A) I '$$LO CK(RCTDA)  G UPDQ S R C0=$G(^RCY (344.5,RCT DA,0)) ; I  RC0="" D   G UPDQ .  W !,*7,"ER A #",RCDA, " is no lo nger in ex ception fi le" S RCOK ="" . D PA USE^VALM1  I $P(RC0,U ,5) S RCOK =1 D  G:'R COK UPDQ .  N ZTSK .  S ZTSK=$P( RC0,U,5) D  STAT^%ZTL OAD Q:ZTSK (0)=0 ;Tas k not sche duled . I  "12"[ZTSK( 1) W *7,!, "This reco rd has alr eady been  scheduled  for update . Task # i s: ",$P(RC 0,U,5) S R COK="" D P AUSE^VALM1  ; S RCTYP =$P(RC0,U, 2) S RCU=$ S(RCTYP="8 35ERA":"NE WERA^RCDPE SR2("_RCTD A_",1)",RC TYP="835XF R":"FILEEO B^RCDPESR5 ("_RCTDA_" )",1:"") I  RCU="" W  !,*7,"This  message h as an inva lid 'type'  - can't u pdate" D P AUSE^VALM1  G UPDQ S  RCTSK=$$TA SK(RCU,RCT DA) I RCTS K W !,"Fil e update h as been ta sked (#",R CTSK,")" I  'RCTSK W  !,*7,"File  update co uld not be  tasked. P lease try  again late r!!!" D PA USE^VALM1  ; D BLD^RC DPEX1UPDQ  I $G(RCTDA ) L -^RCY( 344.5,RCTD A,0) S VAL MBCK="R" Q  ;VP ; Vie w/Print ER A Messages  - File 34 4.5 N DHD, DIC,FLDS,B Y,FR,TO,DI R,Y,L,RCDA ,RCTDA,RCR AW,POP D F ULL^VALM1, SEL(.RCDA, 1) S RCDA= $O(RCDA("" )) G:'RCDA  VPQ S RCT DA=$G(RCDA (RCDA)) S  DIR(0)="YA ",DIR("A") ="DO YOU W ANT TO INC LUDE DATA  THE WAY IT  WAS RECEI VED (RAW D ATA)?: ",D IR("B")="N " D ^DIR K  DIR I $D( DUOUT)!$D( DTOUT) G V PQ S RCRAW =+Y ; Ask  device N % ZIS,ZTRTN, ZTSAVE,ZTD ESC S %ZIS ="QM" D ^% ZIS G:POP  VPQ I $D(I O("Q")) D   G VPQ . S  ZTRTN="VP OUT^RCDPEX ",ZTDESC=" AR - Print  EEOB Exce ption Mess age" . S Z TSAVE("RCT DA")="",ZT SAVE("RCRA W")="" . D  ^%ZTLOAD  . W !!,$S( $D(ZTSK):" Your task  number"_ZT SK_" has b een queued .",1:"Unab le to queu e this job .") . K ZT SK,IO("Q")  D HOME^%Z IS U IO ;V POUT ; Ent rypoint fo r queued j ob N Z,Z0, RCSTOP,RCP G,RCXM,RCX M1,RC,RCZ, RCTDAC,RCV 5 K ^TMP($ J,"RCRAW") ,^TMP($J," RCOUT") S  RCTDAC=RCT DA_",",RCV 5=0 ; D GE TS^DIQ(344 .5,RCTDAC, "*","IEN", "RCZ") D T XTDE(RCTDA ,.RCZ,1,.R CXM,.RC) ;  I $O(^RCY (344.5,RCT DA,"EX",0) ) D . S RC =RC+1,RCXM (RC)="**EX CEPTION ME SSAGES**"  . D TXTDE( RCTDA,.RCZ ,5,.RCXM,. RC) ; K ^T MP("RCSAVE ",$J) M ^T MP("RCSAVE ",$J)=^RCY (344.5,RCT DA,2) I +$ P($G(^TMP( "RCSAVE",$ J,1,0)),U, 16)>0 S RC V5=1 S Z=0  F  S Z=$O (^TMP("RCS AVE",$J,Z) ) Q:'Z  I  $P($G(^(Z, 0)),U)["83 5" K ^(0)  Q  ; Get r id of head er node D  DISP^RCDPE SR0("^TMP( ""RCSAVE"" ,$J)","^TM P($J,""RCR AW"")",1," ^TMP($J,"" RCOUT"")", 75) ; Get  formatted  'raw' data  K ^TMP("R CSAVE",$J)  I $G(RCRA W) D . S R C=$O(^TMP( $J,"RCOUT" ,""),-1)+1 ,^TMP($J," RCOUT",RC) =" " . S R C=RC+1,^TM P($J,"RCOU T",RC)="** RAW DATA** " . S Z=0  F  S Z=$O( ^RCY(344.5 ,RCTDA,2,Z )) Q:'Z  D  .. F Z0=1 :80:$L($G( ^RCY(344.5 ,RCTDA,2,Z ,0))) S RC =RC+1,^TMP ($J,"RCOUT ",RC)=$E($ G(^RCY(344 .5,RCTDA,2 ,Z,0)),Z0, Z0+79) ; S  (RCPG,RCS TOP,Z)=0 F   S Z=$O(R CXM(Z)) Q: 'Z  S ^TMP ($J,"RCOUT ",Z-999)=R CXM(Z) S Z ="" F  S Z =$O(^TMP($ J,"RCOUT", Z)) Q:'Z   D  Q:RCSTO P . I $D(Z TQUEUED),$ $S^%ZTLOAD  S (RCSTOP ,ZTSTOP)=1  K ZTREQ I  +$G(RCPG)  W !,"***T ASK STOPPE D BY USER* **" Q . I  'RCPG!(($Y +5)>IOSL)  D  I RCSTO P Q .. D:R CPG ASK(.R CSTOP) I R CSTOP Q ..  D HDR(RCT DA,.RCPG)  . W !,$G(^ TMP($J,"RC OUT",Z)) I  'RCSTOP,R CPG D ASK( .RCSTOP) ;  I $D(ZTQU EUED) S ZT REQ="@" I  '$D(ZTQUEU ED) D ^%ZI SC ;VPQ K  ^TMP($J,"R CRAW"),^TM P($J,"RCOU T") S VALM BCK="R" Q  ;SEL(RCDA, ONE) ; Sel ect entry( s) from li st ; RCDA  = array re turned if  selections  made ; RC DA(n)=ien  of bill se lected in  file 344.5  ; ONE = i f set to 1 , only one  selection  can be ma de at a ti me N RC K  RCDA D EN^ VALM2($G(X QORNOD(0)) ,$S('$G(ON E):"",1:"S ")) S RCDA =0 F  S RC DA=$O(VALM Y(RCDA)) Q :'RCDA  S  RC=$G(^TMP ("RCDPEX-E OBDX",$J,R CDA)),RCDA (RCDA)=+$P (RC,U,2) Q  ; ;DEL ;  Delete mes sages from  messages  list - fil e 344.5 N  RCDA,RCOK, RCTDA,RCTD AC,RCTYP,R CU,RC0,DIR ,RCT,RCE,R CDIQ,RCX,Z ,X,Y,XMSUB J,XMTO,XMB ODY,XMDUZ, XMZ D FULL ^VALM1 S R CTDA=0 D S EL(.RCDA,1 ) S RCDA=$ O(RCDA("") ) I RCDA=" " G DELQ S  RCTDA=+RC DA(RCDA),R CTDAC=RCTD A_"," S RC PAYTP=$$PA YTYP(RCTDA ) W ! S DI R(0)="YA", DIR("A",1) ="This act ion will P ERMANENTLY  delete an  EDI Lockb ox message  from your  system",D IR("A",2)= "A bulleti n will be  sent to re port the d eletion",D IR("A",3)= " " S DIR( "A")="ARE  YOU SURE Y OU WANT TO  CONTINUE?  ",DIR("B" )="NO" D ^ DIR K DIR  G:Y'=1 DEL Q I '$$LOC K(RCTDA) G  DELQ S RC 0=$G(^RCY( 344.5,RCTD A,0)) ; I  $P(RC0,U,5 ) S RCOK=1  D  G:'RCO K DELQ . N  ZTSK . S  ZTSK=$P(RC 0,U,5) D S TAT^%ZTLOA D Q:ZTSK(0 )=0 ;Task  not schedu led . I "1 2"[ZTSK(1)  W *7,!,"T his messag e is curre ntly sched uled for u pdate. Tas k # is: ", $P(RC0,U,1 1) S RCOK= "" D PAUSE ^VALM1 ; S  DIR(0)="Y A",DIR("A" ,1)=" ",DI R("A",2)=" ",$P(DIR(" A",2),"*", 54)="",DIR ("A",3)="*  This EDI  Lockbox me ssage is a bout to be  PERMANENT LY deleted !! *",DIR( "A",4)=DIR ("A",2),DI R("A",5)="  " S DIR(" A")="ARE Y OU STILL S URE YOU WA NT TO CONT INUE? ",DI R("B")="NO " W ! D ^D IR W ! K D IR I Y'=1  W !!,"Noth ing delete d" D PAUSE ^VALM1 G D ELQ ; D GE TS^DIQ(344 .5,RCTDAC, "*","IEN", "RCDIQ") S  RCE=0 D T XTDE(RCTDA ,.RCDIQ,1, .RCX,.RCE)  S RCE=RCE +1,RCX(RCE )="RAW MES SAGE DATA: " D TXTDE( RCTDA,.RCD IQ,2,.RCX, .RCE) D DE LMSG(RCTDA ) I $D(^RC Y(344.5,RC TDA)) D  G  DELQ . W  !,"Message  not delet ed - probl em with de lete" D PA USE^VALM1  ; W !,"A b ulletin ha s been sen t to repor t this del etion",! D  PAUSE^VAL M1 ; D BLD ^RCDPEX1DE LQ L -^RCY (344.5,RCT DA,0) S VA LMBCK="R"  Q ;DELMSG( RCTDA) ; D elete mess age from t emporary m essage hol ding file  344.5 ; N  DIK,DA,Y S  DIK="^RCY (344.5,",D A=RCTDA D  ^DIK Q ;TA SK(RCRTN,R CTDA) ; Sc hedule the  task to u pdate data  base from  message ;  RCRTN = r outine to  task ; RCT DA = inter nal entry  of message  in file 3 44.5 ; N Z TSK,ZTDESC ,ZTIO,ZTDT H,ZTSAVE,D A,DR,DIE S  ZTIO="",Z TDTH=$H,ZT DESC="UPDA TE DATA BA SE FROM EE OB EXCEPTI ON PROCESS ING",ZTSAV E("RC*")=" ",ZTRTN=RC RTN D ^%ZT LOAD I $G( ZTSK),$G(^ RCY(344.5, RCTDA,0))  D . S DIE= "^RCY(344. 5,",DR=".0 5////"_ZTS K_";.04/// /1;.08//// 0",DA=RCTD A D ^DIE Q  $G(ZTSK)  ;LOCK(RCTD A) ; Attem pt to lock  message f ile entry  RCTDA in f ile 344.5  ; Return 1  if succes sful, 0 if  not able  to lock ;  N OK S OK= 1 L +^RCY( 344.5,RCTD A,0):5 I ' $T D . I ' $D(DIQUIET ) W !,*7," Another us er is edit ing this e ntry ... p lease try  again late r" D PAUSE ^VALM1 . S  OK=0 Q OK  ;HDR(RCTD A,RCPG) ;P rints repo rt heading  ; RCTDA =  ien of fi le 344.5 ;  RCPG = pa ge # last  printed N  Z I RCPG!( $E(IOST,1, 2)="C-") W  @IOF,*13  I 'RCPG D  . N RCX,RC Z . D TXT0 (RCTDA,.RC Z,.RCX,0)  ; Get 0-no de caption ed fields  . S Z=0 F   S Z=$O(RC X(Z)) Q:'Z   S ^TMP($ J,"RCHDR_E X",Z)=RCX( Z) S RCPG= RCPG+1 W ! ,?15,"EDI  LBOX – DUP LICATE ERA  - EEOB DE TAIL",?55, $$FMTE^XLF DT(DT,2),? 70,"Page:  ",RCPG,! S  Z=0 F  S  Z=$O(^TMP( $J,"RCHDR_ EX",Z)) Q: 'Z  W !,$G (^(Z)) W ! ,$TR($J("" ,IOM)," ", "=") Q ;AS K(RCSTOP)  ; Ask to s top ; RCST OP: passed  by ref, f lag to sto p processi ng I $E(IO ST,1,2)'[" C-" Q N DI R,DIROUT,D IRUT,DTOUT ,DUOUT S D IR(0)="E"  W ! D ^DIR  I ($D(DIR UT))!($D(D UOUT)) S R CSTOP=1 Q  Q ; *** ;  *** Entryp oints TXT*  assume th ese parame ter defini tions ***  ; *** ; FU NCTIONs re turns RCXM 1 and RCCT  if passed  by refere nce ; RCTD A = ien, f ile 344.5  ; RCXM1 =  the array  returned w ith text,  captioned  ; RCCT = #  of lines  already in  array (op tional) ;  RCDIQ = th e array re turned fro m GETS^DIQ  ; *** ;TX T0(RCTDA,R CDIQ,RCXM1 ,RCCT) ; A ppend 0-no de caption ed data to  array RCX M1 ; See a bove for p arameter d efinitions  ; N RCZ,R CTDAC,LINE ,DAT,Z,Z0  S LINE="", RCCT=+$G(R CCT),RCTDA C=RCTDA_", " S Z=0 F   S Z=$O(RC DIQ(344.5, RCTDAC,Z))  Q:'Z!(Z'< 1) D . S Z 0=$$GET1^D ID(344.5,Z ,,"LABEL")  . S DAT=Z 0_": "_$G( RCDIQ(344. 5,RCTDAC,Z ,"E")) . I  $L(DAT)>3 9 S:$L(LIN E) RCCT=RC CT+1,RCXM1 (RCCT)=LIN E S RCCT=R CCT+1,RCXM 1(RCCT)=DA T,LINE=""  Q . I $L(L INE) D  Q: LINE=""  ;  Left side  exists ..  I $L(LINE )+$L(DAT)> 75 S RCCT= RCCT+1,RCX M1(RCCT)=L INE,LINE=D AT Q .. S  LINE=LINE_ " "_DAT,RC CT=RCCT+1, RCXM1(RCCT )=LINE,LIN E="" . S L INE=$E(DAT _$J("",39) ,1,39) I $ L(LINE) S  RCCT=RCCT+ 1,RCXM1(RC CT)=LINE S :RCCT RCCT =RCCT+1,RC XM1(RCCT)= " " Q ;TXT DE(RCTDA,R CDIQ,RCNOD E,RCXM1,RC CT) ; Appe nd display  data to a rray RCXM1  ; See abo ve for par ameter def initions ;  RCNODE =  the WP fie ld # to re turn ; N R CCT1,LINE, Z,RCTDAC S  LINE="",R CCT=+$G(RC CT),RCCT1= RCCT S RCT DAC=RCTDA_ "," S Z=0  F  S Z=$O( RCDIQ(344. 5,RCTDAC,R CNODE,Z))  Q:'Z  D .  S RCCT=RCC T+1,RCXM1( RCCT)=$G(R CDIQ(344.5 ,RCTDAC,RC NODE,Z)) S :RCCT'=RCC T1 RCCT=RC CT+1,RCXM1 (RCCT)=" "  Q ;PAYTYP (RCTDA) ;F ind pay so urce - PRC A*4.5*298  N RCPT,X S  RCPT="" S  X=$G(^RCY (344.5,RCT DA,2,1,0))  I $P(X,U) ="835ERA"  S RCPT=$P( X,U,17) Q  RCPT
  384  
  385  
  386  
  387   Options
  388   Activities
  389   Option Nam e
  390   RCDPE DUPL ICATE ERA  WORKLIST
  391   Enhancemen t Category
  392    New
  393    Modify
  394    Delete
  395    No Change
  396   Associated  Menu Opti ons that w ill invoke  this refe rence
  397   RCDPE EDI  LOCKBOX ME NU
  398   Data Passi ng
  399    Input
  400    Output
  401    Both
  402    Global Re ference
  403    Local Ref erence
  404   Menu Text  Descriptio n
  405   Duplicate  ERA Workli st
  406   Option Typ e
  407    Edit
  408    Print
  409    Menu
  410    Inquire
  411  
  412    Action
  413    Run Routi ne
  414    Other
  415  
  416   Associated  Routine
  417   RCDPEX1
  418   Option Def inition
  419   N/A
  420  
  421   Current En try Action  Logic
  422   N/A
  423  
  424   Modified E ntry Actio n Logic (C hanges are  in bold)
  425   EN1^RCDPEX 1
  426  
  427   Current Ex it Action  Logic
  428   N/A
  429  
  430   Modified E xit Action  Logic (Ch anges are  in bold)
  431   N/A
  432  
  433  
  434  
  435   Options
  436   Activities
  437   Option Nam e
  438   RCDPE EDI  LOCKBOX ME NU
  439   Enhancemen t Category
  440    New
  441    Modify
  442    Delete
  443    No Change
  444   Associated  Menu Opti ons that w ill invoke  this refe rence
  445   RCDPE EDI  LOCKBOX ME NU
  446   Data Passi ng
  447    Input
  448    Output
  449    Both
  450    Global Re ference
  451    Local Ref erence
  452   Menu Text  Descriptio n
  453   Duplicate  ERA Workli st
  454   Option Typ e
  455    Edit
  456    Print
  457    Menu
  458    Inquire
  459  
  460    Action
  461    Run Routi ne
  462    Other
  463  
  464   Associated  Routine
  465   N/A
  466   Option Def inition
  467   NAME: RCDP E EDI LOCK BOX MENU              MENU TEXT:  EDI Lockb ox (ePayme nts)
  468     TYPE: me nu                               CREATOR: D OBY,LAMONT
  469     PACKAGE:  ACCOUNTS  RECEIVABLE
  470    DESCRIPTI ON:   This  is the me nu that co ntains the  EDI Lockb ox functio nality.  
  471   ITEM: RCDP E EDI LOCK BOX WORKLI ST         SYNONYM: W L    DISPL AY ORDER:  10
  472   ITEM: RCDP E EXCEPTIO N PROCESSI NG         SYNONYM: E XC   DISPL AY ORDER:  5
  473   ITEM: RCDP E DUPLICAT E ERA WORK LIST       SYNONYM: D UP   DISPL AY ORDER:  42
  474   ITEM: RCDP E MATCH EF T TO ERA              SYNONYM: M A    DISPL AY ORDER:  20
  475   ITEM: RCDP E EDI LOCK BOX REPORT S MENU     SYNONYM: R EP   DISPL AY ORDER:  55
  476   ITEM: RCDP E MANUAL M ATCH EFT-E RA         SYNONYM: M M    DISPL AY ORDER:  30
  477   ITEM: RCDP E MARK 0-B AL EFT MAT CHED       SYNONYM: Z B    DISPL AY ORDER:  70
  478   ITEM: RCDP E ERA POST ED BY PAPE R EOB      SYNONYM: U P    DISPL AY ORDER:  65
  479   ITEM: RCDP E UNMATCH  ERA                   SYNONYM: U N    DISPL AY ORDER:  60
  480   ITEM: RCDP E REMOVE E RA FROM WO RKLIST     SYNONYM: R EM   DISPL AY ORDER:  50
  481   ITEM: RCDP E EEOB MOV E/COPY/REM OVE        SYNONYM: M CR   DISPL AY ORDER:  25
  482   ITEM: RCDP E REMOVE D UP DEPOSIT S          SYNONYM: R EFT  DISPL AY ORDER:  45
  483   ITEM: RCDP E UNPOSTED  EFT OVERR IDE        SYNONYM: O EFT  DISPL AY ORDER:  40
  484   ITEM: RCDP E APAR                           SYNONYM: A PAR  DISPL AY ORDER:  15
  485   ITEM: RCDP E PAYER ID ENTIFY                SYNONYM: I DP   DISPL AY ORDER:  80
  486      UPPERCA SE MENU TE XT: EDI LO CKBOX (EPA YMENTS)
  487  
  488   Current En try Action  Logic
  489   N/A
  490  
  491   Modified E ntry Actio n Logic (C hanges are  in bold)
  492   N/A
  493  
  494   Current Ex it Action  Logic
  495   N/A
  496  
  497   Modified E xit Action  Logic (Ch anges are  in bold)
  498   N/A