source: WorldVistAEHR/trunk/r/E_CLAIMS_MGMT_ENGINE-BPS/BPSECMP2.m@ 808

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

initial load of WorldVistAEHR
File size: 8.5 KB
Line 
1BPSECMP2 ;BHAM ISC/FCS/DRS - Parse Claim Response ;06/15/2004
2 ;;1.0;E CLAIMS MGMT ENGINE;**1,5**;JUN 2004;Build 45
3 ;;Per VHA Directive 2004-038, this routine should not be modified.
4 ;Reference to STORESP^IBNCPDP supported by DBIA 4299
5 Q
6 ; Parameters:
7 ; CLAIMIEN: IEN from BPS Claims
8 ; RESPIEN: IEN from BPS Response
9 ; EVENT: This is used by PSO to create specific events (BILL).
10 ; USER: User who is creating the event. This is required when EVENT is sent.
11IBSEND(CLAIMIEN,RESPIEN,EVENT,USER) ;
12 N BPSARRY,RXIEN,FILLNUM,IND,TRNDX,RELDATE,X,Y,%DT
13 N CLAIMNFO,RESPNFO,RXINFO,RFINFO,TRANINFO
14 N RESPONSE,RXACT,CLREAS,BILLNUM,DFN,REQCLAIM
15 N DIE,DA,DR
16 ;
17 ; Quit if there is not a Response or Claim IEN
18 I '$G(RESPIEN) Q
19 I '$G(CLAIMIEN) Q
20 ;
21 ; Get Claims and Response Data
22 D GETS^DIQ("9002313.02",CLAIMIEN,"103;400*;401;402;403;426","","CLAIMNFO")
23 D GETS^DIQ("9002313.0301","1,"_RESPIEN,"112;503;509","I","RESPNFO")
24 ;
25 ; Get the Transaction IEN and Data
26 S IND=$S(CLAIMNFO("9002313.02",CLAIMIEN_",","103")="B2":"AER",1:"AE")
27 S TRNDX=$O(^BPST(IND,CLAIMIEN,""))
28 I TRNDX="" Q
29 D GETS^DIQ("9002313.59",TRNDX,"3;13;404;501;1201","I","TRANINFO")
30 ;
31 ; Determine Prescription IEN
32 S RXIEN=$P(^BPSC(CLAIMIEN,400,1,0),"^",5)
33 ;
34 ; If Certify Mode is On, don't send to IB
35 I $$GET1^DIQ(9002313.59902,"1,"_TRNDX_",","902.22")["MODE ON" Q
36 ;
37 ; Testing for Certification Only - DLF
38 I $$RXAPI1^BPSUTIL1(RXIEN,.01)="" Q
39 ;
40 ; Store RXACT into a local variable as it is will be used a lot
41 S RXACT=TRANINFO("9002313.59",TRNDX_",",1201,"I")
42 ;
43 ; Setup User data
44 ; If event is passed in, the user should be passed in as well
45 ; If no Event, but action is Auto-Reversal (AREV) or CMOP (CR*/PC/RL),
46 ; user postmaster (.5)
47 ; Else use the user from BPS Transaction
48 I EVENT]"" S BPSARRY("USER")=USER
49 E I ",AREV,CRLB,CRLX,CRLR,PC,RL,"[(","_RXACT_",") S BPSARRY("USER")=.5
50 E S BPSARRY("USER")=TRANINFO("9002313.59",TRNDX_",",13,"I")
51 ;
52 ; Determine Payer Response
53 ; Treat Duplicate of Accepted Reversal ("S") as accepted
54 S RESPONSE=RESPNFO(9002313.0301,"1,"_RESPIEN_",",112,"I")
55 S RESPONSE=$S(RESPONSE="A":"ACCEPTED",RESPONSE="C":"CAPTURED",RESPONSE="D":"DUPLICATE",RESPONSE="P":"PAYABLE",RESPONSE="R":"REJECTED",RESPONSE="S":"ACCEPTED",1:"OTHER")
56 ;
57 ; Get Prescription Information
58 D RXAPI^BPSUTIL1(RXIEN,".01;4;6;8;16;27","RXINFO","IE")
59 ;
60 ; Get Refill Info if this is a refill
61 S FILLNUM=+$E($P(TRNDX,".",2),1,4)
62 I FILLNUM>0 D RXSUBF^BPSUTIL1(RXIEN,52,52.1,FILLNUM,".01;1.1;11","RFINFO","E")
63 ;
64 ; Fill Date
65 S BPSARRY("FILL DATE")=CLAIMNFO("9002313.0201","1,"_CLAIMIEN_",","401")
66 S %DT="X",X=BPSARRY("FILL DATE") D ^%DT S:Y'=-1 BPSARRY("FILL DATE")=Y
67 ;
68 ; Information needed for PAID/BILLING event
69 S BPSARRY("PAID")=0
70 I RESPONSE="PAYABLE" D
71 . S BPSARRY("PAID")=$$DFF2EXT^BPSECFM(RESPNFO(9002313.0301,"1,"_RESPIEN_",",509,"I"))
72 . S BPSARRY("AUTH #")=RESPNFO(9002313.0301,"1,"_RESPIEN_",",503,"I")
73 . S BPSARRY("RX NO")=RXINFO(52,RXIEN,.01,"E")
74 . S BPSARRY("DRUG")=$$RXAPI1^BPSUTIL1(RXIEN,6,"I")
75 . S BPSARRY("QTY")=$G(TRANINFO(9002313.59,TRNDX_",",501,"I"))
76 . I FILLNUM<1 D
77 .. S BPSARRY("DAYS SUPPLY")=RXINFO(52,RXIEN,8,"E")
78 . E D
79 .. S BPSARRY("DAYS SUPPLY")=$G(RFINFO(52.1,FILLNUM,1.1,"E"))
80 ;
81 ; Get Plan info
82 I $D(^BPST(TRNDX,10,1,0)) S BPSARRY("PLAN")=$P(^BPST(TRNDX,10,1,0),"^")
83 ;
84 ; Setup miscellaneous values
85 S DFN=$$RXAPI1^BPSUTIL1(RXIEN,2,"I")
86 S BPSARRY("NDC")=$$GETNDC^PSONDCUT(RXIEN,FILLNUM)
87 S BPSARRY("FILL NUMBER")=FILLNUM
88 S BPSARRY("FILLED BY")=RXINFO(52,RXIEN,16,"I")
89 S BPSARRY("PRESCRIPTION")=RXIEN
90 S BPSARRY("BILLED")=$P(CLAIMNFO("9002313.0201","1,"_CLAIMIEN_",","426"),"DQ",2)
91 S BPSARRY("BILLED")=$$DFF2EXT^BPSECFM(BPSARRY("BILLED"))
92 S BPSARRY("CLAIMID")=$P(CLAIMNFO("9002313.0201","1,"_CLAIMIEN_",","402"),"D2",2)
93 S RELDATE=$S(FILLNUM=0:$$RXAPI1^BPSUTIL1(RXIEN,31,"I"),1:$$RXSUBF1^BPSUTIL1(RXIEN,52,52.1,FILLNUM,17,"I"))
94 S BPSARRY("RELEASE DATE")=$P(RELDATE,".")
95 S BPSARRY("RESPONSE")=RESPONSE
96 S BPSARRY("EPHARM")=$$GET1^DIQ(9002313.59,TRNDX,1.07,"I")
97 ;
98 ; For reversals, get reversal reason and check for closed reason
99 ; Call IB with Reversal Event
100 ; If there is a close reason, call IB with CLOSE event
101 ; and update BPS Claim with close information
102 I EVENT="",$$ISREVERS^BPSOSU(CLAIMIEN) D Q
103 . S REQCLAIM=TRANINFO("9002313.59",TRNDX_",",3,"I")
104 . S BPSARRY("REVERSAL REASON")=TRANINFO("9002313.59",TRNDX_",",404,"I")
105 . S BPSARRY("RTS-DEL")=0
106 . ; Get RX action, which determine close event
107 . I RXACT="RS" S CLREAS="PRESCRIPTION NOT RELEASED",BPSARRY("RTS-DEL")=1
108 . I RXACT="DE" D
109 . . S CLREAS="PRESCRIPTION DELETED",BPSARRY("RTS-DEL")=1
110 . . ; check whether RX was in fact deleted in Pharmacy
111 . . ; if not then the refill was deleted
112 . . I $$RXSTATUS^BPSSCRU2(RXIEN)'=13 S BPSARRY("CLOSE COMMENT")="DELETION OF REFILL ONLY - ORIGINAL RX MAY REMAIN ACTIVE"
113 . ; If accepted inpatient autoreversal, then close the claim
114 . I RXACT="AREV",RESPONSE="ACCEPTED",REQCLAIM,$P($G(^BPSC(REQCLAIM,0)),U,7)=2 D
115 .. S CLREAS="OTHER",BPSARRY("CLOSE COMMENT")="INPATIENT PRESCRIPTION"
116 . I $D(CLREAS) S BPSARRY("CLOSE REASON")=$O(^IBE(356.8,"B",CLREAS,0))
117 . ;
118 . ; Call IB for Reversal Event
119 . S BPSARRY("STATUS")="REVERSED",BILLNUM=$$STORESP^IBNCPDP(DFN,.BPSARRY)
120 . ; If there is no close reason, quit
121 . I '$D(BPSARRY("CLOSE REASON")) Q
122 . ; Call IB for CLOSE event
123 . ; Note for close, user is always postmaster (.5)
124 . S BPSARRY("STATUS")="CLOSED",BPSARRY("USER")=.5
125 . S BILLNUM=$$STORESP^IBNCPDP(DFN,.BPSARRY)
126 . ;
127 . ; Populate the original claim request with the close reason
128 . I REQCLAIM D
129 .. S DIE="^BPSC(",DA=REQCLAIM
130 .. S DR="901///1;902///"_$$NOW^XLFDT()_";903///.5;904///"_BPSARRY("CLOSE REASON")
131 .. D ^DIE
132 ;
133 ; If we got here, then it is not a reversal
134 ; If EVENT is set, send Submit event
135 I EVENT="" S BPSARRY("STATUS")="SUBMITTED",BILLNUM=$$STORESP^IBNCPDP(DFN,.BPSARRY)
136 ;
137 ; Sent Paid (Billable) event is the claim was paid and released or EVENT is BILL
138 ; Note: User is always postmaster except for BackBilling (BB)
139 I EVENT="BILL"!(RESPONSE="PAYABLE"&(BPSARRY("RELEASE DATE")]"")) D
140 . I RXACT'="BB" S BPSARRY("USER")=.5
141 . S BPSARRY("STATUS")="PAID",BILLNUM=$$STORESP^IBNCPDP(DFN,.BPSARRY)
142 Q
143 ;
144 ; Synch DURs between ECME and PSO
145 ; Parameters:
146 ; IEN59 is the BPS Transaction IEN
147DURSYNC(IEN59) ;
148 N RXIEN,RXFILL
149 ;
150 ; Check Parameter
151 I IEN59="" Q
152 ;
153 ; Get Prescription and Fill number
154 S RXIEN=$$GET1^DIQ(9002313.59,IEN59_",",1.11,"I")
155 S RXFILL=$$GET1^DIQ(9002313.59902,"1,"_IEN59_",",902.17,"E")
156 I RXIEN=""!(RXFILL="") Q
157 ;
158 ; Call PSO to sync reject codes
159 D SYNC^PSOREJUT(RXIEN,RXFILL,"")
160 Q
161 ;
162PROCOTH ;
163 Q:$G(FDATA(TRANSACT,563.01,1))=""
164 N NNDX,FILE,ROOT,FDATA3,FLDNUM
165 S FILE="9002313.1401"
166 S ROOT="FDATA3(9002313.1401)"
167 S NNDX=""
168 F S NNDX=$O(FDATA(FDAIEN(TRANSACT),563.01,NNDX)) Q:NNDX="" D
169 .S FLDNUM=".01" D FDA^DILF(FILE,"+"_NNDX_","_FDAIEN03(TRANSACT)_","_FDAIEN(TRANSACT),FLDNUM,"",FDATA(TRANSACT,563.01,NNDX),ROOT)
170 D UPDATE^DIE("S","FDATA3(9002313.1401)")
171 Q
172PROCDUR ;
173 Q:$G(FDATA(TRANSACT,567,1))=""
174 N NNDX,FILE,ROOT,FDAT1101,FLDNUM
175 S FILE="9002313.1101"
176 S ROOT="FDAT1101(9002313.1101)"
177 S NNDX=""
178 F S NNDX=$O(FDATA(TRANSACT,567,NNDX)) Q:NNDX="" D
179 .S FLDNUM=".01" D FDA^DILF(FILE,"+"_NNDX_","_FDAIEN03(TRANSACT)_","_FDAIEN(TRANSACT),FLDNUM,"",FDATA(TRANSACT,567,NNDX),ROOT)
180 .I $D(FDATA(TRANSACT,439,NNDX)) D
181 ..S FLDNUM="439"
182 ..D FDA^DILF(FILE,"+"_NNDX_","_FDAIEN03(TRANSACT)_","_FDAIEN(TRANSACT),FLDNUM,"",FDATA(TRANSACT,439,NNDX),ROOT)
183 .I $D(FDATA(TRANSACT,528,NNDX)) D
184 ..S FLDNUM="528"
185 ..D FDA^DILF(FILE,"+"_NNDX_","_FDAIEN03(TRANSACT)_","_FDAIEN(TRANSACT),FLDNUM,"",FDATA(TRANSACT,528,NNDX),ROOT)
186 .I $D(FDATA(TRANSACT,529,NNDX)) D
187 ..S FLDNUM="529"
188 ..D FDA^DILF(FILE,"+"_NNDX_","_FDAIEN03(TRANSACT)_","_FDAIEN(TRANSACT),FLDNUM,"",FDATA(TRANSACT,529,NNDX),ROOT)
189 .I $D(FDATA(TRANSACT,530,NNDX)) D
190 ..S FLDNUM="530"
191 ..D FDA^DILF(FILE,"+"_NNDX_","_FDAIEN03(TRANSACT)_","_FDAIEN(TRANSACT),FLDNUM,"",FDATA(TRANSACT,530,NNDX),ROOT)
192 .I $D(FDATA(TRANSACT,531,NNDX)) D
193 ..S FLDNUM="531"
194 ..D FDA^DILF(FILE,"+"_NNDX_","_FDAIEN03(TRANSACT)_","_FDAIEN(TRANSACT),FLDNUM,"",FDATA(TRANSACT,531,NNDX),ROOT)
195 .I $D(FDATA(TRANSACT,532,NNDX)) D
196 ..S FLDNUM="532"
197 ..D FDA^DILF(FILE,"+"_NNDX_","_FDAIEN03(TRANSACT)_","_FDAIEN(TRANSACT),FLDNUM,"",FDATA(TRANSACT,532,NNDX),ROOT)
198 .I $D(FDATA(TRANSACT,533,NNDX)) D
199 ..S FLDNUM="533"
200 ..D FDA^DILF(FILE,"+"_NNDX_","_FDAIEN03(TRANSACT)_","_FDAIEN(TRANSACT),FLDNUM,"",FDATA(TRANSACT,533,NNDX),ROOT)
201 .I $D(FDATA(TRANSACT,544,NNDX)) D
202 ..S FLDNUM="544"
203 ..D FDA^DILF(FILE,"+"_NNDX_","_FDAIEN03(TRANSACT)_","_FDAIEN(TRANSACT),FLDNUM,"",FDATA(TRANSACT,544,NNDX),ROOT)
204 D UPDATE^DIE("S","FDAT1101(9002313.1101)")
205 Q
Note: See TracBrowser for help on using the repository browser.