Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: RCDPEWLD

RCDPEWLD.m

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