RCDPEAA1 ;ALB/KML - AUTO POST AWAITING RESOLUTION (APAR) - LIST OF UNPOSTED EEOBS ;Jun 06, 2014@19:11:19
;;4.5;Accounts Receivable;**298,304,317,321,326**;Mar 20, 1995;Build 26
;Per VA Directive 6402, this routine should not be modified.
Q
;
EN ; Main entry point
N RCQUIT,RCPROG
S RCQUIT=0
S RCPROG="RCDPEAA1"
; Calling Change View API in Menu Option Mode
S RCQUIT=$$PARAMS("MO") ; PRCA*4.5*321
Q:RCQUIT
D EN^VALM("RCDPE APAR EEOB LIST")
;
ENQ Q
;
INIT ; EP Listman Template - RCDPE APAR EEOB LIST
;
; Parameters for selecting EEOBs to be included in the list are
; contained in the global ^TMP("RCDPE_APAR_EEOB_PARAMS",$J,parameter name)
;
; PRCA*4.5*321 - Start modified code block
N FDTTM,P1,P2,RCAPAR,RCDA,RCPROG
S RCAPAR=1,P1="RCDPE_APAR_EEOB_PASS1",P2="RCDPE_APAR_EEOB_PASS2"
S RCPROG="RCDPE-APAR_EEOB_WL"
D FULL^VALM1,CLEAN^VALM10
K ^TMP($J,RCPROG),^TMP($J,P1),^TMP($J,P2)
K ^TMP(RCPROG,$J),^TMP("RCDPE-APAR_EEOB_WLDX",$J)
; First Pass - Get ERAs that are in a 'partial' auto-post status
S RCDA=0
F D Q:'RCDA
. S RCDA=$O(^RCY(344.4,"E",1,RCDA))
. Q:'RCDA
. Q:'$$FILTER(RCDA) ; Record didn't pass filter criteria
. S ^TMP($J,P1,RCDA)=""
;
D:$D(^TMP($J,P1)) BLD^RCDPEAA4(P1,P2,RCPROG) ; Build, Sort and Output the list
;
; If no EEOBs found display the message below in the list area
I '$O(^TMP(RCPROG,$J,0)) D
. S ^TMP(RCPROG,$J,1,0)="THERE ARE NO EEOBs MATCHING YOUR SELECTION CRITERIA"
. S VALMCNT=1
; PRCA*4.5*321 - End modified code block
Q
;
HDR ;
N LINE,RCMDRX,RCPAYR,SORT,X,Y
S RCPAYR=$G(^TMP("RCDPE_APAR_EEOB_PARAMS",$J,"RCPAYR"))
S RCMDRX=$G(^TMP("RCDPE_APAR_EEOB_PARAMS",$J,"RCMEDRX"))
S Y=$S(RCMDRX="M":"MEDICAL",RCMDRX="P":"PHARMACY",RCMDRX="T":"TRICARE",1:"ALL")_" CLAIMS"
S X=$S(($P(RCPAYR,U)="A")!(RCPAYR=""):"ALL PAYERS",1:"PAYERS: "_$P(RCPAYR,U,2)_"-"_$P(RCPAYR,U,3))
S VALMHDR(1)="Current View:"_$J("",4)_Y_" for "_X
; PRCA*4.5*321 - Start modified code block
S SORT=$P($G(^TMP("RCDPE_APAR_EEOB_PARAMS",$J,"SORT")),"^",1)
S X=$S(SORT="N":"Payer Name",SORT="R":"Reason",SORT="D":"Date",SORT="U":"Unposted",1:"Posted")
S Y=$P($G(^TMP("RCDPE_APAR_EEOB_PARAMS",$J,"SORT")),"^",2)
I SORT="D" S X=X_$S(Y="H":" - Descending",1:" - Ascending")
E S X=X_$S(Y="H":" - Highest to Lowest",Y="L":" - Lowest to Highest",1:"")
S VALMHDR(2)=" Sorted By:"_$J("",4)_X
S LINE=$J("",10)_$$LJ^XLFSTR("ERA #.Sequence",17)
S LINE=LINE_$$LJ^XLFSTR("Claim #",14)
S LINE=LINE_$$RJ^XLFSTR("Posted",13)_" "
; S LINE=LINE_$$LJ^XLFSTR("Post Dt",11)
S LINE=LINE_$$LJ^XLFSTR("Created Dt",11) ; PRCA*4.5*321
S LINE=LINE_$$RJ^XLFSTR("Unposted",13)
; PRCA*4.5*321 - End modified code block
S VALMHDR(3)=LINE
Q
;
EXIT ; -- Clean up list
; PRCA*4.5*321 - Start modified code block
K ^TMP("RCDPE_APAR_PVW",$J)
K ^TMP("RCDPE_APAR_EEOB_PARAMS",$J)
K ^TMP("RCDPE-APAR_EEOB_WL",$J),^TMP("RCDPE-APAR_EEOB_WLDX",$J)
K ^TMP($J,"RCDPE_APAR_EEOB_PASS1"),^TMP($J,"RCDPE_APAR_EEOB_PASS2")
; PRCA*4.5*321 - End modified code block
K RCAPAR
Q
;
PARAMS(SOURCE) ; Retrieve/Edit/Save View Parameters for APAR EEOB Worklist
; Input: SOURCE - "MO" - Called from Menu Option
; "CV" - Called from Change View action
; Output: ^TMP("RCDPE_APAR_EEOB_PARAMS",$J,"RCPAYR") - P1^P2^P3 Where:
; P1- All Payers/Range of Payers
; ("A": All/"R":Range of Payers)
; P2- START WITH PAYER (e.g.,'AET')
; (Range Limited Only)
; P3- GO TO PAYER (e.g.,'AETZ')
; (Range Limited Only)
; ^TMP("RCDPE_APAR_EEOB_PARAMS",$J,"RCMEDRX")- (M)edical, (P)harmacy, or (B)
;
; ^TMP("RCDPE_APAR_EEOB_PARAMS",$J,"SORT") - P1^P2 Where
; P1 - Sort Type
; "N" - Payer Name
; "P" - Posted Amount
; "R" - Auto-Post Reject Reason
; "U" - Unposted Amount
; P2 - H - Highest to Lowest Amount
; L - Lowest to Highest Amount
; ""- If P1="N" or "P"
; Returns: 1 if user ^ arrowed or timed out, 0 otherwise
N RCQUIT,RCXPAR,USEPVW,XX ;PRCA*4.5*321 added RCQUIT
S (RCQUIT,USEPVW)=0 ;PRCA*4.5*321 initialise USEPW
; Retrieve user's saved preferred view (if any)
D:SOURCE="MO" 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 ; PRCA*4.5*321 - move Q:USEPVW
. ;
. ; Ask the user if they want to use the preferred view
. S USEPVW=$$ASKUVW^RCDPEWL0()
. I USEPVW=-1 S RCQUIT=1 Q
. Q:'USEPVW
. ;
. ; Set the Sort/Filtering Criteria from the preferred view
. M ^TMP("RCDPE_APAR_EEOB_PARAMS",$J)=^TMP("RCDPE_APAR_PVW",$J)
;
; PRCA*4.5*321 - Start modified code block
Q:USEPVW 0
Q:RCQUIT 1
; PRCA*4.5*326 prompt for type filter first in case we need to use it in payer selection
S RCQUIT=$$MORP() ; Select Medical or Pharmacy, or Tricare
Q:RCQUIT 1
S RCQUIT=$$PAYR() ; Select Payer(s)
Q:RCQUIT 1
S RCQUIT=$$SORT() ; Select Sort
Q:RCQUIT 1
S RCQUIT=$$SAVEPVW() ; Save Preferred View
Q:RCQUIT 1
Q 0
; PRCA*4.5*321 - End modified code block
;
GETWLPVW(RCXPAR) ; Retrieves the preferred view settings for the APAR worklist
; for the user
; PRCA*4.5*317 - Added subroutine
; Input: None
; Output: RCXPAR() - Array of preferred view sort/filter criteria
; ^TMP("RCDPE_APAR_EEOB_PARAMS",$)- Global array of preferred view settings
N XX
K ^TMP("RCDPE_APAR_EEOB_PARAMS",$J)
D GETLST^XPAR(.RCXPAR,"USR","RCDPE APAR","I")
D:$D(RCXPAR("ALL_PAYERS/RANGE_OF_PAYERS")) PVWSAVE(.RCXPAR)
;
S XX=$G(RCXPAR("ALL_PAYERS/RANGE_OF_PAYERS"))
S ^TMP("RCDPE_APAR_EEOB_PARAMS",$J,"RCPAYR")=$S(XX'="":$TR(XX,";","^"),1:"A")
S XX=$G(RCXPAR("MEDICAL/PHARMACY"))
S ^TMP("RCDPE_APAR_EEOB_PARAMS",$J,"RCMEDRX")=$S(XX'="":$TR(XX,";","^"),1:"A") ; PRCA*4.5*326 Default A
; PRCA&4.5*321 - add sort to preferened view
S XX=$G(RCXPAR("SORT"))
S ^TMP("RCDPE_APAR_EEOB_PARAMS",$J,"SORT")=$S(XX'="":$TR(XX,";","^"),1:"N")
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("RCDPE_APAR_PVW",$J)
; only continue if we have answers to all APAR related preferred view prompts
Q:'$D(RCXPAR("ALL_PAYERS/RANGE_OF_PAYERS"))
Q:'$D(RCXPAR("MEDICAL/PHARMACY"))
Q:'$D(RCXPAR("SORT")) ; PRCA*4.5*321
;
S ^TMP("RCDPE_APAR_PVW",$J,"RCPAYR")=$TR(RCXPAR("ALL_PAYERS/RANGE_OF_PAYERS"),";","^")
S ^TMP("RCDPE_APAR_PVW",$J,"RCMEDRX")=$TR(RCXPAR("MEDICAL/PHARMACY"),";","^")
S ^TMP("RCDPE_APAR_PVW",$J,"SORT")=$TR(RCXPAR("SORT"),";","^") ; PRCA*4.5*321
Q
;
PREFVW(SOURCE,RCXPAR) ; 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 Lockbox menu
; option
; 'CV' - When called from the Change View
; action
; RCXPAR - Array of preferred view values
; ^TMP("RCDPE_APAR_EEOB_PARAMS")- Global array of currently in use defaults
; ^TMP("RCDPE_APAR_PVW",$J) - Global array of preferred view settings
;
; 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("RCDPE_APAR_PVW",$J)):1,1:-1)
Q:'$D(^TMP("RCDPE_APAR_PVW",$J)) -1 ; No stored preferred view
Q:$G(^TMP("RCDPE_APAR_EEOB_PARAMS",$J,"RCPAYR"))'=$G(^TMP("RCDPE_APAR_PVW",$J,"RCPAYR")) 0
Q:$G(^TMP("RCDPE_APAR_EEOB_PARAMS",$J,"RCMEDRX"))'=$G(^TMP("RCDPE_APAR_PVW",$J,"RCMEDRX")) 0
Q:$G(^TMP("RCDPE_APAR_EEOB_PARAMS",$J,"SORT"))'=$G(^TMP("RCDPE_APAR_PVW",$J,"SORT")) 0 ; PRCA*4.5*321
Q 1
;
PAYR() ; Payer Selection
; Input: ^TMP("RCDPE_APAR_EEOB_PARAMS",$J,"RCPAYR") - Current payer selection setting
; Output: ^TMP("RCDPE_APAR_EEOB_PARAMS",$J,"RCPAYR") - Updated payer selection setting
; RCQUIT=1 if user ^ or timed out
; Returns: 1 if user ^ arrowed or time out
N DIR,DIRUT,DIROUT,DUOUT,DTOUT,RCPAYR,RCPAYRDF,RCXPAR,RCDRLIM,RCERROR,RCAUTOPDF
N RCTYPEDF,RCQ,X,XX,Y
S RCPAYRDF=$G(^TMP("RCDPE_APAR_EEOB_PARAMS",$J,"RCPAYR"))
S RCQUIT=0
K DIR
S DIR(0)="SA^A:ALL;R:RANGE"
S DIR("A")="(A)LL payers, (R)ANGE of payer names: "
S DIR("B")="ALL"
S DIR("?",1)="Entering ALL will select all payers."
S DIR("?")="If RANGE is entered, you will be prompted for a payer range."
S:$P(RCPAYRDF,"^")'="" DIR("B")=$P(RCPAYRDF,"^") ;Stored preferred view, use as default
W !
D ^DIR
I $D(DTOUT)!$D(DUOUT) S RCQUIT=1 Q 1
S RCPAYR=Y
I RCPAYR="A" S ^TMP("RCDPE_APAR_EEOB_PARAMS",$J,"RCPAYR")=Y Q 0
I RCPAYR="R" D Q:RCQUIT RCQUIT
. W !,"Names you select here will be the payer names from the ERA, NOT the INS File"
. K DIR
. S DIR("?")="Enter a name between 1 and 30 characters in UPPERCASE"
. S DIR(0)="FA^1:30^K:X'?.U X",DIR("A")="Start with payer name: "
. S:$P(RCPAYRDF,"^",2)'="" DIR("B")=$P(RCPAYRDF,"^",2) ;Stored preferred view, use as default
. W !
. D ^DIR
. I $D(DTOUT)!$D(DUOUT) D Q
. . S RCQUIT=1 Q
. . K ^TMP("RCDPE_APAR_EEOB_PARAMS",$J,"RCPAYR")
. S RCPAYR("FROM")=Y
. K DIR
. S DIR("?")="Enter a name between 1 and 30 characters in UPPERCASE"
. S DIR(0)="FA^1:30^K:X'?.U X",DIR("A")="Go to payer name: "
. S DIR("B")=$E(RCPAYR("FROM"),1,27)_"ZZZ"
. W ! D ^DIR K DIR
. I $D(DTOUT)!$D(DUOUT) S RCQUIT=1 Q
. S ^TMP("RCDPE_APAR_EEOB_PARAMS",$J,"RCPAYR")=RCPAYR_"^"_RCPAYR("FROM")_"^"_Y
Q 0
;
MORP() ; Ask for Medical or Pharmacy, Tricare (Or All)
; Input: None
; Returns: 1 if user ^ arrowed or timed out, 0 otherwise
N DEF
S DEF=$G(^TMP("RCDPE_APAR_EEOB_PARAMS",$J,"RCMEDRX"))
S DEF=$S(DEF="P":"PHARMACY",DEF="M":"MEDICAL",DEF="T":"TRICARE",1:"ALL") ; PRCA*4.5*326
S RCQ=$$RTYPE^RCDPEU1(DEF) ; PRCA*4.5*326
I RCQ=-1 Q 1
S ^TMP("RCDPE_APAR_EEOB_PARAMS",$J,"RCMEDRX")=RCQ
Q 0
;
SORT() ; Ask for Sort - Payer, Dollar, Date, Trace Number
; Input: None
; Returns: 1 if user ^ arrowed or timed out, 0 otherwise
N DEF,DIR,DIRUT,DTOUT,DUOUT,P1,X,XX,Y
S DEF=$P($G(^TMP("RCDPE_APAR_EEOB_PARAMS",$J,"SORT")),"^",1)
S DEF=$S(DEF="D":"DATE",DEF="N":"PAYER NAME",DEF="P":"POSTED",DEF="R":"REASON",DEF="U":"UNPOSTED",1:"")
S DIR(0)="SA^D:DATE;N:PAYER NAME;P:POSTED;R:REASON;U:UNPOSTED"
S DIR("A")="Sort By (D)ATE, PAYER (N)AME, (R)EASON, (P)OSTED, (U)NPOSTED: "
S DIR("B")=$S(DEF'="":DEF,1:"DATE")
S DIR("?",1)="Enter 'DATE' to sort by date created."
S DIR("?",2)="Enter 'PAYER NAME' to sort by payer name."
S DIR("?",3)="Enter 'REASON' to sort by auto-post reject reason."
S DIR("?",4)="Enter 'POSTED' to sort by the posted amount."
S DIR("?")="Enter 'UNPOSTED' to sort by the unposted amount."
W !
D ^DIR
I $D(DTOUT)!$D(DUOUT) Q 1
I Y="N"!(Y="R") D Q 0
. S ^TMP("RCDPE_APAR_EEOB_PARAMS",$J,"SORT")=Y
;
S P1=Y,XX=""
I P1="P"!(P1="U") S XX=$$HTOL() I XX=-1 Q 1
I P1="D" S XX=$$DATEORD() I XX=-1 Q 1
S ^TMP("RCDPE_APAR_EEOB_PARAMS",$J,"SORT")=P1_"^"_XX
Q 0
;
HTOL() ; Ask for how dollar amounts should be sorted - either highest to
; lowest amount or lowest to highest amount
; Input: None
; Returns: -1 - if user ^ arrowed or timed out
; H - Highest to Lowest
; L - Lowest to Highest
N DEF,DIR,DIRUT,DTOUT,DUOUT,P1,X,Y
S DEF=$P($G(^TMP("RCDPE_APAR_EEOB_PARAMS",$J,"SORT")),"^",2)
S DEF=$S(DEF="H":"HIGHEST TO LOWEST",DEF="L":"LOWEST TO HIGHEST",1:"")
S DIR(0)="SA^H:HIGHEST TO LOWEST;L:LOWEST TO HIGHEST"
S DIR("A")="Sort By (H)IGHEST TO LOWEST or (L)OWEST TO HIGHEST: "
S DIR("B")=$S(DEF'="":DEF,1:"HIGHEST TO LOWEST")
S DIR("?",1)="Enter 'HIGHEST TO LOWEST' to sort amounts in decreasing order."
S DIR("?")="Enter 'LOWEST TO HIGHEST' to sort amounts in increasing order."
W !
D ^DIR
I $D(DTOUT)!$D(DUOUT) Q -1
Q Y
DATEORD() ; Ask how creation date should be sorted - ascending or descending
; Input: None
; Returns: -1 - if user ^ arrowed or timed out
; H - Descending (Highest to lowest)
; L - Ascending (Lowest to Highest)
N DEF,DIR,DIRUT,DTOUT,DUOUT,P1,X,Y
S DEF=$P($G(^TMP("RCDPE_APAR_EEOB_PARAMS",$J,"SORT")),"^",2)
S DEF=$S(DEF="H":"DESCENDING",DEF="L":"ASCENDING",1:"")
S DIR(0)="SA^A:ASCENDING;D:DESCENDING"
S DIR("A")="Sort in (A)SCENDING or (D)ESCENDING order: "
S DIR("B")=$S(DEF'="":DEF,1:"ASCENDING")
S DIR("?",1)="Enter 'ASCENDING' to see oldest EEOBs first."
S DIR("?")="Enter 'DESCENDING' to see newest EEOBs first."
W !
D ^DIR
I $D(DTOUT)!$D(DUOUT) Q -1
S Y=$S(Y="D":"H",1:"L")
Q Y
SAVEPVW() ; Option to save as User Preferred View
; PRCA*4.5*317 added subroutine
; Input: ^TMP("RCDPE_APAR_EEOB_PARAMS",$J) - Global array of current worklist settings
; Output Current worklist settings set as preferred view (potentially)
; ^TMP("RCDPE_APAR_PVW",$J) - Global array of preferred view settings
; Returns: 1 - User ^ arrowed or timed out, 0 otherwise
N DIR,DIRUT,DIROUT,DTOUT,DUOUT,X,XX,Y
K DIR
W !
S DIR(0)="YA",DIR("B")="NO"
S DIR("A")="Do you want to save this as your preferred view (Y/N)? "
D ^DIR
; PRCA*4.5*321 ; Start modified code block
I $D(DTOUT)!$D(DUOUT) Q 1
I Y=1 D
. S XX=^TMP("RCDPE_APAR_EEOB_PARAMS",$J,"RCPAYR")
. D EN^XPAR(DUZ_";VA(200,","RCDPE APAR","ALL_PAYERS/RANGE_OF_PAYERS",$TR(XX,"^",";"),.RCERROR)
. S XX=^TMP("RCDPE_APAR_EEOB_PARAMS",$J,"RCMEDRX")
. D EN^XPAR(DUZ_";VA(200,","RCDPE APAR","MEDICAL/PHARMACY",XX,.RCERROR)
. S XX=^TMP("RCDPE_APAR_EEOB_PARAMS",$J,"SORT")
. D EN^XPAR(DUZ_";VA(200,","RCDPE APAR","SORT",$TR(XX,"^",";"),.RCERROR)
. ;
. ;Capture new preferred settings for comparison
. K ^TMP("RCDPE_APAR_PVW",$J)
. M ^TMP("RCDPE_APAR_PVW",$J)=^TMP("RCDPE_APAR_EEOB_PARAMS",$J)
Q 0
; PRCA*4.5*321 ; End modified code block
;
FILTER(RCDA) ; Returns 1 if record in entry 344.4 passes
; the edits for the APAR worklist selection of EEOBs
; Parameters found in ^TMP("RCDPE_APAR_EEOB_PARAMS",$J)
;
; Input: RCDA - Internal IEN OF 344.4
; Returns: 1 if the ERA Record passes filters, 0 otherwise
; PRCA*4.5*321 - Start modified code block
N OK,RCECME,RCERATYP,RCIEN,RCPAYR,RCPAYFR,RCPAYTO,XX
S OK=1
;
S RCPAYR=$P($G(^TMP("RCDPE_APAR_EEOB_PARAMS",$J,"RCPAYR")),U,1)
S RCPAYFR=$P($G(^TMP("RCDPE_APAR_EEOB_PARAMS",$J,"RCPAYR")),U,2)
S RCPAYTO=$P($G(^TMP("RCDPE_APAR_EEOB_PARAMS",$J,"RCPAYR")),U,3)
S RCERATYP=$G(^TMP("RCDPE_APAR_EEOB_PARAMS",$J,"RCMEDRX"))
; Payer name filter
I RCPAYR'="A" D Q:'OK OK
. S XX=$$GET1^DIQ(344.4,RCDA,.06,"I") ; Payer Name
. S XX=$$UP^XLFSTR(XX)
. ;
. ; Make sure the Payer is in the selected Payer range
. I $S(XX=RCPAYFR:1,XX=RCPAYTO:1,XX]RCPAYFR:RCPAYTO]XX,1:0) Q
. S OK=0
;
; ERA Type (Medical/Pharmacy) filter
I RCERATYP'="A" D ; PRCA*4.5*326
. I '$$ISTYPE^RCDPEU1(344.4,RCDA,RCERATYP) S OK=0 ; PRCA*4.5*326
Q OK
; PRCA*4.5*321 - End modified code block
;
ENTEREOB ; EP Protocol action - RCDPE APAR SELECT EEOB
; Enter the APAR EEOB SCRATCHPAD
N RCDA,RCDA1,RCIENS,X,XQORM
S VALMBCK="R"
S RCIENS=$$SEL()
I 'RCIENS D INIT Q
D EN^VALM("RCDPE APAR SELECTED EEOB")
D INIT
Q
;
SEL() ; Select an item from the APAR list of EEOBs
; Input: None
; Returns: RCIENS - Internal IENs A1^A2^A3 Where:
; A1 - IEN for in file 344.49
; A2 - IEN for subfile 344.491
; A3 - Selectable line item from listman screen
N RCDA,RCITEMS,RCSEQ,VALMY
D FULL^VALM1
D EN^VALM2($G(XQORNOD(0)),"S")
S (RCSEQ,RCDA,RCITEMS)=0
F D Q:'RCSEQ
. S RCSEQ=$O(VALMY(RCSEQ))
. Q:'RCSEQ
. S RCITEMS=$P($G(^TMP("RCDPE-APAR_EEOB_WLDX",$J,RCSEQ)),U,2,3)_U_RCSEQ
Q RCITEMS
;
CV ;
; Change View action for APAR pick list
D FULL^VALM1 D PARAMS("CV")
D HDR,INIT S VALMBCK="R",VALMBG=1
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HRCDPEAA1 17150 printed Apr 09, 2024@20:49:52 Page 2
RCDPEAA1 ;ALB/KML - AUTO POST AWAITING RESOLUTION (APAR) - LIST OF UNPOSTED EEOBS ;Jun 06, 2014@19:11:19
+1 ;;4.5;Accounts Receivable;**298,304,317,321,326**;Mar 20, 1995;Build 26
+2 ;Per VA Directive 6402, this routine should not be modified.
+3 QUIT
+4 ;
EN ; Main entry point
+1 NEW RCQUIT,RCPROG
+2 SET RCQUIT=0
+3 SET RCPROG="RCDPEAA1"
+4 ; Calling Change View API in Menu Option Mode
+5 ; PRCA*4.5*321
SET RCQUIT=$$PARAMS("MO")
+6 if RCQUIT
QUIT
+7 DO EN^VALM("RCDPE APAR EEOB LIST")
+8 ;
ENQ QUIT
+1 ;
INIT ; EP Listman Template - RCDPE APAR EEOB LIST
+1 ;
+2 ; Parameters for selecting EEOBs to be included in the list are
+3 ; contained in the global ^TMP("RCDPE_APAR_EEOB_PARAMS",$J,parameter name)
+4 ;
+5 ; PRCA*4.5*321 - Start modified code block
+6 NEW FDTTM,P1,P2,RCAPAR,RCDA,RCPROG
+7 SET RCAPAR=1
SET P1="RCDPE_APAR_EEOB_PASS1"
SET P2="RCDPE_APAR_EEOB_PASS2"
+8 SET RCPROG="RCDPE-APAR_EEOB_WL"
+9 DO FULL^VALM1
DO CLEAN^VALM10
+10 KILL ^TMP($JOB,RCPROG),^TMP($JOB,P1),^TMP($JOB,P2)
+11 KILL ^TMP(RCPROG,$JOB),^TMP("RCDPE-APAR_EEOB_WLDX",$JOB)
+12 ; First Pass - Get ERAs that are in a 'partial' auto-post status
+13 SET RCDA=0
+14 FOR
Begin DoDot:1
+15 SET RCDA=$ORDER(^RCY(344.4,"E",1,RCDA))
+16 if 'RCDA
QUIT
+17 ; Record didn't pass filter criteria
if '$$FILTER(RCDA)
QUIT
+18 SET ^TMP($JOB,P1,RCDA)=""
End DoDot:1
if 'RCDA
QUIT
+19 ;
+20 ; Build, Sort and Output the list
if $DATA(^TMP($JOB,P1))
DO BLD^RCDPEAA4(P1,P2,RCPROG)
+21 ;
+22 ; If no EEOBs found display the message below in the list area
+23 IF '$ORDER(^TMP(RCPROG,$JOB,0))
Begin DoDot:1
+24 SET ^TMP(RCPROG,$JOB,1,0)="THERE ARE NO EEOBs MATCHING YOUR SELECTION CRITERIA"
+25 SET VALMCNT=1
End DoDot:1
+26 ; PRCA*4.5*321 - End modified code block
+27 QUIT
+28 ;
HDR ;
+1 NEW LINE,RCMDRX,RCPAYR,SORT,X,Y
+2 SET RCPAYR=$GET(^TMP("RCDPE_APAR_EEOB_PARAMS",$JOB,"RCPAYR"))
+3 SET RCMDRX=$GET(^TMP("RCDPE_APAR_EEOB_PARAMS",$JOB,"RCMEDRX"))
+4 SET Y=$SELECT(RCMDRX="M":"MEDICAL",RCMDRX="P":"PHARMACY",RCMDRX="T":"TRICARE",1:"ALL")_" CLAIMS"
+5 SET X=$SELECT(($PIECE(RCPAYR,U)="A")!(RCPAYR=""):"ALL PAYERS",1:"PAYERS: "_$PIECE(RCPAYR,U,2)_"-"_$PIECE(RCPAYR,U,3))
+6 SET VALMHDR(1)="Current View:"_$JUSTIFY("",4)_Y_" for "_X
+7 ; PRCA*4.5*321 - Start modified code block
+8 SET SORT=$PIECE($GET(^TMP("RCDPE_APAR_EEOB_PARAMS",$JOB,"SORT")),"^",1)
+9 SET X=$SELECT(SORT="N":"Payer Name",SORT="R":"Reason",SORT="D":"Date",SORT="U":"Unposted",1:"Posted")
+10 SET Y=$PIECE($GET(^TMP("RCDPE_APAR_EEOB_PARAMS",$JOB,"SORT")),"^",2)
+11 IF SORT="D"
SET X=X_$SELECT(Y="H":" - Descending",1:" - Ascending")
+12 IF '$TEST
SET X=X_$SELECT(Y="H":" - Highest to Lowest",Y="L":" - Lowest to Highest",1:"")
+13 SET VALMHDR(2)=" Sorted By:"_$JUSTIFY("",4)_X
+14 SET LINE=$JUSTIFY("",10)_$$LJ^XLFSTR("ERA #.Sequence",17)
+15 SET LINE=LINE_$$LJ^XLFSTR("Claim #",14)
+16 SET LINE=LINE_$$RJ^XLFSTR("Posted",13)_" "
+17 ; S LINE=LINE_$$LJ^XLFSTR("Post Dt",11)
+18 ; PRCA*4.5*321
SET LINE=LINE_$$LJ^XLFSTR("Created Dt",11)
+19 SET LINE=LINE_$$RJ^XLFSTR("Unposted",13)
+20 ; PRCA*4.5*321 - End modified code block
+21 SET VALMHDR(3)=LINE
+22 QUIT
+23 ;
EXIT ; -- Clean up list
+1 ; PRCA*4.5*321 - Start modified code block
+2 KILL ^TMP("RCDPE_APAR_PVW",$JOB)
+3 KILL ^TMP("RCDPE_APAR_EEOB_PARAMS",$JOB)
+4 KILL ^TMP("RCDPE-APAR_EEOB_WL",$JOB),^TMP("RCDPE-APAR_EEOB_WLDX",$JOB)
+5 KILL ^TMP($JOB,"RCDPE_APAR_EEOB_PASS1"),^TMP($JOB,"RCDPE_APAR_EEOB_PASS2")
+6 ; PRCA*4.5*321 - End modified code block
+7 KILL RCAPAR
+8 QUIT
+9 ;
PARAMS(SOURCE) ; Retrieve/Edit/Save View Parameters for APAR EEOB Worklist
+1 ; Input: SOURCE - "MO" - Called from Menu Option
+2 ; "CV" - Called from Change View action
+3 ; Output: ^TMP("RCDPE_APAR_EEOB_PARAMS",$J,"RCPAYR") - P1^P2^P3 Where:
+4 ; P1- All Payers/Range of Payers
+5 ; ("A": All/"R":Range of Payers)
+6 ; P2- START WITH PAYER (e.g.,'AET')
+7 ; (Range Limited Only)
+8 ; P3- GO TO PAYER (e.g.,'AETZ')
+9 ; (Range Limited Only)
+10 ; ^TMP("RCDPE_APAR_EEOB_PARAMS",$J,"RCMEDRX")- (M)edical, (P)harmacy, or (B)
+11 ;
+12 ; ^TMP("RCDPE_APAR_EEOB_PARAMS",$J,"SORT") - P1^P2 Where
+13 ; P1 - Sort Type
+14 ; "N" - Payer Name
+15 ; "P" - Posted Amount
+16 ; "R" - Auto-Post Reject Reason
+17 ; "U" - Unposted Amount
+18 ; P2 - H - Highest to Lowest Amount
+19 ; L - Lowest to Highest Amount
+20 ; ""- If P1="N" or "P"
+21 ; Returns: 1 if user ^ arrowed or timed out, 0 otherwise
+22 ;PRCA*4.5*321 added RCQUIT
NEW RCQUIT,RCXPAR,USEPVW,XX
+23 ;PRCA*4.5*321 initialise USEPW
SET (RCQUIT,USEPVW)=0
+24 ; Retrieve user's saved preferred view (if any)
+25 if SOURCE="MO"
DO GETWLPVW(.RCXPAR)
+26 ;
+27 ;Only ask user if they want to use their preferred view in the following scenarios:
+28 ; a) Source is "MO" and user has a preferred view on file
+29 ; b) Source is "CV" (change view action), user has a preferred view but is
+30 ; not using the preferred view criteria at this time.
+31 SET XX=$$PREFVW(SOURCE)
+32 ; PRCA*4.5*321 - move Q:USEPVW
IF ((XX=1)&(SOURCE="MO"))!((XX=0)&(SOURCE="CV"))
Begin DoDot:1
+33 ;
+34 ; Ask the user if they want to use the preferred view
+35 SET USEPVW=$$ASKUVW^RCDPEWL0()
+36 IF USEPVW=-1
SET RCQUIT=1
QUIT
+37 if 'USEPVW
QUIT
+38 ;
+39 ; Set the Sort/Filtering Criteria from the preferred view
+40 MERGE ^TMP("RCDPE_APAR_EEOB_PARAMS",$JOB)=^TMP("RCDPE_APAR_PVW",$JOB)
End DoDot:1
+41 ;
+42 ; PRCA*4.5*321 - Start modified code block
+43 if USEPVW
QUIT 0
+44 if RCQUIT
QUIT 1
+45 ; PRCA*4.5*326 prompt for type filter first in case we need to use it in payer selection
+46 ; Select Medical or Pharmacy, or Tricare
SET RCQUIT=$$MORP()
+47 if RCQUIT
QUIT 1
+48 ; Select Payer(s)
SET RCQUIT=$$PAYR()
+49 if RCQUIT
QUIT 1
+50 ; Select Sort
SET RCQUIT=$$SORT()
+51 if RCQUIT
QUIT 1
+52 ; Save Preferred View
SET RCQUIT=$$SAVEPVW()
+53 if RCQUIT
QUIT 1
+54 QUIT 0
+55 ; PRCA*4.5*321 - End modified code block
+56 ;
GETWLPVW(RCXPAR) ; Retrieves the preferred view settings for the APAR worklist
+1 ; for the user
+2 ; PRCA*4.5*317 - Added subroutine
+3 ; Input: None
+4 ; Output: RCXPAR() - Array of preferred view sort/filter criteria
+5 ; ^TMP("RCDPE_APAR_EEOB_PARAMS",$)- Global array of preferred view settings
+6 NEW XX
+7 KILL ^TMP("RCDPE_APAR_EEOB_PARAMS",$JOB)
+8 DO GETLST^XPAR(.RCXPAR,"USR","RCDPE APAR","I")
+9 if $DATA(RCXPAR("ALL_PAYERS/RANGE_OF_PAYERS"))
DO PVWSAVE(.RCXPAR)
+10 ;
+11 SET XX=$GET(RCXPAR("ALL_PAYERS/RANGE_OF_PAYERS"))
+12 SET ^TMP("RCDPE_APAR_EEOB_PARAMS",$JOB,"RCPAYR")=$SELECT(XX'="":$TRANSLATE(XX,";","^"),1:"A")
+13 SET XX=$GET(RCXPAR("MEDICAL/PHARMACY"))
+14 ; PRCA*4.5*326 Default A
SET ^TMP("RCDPE_APAR_EEOB_PARAMS",$JOB,"RCMEDRX")=$SELECT(XX'="":$TRANSLATE(XX,";","^"),1:"A")
+15 ; PRCA&4.5*321 - add sort to preferened view
+16 SET XX=$GET(RCXPAR("SORT"))
+17 SET ^TMP("RCDPE_APAR_EEOB_PARAMS",$JOB,"SORT")=$SELECT(XX'="":$TRANSLATE(XX,";","^"),1:"N")
+18 QUIT
+19 ;
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("RCDPE_APAR_PVW",$JOB)
+6 ; only continue if we have answers to all APAR related preferred view prompts
+7 if '$DATA(RCXPAR("ALL_PAYERS/RANGE_OF_PAYERS"))
QUIT
+8 if '$DATA(RCXPAR("MEDICAL/PHARMACY"))
QUIT
+9 ; PRCA*4.5*321
if '$DATA(RCXPAR("SORT"))
QUIT
+10 ;
+11 SET ^TMP("RCDPE_APAR_PVW",$JOB,"RCPAYR")=$TRANSLATE(RCXPAR("ALL_PAYERS/RANGE_OF_PAYERS"),";","^")
+12 SET ^TMP("RCDPE_APAR_PVW",$JOB,"RCMEDRX")=$TRANSLATE(RCXPAR("MEDICAL/PHARMACY"),";","^")
+13 ; PRCA*4.5*321
SET ^TMP("RCDPE_APAR_PVW",$JOB,"SORT")=$TRANSLATE(RCXPAR("SORT"),";","^")
+14 QUIT
+15 ;
PREFVW(SOURCE,RCXPAR) ; 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 Lockbox menu
+4 ; option
+5 ; 'CV' - When called from the Change View
+6 ; action
+7 ; RCXPAR - Array of preferred view values
+8 ; ^TMP("RCDPE_APAR_EEOB_PARAMS")- Global array of currently in use defaults
+9 ; ^TMP("RCDPE_APAR_PVW",$J) - Global array of preferred view settings
+10 ;
+11 ; Returns: 1 - User has preferred view if SOURCE is 'MO' or is using
+12 ; their preferred view if SOURCE is 'CV'
+13 ; 0 - User is not using their preferred view
+14 ; -1 - User does not have a preferred view
+15 ;
+16 IF SOURCE="MO"
QUIT $SELECT($DATA(^TMP("RCDPE_APAR_PVW",$JOB)):1,1:-1)
+17 ; No stored preferred view
if '$DATA(^TMP("RCDPE_APAR_PVW",$JOB))
QUIT -1
+18 if $GET(^TMP("RCDPE_APAR_EEOB_PARAMS",$JOB,"RCPAYR"))'=$GET(^TMP("RCDPE_APAR_PVW",$JOB,"RCPAYR"))
QUIT 0
+19 if $GET(^TMP("RCDPE_APAR_EEOB_PARAMS",$JOB,"RCMEDRX"))'=$GET(^TMP("RCDPE_APAR_PVW",$JOB,"RCMEDRX"))
QUIT 0
+20 ; PRCA*4.5*321
if $GET(^TMP("RCDPE_APAR_EEOB_PARAMS",$JOB,"SORT"))'=$GET(^TMP("RCDPE_APAR_PVW",$JOB,"SORT"))
QUIT 0
+21 QUIT 1
+22 ;
PAYR() ; Payer Selection
+1 ; Input: ^TMP("RCDPE_APAR_EEOB_PARAMS",$J,"RCPAYR") - Current payer selection setting
+2 ; Output: ^TMP("RCDPE_APAR_EEOB_PARAMS",$J,"RCPAYR") - Updated payer selection setting
+3 ; RCQUIT=1 if user ^ or timed out
+4 ; Returns: 1 if user ^ arrowed or time out
+5 NEW DIR,DIRUT,DIROUT,DUOUT,DTOUT,RCPAYR,RCPAYRDF,RCXPAR,RCDRLIM,RCERROR,RCAUTOPDF
+6 NEW RCTYPEDF,RCQ,X,XX,Y
+7 SET RCPAYRDF=$GET(^TMP("RCDPE_APAR_EEOB_PARAMS",$JOB,"RCPAYR"))
+8 SET RCQUIT=0
+9 KILL DIR
+10 SET DIR(0)="SA^A:ALL;R:RANGE"
+11 SET DIR("A")="(A)LL payers, (R)ANGE of payer names: "
+12 SET DIR("B")="ALL"
+13 SET DIR("?",1)="Entering ALL will select all payers."
+14 SET DIR("?")="If RANGE is entered, you will be prompted for a payer range."
+15 ;Stored preferred view, use as default
if $PIECE(RCPAYRDF,"^")'=""
SET DIR("B")=$PIECE(RCPAYRDF,"^")
+16 WRITE !
+17 DO ^DIR
+18 IF $DATA(DTOUT)!$DATA(DUOUT)
SET RCQUIT=1
QUIT 1
+19 SET RCPAYR=Y
+20 IF RCPAYR="A"
SET ^TMP("RCDPE_APAR_EEOB_PARAMS",$JOB,"RCPAYR")=Y
QUIT 0
+21 IF RCPAYR="R"
Begin DoDot:1
+22 WRITE !,"Names you select here will be the payer names from the ERA, NOT the INS File"
+23 KILL DIR
+24 SET DIR("?")="Enter a name between 1 and 30 characters in UPPERCASE"
+25 SET DIR(0)="FA^1:30^K:X'?.U X"
SET DIR("A")="Start with payer name: "
+26 ;Stored preferred view, use as default
if $PIECE(RCPAYRDF,"^",2)'=""
SET DIR("B")=$PIECE(RCPAYRDF,"^",2)
+27 WRITE !
+28 DO ^DIR
+29 IF $DATA(DTOUT)!$DATA(DUOUT)
Begin DoDot:2
+30 SET RCQUIT=1
QUIT
+31 KILL ^TMP("RCDPE_APAR_EEOB_PARAMS",$JOB,"RCPAYR")
End DoDot:2
QUIT
+32 SET RCPAYR("FROM")=Y
+33 KILL DIR
+34 SET DIR("?")="Enter a name between 1 and 30 characters in UPPERCASE"
+35 SET DIR(0)="FA^1:30^K:X'?.U X"
SET DIR("A")="Go to payer name: "
+36 SET DIR("B")=$EXTRACT(RCPAYR("FROM"),1,27)_"ZZZ"
+37 WRITE !
DO ^DIR
KILL DIR
+38 IF $DATA(DTOUT)!$DATA(DUOUT)
SET RCQUIT=1
QUIT
+39 SET ^TMP("RCDPE_APAR_EEOB_PARAMS",$JOB,"RCPAYR")=RCPAYR_"^"_RCPAYR("FROM")_"^"_Y
End DoDot:1
if RCQUIT
QUIT RCQUIT
+40 QUIT 0
+41 ;
MORP() ; Ask for Medical or Pharmacy, Tricare (Or All)
+1 ; Input: None
+2 ; Returns: 1 if user ^ arrowed or timed out, 0 otherwise
+3 NEW DEF
+4 SET DEF=$GET(^TMP("RCDPE_APAR_EEOB_PARAMS",$JOB,"RCMEDRX"))
+5 ; PRCA*4.5*326
SET DEF=$SELECT(DEF="P":"PHARMACY",DEF="M":"MEDICAL",DEF="T":"TRICARE",1:"ALL")
+6 ; PRCA*4.5*326
SET RCQ=$$RTYPE^RCDPEU1(DEF)
+7 IF RCQ=-1
QUIT 1
+8 SET ^TMP("RCDPE_APAR_EEOB_PARAMS",$JOB,"RCMEDRX")=RCQ
+9 QUIT 0
+10 ;
SORT() ; Ask for Sort - Payer, Dollar, Date, Trace Number
+1 ; Input: None
+2 ; Returns: 1 if user ^ arrowed or timed out, 0 otherwise
+3 NEW DEF,DIR,DIRUT,DTOUT,DUOUT,P1,X,XX,Y
+4 SET DEF=$PIECE($GET(^TMP("RCDPE_APAR_EEOB_PARAMS",$JOB,"SORT")),"^",1)
+5 SET DEF=$SELECT(DEF="D":"DATE",DEF="N":"PAYER NAME",DEF="P":"POSTED",DEF="R":"REASON",DEF="U":"UNPOSTED",1:"")
+6 SET DIR(0)="SA^D:DATE;N:PAYER NAME;P:POSTED;R:REASON;U:UNPOSTED"
+7 SET DIR("A")="Sort By (D)ATE, PAYER (N)AME, (R)EASON, (P)OSTED, (U)NPOSTED: "
+8 SET DIR("B")=$SELECT(DEF'="":DEF,1:"DATE")
+9 SET DIR("?",1)="Enter 'DATE' to sort by date created."
+10 SET DIR("?",2)="Enter 'PAYER NAME' to sort by payer name."
+11 SET DIR("?",3)="Enter 'REASON' to sort by auto-post reject reason."
+12 SET DIR("?",4)="Enter 'POSTED' to sort by the posted amount."
+13 SET DIR("?")="Enter 'UNPOSTED' to sort by the unposted amount."
+14 WRITE !
+15 DO ^DIR
+16 IF $DATA(DTOUT)!$DATA(DUOUT)
QUIT 1
+17 IF Y="N"!(Y="R")
Begin DoDot:1
+18 SET ^TMP("RCDPE_APAR_EEOB_PARAMS",$JOB,"SORT")=Y
End DoDot:1
QUIT 0
+19 ;
+20 SET P1=Y
SET XX=""
+21 IF P1="P"!(P1="U")
SET XX=$$HTOL()
IF XX=-1
QUIT 1
+22 IF P1="D"
SET XX=$$DATEORD()
IF XX=-1
QUIT 1
+23 SET ^TMP("RCDPE_APAR_EEOB_PARAMS",$JOB,"SORT")=P1_"^"_XX
+24 QUIT 0
+25 ;
HTOL() ; Ask for how dollar amounts should be sorted - either highest to
+1 ; lowest amount or lowest to highest amount
+2 ; Input: None
+3 ; Returns: -1 - if user ^ arrowed or timed out
+4 ; H - Highest to Lowest
+5 ; L - Lowest to Highest
+6 NEW DEF,DIR,DIRUT,DTOUT,DUOUT,P1,X,Y
+7 SET DEF=$PIECE($GET(^TMP("RCDPE_APAR_EEOB_PARAMS",$JOB,"SORT")),"^",2)
+8 SET DEF=$SELECT(DEF="H":"HIGHEST TO LOWEST",DEF="L":"LOWEST TO HIGHEST",1:"")
+9 SET DIR(0)="SA^H:HIGHEST TO LOWEST;L:LOWEST TO HIGHEST"
+10 SET DIR("A")="Sort By (H)IGHEST TO LOWEST or (L)OWEST TO HIGHEST: "
+11 SET DIR("B")=$SELECT(DEF'="":DEF,1:"HIGHEST TO LOWEST")
+12 SET DIR("?",1)="Enter 'HIGHEST TO LOWEST' to sort amounts in decreasing order."
+13 SET DIR("?")="Enter 'LOWEST TO HIGHEST' to sort amounts in increasing order."
+14 WRITE !
+15 DO ^DIR
+16 IF $DATA(DTOUT)!$DATA(DUOUT)
QUIT -1
+17 QUIT Y
DATEORD() ; Ask how creation date should be sorted - ascending or descending
+1 ; Input: None
+2 ; Returns: -1 - if user ^ arrowed or timed out
+3 ; H - Descending (Highest to lowest)
+4 ; L - Ascending (Lowest to Highest)
+5 NEW DEF,DIR,DIRUT,DTOUT,DUOUT,P1,X,Y
+6 SET DEF=$PIECE($GET(^TMP("RCDPE_APAR_EEOB_PARAMS",$JOB,"SORT")),"^",2)
+7 SET DEF=$SELECT(DEF="H":"DESCENDING",DEF="L":"ASCENDING",1:"")
+8 SET DIR(0)="SA^A:ASCENDING;D:DESCENDING"
+9 SET DIR("A")="Sort in (A)SCENDING or (D)ESCENDING order: "
+10 SET DIR("B")=$SELECT(DEF'="":DEF,1:"ASCENDING")
+11 SET DIR("?",1)="Enter 'ASCENDING' to see oldest EEOBs first."
+12 SET DIR("?")="Enter 'DESCENDING' to see newest EEOBs first."
+13 WRITE !
+14 DO ^DIR
+15 IF $DATA(DTOUT)!$DATA(DUOUT)
QUIT -1
+16 SET Y=$SELECT(Y="D":"H",1:"L")
+17 QUIT Y
SAVEPVW() ; Option to save as User Preferred View
+1 ; PRCA*4.5*317 added subroutine
+2 ; Input: ^TMP("RCDPE_APAR_EEOB_PARAMS",$J) - Global array of current worklist settings
+3 ; Output Current worklist settings set as preferred view (potentially)
+4 ; ^TMP("RCDPE_APAR_PVW",$J) - Global array of preferred view settings
+5 ; Returns: 1 - User ^ arrowed or timed out, 0 otherwise
+6 NEW DIR,DIRUT,DIROUT,DTOUT,DUOUT,X,XX,Y
+7 KILL DIR
+8 WRITE !
+9 SET DIR(0)="YA"
SET DIR("B")="NO"
+10 SET DIR("A")="Do you want to save this as your preferred view (Y/N)? "
+11 DO ^DIR
+12 ; PRCA*4.5*321 ; Start modified code block
+13 IF $DATA(DTOUT)!$DATA(DUOUT)
QUIT 1
+14 IF Y=1
Begin DoDot:1
+15 SET XX=^TMP("RCDPE_APAR_EEOB_PARAMS",$JOB,"RCPAYR")
+16 DO EN^XPAR(DUZ_";VA(200,","RCDPE APAR","ALL_PAYERS/RANGE_OF_PAYERS",$TRANSLATE(XX,"^",";"),.RCERROR)
+17 SET XX=^TMP("RCDPE_APAR_EEOB_PARAMS",$JOB,"RCMEDRX")
+18 DO EN^XPAR(DUZ_";VA(200,","RCDPE APAR","MEDICAL/PHARMACY",XX,.RCERROR)
+19 SET XX=^TMP("RCDPE_APAR_EEOB_PARAMS",$JOB,"SORT")
+20 DO EN^XPAR(DUZ_";VA(200,","RCDPE APAR","SORT",$TRANSLATE(XX,"^",";"),.RCERROR)
+21 ;
+22 ;Capture new preferred settings for comparison
+23 KILL ^TMP("RCDPE_APAR_PVW",$JOB)
+24 MERGE ^TMP("RCDPE_APAR_PVW",$JOB)=^TMP("RCDPE_APAR_EEOB_PARAMS",$JOB)
End DoDot:1
+25 QUIT 0
+26 ; PRCA*4.5*321 ; End modified code block
+27 ;
FILTER(RCDA) ; Returns 1 if record in entry 344.4 passes
+1 ; the edits for the APAR worklist selection of EEOBs
+2 ; Parameters found in ^TMP("RCDPE_APAR_EEOB_PARAMS",$J)
+3 ;
+4 ; Input: RCDA - Internal IEN OF 344.4
+5 ; Returns: 1 if the ERA Record passes filters, 0 otherwise
+6 ; PRCA*4.5*321 - Start modified code block
+7 NEW OK,RCECME,RCERATYP,RCIEN,RCPAYR,RCPAYFR,RCPAYTO,XX
+8 SET OK=1
+9 ;
+10 SET RCPAYR=$PIECE($GET(^TMP("RCDPE_APAR_EEOB_PARAMS",$JOB,"RCPAYR")),U,1)
+11 SET RCPAYFR=$PIECE($GET(^TMP("RCDPE_APAR_EEOB_PARAMS",$JOB,"RCPAYR")),U,2)
+12 SET RCPAYTO=$PIECE($GET(^TMP("RCDPE_APAR_EEOB_PARAMS",$JOB,"RCPAYR")),U,3)
+13 SET RCERATYP=$GET(^TMP("RCDPE_APAR_EEOB_PARAMS",$JOB,"RCMEDRX"))
+14 ; Payer name filter
+15 IF RCPAYR'="A"
Begin DoDot:1
+16 ; Payer Name
SET XX=$$GET1^DIQ(344.4,RCDA,.06,"I")
+17 SET XX=$$UP^XLFSTR(XX)
+18 ;
+19 ; Make sure the Payer is in the selected Payer range
+20 IF $SELECT(XX=RCPAYFR:1,XX=RCPAYTO:1,XX]RCPAYFR:RCPAYTO]XX,1:0)
QUIT
+21 SET OK=0
End DoDot:1
if 'OK
QUIT OK
+22 ;
+23 ; ERA Type (Medical/Pharmacy) filter
+24 ; PRCA*4.5*326
IF RCERATYP'="A"
Begin DoDot:1
+25 ; PRCA*4.5*326
IF '$$ISTYPE^RCDPEU1(344.4,RCDA,RCERATYP)
SET OK=0
End DoDot:1
+26 QUIT OK
+27 ; PRCA*4.5*321 - End modified code block
+28 ;
ENTEREOB ; EP Protocol action - RCDPE APAR SELECT EEOB
+1 ; Enter the APAR EEOB SCRATCHPAD
+2 NEW RCDA,RCDA1,RCIENS,X,XQORM
+3 SET VALMBCK="R"
+4 SET RCIENS=$$SEL()
+5 IF 'RCIENS
DO INIT
QUIT
+6 DO EN^VALM("RCDPE APAR SELECTED EEOB")
+7 DO INIT
+8 QUIT
+9 ;
SEL() ; Select an item from the APAR list of EEOBs
+1 ; Input: None
+2 ; Returns: RCIENS - Internal IENs A1^A2^A3 Where:
+3 ; A1 - IEN for in file 344.49
+4 ; A2 - IEN for subfile 344.491
+5 ; A3 - Selectable line item from listman screen
+6 NEW RCDA,RCITEMS,RCSEQ,VALMY
+7 DO FULL^VALM1
+8 DO EN^VALM2($GET(XQORNOD(0)),"S")
+9 SET (RCSEQ,RCDA,RCITEMS)=0
+10 FOR
Begin DoDot:1
+11 SET RCSEQ=$ORDER(VALMY(RCSEQ))
+12 if 'RCSEQ
QUIT
+13 SET RCITEMS=$PIECE($GET(^TMP("RCDPE-APAR_EEOB_WLDX",$JOB,RCSEQ)),U,2,3)_U_RCSEQ
End DoDot:1
if 'RCSEQ
QUIT
+14 QUIT RCITEMS
+15 ;
CV ;
+1 ; Change View action for APAR pick list
+2 DO FULL^VALM1
DO PARAMS("CV")
+3 DO HDR
DO INIT
SET VALMBCK="R"
SET VALMBG=1
+4 QUIT
