1 | RCXVDC4 ;DAOU/ALA-AR Data Extraction Data Creation ;02-JUL-03
|
---|
2 | ;;4.5;Accounts Receivable;**201,227,228,248,251,256**;Mar 20, 1995;Build 6
|
---|
3 | ;;Per VHA Directive 2004-038, this routine should not be modified.
|
---|
4 | ;
|
---|
5 | ; Procedures
|
---|
6 | Q
|
---|
7 | D399PC ;
|
---|
8 | I RCXVD0="" Q
|
---|
9 | N RCXVD,RCXVDA,RCXVB,RCXVPC,RCXVP1,RCXVP2,RCXVP3,RCXVMULT
|
---|
10 | N RCXVDT3,RCXVCP,RCXVPCDT,RCXVPS1,RCXVPS2,RCXVPS,RCXVPSER,RCXVNPI,RCXVCNT,RCXVMH
|
---|
11 | ;RCXVPC=PROC. CODE IEN, RCXVCP=CPT CODE IEN
|
---|
12 | ; LOOP THRU PROC.
|
---|
13 | S RCXVMH="",(RCXVPC,RCXVCNT)=0
|
---|
14 | F S RCXVPC=$O(^DGCR(399,RCXVD0,"CP",RCXVPC)) Q:'RCXVPC D D399PCA
|
---|
15 | S RCXVPC=0
|
---|
16 | F S RCXVPC=$O(^DGCR(399,RCXVD0,"RC",RCXVPC)) Q:'RCXVPC D D39942
|
---|
17 | Q
|
---|
18 | D399PCA ;
|
---|
19 | S RCXVD=$G(^DGCR(399,RCXVD0,"CP",RCXVPC,0)) Q:RCXVD=""
|
---|
20 | S RCXVP1=$P(RCXVD,U,1),RCXVVP="",RCXVVP1=""
|
---|
21 | I RCXVP1'="" S RCXVVP="^"_$P(RCXVP1,";",2)_$P(RCXVP1,";",1)_",0)"
|
---|
22 | I RCXVVP'="" S RCXVVP1=$P($G(@RCXVVP),U,1) I RCXVVP1="" D
|
---|
23 | . NEW CT
|
---|
24 | . S CT=$G(^TMP("RCXVBREC",$J,0))+1,^TMP("RCXVBREC",$J,0)=CT
|
---|
25 | . S ^TMP("RCXVBREC",$J,CT,0)="Bill # "_$P($G(^DGCR(399,RCXVD0,0)),"^",1)_" has a bad CPT code at IEN # "_RCXVPC_" check ^DGCR(399,"_RCXVD0_",""CP"","_RCXVPC_",0)"
|
---|
26 | S RCXVDA=RCXVBLNA_RCXVU_RCXVVP1 ; PROC.
|
---|
27 | S RCXVDT=$P(RCXVD,U,2)
|
---|
28 | S RCXVPCDT=$E($$HLDATE^HLFNC(RCXVDT),1,8)
|
---|
29 | S RCXVDA=RCXVDA_RCXVU_RCXVPCDT ; DT
|
---|
30 | S RCXVP1=$P(RCXVD,U,11),RCXVP2=""
|
---|
31 | I RCXVP1'="" S RCXVP1=$P($G(^IBA(362.3,RCXVP1,0)),U,1)
|
---|
32 | I RCXVP1'="" S RCXVP2=$P($G(^ICD9(RCXVP1,0)),U,1)
|
---|
33 | S RCXVDA=RCXVDA_RCXVU_RCXVP2 ; ASSOC DXN (1)
|
---|
34 | S RCXVP1=$P(RCXVD,U,7),RCXVP2=""
|
---|
35 | I RCXVP1'="" S RCXVP2=$P($G(^SC(RCXVP1,0)),U,1)
|
---|
36 | S RCXVDA=RCXVDA_RCXVU_RCXVP2 ; ASSC. CLNC (P)
|
---|
37 | S RCXVP1=$P(RCXVD,U,18),(RCXVP2,RCXVPS,RCXVPSER,RCXVNPI)=""
|
---|
38 | I RCXVP1'="" S RCXVP2=$$GET1^DIQ(200,RCXVP1_",",.01,"E"),RCXVNPI=$P($$NPI^XUSNPI("Individual_ID",RCXVP1),RCXVU,1) S:+RCXVNPI<1 RCXVNPI="" D
|
---|
39 | . S RCXVPS=$$GET^XUA4A72(RCXVP1,RCXVDT)
|
---|
40 | . S RCXVPS=$P(RCXVPS,U,3)
|
---|
41 | . S RCXVPSER=$$GET1^DIQ(200,RCXVP1_",",29,"E")
|
---|
42 | . Q
|
---|
43 | ;provider^provider npi^specialty^service/section
|
---|
44 | S RCXVDA=RCXVDA_RCXVU_RCXVP2_RCXVU_RCXVNPI_RCXVU_RCXVPS_RCXVU_RCXVPSER
|
---|
45 | S RCXVCNT=RCXVCNT+1,^TMP($J,RCXVBLN,"4-399A",RCXVCNT)=RCXVDA
|
---|
46 | ; LOOP THRU CPT
|
---|
47 | S RCXVCP=0,RCXVMULT=0
|
---|
48 | F S RCXVCP=$O(^DGCR(399,RCXVD0,"CP",RCXVPC,"MOD",RCXVCP)) Q:'RCXVCP D
|
---|
49 | . Q:'($D(^DGCR(399,RCXVD0,"CP",RCXVPC,"MOD",RCXVCP,0)))
|
---|
50 | . ; ^DGCR(399,D0,CP,D1,MOD,D2,0)= (#.01) CPT MODIFIER SEQUENCE [1N]
|
---|
51 | . ; (#.02) CPT ==>MODIFIER [2P:81.3]
|
---|
52 | . S RCXVP1=$P($G(^DGCR(399,RCXVD0,"CP",RCXVPC,"MOD",RCXVCP,0)),U,2)
|
---|
53 | . Q:RCXVP1=""
|
---|
54 | . S RCXVMULT=RCXVMULT+1
|
---|
55 | . S RCXVP2=$P($G(^DIC(81.3,RCXVP1,0)),U,1)
|
---|
56 | . S ^TMP($J,RCXVBLN,"4-399A",RCXVCNT,RCXVMULT)=RCXVP2
|
---|
57 | . Q
|
---|
58 | ;
|
---|
59 | ; *256 - loop through 399.042 to find CPT procedure
|
---|
60 | MATCH N RCXVCPT1,RCXVFND,X
|
---|
61 | S RCXVCPT1=$P(RCXVD,";",1) ;proc
|
---|
62 | S (RCXVFND,RCXVCP)=0
|
---|
63 | F S RCXVCP=$O(^DGCR(399,RCXVD0,"RC",RCXVCP)) Q:'RCXVCP!RCXVFND D
|
---|
64 | . Q:$F(RCXVMH,";"_RCXVCP) ;quit if CPT proc match
|
---|
65 | . S RCXVD1=$G(^DGCR(399,RCXVD0,"RC",RCXVCP,0))
|
---|
66 | . Q:RCXVD1=""
|
---|
67 | . S X=$P(RCXVD1,U,6) ;CPT proc
|
---|
68 | . I RCXVCPT1'="",X'="",RCXVCPT1=X D
|
---|
69 | .. S RCXVFND=1
|
---|
70 | .. S X=$P(RCXVD1,U)
|
---|
71 | .. S RCXVDB=RCXVBLNA_RCXVU_$$GET1^DIQ(399.2,X_",",.01,"E") ; Revenue Code
|
---|
72 | .. S X=$P(RCXVD1,U,6)
|
---|
73 | .. S RCXVDB=RCXVDB_RCXVU_$$GET1^DIQ(81,X_",",.01,"E") ; Procedures [P]
|
---|
74 | .. S RCXVDB=RCXVDB_RCXVU_RCXVPCDT ; PROC. DT
|
---|
75 | .. S RCXVDB=RCXVDB_RCXVU_$P(RCXVD1,U,2) ; Charges
|
---|
76 | .. S ^TMP($J,RCXVBLN,"4-399B",RCXVCNT)=RCXVDB
|
---|
77 | .. S RCXVMH=RCXVMH_";"_RCXVCP
|
---|
78 | I 'RCXVFND S ^TMP($J,RCXVBLN,"4-399B",RCXVCNT)=""
|
---|
79 | Q
|
---|
80 | ;
|
---|
81 | D39942 ; charge
|
---|
82 | N X
|
---|
83 | Q:$F(RCXVMH,";"_RCXVPC)
|
---|
84 | S RCXVD1=$G(^DGCR(399,RCXVD0,"RC",RCXVPC,0))
|
---|
85 | Q:RCXVD1=""
|
---|
86 | S X=$P(RCXVD1,U)
|
---|
87 | S RCXVDB=RCXVBLNA_RCXVU_$$GET1^DIQ(399.2,X_",",.01,"E") ; Revenue Code
|
---|
88 | S RCXVDB=RCXVDB_RCXVU_"" ;No CPT proc
|
---|
89 | S RCXVDB=RCXVDB_RCXVU_"" ; No proc dt
|
---|
90 | S RCXVDB=RCXVDB_RCXVU_$P(RCXVD1,U,2) ; Charges
|
---|
91 | S RCXVCNT=RCXVCNT+1
|
---|
92 | S ^TMP($J,RCXVBLN,"4-399A",RCXVCNT)=""
|
---|
93 | S ^TMP($J,RCXVBLN,"4-399B",RCXVCNT)=RCXVDB
|
---|
94 | Q
|
---|
95 | ;
|
---|