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

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

initial load of FOIAVistA 6/30/08 version
File size: 9.0 KB
Line 
1IBCNERP8 ;DAOU/BHS - IBCNE IIV STATISTICAL REPORT COMPILE ;11-JUN-2002
2 ;;2.0;INTEGRATED BILLING;**184,271,345**;21-MAR-94;Build 28
3 ;;Per VHA Directive 2004-038, this routine should not be modified.
4 ;
5 ; IIV - Insurance Identification and Verification Interface
6 ;
7 ;Input vars from IBCNERP7:
8 ; IBCNERTN = "IBCNERP7"
9 ; **IBCNESPC array ONLY passed by reference **
10 ; IBCNESPC("BEGDTM") = Start Dt/Tm for rpt range
11 ; IBCNESPC("ENDDTM") = End Dt/Tm for rpt range
12 ; IBCNESPC("SECTS") = 1 - All sections OR ',' sep'd list of 1 or more
13 ; of the following (not all)
14 ; 2 - Outgoing data, inq trans stats
15 ; 3 - Incoming data, resps rec'd stats
16 ; 4 - Current status, pending resps, queued inqs, deferred inqs, payer
17 ; stats, ins buf stats
18 ; IBCNESPC("MM") = "" - do not generate MailMan message OR MAILGROUP to
19 ; send report to Mail Group as defined in the IB site parameters
20 ;Output vars:
21 ; Based on IBCNESPC("SECTS") parameter the following scratch globals
22 ; may be built
23 ; 1 OR contains 2 -->
24 ; ^TMP($J,RTN,"OUT")=TotInq^InsBufExtSubtotal^PreRegExtSubtotal^...
25 ; NonVerifInsExtSubtotal^NoActInsExtSubtotal
26 ; 1 OR contains 3 -->
27 ; ^TMP($J,RTN,"IN")=TotResp^InsBufExtSubtotal^PreRegExtSubtotal^...
28 ; NonVerifInsExtSubtotal^NoActInsExtSubtotal
29 ; 1 OR contains 4 -->
30 ; ^TMP($J,RTN,"CUR")=TotPendingResponses^TotQueuedInquiries^...
31 ; TotDeferredInquiries(Hold)^TotInsCosw/oNationalID^...
32 ; ToteIIVPyrsDisabldLocally^TotInsBufVerified^TotalManVerified...
33 ; TotalIIVVerified^TotInsBufUnverified^! InsBufSubtotal^...
34 ; ? InsBufSubtotal^- InsBufSubtotal^Other InsBufSubtotal
35 ; 1 OR contains 4 -->
36 ; ^TMP($J,RTN,"PYR",PAYER,IEN)="" (list of new payers)
37 ;
38 ; Must call at EN
39 Q
40 ;
41EN(IBCNERTN,IBCNESPC) ; Entry pt
42 ; Init vars
43 N IBBDT,IBEDT,IBSCT,IBTOT,PIECES,VALUE,CT
44 ;
45 I '$D(ZTQUEUED),$G(IOST)["C-" W !!,"Compiling report data ..."
46 ;
47 S IBTOT=0
48 ;
49 ; Kill scratch global
50 K ^TMP($J,IBCNERTN)
51 ;
52 ; Init looping vars
53 S IBBDT=$G(IBCNESPC("BEGDTM")),IBEDT=$G(IBCNESPC("ENDDTM"))
54 S IBSCT=$G(IBCNESPC("SECTS"))
55 ;
56 I IBSCT=1!$F(IBSCT,",2,") D OUT(IBCNERTN,IBBDT,IBEDT,.IBTOT)
57 I $G(ZTSTOP) G EXIT
58 I IBSCT=1!$F(IBSCT,",3,") D IN(IBCNERTN,IBBDT,IBEDT,.IBTOT)
59 I $G(ZTSTOP) G EXIT
60 I IBSCT=1!$F(IBSCT,",4,") D CUR(IBCNERTN,.IBTOT),PYR^IBCNERP0(IBCNERTN,IBBDT,IBEDT,.IBTOT)
61 ;
62EXIT ; EN Exit pt
63 Q
64 ;
65IN(RTN,BDT,EDT,TOT) ; Determine Incoming Data
66 ; Input params: RTN-routine name for ^TMP($J), BDT-start dt/time,
67 ; EDT-end dt/time, **TOT-total records searched - used only for status
68 ; checks when the process is queued (passed by reference)
69 ; Output vars: Set pcs of ^TMP($J,RTN,"IN") as follows:
70 ; 1=total Resps rec'd for date/time range
71 ; 2=Ins Buf extract subtotal
72 ; 3=Pre-Reg extract subtotal
73 ; 4=Non-ver extract subtotal
74 ; 5=No Act Ins subtotal
75 ;
76 ; Init vars
77 N IBDT,PYRIEN,PATIEN,IBPTR,IBTYP,RPTDATA,TRANSIEN
78 ;
79 ; Loop thru the IIV Resp File (#365) x-ref on Date/Time Resp Rec'd
80 S IBDT=$O(^IBCN(365,"AD",BDT),-1)
81 F S IBDT=$O(^IBCN(365,"AD",IBDT)) Q:IBDT=""!(IBDT>EDT) D Q:$G(ZTSTOP)
82 . S PYRIEN=0
83 . F S PYRIEN=$O(^IBCN(365,"AD",IBDT,PYRIEN)) Q:'PYRIEN D Q:$G(ZTSTOP)
84 . . S PATIEN=0
85 . . F S PATIEN=$O(^IBCN(365,"AD",IBDT,PYRIEN,PATIEN)) Q:'PATIEN D Q:$G(ZTSTOP)
86 . . . S IBPTR=0
87 . . . F S IBPTR=$O(^IBCN(365,"AD",IBDT,PYRIEN,PATIEN,IBPTR)) Q:'IBPTR D Q:$G(ZTSTOP)
88 . . . . S TOT=TOT+1
89 . . . . I $D(ZTQUEUED),TOT#100=0,$$S^%ZTLOAD() S ZTSTOP=1 Q
90 . . . . ; Update total
91 . . . . S $P(RPTDATA,U,1)=$P($G(RPTDATA),U,1)+1
92 . . . . ; Update extract type total
93 . . . . ; Get the data for the report - build RPTDATA
94 . . . . S IBTYP=5,TRANSIEN=$P($G(^IBCN(365,IBPTR,0)),U,5)
95 . . . . I TRANSIEN'="" S IBTYP=$P($G(^IBCN(365.1,TRANSIEN,0)),U,10)
96 . . . . S $P(RPTDATA,U,IBTYP+1)=$P($G(RPTDATA),U,IBTYP+1)+1
97 ;
98 I $G(ZTSTOP) G INX
99 ;
100 ; Save data to global
101 S ^TMP($J,RTN,"IN")=$G(RPTDATA)
102 ;
103INX ; IN exit pt
104 Q
105 ;
106OUT(RTN,BDT,EDT,TOT) ; Outgoing Data
107 ;Input params: RTN-routine name used as subscript in ^TMP($J),
108 ; BDT-start date/time, EDT-end date/time, **TOT-total recs searched-used
109 ; only for status checks when process is queued (passed by reference)
110 ;Output vars: Set pcs of ^TMP($J,RTN,"OUT") as follows:
111 ; 1=total Inqs transmitted for timeframe
112 ; 2=Ins Buffer extract subtotal
113 ; 3=Pre-Reg extract subtotal
114 ; 4=Non-Ver extract subtotal
115 ; 5=No Act Ins subtotal
116 ;
117 ; Init vars
118 N IBDT,IBPTR,IBTYP,RPTDATA,TQIEN
119 ;
120 ; Loop thru the IIV Resp File (#365) by x-ref on Date/Time Resp Created
121 ; Only count responses for unique HL7 message IDs - filter out
122 ; unsolicited responses as they artificially inflate the Outgoing Count
123 S IBDT=$O(^IBCN(365,"AE",BDT),-1)
124 F S IBDT=$O(^IBCN(365,"AE",IBDT)) Q:IBDT=""!(IBDT>EDT) D Q:$G(ZTSTOP)
125 . S IBPTR=0
126 . F S IBPTR=$O(^IBCN(365,"AE",IBDT,IBPTR)) Q:'IBPTR D Q:$G(ZTSTOP)
127 . . S TOT=TOT+1
128 . . I $D(ZTQUEUED),TOT#100=0,$$S^%ZTLOAD() S ZTSTOP=1 Q
129 . . ; Quit, if response was not O - original
130 . . I $P($G(^IBCN(365,IBPTR,0)),U,10)'="O" Q
131 . . ; Update total
132 . . S $P(RPTDATA,U,1)=$P($G(RPTDATA),U,1)+1
133 . . ; Update extract type total (1,2,3,4)
134 . . S IBTYP=5
135 . . S TQIEN=$P($G(^IBCN(365,IBPTR,0)),U,5)
136 . . I TQIEN="" Q
137 . . S IBTYP=$P($G(^IBCN(365.1,TQIEN,0)),U,10)
138 . . S $P(RPTDATA,U,IBTYP+1)=$P($G(RPTDATA),U,IBTYP+1)+1
139 ;
140 I $G(ZTSTOP) G OUTX
141 ;
142 ; Save data to global array
143 S ^TMP($J,RTN,"OUT")=$G(RPTDATA)
144 ;
145OUTX ; OUT exit pt
146 Q
147 ;
148CUR(RTN,TOT) ; Current Status - stats - timeframe independent
149 ; Input params: RTN-routine name as subs in ^TMP($J), **TOT-total recs
150 ; searched - used only for status checks when the process is queued
151 ; passed by reference
152 ; Output vars: Set pcs of ^TMP($J,RTN,"CUR") as follows:
153 ; 1=total Pending Resps (Transmitted-2)
154 ; 2=total Queued Inqs (Ready to Transmit-1/Retry-6)
155 ; 3=total Deferred Inqs (Hold-4)
156 ; 4=Ins Cos w/o National ID
157 ; 5=Payers w/IIV disabled locally
158 ; 6=total user action required (symbol'='*' or '#' or '!' or '?' or '-')
159 ; 7=total Man. Ver'd Ins Buf entries (symbol='*')
160 ; 8=total IIV Processed Ver. (symbol='+')
161 ; 9=total awaiting processing (symbol='?' or BLANK)
162 ; 10=total Ins Buf entries w/symbol='#'
163 ; 11=total Ins Buf entries w/symbol='!'
164 ; 12=total Ins Buf entries w/symbol='?'
165 ; 13=total Ins Buf entries w/symbol='-'
166 ; 14=total Ins Buffer entries w/symbol not in ('*','#','!','?','-')
167 ;
168 ; Init vars
169 N RIEN,TQIEN,ICIEN,IBIEN,RPTDATA,IEN,IBSYMBOL,PIECE,IBSTS,APPIEN
170 N PIEN,TMP,APPDATA,XDT
171 ;
172 S RPTDATA=""
173 ;
174 ; Responses pending (Transmitted - 2)
175 S RIEN=0
176 F S RIEN=$O(^IBCN(365,"AC",2,RIEN)) Q:'RIEN D Q:$G(ZTSTOP)
177 . S TOT=TOT+1
178 . I $D(ZTQUEUED),TOT#100=0,$$S^%ZTLOAD() S ZTSTOP=1 Q
179 . S $P(RPTDATA,U,1)=$P(RPTDATA,U,1)+1
180 ;
181 I $G(ZTSTOP) G CURX
182 ;
183 ; Queued inquiries (Ready to Transmit - 1/Retry - 6) and
184 ; Deferred inquiries (Hold - 4)
185 F IBSTS=1,6,4 D Q:$G(ZTSTOP)
186 . S TQIEN=0
187 . F S TQIEN=$O(^IBCN(365.1,"AC",IBSTS,TQIEN)) Q:'TQIEN D Q:$G(ZTSTOP)
188 . . S TOT=TOT+1
189 . . I $D(ZTQUEUED),TOT#100=0,$$S^%ZTLOAD() S ZTSTOP=1 QUIT
190 . . I IBSTS'=4 S $P(RPTDATA,U,2)=$P(RPTDATA,U,2)+1 Q
191 . . S $P(RPTDATA,U,3)=$P(RPTDATA,U,3)+1
192 ;
193 I $G(ZTSTOP) G CURX
194 ;
195 ; Payer stats
196 ; Ins cos w/o National ID
197 S ICIEN=0
198 F S ICIEN=$O(^DIC(36,ICIEN)) Q:'ICIEN D Q:$G(ZTSTOP)
199 . S TOT=TOT+1
200 . I $D(ZTQUEUED),TOT#100=0,$$S^%ZTLOAD() S ZTSTOP=1 QUIT
201 . ; Exclude inactive
202 . S TMP=$$ACTIVE^IBCNEUT4(ICIEN) I 'TMP Q
203 . ; Exclude Medicare/Medicaid, etc.
204 . I $$EXCLUDE^IBCNEUT4($P(TMP,U,2)) Q
205 . ; Determine assoc Payer
206 . S PIEN=$P($G(^DIC(36,ICIEN,3)),U,10)
207 . ; Missing payer link
208 . I 'PIEN S $P(RPTDATA,U,4)=$P(RPTDATA,U,4)+1 Q
209 . ; Does a VA NATIONAL ID exist?
210 . I $P($G(^IBE(365.12,PIEN,0)),U,2)'="" Q
211 . S $P(RPTDATA,U,4)=$P(RPTDATA,U,4)+1
212 ;
213 I $G(ZTSTOP) G CURX
214 ;
215 ; IIV Payers disabled locally
216 S PIEN=0
217 F S PIEN=$O(^IBE(365.12,PIEN)) Q:'PIEN D Q:$G(ZTSTOP)
218 . S TOT=TOT+1
219 . I $D(ZTQUEUED),TOT#100=0,$$S^%ZTLOAD() S ZTSTOP=1 Q
220 . ; Must have National ID
221 . I $P($G(^IBE(365.12,PIEN,0)),U,2)'="" Q
222 . ; Get Payer app multiple IEN
223 . S APPIEN=$$PYRAPP^IBCNEUT5("IIV",PIEN)
224 . ; Must have eIIV application
225 . I 'APPIEN Q
226 . S APPDATA=$G(^IBE(365.12,PIEN,1,APPIEN,0))
227 . ; Must be Nationally Active
228 . I '$P(APPDATA,U,2) Q
229 . ; Must not be Locally Active
230 . I $P(APPDATA,U,3) Q
231 . S $P(RPTDATA,U,5)=$P(RPTDATA,U,5)+1
232 ;
233 I $G(ZTSTOP) G CURX
234 ;
235 ; Buffer stats
236 ; Loop thru the Ins Buffer File (#355.33)
237 S IBIEN=0,XDT=0
238 F S XDT=$O(^IBA(355.33,"AEST","E",XDT)) Q:XDT="" D Q:$G(ZTSTOP)
239 . F S IBIEN=$O(^IBA(355.33,"AEST","E",XDT,IBIEN)) Q:IBIEN="" D Q:$G(ZTSTOP)
240 . . S TOT=TOT+1
241 . . I $D(ZTQUEUED),TOT#100=0,$$S^%ZTLOAD() S ZTSTOP=1 Q
242 . . S IBSYMBOL=$$SYMBOL^IBCNBLL(IBIEN)
243 . . ; Determine piece to update based on symbol
244 . . ; ('*') = Man. Verified, ('#','!','-','?',blank/null) = IIV Processing
245 . . ; ('+') = IIV Processed
246 . . S PIECE=$S(IBSYMBOL="*":7,IBSYMBOL="+":8,IBSYMBOL="#":10,IBSYMBOL="!":11,IBSYMBOL="-":13,IBSYMBOL="?":12,1:14)
247 . . I PIECE=12!(PIECE=14) S $P(RPTDATA,U,9)=$P($G(RPTDATA),U,9)+1
248 . . E S $P(RPTDATA,U,6)=$P($G(RPTDATA),U,6)+1
249 . . S $P(RPTDATA,U,PIECE)=$P($G(RPTDATA),U,PIECE)+1
250 ;
251 I $G(ZTSTOP) G CURX
252 ;
253 ; Save data to global
254 S ^TMP($J,RTN,"CUR")=$G(RPTDATA)
255 ;
256CURX ; CUR exit point
257 Q
258 ;
259 ;
Note: See TracBrowser for help on using the repository browser.