source: WorldVistAEHR/trunk/r/ACCOUNTS_RECEIVABLE-PRCA-PRY-RC/RCXVDC3.m@ 1006

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

initial load of WorldVistAEHR

File size: 5.5 KB
Line 
1RCXVDC3 ;DAOU/ALA-AR Data Extraction Data Creation ; 23 Jul 2007 10:32 AM
2 ;;4.5;Accounts Receivable;**201,227,228,232,248,251**;Mar 20, 1995;Build 21
3 ;;Per VHA Directive 2004-038, this routine should not be modified.
4 ;
5 ; CLAIMS (# 399)
6 Q
7D399 ;
8 NEW RCXVD,RCXVBC,RCXVDT,RCXVD1,RCXVD2,RCXVD3
9 NEW RCXVD4,RCXVD5,RCXVD6,RCXVD7,RCXVDA,RCXVDB,RCXVDC,RCXVDD
10 NEW RCXVP1,RCXVP2,RCXVD0C,RCXVP3,RCXVP4,RCXVP5,RCXVCFL,RCXVPAY
11 NEW RCXVINS,RCXVVAN,RCXVDRG,RCXVCAN,RCXVSNR,IBD,X1,X2,RCXVNPI
12 ;
13 I $P(RCXVBLNA,"-",2)="" Q
14 S RCXVD0=$O(^DGCR(399,"B",$P(RCXVBLNA,"-",2),""))
15 I RCXVD0="" Q
16 S RCXVD1=$G(^DGCR(399,RCXVD0,0))
17 I $G(DFN)="" S DFN=$P(RCXVD1,U,2)
18 S RCXVD2=$G(^DGCR(399,RCXVD0,"S"))
19 S RCXVD3=$G(^DGCR(399,RCXVD0,"U"))
20 S RCXVD7=$G(^DGCR(399,RCXVD0,"TX"))
21 S RCXVDA=$P(RCXVD1,U,1) ; BILL #
22 S (RCXVEVDT,RCXVDT)=$P($P(RCXVD1,U,3),".",1)
23 ;S RCXVDA=RCXVBLNB_RCXVDA_RCXVU_$E($$HLDATE^HLFNC(RCXVDT),1,8) ; EVNT DT
24 S RCXVDA=RCXVBLNA_RCXVU_$P(^DPT(DFN,0),U,9) ; SSN
25 S RCXVDA=RCXVDA_RCXVU_$E($$HLDATE^HLFNC(RCXVDT),1,8) ; EVNT DT
26 S RCXVDA=RCXVDA_RCXVU_$P(RCXVD1,U,5) ; BILL CLASS
27 S RCXVP1=$P(RCXVD1,U,7),RCXVP2=""
28 I RCXVP1'="" S RCXVP2=$P($G(^DGCR(399.3,RCXVP1,0)),U,1)
29 S RCXVDA=RCXVDA_RCXVU_RCXVP2 ; RATE TYPE (P)
30 S RCXVP1=$P(RCXVD2,U,11),RCXVP2=""
31 I RCXVP1'="" S RCXVP2=$P($G(^VA(200,RCXVP1,2,0)),U,1)_RCXVP1 ; SITE_IEN
32 S RCXVDA=RCXVDA_RCXVU_RCXVSITE_RCXVP2 ; Authorizer (P)
33 S RCXVDA=RCXVDA_RCXVU_$P(RCXVD1,U,13) ; Stat
34 S RCXVDT=$P(RCXVD1,U,14)
35 S RCXVDA=RCXVDA_RCXVU_$E($$HLDATE^HLFNC(RCXVDT),1,8) ; Stat DT
36 S RCXVP1=$P(RCXVD1,U,22),RCXVP2="",RCXVNPI=""
37 I RCXVP1'="" S RCXVP2=$$GET1^DIQ(40.8,RCXVP1,1) ;$P($G(^DG(40.8,RCXVP1,0)),U,2)
38 S:$G(RCXVP1)'="" RCXVNPI=$P($$NPI^XUSNPI("Organization_ID",$$GET1^DIQ(40.8,RCXVP1,.07,"I")),RCXVU,1) S:+RCXVNPI<1 RCXVNPI="" ;Default Division NPI
39 S RCXVDA=RCXVDA_RCXVU_RCXVP2_RCXVU_RCXVNPI ; Default division^Default division NPI
40 S RCXVDA=RCXVDA_RCXVU_$P(RCXVD1,U,24) ; UB92 Location
41 S RCXVDA=RCXVDA_RCXVU_$P(RCXVD1,U,27) ; Bill Chrg type
42 S RCXVDT=$P(RCXVD2,U,10)
43 S RCXVDB=$E($$HLDATE^HLFNC(RCXVDT),1,8) ; Auth. DT
44 S RCXVDT=$P(RCXVD2,U,12)
45 S RCXVDB=RCXVDB_RCXVU_$E($$HLDATE^HLFNC(RCXVDT),1,8) ; DT 1st printed
46 S (RCXVP1,RCXVD0C)=$P($G(^DGCR(399,RCXVD0,"M")),U,1),RCXVP2=""
47 I RCXVP1'="" S RCXVP2=$P($G(^DIC(36,RCXVP1,0)),U,1)
48 S RCXVDB=RCXVDB_RCXVU_RCXVP2 ; PRIM. INSR (P)
49 ;
50 ; Type of Plan
51 S RCXVP2="",RCXVI=0,RCXVP3="",RCXVP4="",RCXVP5=""
52 S IBD=$$IBAREXT^IBRFN4(RCXVD0,.IBD)
53 S RCXVP2=$P(IBD("IN"),U),RCXVP5=$P(IBD("IN"),U,2),RCXVP3=$P(IBD("IN"),U,3),RCXVP4=$P(IBD("IN"),U,4)
54 S RCXVDB=RCXVDB_RCXVU_RCXVP2_RCXVU_RCXVP5_RCXVU_RCXVP3_RCXVU_RCXVP4,RCXVD5="",RCXVD6=""
55 ;
56 ; 36, 36.3 ADDRESS/EDI
57 I RCXVD0C S RCXVD5=$G(^DIC(36,RCXVD0C,.11))
58 S RCXVDB=RCXVDB_RCXVU_$P(RCXVD5,U,1) ; STRT ADD 1
59 S RCXVDB=RCXVDB_RCXVU_$P(RCXVD5,U,2) ; STRT ADD 2
60 S RCXVDB=RCXVDB_RCXVU_$P(RCXVD5,U,4) ; CITY
61 S RCXVP1=$P(RCXVD5,U,5),RCXVP2=""
62 I RCXVP1'="" S RCXVP2=$P($G(^DIC(5,RCXVP1,0)),U,1)
63 S RCXVDB=RCXVDB_RCXVU_RCXVP2 ; STATE (P)
64 S RCXVDB=RCXVDB_RCXVU_$P(RCXVD5,U,6) ; ZIP
65 I RCXVD0C'="" S RCXVD6=$G(^DIC(36,RCXVD0C,3))
66 S RCXVDB=RCXVDB_RCXVU_$P(RCXVD6,U,2) ; EDI - PROF
67 S RCXVDB=RCXVDB_RCXVU_$P(RCXVD6,U,4) ; EDI - INST
68 S RCXVDB=RCXVDB_RCXVU_$$GET1^DIQ(36,RCXVD0C_",",1,"I") ; REIMBURSE?
69 ;
70 S RCXVPFDT=$P(RCXVD3,U,1)
71 S RCXVDC=$$HLDATE^HLFNC(RCXVPFDT) ; STMT COVERS FROM
72 S RCXVPTDT=$P(RCXVD3,U,2)
73 S RCXVDC=RCXVDC_RCXVU_$$HLDATE^HLFNC(RCXVPTDT) ; STMT COVERS TO
74 S RCXVP1=$P(RCXVD3,U,11),RCXVP2=""
75 I RCXVP1'="" S RCXVP2=$P($G(^DGCR(399.1,RCXVP1,0)),U,1)
76 S RCXVDC=RCXVDC_RCXVU_RCXVP2 ; DISCH. BED SEC.
77 S RCXVD4=$G(^DGCR(399,RCXVD0,"U1"))
78 S RCXVDC=RCXVDC_RCXVU_$P(RCXVD4,U,1) ; TOT CHRG
79 ;
80 S RCXVP1=$P($G(^DGCR(399,RCXVD0,"U2")),U,10),RCXVP2="",RCXVNPI=""
81 I RCXVP1'="" S RCXVP2=$P($G(^IBA(355.93,RCXVP1,0)),U,1)
82 S:$G(RCXVP2)'="" RCXVNPI=$P($$NPI^XUSNPI("Non_VA_Provider_ID",RCXVP1),RCXVU,1) S:+RCXVNPI<1 RCXVNPI=""
83 I RCXVNPI="",$G(RCXVP2)'="" S RCXVNPI=$$GET1^DIQ(355.93,RCXVP1,41.01,"I") ;This line is used if the XUSNPI API does not work
84 S RCXVDC=RCXVDC_RCXVU_RCXVP2_RCXVU_RCXVNPI ; NON VA FAC (P)^NON VA FAC NPI
85 ;
86 ; Get VACARE or NONVACARE flag
87 NEW RCXVIEN
88 D CARE^RCXVUTIL(RCXVD0)
89 S RCXVDC=RCXVDC_RCXVU_$S(RCXVCFL=1:"VACARE",1:"NONVACARE")
90 ; MRA data
91 S RCXVDT=$P(IBD,U,2)
92 S RCXVDD=$E($$HLDATE^HLFNC(RCXVDT),1,8) ; MRA Requested DT
93 S RCXVDT=$P(IBD,U,3)
94 S RCXVDD=RCXVDD_RCXVU_$E($$HLDATE^HLFNC(RCXVDT),1,8) ;Last Electronic Extract Date
95 S RCXVDD=RCXVDD_RCXVU_$P(IBD,U,4) ;Printed VIA EDI
96 S RCXVDD=RCXVDD_RCXVU_$P(IBD,U,5) ;Force Claim To Print
97 S RCXVDD=RCXVDD_RCXVU_$P(IBD,U,6) ;Claim MRA Status
98 S RCXVDT=$P(IBD,U,7)
99 S RCXVDD=RCXVDD_RCXVU_$E($$HLDATE^HLFNC(RCXVDT),1,8) ;MRA Recorded Date
100 S RCXVDT=$P(IBD,U,8)
101 S RCXVDD=RCXVDD_RCXVU_$E($$HLDATE^HLFNC(RCXVDT),1,8) ;Date Cancelled
102 S RCXVDD=RCXVDD_RCXVU_$P(IBD,U,9) ;Form Type
103 S RCXVDD=RCXVDD_RCXVU_$P(IBD,U,16)_RCXVU_$P(IBD,U,15) ;PAYER&VA NAT.ID #
104 S RCXVDRG=$P(IBD,U,11)
105 S RCXVDD=RCXVDD_RCXVU_RCXVDRG ;DRG
106 S RCXVSNR=$P(IBD,U,14) ;Days site not responsible for MRA request
107 S RCXVDD=RCXVDD_RCXVU_RCXVSNR
108 S RCXVDD=RCXVDD_RCXVU_$P($P(IBD,U,12),";") ;ECME #
109 S RCXVDD=RCXVDD_RCXVU_$P(IBD,U,17) ;Offset Amount
110 S ^TMP($J,RCXVBLN,"3-399A")=RCXVDA
111 S ^TMP($J,RCXVBLN,"3-399B")=RCXVDB
112 S ^TMP($J,RCXVBLN,"3-399C")=RCXVDC
113 S ^TMP($J,RCXVBLN,"3-399D")=RCXVDD
114 Q
115 ;
116REJ() ;Checks for reject on a claim
117 S X="NO"
118 S X1=$P(RCXVD1,U,15) S D0=RCXVD0
119 F D G REJQ:'D0
120 . S I=0 F S I=$O(^IBM(361,"B",D0,I)) Q:'I D Q:'D0
121 ..S X2=$P($G(^IBM(361,I,0)),U,3)
122 ..I X2="R" S X="YES",D0=""
123 ..Q
124 .I X="YES" Q
125 .I X1=D0 S D0="" Q
126 .S D0=X1 Q:'D0 S X1=$P($G(^DGCR(399,X1,0)),U,15)
127 .Q
128 K I
129REJQ Q X
130 ;
Note: See TracBrowser for help on using the repository browser.