source: FOIAVistA/trunk/r/INTEGRATED_BILLING-IB-PRQ--IBD--IBQ--PRQS/IBCNRSM.m@ 868

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

initial load of FOIAVistA 6/30/08 version
File size: 7.1 KB
Line 
1IBCNRSM ;DAOU/BEE - Shared Plan Matches Report ;14-OCT-2004
2 ;;2.0;INTEGRATED BILLING;**322**;21-MAR-94
3 ;;Per VHA Directive 10-93-142, this routine should not be modified.
4 ;
5 ; e-Pharmacy Shared Plan Matches Report
6 ;
7 ; Input parameter: N/A
8 ;
9 ; Predefined Variables: U => "^"
10 ; DT => Current System Date (VA format: yyymmdd)
11 ;
12 ; Other relevant variables:
13 ; IBCNRRTN = "IBCNRSM" (current routine name, used for ^XTMP and ^TMP
14 ; storage subscript)
15 ; Storage Global:
16 ; ^XTMP("IBCNRSM",0) = Piece 1^Piece 2^Piece 3^Piece 4^Piece 5^Piece 6
17 ; where:
18 ; Piece 1 => Purge Date - 1 year in future
19 ; Piece 2 => Create Date - Today
20 ; Piece 3 => Description
21 ; Piece 4 => Last Date Compiled
22 ; Piece 5 => $H of Paid Date Compile
23 ; Piece 6 => $H last run completion time
24 ;
25 ; ^XTMP("IBCNRSM",1,IEN) = LDT
26 ; where:
27 ; IEN => Internal GROUP INSURANCE index entry
28 ; LDT => Last Date Paid, VA Fileman Format
29 ;
30 ; Entry Point - TASKMAN => Run report in background using TASKMAN
31 ;
32 Q
33 ;
34 ; TASKMAN ENTRY POINT
35 ;
36TASKMAN N IBCNRRTN,P,D0,D1,D2,DG,DIC,DICR,DISYS,DIW,Y
37 ;
38 ;Process Report
39 ;
40 ;Initialize variables
41 S IBCNRRTN="IBCNRSM"
42 S P="|"
43 ;
44 ;Check to see if report is in use
45 L +^XTMP(IBCNRRTN):5 I '$T G EXIT
46 ;
47 ;Reset Temporary Scratch Global
48 K ^TMP(IBCNRRTN,$J)
49 ;
50 ;Check for required variables
51 I $G(U)=""!($G(DT)="") G EXIT
52 ;
53 ;Pull Station (Institution) address
54 D STAT(IBCNRRTN)
55 ;
56 ;Perform Compile
57 ;
58 ;Recompile the Paid Date Index
59 D PDT(IBCNRRTN,DT)
60 ;
61 ;Process the entries
62 D PROC(IBCNRRTN)
63 ;
64 ;Send the message
65 D EMAIL(IBCNRRTN)
66 ;
67 ;Log Run Completion Time
68 S $P(^XTMP(IBCNRRTN,0),U,6)=$H
69 ;
70 ;Standard EXIT point
71EXIT K ^TMP(IBCNRRTN,$J)
72 L -^XTMP(IBCNRRTN)
73 K IBCNRRTN,P,D0,D1,D2,DG,DIC,DICR,DISYS,DIW,Y
74 Q
75 ;
76 ; PULL STATION AND INSTITUTION ADDRESS
77 ;
78STAT(IBCNRRTN) N INST,N,CITY,SINFO,SITE,STATE,ZIP
79 S (CITY,STATE,ZIP)=""
80 ;
81 ;Pull Site Info
82 S SINFO=$$SITE^VASITE
83 S SITE=$P(SINFO,U,3)
84 S INST=$P(SINFO,U)
85 ;
86 I INST D
87 .S N(0)=$G(^DIC(4,INST,0))
88 .S N(1)=$G(^DIC(4,INST,1))
89 .S CITY=$P(N(1),U,3)
90 .S STATE=$P(N(0),U,2)
91 .I STATE S STATE=$P($G(^DIC(5,STATE,0)),U,2)
92 .S ZIP=$P(N(1),U,4)
93 S ^TMP(IBCNRRTN,$J,1)="Station: "_SITE_P_CITY_P_STATE_P_ZIP
94 ;
95 K IBCNRRTN,INST,N,CITY,SINFO,SITE,STATE,ZIP
96 Q
97 ;
98 ; PROCESS EACH GROUP INSURANCE ENTRY
99 ;
100PROC(IBCNRRTN) N COUNT,IGRP,IPAYER,IINS,GRPDATA,INSDATA,PLNDATA,PAYDATA,PDTDATA,PLANID
101 ;
102 ;Initialize Counter
103 S COUNT=1
104 ;
105 ;Loop through GROUP INSURANCE PLAN and process any item with a PLANID
106 S IGRP=0 F S IGRP=$O(^IBA(355.3,IGRP)) Q:'IGRP D
107 .;
108 .;Get PLANID and process each entry
109 .S PLANID=$P($G(^IBA(355.3,IGRP,6)),U) I 'PLANID Q
110 .;
111 .;Pull Group Information
112 .S GRPDATA=$$GRP(IGRP)
113 .;
114 .;Get Insurance Lookup from GROUP INSURANCE
115 .S IINS=+$P($G(^IBA(355.3,IGRP,0)),U)
116 .;
117 .;Pull Insurance Information from INSURANCE COMPANY
118 .S INSDATA=$$INS(IINS)
119 .;
120 .;Get Plan info from PLAN
121 .S PLNDATA=$$PLAN(PLANID) I PLNDATA="" Q
122 .;
123 .;Get Payer Lookup from PLAN
124 .S IPAYER=+$P($G(^IBCNR(366.03,PLANID,0)),U,3)
125 .;
126 .;If no (or invalid) Payer Lookup in PLAN, Pull from INSURANCE COMPANY
127 .I IPAYER=0!('$D(^IBE(365.12,IPAYER,0))) S IPAYER=+$P($G(^DIC(36,IINS,3)),U,10)
128 .;
129 .;Pull Payer Information
130 .S PAYDATA=P_P I IPAYER S PAYDATA=$$PAYER(IPAYER)
131 .;
132 .;Last Paid Date
133 .S PDTDATA=$$PAID(IBCNRRTN,IGRP)
134 .;
135 .;Update Counter and Save Entry
136 .S COUNT=$G(COUNT)+1
137 .S ^TMP(IBCNRRTN,$J,COUNT)=INSDATA_P_PAYDATA_P_GRPDATA_P_PLNDATA_P_PDTDATA
138 ;
139 K IBCNRRTN,COUNT,IGRP,IPAYER,IINS,GRPDATA,INSDATA,PLNDATA,PAYDATA,PDTDATA,PLANID
140 Q
141 ;
142 ; PULL GROUP INFORMATION
143 ;
144 ; Function Returns Piece 1 -> Group Name
145 ; 2 -> Group Number
146 ;
147GRP(IGRP) N GRPDATA,NAME,NUMB,N
148 ;
149 S N=$G(^IBA(355.3,IGRP,0))
150 ;
151 ;Group Name
152 S NAME=$P(N,U,3)
153 ;
154 ;Group Number
155 S NUMB=$P(N,U,4)
156 ;
157 S GRPDATA=NAME_P_NUMB
158 K IGRP,NAME,NUMB,N
159 Q GRPDATA
160 ;
161 ; GET INSURANCE INFORMATION
162 ;
163 ; Return Variable: Piece 1 -> Company Name
164 ; 2 -> Company Address 1
165 ; 3 -> Company Address 2
166 ; 4 -> Company City
167 ; 5 -> Company State
168 ; 6 -> Company Zip Code
169 ;
170INS(IINS) N ADDR1,ADDR2,CITY,NAME,N,STATE,ZIP
171 ;
172 ;Reset Return Variable
173 S INSDATA=P_P_P_P_P I IINS="" G XINS
174 ;
175 S NAME=$P($G(^DIC(36,IINS,0)),U)
176 S N=$G(^DIC(36,IINS,.11))
177 S ADDR1=$P(N,U,1) ;Address Line 1
178 S ADDR2=$P(N,U,2) ;Address Line 2
179 S CITY=$P(N,U,4) ;City
180 S STATE=$P(N,U,5) ;State
181 I STATE]"" S STATE=$P($G(^DIC(5,STATE,0)),U,2)
182 S ZIP=$P(N,U,6) ;Zip Code
183 ;
184XINS I IINS]"" S INSDATA=NAME_P_ADDR1_P_ADDR2_P_CITY_P_STATE_P_ZIP
185 K IINS,ADDR1,ADDR2,CITY,NAME,N,STATE,ZIP
186 Q INSDATA
187 ;
188 ; GET PAYER INFORMATION
189 ;
190 ; Return Variable: Piece 1 -> VA National Payer ID
191 ; 2 -> Professional ID
192 ; 3 -> Institutional ID
193 ;
194PAYER(IPAYER) N N,VAID,PROF,INST,PAYDATA
195 ;
196 S N=$G(^IBE(365.12,IPAYER,0))
197 S VAID=$P(N,U,2) ;VA National Payer ID
198 S PROF=$P(N,U,5) ;Professional ID
199 S INST=$P(N,U,6) ;Institutional ID
200 ;
201 S PAYDATA=INST_P_PROF_P_VAID
202 K IPAYER,N,VAID,PROF,INST
203 Q PAYDATA
204 ;
205 ; GET PLAN INFORMATION
206 ;
207 ; Return Variable: Piece 1 -> VA National Plan ID
208 ;
209PLAN(PLANID) N PLNDATA
210 ;
211 ;Get Plan ID
212 S PLNDATA=$P($G(^IBCNR(366.03,PLANID,0)),U)
213 ;
214 K PLANID
215 Q PLNDATA
216 ;
217 ; GET LAST DATE PAID
218 ;
219PAID(IBCNRRTN,IGRP) N PDTDATA
220 ;
221 ;Pull Last Date Paid from Storage Global
222 S PDTDATA=$G(^XTMP(IBCNRRTN,1,IGRP))
223 ;
224 ;Convert to External Format
225 I PDTDATA]"" S PDTDATA=PDTDATA+17000000
226 ;
227 K IBCNRRTN,IGRP
228 Q PDTDATA
229 ;
230 ; COMPILE THE PAID DATE SCRATCH GLOBAL
231 ;
232PDT(IBCNRRTN,DATE) N CDT,RDT,LDT,LASTDT,XBPS,CID,IEN,DESC
233 ;
234 ;Pull the current information from ^XTMP
235 S CDT=$P($G(^XTMP(IBCNRRTN,0)),U,4) ;Last Date Compiled
236 ;
237 ;Capture the most current response entry
238 S LASTDT=$P($O(^BPSR("AE",""),-1),".")
239 ;
240 ;Loop through Response Received Index and get latest paid date
241 S RDT="" F S RDT=$O(^BPSR("AE",RDT),-1),LDT=$P(RDT,".") Q:RDT=""!(LDT<CDT) D
242 .S XBPS="" F S XBPS=$O(^BPSR("AE",RDT,XBPS)) Q:XBPS="" D
243 ..;
244 ..;Screen out any non-accepted claims
245 ..I $P($G(^BPSR(XBPS,500)),U)'="A" Q
246 ..;
247 ..;Pull Claim Internal ID
248 ..S CID=$P($G(^BPSR(XBPS,0)),U) I CID="" Q
249 ..;
250 ..;Pull VA Plan IEN (Lookup to Group Insurance)
251 ..S IEN=$P($G(^BPSC(CID,1)),U,4) I IEN="" Q
252 ..;
253 ..;If more recent Response Date update storage entry
254 ..I (LDT>$G(^XTMP(IBCNRRTN,1,IEN))) S ^XTMP(IBCNRRTN,1,IEN)=LDT
255 ;
256 ;Update ^XTMP(IBCNRRTN,0) top level entry
257 S DESC="Shared Plan Matches Report Storage - Do Not Delete"
258 S ^XTMP(IBCNRRTN,0)=(DATE+10000)_U_DATE_U_DESC_U_LASTDT_U_$H
259 ;
260 K IBCNRRTN,DATE,CDT,RDT,LDT,XBPS,CID,IEN,DESC,LASTDT
261 Q
262 ;
263 ; EMAIL THE MESSAGE
264 ;
265EMAIL(IBCNRRTN) N XMY,XMTEXT,XMSUB,XMDUN,XMDUZ,XMZ
266 ;
267 S XMTEXT="^TMP("""_IBCNRRTN_""","_$J_","
268 S XMY("JANUS@MED.VA.GOV")=""
269 S XMSUB=$TR($P($G(^TMP(IBCNRRTN,$J,1)),P),":")_" Matches"
270 D ^XMD
271 ;
272 K IBCNRRTN,XMY,XMTEXT,XMSUB,XMDUN,XMDUZ,XMZ
273 Q
Note: See TracBrowser for help on using the repository browser.