RCDPEX32 ;ALB/TMK - ELECTRONIC EOB EXCEPTION PROCESSING - FILE 344.4 ;Aug 14, 2014@16:27:32
;;4.5;Accounts Receivable;**173,249,298,304,321**;Mar 20, 1995;Build 48
;Per VA Directive 6402, this routine should not be modified.
;
EDITNUM ; Edit invalid claim # to valid, refile EOB
N RC,RC0,RCDA,RCXDA,RCXDA1,RCSAVE,RCEOB,RCWARN,Q,Q0,DA,DR,DIE,DIC,DIR,DTOUT,DIRUT,X,Y,RCBILL,RCCHG,RCSUSP,RCQUIT,RCDONE
D FULL^VALM1
D SEL^RCDPEX3(.RCDA)
G:'$O(RCDA(0)) EDITNQ
;
S RC=0 F S RC=$O(RCDA(RC)) Q:'RC D L -^RCY(344.4,RCXDA1,1,RCXDA,0)
. S RCXDA1=+RCDA(RC),RCXDA=+$P(RCDA(RC),U,2),RCSAVE=""
. I '$$LOCK^RCDPEX31(RCXDA1,RCXDA,1) D Q
.. S DIR(0)="EA",DIR("A",1)="**Selection #"_RC_" is being edited by another user - ... please try again later",DIR("A")="PRESS RETURN TO CONTINUE" D ^DIR K DIR
. S RC0=$G(^RCY(344.4,RCXDA1,1,RCXDA,0))
. I $P(RC0,U,5)="" D Q
.. S DIR(0)="EA",DIR("A",1)="The claim for selection #"_RC_" can't be edited as the bill # is not invalid",DIR("A")="PRESS RETURN TO CONTINUE" D ^DIR K DIR
. I $P(RC0,U,9) D Q
.. S DIR(0)="EA",DIR("A",1)="The claim for selection #"_RC_" can't be edited as the claim has already",DIR("A")="been transferred to another site - PRESS RETURN TO CONTINUE" W ! D ^DIR K DIR
. ;
. I $D(^RCY(344.49,RCXDA1)) D
.. N X
.. S X=$G(^RCY(344,+$P($G(^RCY(344.49,RCXDA1,0)),U,2),0))
.. W !!,*7,"Warning: EEOB Worklist entry #"_RCXDA1_$S($P(X,U)'="":" and receipt "_$P(X,U),1:"")_" exist for this EEOB"
.. I X="" W !,"You should refresh the worklist entry to include the new claim #",!," before creating the receipt",!
. I $P($G(^RCY(344.4,RCXDA1,0)),U,8) D
.. W !,"Since the receipt for this EEOB ("_$P($G(^RCY(344,+$P($G(^RCY(344.4,RCXDA1,0)),U,8),0)),U)_") already exists"
.. I '$P($G(^RCY(344,+$P($G(^RCY(344.4,RCXDA1,0)),U,8),0)),U,14) W !," and is closed, you will need to use link payment to apply the payment",!," to the correct account",! Q
.. W !," you should edit the receipt and change the claim # so it posts to the",!," correct account",!
. ;
. I $P(RC0,U,17)="" S RCSAVE=$P(RC0,U,5)
. W !,"Selection #: "_RC_$J("",5)_$P(RC0,U,5)
. S (RCQUIT,RCDONE)=0
. F D Q:RCQUIT!RCDONE
.. K DIR
.. S DIR("?",1)="Answer with ACCOUNTS RECEIVABLE BILL NO., or PATIENT, or DEBTOR, or"
.. S DIR("?")=" TOP REFUND STATUS, or FMS TRANSMISSION DATE"
.. S DIR(0)="FAO^1:15",DIR("A")="Select A/R Bill this EEOB is actually paying on: "
.. D ^DIR I $D(DIRUT)!$D(DTOUT) S RCQUIT=1 Q
.. S DIC="^PRCA(430,",DIC(0)="EM",DIC("S")="I $D(^DGCR(399,+Y,0))" W ! D ^DIC I X="^" S RCQUIT=1 Q
.. S RCSUSP=X
.. I '(Y>0) D Q:RCQUIT
... S DIR("A")=" THIS CLAIM WAS NOT FOUND IN YOUR AR. DO YOU WANT TO CONTINUE?: "
... S DIR("B")="NO",DIR(0)="YA" D ^DIR K DIR W ! I $D(DIRUT)!$D(DTOUT) S RCQUIT=1 Q
... I Y=1 S RCBILL=0,RCBILL(1)=RCSUSP,RCWARN=0,RCDONE=1
.. E D
... S RCBILL=+Y,RCBILL(1)=$P($G(^PRCA(430,RCBILL,0)),U),RCWARN=0,RCDONE=1
. Q:RCQUIT
. I $P($G(^RCY(344.4,RCXDA1,0)),U,14) S RCWARN=RCWARN+1,DIR("A",RCWARN+1)=$J("",4)_"THE RECEIPT FOR THIS EEOB HAS ALREADY BEEN POSTED."
. I RCBILL>0,$P($G(^PRCA(430.3,+$P($G(^PRCA(430,RCBILL,0)),U,8),0)),U,3)'=102 S RCWARN=RCWARN+1,DIR("A",RCWARN+1)=$J("",4)_"THIS IS NOT AN ACTIVE ACCOUNTS RECEIVABLE."
. I RCWARN>0 D I Y'=1 Q
.. S DIR("A",1)="** WARNING"_$S(RCWARN>1:"S",1:"")_":"
.. S DIR("A",RCWARN+2)=" "
.. S DIR(0)="YA",DIR("A")="ARE YOU SURE YOU WANT TO FILE THIS EEOB FOR CLAIM #: "_RCBILL(1)_"?: ",DIR("B")="NO" W ! D ^DIR K DIR
.. ;
. ; File EOB for new claim #
. K ^TMP($J,"RCDP-EOB"),^TMP($J,"RCDPEOB","HDR")
. S Q=0 F S Q=$O(^RCY(344.4,RCXDA1,1,RCXDA,1,Q)) Q:'Q S Q0=$G(^(Q,0)) D
.. I $P(Q0,U)["835ERA" S ^TMP($J,"RCDPEOB","HDR")=Q0
.. I $P(Q0,U,2)=$P(RC0,U,5) S $P(Q0,U,2)=RCBILL(1)
.. S ^TMP($J,"RCDP-EOB",1,Q,0)=Q0
. S ^TMP($J,"RCDP-EOB",1,.5,0)="835ERA"
. S RCEOB=0 I RCBILL>0 S RCEOB=$$DUP^IBCEOB("^TMP("_$J_",""RCDP-EOB"",1)",RCBILL) ; IA 4042
. K ^TMP($J,"RCDP-EOB",1,.5,0)
. I RCEOB D Q
.. N RCWHY S RCWHY(1)="EEOB already found on file while trying to change claim # and filing into IB"
.. D STORACT^RCDPEX31(RCXDA1,RCXDA,.RCWHY)
.. S RCCHG=1,DA(1)=RCXDA1,DA=RCXDA D CHGED(.DA,RCEOB,RCSAVE,.RCBILL)
.. S DIR(0)="E"
.. S DIR("A",1)="EEOB detail is already on file for "_RCBILL(1)_" - Exception removed",DIR("A")="PRESS RETURN TO CONTINUE" D ^DIR K DIR
. ;
. ; Add stub rec to 361.1 if not there
. I RCBILL>0 S RCEOB=+$$ADD3611^IBCEOB(+$P($G(^RCY(344.4,RCXDA1,0)),U,12),"","",RCBILL,1,"^TMP("_$J_",""RCDP-EOB"",1)") ; IA 4042
. ;
. I RCEOB<0 D Q
.. N RCWHY S RCWHY(1)="Error encountered trying to change claim # and file into IB"
.. D STORACT^RCDPEX31(RCXDA1,RCXDA,.RCWHY)
.. S DIR("A")="EA",DIR("A",1)="Error - EEOB detail not added to IB for bill "_RCBILL(1),DIR("A")="PRESS RETURN TO CONTINUE" D ^DIR K DIR
. ;
. ; Update EOB in file 361.1
. ; Call needs ^TMP arrays: $J,"RCDPEOB","HDR" and $J,"RCDP-EOB"
. I RCEOB>0 D
.. D UPD3611^IBCEOB(RCEOB,1,1) ; IA 4042
.. ; errors in ^TMP("RCDPERR-EOB",$J
.. I $O(^TMP("RCDPERR-EOB",$J,0)) D
... D ERRUPD^IBCEOB(RCEOB,"RCDPERR-EOB") ; Adds error msgs to IB file 361.1 ; IA 4042
. ;
. S RCCHG=1
. N RCWHY S RCWHY(1)="EEOB claim # changed and filed into IB under new claim #"
. D STORACT^RCDPEX31(RCXDA1,RCXDA,.RCWHY)
. S DA(1)=RCXDA1,DA=RCXDA
. D CHGED(.DA,RCEOB,RCSAVE,.RCBILL)
. S DIE="^RCY(344.4,"_DA(1)_",1,",DR="1///@" D ^DIE
. D ^DIE
. W !!,"EEOB Filed. "_$S(RCBILL>0:"Its detail may be viewed using Third Party Joint Inquiry.",1:"")
. ; Check if auto-post candidate
. N AUTOPOST
. S AUTOPOST=$$AUTOCHK2^RCDPEAP1(RCXDA1,0) ; added parameter - PRCA*4.5*321
. I AUTOPOST D
.. D SETSTA^RCDPEAP(RCXDA1,0,"Exceptions: Marked as Auto-Post Candidate")
.. W !,"ERA has been successfully Marked as an Auto-Post CANDIDATE"
. I 'AUTOPOST D
.. D AUDITLOG^RCDPEAP(RCXDA1,"","Exceptions: Not Marked as Auto-Post Candidate-"_$P(AUTOPOST,U,2))
.. W !,"ERA was NOT Marked as an Auto-Post CANDIDATE - ",$P(AUTOPOST,U,2)
. ;
. K DIR
. S DIR("A")="PRESS RETURN TO CONTINUE ",DIR(0)="EA"
. D ^DIR K DIR
. S VALMBG=1
;
EDITNQ I $G(RCCHG) D BLD^RCDPEX2
K ^TMP($J,"RCDP-EOB"),^TMP($J,"RCDPEOB","HDR"),^TMP("RCDPERR-EOB",$J)
S VALMBCK="R"
Q
;
CHGED(DA,RCEOB,RCSAVE,RCBILL) ; Update Invalid Bill # for EOB
; DA = DA and DA(1) to use for DIE call
; RCEOB = the ien of the entry in file 361.1
; RCSAVE = the free text of the original bill #
; RCBILL = Array containing Bill Information
N DIE,DR,X,Y,INVBILL
S INVBILL="@" I +$G(RCBILL)=0 S INVBILL=$G(RCBILL(1))
S DIE="^RCY(344.4,"_DA(1)_",1,",DR=".05///"_INVBILL_";.02////"_RCEOB_";.13////1"_$S(RCSAVE'="":";.17////"_RCSAVE,1:"")_";.07///@" D ^DIE
Q
;
EDITRXC ; Edit pharmacy comment - PRCA*4.5*298
N DA,DIC,DIE,DIR,DR,Q,Q0,RC,RC0,RCBILL,RCDA,RCDSEL,RCEOB,RCSAVE,RCWARN,RCXDA,RCXDA1,X,Y
D FULL^VALM1
; PRCA*4.5*304 - Pharmacy claim selection based coming from Exception or APAR screen
I '$D(RCAPAR) D SEL^RCDPEX3(.RCDA)
I $D(RCAPAR) D SEL^RCDPEX3(.RCDA,1)
;Only allow action if the selected exception has an ECME number
S RCDSEL=$O(RCDA(0)) D:RCDSEL
.N IENS,RCRXNO,RCRLSDT ; IENS for FileMan, Rx number, Rx release date
.S IENS=$P(RCDA(RCDSEL),U,2)_","_$P(RCDA(RCDSEL),U,1)_","
.S RCRXNO=$$GET1^DIQ(344.41,IENS,.24) I RCRXNO="" D Q
..W !,"Comment not allowed. This is not a pharmacy exception." D WAIT^VALM1
.;
.; IA #4701, RELEASE DATE for the prescription/fill
.S RCRLSDT=$$RXRLDT^PSOBPSUT(RCRXNO) ; get release date
.I RCRLSDT]"" D Q
..W !!,"Release Date: "_$$FMTE^XLFDT(RCRLSDT)
..W !,"Comment not allowed for Rx with Release Date." D WAIT^VALM1
.;
.;Display sequence and INVALID BILL NUMBER
.W !,"Selection #: ",RCDSEL," ",$$GET1^DIQ(344.41,IENS,.05)
.;Allow edit of pharmacy comment
.S DIE="^RCY(344.4,"_$P(RCDA(RCDSEL),U,1)_",1,",DA=$P(RCDA(RCDSEL),U,2),DA(1)=$P(RCDA(RCDSEL),U,1),DR="9.01Comment" D ^DIE Q:$D(DUOUT)!$D(DTOUT)
.D WAIT^VALM1,BLD^RCDPEX2
;
K ^TMP($J,"RCDP-EOB"),^TMP($J,"RCDPEOB","HDR"),^TMP("RCDPERR-EOB",$J)
S VALMBCK="R"
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HRCDPEX32 8124 printed Oct 16, 2024@17:46:50 Page 2
RCDPEX32 ;ALB/TMK - ELECTRONIC EOB EXCEPTION PROCESSING - FILE 344.4 ;Aug 14, 2014@16:27:32
+1 ;;4.5;Accounts Receivable;**173,249,298,304,321**;Mar 20, 1995;Build 48
+2 ;Per VA Directive 6402, this routine should not be modified.
+3 ;
EDITNUM ; Edit invalid claim # to valid, refile EOB
+1 NEW RC,RC0,RCDA,RCXDA,RCXDA1,RCSAVE,RCEOB,RCWARN,Q,Q0,DA,DR,DIE,DIC,DIR,DTOUT,DIRUT,X,Y,RCBILL,RCCHG,RCSUSP,RCQUIT,RCDONE
+2 DO FULL^VALM1
+3 DO SEL^RCDPEX3(.RCDA)
+4 if '$ORDER(RCDA(0))
GOTO EDITNQ
+5 ;
+6 SET RC=0
FOR
SET RC=$ORDER(RCDA(RC))
if 'RC
QUIT
Begin DoDot:1
+7 SET RCXDA1=+RCDA(RC)
SET RCXDA=+$PIECE(RCDA(RC),U,2)
SET RCSAVE=""
+8 IF '$$LOCK^RCDPEX31(RCXDA1,RCXDA,1)
Begin DoDot:2
+9 SET DIR(0)="EA"
SET DIR("A",1)="**Selection #"_RC_" is being edited by another user - ... please try again later"
SET DIR("A")="PRESS RETURN TO CONTINUE"
DO ^DIR
KILL DIR
End DoDot:2
QUIT
+10 SET RC0=$GET(^RCY(344.4,RCXDA1,1,RCXDA,0))
+11 IF $PIECE(RC0,U,5)=""
Begin DoDot:2
+12 SET DIR(0)="EA"
SET DIR("A",1)="The claim for selection #"_RC_" can't be edited as the bill # is not invalid"
SET DIR("A")="PRESS RETURN TO CONTINUE"
DO ^DIR
KILL DIR
End DoDot:2
QUIT
+13 IF $PIECE(RC0,U,9)
Begin DoDot:2
+14 SET DIR(0)="EA"
SET DIR("A",1)="The claim for selection #"_RC_" can't be edited as the claim has already"
SET DIR("A")="been transferred to another site - PRESS RETURN TO CONTINUE"
WRITE !
DO ^DIR
KILL DIR
End DoDot:2
QUIT
+15 ;
+16 IF $DATA(^RCY(344.49,RCXDA1))
Begin DoDot:2
+17 NEW X
+18 SET X=$GET(^RCY(344,+$PIECE($GET(^RCY(344.49,RCXDA1,0)),U,2),0))
+19 WRITE !!,*7,"Warning: EEOB Worklist entry #"_RCXDA1_$SELECT($PIECE(X,U)'="":" and receipt "_$PIECE(X,U),1:"")_" exist for this EEOB"
+20 IF X=""
WRITE !,"You should refresh the worklist entry to include the new claim #",!," before creating the receipt",!
End DoDot:2
+21 IF $PIECE($GET(^RCY(344.4,RCXDA1,0)),U,8)
Begin DoDot:2
+22 WRITE !,"Since the receipt for this EEOB ("_$PIECE($GET(^RCY(344,+$PIECE($GET(^RCY(344.4,RCXDA1,0)),U,8),0)),U)_") already exists"
+23 IF '$PIECE($GET(^RCY(344,+$PIECE($GET(^RCY(344.4,RCXDA1,0)),U,8),0)),U,14)
WRITE !," and is closed, you will need to use link payment to apply the payment",!," to the correct account",!
QUIT
+24 WRITE !," you should edit the receipt and change the claim # so it posts to the",!," correct account",!
End DoDot:2
+25 ;
+26 IF $PIECE(RC0,U,17)=""
SET RCSAVE=$PIECE(RC0,U,5)
+27 WRITE !,"Selection #: "_RC_$JUSTIFY("",5)_$PIECE(RC0,U,5)
+28 SET (RCQUIT,RCDONE)=0
+29 FOR
Begin DoDot:2
+30 KILL DIR
+31 SET DIR("?",1)="Answer with ACCOUNTS RECEIVABLE BILL NO., or PATIENT, or DEBTOR, or"
+32 SET DIR("?")=" TOP REFUND STATUS, or FMS TRANSMISSION DATE"
+33 SET DIR(0)="FAO^1:15"
SET DIR("A")="Select A/R Bill this EEOB is actually paying on: "
+34 DO ^DIR
IF $DATA(DIRUT)!$DATA(DTOUT)
SET RCQUIT=1
QUIT
+35 SET DIC="^PRCA(430,"
SET DIC(0)="EM"
SET DIC("S")="I $D(^DGCR(399,+Y,0))"
WRITE !
DO ^DIC
IF X="^"
SET RCQUIT=1
QUIT
+36 SET RCSUSP=X
+37 IF '(Y>0)
Begin DoDot:3
+38 SET DIR("A")=" THIS CLAIM WAS NOT FOUND IN YOUR AR. DO YOU WANT TO CONTINUE?: "
+39 SET DIR("B")="NO"
SET DIR(0)="YA"
DO ^DIR
KILL DIR
WRITE !
IF $DATA(DIRUT)!$DATA(DTOUT)
SET RCQUIT=1
QUIT
+40 IF Y=1
SET RCBILL=0
SET RCBILL(1)=RCSUSP
SET RCWARN=0
SET RCDONE=1
End DoDot:3
if RCQUIT
QUIT
+41 IF '$TEST
Begin DoDot:3
+42 SET RCBILL=+Y
SET RCBILL(1)=$PIECE($GET(^PRCA(430,RCBILL,0)),U)
SET RCWARN=0
SET RCDONE=1
End DoDot:3
End DoDot:2
if RCQUIT!RCDONE
QUIT
+43 if RCQUIT
QUIT
+44 IF $PIECE($GET(^RCY(344.4,RCXDA1,0)),U,14)
SET RCWARN=RCWARN+1
SET DIR("A",RCWARN+1)=$JUSTIFY("",4)_"THE RECEIPT FOR THIS EEOB HAS ALREADY BEEN POSTED."
+45 IF RCBILL>0
IF $PIECE($GET(^PRCA(430.3,+$PIECE($GET(^PRCA(430,RCBILL,0)),U,8),0)),U,3)'=102
SET RCWARN=RCWARN+1
SET DIR("A",RCWARN+1)=$JUSTIFY("",4)_"THIS IS NOT AN ACTIVE ACCOUNTS RECEIVABLE."
+46 IF RCWARN>0
Begin DoDot:2
+47 SET DIR("A",1)="** WARNING"_$SELECT(RCWARN>1:"S",1:"")_":"
+48 SET DIR("A",RCWARN+2)=" "
+49 SET DIR(0)="YA"
SET DIR("A")="ARE YOU SURE YOU WANT TO FILE THIS EEOB FOR CLAIM #: "_RCBILL(1)_"?: "
SET DIR("B")="NO"
WRITE !
DO ^DIR
KILL DIR
+50 ;
End DoDot:2
IF Y'=1
QUIT
+51 ; File EOB for new claim #
+52 KILL ^TMP($JOB,"RCDP-EOB"),^TMP($JOB,"RCDPEOB","HDR")
+53 SET Q=0
FOR
SET Q=$ORDER(^RCY(344.4,RCXDA1,1,RCXDA,1,Q))
if 'Q
QUIT
SET Q0=$GET(^(Q,0))
Begin DoDot:2
+54 IF $PIECE(Q0,U)["835ERA"
SET ^TMP($JOB,"RCDPEOB","HDR")=Q0
+55 IF $PIECE(Q0,U,2)=$PIECE(RC0,U,5)
SET $PIECE(Q0,U,2)=RCBILL(1)
+56 SET ^TMP($JOB,"RCDP-EOB",1,Q,0)=Q0
End DoDot:2
+57 SET ^TMP($JOB,"RCDP-EOB",1,.5,0)="835ERA"
+58 ; IA 4042
SET RCEOB=0
IF RCBILL>0
SET RCEOB=$$DUP^IBCEOB("^TMP("_$JOB_",""RCDP-EOB"",1)",RCBILL)
+59 KILL ^TMP($JOB,"RCDP-EOB",1,.5,0)
+60 IF RCEOB
Begin DoDot:2
+61 NEW RCWHY
SET RCWHY(1)="EEOB already found on file while trying to change claim # and filing into IB"
+62 DO STORACT^RCDPEX31(RCXDA1,RCXDA,.RCWHY)
+63 SET RCCHG=1
SET DA(1)=RCXDA1
SET DA=RCXDA
DO CHGED(.DA,RCEOB,RCSAVE,.RCBILL)
+64 SET DIR(0)="E"
+65 SET DIR("A",1)="EEOB detail is already on file for "_RCBILL(1)_" - Exception removed"
SET DIR("A")="PRESS RETURN TO CONTINUE"
DO ^DIR
KILL DIR
End DoDot:2
QUIT
+66 ;
+67 ; Add stub rec to 361.1 if not there
+68 ; IA 4042
IF RCBILL>0
SET RCEOB=+$$ADD3611^IBCEOB(+$PIECE($GET(^RCY(344.4,RCXDA1,0)),U,12),"","",RCBILL,1,"^TMP("_$JOB_",""RCDP-EOB"",1)")
+69 ;
+70 IF RCEOB<0
Begin DoDot:2
+71 NEW RCWHY
SET RCWHY(1)="Error encountered trying to change claim # and file into IB"
+72 DO STORACT^RCDPEX31(RCXDA1,RCXDA,.RCWHY)
+73 SET DIR("A")="EA"
SET DIR("A",1)="Error - EEOB detail not added to IB for bill "_RCBILL(1)
SET DIR("A")="PRESS RETURN TO CONTINUE"
DO ^DIR
KILL DIR
End DoDot:2
QUIT
+74 ;
+75 ; Update EOB in file 361.1
+76 ; Call needs ^TMP arrays: $J,"RCDPEOB","HDR" and $J,"RCDP-EOB"
+77 IF RCEOB>0
Begin DoDot:2
+78 ; IA 4042
DO UPD3611^IBCEOB(RCEOB,1,1)
+79 ; errors in ^TMP("RCDPERR-EOB",$J
+80 IF $ORDER(^TMP("RCDPERR-EOB",$JOB,0))
Begin DoDot:3
+81 ; Adds error msgs to IB file 361.1 ; IA 4042
DO ERRUPD^IBCEOB(RCEOB,"RCDPERR-EOB")
End DoDot:3
End DoDot:2
+82 ;
+83 SET RCCHG=1
+84 NEW RCWHY
SET RCWHY(1)="EEOB claim # changed and filed into IB under new claim #"
+85 DO STORACT^RCDPEX31(RCXDA1,RCXDA,.RCWHY)
+86 SET DA(1)=RCXDA1
SET DA=RCXDA
+87 DO CHGED(.DA,RCEOB,RCSAVE,.RCBILL)
+88 SET DIE="^RCY(344.4,"_DA(1)_",1,"
SET DR="1///@"
DO ^DIE
+89 DO ^DIE
+90 WRITE !!,"EEOB Filed. "_$SELECT(RCBILL>0:"Its detail may be viewed using Third Party Joint Inquiry.",1:"")
+91 ; Check if auto-post candidate
+92 NEW AUTOPOST
+93 ; added parameter - PRCA*4.5*321
SET AUTOPOST=$$AUTOCHK2^RCDPEAP1(RCXDA1,0)
+94 IF AUTOPOST
Begin DoDot:2
+95 DO SETSTA^RCDPEAP(RCXDA1,0,"Exceptions: Marked as Auto-Post Candidate")
+96 WRITE !,"ERA has been successfully Marked as an Auto-Post CANDIDATE"
End DoDot:2
+97 IF 'AUTOPOST
Begin DoDot:2
+98 DO AUDITLOG^RCDPEAP(RCXDA1,"","Exceptions: Not Marked as Auto-Post Candidate-"_$PIECE(AUTOPOST,U,2))
+99 WRITE !,"ERA was NOT Marked as an Auto-Post CANDIDATE - ",$PIECE(AUTOPOST,U,2)
End DoDot:2
+100 ;
+101 KILL DIR
+102 SET DIR("A")="PRESS RETURN TO CONTINUE "
SET DIR(0)="EA"
+103 DO ^DIR
KILL DIR
+104 SET VALMBG=1
End DoDot:1
LOCK -^RCY(344.4,RCXDA1,1,RCXDA,0)
+105 ;
EDITNQ IF $GET(RCCHG)
DO BLD^RCDPEX2
+1 KILL ^TMP($JOB,"RCDP-EOB"),^TMP($JOB,"RCDPEOB","HDR"),^TMP("RCDPERR-EOB",$JOB)
+2 SET VALMBCK="R"
+3 QUIT
+4 ;
CHGED(DA,RCEOB,RCSAVE,RCBILL) ; Update Invalid Bill # for EOB
+1 ; DA = DA and DA(1) to use for DIE call
+2 ; RCEOB = the ien of the entry in file 361.1
+3 ; RCSAVE = the free text of the original bill #
+4 ; RCBILL = Array containing Bill Information
+5 NEW DIE,DR,X,Y,INVBILL
+6 SET INVBILL="@"
IF +$GET(RCBILL)=0
SET INVBILL=$GET(RCBILL(1))
+7 SET DIE="^RCY(344.4,"_DA(1)_",1,"
SET DR=".05///"_INVBILL_";.02////"_RCEOB_";.13////1"_$SELECT(RCSAVE'="":";.17////"_RCSAVE,1:"")_";.07///@"
DO ^DIE
+8 QUIT
+9 ;
EDITRXC ; Edit pharmacy comment - PRCA*4.5*298
+1 NEW DA,DIC,DIE,DIR,DR,Q,Q0,RC,RC0,RCBILL,RCDA,RCDSEL,RCEOB,RCSAVE,RCWARN,RCXDA,RCXDA1,X,Y
+2 DO FULL^VALM1
+3 ; PRCA*4.5*304 - Pharmacy claim selection based coming from Exception or APAR screen
+4 IF '$DATA(RCAPAR)
DO SEL^RCDPEX3(.RCDA)
+5 IF $DATA(RCAPAR)
DO SEL^RCDPEX3(.RCDA,1)
+6 ;Only allow action if the selected exception has an ECME number
+7 SET RCDSEL=$ORDER(RCDA(0))
if RCDSEL
Begin DoDot:1
+8 ; IENS for FileMan, Rx number, Rx release date
NEW IENS,RCRXNO,RCRLSDT
+9 SET IENS=$PIECE(RCDA(RCDSEL),U,2)_","_$PIECE(RCDA(RCDSEL),U,1)_","
+10 SET RCRXNO=$$GET1^DIQ(344.41,IENS,.24)
IF RCRXNO=""
Begin DoDot:2
+11 WRITE !,"Comment not allowed. This is not a pharmacy exception."
DO WAIT^VALM1
End DoDot:2
QUIT
+12 ;
+13 ; IA #4701, RELEASE DATE for the prescription/fill
+14 ; get release date
SET RCRLSDT=$$RXRLDT^PSOBPSUT(RCRXNO)
+15 IF RCRLSDT]""
Begin DoDot:2
+16 WRITE !!,"Release Date: "_$$FMTE^XLFDT(RCRLSDT)
+17 WRITE !,"Comment not allowed for Rx with Release Date."
DO WAIT^VALM1
End DoDot:2
QUIT
+18 ;
+19 ;Display sequence and INVALID BILL NUMBER
+20 WRITE !,"Selection #: ",RCDSEL," ",$$GET1^DIQ(344.41,IENS,.05)
+21 ;Allow edit of pharmacy comment
+22 SET DIE="^RCY(344.4,"_$PIECE(RCDA(RCDSEL),U,1)_",1,"
SET DA=$PIECE(RCDA(RCDSEL),U,2)
SET DA(1)=$PIECE(RCDA(RCDSEL),U,1)
SET DR="9.01Comment"
DO ^DIE
if $DATA(DUOUT)!$DATA(DTOUT)
QUIT
+23 DO WAIT^VALM1
DO BLD^RCDPEX2
End DoDot:1
+24 ;
+25 KILL ^TMP($JOB,"RCDP-EOB"),^TMP($JOB,"RCDPEOB","HDR"),^TMP("RCDPERR-EOB",$JOB)
+26 SET VALMBCK="R"
+27 QUIT
