RCDPEX1 ;ALB/TMK - ELECTRONIC EOB MESSAGE EXCEPTIONS PROCESS ;2 Aug 2018 21:41:05
;;4.5;Accounts Receivable;**173,262,298,304,326,332**;Mar 20, 1995;Build 40
;Per VA Directive 6402, this routine should not be modified.
;
EN ; Main entry point
D DT^DICRW
N RCFASTXT,RCDA,RCEXCTYP,RCINCEX,DIR,Y,X,RCPAR,RCPAY,RCQUIT,RCTYPE,XX
; Ask for TRANSMISSION exceptions or DATA exceptions
S DIR("A")="DO YOU WANT TO SEE (T)RANSMISSION OR (D)ATA EXCEPTIONS?: ",DIR("B")="T",DIR(0)="SAO^T:TRANSMISSION;D:DATA"
S DIR("?",1)="TRANSMISSION EXCEPTIONS INCLUDE ANY PROBLEM ENCOUNTERED WHEN AN ERA/EEOB",DIR("?",2)=" IS RECEIVED AT THE SITE AND BEFORE IT IS STORED PERMANENTLY IN VISTA."
S DIR("?",3)=" THIS INCLUDES PARTIAL MESSAGE RECEIPTS, EXTRACT PROBLEMS AND EEOBs THAT ",DIR("?",4)=" WERE TRANSFERRED IN FROM ANOTHER SITE."
S DIR("?",5)="DATA EXCEPTIONS INCLUDE EEOB DETAIL RECORDS FOR SPECIFIC BILLS THAT CAN'T BE"
S DIR("?",6)=" FULLY PROCESSED INTO THE VISTA SYSTEM. THIS INCLUDES EEOB DETAIL FOR",DIR("?",7)=" CLAIMS THAT NEED TO BE TRANSFERRED TO ANOTHER SITE OR WHOSE DETAIL COULD",DIR("?")=" NOT BE STORED IN IB"
D ^DIR K DIR
I Y=""!(Y="^") Q
S RCEXCTYP=Y,RCQUIT=0
I RCEXCTYP="D" D ; Include exceptions for MEDICAL, PHARMACY or BOTH - PRCA*4.5*298 Filter question for medical, pharmacy or both
. S RCTYPE=$$RTYPE^RCDPEU1("A") ; PRCA*4.5*326 Pick MEDICAL/PHARMACY/TRICARE/ALL
. I RCTYPE=-1 S RCQUIT=1 Q
. ;
. S RCPAY=$$PAYRNG^RCDPEU1() ; PRCA*4.5*326 New payer selection
. I RCTYPE=-1 S RCQUIT=1 Q
. I RCPAY'="A" D ;
.. S RCPAR("TYPE")=RCTYPE,RCPAR("SELC")=RCPAY
.. S RCPAR("DICA")="Select Insurance Company NAME: "
.. S XX=$$SELPAY^RCDPEU1(.RCPAR)
.. I XX=-1 S RCQUIT=1
;
; Exit if the user asks to exit.
I RCQUIT Q
;
; Transmission exceptions
I RCEXCTYP="T" D EN^VALM("RCDPEX EOB EXCEPTION LIST")
I RCEXCTYP="D" D EN^VALM("RCDPEX EOB_SUM EXCEPTION LIST")
K RCFASTXT,RCDA
Q
;
EN1 ; Duplicate ERA Worklist [RCDPE DUPLICATE ERA WORKLIST] option
D EN^VALM("RCDPEX DUPLICATE ERA LIST")
K RCFASTXT,RCDA
Q
;
INITD ; set up initial variables (RCDPEX DUPLICATE ERA LIST)
S U="^",VALMCNT=0,VALMBG=1
D BLD("DUPLICATE ERA")
Q
;
INIT ; set up initial variables
S U="^",VALMCNT=0,VALMBG=1
D BLD("TRANSMISSION")
Q
;
BLD(MODE) ; EP - from RCDPEX -- build list of messages
; INPUT: MODE = "TRANSMISSION" or "DUPLICATE ERA"
; OUTPUT: ^TMP("RCDPEX-EOB",$J)
N DA,DR,RCSEQ,RCMSG,RCS,RCER,RCDPDATA,RC0,RCDUP,X,Z
K ^TMP("RCDPEX-EOB",$J),^TMP("RCDPEX-EOBDX",$J)
S (RCMSG,RCSEQ,VALMCNT)=0
; Extract from 344.5
F S RCMSG=$O(^RCY(344.5,"AEXC",1,RCMSG)) Q:'RCMSG S RC0=$G(^RCY(344.5,RCMSG,0)) D
. ; Check if message is on duplicate ERA worklist
. S RCDUP=+$$GET1^DIQ(344.5,RCMSG_",",.15,"I")
. ; Only display messages relevant to worklist type
. I MODE="TRANSMISSION",RCDUP Q
. I MODE="DUPLICATE ERA",'RCDUP Q
. ; add to list
. S RCSEQ=RCSEQ+1
. S DR=".01:.03;.1;.11",DA=RCMSG D DIQ3445(DA,DR)
. S X=""
. S X=$$SETSTR^VALM1($E(RCSEQ_" ",1,4)_" "_$G(RCDPDATA(344.5,RCMSG,.01,"E")),"",1,26) ;(#.01) MESSAGE ID [1F]
. S X=$$SETSTR^VALM1(" "_$E($G(RCDPDATA(344.5,RCMSG,.02,"I")),4,6),X,27,9) ;(#.02) MESSAGE TYPE [2S]
. S X=$$SETSTR^VALM1(" "_$G(RCDPDATA(344.5,RCMSG,.03,"E")),X,36,22) ;(#.03) DATE RECORDED [3D]
. S X=$$SETSTR^VALM1(" "_$G(RCDPDATA(344.5,RCMSG,.11,"E")),X,58,17) ;(#.11) MAIL MESSAGE [11F]
. D SET(X,344.5,RCMSG,RCSEQ)
. S X=" EXCEPTION: "_$G(RCDPDATA(344.5,RCMSG,.1,"E")) ;(#.1) EXCEPTION CATEGORY [10S]
. D SET(X,344.5,RCMSG,RCSEQ)
. S DR=1,DA=RCMSG D DIQ3445(DA,DR) ;(#1) DISPLAY DATA
. S Z=0 F S Z=$O(RCDPDATA(344.5,RCMSG,1,Z)) Q:'Z S X=" "_RCDPDATA(344.5,RCMSG,1,Z) D SET(X,344.5,RCMSG,RCSEQ)
;
I '$D(^TMP("RCDPEX-EOB",$J)) S VALMCNT=2,^TMP("RCDPEX-EOB",$J,1,0)=" ",^TMP("RCDPEX-EOB",$J,2,0)=" There Are No EEOB Exception Records On File"
Q
;
FNL ; -- Clean up list
K ^TMP("RCDPEX-EOBDX",$J),^TMP("RCDPEU1",$J) ; PRCA*4.5*326
D CLEAN^VALM10
K RCFASTXT
Q
;
SET(X,FILE,RCMSG,RCSEQ) ; -- set arrays for EOB exception records
; X = the data to set into the global
S VALMCNT=VALMCNT+1,^TMP("RCDPEX-EOB",$J,VALMCNT,0)=X
S ^TMP("RCDPEX-EOB",$J,"IDX",VALMCNT,RCSEQ)=""
S ^TMP("RCDPEX-EOBDX",$J,RCSEQ)=VALMCNT_U_RCMSG_U_FILE
Q
;
HDR ;
S VALMHDR(1)=$J("",21)_"ERA/EEOB MESSAGES WITH EXCEPTION CONDITIONS"
S VALMHDR(2)=" "
Q
;
HDR1 ;
S VALMHDR(1)=$J("",21)_"Duplicate 835ERA Messages",VALMHDR(2)=" "
Q
;
DIQ3445(DA,DR) ; DIQ call to retrieve data for DR fields in file 344.5
N %I,D0,DIC,DIQ,DIQ2,YY
K RCDPDATA(344.5)
S DIQ(0)="EI",DIC="^RCY(344.5,",DIQ="RCDPDATA" D EN^DIQ1
Q
;
DIQ3444(DA,DR) ; DIQ call to retrieve data for DR fields in file 344.4
N %I,D0,DIC,DIQ,DIQ2,YY
K RCDPDATA(344.4)
S DIQ(0)="EI",DIC="^RCY(344.4,",DIQ="RCDPDATA" D EN^DIQ1
Q
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HRCDPEX1 4890 printed Apr 09, 2024@20:48:26 Page 2
RCDPEX1 ;ALB/TMK - ELECTRONIC EOB MESSAGE EXCEPTIONS PROCESS ;2 Aug 2018 21:41:05
+1 ;;4.5;Accounts Receivable;**173,262,298,304,326,332**;Mar 20, 1995;Build 40
+2 ;Per VA Directive 6402, this routine should not be modified.
+3 ;
EN ; Main entry point
+1 DO DT^DICRW
+2 NEW RCFASTXT,RCDA,RCEXCTYP,RCINCEX,DIR,Y,X,RCPAR,RCPAY,RCQUIT,RCTYPE,XX
+3 ; Ask for TRANSMISSION exceptions or DATA exceptions
+4 SET DIR("A")="DO YOU WANT TO SEE (T)RANSMISSION OR (D)ATA EXCEPTIONS?: "
SET DIR("B")="T"
SET DIR(0)="SAO^T:TRANSMISSION;D:DATA"
+5 SET DIR("?",1)="TRANSMISSION EXCEPTIONS INCLUDE ANY PROBLEM ENCOUNTERED WHEN AN ERA/EEOB"
SET DIR("?",2)=" IS RECEIVED AT THE SITE AND BEFORE IT IS STORED PERMANENTLY IN VISTA."
+6 SET DIR("?",3)=" THIS INCLUDES PARTIAL MESSAGE RECEIPTS, EXTRACT PROBLEMS AND EEOBs THAT "
SET DIR("?",4)=" WERE TRANSFERRED IN FROM ANOTHER SITE."
+7 SET DIR("?",5)="DATA EXCEPTIONS INCLUDE EEOB DETAIL RECORDS FOR SPECIFIC BILLS THAT CAN'T BE"
+8 SET DIR("?",6)=" FULLY PROCESSED INTO THE VISTA SYSTEM. THIS INCLUDES EEOB DETAIL FOR"
SET DIR("?",7)=" CLAIMS THAT NEED TO BE TRANSFERRED TO ANOTHER SITE OR WHOSE DETAIL COULD"
SET DIR("?")=" NOT BE STORED IN IB"
+9 DO ^DIR
KILL DIR
+10 IF Y=""!(Y="^")
QUIT
+11 SET RCEXCTYP=Y
SET RCQUIT=0
+12 ; Include exceptions for MEDICAL, PHARMACY or BOTH - PRCA*4.5*298 Filter question for medical, pharmacy or both
IF RCEXCTYP="D"
Begin DoDot:1
+13 ; PRCA*4.5*326 Pick MEDICAL/PHARMACY/TRICARE/ALL
SET RCTYPE=$$RTYPE^RCDPEU1("A")
+14 IF RCTYPE=-1
SET RCQUIT=1
QUIT
+15 ;
+16 ; PRCA*4.5*326 New payer selection
SET RCPAY=$$PAYRNG^RCDPEU1()
+17 IF RCTYPE=-1
SET RCQUIT=1
QUIT
+18 ;
IF RCPAY'="A"
Begin DoDot:2
+19 SET RCPAR("TYPE")=RCTYPE
SET RCPAR("SELC")=RCPAY
+20 SET RCPAR("DICA")="Select Insurance Company NAME: "
+21 SET XX=$$SELPAY^RCDPEU1(.RCPAR)
+22 IF XX=-1
SET RCQUIT=1
End DoDot:2
End DoDot:1
+23 ;
+24 ; Exit if the user asks to exit.
+25 IF RCQUIT
QUIT
+26 ;
+27 ; Transmission exceptions
+28 IF RCEXCTYP="T"
DO EN^VALM("RCDPEX EOB EXCEPTION LIST")
+29 IF RCEXCTYP="D"
DO EN^VALM("RCDPEX EOB_SUM EXCEPTION LIST")
+30 KILL RCFASTXT,RCDA
+31 QUIT
+32 ;
EN1 ; Duplicate ERA Worklist [RCDPE DUPLICATE ERA WORKLIST] option
+1 DO EN^VALM("RCDPEX DUPLICATE ERA LIST")
+2 KILL RCFASTXT,RCDA
+3 QUIT
+4 ;
INITD ; set up initial variables (RCDPEX DUPLICATE ERA LIST)
+1 SET U="^"
SET VALMCNT=0
SET VALMBG=1
+2 DO BLD("DUPLICATE ERA")
+3 QUIT
+4 ;
INIT ; set up initial variables
+1 SET U="^"
SET VALMCNT=0
SET VALMBG=1
+2 DO BLD("TRANSMISSION")
+3 QUIT
+4 ;
BLD(MODE) ; EP - from RCDPEX -- build list of messages
+1 ; INPUT: MODE = "TRANSMISSION" or "DUPLICATE ERA"
+2 ; OUTPUT: ^TMP("RCDPEX-EOB",$J)
+3 NEW DA,DR,RCSEQ,RCMSG,RCS,RCER,RCDPDATA,RC0,RCDUP,X,Z
+4 KILL ^TMP("RCDPEX-EOB",$JOB),^TMP("RCDPEX-EOBDX",$JOB)
+5 SET (RCMSG,RCSEQ,VALMCNT)=0
+6 ; Extract from 344.5
+7 FOR
SET RCMSG=$ORDER(^RCY(344.5,"AEXC",1,RCMSG))
if 'RCMSG
QUIT
SET RC0=$GET(^RCY(344.5,RCMSG,0))
Begin DoDot:1
+8 ; Check if message is on duplicate ERA worklist
+9 SET RCDUP=+$$GET1^DIQ(344.5,RCMSG_",",.15,"I")
+10 ; Only display messages relevant to worklist type
+11 IF MODE="TRANSMISSION"
IF RCDUP
QUIT
+12 IF MODE="DUPLICATE ERA"
IF 'RCDUP
QUIT
+13 ; add to list
+14 SET RCSEQ=RCSEQ+1
+15 SET DR=".01:.03;.1;.11"
SET DA=RCMSG
DO DIQ3445(DA,DR)
+16 SET X=""
+17 ;(#.01) MESSAGE ID [1F]
SET X=$$SETSTR^VALM1($EXTRACT(RCSEQ_" ",1,4)_" "_$GET(RCDPDATA(344.5,RCMSG,.01,"E")),"",1,26)
+18 ;(#.02) MESSAGE TYPE [2S]
SET X=$$SETSTR^VALM1(" "_$EXTRACT($GET(RCDPDATA(344.5,RCMSG,.02,"I")),4,6),X,27,9)
+19 ;(#.03) DATE RECORDED [3D]
SET X=$$SETSTR^VALM1(" "_$GET(RCDPDATA(344.5,RCMSG,.03,"E")),X,36,22)
+20 ;(#.11) MAIL MESSAGE [11F]
SET X=$$SETSTR^VALM1(" "_$GET(RCDPDATA(344.5,RCMSG,.11,"E")),X,58,17)
+21 DO SET(X,344.5,RCMSG,RCSEQ)
+22 ;(#.1) EXCEPTION CATEGORY [10S]
SET X=" EXCEPTION: "_$GET(RCDPDATA(344.5,RCMSG,.1,"E"))
+23 DO SET(X,344.5,RCMSG,RCSEQ)
+24 ;(#1) DISPLAY DATA
SET DR=1
SET DA=RCMSG
DO DIQ3445(DA,DR)
+25 SET Z=0
FOR
SET Z=$ORDER(RCDPDATA(344.5,RCMSG,1,Z))
if 'Z
QUIT
SET X=" "_RCDPDATA(344.5,RCMSG,1,Z)
DO SET(X,344.5,RCMSG,RCSEQ)
End DoDot:1
+26 ;
+27 IF '$DATA(^TMP("RCDPEX-EOB",$JOB))
SET VALMCNT=2
SET ^TMP("RCDPEX-EOB",$JOB,1,0)=" "
SET ^TMP("RCDPEX-EOB",$JOB,2,0)=" There Are No EEOB Exception Records On File"
+28 QUIT
+29 ;
FNL ; -- Clean up list
+1 ; PRCA*4.5*326
KILL ^TMP("RCDPEX-EOBDX",$JOB),^TMP("RCDPEU1",$JOB)
+2 DO CLEAN^VALM10
+3 KILL RCFASTXT
+4 QUIT
+5 ;
SET(X,FILE,RCMSG,RCSEQ) ; -- set arrays for EOB exception records
+1 ; X = the data to set into the global
+2 SET VALMCNT=VALMCNT+1
SET ^TMP("RCDPEX-EOB",$JOB,VALMCNT,0)=X
+3 SET ^TMP("RCDPEX-EOB",$JOB,"IDX",VALMCNT,RCSEQ)=""
+4 SET ^TMP("RCDPEX-EOBDX",$JOB,RCSEQ)=VALMCNT_U_RCMSG_U_FILE
+5 QUIT
+6 ;
HDR ;
+1 SET VALMHDR(1)=$JUSTIFY("",21)_"ERA/EEOB MESSAGES WITH EXCEPTION CONDITIONS"
+2 SET VALMHDR(2)=" "
+3 QUIT
+4 ;
HDR1 ;
+1 SET VALMHDR(1)=$JUSTIFY("",21)_"Duplicate 835ERA Messages"
SET VALMHDR(2)=" "
+2 QUIT
+3 ;
DIQ3445(DA,DR) ; DIQ call to retrieve data for DR fields in file 344.5
+1 NEW %I,D0,DIC,DIQ,DIQ2,YY
+2 KILL RCDPDATA(344.5)
+3 SET DIQ(0)="EI"
SET DIC="^RCY(344.5,"
SET DIQ="RCDPDATA"
DO EN^DIQ1
+4 QUIT
+5 ;
DIQ3444(DA,DR) ; DIQ call to retrieve data for DR fields in file 344.4
+1 NEW %I,D0,DIC,DIQ,DIQ2,YY
+2 KILL RCDPDATA(344.4)
+3 SET DIQ(0)="EI"
SET DIC="^RCY(344.4,"
SET DIQ="RCDPDATA"
DO EN^DIQ1
+4 QUIT
+5 ;
