source: FOIAVistA/trunk/r/INTEGRATED_BILLING-IB-PRQ--IBD--IBQ--PRQS/IBCNERP5.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.6 KB
Line 
1IBCNERP5 ;DAOU/BHS - IBCNE IIV PAYER REPORT COMPILE ;03-JUN-2002
2 ;;2.0;INTEGRATED BILLING;**184,271,300**;21-MAR-94
3 ;;Per VHA Directive 10-93-142, this routine should not be modified.
4 ;
5 ; IIV - Insurance Identification and Verification Interface
6 ;
7 ; Input variables from IBCNERP4:
8 ; IBCNERTN = "IBCNERP4"
9 ; IBCNESPC("BEGDT") = Start Date for date range
10 ; IBCNESPC("ENDDT") = End Date for date range
11 ; IBCNESPC("PYR") = Payer IEN for report, if = "", then include all
12 ; IBCNESPC("SORT") = 1 - Payer OR 2 - Total Inquiries
13 ; IBCNESPC("DTL") = 1 - YES OR 0 - NO - include Rejection Detail?
14 ; Output variables passed to IBCNERP6:
15 ; ^TMP($J,IBCNERTN,SORT1,SORT2,SORT3)=InqCreatedCount^InqCancelledCt^
16 ; InqQueuedCt^1stTransCount^
17 ; RetryTransCt^Non-ErrorRespCt^
18 ; ErrorRespCount^TotRespTime-days^
19 ; CommFailRespCount^PendRespCount^
20 ; eIIVDeactivatedDt
21 ; IBCNERTN = "IBCNERP4"
22 ; SORT1 = PayerName (SORT=1) or -InquiryCount(SORT=2)
23 ; SORT2 = PayerIEN (SORT=1) or PayerName (SORT=2)
24 ; SORT3 = "*" (SORT=1) or PayerIEN (SORT=2)
25 ; ^TMP($J,IBCNERTN,SORT1,SORT2,SORT3,ERRCD)=RespCount
26 ; (see above)
27 ; ERRCD = Error Condition code (ptr to 365.018) or Error Text
28 ; from the Eligibility Communicator (4.01)
29 ;
30 ; Must call at EN tag
31 Q
32 ;
33EN(IBCNERTN,IBCNESPC) ; Entry point
34 ;
35 ; Initialize variables
36 NEW IBCNEDT,IBCNEDT1,IBCNEDT2,IBCNEPY,IBCNEPYR,IBCNEPTR
37 NEW IBCNETOT,IBCNESRT,IBCNEDTL,RPTDATA,PYRIEN,INQS,IEN
38 NEW IBPNM,IBPIEN,ERR,PC,PYR
39 ;
40 I '$D(ZTQUEUED),$G(IOST)["C-" W !!,"Compiling report data ..."
41 ;
42 ; Total responses selected
43 S IBCNETOT=0
44 ;
45 ; Kill scratch globals
46 KILL ^TMP($J,IBCNERTN),^TMP($J,IBCNERTN_"X")
47 ;
48 ; Initialize looping variables
49 S IBCNEDT2=$G(IBCNESPC("ENDDT"))
50 S IBCNEDT1=$G(IBCNESPC("BEGDT"))
51 S IBCNEPY=$G(IBCNESPC("PYR"))
52 S IBCNESRT=$G(IBCNESPC("SORT"))
53 S IBCNEDTL=$G(IBCNESPC("DTL"))
54 ;
55 ; Loop through the IIV Transmission Queue File (#365.1)
56 ; by Date/Time Created Cross-Reference
57 S IBCNEDT=$O(^IBCN(365.1,"AE",IBCNEDT1),-1)
58 F S IBCNEDT=$O(^IBCN(365.1,"AE",IBCNEDT)) Q:IBCNEDT=""!($P(IBCNEDT,".",1)>IBCNEDT2) D Q:$G(ZTSTOP)
59 . S IBCNEPTR=0
60 . F S IBCNEPTR=$O(^IBCN(365.1,"AE",IBCNEDT,IBCNEPTR)) Q:'IBCNEPTR D Q:$G(ZTSTOP)
61 . . ; Update selected count
62 . . S IBCNETOT=IBCNETOT+1
63 . . I $D(ZTQUEUED),IBCNETOT#100=0,$$S^%ZTLOAD() S ZTSTOP=1 QUIT
64 . . ; Determine Payer name from Payer File (#365.12)
65 . . S PYRIEN=$P($G(^IBCN(365.1,IBCNEPTR,0)),U,3)
66 . . I 'PYRIEN Q
67 . . ; Check payer filter
68 . . I IBCNEPY'="",PYRIEN'=IBCNEPY Q
69 . . S IBCNEPYR=$P($G(^IBE(365.12,PYRIEN,0)),U)
70 . . I IBCNEPYR="" Q
71 . . ; Now get the data for the report - build RPTDATA
72 . . KILL RPTDATA
73 . . D GETDATA(IBCNEPTR,.RPTDATA,IBCNEDTL,IBCNEPYR,PYRIEN,IBCNEPY)
74 . . ; Loop through results by Payer Name, Payer IEN
75 . . S IBPNM=""
76 . . F S IBPNM=$O(RPTDATA(IBPNM)) Q:IBPNM="" D
77 . . . S IBPIEN=0
78 . . . F S IBPIEN=$O(RPTDATA(IBPNM,IBPIEN)) Q:'IBPIEN D
79 . . . . ; Store totals in global
80 . . . . F PC=1:1:10 S $P(^TMP($J,IBCNERTN,IBPNM,IBPIEN,"*"),U,PC)=$P($G(^TMP($J,IBCNERTN,IBPNM,IBPIEN,"*")),U,PC)+$P(RPTDATA(IBPNM,IBPIEN),U,PC)
81 . . . . ; Store deactivation date/time
82 . . . . S $P(^TMP($J,IBCNERTN,IBPNM,IBPIEN,"*"),U,11)=$P(RPTDATA(IBPNM,IBPIEN),U,11)
83 . . . . I 'IBCNEDTL Q
84 . . . . ; Store rejection detail
85 . . . . S ERR=""
86 . . . . F S ERR=$O(RPTDATA(IBPNM,IBPIEN,ERR)) Q:ERR="" D
87 . . . . . S ^TMP($J,IBCNERTN,IBPNM,IBPIEN,"*",ERR)=$G(^TMP($J,IBCNERTN,IBPNM,IBPIEN,"*",ERR))+$G(RPTDATA(IBPNM,IBPIEN,ERR))
88 . . Q
89 . Q
90 ;
91 ; Call tag to find good/bad/rejection detail data from response file
92 D DATA^IBCNERP4
93 ;
94 I $G(ZTSTOP)!(IBCNESRT=1) G EXIT
95 ;
96 ; Resort if sorted by Total Inquiries
97 ; M ^TMP($J,IBCNERTN_"X")=^TMP($J,IBCNERTN)
98 N %X,%Y,SUB2
99 S SUB2=IBCNERTN_"X"
100 S %X="^TMP($J,IBCNERTN,"
101 S %Y="^TMP($J,SUB2,"
102 I $D(^TMP($J,IBCNERTN))#10=1 S ^TMP($J,SUB2)=^TMP($J,IBCNERTN)
103 D %XY^%RCR K %X,%Y,SUB2
104 KILL ^TMP($J,IBCNERTN)
105 S PYR=""
106 F S PYR=$O(^TMP($J,IBCNERTN_"X",PYR)) Q:PYR="" D
107 . S IEN=0
108 . F S IEN=$O(^TMP($J,IBCNERTN_"X",PYR,IEN)) Q:'IEN D
109 . . S INQS=-$G(^TMP($J,IBCNERTN_"X",PYR,IEN,"*"))
110 . . ;M ^TMP($J,IBCNERTN,INQS,PYR,IEN)=^TMP($J,IBCNERTN_"X",PYR,IEN,"*")
111 . . N %X,%Y,SUB2
112 . . S SUB2=IBCNERTN_"X"
113 . . S %X="^TMP($J,SUB2,PYR,IEN,""*"","
114 . . S %Y="^TMP($J,IBCNERTN,INQS,PYR,IEN,"
115 . . I $D(^TMP($J,SUB2,PYR,IEN,"*"))#10=1 S ^TMP($J,IBCNERTN,INQS,PYR,IEN)=^TMP($J,SUB2,PYR,IEN,"*")
116 . . D %XY^%RCR K %X,%Y,SUB2
117 . . QUIT
118 . QUIT
119 ; KILL temporary report global - used to resort
120 KILL ^TMP($J,IBCNERTN_"X")
121 ;
122EXIT ; EN Exit point
123 Q
124 ;
125 ;
126GETDATA(IEN,RPTDATA,DTL,PYNM,PYIEN,PYR) ; Retrieve data for this inquiry and response(s)
127 ; Output:
128 ; RPTDATA(PayerName,PayerIEN) = Created(1)^Cancelled(0/1)^Queued(0/1)^
129 ; #1stTrans^#Retries^#Non-ErrorResponses^#ErrorResponses^
130 ; #ofDaysforResponses^#Timeouts^#Pending^DeactivationDTM
131 ; RPTDATA(PayerName,PayerIEN,ErrCond OR ErrText) = #ErrorResps subtotal
132 ; Initialize variables
133 NEW HLIEN,HLID,RIEN,RDATA0,RPYIEN,RPYNM,RDATA1,ERRTXT,X1,X2,FIRST,APIEN
134 ;
135 S RPTDATA(PYNM,PYIEN)=1
136 ; Determine Deactivation DTM for eIIV application
137 S APIEN=$$PYRAPP^IBCNEUT5("IIV",PYIEN)
138 I APIEN,$P($G(^IBE(365.12,PYIEN,1,APIEN,0)),U,11) S $P(RPTDATA(PYNM,PYIEN),U,11)=$P($G(^IBE(365.12,PYIEN,1,APIEN,0)),U,12)
139 ; Logic by Transmission Status
140 ; Cancelled (7) - Payer deactivated
141 I $P($G(^IBCN(365.1,IEN,0)),U,4)=7 S $P(RPTDATA(PYNM,PYIEN),U,2)=1 Q
142 ; Queued - no HL7 messages (# Transmissions = 0) - no multiples exist
143 I '$P($G(^IBCN(365.1,IEN,2,0)),U,3) S $P(RPTDATA(PYNM,PYIEN),U,3)=1 Q
144 ; Sent processing - HL7 messages associated (# Transmissions > 0)
145 S HLIEN=0,FIRST=1
146 F S HLIEN=$O(^IBCN(365.1,IEN,2,HLIEN)) Q:'HLIEN D
147 . I 'FIRST S $P(RPTDATA(PYNM,PYIEN),U,5)=$P(RPTDATA(PYNM,PYIEN),U,5)+1
148 . I FIRST S $P(RPTDATA(PYNM,PYIEN),U,4)=$P(RPTDATA(PYNM,PYIEN),U,4)+1,FIRST=0
149 . ; Process response based on HL7 Message ID
150 . S HLID=$P($G(^IBCN(365.1,IEN,2,HLIEN,0)),U,2) I HLID="" Q
151 . ; Lookup responses by HL7 Message ID
152 . S RIEN=0
153 . F S RIEN=$O(^IBCN(365,"B",HLID,RIEN)) Q:'RIEN D
154 . . S RDATA0=$G(^IBCN(365,RIEN,0))
155 . . S RPYIEN=$P(RDATA0,U,3) I RPYIEN="" Q
156 . . S RPYNM=$P($G(^IBE(365.12,RPYIEN,0)),U,1) I RPYNM="" Q
157 . . ; Apply payer filter here, too!
158 . . ; If there is a Payer filter, check against the IEN
159 . . I PYR'="",RPYIEN'=PYR Q
160 . . ; Determine Deactivation DTM for eIIV application
161 . . S APIEN=$$PYRAPP^IBCNEUT5("IIV",RPYIEN)
162 . . I APIEN,$P($G(^IBE(365.12,RPYIEN,1,APIEN,0)),U,11) S $P(RPTDATA(RPYNM,RPYIEN),U,11)=$P($G(^IBE(365.12,RPYIEN,1,APIEN,0)),U,12)
163 . . S RDATA1=$G(^IBCN(365,RIEN,1))
164 . . S ERRTXT=$G(^IBCN(365,RIEN,4))
165 . . ; Transmitted (Pending)
166 . . I $P(RDATA0,U,6)=2 D Q
167 . . . ; Increment for response pending
168 . . . S $P(RPTDATA(RPYNM,RPYIEN),U,10)=$P($G(RPTDATA(RPYNM,RPYIEN)),U,10)+1
169 . . ; Timeout (Communication Failure)
170 . . I $P(RDATA0,U,6)=5 D Q
171 . . . ; Increment for response timeout
172 . . . S $P(RPTDATA(RPYNM,RPYIEN),U,9)=$P($G(RPTDATA(RPYNM,RPYIEN)),U,9)+1
173 . . ; Response Received - gather additional information
174 . . I $P(RDATA0,U,6)=3 D Q
175 . . . ; Determine response time (in days) as difference between
176 . . . ; IIV Response File - Date/Time Response Received and
177 . . . ; Date/Time Response Created (based on HL7)
178 . . . S X1=$P(RDATA0,U,8)
179 . . . S X2=$P(RDATA0,U,7)
180 . . . ; Determine date difference in days
181 . . . S $P(RPTDATA(RPYNM,RPYIEN),U,8)=$P($G(RPTDATA(RPYNM,RPYIEN)),U,8)+$$FMDIFF^XLFDT(X2,X1,1)
182 ;
183GETDATX ; GETDATA exit point
184 Q
185 ;
186 ;
Note: See TracBrowser for help on using the repository browser.