source: WorldVistAEHR/trunk/r/ACCOUNTS_RECEIVABLE-PRCA-PRY-RC/RCXVDC5.m@ 1042

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

initial load of WorldVistAEHR
File size: 4.8 KB
Line 
1RCXVDC5 ;DAOU/ALA-AR Data Extraction Data Creation ;02-JUL-03
2 ;;4.5;Accounts Receivable;**201,227,228,240,243,248,245,251**;Mar 20, 1995;Build 21
3 ;
4 ; Integrated Billing Action File (# 350)
5 Q
6D350 ;
7 NEW RCXVD,RCXVDA,RCXVDB,RCXVD0A,RCXVDT,RCXVP1,RCXVP2,RCXVPC,RCT
8 NEW RCIBVD,RCIBAD,RCIBDD,RCIBSL,RCIBBG,RCIBPE,RCXVNPI
9 S RCXVD0A="",RCT=0
10 F S RCXVD0A=$O(^IB("ABIL",RCXVBLNA,RCXVD0A)) Q:RCXVD0A="" D
11 . S RCXVD=$G(^IB(RCXVD0A,0))
12 . I $G(DFN)="" S DFN=$P(RCXVD,U,2)
13 . ;
14 . S RCXVDA=RCXVBLNA_RCXVU_$P(RCXVD,U,1)
15 . S RCXVDA=RCXVDA_RCXVU_$$GET1^DIQ(350,RCXVD0A_",",.05,"E")
16 . S RCXVP1=$P(RCXVD,U,3),RCXVP2=""
17 . I RCXVP1'="" S RCXVP2=$P($G(^IBE(350.1,RCXVP1,0)),U,1)
18 . S RCXVDA=RCXVDA_RCXVU_RCXVP2 ; ACTION TYPE (P)
19 . S RCXVDA=RCXVDA_RCXVU_$P(RCXVD,U,6) ; UNITS
20 . S RCXVDA=RCXVDA_RCXVU_$P(RCXVD,U,7) ; TOTAL CHARGE
21 . S RCXVDT=$P(RCXVD,U,14)
22 . S RCXVDA=RCXVDA_RCXVU_$E($$HLDATE^HLFNC(RCXVDT),1,8) ; DT BILLD FROM
23 . S RCXVDT=$P(RCXVD,U,15)
24 . S RCXVDA=RCXVDA_RCXVU_$E($$HLDATE^HLFNC(RCXVDT),1,8) ; DT BILLD TO
25 . S RCXVDA=RCXVDA_RCXVU_$P(RCXVD,U,11) ; AR BILL #
26 . S RCXVDT=$P($P($G(^IB(RCXVD0A,1)),U,2),".",1)
27 . S RCXVDA=RCXVDA_RCXVU_$E($$HLDATE^HLFNC(RCXVDT),1,8) ; DT ENTRY ADDED
28 . S RCXVDA=RCXVDA_RCXVU_$P($G(^DPT(DFN,0)),U,9) ; SSN
29 . S RCXVDT=$P(RCXVD,U,17)
30 . S RCXVDA=RCXVDA_RCXVU_$E($$HLDATE^HLFNC(RCXVDT),1,8) ; EVENT DT
31 . S RCXVDT=$$PRESC($P(RCXVD,U,4))
32 . S RCXVDA=RCXVDA_RCXVU_$E($$HLDATE^HLFNC(RCXVDT),1,8) ;FILL/REFILL DATE
33 . S (RCIBVD,RCIBAD,RCIBDD)="" D
34 ..S RCIBSL=$P(RCXVD,U,4) Q:+RCIBSL=52
35 ..S RCIBBG=$P($G(^IBE(350.1,+$P(RCXVD,"^",3),0)),"^",11)
36 ..I RCIBBG=4 S RCXVDT=$P(RCXVD,U,14),RCIBVD=$E($$HLDATE^HLFNC(RCXVDT),1,8) Q
37 ..S RCIBPE=$G(^IB(+$P(RCXVD,"^",16),0))
38 ..I +RCIBSL'=405,+RCIBSL'=45 S RCIBSL=$P(RCIBPE,"^",4)
39 ..I +RCIBSL=405!(+RCIBSL=45) D INP
40 ..Q
41 . ;add outpatient visit date, inp. admission date, inp. discharge date
42 . S RCXVDA=RCXVDA_RCXVU_RCIBVD_RCXVU_RCIBAD_RCXVU_RCIBDD
43 . S RCXVNPI="",RCXVDA=RCXVDA_RCXVU_$$SITE(RCXVD0A,1)_RCXVU_RCXVNPI ;DIVISION WHERE CARE RENDERED^DIVISION NPI
44 . S RCT=RCT+1
45 . S ^TMP($J,RCXVBLN,"5-350A",RCT)=RCXVDA
46 Q
47 ;
48PRESC(RCPC4) ;Calculates prescription fill/refill date
49 ; Input is resulting from field (4th piece of 0 node) in 350
50 ; Output is fill/refill date in fileman format
51 N RCRXN,RCRF,RCPRDT,PSOFILE,DIC,DR,DA,DIQ,RCX
52 S RCPRDT=""
53 I $P(RCPC4,":")'=52 Q RCPRDT
54 S RCRXN=+$P(RCPC4,":",2),RCRF=$P(RCPC4,":",3)
55 ;Set variables for DIQ^PSODI call
56 S PSOFILE=52
57 S DIC=52
58 S DIQ="RCX"
59 S DIQ(0)="I"
60 I RCRF>0 D
61 .S DR=52
62 .S DR(52.1)="17"
63 .S DA=RCRXN
64 .S DA(52.1)=RCRF
65 .D DIQ^PSODI(PSOFILE,DIC,.DR,.DA,.DIQ)
66 .S RCPRDT=$G(RCX(52.1,DA(52.1),17,"I"))
67 E D
68 .S DR=31
69 .S DA=+RCRXN
70 .D DIQ^PSODI(PSOFILE,DIC,DR,DA,.DIQ)
71 .S RCPRDT=$G(RCX(52,DA,31,"I"))
72 S RCPRDT=$P(RCPRDT,".")
73 ;Return refill date without time
74 Q RCPRDT
75INP ; get inpatient admission and discharge date
76 N PM,PM0,X,X1,X2
77 I +RCIBSL=405 D
78 .S PM=+$P(RCIBSL,":",2),PM0=$G(^DGPM(PM,0))
79 .S RCIBAD=$S(PM0:+PM0\1,1:$P(RCIBPE,"^",17))
80 .S RCIBAD=$E($$HLDATE^HLFNC(RCIBAD),1,8)
81 .S RCIBDD=$S(PM0:$S($D(^DGPM(+$P(PM0,"^",17),0)):+^(0)\1,1:""),1:"")
82 .S RCIBDD=$E($$HLDATE^HLFNC(RCIBDD),1,8)
83 I +RCIBSL=45 D
84 .S PM=+$P(RCIBSL,":",2),PM0=$G(^DGPT(PM,0))
85 .S RCIBAD=$S(PM0:+$P(PM0,"^",2)\1,1:$P(RCIBPE,"^",17))
86 .S RCIBAD=$E($$HLDATE^HLFNC(RCIBAD),1,8)
87 .S RCIBDD=$S($G(^DGPT(PM,70)):+^(70)\1,1:"")
88 .S RCIBDD=$E($$HLDATE^HLFNC(RCIBDD),1,8)
89 Q
90SITE(IIEN,FLG) ; Find the Care Site for Co-Pays
91 ; Input Parameters
92 ; IIEN = Internal Entry Number for IB ACTION #350
93 ; FLG = 1=Division Name,2=Facility Number
94 ;
95 NEW VDIV,VFAC,VWIEN,VWFIL,VVIS,VLOC,VWARD,VLVAL,VWHER
96 S VWHER=$P(^IB(IIEN,0),U,4)
97 ;
98 I VWHER="" Q ""
99 ;
100 S VWFIL=$P(VWHER,":",1),VWIEN=$P(VWHER,":",2)
101 I VWIEN[";" S VWIEN=$P(VWIEN,";",1)
102 ;
103 S VLVAL=""
104MV I VWFIL=405 D
105 . I VWIEN="" Q
106 . S VWARD=$P($G(^DGPM(VWIEN,0)),U,6)
107 . I VWARD="" Q
108 . S VLOC=$P($G(^DIC(42,VWARD,44)),U,1)
109 . I VLOC="" Q
110 . S VDIV=$P($G(^SC(VLOC,0)),U,15)
111 . I VDIV="" Q
112 . D VLU
113 ;
114OP I VWFIL=409.68 D
115 . S VLOC=$P($G(^SCE(VWIEN,0)),U,4)
116 . I VLOC="" D
117 .. S VVIS=$P($G(^SCE(VWIEN,0)),U,5)
118 .. I VVIS="" Q
119 .. S VLOC=$P($G(^AUPNVSIT(VVIS,0)),U,22)
120 . I VLOC="" Q
121 . S VDIV=$P($G(^SC(VLOC,0)),U,15)
122 . I VDIV="" Q
123 . D VLU
124 ;
125RX I VWFIL=52 D
126 .N PSOFILE,DIC,DR,DA,DIQ,RCX
127 .S PSOFILE=52
128 .S DIC=52
129 .S DA=VWIEN
130 .S DR=5
131 .S DIQ="RCX"
132 .S DIQ(0)="I"
133 .D DIQ^PSODI(PSOFILE,DIC,DR,DA,.DIQ)
134 .S VLOC=$G(RCX(PSOFILE,DA,DR,"I"))
135 .I VLOC="" Q
136 .S VDIV=$P($G(^SC(VLOC,0)),U,15)
137 .I VDIV="" Q
138 .D VLU
139 ;
140LC I VWFIL=44 D
141 . S VDIV=$P($G(^SC(VWIEN,0)),U,15)
142 . I VDIV="" Q
143 . D VLU
144 ;
145IB I VWFIL=350 D
146 . S VFAC=$P($G(^IB(VWIEN,0)),U,13)
147 . I VFAC="" Q
148 . S VDIV=$O(^DG(40.8,"C",VFAC,""))
149 . I VDIV="" Q
150 . D VLU
151 ;
152 Q VLVAL
153 ;
154VLU I FLG=1 S VLVAL=$P(^DG(40.8,VDIV,0),U,1)
155 I FLG=2 S VLVAL=$P(^DG(40.8,VDIV,0),U,2)
156 I $G(VLVAL)'=""&($G(VDIV)'="") S RCXVNPI=$P($$NPI^XUSNPI("Organization_ID",$$GET1^DIQ(40.8,VDIV,.07,"I")),RCXVU,1) S:+RCXVNPI<1 RCXVNPI=""
157 Q
Note: See TracBrowser for help on using the repository browser.