RCDPEAA3 ;ALB/KML - APAR Screen - callable entry points ;Nov 24, 2014@23:32:24
;;4.5;Accounts Receivable;**298,304,318,332**;Mar 20, 1995;Build 40
;Per VA Directive 6402, this routine should not be modified.
Q
;
SPLIT(RCIENS) ;EP - Protocol action - RCDPE APAR SPLINE LINE
; Split EEOB in APAR
; Input: RCIENS - Internal IEN of entry in file 344.49^ien of
; 344.491^selectable line item from listman screen
N DIR,L,RCQUIT,X
S RCQUIT=0
D FULL^VALM1
I '$D(^XUSEC("RCDPEPP",DUZ)) D Q ; PRCA*4.5*318 Added security key check
. S VALMBCK="R"
. W !!,"This action can only be taken by users that have the RCDPEPP security key.",!
. D PAUSE^VALM1
S L=0
F S L=$O(^RCY(344.49,$P(RCIENS,U),1,$P(RCIENS,U,2),1,L)) Q:'L I "01"[$P($G(^(L,0)),U,2) D G SPLITQ
. S DIR(0)="EA",DIR("A",1)="THIS EEOB IS NOT AVAILABLE TO EDIT/SPLIT",DIR("A")="PRESS RETURN TO CONTINUE "
. W ! D ^DIR K DIR
I $P($G(^RCY(344.49,$P(RCIENS,U),1,$P(RCIENS,U,2),0)),U,13) D G:RCQUIT SPLITQ
. S DIR("A",1)="WARNING! THIS LINE HAS ALREADY BEEN VERIFIED",DIR("A")="ARE YOU SURE YOU WANT TO CONTINUE?: ",DIR(0)="YA",DIR("B")="NO" W ! D ^DIR K DIR
. I Y'=1 S RCQUIT=1
K ^TMP("RCDPE_SPLIT_REBLD",$J)
S X=+$O(^TMP("RCDPE-EOB_WLDX",$J,""),-1)
D SPLIT^RCDPEWL3($P(RCIENS,U),X)
I $G(^TMP("RCDPE_SPLIT_REBLD",$J)) K ^TMP("RCDPE_SPLIT_REBLD",$J) D INIT^RCDPEAA2(RCIENS)
;
SPLITQ S VALMBCK="R"
Q
;
REFRESH(RCIENS) ;EP - Protocol action - RCDPE APAR EEOB REFRESH - PRCA*4.5*332 subroutine re-written
; Refresh the entry in file 344.49 to remove all user adjustments
; Input: RCIENS - Internal IEN of entry in file 344.49^ien of
; 344.491^selectable line item from listman screen
N DA,DIK,DIR,DONE,IENS,OSEQ,SEQ,X,XX,Y,Z,ZZ,Z0
D FULL^VALM1
S XX=$P(RCIENS,"^",2)_","_$P(RCIENS,"^",1)_","
S SEQ=$$GET1^DIQ(344.491,XX,.01,"I") ; Line Sequence #
I '$D(^XUSEC("RCDPEPP",DUZ)) D Q ; PRCA*4.5*318 Added security key check
. S VALMBCK="R"
. W !!,"This action can only be taken by users that have the RCDPEPP security key.",!
. D PAUSE^VALM1
;
S DIR(0)="YA"
S DIR("A",1)="This action will delete and rebuild this EEOB Worklist Scratch Pad for Line "_SEQ_"."
S DIR("A",2)="All Splits/Edits/Reviews entered for this line will be erased and all entries"
S DIR("A",3)="marked as manually verified will be unmarked.",DIR("A",4)=" "
S DIR("A")="ARE YOU SURE YOU WANT TO DO THIS? "
W !
D ^DIR
K DIR
I Y'=1 D REFQ Q
;
; First remove Review and Verify information
S DA=$P(RCIENS,"^",2),DA(1)=$P(RCIENS,"^",1)
S DIE="^RCY(344.49,"_DA(1)_",1,",DA=$P(RCIENS,"^",2),DA(1)=$P(RCIENS,"^",1)
S DR=".1///@;.11///@;.12///@;.13///@"
D ^DIE
S XX=0,DA(2)=DA(1),DA(1)=DA
F D Q:'XX
. S XX=$O(^RCY(344.49,DA(2),1,DA(1),4,XX))
. Q:'XX
. S DA=XX
. S DIK="^RCY(344.49,"_DA(2)_",1,"_DA(1)_",4,"
. D ^DIK
;
; Next remove distributed adjustments
S XX=0
F D Q:'XX
. S XX=$O(^RCY(344.49,DA(2),1,DA(1),1,XX))
. Q:'XX
. S DA=XX,DIK="^RCY(344.49,"_DA(2)_"1,"_DA(1)_",1,"
. D ^DIK
;
; Finally remove Split/Edited lines
K DA
S IENS=$P(RCIENS,"^",2)_","_$P(RCIENS,"^",1)_","
D GETS^DIQ(344.491,IENS,"**","I","OSEQ") ; Get Original line values
S DA=$P(RCIENS,"^",2)+1,DA(1)=$P(RCIENS,"^",1)
K DR
S DIE="^RCY(344.49,"_DA(1)_",1,"
S DR=".02///"_OSEQ(344.491,IENS,.02,"I")_";" ; Original Claim #
S DR=DR_".03///"_OSEQ(344.491,IENS,.03,"I")_";" ; Amount to Post on Receipt
S DR=DR_".04///"_OSEQ(344.491,IENS,.04,"I")_";" ; Include on Receipt
S DR=DR_".05///"_OSEQ(344.491,IENS,.05,"I")_";" ; Amount of Payment
S DR=DR_".06///"_OSEQ(344.491,IENS,.06,"I")_";" ; Net Amount of Payment
;
; PRCA*4.5*332 - AR Bill pointer goes in .07 field. It is populated during scratchpad creation
; but when refreshing we need to derive it from the old bill number in the .02 field.
S Z0=""
S ZZ=OSEQ(344.491,IENS,.02,"I")
I ZZ'="" S Z0=$O(^DGCR(399,"B",ZZ,""))
S DR=DR_".07///"_$S(Z0:Z0,1:"@")_";" ; AR Bill (399 or 430 IEN)
;
S DR=DR_".08///@;.09///@;.10///@;2.03///@;2.04///@" ; Null out the other fields
D ^DIE
S XX=DA,DONE=0
F D Q:DONE
. S XX=$O(^RCY(344.49,DA(1),1,XX))
. I 'XX S DONE=1 Q
. Q:$P($P(^RCY(344.49,DA(1),1,XX,0),"^",1),".",1)'=SEQ ; Not line being refreshed
. S DA=XX,DIK="^RCY(344.49,"_DA(1)_",1,"
. D ^DIK
;
D INIT^RCDPEAA2(RCIENS)
REFQ ;
S VALMBG=1,VALMBCK="R"
Q
;
RESEARCH ; Invoke the research menu off APAR
;
K ^TMP($J,"RC_VALMBG")
S ^TMP($J,"RC_VALMBG")=$G(VALMBG)
D FULL^VALM1
D EN^VALM("RCDPE APAR EEOB RESEARCH")
RQ K ^TMP($J,"RC_VALMBG")
Q
;
VRECPT(RCIENS) ;
;
; Input - RCIENS = ien of entry in file 344.49^ien of 344.491^selectable line item from listman screen
;
D VR^RCDPEWLP($P(RCIENS,U))
Q
REVIEW(RCIENS) ; Enter review information on worklist and turn review display on/off
;
; Input - RCIENS = ien of entry in file 344.49^ien of 344.491^selectable line item from listman screen
;
;
N Z,RC,RCDA,RCZ,DIC,DA,DIE,DR,X,Y,DIR,REVCHG,RCUSPREF,RCLSTREV,RCREV
D FULL^VALM1
;
S REVCHG=""
S DIR(0)="YA",RC=+$G(^TMP($J,"RC_REVIEW"))
S DIR("A",1)="REVIEW DATA DISPLAY IS CURRENTLY TURNED "_$P("OFF^ON",U,RC+1),DIR("A")="DO YOU WANT TO TURN IT "_$P("ON^OFF",U,RC+1)_"?: ",DIR("B")=$S('RC:"YES",1:"NO") W ! D ^DIR K DIR
I Y=1 S ^TMP($J,"RC_REVIEW")=((RC+1)#2),REVCHG=1
S RCUSPREF=+$O(^RCY(344.49,$P(RCIENS,U),2,"B",DUZ,0))
;
I 'RCUSPREF D ; Add the user pref record
. S RCUSPREF=+$$ADDUSER($P(RCIENS,U),DUZ)
S RCLSTREV=+$P($G(^RCY(344.49,$P(RCIENS,U),2,RCUSPREF,0)),U,2)
S DA(1)=$P(RCIENS,U),DA=RCUSPREF
I DA,RCLSTREV'=$G(^TMP($J,"RC_REVIEW")) D ; Update user pref
. S DIE="^RCY(344.49,"_DA(1)_",2,",DR=".02////"_+$G(^TMP($J,"RC_REVIEW")) D ^DIE
W !
I '$G(^TMP($J,"RC_REVIEW")) G REVIEWQ
;
D SEL^RCDPEWL(.RCDA)
S RCZ=+$O(RCDA(0)),RCZ=+$G(RCDA(RCZ)) G:'RCZ REVIEWQ
;
S RCREV=0
I '$O(^RCY(344.49,$P(RCIENS,U),1,"AC",DUZ,RCZ,0)) D
. S RCREV=$$NEWREV($P(RCIENS,U),RCZ,DUZ)
E D
. N DIR,X,Y
. S DIR("A")="(A)DD or (E)DIT A REVIEW COMMENT?: ",DIR("B")="ADD",DIR(0)="SA^A:ADD;E:EDIT" W ! D ^DIR K DIR
. I $D(DUOUT)!$D(DTOUT) Q
. ;
. I Y="E" D Q ; Edit a review entry entered by same user
.. N DA,DR,DIE,X,Y
.. S DA(1)=$P(RCIENS,U),DA=RCZ,DIC="^RCY(344.49,"_DA(1)_",1,"_DA_",4,",DIC(0)="AEMQ",DIC("S")="I $P(^(0),U,2)=DUZ" D ^DIC
.. S RCREV=$S(Y>0:+Y,1:0)
.. I RCREV S DA(2)=$P(RCIENS,U),DA(1)=RCZ,DA=RCREV,DIE="^RCY(344.49,"_DA(2)_",1,"_DA(1)_",4,",DR=".03;.04////^S X=$$NOW^XLFDT()" D ^DIE
. ;
. S RCREV=$$NEWREV($P(RCIENS,U),RCZ,DUZ)
;
I RCREV S DIE("NO^")="",DA(1)=$P(RCIENS,U),DA=RCZ,DIE="^RCY(344.49,"_DA(1)_",1,",DR=".11R;I X=0 S Y=""@10"";.12////^S X=DUZ;S Y=""@20"";@10;.12///@;@20" D ^DIE K DIE
D INIT^RCDPEAA2(RCIENS)
S REVCHG=""
;
REVIEWQ I $G(REVCHG) D INIT^RCDPEAA2(RCIENS)
S VALMBCK="R"
Q
;
NEWREV(RCSCR,RCZ,RCDUZ) ; Enter a new review comment
; RCSCR = ien of entry in file 344.49
; RCZ = ien of the EEOB (seq #)
; RCDUZ =DUZ of user entering the comment
; Function returns 0 if no new comment, ien of comment if added
N DA,X,Y,DIC,DIK,DLAYGO,DO,DD,RCREV,RCNOW
S RCNOW=$$NOW^XLFDT() W !!,"REVIEW DATE/TIME: "_$$FMTE^XLFDT(RCNOW,"2")
S DA(2)=RCSCR,DA(1)=RCZ,X=RCNOW,DIC("DR")=".02////"_RCDUZ_";.03",DLAYGO=344.492,DIC(0)="L"
S DIC="^RCY(344.49,"_DA(2)_",1,"_DA(1)_",4,"
K DO,DD
D FILE^DICN K DO,DD,DIC,DLAYGO
S RCREV=+Y
I RCREV'>0 S RCREV=0 G NEWREVQ
I '$O(^RCY(344.49,DA(2),1,DA(1),4,RCREV,0)) S DIK="^RCY(344.49,"_DA(2)_",1,"_DA(1)_",4,",DA=RCREV D ^DIK S RCREV=0 ; No comment - delete entry
;
NEWREVQ Q RCREV
;
ADDUSER(RCSCR,RCDUZ) ; Add user record to user preferences multiple in file 344.49 and initialize all preferences
; RCSCR = ien of entry in file 344.49
; RCDUZ = the ien of the user
N DIC,DA,X,Y,DLAYGO,DO,DD
S Y=+$O(^RCY(344.49,RCSCR,2,"B",RCDUZ,0))
I Y G ADDUQ
S DLAYGO=344.492,DA(1)=RCSCR,DIC(0)="L",X=RCDUZ,DIC="^RCY(344.49,"_DA(1)_",2,",DIC("DR")=".02////0;.03////N"
D FILE^DICN K DIC,DLAYGO
ADDUQ Q $S(Y>0:Y,1:0)
;
PREOB(RCIENS) ; Print/View EOB detail
N RCDA,RCDAZ,Z,Z0
D FULL^VALM1
S RCDA=$P($G(^RCY(344.49,$P(RCIENS,U),1,$P(RCIENS,U,2),0)),U,9)
F RCDAZ=1:1:$L(RCDA,",") S RCDAZ(RCDAZ)=$P(RCDA,",",RCDAZ)
S Z=0 F S Z=$O(RCDAZ(Z)) Q:'Z D
. ;
. S Z0=RCDAZ(Z)
. I $E(Z0,1,3)="ADJ" D Q
.. I $G(^RCY(344.4,RCSCR,2,+$P(Z0,"ADJ",2),0))'="" S RCDAZ(Z)="ADJ^"_+$P(Z0,"ADJ",2)
. ;
. S Z0=$G(^RCY(344.4,$P(RCIENS,U),1,+Z0,0))
. S RCDAZ(Z)=+Z0_U_$S($P(Z0,U,2):$P(Z0,U,2),1:-1) Q
;
D VP^RCDPEWL2($P(RCIENS,U),.RCDAZ)
;
S VALMBCK="R"
Q
;
VERIF(RCIENS) ;EP - Protocol action RCDPE APAR VERIFY
; Entry point to verification options on APAR worklist
; Input: RCIENS - Internal IEN of entry in file 344.49^ien of
; 344.491^selectable line item from listman screen
N DIR,DIRUT,DTOUT,DUOUT,RCQUIT,X,Y
D FULL^VALM1
I '$D(^XUSEC("RCDPEPP",DUZ)) D Q ; PRCA*4.5*318 Added security key check
. S VALMBCK="R"
. W !!,"This action can only be taken by users that have the RCDPEPP security key.",!
. D PAUSE^VALM1
;
W !!!!
S RCQUIT=0
F D Q:RCQUIT
. S DIR(0)="SAO^1:MANUAL VERIFICATION;2:REPORT UNVERIFIED DISCREPANCIES;3:QUIT"
. S DIR("A",1)="VERIFY EEOBs:"
. S DIR("A",2)=" 1 MANUALLY MARK AS VERIFIED"
. S DIR("A",3)=" 2 REPORT OF UNVERIFIED WITH DISCREPANCIES"
. S DIR("A",4)=" 3 QUIT AND RETURN TO WORKLIST"
. S DIR("A")="Select Action: ",DIR("B")="QUIT" W ! D ^DIR K DIR
. I Y=3!(Y="")!$D(DUOUT)!$D(DTOUT) S RCQUIT=1 Q
. ;
. I Y=1 D MVER($P(RCIENS,U)) W !! Q
. ;
. I Y=2 D RPT^RCDPEV0($P(RCIENS,U)) W !! Q
;
S VALMBCK="R"
Q
;
MVER(RCERA) ; Manually mark an EEOB as verified within APAR
; subroutine cloned from the process that VERIFIES EEOBs off the standard worklist (MVER^RCDPEV)
; but with specific changes to support APAR
; this subroutine only needs to VERIFY one EEOB rather than a list of EEOBs
N A,CT,DA,DIE,DR,DTOUT,DUOUT,Z,Z0,Z1,RCT,RCY,RCY0,RCZ0,RCLINE,RCYNUM,DIR,X,Y,RESULT,SPLIT,Q,Q0,DT1,DT2
N VERIFIED
S (VERIFIED,RCT)=0,CT=1,Z0=""
; get the EEOB entry ien to determine if already it's already been verified
S Z1=$O(^TMP("RCDPE-EOB_WLDX",$J,"")) I Z1 S Z=^TMP("RCDPE-EOB_WLDX",$J,Z1)
; grab the data belonging to the EEOB
I Z]"" S Z0=$G(^RCY(344.49,RCERA,1,+$P(Z,U,2),0))
; get VERIFY data
I Z0'="",$P(Z0,U,13) S VERIFIED=1
I VERIFIED D Q
. S DIR(0)="EA",DIR("A",1)="THIS EEOB IS ALREADY VERIFIED",DIR("A")="PRESS RETURN TO CONTINUE: " W ! D ^DIR K DIR
S RCY=+$P($G(^TMP("RCDPE-EOB_WLDX",$J,Z1)),U,2),RCLINE=+^(Z1),RCYNUM=Z1
S RCY0=$G(^RCY(344.49,RCERA,1,RCY,0))
S RCZ0=$G(^RCY(344.4,RCERA,1,+$P(RCY0,U,9),0))
I '$P(RCZ0,U,2) D
. W !!,"THIS LINE DOES NOT REFERENCE A VALID BILL"
E D
. S RESULT=$$VER^RCDPEV(RCERA,+$G(^IBM(361.1,+$P(RCZ0,U,2),0)),+$P(RCY0,U,9),1)
. F Z=2:1:9 I $E($P(RESULT,U,Z))="*" S Q=$P(RESULT,U,Z),$E(Q,1)="",$P(RESULT,U,Z)=Q
. S SPLIT=$O(^RCY(344.49,RCERA,1,"B",+RCY0_".9999"),-1)'=(+RCY0_".0001")
. S Z=$S(SPLIT:"CLAIM #'s: ",1:" CLAIM #: ")
. S Z=Z_$P(RCY0,U,2)_$S('SPLIT:"",1:" (ORIGINAL ERA DATA)")
. I SPLIT D
.. S Q=+RCY0 F S Q=$O(^RCY(344.49,RCERA,1,"B",Q)) Q:(Q\1)'=+RCY0 S Q0=+$O(^RCY(344.49,RCERA,1,"B",Q,0)),Q0=$G(^RCY(344.49,RCERA,1,Q0,0)) I $P(Q0,U,2)'="" S Z=Z_" "_$P(Q0,U,2)
. W !!!,Z
. W !,?13,"PATIENT NAME"_$J("",18)_" SUBMITTED AMT SVC DATE(S)"
. W !,?13,"------------------------------ --------------- -----------------"
. S DT1=$E($S($P(RESULT,U,7):$$FMTE^XLFDT($P(RESULT,U,7),"2D"),1:"NOTFOUND")_$J("",8),1,8)
. S DT2=$E($S($P(RESULT,U,9):"-"_$$FMTE^XLFDT($P(RESULT,U,9),"2D"),1:"-NOTFOUND")_$J("",9),1,9)
. W !," ERA DATA: ",$E($P(RESULT,U,3)_$J("",30),1,30)," ",$E($J($P(RESULT,U,5),"",2)_$J("",15),1,15)_" "_DT1_DT2
. W !,?15,$P($G(^RCY(344,RCERA,0)),U,6)
. S DT1=$E($S($P(RESULT,U,6):$$FMTE^XLFDT($P(RESULT,U,6),"2D"),1:"NOTFOUND")_$J("",8),1,8)
. S DT2=$E($S($P(RESULT,U,8):"-"_$$FMTE^XLFDT($P(RESULT,U,8),"2D"),1:"-NOTFOUND")_$J("",9),1,9)
. W !," BILL DATA: "_$E($P(RESULT,U,2)_$J("",30),1,30)_" "_$E($J($P(RESULT,U,4),"",2)_$J("",15),1,15)_" "_DT1_DT2
. W !,?15,$P($G(^DIC(36,+$P(RCZ0,U,4),0)),U),!
S DIR(0)="YA",DIR("A")="DO YOU WANT TO MARK THIS LINE VERIFIED? ",DIR("B")="NO" W ! D ^DIR K DIR
;
I Y'=1 Q
S DA(1)=RCERA,DA=+RCY,DIE="^RCY(344.49,"_DA(1)_",1,",DR=".13////1" D ^DIE
S A=$$TOPLINE^RCDPEWL1($G(^RCY(344.49,RCERA,1,+RCY,0)),RCYNUM)
S ^TMP("RCDPE-EOB_WL",$J,RCLINE,0)=A
Q
;
;PRCA*4.5*304 - add a claim comment to the ERA detail line from APAR
COMNT ;
N IEN,SEQ,DA,DIR,DTOUT,DUOUT,X,Y,DIRUT,DIROUT,ZDA,ZBILL,RCOMMENT,TCOMM
S RCOMMENT=0
S IEN=+$P(RCIENS,U,1)
; Validate the selection
I IEN=0 D G COMQ
. W !,"Cannot comment, no record in file ELECTRONIC REMITTANCE ADVICE file selected." D WAIT^VALM1
S SEQ=$P(^RCY(344.49,IEN,1,+$P(RCIENS,U,2),0),U,9) ; Just grab the first sequence number for the comment.
I $G(SEQ)="" D G COMQ
. W !,"Cannot comment, no ERA detail record selected." D WAIT^VALM1
I $G(^RCY(344.4,IEN,1,SEQ,0))']"" D G COMQ
. W !,"Cannot comment, ERA detail record selected not found." D WAIT^VALM1
;
; Allow user to put comment on this ERA Detail record
S ZDA=SEQ,ZDA(1)=IEN,ZBILL=$P($$GETBILL^RCDPESR0(.ZDA),"-",2)
W !,"Enter a comment on ERA #"_IEN_" ERA Detail Seq #",SEQ," Bill #",ZBILL,!
S DIE="^RCY(344.4,"_IEN_",1,",DA=SEQ,DA(1)=IEN,DR="4Comment" D ^DIE G:$D(DTOUT)!$D(Y) COMQ
; Now file user (DUZ) and DATE
K DR
; If DA is not defined then the user deleted the comment with an @,
; Delete the user and date too.
S TCOMM=$$GET1^DIQ(344.41,SEQ_","_IEN_",",4,"E")
I TCOMM="" S DA=SEQ,DA(1)=IEN,DR="4.01////@;4.02////@;"
E S DR="4.01////"_$$DT^XLFDT_";4.02////"_$G(DUZ)_";"
D ^DIE
S RCOMMENT=1
D WAIT^VALM1
;
COMQ I RCOMMENT D INIT^RCDPEAA2(RCIENS) ;
S VALMBCK="R"
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HRCDPEAA3 14024 printed Dec 13, 2024@01:44:07 Page 2
RCDPEAA3 ;ALB/KML - APAR Screen - callable entry points ;Nov 24, 2014@23:32:24
+1 ;;4.5;Accounts Receivable;**298,304,318,332**;Mar 20, 1995;Build 40
+2 ;Per VA Directive 6402, this routine should not be modified.
+3 QUIT
+4 ;
SPLIT(RCIENS) ;EP - Protocol action - RCDPE APAR SPLINE LINE
+1 ; Split EEOB in APAR
+2 ; Input: RCIENS - Internal IEN of entry in file 344.49^ien of
+3 ; 344.491^selectable line item from listman screen
+4 NEW DIR,L,RCQUIT,X
+5 SET RCQUIT=0
+6 DO FULL^VALM1
+7 ; PRCA*4.5*318 Added security key check
IF '$DATA(^XUSEC("RCDPEPP",DUZ))
Begin DoDot:1
+8 SET VALMBCK="R"
+9 WRITE !!,"This action can only be taken by users that have the RCDPEPP security key.",!
+10 DO PAUSE^VALM1
End DoDot:1
QUIT
+11 SET L=0
+12 FOR
SET L=$ORDER(^RCY(344.49,$PIECE(RCIENS,U),1,$PIECE(RCIENS,U,2),1,L))
if 'L
QUIT
IF "01"[$PIECE($GET(^(L,0)),U,2)
Begin DoDot:1
+13 SET DIR(0)="EA"
SET DIR("A",1)="THIS EEOB IS NOT AVAILABLE TO EDIT/SPLIT"
SET DIR("A")="PRESS RETURN TO CONTINUE "
+14 WRITE !
DO ^DIR
KILL DIR
End DoDot:1
GOTO SPLITQ
+15 IF $PIECE($GET(^RCY(344.49,$PIECE(RCIENS,U),1,$PIECE(RCIENS,U,2),0)),U,13)
Begin DoDot:1
+16 SET DIR("A",1)="WARNING! THIS LINE HAS ALREADY BEEN VERIFIED"
SET DIR("A")="ARE YOU SURE YOU WANT TO CONTINUE?: "
SET DIR(0)="YA"
SET DIR("B")="NO"
WRITE !
DO ^DIR
KILL DIR
+17 IF Y'=1
SET RCQUIT=1
End DoDot:1
if RCQUIT
GOTO SPLITQ
+18 KILL ^TMP("RCDPE_SPLIT_REBLD",$JOB)
+19 SET X=+$ORDER(^TMP("RCDPE-EOB_WLDX",$JOB,""),-1)
+20 DO SPLIT^RCDPEWL3($PIECE(RCIENS,U),X)
+21 IF $GET(^TMP("RCDPE_SPLIT_REBLD",$JOB))
KILL ^TMP("RCDPE_SPLIT_REBLD",$JOB)
DO INIT^RCDPEAA2(RCIENS)
+22 ;
SPLITQ SET VALMBCK="R"
+1 QUIT
+2 ;
REFRESH(RCIENS) ;EP - Protocol action - RCDPE APAR EEOB REFRESH - PRCA*4.5*332 subroutine re-written
+1 ; Refresh the entry in file 344.49 to remove all user adjustments
+2 ; Input: RCIENS - Internal IEN of entry in file 344.49^ien of
+3 ; 344.491^selectable line item from listman screen
+4 NEW DA,DIK,DIR,DONE,IENS,OSEQ,SEQ,X,XX,Y,Z,ZZ,Z0
+5 DO FULL^VALM1
+6 SET XX=$PIECE(RCIENS,"^",2)_","_$PIECE(RCIENS,"^",1)_","
+7 ; Line Sequence #
SET SEQ=$$GET1^DIQ(344.491,XX,.01,"I")
+8 ; PRCA*4.5*318 Added security key check
IF '$DATA(^XUSEC("RCDPEPP",DUZ))
Begin DoDot:1
+9 SET VALMBCK="R"
+10 WRITE !!,"This action can only be taken by users that have the RCDPEPP security key.",!
+11 DO PAUSE^VALM1
End DoDot:1
QUIT
+12 ;
+13 SET DIR(0)="YA"
+14 SET DIR("A",1)="This action will delete and rebuild this EEOB Worklist Scratch Pad for Line "_SEQ_"."
+15 SET DIR("A",2)="All Splits/Edits/Reviews entered for this line will be erased and all entries"
+16 SET DIR("A",3)="marked as manually verified will be unmarked."
SET DIR("A",4)=" "
+17 SET DIR("A")="ARE YOU SURE YOU WANT TO DO THIS? "
+18 WRITE !
+19 DO ^DIR
+20 KILL DIR
+21 IF Y'=1
DO REFQ
QUIT
+22 ;
+23 ; First remove Review and Verify information
+24 SET DA=$PIECE(RCIENS,"^",2)
SET DA(1)=$PIECE(RCIENS,"^",1)
+25 SET DIE="^RCY(344.49,"_DA(1)_",1,"
SET DA=$PIECE(RCIENS,"^",2)
SET DA(1)=$PIECE(RCIENS,"^",1)
+26 SET DR=".1///@;.11///@;.12///@;.13///@"
+27 DO ^DIE
+28 SET XX=0
SET DA(2)=DA(1)
SET DA(1)=DA
+29 FOR
Begin DoDot:1
+30 SET XX=$ORDER(^RCY(344.49,DA(2),1,DA(1),4,XX))
+31 if 'XX
QUIT
+32 SET DA=XX
+33 SET DIK="^RCY(344.49,"_DA(2)_",1,"_DA(1)_",4,"
+34 DO ^DIK
End DoDot:1
if 'XX
QUIT
+35 ;
+36 ; Next remove distributed adjustments
+37 SET XX=0
+38 FOR
Begin DoDot:1
+39 SET XX=$ORDER(^RCY(344.49,DA(2),1,DA(1),1,XX))
+40 if 'XX
QUIT
+41 SET DA=XX
SET DIK="^RCY(344.49,"_DA(2)_"1,"_DA(1)_",1,"
+42 DO ^DIK
End DoDot:1
if 'XX
QUIT
+43 ;
+44 ; Finally remove Split/Edited lines
+45 KILL DA
+46 SET IENS=$PIECE(RCIENS,"^",2)_","_$PIECE(RCIENS,"^",1)_","
+47 ; Get Original line values
DO GETS^DIQ(344.491,IENS,"**","I","OSEQ")
+48 SET DA=$PIECE(RCIENS,"^",2)+1
SET DA(1)=$PIECE(RCIENS,"^",1)
+49 KILL DR
+50 SET DIE="^RCY(344.49,"_DA(1)_",1,"
+51 ; Original Claim #
SET DR=".02///"_OSEQ(344.491,IENS,.02,"I")_";"
+52 ; Amount to Post on Receipt
SET DR=DR_".03///"_OSEQ(344.491,IENS,.03,"I")_";"
+53 ; Include on Receipt
SET DR=DR_".04///"_OSEQ(344.491,IENS,.04,"I")_";"
+54 ; Amount of Payment
SET DR=DR_".05///"_OSEQ(344.491,IENS,.05,"I")_";"
+55 ; Net Amount of Payment
SET DR=DR_".06///"_OSEQ(344.491,IENS,.06,"I")_";"
+56 ;
+57 ; PRCA*4.5*332 - AR Bill pointer goes in .07 field. It is populated during scratchpad creation
+58 ; but when refreshing we need to derive it from the old bill number in the .02 field.
+59 SET Z0=""
+60 SET ZZ=OSEQ(344.491,IENS,.02,"I")
+61 IF ZZ'=""
SET Z0=$ORDER(^DGCR(399,"B",ZZ,""))
+62 ; AR Bill (399 or 430 IEN)
SET DR=DR_".07///"_$SELECT(Z0:Z0,1:"@")_";"
+63 ;
+64 ; Null out the other fields
SET DR=DR_".08///@;.09///@;.10///@;2.03///@;2.04///@"
+65 DO ^DIE
+66 SET XX=DA
SET DONE=0
+67 FOR
Begin DoDot:1
+68 SET XX=$ORDER(^RCY(344.49,DA(1),1,XX))
+69 IF 'XX
SET DONE=1
QUIT
+70 ; Not line being refreshed
if $PIECE($PIECE(^RCY(344.49,DA(1),1,XX,0),"^",1),".",1)'=SEQ
QUIT
+71 SET DA=XX
SET DIK="^RCY(344.49,"_DA(1)_",1,"
+72 DO ^DIK
End DoDot:1
if DONE
QUIT
+73 ;
+74 DO INIT^RCDPEAA2(RCIENS)
REFQ ;
+1 SET VALMBG=1
SET VALMBCK="R"
+2 QUIT
+3 ;
RESEARCH ; Invoke the research menu off APAR
+1 ;
+2 KILL ^TMP($JOB,"RC_VALMBG")
+3 SET ^TMP($JOB,"RC_VALMBG")=$GET(VALMBG)
+4 DO FULL^VALM1
+5 DO EN^VALM("RCDPE APAR EEOB RESEARCH")
RQ KILL ^TMP($JOB,"RC_VALMBG")
+1 QUIT
+2 ;
VRECPT(RCIENS) ;
+1 ;
+2 ; Input - RCIENS = ien of entry in file 344.49^ien of 344.491^selectable line item from listman screen
+3 ;
+4 DO VR^RCDPEWLP($PIECE(RCIENS,U))
+5 QUIT
REVIEW(RCIENS) ; Enter review information on worklist and turn review display on/off
+1 ;
+2 ; Input - RCIENS = ien of entry in file 344.49^ien of 344.491^selectable line item from listman screen
+3 ;
+4 ;
+5 NEW Z,RC,RCDA,RCZ,DIC,DA,DIE,DR,X,Y,DIR,REVCHG,RCUSPREF,RCLSTREV,RCREV
+6 DO FULL^VALM1
+7 ;
+8 SET REVCHG=""
+9 SET DIR(0)="YA"
SET RC=+$GET(^TMP($JOB,"RC_REVIEW"))
+10 SET DIR("A",1)="REVIEW DATA DISPLAY IS CURRENTLY TURNED "_$PIECE("OFF^ON",U,RC+1)
SET DIR("A")="DO YOU WANT TO TURN IT "_$PIECE("ON^OFF",U,RC+1)_"?: "
SET DIR("B")=$SELECT('RC:"YES",1:"NO")
WRITE !
DO ^DIR
KILL DIR
+11 IF Y=1
SET ^TMP($JOB,"RC_REVIEW")=((RC+1)#2)
SET REVCHG=1
+12 SET RCUSPREF=+$ORDER(^RCY(344.49,$PIECE(RCIENS,U),2,"B",DUZ,0))
+13 ;
+14 ; Add the user pref record
IF 'RCUSPREF
Begin DoDot:1
+15 SET RCUSPREF=+$$ADDUSER($PIECE(RCIENS,U),DUZ)
End DoDot:1
+16 SET RCLSTREV=+$PIECE($GET(^RCY(344.49,$PIECE(RCIENS,U),2,RCUSPREF,0)),U,2)
+17 SET DA(1)=$PIECE(RCIENS,U)
SET DA=RCUSPREF
+18 ; Update user pref
IF DA
IF RCLSTREV'=$GET(^TMP($JOB,"RC_REVIEW"))
Begin DoDot:1
+19 SET DIE="^RCY(344.49,"_DA(1)_",2,"
SET DR=".02////"_+$GET(^TMP($JOB,"RC_REVIEW"))
DO ^DIE
End DoDot:1
+20 WRITE !
+21 IF '$GET(^TMP($JOB,"RC_REVIEW"))
GOTO REVIEWQ
+22 ;
+23 DO SEL^RCDPEWL(.RCDA)
+24 SET RCZ=+$ORDER(RCDA(0))
SET RCZ=+$GET(RCDA(RCZ))
if 'RCZ
GOTO REVIEWQ
+25 ;
+26 SET RCREV=0
+27 IF '$ORDER(^RCY(344.49,$PIECE(RCIENS,U),1,"AC",DUZ,RCZ,0))
Begin DoDot:1
+28 SET RCREV=$$NEWREV($PIECE(RCIENS,U),RCZ,DUZ)
End DoDot:1
+29 IF '$TEST
Begin DoDot:1
+30 NEW DIR,X,Y
+31 SET DIR("A")="(A)DD or (E)DIT A REVIEW COMMENT?: "
SET DIR("B")="ADD"
SET DIR(0)="SA^A:ADD;E:EDIT"
WRITE !
DO ^DIR
KILL DIR
+32 IF $DATA(DUOUT)!$DATA(DTOUT)
QUIT
+33 ;
+34 ; Edit a review entry entered by same user
IF Y="E"
Begin DoDot:2
+35 NEW DA,DR,DIE,X,Y
+36 SET DA(1)=$PIECE(RCIENS,U)
SET DA=RCZ
SET DIC="^RCY(344.49,"_DA(1)_",1,"_DA_",4,"
SET DIC(0)="AEMQ"
SET DIC("S")="I $P(^(0),U,2)=DUZ"
DO ^DIC
+37 SET RCREV=$SELECT(Y>0:+Y,1:0)
+38 IF RCREV
SET DA(2)=$PIECE(RCIENS,U)
SET DA(1)=RCZ
SET DA=RCREV
SET DIE="^RCY(344.49,"_DA(2)_",1,"_DA(1)_",4,"
SET DR=".03;.04////^S X=$$NOW^XLFDT()"
DO ^DIE
End DoDot:2
QUIT
+39 ;
+40 SET RCREV=$$NEWREV($PIECE(RCIENS,U),RCZ,DUZ)
End DoDot:1
+41 ;
+42 IF RCREV
SET DIE("NO^")=""
SET DA(1)=$PIECE(RCIENS,U)
SET DA=RCZ
SET DIE="^RCY(344.49,"_DA(1)_",1,"
SET DR=".11R;I X=0 S Y=""@10"";.12////^S X=DUZ;S Y=""@20"";@10;.12///@;@20"
DO ^DIE
KILL DIE
+43 DO INIT^RCDPEAA2(RCIENS)
+44 SET REVCHG=""
+45 ;
REVIEWQ IF $GET(REVCHG)
DO INIT^RCDPEAA2(RCIENS)
+1 SET VALMBCK="R"
+2 QUIT
+3 ;
NEWREV(RCSCR,RCZ,RCDUZ) ; Enter a new review comment
+1 ; RCSCR = ien of entry in file 344.49
+2 ; RCZ = ien of the EEOB (seq #)
+3 ; RCDUZ =DUZ of user entering the comment
+4 ; Function returns 0 if no new comment, ien of comment if added
+5 NEW DA,X,Y,DIC,DIK,DLAYGO,DO,DD,RCREV,RCNOW
+6 SET RCNOW=$$NOW^XLFDT()
WRITE !!,"REVIEW DATE/TIME: "_$$FMTE^XLFDT(RCNOW,"2")
+7 SET DA(2)=RCSCR
SET DA(1)=RCZ
SET X=RCNOW
SET DIC("DR")=".02////"_RCDUZ_";.03"
SET DLAYGO=344.492
SET DIC(0)="L"
+8 SET DIC="^RCY(344.49,"_DA(2)_",1,"_DA(1)_",4,"
+9 KILL DO,DD
+10 DO FILE^DICN
KILL DO,DD,DIC,DLAYGO
+11 SET RCREV=+Y
+12 IF RCREV'>0
SET RCREV=0
GOTO NEWREVQ
+13 ; No comment - delete entry
IF '$ORDER(^RCY(344.49,DA(2),1,DA(1),4,RCREV,0))
SET DIK="^RCY(344.49,"_DA(2)_",1,"_DA(1)_",4,"
SET DA=RCREV
DO ^DIK
SET RCREV=0
+14 ;
NEWREVQ QUIT RCREV
+1 ;
ADDUSER(RCSCR,RCDUZ) ; Add user record to user preferences multiple in file 344.49 and initialize all preferences
+1 ; RCSCR = ien of entry in file 344.49
+2 ; RCDUZ = the ien of the user
+3 NEW DIC,DA,X,Y,DLAYGO,DO,DD
+4 SET Y=+$ORDER(^RCY(344.49,RCSCR,2,"B",RCDUZ,0))
+5 IF Y
GOTO ADDUQ
+6 SET DLAYGO=344.492
SET DA(1)=RCSCR
SET DIC(0)="L"
SET X=RCDUZ
SET DIC="^RCY(344.49,"_DA(1)_",2,"
SET DIC("DR")=".02////0;.03////N"
+7 DO FILE^DICN
KILL DIC,DLAYGO
ADDUQ QUIT $SELECT(Y>0:Y,1:0)
+1 ;
PREOB(RCIENS) ; Print/View EOB detail
+1 NEW RCDA,RCDAZ,Z,Z0
+2 DO FULL^VALM1
+3 SET RCDA=$PIECE($GET(^RCY(344.49,$PIECE(RCIENS,U),1,$PIECE(RCIENS,U,2),0)),U,9)
+4 FOR RCDAZ=1:1:$LENGTH(RCDA,",")
SET RCDAZ(RCDAZ)=$PIECE(RCDA,",",RCDAZ)
+5 SET Z=0
FOR
SET Z=$ORDER(RCDAZ(Z))
if 'Z
QUIT
Begin DoDot:1
+6 ;
+7 SET Z0=RCDAZ(Z)
+8 IF $EXTRACT(Z0,1,3)="ADJ"
Begin DoDot:2
+9 IF $GET(^RCY(344.4,RCSCR,2,+$PIECE(Z0,"ADJ",2),0))'=""
SET RCDAZ(Z)="ADJ^"_+$PIECE(Z0,"ADJ",2)
End DoDot:2
QUIT
+10 ;
+11 SET Z0=$GET(^RCY(344.4,$PIECE(RCIENS,U),1,+Z0,0))
+12 SET RCDAZ(Z)=+Z0_U_$SELECT($PIECE(Z0,U,2):$PIECE(Z0,U,2),1:-1)
QUIT
End DoDot:1
+13 ;
+14 DO VP^RCDPEWL2($PIECE(RCIENS,U),.RCDAZ)
+15 ;
+16 SET VALMBCK="R"
+17 QUIT
+18 ;
VERIF(RCIENS) ;EP - Protocol action RCDPE APAR VERIFY
+1 ; Entry point to verification options on APAR worklist
+2 ; Input: RCIENS - Internal IEN of entry in file 344.49^ien of
+3 ; 344.491^selectable line item from listman screen
+4 NEW DIR,DIRUT,DTOUT,DUOUT,RCQUIT,X,Y
+5 DO FULL^VALM1
+6 ; PRCA*4.5*318 Added security key check
IF '$DATA(^XUSEC("RCDPEPP",DUZ))
Begin DoDot:1
+7 SET VALMBCK="R"
+8 WRITE !!,"This action can only be taken by users that have the RCDPEPP security key.",!
+9 DO PAUSE^VALM1
End DoDot:1
QUIT
+10 ;
+11 WRITE !!!!
+12 SET RCQUIT=0
+13 FOR
Begin DoDot:1
+14 SET DIR(0)="SAO^1:MANUAL VERIFICATION;2:REPORT UNVERIFIED DISCREPANCIES;3:QUIT"
+15 SET DIR("A",1)="VERIFY EEOBs:"
+16 SET DIR("A",2)=" 1 MANUALLY MARK AS VERIFIED"
+17 SET DIR("A",3)=" 2 REPORT OF UNVERIFIED WITH DISCREPANCIES"
+18 SET DIR("A",4)=" 3 QUIT AND RETURN TO WORKLIST"
+19 SET DIR("A")="Select Action: "
SET DIR("B")="QUIT"
WRITE !
DO ^DIR
KILL DIR
+20 IF Y=3!(Y="")!$DATA(DUOUT)!$DATA(DTOUT)
SET RCQUIT=1
QUIT
+21 ;
+22 IF Y=1
DO MVER($PIECE(RCIENS,U))
WRITE !!
QUIT
+23 ;
+24 IF Y=2
DO RPT^RCDPEV0($PIECE(RCIENS,U))
WRITE !!
QUIT
End DoDot:1
if RCQUIT
QUIT
+25 ;
+26 SET VALMBCK="R"
+27 QUIT
+28 ;
MVER(RCERA) ; Manually mark an EEOB as verified within APAR
+1 ; subroutine cloned from the process that VERIFIES EEOBs off the standard worklist (MVER^RCDPEV)
+2 ; but with specific changes to support APAR
+3 ; this subroutine only needs to VERIFY one EEOB rather than a list of EEOBs
+4 NEW A,CT,DA,DIE,DR,DTOUT,DUOUT,Z,Z0,Z1,RCT,RCY,RCY0,RCZ0,RCLINE,RCYNUM,DIR,X,Y,RESULT,SPLIT,Q,Q0,DT1,DT2
+5 NEW VERIFIED
+6 SET (VERIFIED,RCT)=0
SET CT=1
SET Z0=""
+7 ; get the EEOB entry ien to determine if already it's already been verified
+8 SET Z1=$ORDER(^TMP("RCDPE-EOB_WLDX",$JOB,""))
IF Z1
SET Z=^TMP("RCDPE-EOB_WLDX",$JOB,Z1)
+9 ; grab the data belonging to the EEOB
+10 IF Z]""
SET Z0=$GET(^RCY(344.49,RCERA,1,+$PIECE(Z,U,2),0))
+11 ; get VERIFY data
+12 IF Z0'=""
IF $PIECE(Z0,U,13)
SET VERIFIED=1
+13 IF VERIFIED
Begin DoDot:1
+14 SET DIR(0)="EA"
SET DIR("A",1)="THIS EEOB IS ALREADY VERIFIED"
SET DIR("A")="PRESS RETURN TO CONTINUE: "
WRITE !
DO ^DIR
KILL DIR
End DoDot:1
QUIT
+15 SET RCY=+$PIECE($GET(^TMP("RCDPE-EOB_WLDX",$JOB,Z1)),U,2)
SET RCLINE=+^(Z1)
SET RCYNUM=Z1
+16 SET RCY0=$GET(^RCY(344.49,RCERA,1,RCY,0))
+17 SET RCZ0=$GET(^RCY(344.4,RCERA,1,+$PIECE(RCY0,U,9),0))
+18 IF '$PIECE(RCZ0,U,2)
Begin DoDot:1
+19 WRITE !!,"THIS LINE DOES NOT REFERENCE A VALID BILL"
End DoDot:1
+20 IF '$TEST
Begin DoDot:1
+21 SET RESULT=$$VER^RCDPEV(RCERA,+$GET(^IBM(361.1,+$PIECE(RCZ0,U,2),0)),+$PIECE(RCY0,U,9),1)
+22 FOR Z=2:1:9
IF $EXTRACT($PIECE(RESULT,U,Z))="*"
SET Q=$PIECE(RESULT,U,Z)
SET $EXTRACT(Q,1)=""
SET $PIECE(RESULT,U,Z)=Q
+23 SET SPLIT=$ORDER(^RCY(344.49,RCERA,1,"B",+RCY0_".9999"),-1)'=(+RCY0_".0001")
+24 SET Z=$SELECT(SPLIT:"CLAIM #'s: ",1:" CLAIM #: ")
+25 SET Z=Z_$PIECE(RCY0,U,2)_$SELECT('SPLIT:"",1:" (ORIGINAL ERA DATA)")
+26 IF SPLIT
Begin DoDot:2
+27 SET Q=+RCY0
FOR
SET Q=$ORDER(^RCY(344.49,RCERA,1,"B",Q))
if (Q\1)'=+RCY0
QUIT
SET Q0=+$ORDER(^RCY(344.49,RCERA,1,"B",Q,0))
SET Q0=$GET(^RCY(344.49,RCERA,1,Q0,0))
IF $PIECE(Q0,U,2)'=""
SET Z=Z_" "_$PIECE(Q0,U,2)
End DoDot:2
+28 WRITE !!!,Z
+29 WRITE !,?13,"PATIENT NAME"_$JUSTIFY("",18)_" SUBMITTED AMT SVC DATE(S)"
+30 WRITE !,?13,"------------------------------ --------------- -----------------"
+31 SET DT1=$EXTRACT($SELECT($PIECE(RESULT,U,7):$$FMTE^XLFDT($PIECE(RESULT,U,7),"2D"),1:"NOTFOUND")_$JUSTIFY("",8),1,8)
+32 SET DT2=$EXTRACT($SELECT($PIECE(RESULT,U,9):"-"_$$FMTE^XLFDT($PIECE(RESULT,U,9),"2D"),1:"-NOTFOUND")_$JUSTIFY("",9),1,9)
+33 WRITE !," ERA DATA: ",$EXTRACT($PIECE(RESULT,U,3)_$JUSTIFY("",30),1,30)," ",$EXTRACT($JUSTIFY($PIECE(RESULT,U,5),"",2)_$JUSTIFY("",15),1,15)_" "_DT1_DT2
+34 WRITE !,?15,$PIECE($GET(^RCY(344,RCERA,0)),U,6)
+35 SET DT1=$EXTRACT($SELECT($PIECE(RESULT,U,6):$$FMTE^XLFDT($PIECE(RESULT,U,6),"2D"),1:"NOTFOUND")_$JUSTIFY("",8),1,8)
+36 SET DT2=$EXTRACT($SELECT($PIECE(RESULT,U,8):"-"_$$FMTE^XLFDT($PIECE(RESULT,U,8),"2D"),1:"-NOTFOUND")_$JUSTIFY("",9),1,9)
+37 WRITE !," BILL DATA: "_$EXTRACT($PIECE(RESULT,U,2)_$JUSTIFY("",30),1,30)_" "_$EXTRACT($JUSTIFY($PIECE(RESULT,U,4),"",2)_$JUSTIFY("",15),1,15)_" "_DT1_DT2
+38 WRITE !,?15,$PIECE($GET(^DIC(36,+$PIECE(RCZ0,U,4),0)),U),!
End DoDot:1
+39 SET DIR(0)="YA"
SET DIR("A")="DO YOU WANT TO MARK THIS LINE VERIFIED? "
SET DIR("B")="NO"
WRITE !
DO ^DIR
KILL DIR
+40 ;
+41 IF Y'=1
QUIT
+42 SET DA(1)=RCERA
SET DA=+RCY
SET DIE="^RCY(344.49,"_DA(1)_",1,"
SET DR=".13////1"
DO ^DIE
+43 SET A=$$TOPLINE^RCDPEWL1($GET(^RCY(344.49,RCERA,1,+RCY,0)),RCYNUM)
+44 SET ^TMP("RCDPE-EOB_WL",$JOB,RCLINE,0)=A
+45 QUIT
+46 ;
+47 ;PRCA*4.5*304 - add a claim comment to the ERA detail line from APAR
COMNT ;
+1 NEW IEN,SEQ,DA,DIR,DTOUT,DUOUT,X,Y,DIRUT,DIROUT,ZDA,ZBILL,RCOMMENT,TCOMM
+2 SET RCOMMENT=0
+3 SET IEN=+$PIECE(RCIENS,U,1)
+4 ; Validate the selection
+5 IF IEN=0
Begin DoDot:1
+6 WRITE !,"Cannot comment, no record in file ELECTRONIC REMITTANCE ADVICE file selected."
DO WAIT^VALM1
End DoDot:1
GOTO COMQ
+7 ; Just grab the first sequence number for the comment.
SET SEQ=$PIECE(^RCY(344.49,IEN,1,+$PIECE(RCIENS,U,2),0),U,9)
+8 IF $GET(SEQ)=""
Begin DoDot:1
+9 WRITE !,"Cannot comment, no ERA detail record selected."
DO WAIT^VALM1
End DoDot:1
GOTO COMQ
+10 IF $GET(^RCY(344.4,IEN,1,SEQ,0))']""
Begin DoDot:1
+11 WRITE !,"Cannot comment, ERA detail record selected not found."
DO WAIT^VALM1
End DoDot:1
GOTO COMQ
+12 ;
+13 ; Allow user to put comment on this ERA Detail record
+14 SET ZDA=SEQ
SET ZDA(1)=IEN
SET ZBILL=$PIECE($$GETBILL^RCDPESR0(.ZDA),"-",2)
+15 WRITE !,"Enter a comment on ERA #"_IEN_" ERA Detail Seq #",SEQ," Bill #",ZBILL,!
+16 SET DIE="^RCY(344.4,"_IEN_",1,"
SET DA=SEQ
SET DA(1)=IEN
SET DR="4Comment"
DO ^DIE
if $DATA(DTOUT)!$DATA(Y)
GOTO COMQ
+17 ; Now file user (DUZ) and DATE
+18 KILL DR
+19 ; If DA is not defined then the user deleted the comment with an @,
+20 ; Delete the user and date too.
+21 SET TCOMM=$$GET1^DIQ(344.41,SEQ_","_IEN_",",4,"E")
+22 IF TCOMM=""
SET DA=SEQ
SET DA(1)=IEN
SET DR="4.01////@;4.02////@;"
+23 IF '$TEST
SET DR="4.01////"_$$DT^XLFDT_";4.02////"_$G(DUZ)_";"
+24 DO ^DIE
+25 SET RCOMMENT=1
+26 DO WAIT^VALM1
+27 ;
COMQ ;
IF RCOMMENT
DO INIT^RCDPEAA2(RCIENS)
+1 SET VALMBCK="R"
+2 QUIT
