source: WorldVistAEHR/trunk/r/ACCOUNTS_RECEIVABLE-PRCA-PRY-RC/RCDPEWLD.m@ 1476

Last change on this file since 1476 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR
File size: 5.0 KB
Line 
1RCDPEWLD ;ALB/CLT - Continuation of routine RCDPEWL0 ;12 DEC 2007
2 ;;4.5;Accounts Receivable;**252**;Mar 20, 1995;Build 63
3 ;;Per VHA Directive 2004-038, this routine should not be modified.
4 Q
5 ;
6PROV(RCSCR,RCSCR1,RCXM1,RC) ;Get prov data from ERA (FILE 344.4) and claim (FILE 399)
7 N RCXXX,RCYYY,RCDPEPV,RCCLAIM,RCIEN,RCBILL,RCID,RCBLANK,RCNPI,DIC,X,Y
8 N RCPROV,RCEXP,XUSNPI,RCRTN,RCBNM,RCCOM1,RCCOM2,RCWARN,RCYNODE3
9 ;
10 S RCBLANK="" F X=1:1:30 S RCBLANK=RCBLANK_" "
11 S RC=RC+1 S RCXM1(RC-1)=RCBLANK
12 S RCYNODE3=$G(^RCY(344.4,RCSCR,1,RCSCR1,3))
13 ;
14LKBOX ;Get provider data from ELECTRONIC REMITTANCE ADVICE file (#344.4)
15 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
16 S RC=RC+1,RCXM1(RC-1)=$E("---------------------"_$J(" ",39),1,39)_"-----------------------"
17 ;
18 S RCPROV="BILLING",$P(RCYYY(RCPROV),U,3)=0 ; piece 3 initialize for error msgs
19 I $P(RCYNODE3,U)'="" S RCYYY(RCPROV)="/"_$P(RCYNODE3,U) ; Billing Prov NPI
20 ;
21 S RCPROV="RENDERING"
22 I $P(RCYNODE3,U,3)=2 S RCPROV="SERVICING"
23 I $P(RCYNODE3,U,3)="",($P(RCYNODE3,U,4)'[","),($P(RCYNODE3,U,4)'="") S RCPROV="SERVICING"
24 I $P(RCYNODE3,U,2)'=""!($P(RCYNODE3,U,4)'="") S RCYYY(RCPROV)=$E($P(RCYNODE3,U,4),1,20)_"/"_$P(RCYNODE3,U,2)
25 S $P(RCYYY(RCPROV),U,3)=0 ; initialize for error msgs
26 D NPICHK ; RCPROV has to be "RENDERING" or "SERVICING" when this tag is called !
27 ;
28CLAIM ;Retrieve provider data from the claim
29 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
30 S DIC="^DGCR(399,",DIC(0)="",X=RCCLAIM D ^DIC S RCCLAIM=+Y ;find ien for file 399
31 D GETS^DIQ(399,RCCLAIM,"222*","IE","RCXXX") ;retrieve prov information
32 S RCBILL=$$GET1^DIQ(399,RCCLAIM,.22,"I") ;retrieve default division
33 S RCBNM=$$GET1^DIQ(4,$$GET1^DIQ(40.8,RCBILL,.07,"I"),.01) ;get name from institution file
34 S RCBILL=$$GET1^DIQ(4,$$GET1^DIQ(40.8,RCBILL,.07,"I"),41.99) ;get NPI from institution file
35 ;
36 S $P(RCYYY("BILLING"),U,2)=RCBNM_"/"_RCBILL_"^"_0 ;NPI set into local array
37 I $D(RCXXX) S RCPROV="" F S RCPROV=$O(RCXXX(399.0222,RCPROV)) Q:RCPROV="" D ;loop through claim providers
38 . S RCIEN=$P(RCXXX(399.0222,RCPROV,.02,"I"),";",1)
39 . S RCID=$S($P(RCXXX(399.0222,RCPROV,.02,"I"),";",2)["VA(200":"Individual_ID",1:"Non_VA_Provider_ID")
40 . S RCNPI=$$NPI^XUSNPI(RCID,RCIEN) ;retrieve provider NPI
41 . 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)
42 . S:$P(RCYYY(RCXXX(399.0222,RCPROV,.01,"E")),U,3)="" $P(RCYYY(RCXXX(399.0222,RCPROV,.01,"E")),U,3)=0
43LINESET ;SET THE PRINT LINES
44 S (RCWARN,RCPROV)="" F S RCPROV=$O(RCYYY(RCPROV)) Q:RCPROV="" D ;loop through the found provider types
45 . S RC=RC+1 ;increment line counter
46 . ; build display detail line
47 . S RCXM1(RC-1)=RCPROV_": "_$P(RCYYY(RCPROV),U,1)
48 . I $L(RCXM1(RC-1))>39 D
49 .. S RCXM1(RC-1)=$E($P(RCXM1(RC-1),"/"),1,27)_"/"_$P(RCXM1(RC-1),"/",2)
50 . S RCXM1(RC-1)=$E(RCXM1(RC-1)_RCBLANK,1,39)_$P(RCYYY(RCPROV),U,2)
51 . I $P(RCYYY(RCPROV),U,3)'=0 S RCWARN=$P(RCYYY(RCPROV),U,3)
52 I RCWARN'="" D
53 . S RC=RC+1,RCXM1(RC-1)=" " ;Blank line for separation
54 . S RC=RC+1,RCXM1(RC-1)="Rendering/Servicing Provider NPI Warning:"
55 . S RC=RC+1,RCXM1(RC-1)=RCWARN
56 S RC=RC+1,RCXM1(RC-1)=" " ;Blank line to separate from possible comments
57 S RCCOM1=$P(RCYNODE3,U,5),RCCOM2=$P(RCYNODE3,U,6) D ;Error in NPI format
58 . I $G(RCCOM1)'="" S RC=RC+1,RCXM1(RC-1)=RCCOM1
59 . I $G(RCCOM2)'="" S RC=RC+1,RCXM1(RC-1)=RCCOM2
60 Q
61 ;
62NPICHK ;CHECK THAT THE NPI RETURNED MATCHES THE ENTITY TYPE QUALIFIER
63 S RCEXP="" Q:$P(RCYNODE3,U,3)="" ; ENTITY TYPE QUALIFIER
64 ;
65 S RCCOM2=$P(RCYNODE3,U,6) ; Ren/Serv comment
66 S XUSNPI=$P(RCYNODE3,U,2)
67 I RCCOM2="",(XUSNPI="") S RCEXP="**NO SERVICING/RENDERING NPI INCLUDED IN 835**" D EXPSET Q
68 S RCRTN=$$QI^XUSNPI(XUSNPI)
69 I $P(RCRTN,U,1)="Individual_ID" D Q
70 . I $P(RCYNODE3,U,3)'=1 S RCEXP="**NPI from 835 indicated organizational but is associated with an individual**" D EXPSET Q
71 I $P(RCRTN,U,1)="Organization_ID" D Q
72 . I $P(RCYNODE3,U,3)'=2 S RCEXP="**NPI from 835 indicated individual but is associated with an organization**" D EXPSET Q
73 I $E($P(RCRTN,U,1),1,3)="Non" D Q
74 . N RCIEN,RCTYPE S RCIEN=$P(RCRTN,U,2),RCTYPE=$$GET1^DIQ(355.93,RCIEN,.02,"I") Q:$G(RCTYPE)=""
75 . I $P(RCYNODE3,U,3)=1,RCTYPE=1 S RCEXP="**NPI from 835 indicated individual but is associated with an organization**" D EXPSET Q
76 . I $P(RCYNODE3,U,3)=2,RCTYPE=2 S RCEXP="**NPI from 835 indicated organizational but is associated with an individual**" D EXPSET Q
77 I RCCOM2="",(+RCRTN=0) S RCEXP="**The NPI returned on the 835 is not associated with this VistA system**" D EXPSET Q
78 Q
79 ;
80EXPSET ;SET THE PRINT LINE WITH THE ERROR AS DEFINED IN RCEXP
81 S $P(RCYYY(RCPROV),U,3)=RCEXP
82 Q
83 ;
84PARAMS(RCQUIT) ;PARAMETERS ENTRY CONTINUED FROM RCDPEWL0
85 I $G(RCQUIT) K ^TMP("RCERA_PARAMS",$J)
86PARMSQ ;
87 Q
Note: See TracBrowser for help on using the repository browser.