RCDPEWL0 ;ALB/TMK/PJH - ELECTRONIC EOB WORKLIST ACTIONS ;Jun 06, 2014@19:11:19
;;4.5;Accounts Receivable;**173,208,252,269,298,317,321,326,332,409**;Mar 20, 1995;Build 17
;Per VA Directive 6402, this routine should not be modified.
Q
;
PARAMS(SOURCE) ; Retrieve/Edit/Save View Parameters for ERA Worklist
; Input: SOURCE - "MO" - Menu Option
; "CV" - Change View Action
; Output: Sort/Filtering Criteria for the worklist sent into ^TMP("RCERA_PARAMS",$J)
; ^TMP("RCERA_PARAMS",$J,"RCPOST") - ERA Posting Status ("P":Posted/"U":Unposted)
; ^TMP("RCERA_PARAMS",$J,"RCAUTOP")- Auto-Posting Queue
; ("A":Auto-Posting/"N":Non Auto-Posting/"B":Both)
; ^TMP("RCERA_PARAMS",$J,"RCAPSTA")- Auto-Posting Status ; PRCA*4.5*326
; ("M":Marked/"P":Partial/"C":Complete/"A":All)
; ^TMP("RCERA_PARAMS",$J,"RCMATCH")- ERA Matching Status ("M":Matched/"U":Unmatched)
; ^TMP("RCERA_PARAMS",$J,"RCTYPE") - ERA Claim Type ("M":Medical/"P":Pharmacy/"B":Both)
; ^TMP("RCERA_PARAMS",$J,"RCDT") - A1^A2 Where:
; A1 - ERA Received EARLIEST DATE (Range Limited Only)
; A2 - ERA Received LATEST DATE (Range Limited Only)
; ^TMP("RCERA_PARAMS",$J,"RCPAYR") - B1^B2^B3 Where:
; B1 - All Payers/Range of Payers
; ("A": All/"R":Range of Payers)
; B2 - START WITH PAYER (e.g.,'AET')
; (Range Limited Only)
; B3 - GO TO PAYER (e.g.,'AETZ') (Range Limited Only)
;
; ^TMP("RCERA_PVW",$J) - Same layout as ^TMP("RCERA_PARAMS",$J). This global contains
; the sort/filters of the user's preferred view (for ERA main page)
; while ^TMP("RCERA_PARAMS",$J) contains the sort/filters of what is
; currently displayed. They may or may not be the same values.
;
; ^TMP("RCSCRATCH_PVW",$J) - This global contains the sort/filters of the user's preferred view
; for the Scratch Pad. See PARAMS^RCDPEWLA for the layout.
;
; RCQUIT=1 if the user exited out, 0 otherwise
;
N RCXPAR,USEPVW,X,XX,Y ; PRCA*4.5*317 Added USEPVW,XX
S RCQUIT=0
;
; Ask Date Range Selection when coming straight from the menu option
I SOURCE="MO" D Q:RCQUIT
. K ^TMP("RCERA_PARAMS",$J),^TMP("RCERA_PVW",$J),^TMP("RCSCRATCH_PVW",$J)
. S RCQUIT=$$DTR() ; Set date range filter
. Q:RCQUIT
. ;
. ;Retrieve user's saved preferred view (if any)
. D GETWLPVW(.RCXPAR)
;
;Only ask user if they want to use their preferred view in the following scenarios:
; a) Source is "MO" and user has a preferred view on file
; b) Source is "CV" (change view action), user has a preferred view but is
; not using the preferred view criteria at this time.
S XX=$$PREFVW(SOURCE)
I ((XX=1)&(SOURCE="MO"))!((XX=0)&(SOURCE="CV")) D Q:USEPVW
. ;
. ; Ask the user if they want to use the preferred view
. S USEPVW=$$ASKUVW()
. I USEPVW=-1 S RCQUIT=1 Q
. Q:'USEPVW
. ;
. ; Set the Sort/Filtering Criteria from the preferred view
. M ^TMP("RCERA_PARAMS",$J)=^TMP("RCERA_PVW",$J)
;
W !!,"Select parameters for displaying the list of ERAs"
S RCQUIT=$$PARAMS2^RCDPEWLD()
Q:RCQUIT
D SAVEPVW ; Ask if they want to save as preferred view
Q
;
GETWLPVW(RCXPAR) ; Retrieves the preferred view settings for the ERA worklist
; for the user
; Input: None
; Output: RCXPAR() - Array of preferred view sort/filter criteria
; ^TMP("RCERA_PARAMS",$J)- Global array of preferred view settings
; ^TMP("RCERA_PVW") - A copy of the preferred settings (if any)
N XX
K RCXPAR
D GETLST^XPAR(.RCXPAR,"USR","RCDPE EDI LOCKBOX WORKLIST","I")
D:$D(RCXPAR("ERA_POSTING_STATUS")) PVWSAVE(.RCXPAR)
;
S XX=$G(RCXPAR("ERA_POSTING_STATUS"))
S ^TMP("RCERA_PARAMS",$J,"RCPOST")=$S(XX'="":XX,1:"U")
S XX=$G(RCXPAR("ERA_AUTO_POSTING"))
S ^TMP("RCERA_PARAMS",$J,"RCAUTOP")=$S(XX'="":XX,1:"B")
S XX=$G(RCXPAR("ERA-EFT_MATCH_STATUS"))
S ^TMP("RCERA_PARAMS",$J,"RCMATCH")=$S(XX'="":XX,1:"B")
S XX=$G(RCXPAR("ERA_CLAIM_TYPE"))
; S ^TMP("RCERA_PARAMS",$J,"RCTYPE")=$S(XX'="":XX,1:"B") ; PRCA*4.5*321
S ^TMP("RCERA_PARAMS",$J,"RCTYPE")=$S(XX'="":XX,1:"A") ; PRCA*4.5*321 change default to (A)LL
S XX=$G(RCXPAR("ALL_PAYERS/RANGE_OF_PAYERS"))
S ^TMP("RCERA_PARAMS",$J,"RCPAYR")=$S(XX'="":$TR(XX,";","^"),1:"A")
S XX=$G(RCXPAR("ERA_PAYMENT_TYPE")) ; PRCA*4.5*321 new filter
S ^TMP("RCERA_PARAMS",$J,"RCPAYMNT")=$S(XX'="":XX,1:"B") ; PRCA*4.5*321
S XX=$G(RCXPAR("AUTO-POST_STATUS")) ; PRCA*4.5*326
S ^TMP("RCERA_PARAMS",$J,"RCAPSTA")=$S(XX'="":XX,1:"A") ; PRCA*4.5*326
Q
;
PVWSAVE(RCXPAR) ; Save a copy of the preferred view on file
; PRCA*4.5*317 added subroutine
; Input: RCXPAR - array of preferred view setting for the user
; Output: ^TMP("RCERA_PVW") - a copy of the preferred settings
;
K ^TMP("RCERA_PVW",$J)
; only continue if we have answers to all ERA Worklist related preferred view prompts
Q:'$D(RCXPAR("ERA_POSTING_STATUS"))
Q:'$D(RCXPAR("ERA_AUTO_POSTING"))
Q:'$D(RCXPAR("ERA-EFT_MATCH_STATUS"))
Q:'$D(RCXPAR("ERA_CLAIM_TYPE"))
Q:'$D(RCXPAR("ALL_PAYERS/RANGE_OF_PAYERS"))
Q:'$D(RCXPAR("ERA_PAYMENT_TYPE")) ; PRCA*4.5*321
Q:'$D(RCXPAR("AUTO-POST_STATUS")) ; PRCA*4.5*326
;
S ^TMP("RCERA_PVW",$J,"RCPOST")=RCXPAR("ERA_POSTING_STATUS")
S ^TMP("RCERA_PVW",$J,"RCAUTOP")=RCXPAR("ERA_AUTO_POSTING")
S ^TMP("RCERA_PVW",$J,"RCMATCH")=RCXPAR("ERA-EFT_MATCH_STATUS")
S ^TMP("RCERA_PVW",$J,"RCTYPE")=RCXPAR("ERA_CLAIM_TYPE")
S ^TMP("RCERA_PVW",$J,"RCPAYR")=$TR(RCXPAR("ALL_PAYERS/RANGE_OF_PAYERS"),";","^")
S ^TMP("RCERA_PVW",$J,"RCPAYMNT")=RCXPAR("ERA_PAYMENT_TYPE") ; PRCA*4.5*321 new filter
S ^TMP("RCERA_PVW",$J,"RCPAPST")=RCXPAR("AUTO-POST_STATUS") ; PRCA*4.5*326
Q
;
PREFVW(SOURCE) ; Checks to see if the user has a preferred view
; PRCA*4.5*317 added subroutine
; When source is 'CV', checks to see if the preferred view is being used
; Input: SOURCE - 'MO' - When called from the Worklist menu
; option
; 'CV' - When called from the Change View
; action
;
; ^TMP("RCERA_PVW") - Global array of preferred view settings
; ^TMP("RCERA_PARAMS") - Global array of currently in use defaults
; Returns: 1 - User has preferred view if SOURCE is 'MO' or is using
; their preferred view if SOURCE is 'CV'
; 0 - User is not using their preferred view
; -1 - User does not have a preferred view
I SOURCE="MO" Q $S($D(^TMP("RCERA_PVW",$J)):1,1:-1)
Q:'$D(^TMP("RCERA_PVW",$J)) -1 ; No stored preferred view
Q:$G(^TMP("RCERA_PARAMS",$J,"RCPOST"))'=$G(^TMP("RCERA_PVW",$J,"RCPOST")) 0
Q:$G(^TMP("RCERA_PARAMS",$J,"RCAUTOP"))'=$G(^TMP("RCERA_PVW",$J,"RCAUTOP")) 0
Q:$G(^TMP("RCERA_PARAMS",$J,"RCMATCH"))'=$G(^TMP("RCERA_PVW",$J,"RCMATCH")) 0
Q:$G(^TMP("RCERA_PARAMS",$J,"RCTYPE"))'=$G(^TMP("RCERA_PVW",$J,"RCTYPE")) 0
Q:$G(^TMP("RCERA_PARAMS",$J,"RCPAYR"))'=$G(^TMP("RCERA_PVW",$J,"RCPAYR")) 0
Q:$G(^TMP("RCERA_PARAMS",$J,"RCPAYMNT"))'=$G(^TMP("RCERA_PVW",$J,"RCPAYMNT")) 0 ; PRCA*4.5*321
Q:$G(^TMP("RCERA_PARAMS",$J,"RCAPSTA"))'=$G(^TMP("RCERA_PVW",$J,"RCAPSTA")) 0 ; PRCA*4.5*326
Q 1
;
ASKUVW() ;EP from PARAMS^RCDPEWLA, PARAMS^RCDPEAA1
; Prompts the user to see if they want to use their preferred view
; PRCA*4.5*317 added function
; Input: None
; Returns: 1 - User wants to use their preferred view
; 0 - User does not want to use their preferred view
; -1 - User typed '^'
N DIR,DTOUT,DUOUT
S DIR(0)="Y"
S DIR("A")="Use preferred view"
S DIR("B")="N"
W !
D ^DIR
I $D(DTOUT)!$D(DUOUT) Q -1
Q:Y 1 ; response is YES
Q 0
;
SAVEPVW ; Option to save as User Preferred View
; PRCA*4.5*317 added subroutine
; Input: ^TMP("RCERA_PARAMS") - Global array of current worklist settings
; Output Current worklist settings set as preferred view (potentially)
N DIR,DTOUT,DUOUT,RCERROR,XX
K DIR
S DIR(0)="YA",DIR("B")="NO"
S DIR("A")="Do you want to save this as your preferred view (Y/N)? "
W !
D ^DIR
Q:Y'=1
S XX=^TMP("RCERA_PARAMS",$J,"RCPOST")
D EN^XPAR(DUZ_";VA(200,","RCDPE EDI LOCKBOX WORKLIST","ERA_POSTING_STATUS",XX,.RCERROR)
S XX=^TMP("RCERA_PARAMS",$J,"RCAUTOP")
D EN^XPAR(DUZ_";VA(200,","RCDPE EDI LOCKBOX WORKLIST","ERA_AUTO_POSTING",XX,.RCERROR)
S XX=^TMP("RCERA_PARAMS",$J,"RCMATCH")
D EN^XPAR(DUZ_";VA(200,","RCDPE EDI LOCKBOX WORKLIST","ERA-EFT_MATCH_STATUS",XX,.RCERROR)
S XX=^TMP("RCERA_PARAMS",$J,"RCTYPE")
D EN^XPAR(DUZ_";VA(200,","RCDPE EDI LOCKBOX WORKLIST","ERA_CLAIM_TYPE",XX,.RCERROR)
S XX=$TR(^TMP("RCERA_PARAMS",$J,"RCPAYR"),"^",";")
D EN^XPAR(DUZ_";VA(200,","RCDPE EDI LOCKBOX WORKLIST","ALL_PAYERS/RANGE_OF_PAYERS",XX,.RCERROR)
S XX=^TMP("RCERA_PARAMS",$J,"RCPAYMNT") ; PRCA*4.5*321
D EN^XPAR(DUZ_";VA(200,","RCDPE EDI LOCKBOX WORKLIST","ERA_PAYMENT_TYPE",XX,.RCERROR) ; PRCA*4.5*321
S XX=$TR(^TMP("RCERA_PARAMS",$J,"RCAPSTA"),"^",";") ; PRCA*4.5*326
D EN^XPAR(DUZ_";VA(200,","RCDPE EDI LOCKBOX WORKLIST","AUTO-POST_STATUS",XX,.RCERROR) ; PRCA*4.5*326
;
K ^TMP("RCERA_PVW",$J)
M ^TMP("RCERA_PVW",$J)=^TMP("RCERA_PARAMS",$J) ; capture new preferred settings for comparison
Q
;
DTR() ; Date Range Selection
; Input: ^TMP("RCERA_PARAMS",$J,"RCDT") - Current selected Date Range (if any)
; Output: ^TMP("RCERA_PARAMS",$J,"RCDT") - Updated Selected Date Range
; Returns: 1 if user quit or timed out, 0 otherwise
DTR1 ;
N DIR,DTOUT,DTQUIT,DUOUT,Y,FROM,TO,RCDTRNG
S ^TMP("RCERA_PARAMS",$J,"RCDT")="0^"_DT
K DIR S DIR(0)="YA"
S DIR("A")="Limit the selection to a date range when the ERA was received?: "
S DIR("B")="NO"
S DIR("?")="Enter YES to specify a date range filter."
W !
D ^DIR
I $D(DTOUT)!$D(DUOUT) Q 1
I Y D G:DTQUIT DTR1
. S DTQUIT=0
. S FROM=$P($G(^TMP("RCERA_PARAMS",$J,"RCDT")),"^",1)
. S TO=$P($G(^TMP("RCERA_PARAMS",$J,"RCDT")),"^",2)
. W !
. S RCDTRNG=$$DTRANGE(FROM,TO)
. I RCDTRNG="^" S DTQUIT=1 Q
. S ^TMP("RCERA_PARAMS",$J,"RCDT")=RCDTRNG
Q 0
;
DTRANGE(DEFFROM,DEFTO) ; Asks for and returns a Date Range
; Input: DEFFROM - Default FROM date
; DEFTO - Default TO date
;Output: From_Date^To_Date (YYYMMDD^YYYDDMM) or "^" (timeout or ^ entered)
;
N DIR,Y,DTOUT,DUOUT,RCDFR,START
S RCQUIT=0
S DIR(0)="DAE^:"_DT_":E"
S DIR("A")="Earliest date: "
S DIR("?")="Enter the start of the date range."
S:($G(DEFFROM)) DIR("B")=$$FMTE^XLFDT(DEFFROM,2)
D ^DIR
I $D(DTOUT)!$D(DUOUT) Q "^"
S RCDFR=Y,START=$$FMTE^XLFDT(RCDFR,"2DZ")
K DIR
S DIR(0)="DAE^"_RCDFR_":"_DT_":E"
S DIR("A")="Latest date: "
S DIR("?",1)="Enter the end of the date range. The ending date must be greater than "
S DIR("?")="or equal to "_START_"."
S:($G(DEFTO)) DIR("B")=$$FMTE^XLFDT(DEFTO,2)
D ^DIR
I $D(DTOUT)!$D(DUOUT) Q "^"
Q (RCDFR_"^"_Y)
;
SPLIT ; Split line in ERA list
; input - RCSCR = ien of 344.49 and 344.4
N RCLINE,RCZ,RCDA,Q,Q0,Z,Z0,DIR,X,Y,CT,L,L1,RCONE,RCQUIT
D FULL^VALM1
I $S($P($G(^RCY(344.4,RCSCR,4)),U,2)]"":1,1:0) D NOEDIT^RCDPEWLP G SPLITQ ;prca*4.5*298 auto-posted ERAs cannot enter Split/Edit action
I $G(RCSCR("NOEDIT")) D NOEDIT^RCDPEWL G SPLITQ
W !!,"Select the entry that has a line you need to Split/Edit",!
D SEL^RCDPEWL(.RCDA)
S Z=+$O(RCDA(0)) G:'$G(RCDA(Z)) SPLITQ
S RCLINE=+RCDA(Z),Z0=+$O(^TMP("RCDPE-EOB_WLDX",$J,Z_".999"),-1)
S RCZ=Z F S RCZ=$O(^TMP("RCDPE-EOB_WLDX",$J,RCZ)) Q:'RCZ!(RCZ\1'=Z) D
. S Q=$P($G(^TMP("RCDPE-EOB_WLDX",$J,RCZ)),U,2)
. Q:'Q
. S RCZ(RCZ)=Q
. S Q0=0 F S Q0=$O(^RCY(344.49,RCSCR,1,Q,1,Q0)) Q:'Q0 I "01"[$P($G(^(Q0,0)),U,2) K RCZ(RCZ) Q
I '$O(RCZ(0)) D G SPLITQ
. S DIR(0)="EA",DIR("A",1)="This entry has no lines available to Edit/Split",DIR("A")="PRESS RETURN TO CONTINUE " W ! D ^DIR K DIR
S RCQUIT=0
I $P($G(^RCY(344.49,RCSCR,1,RCLINE,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
S CT=0,CT=CT+1,DIR("?",CT)="Enter the line # that you want to split or edit:",RCONE=1
S L=Z F S L=$O(RCZ(L)) Q:'L D
. S L1=+$G(^TMP("RCDPE-EOB_WLDX",$J,L))
. S CT=CT+1
. S DIR("?",CT)=$G(^TMP("RCDPE-EOB_WL",$J,L1,0)),CT=CT+1,DIR("?",CT)=$G(^TMP("RCDPE-EOB_WL",$J,L1+1,0)) S RCONE(1)=$S(RCONE:L,1:"") S RCONE=0
S DIR("?")=" ",Y=-1
I $G(RCONE(1)) S Y=+RCONE(1) K DIR G:'Y SPLITQ
I '$G(RCONE(1)) D K DIR I $D(DTOUT)!$D(DUOUT)!(Y\1'=Z) G SPLITQ
. F S DIR(0)="NAO^"_(Z+.001)_":"_Z0_":3",DIR("A")="Which line of entry "_Z_" do you want to Split/Edit?: " S:$G(RCONE(1))'="" DIR("B")=RCONE(1) D ^DIR Q:'Y!$D(DUOUT)!$D(DTOUT) D Q:Y>0
.. I '$D(^TMP("RCDPE-EOB_WLDX",$J,Y)) W !!,"Line "_Y_" does NOT exist - TRY AGAIN",! S Y=-1 Q
.. I '$D(RCZ(Y)) W !!,"Line "_Y_" has been used in a DISTRIBUTE ADJ action and can't be edited",! S Y=-1 Q
.. S Q=+$O(^RCY(344.49,RCSCR,1,"B",Y,0))
;
K ^TMP("RCDPE_SPLIT_REBLD",$J)
D SPLIT^RCDPEWL3(RCSCR,+Y)
I $G(^TMP("RCDPE_SPLIT_REBLD",$J)) K ^TMP("RCDPE_SPLIT_REBLD",$J) D BLD^RCDPEWL1($G(^TMP($J,"RC_SORTPARM")))
;
SPLITQ S VALMBCK="R"
Q
;
PRTERA ; EP from menu option View/Print ERA (VP) [RCDPE VIEW/PRINT ERA]
; View the selected ERA in a listman template
; Input: RCSCR - IEN of the ERA to be viewed
N DIC,RCSCR,X,Y
S DIC="^RCY(344.4,",DIC(0)="AEMQ"
D ^DIC
Q:Y'>0
S RCSCR=+Y
D PRERA1
Q
;
PRERA ; RCSCR is assumed to be defined
D FULL^VALM1 ; Protocol entry
PRERA1 ; Option entry
N DIR,X,Y,RCERADET,RCLSTMGR,POP,ZTRTN,ZTSAVE,ZTDESC,%ZIS ; PRCA*4.5*332
D EXCWARN^RCDPEWLP(RCSCR)
S DIR("?",1)="Including expanded detail will significantly increase the size of this report",DIR("?",2)="IF YOU CHOOSE TO INCLUDE IT, ALL PAYMENT DETAILS FOR EACH EEOB WILL BE"
S DIR("?")="listed. If you want just summary data for each EEOB, do NOT include it."
S DIR(0)="YA",DIR("A")="Do you want to include expanded EEOB detail?: ",DIR("B")="NO"
W !
D ^DIR
K DIR
I $D(DUOUT)!$D(DTOUT) G PRERAQ
S RCERADET=+Y
S RCLSTMGR=$$ASKLM^RCDPEARL(1) ; PRCA*4.5*332
I RCLSTMGR=-1 G PRERAQ ; PRCA*4.5*332
I RCLSTMGR D VPERA(RCSCR,RCERADET,1) Q ; PRCA*4.5*332
S %ZIS="QM" D ^%ZIS G:POP PRERAQ
I $D(IO("Q")) D G PRERAQ
. S ZTRTN="VPERA^RCDPEWL0("_RCSCR_","_RCERADET_",0)",ZTDESC="AR - Print ERA From Worklist"
. D ^%ZTLOAD
. W !!,$S($D(ZTSK):"Your task # "_ZTSK_" has been queued.",1:"Unable to queue this job.")
. K ZTSK,IO("Q") D HOME^%ZIS
U IO
D VPERA(RCSCR,RCERADET,0) ; PRCA*4.5*332
Q
;
VPERA(RCSCR,RCERADET,LSTMGR) ; Queued entry
; Input: RCSCR - IEN of ERA to be viewed (#344.4)
; RCERADET - 1 if inclusion of all EOB details from file 361.1 is
; desired, 0 if not
; LSTMGR - 1 display in list manager, 0 otherwise
N RC,RCDIQ,RCDIQ1,RCDIQ2,RCDOT,RCPG,RCSCR1,RC3611,RCXM1,RCZ,RC3611,XX,Z,Z0
K ^TMP($J,"RC_SUMRAW"),^TMP($J,"RC_SUMOUT"),^TMP($J,"RC_SUMALL")
S (RCSTOP,RCPG)=0,RCDOT="",$P(RCDOT,".",79)=""
D GETS^DIQ(344.4,RCSCR_",","*","IEN","RCDIQ")
D TXT0^RCDPEX31(RCSCR,.RCDIQ,.RCXM1,.RC) ; Get top level 0-node captioned flds
I $O(^RCY(344.4,RCSCR,2,0)) S RC=RC+1,RCXM1(RC)=" **ERA LEVEL ADJUSTMENTS**"
S RCSCR1=0 F S RCSCR1=$O(^RCY(344.4,RCSCR,2,RCSCR1)) Q:'RCSCR1 D
. K RCDIQ2
. D GETS^DIQ(344.42,RCSCR1_","_RCSCR_",","*","IEN","RCDIQ2")
. D TXT2^RCDPEX31(RCSCR,RCSCR1,.RCDIQ2,.RCXM1,.RC) ; Get top level ERA adjs
;
; PRCA*4.5*409 - Add header and PLB information to print array so it will display
; even when there are no claim lines.
I '$O(^RCY(344.4,RCSCR,1,0)) D
. S RC=RC+1,RCXM1(RC)=" **NO ERA DETAIL PRESENT**"
S Z0=+$O(^TMP($J,"RC_SUMALL"," "),-1)
S Z=0 F S Z=$O(RCXM1(Z)) Q:'Z S Z0=Z0+1,^TMP($J,"RC_SUMALL",Z0)=RCXM1(Z)
K RCXM1 S RC=0
;
; PRCA*4.5*409 - End modified code block
S RCSCR1=0 F S RCSCR1=$O(^RCY(344.4,RCSCR,1,RCSCR1)) Q:'RCSCR1 D
. K RCDIQ1
. D GETS^DIQ(344.41,RCSCR1_","_RCSCR_",","*","IE","RCDIQ1") ;PRCA*4.5*298 need to retrieve all fields even if null (changed "IEN" to "IE")
. D TXT00^RCDPEX31(RCSCR,RCSCR1,.RCDIQ1,.RCXM1,.RC)
. ;HIPAA 5010
. N PNAME4
. S PNAME4=$$PNM4^RCDPEWL1(RCSCR,RCSCR1)
. I $L(PNAME4)<32 D
. .S RC=RC+1,RCXM1(RC-1)=$E("PATIENT: "_PNAME4_$J("",41),1,41)_"CLAIM #: "_$$BILLREF^RCDPESR0(RCSCR,RCSCR1),RCXM1(RC)=" "
. I $L(PNAME4)>31 D
. .S RC=RC+1,RCXM1(RC-1)=$J("",41)_"CLAIM #: "_$$BILLREF^RCDPESR0(RCSCR,RCSCR1)
. .S RC=RC+1,RCXM1(RC-1)=$E("PATIENT: "_PNAME4,1,78),RCXM1(RC)=" "
. D PROV^RCDPEWLD(RCSCR,RCSCR1,.RCXM1,.RC)
. S RC3611=$P($G(^RCY(344.4,RCSCR,1,RCSCR1,0)),U,2)
. I RCERADET D
.. I 'RC3611 D Q
... D DISP^RCDPESR0("^RCY(344.4,"_RCSCR_",1,"_RCSCR1_",1)","^TMP($J,""RC_SUMRAW"")",1,"^TMP($J,""RC_SUMOUT"")",75,1)
..;
.. E D ; Detail record is in 361.1
... K ^TMP("PRCA_EOB",$J)
... D GETEOB^IBCECSA6(RC3611,2)
... I $O(^IBM(361.1,RC3611,"ERR",0)) D GETERR^RCDPEDS(RC3611,+$O(^TMP("PRCA_EOB",$J,RC3611," "),-1)) ; get filing errors
... S Z=0 F S Z=$O(^TMP("PRCA_EOB",$J,RC3611,Z)) Q:'Z S RC=RC+1,^TMP($J,"RC_SUMOUT",RC)=$G(^TMP("PRCA_EOB",$J,RC3611,Z))
... S RC=RC+2,^TMP($J,"RC_SUMOUT",RC-1)=" ",^TMP($J,"RC_SUMOUT",RC)=" "
... K ^TMP("PRCA_EOB",$J)
. I $D(RCDIQ1(344.41,RCSCR1_","_RCSCR_",",2)) D
.. S RC=RC+1,RCXM1(RC)=" **EXCEPTION RESOLUTION LOG DATA**"
.. S Z=0 F S Z=$O(RCDIQ1(344.41,RCSCR1_","_RCSCR_",",2,Z)) Q:'Z S RC=RC+1,RCXM1(RC)=RCDIQ1(344.41,RCSCR1_","_RCSCR_",",2,Z)
. S RC=RC+1,RCXM1(RC)=" "
. S Z0=+$O(^TMP($J,"RC_SUMALL"," "),-1)
. S Z=0 F S Z=$O(RCXM1(Z)) Q:'Z S Z0=Z0+1,^TMP($J,"RC_SUMALL",Z0)=RCXM1(Z)
. K RCXM1 S RC=0
. S Z=0 F S Z=$O(^TMP($J,"RC_SUMOUT",Z)) Q:'Z S Z0=Z0+1,^TMP($J,"RC_SUMALL",Z0)=$G(^TMP($J,"RC_SUMOUT",Z))
I LSTMGR D DOLSTMAN,PRERAQ Q ; PRCA*4.5*332
S RCSTOP=0,Z=""
F S Z=$O(^TMP($J,"RC_SUMALL",Z)) Q:'Z D Q:RCSTOP
. I $D(ZTQUEUED),$$S^%ZTLOAD S (RCSTOP,ZTSTOP)=1 K ZTREQ I +$G(RCPG) W !!,"***TASK STOPPED BY USER***" Q
. I 'RCPG!(($Y+5)>IOSL) D I RCSTOP Q
.. D:RCPG ASK(.RCSTOP) I RCSTOP Q
.. D HDR(.RCPG)
. W !,$G(^TMP($J,"RC_SUMALL",Z))
;
I 'RCSTOP,RCPG D ASK(.RCSTOP)
;
I $D(ZTQUEUED) S ZTREQ="@"
I '$D(ZTQUEUED) D ^%ZISC
;
PRERAQ K ^TMP($J,"RC_SUMRAW"),^TMP($J,"RC_SUMOUT"),^TMP($J,"SUMALL")
S VALMBCK="R"
Q
; PRCA*4.5*332 - Subroutine added
DOLSTMAN ; Display the ERA Detail in a listman format
N HDR
S HDR("TITLE")="VIEW ERA DETAIL"
D LMRPT^RCDPEARL(.HDR,$NA(^TMP($J,"RC_SUMALL")),"RCDPE VIEW ERA DETAIL") ; generate ListMan display
Q
;
HDR(RCPG) ;Report hdr
; RCPG = last page #
I RCPG!($E(IOST,1,2)="C-") W @IOF,*13
S RCPG=$G(RCPG)+1
W !,?5,"EDI LOCKBOX WORKLIST - ERA DETAIL",?55,$$FMTE^XLFDT(DT,2),?70,"Page: ",RCPG,!,$TR($J("",IOM)," ","=")
Q
;
ASK(RCSTOP) ;
I $E(IOST,1,2)'["C-" Q
N DIR,DIROUT,DIRUT,DTOUT,DUOUT
S DIR(0)="E" W ! D ^DIR
I ($D(DIRUT))!($D(DUOUT)) S RCSTOP=1 Q
Q
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HRCDPEWL0 19713 printed Apr 09, 2024@20:46:36 Page 2
RCDPEWL0 ;ALB/TMK/PJH - ELECTRONIC EOB WORKLIST ACTIONS ;Jun 06, 2014@19:11:19
+1 ;;4.5;Accounts Receivable;**173,208,252,269,298,317,321,326,332,409**;Mar 20, 1995;Build 17
+2 ;Per VA Directive 6402, this routine should not be modified.
+3 QUIT
+4 ;
PARAMS(SOURCE) ; Retrieve/Edit/Save View Parameters for ERA Worklist
+1 ; Input: SOURCE - "MO" - Menu Option
+2 ; "CV" - Change View Action
+3 ; Output: Sort/Filtering Criteria for the worklist sent into ^TMP("RCERA_PARAMS",$J)
+4 ; ^TMP("RCERA_PARAMS",$J,"RCPOST") - ERA Posting Status ("P":Posted/"U":Unposted)
+5 ; ^TMP("RCERA_PARAMS",$J,"RCAUTOP")- Auto-Posting Queue
+6 ; ("A":Auto-Posting/"N":Non Auto-Posting/"B":Both)
+7 ; ^TMP("RCERA_PARAMS",$J,"RCAPSTA")- Auto-Posting Status ; PRCA*4.5*326
+8 ; ("M":Marked/"P":Partial/"C":Complete/"A":All)
+9 ; ^TMP("RCERA_PARAMS",$J,"RCMATCH")- ERA Matching Status ("M":Matched/"U":Unmatched)
+10 ; ^TMP("RCERA_PARAMS",$J,"RCTYPE") - ERA Claim Type ("M":Medical/"P":Pharmacy/"B":Both)
+11 ; ^TMP("RCERA_PARAMS",$J,"RCDT") - A1^A2 Where:
+12 ; A1 - ERA Received EARLIEST DATE (Range Limited Only)
+13 ; A2 - ERA Received LATEST DATE (Range Limited Only)
+14 ; ^TMP("RCERA_PARAMS",$J,"RCPAYR") - B1^B2^B3 Where:
+15 ; B1 - All Payers/Range of Payers
+16 ; ("A": All/"R":Range of Payers)
+17 ; B2 - START WITH PAYER (e.g.,'AET')
+18 ; (Range Limited Only)
+19 ; B3 - GO TO PAYER (e.g.,'AETZ') (Range Limited Only)
+20 ;
+21 ; ^TMP("RCERA_PVW",$J) - Same layout as ^TMP("RCERA_PARAMS",$J). This global contains
+22 ; the sort/filters of the user's preferred view (for ERA main page)
+23 ; while ^TMP("RCERA_PARAMS",$J) contains the sort/filters of what is
+24 ; currently displayed. They may or may not be the same values.
+25 ;
+26 ; ^TMP("RCSCRATCH_PVW",$J) - This global contains the sort/filters of the user's preferred view
+27 ; for the Scratch Pad. See PARAMS^RCDPEWLA for the layout.
+28 ;
+29 ; RCQUIT=1 if the user exited out, 0 otherwise
+30 ;
+31 ; PRCA*4.5*317 Added USEPVW,XX
NEW RCXPAR,USEPVW,X,XX,Y
+32 SET RCQUIT=0
+33 ;
+34 ; Ask Date Range Selection when coming straight from the menu option
+35 IF SOURCE="MO"
Begin DoDot:1
+36 KILL ^TMP("RCERA_PARAMS",$JOB),^TMP("RCERA_PVW",$JOB),^TMP("RCSCRATCH_PVW",$JOB)
+37 ; Set date range filter
SET RCQUIT=$$DTR()
+38 if RCQUIT
QUIT
+39 ;
+40 ;Retrieve user's saved preferred view (if any)
+41 DO GETWLPVW(.RCXPAR)
End DoDot:1
if RCQUIT
QUIT
+42 ;
+43 ;Only ask user if they want to use their preferred view in the following scenarios:
+44 ; a) Source is "MO" and user has a preferred view on file
+45 ; b) Source is "CV" (change view action), user has a preferred view but is
+46 ; not using the preferred view criteria at this time.
+47 SET XX=$$PREFVW(SOURCE)
+48 IF ((XX=1)&(SOURCE="MO"))!((XX=0)&(SOURCE="CV"))
Begin DoDot:1
+49 ;
+50 ; Ask the user if they want to use the preferred view
+51 SET USEPVW=$$ASKUVW()
+52 IF USEPVW=-1
SET RCQUIT=1
QUIT
+53 if 'USEPVW
QUIT
+54 ;
+55 ; Set the Sort/Filtering Criteria from the preferred view
+56 MERGE ^TMP("RCERA_PARAMS",$JOB)=^TMP("RCERA_PVW",$JOB)
End DoDot:1
if USEPVW
QUIT
+57 ;
+58 WRITE !!,"Select parameters for displaying the list of ERAs"
+59 SET RCQUIT=$$PARAMS2^RCDPEWLD()
+60 if RCQUIT
QUIT
+61 ; Ask if they want to save as preferred view
DO SAVEPVW
+62 QUIT
+63 ;
GETWLPVW(RCXPAR) ; Retrieves the preferred view settings for the ERA worklist
+1 ; for the user
+2 ; Input: None
+3 ; Output: RCXPAR() - Array of preferred view sort/filter criteria
+4 ; ^TMP("RCERA_PARAMS",$J)- Global array of preferred view settings
+5 ; ^TMP("RCERA_PVW") - A copy of the preferred settings (if any)
+6 NEW XX
+7 KILL RCXPAR
+8 DO GETLST^XPAR(.RCXPAR,"USR","RCDPE EDI LOCKBOX WORKLIST","I")
+9 if $DATA(RCXPAR("ERA_POSTING_STATUS"))
DO PVWSAVE(.RCXPAR)
+10 ;
+11 SET XX=$GET(RCXPAR("ERA_POSTING_STATUS"))
+12 SET ^TMP("RCERA_PARAMS",$JOB,"RCPOST")=$SELECT(XX'="":XX,1:"U")
+13 SET XX=$GET(RCXPAR("ERA_AUTO_POSTING"))
+14 SET ^TMP("RCERA_PARAMS",$JOB,"RCAUTOP")=$SELECT(XX'="":XX,1:"B")
+15 SET XX=$GET(RCXPAR("ERA-EFT_MATCH_STATUS"))
+16 SET ^TMP("RCERA_PARAMS",$JOB,"RCMATCH")=$SELECT(XX'="":XX,1:"B")
+17 SET XX=$GET(RCXPAR("ERA_CLAIM_TYPE"))
+18 ; S ^TMP("RCERA_PARAMS",$J,"RCTYPE")=$S(XX'="":XX,1:"B") ; PRCA*4.5*321
+19 ; PRCA*4.5*321 change default to (A)LL
SET ^TMP("RCERA_PARAMS",$JOB,"RCTYPE")=$SELECT(XX'="":XX,1:"A")
+20 SET XX=$GET(RCXPAR("ALL_PAYERS/RANGE_OF_PAYERS"))
+21 SET ^TMP("RCERA_PARAMS",$JOB,"RCPAYR")=$SELECT(XX'="":$TRANSLATE(XX,";","^"),1:"A")
+22 ; PRCA*4.5*321 new filter
SET XX=$GET(RCXPAR("ERA_PAYMENT_TYPE"))
+23 ; PRCA*4.5*321
SET ^TMP("RCERA_PARAMS",$JOB,"RCPAYMNT")=$SELECT(XX'="":XX,1:"B")
+24 ; PRCA*4.5*326
SET XX=$GET(RCXPAR("AUTO-POST_STATUS"))
+25 ; PRCA*4.5*326
SET ^TMP("RCERA_PARAMS",$JOB,"RCAPSTA")=$SELECT(XX'="":XX,1:"A")
+26 QUIT
+27 ;
PVWSAVE(RCXPAR) ; Save a copy of the preferred view on file
+1 ; PRCA*4.5*317 added subroutine
+2 ; Input: RCXPAR - array of preferred view setting for the user
+3 ; Output: ^TMP("RCERA_PVW") - a copy of the preferred settings
+4 ;
+5 KILL ^TMP("RCERA_PVW",$JOB)
+6 ; only continue if we have answers to all ERA Worklist related preferred view prompts
+7 if '$DATA(RCXPAR("ERA_POSTING_STATUS"))
QUIT
+8 if '$DATA(RCXPAR("ERA_AUTO_POSTING"))
QUIT
+9 if '$DATA(RCXPAR("ERA-EFT_MATCH_STATUS"))
QUIT
+10 if '$DATA(RCXPAR("ERA_CLAIM_TYPE"))
QUIT
+11 if '$DATA(RCXPAR("ALL_PAYERS/RANGE_OF_PAYERS"))
QUIT
+12 ; PRCA*4.5*321
if '$DATA(RCXPAR("ERA_PAYMENT_TYPE"))
QUIT
+13 ; PRCA*4.5*326
if '$DATA(RCXPAR("AUTO-POST_STATUS"))
QUIT
+14 ;
+15 SET ^TMP("RCERA_PVW",$JOB,"RCPOST")=RCXPAR("ERA_POSTING_STATUS")
+16 SET ^TMP("RCERA_PVW",$JOB,"RCAUTOP")=RCXPAR("ERA_AUTO_POSTING")
+17 SET ^TMP("RCERA_PVW",$JOB,"RCMATCH")=RCXPAR("ERA-EFT_MATCH_STATUS")
+18 SET ^TMP("RCERA_PVW",$JOB,"RCTYPE")=RCXPAR("ERA_CLAIM_TYPE")
+19 SET ^TMP("RCERA_PVW",$JOB,"RCPAYR")=$TRANSLATE(RCXPAR("ALL_PAYERS/RANGE_OF_PAYERS"),";","^")
+20 ; PRCA*4.5*321 new filter
SET ^TMP("RCERA_PVW",$JOB,"RCPAYMNT")=RCXPAR("ERA_PAYMENT_TYPE")
+21 ; PRCA*4.5*326
SET ^TMP("RCERA_PVW",$JOB,"RCPAPST")=RCXPAR("AUTO-POST_STATUS")
+22 QUIT
+23 ;
PREFVW(SOURCE) ; Checks to see if the user has a preferred view
+1 ; PRCA*4.5*317 added subroutine
+2 ; When source is 'CV', checks to see if the preferred view is being used
+3 ; Input: SOURCE - 'MO' - When called from the Worklist menu
+4 ; option
+5 ; 'CV' - When called from the Change View
+6 ; action
+7 ;
+8 ; ^TMP("RCERA_PVW") - Global array of preferred view settings
+9 ; ^TMP("RCERA_PARAMS") - Global array of currently in use defaults
+10 ; Returns: 1 - User has preferred view if SOURCE is 'MO' or is using
+11 ; their preferred view if SOURCE is 'CV'
+12 ; 0 - User is not using their preferred view
+13 ; -1 - User does not have a preferred view
+14 IF SOURCE="MO"
QUIT $SELECT($DATA(^TMP("RCERA_PVW",$JOB)):1,1:-1)
+15 ; No stored preferred view
if '$DATA(^TMP("RCERA_PVW",$JOB))
QUIT -1
+16 if $GET(^TMP("RCERA_PARAMS",$JOB,"RCPOST"))'=$GET(^TMP("RCERA_PVW",$JOB,"RCPOST"))
QUIT 0
+17 if $GET(^TMP("RCERA_PARAMS",$JOB,"RCAUTOP"))'=$GET(^TMP("RCERA_PVW",$JOB,"RCAUTOP"))
QUIT 0
+18 if $GET(^TMP("RCERA_PARAMS",$JOB,"RCMATCH"))'=$GET(^TMP("RCERA_PVW",$JOB,"RCMATCH"))
QUIT 0
+19 if $GET(^TMP("RCERA_PARAMS",$JOB,"RCTYPE"))'=$GET(^TMP("RCERA_PVW",$JOB,"RCTYPE"))
QUIT 0
+20 if $GET(^TMP("RCERA_PARAMS",$JOB,"RCPAYR"))'=$GET(^TMP("RCERA_PVW",$JOB,"RCPAYR"))
QUIT 0
+21 ; PRCA*4.5*321
if $GET(^TMP("RCERA_PARAMS",$JOB,"RCPAYMNT"))'=$GET(^TMP("RCERA_PVW",$JOB,"RCPAYMNT"))
QUIT 0
+22 ; PRCA*4.5*326
if $GET(^TMP("RCERA_PARAMS",$JOB,"RCAPSTA"))'=$GET(^TMP("RCERA_PVW",$JOB,"RCAPSTA"))
QUIT 0
+23 QUIT 1
+24 ;
ASKUVW() ;EP from PARAMS^RCDPEWLA, PARAMS^RCDPEAA1
+1 ; Prompts the user to see if they want to use their preferred view
+2 ; PRCA*4.5*317 added function
+3 ; Input: None
+4 ; Returns: 1 - User wants to use their preferred view
+5 ; 0 - User does not want to use their preferred view
+6 ; -1 - User typed '^'
+7 NEW DIR,DTOUT,DUOUT
+8 SET DIR(0)="Y"
+9 SET DIR("A")="Use preferred view"
+10 SET DIR("B")="N"
+11 WRITE !
+12 DO ^DIR
+13 IF $DATA(DTOUT)!$DATA(DUOUT)
QUIT -1
+14 ; response is YES
if Y
QUIT 1
+15 QUIT 0
+16 ;
SAVEPVW ; Option to save as User Preferred View
+1 ; PRCA*4.5*317 added subroutine
+2 ; Input: ^TMP("RCERA_PARAMS") - Global array of current worklist settings
+3 ; Output Current worklist settings set as preferred view (potentially)
+4 NEW DIR,DTOUT,DUOUT,RCERROR,XX
+5 KILL DIR
+6 SET DIR(0)="YA"
SET DIR("B")="NO"
+7 SET DIR("A")="Do you want to save this as your preferred view (Y/N)? "
+8 WRITE !
+9 DO ^DIR
+10 if Y'=1
QUIT
+11 SET XX=^TMP("RCERA_PARAMS",$JOB,"RCPOST")
+12 DO EN^XPAR(DUZ_";VA(200,","RCDPE EDI LOCKBOX WORKLIST","ERA_POSTING_STATUS",XX,.RCERROR)
+13 SET XX=^TMP("RCERA_PARAMS",$JOB,"RCAUTOP")
+14 DO EN^XPAR(DUZ_";VA(200,","RCDPE EDI LOCKBOX WORKLIST","ERA_AUTO_POSTING",XX,.RCERROR)
+15 SET XX=^TMP("RCERA_PARAMS",$JOB,"RCMATCH")
+16 DO EN^XPAR(DUZ_";VA(200,","RCDPE EDI LOCKBOX WORKLIST","ERA-EFT_MATCH_STATUS",XX,.RCERROR)
+17 SET XX=^TMP("RCERA_PARAMS",$JOB,"RCTYPE")
+18 DO EN^XPAR(DUZ_";VA(200,","RCDPE EDI LOCKBOX WORKLIST","ERA_CLAIM_TYPE",XX,.RCERROR)
+19 SET XX=$TRANSLATE(^TMP("RCERA_PARAMS",$JOB,"RCPAYR"),"^",";")
+20 DO EN^XPAR(DUZ_";VA(200,","RCDPE EDI LOCKBOX WORKLIST","ALL_PAYERS/RANGE_OF_PAYERS",XX,.RCERROR)
+21 ; PRCA*4.5*321
SET XX=^TMP("RCERA_PARAMS",$JOB,"RCPAYMNT")
+22 ; PRCA*4.5*321
DO EN^XPAR(DUZ_";VA(200,","RCDPE EDI LOCKBOX WORKLIST","ERA_PAYMENT_TYPE",XX,.RCERROR)
+23 ; PRCA*4.5*326
SET XX=$TRANSLATE(^TMP("RCERA_PARAMS",$JOB,"RCAPSTA"),"^",";")
+24 ; PRCA*4.5*326
DO EN^XPAR(DUZ_";VA(200,","RCDPE EDI LOCKBOX WORKLIST","AUTO-POST_STATUS",XX,.RCERROR)
+25 ;
+26 KILL ^TMP("RCERA_PVW",$JOB)
+27 ; capture new preferred settings for comparison
MERGE ^TMP("RCERA_PVW",$JOB)=^TMP("RCERA_PARAMS",$JOB)
+28 QUIT
+29 ;
DTR() ; Date Range Selection
+1 ; Input: ^TMP("RCERA_PARAMS",$J,"RCDT") - Current selected Date Range (if any)
+2 ; Output: ^TMP("RCERA_PARAMS",$J,"RCDT") - Updated Selected Date Range
+3 ; Returns: 1 if user quit or timed out, 0 otherwise
DTR1 ;
+1 NEW DIR,DTOUT,DTQUIT,DUOUT,Y,FROM,TO,RCDTRNG
+2 SET ^TMP("RCERA_PARAMS",$JOB,"RCDT")="0^"_DT
+3 KILL DIR
SET DIR(0)="YA"
+4 SET DIR("A")="Limit the selection to a date range when the ERA was received?: "
+5 SET DIR("B")="NO"
+6 SET DIR("?")="Enter YES to specify a date range filter."
+7 WRITE !
+8 DO ^DIR
+9 IF $DATA(DTOUT)!$DATA(DUOUT)
QUIT 1
+10 IF Y
Begin DoDot:1
+11 SET DTQUIT=0
+12 SET FROM=$PIECE($GET(^TMP("RCERA_PARAMS",$JOB,"RCDT")),"^",1)
+13 SET TO=$PIECE($GET(^TMP("RCERA_PARAMS",$JOB,"RCDT")),"^",2)
+14 WRITE !
+15 SET RCDTRNG=$$DTRANGE(FROM,TO)
+16 IF RCDTRNG="^"
SET DTQUIT=1
QUIT
+17 SET ^TMP("RCERA_PARAMS",$JOB,"RCDT")=RCDTRNG
End DoDot:1
if DTQUIT
GOTO DTR1
+18 QUIT 0
+19 ;
DTRANGE(DEFFROM,DEFTO) ; Asks for and returns a Date Range
+1 ; Input: DEFFROM - Default FROM date
+2 ; DEFTO - Default TO date
+3 ;Output: From_Date^To_Date (YYYMMDD^YYYDDMM) or "^" (timeout or ^ entered)
+4 ;
+5 NEW DIR,Y,DTOUT,DUOUT,RCDFR,START
+6 SET RCQUIT=0
+7 SET DIR(0)="DAE^:"_DT_":E"
+8 SET DIR("A")="Earliest date: "
+9 SET DIR("?")="Enter the start of the date range."
+10 if ($GET(DEFFROM))
SET DIR("B")=$$FMTE^XLFDT(DEFFROM,2)
+11 DO ^DIR
+12 IF $DATA(DTOUT)!$DATA(DUOUT)
QUIT "^"
+13 SET RCDFR=Y
SET START=$$FMTE^XLFDT(RCDFR,"2DZ")
+14 KILL DIR
+15 SET DIR(0)="DAE^"_RCDFR_":"_DT_":E"
+16 SET DIR("A")="Latest date: "
+17 SET DIR("?",1)="Enter the end of the date range. The ending date must be greater than "
+18 SET DIR("?")="or equal to "_START_"."
+19 if ($GET(DEFTO))
SET DIR("B")=$$FMTE^XLFDT(DEFTO,2)
+20 DO ^DIR
+21 IF $DATA(DTOUT)!$DATA(DUOUT)
QUIT "^"
+22 QUIT (RCDFR_"^"_Y)
+23 ;
SPLIT ; Split line in ERA list
+1 ; input - RCSCR = ien of 344.49 and 344.4
+2 NEW RCLINE,RCZ,RCDA,Q,Q0,Z,Z0,DIR,X,Y,CT,L,L1,RCONE,RCQUIT
+3 DO FULL^VALM1
+4 ;prca*4.5*298 auto-posted ERAs cannot enter Split/Edit action
IF $SELECT($PIECE($GET(^RCY(344.4,RCSCR,4)),U,2)]"":1,1:0)
DO NOEDIT^RCDPEWLP
GOTO SPLITQ
+5 IF $GET(RCSCR("NOEDIT"))
DO NOEDIT^RCDPEWL
GOTO SPLITQ
+6 WRITE !!,"Select the entry that has a line you need to Split/Edit",!
+7 DO SEL^RCDPEWL(.RCDA)
+8 SET Z=+$ORDER(RCDA(0))
if '$GET(RCDA(Z))
GOTO SPLITQ
+9 SET RCLINE=+RCDA(Z)
SET Z0=+$ORDER(^TMP("RCDPE-EOB_WLDX",$JOB,Z_".999"),-1)
+10 SET RCZ=Z
FOR
SET RCZ=$ORDER(^TMP("RCDPE-EOB_WLDX",$JOB,RCZ))
if 'RCZ!(RCZ\1'=Z)
QUIT
Begin DoDot:1
+11 SET Q=$PIECE($GET(^TMP("RCDPE-EOB_WLDX",$JOB,RCZ)),U,2)
+12 if 'Q
QUIT
+13 SET RCZ(RCZ)=Q
+14 SET Q0=0
FOR
SET Q0=$ORDER(^RCY(344.49,RCSCR,1,Q,1,Q0))
if 'Q0
QUIT
IF "01"[$PIECE($GET(^(Q0,0)),U,2)
KILL RCZ(RCZ)
QUIT
End DoDot:1
+15 IF '$ORDER(RCZ(0))
Begin DoDot:1
+16 SET DIR(0)="EA"
SET DIR("A",1)="This entry has no lines available to Edit/Split"
SET DIR("A")="PRESS RETURN TO CONTINUE "
WRITE !
DO ^DIR
KILL DIR
End DoDot:1
GOTO SPLITQ
+17 SET RCQUIT=0
+18 IF $PIECE($GET(^RCY(344.49,RCSCR,1,RCLINE,0)),U,13)
Begin DoDot:1
+19 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
+20 IF Y'=1
SET RCQUIT=1
End DoDot:1
if RCQUIT
GOTO SPLITQ
+21 SET CT=0
SET CT=CT+1
SET DIR("?",CT)="Enter the line # that you want to split or edit:"
SET RCONE=1
+22 SET L=Z
FOR
SET L=$ORDER(RCZ(L))
if 'L
QUIT
Begin DoDot:1
+23 SET L1=+$GET(^TMP("RCDPE-EOB_WLDX",$JOB,L))
+24 SET CT=CT+1
+25 SET DIR("?",CT)=$GET(^TMP("RCDPE-EOB_WL",$JOB,L1,0))
SET CT=CT+1
SET DIR("?",CT)=$GET(^TMP("RCDPE-EOB_WL",$JOB,L1+1,0))
SET RCONE(1)=$SELECT(RCONE:L,1:"")
SET RCONE=0
End DoDot:1
+26 SET DIR("?")=" "
SET Y=-1
+27 IF $GET(RCONE(1))
SET Y=+RCONE(1)
KILL DIR
if 'Y
GOTO SPLITQ
+28 IF '$GET(RCONE(1))
Begin DoDot:1
+29 FOR
SET DIR(0)="NAO^"_(Z+.001)_":"_Z0_":3"
SET DIR("A")="Which line of entry "_Z_" do you want to Split/Edit?: "
if $GET(RCONE(1))'=""
SET DIR("B")=RCONE(1)
DO ^DIR
if 'Y!$DATA(DUOUT)!$DATA(DTOUT)
QUIT
Begin DoDot:2
+30 IF '$DATA(^TMP("RCDPE-EOB_WLDX",$JOB,Y))
WRITE !!,"Line "_Y_" does NOT exist - TRY AGAIN",!
SET Y=-1
QUIT
+31 IF '$DATA(RCZ(Y))
WRITE !!,"Line "_Y_" has been used in a DISTRIBUTE ADJ action and can't be edited",!
SET Y=-1
QUIT
+32 SET Q=+$ORDER(^RCY(344.49,RCSCR,1,"B",Y,0))
End DoDot:2
if Y>0
QUIT
End DoDot:1
KILL DIR
IF $DATA(DTOUT)!$DATA(DUOUT)!(Y\1'=Z)
GOTO SPLITQ
+33 ;
+34 KILL ^TMP("RCDPE_SPLIT_REBLD",$JOB)
+35 DO SPLIT^RCDPEWL3(RCSCR,+Y)
+36 IF $GET(^TMP("RCDPE_SPLIT_REBLD",$JOB))
KILL ^TMP("RCDPE_SPLIT_REBLD",$JOB)
DO BLD^RCDPEWL1($GET(^TMP($JOB,"RC_SORTPARM")))
+37 ;
SPLITQ SET VALMBCK="R"
+1 QUIT
+2 ;
PRTERA ; EP from menu option View/Print ERA (VP) [RCDPE VIEW/PRINT ERA]
+1 ; View the selected ERA in a listman template
+2 ; Input: RCSCR - IEN of the ERA to be viewed
+3 NEW DIC,RCSCR,X,Y
+4 SET DIC="^RCY(344.4,"
SET DIC(0)="AEMQ"
+5 DO ^DIC
+6 if Y'>0
QUIT
+7 SET RCSCR=+Y
+8 DO PRERA1
+9 QUIT
+10 ;
PRERA ; RCSCR is assumed to be defined
+1 ; Protocol entry
DO FULL^VALM1
PRERA1 ; Option entry
+1 ; PRCA*4.5*332
NEW DIR,X,Y,RCERADET,RCLSTMGR,POP,ZTRTN,ZTSAVE,ZTDESC,%ZIS
+2 DO EXCWARN^RCDPEWLP(RCSCR)
+3 SET DIR("?",1)="Including expanded detail will significantly increase the size of this report"
SET DIR("?",2)="IF YOU CHOOSE TO INCLUDE IT, ALL PAYMENT DETAILS FOR EACH EEOB WILL BE"
+4 SET DIR("?")="listed. If you want just summary data for each EEOB, do NOT include it."
+5 SET DIR(0)="YA"
SET DIR("A")="Do you want to include expanded EEOB detail?: "
SET DIR("B")="NO"
+6 WRITE !
+7 DO ^DIR
+8 KILL DIR
+9 IF $DATA(DUOUT)!$DATA(DTOUT)
GOTO PRERAQ
+10 SET RCERADET=+Y
+11 ; PRCA*4.5*332
SET RCLSTMGR=$$ASKLM^RCDPEARL(1)
+12 ; PRCA*4.5*332
IF RCLSTMGR=-1
GOTO PRERAQ
+13 ; PRCA*4.5*332
IF RCLSTMGR
DO VPERA(RCSCR,RCERADET,1)
QUIT
+14 SET %ZIS="QM"
DO ^%ZIS
if POP
GOTO PRERAQ
+15 IF $DATA(IO("Q"))
Begin DoDot:1
+16 SET ZTRTN="VPERA^RCDPEWL0("_RCSCR_","_RCERADET_",0)"
SET ZTDESC="AR - Print ERA From Worklist"
+17 DO ^%ZTLOAD
+18 WRITE !!,$SELECT($DATA(ZTSK):"Your task # "_ZTSK_" has been queued.",1:"Unable to queue this job.")
+19 KILL ZTSK,IO("Q")
DO HOME^%ZIS
End DoDot:1
GOTO PRERAQ
+20 USE IO
+21 ; PRCA*4.5*332
DO VPERA(RCSCR,RCERADET,0)
+22 QUIT
+23 ;
VPERA(RCSCR,RCERADET,LSTMGR) ; Queued entry
+1 ; Input: RCSCR - IEN of ERA to be viewed (#344.4)
+2 ; RCERADET - 1 if inclusion of all EOB details from file 361.1 is
+3 ; desired, 0 if not
+4 ; LSTMGR - 1 display in list manager, 0 otherwise
+5 NEW RC,RCDIQ,RCDIQ1,RCDIQ2,RCDOT,RCPG,RCSCR1,RC3611,RCXM1,RCZ,RC3611,XX,Z,Z0
+6 KILL ^TMP($JOB,"RC_SUMRAW"),^TMP($JOB,"RC_SUMOUT"),^TMP($JOB,"RC_SUMALL")
+7 SET (RCSTOP,RCPG)=0
SET RCDOT=""
SET $PIECE(RCDOT,".",79)=""
+8 DO GETS^DIQ(344.4,RCSCR_",","*","IEN","RCDIQ")
+9 ; Get top level 0-node captioned flds
DO TXT0^RCDPEX31(RCSCR,.RCDIQ,.RCXM1,.RC)
+10 IF $ORDER(^RCY(344.4,RCSCR,2,0))
SET RC=RC+1
SET RCXM1(RC)=" **ERA LEVEL ADJUSTMENTS**"
+11 SET RCSCR1=0
FOR
SET RCSCR1=$ORDER(^RCY(344.4,RCSCR,2,RCSCR1))
if 'RCSCR1
QUIT
Begin DoDot:1
+12 KILL RCDIQ2
+13 DO GETS^DIQ(344.42,RCSCR1_","_RCSCR_",","*","IEN","RCDIQ2")
+14 ; Get top level ERA adjs
DO TXT2^RCDPEX31(RCSCR,RCSCR1,.RCDIQ2,.RCXM1,.RC)
End DoDot:1
+15 ;
+16 ; PRCA*4.5*409 - Add header and PLB information to print array so it will display
+17 ; even when there are no claim lines.
+18 IF '$ORDER(^RCY(344.4,RCSCR,1,0))
Begin DoDot:1
+19 SET RC=RC+1
SET RCXM1(RC)=" **NO ERA DETAIL PRESENT**"
End DoDot:1
+20 SET Z0=+$ORDER(^TMP($JOB,"RC_SUMALL"," "),-1)
+21 SET Z=0
FOR
SET Z=$ORDER(RCXM1(Z))
if 'Z
QUIT
SET Z0=Z0+1
SET ^TMP($JOB,"RC_SUMALL",Z0)=RCXM1(Z)
+22 KILL RCXM1
SET RC=0
+23 ;
+24 ; PRCA*4.5*409 - End modified code block
+25 SET RCSCR1=0
FOR
SET RCSCR1=$ORDER(^RCY(344.4,RCSCR,1,RCSCR1))
if 'RCSCR1
QUIT
Begin DoDot:1
+26 KILL RCDIQ1
+27 ;PRCA*4.5*298 need to retrieve all fields even if null (changed "IEN" to "IE")
DO GETS^DIQ(344.41,RCSCR1_","_RCSCR_",","*","IE","RCDIQ1")
+28 DO TXT00^RCDPEX31(RCSCR,RCSCR1,.RCDIQ1,.RCXM1,.RC)
+29 ;HIPAA 5010
+30 NEW PNAME4
+31 SET PNAME4=$$PNM4^RCDPEWL1(RCSCR,RCSCR1)
+32 IF $LENGTH(PNAME4)<32
Begin DoDot:2
+33 SET RC=RC+1
SET RCXM1(RC-1)=$EXTRACT("PATIENT: "_PNAME4_$JUSTIFY("",41),1,41)_"CLAIM #: "_$$BILLREF^RCDPESR0(RCSCR,RCSCR1)
SET RCXM1(RC)=" "
End DoDot:2
+34 IF $LENGTH(PNAME4)>31
Begin DoDot:2
+35 SET RC=RC+1
SET RCXM1(RC-1)=$JUSTIFY("",41)_"CLAIM #: "_$$BILLREF^RCDPESR0(RCSCR,RCSCR1)
+36 SET RC=RC+1
SET RCXM1(RC-1)=$EXTRACT("PATIENT: "_PNAME4,1,78)
SET RCXM1(RC)=" "
End DoDot:2
+37 DO PROV^RCDPEWLD(RCSCR,RCSCR1,.RCXM1,.RC)
+38 SET RC3611=$PIECE($GET(^RCY(344.4,RCSCR,1,RCSCR1,0)),U,2)
+39 IF RCERADET
Begin DoDot:2
+40 IF 'RC3611
Begin DoDot:3
+41 DO DISP^RCDPESR0("^RCY(344.4,"_RCSCR_",1,"_RCSCR1_",1)","^TMP($J,""RC_SUMRAW"")",1,"^TMP($J,""RC_SUMOUT"")",75,1)
End DoDot:3
QUIT
+42 ;
+43 ; Detail record is in 361.1
IF '$TEST
Begin DoDot:3
+44 KILL ^TMP("PRCA_EOB",$JOB)
+45 DO GETEOB^IBCECSA6(RC3611,2)
+46 ; get filing errors
IF $ORDER(^IBM(361.1,RC3611,"ERR",0))
DO GETERR^RCDPEDS(RC3611,+$ORDER(^TMP("PRCA_EOB",$JOB,RC3611," "),-1))
+47 SET Z=0
FOR
SET Z=$ORDER(^TMP("PRCA_EOB",$JOB,RC3611,Z))
if 'Z
QUIT
SET RC=RC+1
SET ^TMP($JOB,"RC_SUMOUT",RC)=$GET(^TMP("PRCA_EOB",$JOB,RC3611,Z))
+48 SET RC=RC+2
SET ^TMP($JOB,"RC_SUMOUT",RC-1)=" "
SET ^TMP($JOB,"RC_SUMOUT",RC)=" "
+49 KILL ^TMP("PRCA_EOB",$JOB)
End DoDot:3
End DoDot:2
+50 IF $DATA(RCDIQ1(344.41,RCSCR1_","_RCSCR_",",2))
Begin DoDot:2
+51 SET RC=RC+1
SET RCXM1(RC)=" **EXCEPTION RESOLUTION LOG DATA**"
+52 SET Z=0
FOR
SET Z=$ORDER(RCDIQ1(344.41,RCSCR1_","_RCSCR_",",2,Z))
if 'Z
QUIT
SET RC=RC+1
SET RCXM1(RC)=RCDIQ1(344.41,RCSCR1_","_RCSCR_",",2,Z)
End DoDot:2
+53 SET RC=RC+1
SET RCXM1(RC)=" "
+54 SET Z0=+$ORDER(^TMP($JOB,"RC_SUMALL"," "),-1)
+55 SET Z=0
FOR
SET Z=$ORDER(RCXM1(Z))
if 'Z
QUIT
SET Z0=Z0+1
SET ^TMP($JOB,"RC_SUMALL",Z0)=RCXM1(Z)
+56 KILL RCXM1
SET RC=0
+57 SET Z=0
FOR
SET Z=$ORDER(^TMP($JOB,"RC_SUMOUT",Z))
if 'Z
QUIT
SET Z0=Z0+1
SET ^TMP($JOB,"RC_SUMALL",Z0)=$GET(^TMP($JOB,"RC_SUMOUT",Z))
End DoDot:1
+58 ; PRCA*4.5*332
IF LSTMGR
DO DOLSTMAN
DO PRERAQ
QUIT
+59 SET RCSTOP=0
SET Z=""
+60 FOR
SET Z=$ORDER(^TMP($JOB,"RC_SUMALL",Z))
if 'Z
QUIT
Begin DoDot:1
+61 IF $DATA(ZTQUEUED)
IF $$S^%ZTLOAD
SET (RCSTOP,ZTSTOP)=1
KILL ZTREQ
IF +$GET(RCPG)
WRITE !!,"***TASK STOPPED BY USER***"
QUIT
+62 IF 'RCPG!(($Y+5)>IOSL)
Begin DoDot:2
+63 if RCPG
DO ASK(.RCSTOP)
IF RCSTOP
QUIT
+64 DO HDR(.RCPG)
End DoDot:2
IF RCSTOP
QUIT
+65 WRITE !,$GET(^TMP($JOB,"RC_SUMALL",Z))
End DoDot:1
if RCSTOP
QUIT
+66 ;
+67 IF 'RCSTOP
IF RCPG
DO ASK(.RCSTOP)
+68 ;
+69 IF $DATA(ZTQUEUED)
SET ZTREQ="@"
+70 IF '$DATA(ZTQUEUED)
DO ^%ZISC
+71 ;
PRERAQ KILL ^TMP($JOB,"RC_SUMRAW"),^TMP($JOB,"RC_SUMOUT"),^TMP($JOB,"SUMALL")
+1 SET VALMBCK="R"
+2 QUIT
+3 ; PRCA*4.5*332 - Subroutine added
DOLSTMAN ; Display the ERA Detail in a listman format
+1 NEW HDR
+2 SET HDR("TITLE")="VIEW ERA DETAIL"
+3 ; generate ListMan display
DO LMRPT^RCDPEARL(.HDR,$NAME(^TMP($JOB,"RC_SUMALL")),"RCDPE VIEW ERA DETAIL")
+4 QUIT
+5 ;
HDR(RCPG) ;Report hdr
+1 ; RCPG = last page #
+2 IF RCPG!($EXTRACT(IOST,1,2)="C-")
WRITE @IOF,*13
+3 SET RCPG=$GET(RCPG)+1
+4 WRITE !,?5,"EDI LOCKBOX WORKLIST - ERA DETAIL",?55,$$FMTE^XLFDT(DT,2),?70,"Page: ",RCPG,!,$TRANSLATE($JUSTIFY("",IOM)," ","=")
+5 QUIT
+6 ;
ASK(RCSTOP) ;
+1 IF $EXTRACT(IOST,1,2)'["C-"
QUIT
+2 NEW DIR,DIROUT,DIRUT,DTOUT,DUOUT
+3 SET DIR(0)="E"
WRITE !
DO ^DIR
+4 IF ($DATA(DIRUT))!($DATA(DUOUT))
SET RCSTOP=1
QUIT
+5 QUIT
+6 ;
