RCDPEWLD ;ALB/CLT - Continuation of routine RCDPEWL0 ;09 DEC 2016
;;4.5;Accounts Receivable;**252,317,321,326,332,424,432**;Mar 20, 1995;Build 16
;Per VA Directive 6402, this routine should not be modified.
Q
;
PROV(RCSCR,RCSCR1,RCXM1,RC) ;Get prov data from ERA (FILE 344.4) and claim (FILE 399)
N RCXXX,RCYYY,RCDPEPV,RCCLAIM,RCIEN,RCBILL,RCID,RCBLANK,RCNPI,DIC,X,Y
N RCPROV,RCEXP,XUSNPI,RCRTN,RCBNM,RCCOM1,RCCOM2,RCWARN,RCYNODE3
;
S RCBLANK="" F X=1:1:30 S RCBLANK=RCBLANK_" "
S RC=RC+1 S RCXM1(RC-1)=RCBLANK
S RCYNODE3=$G(^RCY(344.4,RCSCR,1,RCSCR1,3))
;
LKBOX ;Get provider data from ELECTRONIC REMITTANCE ADVICE file (#344.4)
S RC=RC+1,RCXM1(RC-1)=$E("**EOB PROVIDER(S)/NPI"_$J(" ",39),1,39)_"CLAIM PROVIDER(S)/NPI**" ;setting sub-header for worklist
S RC=RC+1,RCXM1(RC-1)=$E("---------------------"_$J(" ",39),1,39)_"-----------------------"
;
S RCPROV="BILLING",$P(RCYYY(RCPROV),U,3)=0 ; piece 3 initialize for error msgs
I $P(RCYNODE3,U)'="" S RCYYY(RCPROV)="/"_$P(RCYNODE3,U) ; Billing Prov NPI
;
S RCPROV="RENDERING"
I $P(RCYNODE3,U,3)=2 S RCPROV="SERVICING"
I $P(RCYNODE3,U,3)="",($P(RCYNODE3,U,4)'[","),($P(RCYNODE3,U,4)'="") S RCPROV="SERVICING"
I $P(RCYNODE3,U,2)'=""!($P(RCYNODE3,U,4)'="") S RCYYY(RCPROV)=$E($P(RCYNODE3,U,4),1,20)_"/"_$P(RCYNODE3,U,2)
S $P(RCYYY(RCPROV),U,3)=0 ; initialize for error msgs
D NPICHK ; RCPROV has to be "RENDERING" or "SERVICING" when this tag is called !
;
CLAIM ;Retrieve provider data from the claim
S RCCLAIM=$$GET1^DIQ(361.1,$P(^RCY(344.4,RCSCR,1,RCSCR1,0),U,2),.01) ;determine claim num based on entry in 344.4
S DIC="^DGCR(399,",DIC(0)="",X=RCCLAIM D ^DIC S RCCLAIM=+Y ;find ien for file 399
D GETS^DIQ(399,RCCLAIM,"222*","IE","RCXXX") ;retrieve prov information
S RCBILL=$$GET1^DIQ(399,RCCLAIM,.22,"I") ;retrieve default division
S RCBNM=$$GET1^DIQ(4,$$GET1^DIQ(40.8,RCBILL,.07,"I"),.01) ;get name from institution file
S RCBILL=$$GET1^DIQ(4,$$GET1^DIQ(40.8,RCBILL,.07,"I"),41.99) ;get NPI from institution file
;
S $P(RCYYY("BILLING"),U,2)=RCBNM_"/"_RCBILL_"^"_0 ;NPI set into local array
I $D(RCXXX) S RCPROV="" F S RCPROV=$O(RCXXX(399.0222,RCPROV)) Q:RCPROV="" D ;loop through claim providers
. S RCIEN=$P(RCXXX(399.0222,RCPROV,.02,"I"),";",1)
. S RCID=$S($P(RCXXX(399.0222,RCPROV,.02,"I"),";",2)["VA(200":"Individual_ID",1:"Non_VA_Provider_ID")
. S RCNPI=$$NPI^XUSNPI(RCID,RCIEN) ;retrieve provider NPI
. S $P(RCYYY(RCXXX(399.0222,RCPROV,.01,"E")),U,2)=$E(RCXXX(399.0222,RCPROV,.02,"E"),1,20)_"/"_$S(+RCNPI=0:"No NPI on file",+RCNPI=-1:"Can't look up NPI",1:+RCNPI)
. S:$P(RCYYY(RCXXX(399.0222,RCPROV,.01,"E")),U,3)="" $P(RCYYY(RCXXX(399.0222,RCPROV,.01,"E")),U,3)=0
LINESET ;SET THE PRINT LINES
S (RCWARN,RCPROV)="" F S RCPROV=$O(RCYYY(RCPROV)) Q:RCPROV="" D ;loop through the found provider types
. S RC=RC+1 ;increment line counter
. ; build display detail line
. S RCXM1(RC-1)=RCPROV_": "_$P(RCYYY(RCPROV),U,1)
. I $L(RCXM1(RC-1))>39 D
.. S RCXM1(RC-1)=$E($P(RCXM1(RC-1),"/"),1,27)_"/"_$P(RCXM1(RC-1),"/",2)
. S RCXM1(RC-1)=$E(RCXM1(RC-1)_RCBLANK,1,39)_$P(RCYYY(RCPROV),U,2)
. I $P(RCYYY(RCPROV),U,3)'=0 S RCWARN=$P(RCYYY(RCPROV),U,3)
I RCWARN'="" D
. S RC=RC+1,RCXM1(RC-1)=" " ;Blank line for separation
. S RC=RC+1,RCXM1(RC-1)="Rendering/Servicing Provider NPI Warning:"
. S RC=RC+1,RCXM1(RC-1)=RCWARN
S RC=RC+1,RCXM1(RC-1)=" " ;Blank line to separate from possible comments
S RCCOM1=$P(RCYNODE3,U,5),RCCOM2=$P(RCYNODE3,U,6) D ;Error in NPI format
. I $G(RCCOM1)'="" S RC=RC+1,RCXM1(RC-1)=RCCOM1
. I $G(RCCOM2)'="" S RC=RC+1,RCXM1(RC-1)=RCCOM2
Q
;
NPICHK ;CHECK THAT THE NPI RETURNED MATCHES THE ENTITY TYPE QUALIFIER
S RCEXP="" Q:$P(RCYNODE3,U,3)="" ; ENTITY TYPE QUALIFIER
;
S RCCOM2=$P(RCYNODE3,U,6) ; Ren/Serv comment
S XUSNPI=$P(RCYNODE3,U,2)
I RCCOM2="",(XUSNPI="") S RCEXP="**NO SERVICING/RENDERING NPI INCLUDED IN 835**" D EXPSET Q
S RCRTN=$$QI^XUSNPI(XUSNPI)
I $P(RCRTN,U,1)="Individual_ID" D Q
. I $P(RCYNODE3,U,3)'=1 S RCEXP="**NPI from 835 indicated organizational but is associated with an individual**" D EXPSET Q
I $P(RCRTN,U,1)="Organization_ID" D Q
. I $P(RCYNODE3,U,3)'=2 S RCEXP="**NPI from 835 indicated individual but is associated with an organization**" D EXPSET Q
I $E($P(RCRTN,U,1),1,3)="Non" D Q
. N RCIEN,RCTYPE S RCIEN=$P(RCRTN,U,2),RCTYPE=$$GET1^DIQ(355.93,RCIEN,.02,"I") Q:$G(RCTYPE)=""
. I $P(RCYNODE3,U,3)=1,RCTYPE=1 S RCEXP="**NPI from 835 indicated individual but is associated with an organization**" D EXPSET Q
. I $P(RCYNODE3,U,3)=2,RCTYPE=2 S RCEXP="**NPI from 835 indicated organizational but is associated with an individual**" D EXPSET Q
I RCCOM2="",(+RCRTN=0) S RCEXP="**The NPI returned on the 835 is not associated with this VistA system**" D EXPSET Q
Q
;
EXPSET ;SET THE PRINT LINE WITH THE ERROR AS DEFINED IN RCEXP
S $P(RCYYY(RCPROV),U,3)=RCEXP
Q
;
PARAMS(RCQUIT) ;PARAMETERS ENTRY CONTINUED FROM RCDPEWL0
I $G(RCQUIT) K ^TMP("RCERA_PARAMS",$J)
PARMSQ ;
Q
;
PARAMS2() ;EP from RCDPEWL0
; PRCA*4.5*317 - Moved due to routine size issues
; Input: None
; Returns: RCQUIT - 1 if user ^ or timed out, 0 otherwise
S RCQUIT=$$PAYMNT() ; Ask for zero/payment PRCA*4.5*321
Q:RCQUIT 1 ; PRCA*4.5*321
S RCQUIT=$$POSTSTAT() ; Ask Posting Status
Q:RCQUIT 1
S RCQUIT=$$POSTMETH ; Ask Posting Method
Q:RCQUIT 1
S RCQUIT=$$MATCHST ; Ask ERA-EFT Matching Status
Q:RCQUIT 1
S RCQUIT=$$CLAIMTYP() ; Ask Claim Type
Q:RCQUIT 1
S RCQUIT=$$PAYR() ; Ask for selected payers
Q RCQUIT
;
PAYMNT() ; Payment Type (Zero/Payment or Both) Selection ; PRCA*4.5*321 this whole subroutine
; Input: ^TMP("RCERA_PARAMS") - Global array of preferred values (if any)
; Output: ^TMP("RCERA_PARAMS",$J,"RCPAYMNT") - ERA Posting Status filter
; Returns: 1 if user quit or timed out, 0 otherwise
N DIR,DTOUT,DUOUT,RCTYPEDF
S RCTYPEDF=$G(^TMP("RCERA_PARAMS",$J,"RCPAYMNT"))
K DIR S DIR(0)="SA^Z:ZERO;P:PAYMENT;B:BOTH"
S DIR("A")="(Z)ERO, (P)AYMENT, or (B)OTH: "
S DIR("B")="B"
S DIR("?",1)="Select ZERO to only see ERAs with a zero total amount paid."
S DIR("?",2)="Select PAYMENT to only see ERAs with a non-zero amount paid."
S DIR("?")="Select BOTH to see both zero and non-zero amount ERAs."
S:RCTYPEDF'="" DIR("B")=RCTYPEDF ;Stored preferred value, use as default
W !
D ^DIR
I $D(DTOUT)!$D(DUOUT) Q 1
S ^TMP("RCERA_PARAMS",$J,"RCPAYMNT")=Y
Q 0
;
POSTSTAT() ; ERA Posting Status (Posted/Unposted/Both) Selection
; Input: ^TMP("RCERA_PARAMS") - Global array of preferred values (if any)
; Output: ^TMP("RCERA_PARAMS",$J,"RCPOST")- ERA Posting Status filter
; Returns: 1 if user quit or timed out, 0 otherwise
N DIR,DTOUT,DUOUT,RCPOSTDF
S RCPOSTDF=$G(^TMP("RCERA_PARAMS",$J,"RCPOST"))
K DIR S DIR(0)="SA^U:UNPOSTED;P:POSTED;B:BOTH"
S DIR("A")="ERA posting status: (U)NPOSTED, (P)OSTED, or (B)OTH: "
S DIR("B")="U"
S DIR("?",1)="Select UNPOSTED to only see ERAs with a status of UNPOSTED."
S DIR("?",2)="Select POSTED to only see ERAs with a status of POSTED."
S DIR("?")="Select BOTH to see both unposted and posted ERAs."
S:RCPOSTDF'="" DIR("B")=RCPOSTDF ; Stored preferred value, use as default
W !
D ^DIR
I $D(DTOUT)!$D(DUOUT) Q 1
S ^TMP("RCERA_PARAMS",$J,"RCPOST")=Y
Q 0
;
POSTMETH() ; PRCA*4.5*317 moved from RCDPEWL0 because of routine size issues
; ERA Posting Method (Auto-Posting/Non Auto-Posting/Both) Selection
; Input: ^TMP("RCERA_PARAMS") - Global array of preferred values (if any)
; Output: ^TMP("RCERA_PARAMS",$J,"RCAUTOP")- ERA Posting Status filter
; Returns: 1 if user quit or timed out, 0 otherwise
N DIR,DTOUT,DUOUT,RCAUTOPDF
P1 S RCAUTOPDF=$G(^TMP("RCERA_PARAMS",$J,"RCAUTOP")) ; PRCA*4.5*326
K DIR S DIR(0)="SA^A:AUTO-POSTING;N:NON AUTO-POSTING;B:BOTH"
S DIR("A")="Display (A)UTO-POSTING, (N)ON AUTO-POSTING, or (B)OTH: "
S DIR("B")="B"
S DIR("?",1)="Select AUTO-POSTING to only see auto-posted ERAs."
S DIR("?",2)="Select NON AUTO-POSTING to only see ERAs that were NOT auto-posted."
S DIR("?")="Select BOTH to see both auto-posted and non auto-posted ERAs."
S:RCAUTOPDF'="" DIR("B")=RCAUTOPDF ;Stored preferred value, use as default
W !
D ^DIR
I $D(DTOUT)!$D(DUOUT) Q 1
S ^TMP("RCERA_PARAMS",$J,"RCAUTOP")=Y
; If including auto-post ERA ask for auto-post status filters
I Y'="N" Q $$AUTOPST() ; PRCA*4.5*326
Q 0
;
MATCHST() ; ERA-EFT Matching Status(Matched/Unmatched/Both) Selection
; Input: ^TMP("RCERA_PARAMS") - Global array of preferred values (if any)
; Output: ^TMP("RCERA_PARAMS",$J,"RCMATCH")- ERA Posting Status filter
; Returns: 1 if user quit or timed out, 0 otherwise
N DIR,DTOUT,DUOUT,RCMATCHD
M1 S RCMATCHD=$G(^TMP("RCERA_PARAMS",$J,"RCMATCH")) ; PRCA*4.5*326
K DIR S DIR(0)="SA^N:NOT MATCHED;M:MATCHED;B:BOTH"
S DIR("A")="ERA-EFT match status: (N)OT MATCHED, (M)ATCHED, or (B)OTH: "
S DIR("B")="B"
S DIR("?",1)="Select NOT MATCHED to only see unmatched ERAs."
S DIR("?",2)="Select MATCHED to only see matched ERAs."
S DIR("?")="Select BOTH to see both matched and unmatched ERAs."
S:RCMATCHD'="" DIR("B")=RCMATCHD ;Stored preferred value, use as default
W !
D ^DIR
I $D(DTOUT)!$D(DUOUT) Q 1
G:'$$VALM(Y) M1 ; PRCA*4.5*326
S ^TMP("RCERA_PARAMS",$J,"RCMATCH")=Y
Q 0
;
CLAIMTYP() ; Claim Type (Medical/Pharmacy/Tricare/CHAMPVA/Both) Selection
; Input: ^TMP("RCERA_PARAMS") - Global array of preferred values (if any)
; Output: ^TMP("RCERA_PARAMS",$J,"RCTYPE") - ERA Posting Status filter
; Returns: 1 if user quit or timed out, 0 otherwise
N DIR,DTOUT,DUOUT,RCTYPEDF
S RCTYPEDF=$G(^TMP("RCERA_PARAMS",$J,"RCTYPE"))
; PRCA*4.5*321 - Changed set of codes and help
K DIR S DIR(0)="SA^M:MEDICAL;P:PHARMACY;T:TRICARE;C:CHAMPVA;A:ALL" ;PRCA*4.5*432 CHAMPVA
S DIR("A")="(M)EDICAL, (P)HARMACY, (T)RICARE, (C)HAMPVA or (A)LL: " ;PRCA*4.5*432 CHAMPVA
S DIR("B")="A"
S DIR("?",1)="Select MEDICAL to only see ERAs with a payer type of medical."
S DIR("?",2)="Select PHARMACY to only see ERAs with a payer type of pharmacy."
S DIR("?",3)="Select TRICARE to only see ERAs with a payer type of Tricare."
S DIR("?",4)="Select CHAMPVA to only see ERAs with a payer type of CHAMPVA." ;PRCA*4.5*432 CHAMPVA
S DIR("?")="Select ALL to see medical, pharmacy, Tricare, and CHAMPVA ERAs." ;PRCA*4.5*432 CHAMPVA
; PRCA*4.5*321 - End modified code block
S:RCTYPEDF'="" DIR("B")=RCTYPEDF ;Stored preferred value, use as default
W !
D ^DIR
I $D(DTOUT)!$D(DUOUT) Q 1
S ^TMP("RCERA_PARAMS",$J,"RCTYPE")=Y
Q 0
;
PAYR() ; Payer Selection
; Input: ^TMP("RCERA_PARAMS",$J) - Global array of preferred values (if any)
; Output: ^TMP("RCERA_PARAMS",$J,"RCTYPE") - ERA Posting Status filter
; Returns: 1 if user quit or timed out, 0 otherwise
N DIR,DTOUT,DUOUT,RCPAYR,RCPAYRDF,RCOUT,RCDONE
S RCPAYRDF=$G(^TMP("RCERA_PARAMS",$J,"RCPAYR"))
; PRCA*4.5*332 - wrapped prompts in a for loop to allow the payer range prompt to return to inital prompt if
; user cancels out
S (RCQUIT,RCDONE,RCOUT)=0
F Q:RCDONE D
. 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,"^",1) ;Stored preferred value, use as default
. W !
. D ^DIR
. I $D(DTOUT)!$D(DUOUT) S (RCDONE,RCOUT)=1 Q
. S RCPAYR=Y
. I RCPAYR="A" D Q
. . S ^TMP("RCERA_PARAMS",$J,"RCPAYR")=Y ;All payers selected
. . S RCDONE=1
. I RCPAYR="R" D
. . W !,"Names you select here will be the payer names from the ERA, not the ins. file"
. . K DIR
. . S DIR("?")="Enter a name from 1 to 30 characters in UPPER CASE."
. . S DIR(0)="FA^1:30^K:X'?.U X"
. . S DIR("A")="Start with payer name: "
. . S:$P(RCPAYRDF,"^",2)'="" DIR("B")=$P(RCPAYRDF,"^",2) ;Stored preferred value, use as default
. . W !
. . D ^DIR
. . I $D(DTOUT)!$D(DUOUT) D Q
. . . K ^TMP("RCERA_PARAMS",$J,"RCPAYR")
. . S RCPAYR("FROM")=Y
. . K DIR
. . S DIR("?")="Enter a name from 1 to 30 characters in UPPER CASE."
. . 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"
. . S:$P(RCPAYRDF,"^",3)'="" DIR("B")=$P(RCPAYRDF,"^",3) ;Stored preferred value, use as default
. . W !
. . D ^DIR
. . I $D(DTOUT)!$D(DUOUT) Q
. . S ^TMP("RCERA_PARAMS",$J,"RCPAYR")=RCPAYR_"^"_RCPAYR("FROM")_"^"_Y
. . S RCDONE=1
Q RCOUT
;
; BEGIN PRCA*4.5*326
AUTOPST() ; Auto-post Status (Marked/Partial/Complete/All) Selection
; Input: ^TMP("RCERA_PARAMS") - Global array of preferred values (if any)
; Output: ^TMP("RCERA_PARAMS",$J,"RCAPSTA") - Auto-post Status filter
; Returns: 1 if user quit or timed out, 0 otherwise
N DIR,DTOUT,DUOUT,APTYPEDF
A1 S APTYPEDF=$G(^TMP("RCERA_PARAMS",$J,"RCAPSTA"))
K DIR S DIR(0)="SA^M:MARKED;P:PARTIAL;C:COMPLETE;A:ALL"
S DIR("A")="Auto-Post status: (M)ARKED, (P)ARTIAL, (C)OMPLETE or (A)LL: "
S DIR("B")="A"
S DIR("?",1)="Select MARKED to only see ERAs currently marked for autopost."
S DIR("?",2)="Select PARTIAL to only see ERAs with a partial auto-post status."
S DIR("?",3)="Select COMPLETE to only see ERAs with a complete auto-post status."
S DIR("?")="Select ALL to see ERAs with any autopost status."
S:APTYPEDF'="" DIR("B")=APTYPEDF ;Stored preferred value, use as default
W !
D ^DIR
I $D(DTOUT)!$D(DUOUT) Q 1
G:'$$VALA(Y) A1
S ^TMP("RCERA_PARAMS",$J,"RCAPSTA")=Y
Q 0
;
VALA(INP) ; Compare input auto-post status filter to other filters
; Input INP - Y value from ^DIR
; Output 1 = Valid 0 = Invalid
;
I INP="C",$G(^TMP("RCERA_PARAMS",$J,"RCPOST"))="U" D Q 0
.W !!,"Auto-post COMPLETE is an invalid selection for UNPOSTED ERAs"
I INP="P",$G(^TMP("RCERA_PARAMS",$J,"RCPOST"))="U" D Q 0
.W !!,"Auto-post PARTIAL is an invalid selection for UNPOSTED ERAs"
I INP="M",$G(^TMP("RCERA_PARAMS",$J,"RCPOST"))="P" D Q 0
.W !!,"MARKED for Auto-post is an invalid selection for POSTED ERAs"
Q 1
;
VALM(INP) ; Compare input match type filter to other filters
; Input INP - Y value from ^DIR
; Output 1 = Valid 0 = Invalid
;
I INP="N",$G(^TMP("RCERA_PARAMS",$J,"RCAUTOP"))="A" D Q 0
.W !!,"NOT MATCHED is an invalid selection for AUTO-POSTING ERAs"
Q 1
;
; Following FILTER code moved from RCDPEWL7 due to routine size PRCA*4.5*432
FILTER(IEN344P4) ; Returns 1 if record in entry IEN344P4 in 344.4 passes
; the edits for the worklist selection of ERAs
; Parameters found in ^TMP("RCERA_PARAMS",$J)
N OK,RCPOST,RCAPST,RCAPSTA,RCAUTOP,RCMATCH,RCTYPE,RCDFR,RCDTO,RCPAYFR,RCPAYMNT,RCPAYTO,RCPAYR,RC0,RC4
S OK=1,RC0=$G(^RCY(344.4,IEN344P4,0)),RC4=$G(^RCY(344.4,IEN344P4,4))
;
S RCMATCH=$G(^TMP("RCERA_PARAMS",$J,"RCMATCH")),RCPOST=$G(^TMP("RCERA_PARAMS",$J,"RCPOST"))
S RCAUTOP=$G(^TMP("RCERA_PARAMS",$J,"RCAUTOP")),RCTYPE=$G(^TMP("RCERA_PARAMS",$J,"RCTYPE"))
S RCDFR=+$P($G(^TMP("RCERA_PARAMS",$J,"RCDT")),U),RCDTO=+$P($G(^TMP("RCERA_PARAMS",$J,"RCDT")),U,2)
S RCPAYR=$P($G(^TMP("RCERA_PARAMS",$J,"RCPAYR")),U),RCPAYFR=$P($G(^TMP("RCERA_PARAMS",$J,"RCPAYR")),U,2),RCPAYTO=$P($G(^TMP("RCERA_PARAMS",$J,"RCPAYR")),U,3)
S RCPAYMNT=$G(^TMP("RCERA_PARAMS",$J,"RCPAYMNT")) ; PRCA*4.5*321
S RCAPSTA=$G(^TMP("RCERA_PARAMS",$J,"RCAPSTA"))
;
; Post status
I $S(RCPOST="B":0,RCPOST="U":$P(RC0,U,14),1:'$P(RC0,U,14)) S OK=0 G FQ
; Auto-Posting status
I $S(RCAUTOP="B":0,RCAUTOP="A":($P(RC4,U,2)=""),1:($P(RC4,U,2)'="")) S OK=0 G FQ
; If ERA is autopost and filtering on selected Autopost statuses check status
I $P(RC4,U,2)'="",RCAPSTA'="A",(RCAUTOP="B")!(RCAUTOP="A") D G:OK=0 FQ
.;Auto-post Status
.S RCAPST=$$GET1^DIQ(344.4,IEN344P4_",",4.02,"I")
.;Complete filter
.I RCAPSTA="C" S:RCAPST'=2 OK=0 G FQ
.;Partial filter
.I RCAPSTA="P" S:RCAPST'=1 OK=0 G FQ
.;Marked for Auto-post filter - ignores if not partial post or unposted
.I RCAPSTA="M",RCAPST'=1,RCAPST'=0 S OK=0 G FQ
.;Marked for Auto-post filter - ignores PARTIAL auto-post era if no lines on ERA are marked
.I RCAPSTA="M",RCAPST=1,'$O(^RCY(344.4,"AP",1,IEN344P4,"")) S OK=0 G FQ
.;Marked for Auto-post filter - ignores UNPROCESSED auto-post era if no marked for autopost user
.I RCAPSTA="M",RCAPST=0,$$GET1^DIQ(344.4,IEN344P4_",",4.04,"I")="" S OK=0 G FQ
; Match status
I $S(RCMATCH="B":0,RCMATCH="N":$P(RC0,U,9),1:'$P(RC0,U,9)) S OK=0 G FQ
; Medical/Pharmacy/Tricare Claim
; I $S(RCTYPE="B":0,RCTYPE="M":$$PHARM^RCDPEWLP(IEN344P4),1:'$$PHARM^RCDPEWLP(IEN344P4)) S OK=0 G FQ
I RCTYPE'="A" D I 'OK G FQ
. N RCFLAG
. I '$$PAYFLAGS^RCDPEWL7(IEN344P4,.RCFLAG) S OK=0 Q
. I RCTYPE="P",'RCFLAG("P") S OK=0 Q
. I RCTYPE="T",'RCFLAG("T") S OK=0 Q
. I RCTYPE="C",'RCFLAG("C") S OK=0 Q ;PRCA*4.5*432 CHAMPVA
. I RCTYPE="M",(RCFLAG("P")!RCFLAG("T")!RCFLAG("C")) S OK=0 ;PRCA*4.5*432 CHAMPVA
; dt rec'd range
I $S(RCDFR=0:0,1:$P(RC0,U,7)\1<RCDFR) S OK=0 G FQ
I $S(RCDTO=DT:0,1:$P(RC0,U,7)\1>RCDTO) S OK=0 G FQ
; Payer name
I RCPAYR'="A" D G:'OK FQ
. N Q
. S Q=$$UP^RCDPEARL($P(RC0,U,6))
. I $S(Q=RCPAYFR:1,Q=RCPAYTO:1,Q]RCPAYFR:RCPAYTO]Q,1:0) Q
. S OK=0
; PRCA*4.5*321 - Start modified code block
; Zero amount or payment
I RCPAYMNT'="B" D ;
. I RCPAYMNT="Z",$P(RC0,U,5) S OK=0 Q
. I RCPAYMNT="P",'$P(RC0,U,5) S OK=0
; PRCA*4.5*321 - End modified code block
;
FQ Q OK
; END PRCA*4.5*326
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HRCDPEWLD 18045 printed Nov 22, 2024@16:56:03 Page 2
RCDPEWLD ;ALB/CLT - Continuation of routine RCDPEWL0 ;09 DEC 2016
+1 ;;4.5;Accounts Receivable;**252,317,321,326,332,424,432**;Mar 20, 1995;Build 16
+2 ;Per VA Directive 6402, this routine should not be modified.
+3 QUIT
+4 ;
PROV(RCSCR,RCSCR1,RCXM1,RC) ;Get prov data from ERA (FILE 344.4) and claim (FILE 399)
+1 NEW RCXXX,RCYYY,RCDPEPV,RCCLAIM,RCIEN,RCBILL,RCID,RCBLANK,RCNPI,DIC,X,Y
+2 NEW RCPROV,RCEXP,XUSNPI,RCRTN,RCBNM,RCCOM1,RCCOM2,RCWARN,RCYNODE3
+3 ;
+4 SET RCBLANK=""
FOR X=1:1:30
SET RCBLANK=RCBLANK_" "
+5 SET RC=RC+1
SET RCXM1(RC-1)=RCBLANK
+6 SET RCYNODE3=$GET(^RCY(344.4,RCSCR,1,RCSCR1,3))
+7 ;
LKBOX ;Get provider data from ELECTRONIC REMITTANCE ADVICE file (#344.4)
+1 ;setting sub-header for worklist
SET RC=RC+1
SET RCXM1(RC-1)=$EXTRACT("**EOB PROVIDER(S)/NPI"_$JUSTIFY(" ",39),1,39)_"CLAIM PROVIDER(S)/NPI**"
+2 SET RC=RC+1
SET RCXM1(RC-1)=$EXTRACT("---------------------"_$JUSTIFY(" ",39),1,39)_"-----------------------"
+3 ;
+4 ; piece 3 initialize for error msgs
SET RCPROV="BILLING"
SET $PIECE(RCYYY(RCPROV),U,3)=0
+5 ; Billing Prov NPI
IF $PIECE(RCYNODE3,U)'=""
SET RCYYY(RCPROV)="/"_$PIECE(RCYNODE3,U)
+6 ;
+7 SET RCPROV="RENDERING"
+8 IF $PIECE(RCYNODE3,U,3)=2
SET RCPROV="SERVICING"
+9 IF $PIECE(RCYNODE3,U,3)=""
IF ($PIECE(RCYNODE3,U,4)'[",")
IF ($PIECE(RCYNODE3,U,4)'="")
SET RCPROV="SERVICING"
+10 IF $PIECE(RCYNODE3,U,2)'=""!($PIECE(RCYNODE3,U,4)'="")
SET RCYYY(RCPROV)=$EXTRACT($PIECE(RCYNODE3,U,4),1,20)_"/"_$PIECE(RCYNODE3,U,2)
+11 ; initialize for error msgs
SET $PIECE(RCYYY(RCPROV),U,3)=0
+12 ; RCPROV has to be "RENDERING" or "SERVICING" when this tag is called !
DO NPICHK
+13 ;
CLAIM ;Retrieve provider data from the claim
+1 ;determine claim num based on entry in 344.4
SET RCCLAIM=$$GET1^DIQ(361.1,$PIECE(^RCY(344.4,RCSCR,1,RCSCR1,0),U,2),.01)
+2 ;find ien for file 399
SET DIC="^DGCR(399,"
SET DIC(0)=""
SET X=RCCLAIM
DO ^DIC
SET RCCLAIM=+Y
+3 ;retrieve prov information
DO GETS^DIQ(399,RCCLAIM,"222*","IE","RCXXX")
+4 ;retrieve default division
SET RCBILL=$$GET1^DIQ(399,RCCLAIM,.22,"I")
+5 ;get name from institution file
SET RCBNM=$$GET1^DIQ(4,$$GET1^DIQ(40.8,RCBILL,.07,"I"),.01)
+6 ;get NPI from institution file
SET RCBILL=$$GET1^DIQ(4,$$GET1^DIQ(40.8,RCBILL,.07,"I"),41.99)
+7 ;
+8 ;NPI set into local array
SET $PIECE(RCYYY("BILLING"),U,2)=RCBNM_"/"_RCBILL_"^"_0
+9 ;loop through claim providers
IF $DATA(RCXXX)
SET RCPROV=""
FOR
SET RCPROV=$ORDER(RCXXX(399.0222,RCPROV))
if RCPROV=""
QUIT
Begin DoDot:1
+10 SET RCIEN=$PIECE(RCXXX(399.0222,RCPROV,.02,"I"),";",1)
+11 SET RCID=$SELECT($PIECE(RCXXX(399.0222,RCPROV,.02,"I"),";",2)["VA(200":"Individual_ID",1:"Non_VA_Provider_ID")
+12 ;retrieve provider NPI
SET RCNPI=$$NPI^XUSNPI(RCID,RCIEN)
+13 SET $PIECE(RCYYY(RCXXX(399.0222,RCPROV,.01,"E")),U,2)=$EXTRACT(RCXXX(399.0222,RCPROV,.02,"E"),1,20)_"/"_$SELECT(+RCNPI=0:"No NPI on file",+RCNPI=-1:"Can't look up NPI",1:+RCNPI)
+14 if $PIECE(RCYYY(RCXXX(399.0222,RCPROV,.01,"E")),U,3)=""
SET $PIECE(RCYYY(RCXXX(399.0222,RCPROV,.01,"E")),U,3)=0
End DoDot:1
LINESET ;SET THE PRINT LINES
+1 ;loop through the found provider types
SET (RCWARN,RCPROV)=""
FOR
SET RCPROV=$ORDER(RCYYY(RCPROV))
if RCPROV=""
QUIT
Begin DoDot:1
+2 ;increment line counter
SET RC=RC+1
+3 ; build display detail line
+4 SET RCXM1(RC-1)=RCPROV_": "_$PIECE(RCYYY(RCPROV),U,1)
+5 IF $LENGTH(RCXM1(RC-1))>39
Begin DoDot:2
+6 SET RCXM1(RC-1)=$EXTRACT($PIECE(RCXM1(RC-1),"/"),1,27)_"/"_$PIECE(RCXM1(RC-1),"/",2)
End DoDot:2
+7 SET RCXM1(RC-1)=$EXTRACT(RCXM1(RC-1)_RCBLANK,1,39)_$PIECE(RCYYY(RCPROV),U,2)
+8 IF $PIECE(RCYYY(RCPROV),U,3)'=0
SET RCWARN=$PIECE(RCYYY(RCPROV),U,3)
End DoDot:1
+9 IF RCWARN'=""
Begin DoDot:1
+10 ;Blank line for separation
SET RC=RC+1
SET RCXM1(RC-1)=" "
+11 SET RC=RC+1
SET RCXM1(RC-1)="Rendering/Servicing Provider NPI Warning:"
+12 SET RC=RC+1
SET RCXM1(RC-1)=RCWARN
End DoDot:1
+13 ;Blank line to separate from possible comments
SET RC=RC+1
SET RCXM1(RC-1)=" "
+14 ;Error in NPI format
SET RCCOM1=$PIECE(RCYNODE3,U,5)
SET RCCOM2=$PIECE(RCYNODE3,U,6)
Begin DoDot:1
+15 IF $GET(RCCOM1)'=""
SET RC=RC+1
SET RCXM1(RC-1)=RCCOM1
+16 IF $GET(RCCOM2)'=""
SET RC=RC+1
SET RCXM1(RC-1)=RCCOM2
End DoDot:1
+17 QUIT
+18 ;
NPICHK ;CHECK THAT THE NPI RETURNED MATCHES THE ENTITY TYPE QUALIFIER
+1 ; ENTITY TYPE QUALIFIER
SET RCEXP=""
if $PIECE(RCYNODE3,U,3)=""
QUIT
+2 ;
+3 ; Ren/Serv comment
SET RCCOM2=$PIECE(RCYNODE3,U,6)
+4 SET XUSNPI=$PIECE(RCYNODE3,U,2)
+5 IF RCCOM2=""
IF (XUSNPI="")
SET RCEXP="**NO SERVICING/RENDERING NPI INCLUDED IN 835**"
DO EXPSET
QUIT
+6 SET RCRTN=$$QI^XUSNPI(XUSNPI)
+7 IF $PIECE(RCRTN,U,1)="Individual_ID"
Begin DoDot:1
+8 IF $PIECE(RCYNODE3,U,3)'=1
SET RCEXP="**NPI from 835 indicated organizational but is associated with an individual**"
DO EXPSET
QUIT
End DoDot:1
QUIT
+9 IF $PIECE(RCRTN,U,1)="Organization_ID"
Begin DoDot:1
+10 IF $PIECE(RCYNODE3,U,3)'=2
SET RCEXP="**NPI from 835 indicated individual but is associated with an organization**"
DO EXPSET
QUIT
End DoDot:1
QUIT
+11 IF $EXTRACT($PIECE(RCRTN,U,1),1,3)="Non"
Begin DoDot:1
+12 NEW RCIEN,RCTYPE
SET RCIEN=$PIECE(RCRTN,U,2)
SET RCTYPE=$$GET1^DIQ(355.93,RCIEN,.02,"I")
if $GET(RCTYPE)=""
QUIT
+13 IF $PIECE(RCYNODE3,U,3)=1
IF RCTYPE=1
SET RCEXP="**NPI from 835 indicated individual but is associated with an organization**"
DO EXPSET
QUIT
+14 IF $PIECE(RCYNODE3,U,3)=2
IF RCTYPE=2
SET RCEXP="**NPI from 835 indicated organizational but is associated with an individual**"
DO EXPSET
QUIT
End DoDot:1
QUIT
+15 IF RCCOM2=""
IF (+RCRTN=0)
SET RCEXP="**The NPI returned on the 835 is not associated with this VistA system**"
DO EXPSET
QUIT
+16 QUIT
+17 ;
EXPSET ;SET THE PRINT LINE WITH THE ERROR AS DEFINED IN RCEXP
+1 SET $PIECE(RCYYY(RCPROV),U,3)=RCEXP
+2 QUIT
+3 ;
PARAMS(RCQUIT) ;PARAMETERS ENTRY CONTINUED FROM RCDPEWL0
+1 IF $GET(RCQUIT)
KILL ^TMP("RCERA_PARAMS",$JOB)
PARMSQ ;
+1 QUIT
+2 ;
PARAMS2() ;EP from RCDPEWL0
+1 ; PRCA*4.5*317 - Moved due to routine size issues
+2 ; Input: None
+3 ; Returns: RCQUIT - 1 if user ^ or timed out, 0 otherwise
+4 ; Ask for zero/payment PRCA*4.5*321
SET RCQUIT=$$PAYMNT()
+5 ; PRCA*4.5*321
if RCQUIT
QUIT 1
+6 ; Ask Posting Status
SET RCQUIT=$$POSTSTAT()
+7 if RCQUIT
QUIT 1
+8 ; Ask Posting Method
SET RCQUIT=$$POSTMETH
+9 if RCQUIT
QUIT 1
+10 ; Ask ERA-EFT Matching Status
SET RCQUIT=$$MATCHST
+11 if RCQUIT
QUIT 1
+12 ; Ask Claim Type
SET RCQUIT=$$CLAIMTYP()
+13 if RCQUIT
QUIT 1
+14 ; Ask for selected payers
SET RCQUIT=$$PAYR()
+15 QUIT RCQUIT
+16 ;
PAYMNT() ; Payment Type (Zero/Payment or Both) Selection ; PRCA*4.5*321 this whole subroutine
+1 ; Input: ^TMP("RCERA_PARAMS") - Global array of preferred values (if any)
+2 ; Output: ^TMP("RCERA_PARAMS",$J,"RCPAYMNT") - ERA Posting Status filter
+3 ; Returns: 1 if user quit or timed out, 0 otherwise
+4 NEW DIR,DTOUT,DUOUT,RCTYPEDF
+5 SET RCTYPEDF=$GET(^TMP("RCERA_PARAMS",$JOB,"RCPAYMNT"))
+6 KILL DIR
SET DIR(0)="SA^Z:ZERO;P:PAYMENT;B:BOTH"
+7 SET DIR("A")="(Z)ERO, (P)AYMENT, or (B)OTH: "
+8 SET DIR("B")="B"
+9 SET DIR("?",1)="Select ZERO to only see ERAs with a zero total amount paid."
+10 SET DIR("?",2)="Select PAYMENT to only see ERAs with a non-zero amount paid."
+11 SET DIR("?")="Select BOTH to see both zero and non-zero amount ERAs."
+12 ;Stored preferred value, use as default
if RCTYPEDF'=""
SET DIR("B")=RCTYPEDF
+13 WRITE !
+14 DO ^DIR
+15 IF $DATA(DTOUT)!$DATA(DUOUT)
QUIT 1
+16 SET ^TMP("RCERA_PARAMS",$JOB,"RCPAYMNT")=Y
+17 QUIT 0
+18 ;
POSTSTAT() ; ERA Posting Status (Posted/Unposted/Both) Selection
+1 ; Input: ^TMP("RCERA_PARAMS") - Global array of preferred values (if any)
+2 ; Output: ^TMP("RCERA_PARAMS",$J,"RCPOST")- ERA Posting Status filter
+3 ; Returns: 1 if user quit or timed out, 0 otherwise
+4 NEW DIR,DTOUT,DUOUT,RCPOSTDF
+5 SET RCPOSTDF=$GET(^TMP("RCERA_PARAMS",$JOB,"RCPOST"))
+6 KILL DIR
SET DIR(0)="SA^U:UNPOSTED;P:POSTED;B:BOTH"
+7 SET DIR("A")="ERA posting status: (U)NPOSTED, (P)OSTED, or (B)OTH: "
+8 SET DIR("B")="U"
+9 SET DIR("?",1)="Select UNPOSTED to only see ERAs with a status of UNPOSTED."
+10 SET DIR("?",2)="Select POSTED to only see ERAs with a status of POSTED."
+11 SET DIR("?")="Select BOTH to see both unposted and posted ERAs."
+12 ; Stored preferred value, use as default
if RCPOSTDF'=""
SET DIR("B")=RCPOSTDF
+13 WRITE !
+14 DO ^DIR
+15 IF $DATA(DTOUT)!$DATA(DUOUT)
QUIT 1
+16 SET ^TMP("RCERA_PARAMS",$JOB,"RCPOST")=Y
+17 QUIT 0
+18 ;
POSTMETH() ; PRCA*4.5*317 moved from RCDPEWL0 because of routine size issues
+1 ; ERA Posting Method (Auto-Posting/Non Auto-Posting/Both) Selection
+2 ; Input: ^TMP("RCERA_PARAMS") - Global array of preferred values (if any)
+3 ; Output: ^TMP("RCERA_PARAMS",$J,"RCAUTOP")- ERA Posting Status filter
+4 ; Returns: 1 if user quit or timed out, 0 otherwise
+5 NEW DIR,DTOUT,DUOUT,RCAUTOPDF
P1 ; PRCA*4.5*326
SET RCAUTOPDF=$GET(^TMP("RCERA_PARAMS",$JOB,"RCAUTOP"))
+1 KILL DIR
SET DIR(0)="SA^A:AUTO-POSTING;N:NON AUTO-POSTING;B:BOTH"
+2 SET DIR("A")="Display (A)UTO-POSTING, (N)ON AUTO-POSTING, or (B)OTH: "
+3 SET DIR("B")="B"
+4 SET DIR("?",1)="Select AUTO-POSTING to only see auto-posted ERAs."
+5 SET DIR("?",2)="Select NON AUTO-POSTING to only see ERAs that were NOT auto-posted."
+6 SET DIR("?")="Select BOTH to see both auto-posted and non auto-posted ERAs."
+7 ;Stored preferred value, use as default
if RCAUTOPDF'=""
SET DIR("B")=RCAUTOPDF
+8 WRITE !
+9 DO ^DIR
+10 IF $DATA(DTOUT)!$DATA(DUOUT)
QUIT 1
+11 SET ^TMP("RCERA_PARAMS",$JOB,"RCAUTOP")=Y
+12 ; If including auto-post ERA ask for auto-post status filters
+13 ; PRCA*4.5*326
IF Y'="N"
QUIT $$AUTOPST()
+14 QUIT 0
+15 ;
MATCHST() ; ERA-EFT Matching Status(Matched/Unmatched/Both) Selection
+1 ; Input: ^TMP("RCERA_PARAMS") - Global array of preferred values (if any)
+2 ; Output: ^TMP("RCERA_PARAMS",$J,"RCMATCH")- ERA Posting Status filter
+3 ; Returns: 1 if user quit or timed out, 0 otherwise
+4 NEW DIR,DTOUT,DUOUT,RCMATCHD
M1 ; PRCA*4.5*326
SET RCMATCHD=$GET(^TMP("RCERA_PARAMS",$JOB,"RCMATCH"))
+1 KILL DIR
SET DIR(0)="SA^N:NOT MATCHED;M:MATCHED;B:BOTH"
+2 SET DIR("A")="ERA-EFT match status: (N)OT MATCHED, (M)ATCHED, or (B)OTH: "
+3 SET DIR("B")="B"
+4 SET DIR("?",1)="Select NOT MATCHED to only see unmatched ERAs."
+5 SET DIR("?",2)="Select MATCHED to only see matched ERAs."
+6 SET DIR("?")="Select BOTH to see both matched and unmatched ERAs."
+7 ;Stored preferred value, use as default
if RCMATCHD'=""
SET DIR("B")=RCMATCHD
+8 WRITE !
+9 DO ^DIR
+10 IF $DATA(DTOUT)!$DATA(DUOUT)
QUIT 1
+11 ; PRCA*4.5*326
if '$$VALM(Y)
GOTO M1
+12 SET ^TMP("RCERA_PARAMS",$JOB,"RCMATCH")=Y
+13 QUIT 0
+14 ;
CLAIMTYP() ; Claim Type (Medical/Pharmacy/Tricare/CHAMPVA/Both) Selection
+1 ; Input: ^TMP("RCERA_PARAMS") - Global array of preferred values (if any)
+2 ; Output: ^TMP("RCERA_PARAMS",$J,"RCTYPE") - ERA Posting Status filter
+3 ; Returns: 1 if user quit or timed out, 0 otherwise
+4 NEW DIR,DTOUT,DUOUT,RCTYPEDF
+5 SET RCTYPEDF=$GET(^TMP("RCERA_PARAMS",$JOB,"RCTYPE"))
+6 ; PRCA*4.5*321 - Changed set of codes and help
+7 ;PRCA*4.5*432 CHAMPVA
KILL DIR
SET DIR(0)="SA^M:MEDICAL;P:PHARMACY;T:TRICARE;C:CHAMPVA;A:ALL"
+8 ;PRCA*4.5*432 CHAMPVA
SET DIR("A")="(M)EDICAL, (P)HARMACY, (T)RICARE, (C)HAMPVA or (A)LL: "
+9 SET DIR("B")="A"
+10 SET DIR("?",1)="Select MEDICAL to only see ERAs with a payer type of medical."
+11 SET DIR("?",2)="Select PHARMACY to only see ERAs with a payer type of pharmacy."
+12 SET DIR("?",3)="Select TRICARE to only see ERAs with a payer type of Tricare."
+13 ;PRCA*4.5*432 CHAMPVA
SET DIR("?",4)="Select CHAMPVA to only see ERAs with a payer type of CHAMPVA."
+14 ;PRCA*4.5*432 CHAMPVA
SET DIR("?")="Select ALL to see medical, pharmacy, Tricare, and CHAMPVA ERAs."
+15 ; PRCA*4.5*321 - End modified code block
+16 ;Stored preferred value, use as default
if RCTYPEDF'=""
SET DIR("B")=RCTYPEDF
+17 WRITE !
+18 DO ^DIR
+19 IF $DATA(DTOUT)!$DATA(DUOUT)
QUIT 1
+20 SET ^TMP("RCERA_PARAMS",$JOB,"RCTYPE")=Y
+21 QUIT 0
+22 ;
PAYR() ; Payer Selection
+1 ; Input: ^TMP("RCERA_PARAMS",$J) - Global array of preferred values (if any)
+2 ; Output: ^TMP("RCERA_PARAMS",$J,"RCTYPE") - ERA Posting Status filter
+3 ; Returns: 1 if user quit or timed out, 0 otherwise
+4 NEW DIR,DTOUT,DUOUT,RCPAYR,RCPAYRDF,RCOUT,RCDONE
+5 SET RCPAYRDF=$GET(^TMP("RCERA_PARAMS",$JOB,"RCPAYR"))
+6 ; PRCA*4.5*332 - wrapped prompts in a for loop to allow the payer range prompt to return to inital prompt if
+7 ; user cancels out
+8 SET (RCQUIT,RCDONE,RCOUT)=0
+9 FOR
if RCDONE
QUIT
Begin DoDot:1
+10 KILL DIR
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 value, use as default
if $PIECE(RCPAYRDF,"^")'=""
SET DIR("B")=$PIECE(RCPAYRDF,"^",1)
+16 WRITE !
+17 DO ^DIR
+18 IF $DATA(DTOUT)!$DATA(DUOUT)
SET (RCDONE,RCOUT)=1
QUIT
+19 SET RCPAYR=Y
+20 IF RCPAYR="A"
Begin DoDot:2
+21 ;All payers selected
SET ^TMP("RCERA_PARAMS",$JOB,"RCPAYR")=Y
+22 SET RCDONE=1
End DoDot:2
QUIT
+23 IF RCPAYR="R"
Begin DoDot:2
+24 WRITE !,"Names you select here will be the payer names from the ERA, not the ins. file"
+25 KILL DIR
+26 SET DIR("?")="Enter a name from 1 to 30 characters in UPPER CASE."
+27 SET DIR(0)="FA^1:30^K:X'?.U X"
+28 SET DIR("A")="Start with payer name: "
+29 ;Stored preferred value, use as default
if $PIECE(RCPAYRDF,"^",2)'=""
SET DIR("B")=$PIECE(RCPAYRDF,"^",2)
+30 WRITE !
+31 DO ^DIR
+32 IF $DATA(DTOUT)!$DATA(DUOUT)
Begin DoDot:3
+33 KILL ^TMP("RCERA_PARAMS",$JOB,"RCPAYR")
End DoDot:3
QUIT
+34 SET RCPAYR("FROM")=Y
+35 KILL DIR
+36 SET DIR("?")="Enter a name from 1 to 30 characters in UPPER CASE."
+37 SET DIR(0)="FA^1:30^K:X'?.U X"
SET DIR("A")="Go to payer name: "
+38 SET DIR("B")=$EXTRACT(RCPAYR("FROM"),1,27)_"ZZZ"
+39 ;Stored preferred value, use as default
if $PIECE(RCPAYRDF,"^",3)'=""
SET DIR("B")=$PIECE(RCPAYRDF,"^",3)
+40 WRITE !
+41 DO ^DIR
+42 IF $DATA(DTOUT)!$DATA(DUOUT)
QUIT
+43 SET ^TMP("RCERA_PARAMS",$JOB,"RCPAYR")=RCPAYR_"^"_RCPAYR("FROM")_"^"_Y
+44 SET RCDONE=1
End DoDot:2
End DoDot:1
+45 QUIT RCOUT
+46 ;
+47 ; BEGIN PRCA*4.5*326
AUTOPST() ; Auto-post Status (Marked/Partial/Complete/All) Selection
+1 ; Input: ^TMP("RCERA_PARAMS") - Global array of preferred values (if any)
+2 ; Output: ^TMP("RCERA_PARAMS",$J,"RCAPSTA") - Auto-post Status filter
+3 ; Returns: 1 if user quit or timed out, 0 otherwise
+4 NEW DIR,DTOUT,DUOUT,APTYPEDF
A1 SET APTYPEDF=$GET(^TMP("RCERA_PARAMS",$JOB,"RCAPSTA"))
+1 KILL DIR
SET DIR(0)="SA^M:MARKED;P:PARTIAL;C:COMPLETE;A:ALL"
+2 SET DIR("A")="Auto-Post status: (M)ARKED, (P)ARTIAL, (C)OMPLETE or (A)LL: "
+3 SET DIR("B")="A"
+4 SET DIR("?",1)="Select MARKED to only see ERAs currently marked for autopost."
+5 SET DIR("?",2)="Select PARTIAL to only see ERAs with a partial auto-post status."
+6 SET DIR("?",3)="Select COMPLETE to only see ERAs with a complete auto-post status."
+7 SET DIR("?")="Select ALL to see ERAs with any autopost status."
+8 ;Stored preferred value, use as default
if APTYPEDF'=""
SET DIR("B")=APTYPEDF
+9 WRITE !
+10 DO ^DIR
+11 IF $DATA(DTOUT)!$DATA(DUOUT)
QUIT 1
+12 if '$$VALA(Y)
GOTO A1
+13 SET ^TMP("RCERA_PARAMS",$JOB,"RCAPSTA")=Y
+14 QUIT 0
+15 ;
VALA(INP) ; Compare input auto-post status filter to other filters
+1 ; Input INP - Y value from ^DIR
+2 ; Output 1 = Valid 0 = Invalid
+3 ;
+4 IF INP="C"
IF $GET(^TMP("RCERA_PARAMS",$JOB,"RCPOST"))="U"
Begin DoDot:1
+5 WRITE !!,"Auto-post COMPLETE is an invalid selection for UNPOSTED ERAs"
End DoDot:1
QUIT 0
+6 IF INP="P"
IF $GET(^TMP("RCERA_PARAMS",$JOB,"RCPOST"))="U"
Begin DoDot:1
+7 WRITE !!,"Auto-post PARTIAL is an invalid selection for UNPOSTED ERAs"
End DoDot:1
QUIT 0
+8 IF INP="M"
IF $GET(^TMP("RCERA_PARAMS",$JOB,"RCPOST"))="P"
Begin DoDot:1
+9 WRITE !!,"MARKED for Auto-post is an invalid selection for POSTED ERAs"
End DoDot:1
QUIT 0
+10 QUIT 1
+11 ;
VALM(INP) ; Compare input match type filter to other filters
+1 ; Input INP - Y value from ^DIR
+2 ; Output 1 = Valid 0 = Invalid
+3 ;
+4 IF INP="N"
IF $GET(^TMP("RCERA_PARAMS",$JOB,"RCAUTOP"))="A"
Begin DoDot:1
+5 WRITE !!,"NOT MATCHED is an invalid selection for AUTO-POSTING ERAs"
End DoDot:1
QUIT 0
+6 QUIT 1
+7 ;
+8 ; Following FILTER code moved from RCDPEWL7 due to routine size PRCA*4.5*432
FILTER(IEN344P4) ; Returns 1 if record in entry IEN344P4 in 344.4 passes
+1 ; the edits for the worklist selection of ERAs
+2 ; Parameters found in ^TMP("RCERA_PARAMS",$J)
+3 NEW OK,RCPOST,RCAPST,RCAPSTA,RCAUTOP,RCMATCH,RCTYPE,RCDFR,RCDTO,RCPAYFR,RCPAYMNT,RCPAYTO,RCPAYR,RC0,RC4
+4 SET OK=1
SET RC0=$GET(^RCY(344.4,IEN344P4,0))
SET RC4=$GET(^RCY(344.4,IEN344P4,4))
+5 ;
+6 SET RCMATCH=$GET(^TMP("RCERA_PARAMS",$JOB,"RCMATCH"))
SET RCPOST=$GET(^TMP("RCERA_PARAMS",$JOB,"RCPOST"))
+7 SET RCAUTOP=$GET(^TMP("RCERA_PARAMS",$JOB,"RCAUTOP"))
SET RCTYPE=$GET(^TMP("RCERA_PARAMS",$JOB,"RCTYPE"))
+8 SET RCDFR=+$PIECE($GET(^TMP("RCERA_PARAMS",$JOB,"RCDT")),U)
SET RCDTO=+$PIECE($GET(^TMP("RCERA_PARAMS",$JOB,"RCDT")),U,2)
+9 SET RCPAYR=$PIECE($GET(^TMP("RCERA_PARAMS",$JOB,"RCPAYR")),U)
SET RCPAYFR=$PIECE($GET(^TMP("RCERA_PARAMS",$JOB,"RCPAYR")),U,2)
SET RCPAYTO=$PIECE($GET(^TMP("RCERA_PARAMS",$JOB,"RCPAYR")),U,3)
+10 ; PRCA*4.5*321
SET RCPAYMNT=$GET(^TMP("RCERA_PARAMS",$JOB,"RCPAYMNT"))
+11 SET RCAPSTA=$GET(^TMP("RCERA_PARAMS",$JOB,"RCAPSTA"))
+12 ;
+13 ; Post status
+14 IF $SELECT(RCPOST="B":0,RCPOST="U":$PIECE(RC0,U,14),1:'$PIECE(RC0,U,14))
SET OK=0
GOTO FQ
+15 ; Auto-Posting status
+16 IF $SELECT(RCAUTOP="B":0,RCAUTOP="A":($PIECE(RC4,U,2)=""),1:($PIECE(RC4,U,2)'=""))
SET OK=0
GOTO FQ
+17 ; If ERA is autopost and filtering on selected Autopost statuses check status
+18 IF $PIECE(RC4,U,2)'=""
IF RCAPSTA'="A"
IF (RCAUTOP="B")!(RCAUTOP="A")
Begin DoDot:1
+19 ;Auto-post Status
+20 SET RCAPST=$$GET1^DIQ(344.4,IEN344P4_",",4.02,"I")
+21 ;Complete filter
+22 IF RCAPSTA="C"
if RCAPST'=2
SET OK=0
GOTO FQ
+23 ;Partial filter
+24 IF RCAPSTA="P"
if RCAPST'=1
SET OK=0
GOTO FQ
+25 ;Marked for Auto-post filter - ignores if not partial post or unposted
+26 IF RCAPSTA="M"
IF RCAPST'=1
IF RCAPST'=0
SET OK=0
GOTO FQ
+27 ;Marked for Auto-post filter - ignores PARTIAL auto-post era if no lines on ERA are marked
+28 IF RCAPSTA="M"
IF RCAPST=1
IF '$ORDER(^RCY(344.4,"AP",1,IEN344P4,""))
SET OK=0
GOTO FQ
+29 ;Marked for Auto-post filter - ignores UNPROCESSED auto-post era if no marked for autopost user
+30 IF RCAPSTA="M"
IF RCAPST=0
IF $$GET1^DIQ(344.4,IEN344P4_",",4.04,"I")=""
SET OK=0
GOTO FQ
End DoDot:1
if OK=0
GOTO FQ
+31 ; Match status
+32 IF $SELECT(RCMATCH="B":0,RCMATCH="N":$PIECE(RC0,U,9),1:'$PIECE(RC0,U,9))
SET OK=0
GOTO FQ
+33 ; Medical/Pharmacy/Tricare Claim
+34 ; I $S(RCTYPE="B":0,RCTYPE="M":$$PHARM^RCDPEWLP(IEN344P4),1:'$$PHARM^RCDPEWLP(IEN344P4)) S OK=0 G FQ
+35 IF RCTYPE'="A"
Begin DoDot:1
+36 NEW RCFLAG
+37 IF '$$PAYFLAGS^RCDPEWL7(IEN344P4,.RCFLAG)
SET OK=0
QUIT
+38 IF RCTYPE="P"
IF 'RCFLAG("P")
SET OK=0
QUIT
+39 IF RCTYPE="T"
IF 'RCFLAG("T")
SET OK=0
QUIT
+40 ;PRCA*4.5*432 CHAMPVA
IF RCTYPE="C"
IF 'RCFLAG("C")
SET OK=0
QUIT
+41 ;PRCA*4.5*432 CHAMPVA
IF RCTYPE="M"
IF (RCFLAG("P")!RCFLAG("T")!RCFLAG("C"))
SET OK=0
End DoDot:1
IF 'OK
GOTO FQ
+42 ; dt rec'd range
+43 IF $SELECT(RCDFR=0:0,1:$PIECE(RC0,U,7)\1<RCDFR)
SET OK=0
GOTO FQ
+44 IF $SELECT(RCDTO=DT:0,1:$PIECE(RC0,U,7)\1>RCDTO)
SET OK=0
GOTO FQ
+45 ; Payer name
+46 IF RCPAYR'="A"
Begin DoDot:1
+47 NEW Q
+48 SET Q=$$UP^RCDPEARL($PIECE(RC0,U,6))
+49 IF $SELECT(Q=RCPAYFR:1,Q=RCPAYTO:1,Q]RCPAYFR:RCPAYTO]Q,1:0)
QUIT
+50 SET OK=0
End DoDot:1
if 'OK
GOTO FQ
+51 ; PRCA*4.5*321 - Start modified code block
+52 ; Zero amount or payment
+53 ;
IF RCPAYMNT'="B"
Begin DoDot:1
+54 IF RCPAYMNT="Z"
IF $PIECE(RC0,U,5)
SET OK=0
QUIT
+55 IF RCPAYMNT="P"
IF '$PIECE(RC0,U,5)
SET OK=0
End DoDot:1
+56 ; PRCA*4.5*321 - End modified code block
+57 ;
FQ QUIT OK
+1 ; END PRCA*4.5*326
