RCDPEWLD ;ALB/CLT - Continuation of routine RCDPEWL0 ;09 DEC 2016
;;4.5;Accounts Receivable;**252,317,321,326,332**;Mar 20, 1995;Build 40
;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
G:'$$VALP(Y) P1 ; PRCA*4.5*326
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/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;A:ALL"
S DIR("A")="(M)EDICAL, (P)HARMACY, (T)RICARE or (A)LL: "
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("?")="Select ALL to see medical, pharmacy and Tricare ERAs."
; 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 ; PRCA*4.5*332 - Remove GOTO and instead make FOR loop
. 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
;
VALP(INP) ; Compare input posting method filter to other filters
; Input INP - Y value from ^DIR
; Output 1 = Valid 0 = Invalid
;
I INP="A",$G(^TMP("RCERA_PARAMS",$J,"RCPAYMNT"))="Z" D Q 0
.W !!,"AUTO-POSTING is an invalid selection for ZERO ERAs"
Q 1
; END PRCA*4.5*326
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HRCDPEWLD 15098 printed Apr 09, 2024@20:50:15 Page 2
RCDPEWLD ;ALB/CLT - Continuation of routine RCDPEWL0 ;09 DEC 2016
+1 ;;4.5;Accounts Receivable;**252,317,321,326,332**;Mar 20, 1995;Build 40
+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 ; PRCA*4.5*326
if '$$VALP(Y)
GOTO P1
+12 SET ^TMP("RCERA_PARAMS",$JOB,"RCAUTOP")=Y
+13 ; If including auto-post ERA ask for auto-post status filters
+14 ; PRCA*4.5*326
IF Y'="N"
QUIT $$AUTOPST()
+15 QUIT 0
+16 ;
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/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 KILL DIR
SET DIR(0)="SA^M:MEDICAL;P:PHARMACY;T:TRICARE;A:ALL"
+8 SET DIR("A")="(M)EDICAL, (P)HARMACY, (T)RICARE 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 SET DIR("?")="Select ALL to see medical, pharmacy and Tricare ERAs."
+14 ; PRCA*4.5*321 - End modified code block
+15 ;Stored preferred value, use as default
if RCTYPEDF'=""
SET DIR("B")=RCTYPEDF
+16 WRITE !
+17 DO ^DIR
+18 IF $DATA(DTOUT)!$DATA(DUOUT)
QUIT 1
+19 SET ^TMP("RCERA_PARAMS",$JOB,"RCTYPE")=Y
+20 QUIT 0
+21 ;
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 ; PRCA*4.5*332 - Remove GOTO and instead make FOR loop
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 ;
VALP(INP) ; Compare input posting method filter to other filters
+1 ; Input INP - Y value from ^DIR
+2 ; Output 1 = Valid 0 = Invalid
+3 ;
+4 IF INP="A"
IF $GET(^TMP("RCERA_PARAMS",$JOB,"RCPAYMNT"))="Z"
Begin DoDot:1
+5 WRITE !!,"AUTO-POSTING is an invalid selection for ZERO ERAs"
End DoDot:1
QUIT 0
+6 QUIT 1
+7 ; END PRCA*4.5*326
