source: WorldVistAEHR/trunk/r/E_CLAIMS_MGMT_ENGINE-BPS/BPSBUTL.m@ 1005

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

initial load of WorldVistAEHR

File size: 8.2 KB
Line 
1BPSBUTL ;BHAM ISC/MFR/VA/DLF - IB Communication Utilities ;06/01/2004
2 ;;1.0;E CLAIMS MGMT ENGINE;**1,3,2,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 ;
7CLOSE(CLAIM,TRNDX,REASON,PAPER,RELCOP,COMMENT,ERROR) ; Send IB an update on the CLAIM status for a Closed Claim
8 N DFN,BPSARRY,BILLNUM,CLAIMNFO,FILLNUM,RXIEN,TRANINFO
9 ;
10 ; - Data gathering
11 D GETS^DIQ("9002313.59",TRNDX,"1.11;9","I","TRANINFO")
12 S RXIEN=TRANINFO(9002313.59,TRNDX_",",1.11,"I")
13 I $$RXAPI1^BPSUTIL1(RXIEN,.01)="" S ERROR="Prescription not found." Q
14 S BPSARRY("FILL NUMBER")=TRANINFO(9002313.59,TRNDX_",",9,"I")
15 D GETS^DIQ("9002313.02",CLAIM,"400*;401;402;403;426","","CLAIMNFO")
16 S BPSARRY("FILL DATE")=$$EXT2FM^BPSOSU1(CLAIMNFO("9002313.0201","1,"_CLAIM_",","401"))
17 S FILLNUM=+BPSARRY("FILL NUMBER")
18 S DFN=$$RXAPI1^BPSUTIL1(RXIEN,2,"I")
19 S BPSARRY("FILLED BY")=$$RXAPI1^BPSUTIL1(RXIEN,16,"I")
20 S BPSARRY("PRESCRIPTION")=RXIEN
21 S BPSARRY("BILLED")=$$DFF2EXT^BPSECFM($P(CLAIMNFO("9002313.0201","1,"_CLAIM_",","426"),"DQ",2))
22 S BPSARRY("CLAIMID")=$P(CLAIMNFO("9002313.0201","1,"_CLAIM_",","402"),"D2",2)
23 S BPSARRY("PLAN")=$P(^BPST(TRNDX,10,1,0),"^")
24 S BPSARRY("STATUS")="CLOSED"
25 S BPSARRY("PAID")=0
26 S BPSARRY("RELEASE DATE")=$S(FILLNUM=0:$$RXAPI1^BPSUTIL1(RXIEN,31,"I"),1:$$RXSUBF1^BPSUTIL1(RXIEN,52,52.1,FILLNUM,17,"I"))
27 S BPSARRY("USER")=DUZ
28 S BPSARRY("EPHARM")=$$GET1^DIQ(9002313.59,TRNDX,1.07,"I")
29 I REASON'="" D
30 . S BPSARRY("CLOSE REASON")=$O(^IBE(356.8,"B",REASON,0))
31 . S BPSARRY("DROP TO PAPER")=+$G(PAPER)
32 . S BPSARRY("RELEASE COPAY")=+$G(RELCOP)
33 I $G(COMMENT)]"" S BPSARRY("CLOSE COMMENT")=COMMENT
34 ;
35 ; If dropped to Paper, increment the counter in BPS Statistics
36 I BPSARRY("DROP TO PAPER")=1 D INCSTAT^BPSOSUD("R",8)
37 ;
38 ; Call IB
39 S BILLNUM=$$STORESP^IBNCPDP(DFN,.BPSARRY)
40 Q
41 ; Send IB an update on the CLAIM status for a restocked or deleted prescription
42CLOSE2(RXIEN,BFILL,BWHERE) ;
43 N IEN59,BPSARRY,DFN,BILLNUM,FILL,REASON
44 N CLAIMNFO
45 N DIE,DA,DR
46 ;
47 ; Check parameters
48 I '$G(RXIEN) S ERROR="No prescription parameter" Q
49 ;
50 I $$RXAPI1^BPSUTIL1(RXIEN,.01)="" S ERROR="Prescription not found." Q
51 I ",DDED,DE,RS,"'[(","_BWHERE_",") S ERROR="Invalid BWHERE parameter" Q
52 ;
53 ; Calculate the transaction IEN and see that it exists
54 S FILL=".0000"_+BFILL
55 S IEN59=RXIEN_"."_$E(FILL,$L(FILL)-3,$L(FILL))_"1"
56 I '$D(^BPST(IEN59,0)) Q
57 ;
58 ; Get claim data
59 S CLAIM=$P(^BPST(IEN59,0),"^",4)
60 D GETS^DIQ("9002313.02",CLAIM,"400*;401;402;426","","CLAIMNFO")
61 S BPSARRY("FILL NUMBER")=+BFILL
62 S BPSARRY("FILL DATE")=$$EXT2FM^BPSOSU1(CLAIMNFO("9002313.0201","1,"_CLAIM_",","401"))
63 ;
64 ; Get prescription data
65 S FILLNUM=BPSARRY("FILL NUMBER")
66 S DFN=$$RXAPI1^BPSUTIL1(RXIEN,2,"I")
67 S BPSARRY("FILLED BY")=$$RXAPI1^BPSUTIL1(RXIEN,16,"I")
68 S BPSARRY("PRESCRIPTION")=RXIEN
69 S BPSARRY("BILLED")=$$DFF2EXT^BPSECFM($P(CLAIMNFO("9002313.0201","1,"_CLAIM_",","426"),"DQ",2))
70 S BPSARRY("CLAIMID")=$P(CLAIMNFO("9002313.0201","1,"_CLAIM_",","402"),"D2",2)
71 S BPSARRY("PLAN")=$P(^BPST(IEN59,10,1,0),"^")
72 S BPSARRY("STATUS")="CLOSED"
73 S BPSARRY("PAID")=0
74 S BPSARRY("RELEASE DATE")=$S(FILLNUM=0:$$RXAPI1^BPSUTIL1(RXIEN,31,"I"),1:$$RXSUBF1^BPSUTIL1(RXIEN,52,52.1,FILLNUM,17,"I"))
75 S BPSARRY("USER")=.5
76 S BPSARRY("EPHARM")=$$GET1^DIQ(9002313.59,IEN59,1.07,"I")
77 ;
78 ; Determine the reversal reason based on the BWHERE value
79 I BWHERE="RS" S REASON="PRESCRIPTION NOT RELEASED"
80 I BWHERE="DE"!(BWHERE="DDED") S REASON="PRESCRIPTION DELETED"
81 I REASON]"" S BPSARRY("CLOSE REASON")=$O(^IBE(356.8,"B",REASON,0))
82 ;
83 ;if a refill was deleted while RX is still active (not deleted) then send DELETION OF REFILL comment for CT record
84 I BWHERE="DE",$$RXSTATUS^BPSSCRU2(RXIEN)'=13 S BPSARRY("CLOSE COMMENT")="DELETION OF REFILL ONLY - ORIGINAL RX MAY REMAIN ACTIVE"
85 ;
86 ;
87 ; Update IB
88 S BILLNUM=$$STORESP^IBNCPDP(DFN,.BPSARRY)
89 ;
90 ; Update the claim file that the claim is closed and the reason why.
91 S DIE="^BPSC(",DA=CLAIM
92 S DR="901///1;902///"_$$NOW^XLFDT()_";903///.5;904///"_BPSARRY("CLOSE REASON")
93 D ^DIE
94 Q
95 ;
96 ; Function to return Transaction, claim, and response IENs
97 ; Parameters:
98 ; RXI: Prescription IEN
99 ; RXR: Fill Number
100 ; Returns:
101 ; IEN59^Claim IEN^Response IEN^Reversal Claim IEN^Reversal Response IEN
102CLAIM(RXI,RXR) ;
103 N IEN59,CLAIMIEN,RESPIEN,REVCLAIM,REVRESP
104 I '$G(RXI) Q
105 S IEN59=$$IEN59^BPSOSRX(RXI,RXR)
106 I '$D(^BPST(IEN59,0)) Q ""
107 S CLAIMIEN=$P(^BPST(IEN59,0),"^",4),RESPIEN=$P(^BPST(IEN59,0),"^",5)
108 S REVCLAIM=$P($G(^BPST(IEN59,4)),"^",1),REVRESP=$P($G(^BPST(IEN59,4)),"^",2)
109 Q IEN59_U_CLAIMIEN_U_RESPIEN_U_REVCLAIM_U_REVRESP
110 ;
111 ; NABP - Return the value in the Service Provider ID (201-B1) field
112 ; of the claim. Note that as of the NPI release (BPS*1*2), this
113 ; API may return NPI instead of NABP/NCPDP
114NABP(RXP,BFILL) ;
115 I '$G(RXP) Q ""
116 I $G(BFILL)="" S BFILL=0
117 N BPSTIEN,BPSCIEN,DFILL,NABP
118 S DFILL=$E($TR($J("",4-$L(BFILL))," ","0")_BFILL,1,4)
119 S BPSTIEN=RXP_"."_DFILL_"1"
120 I 'BPSTIEN Q ""
121 S BPSCIEN=$P($G(^BPST(BPSTIEN,0)),U,4)
122 I 'BPSCIEN Q ""
123 S NABP=$P($G(^BPSC(BPSCIEN,200)),U)
124 Q NABP
125 ;
126 ; DIVNCPDP - For a specific outpatient site, return the NPI & NCPDP.
127 ; Note that the procedure name is misleading but when originally
128 ; coded, this procedure only returned NCPDP.
129 ;
130 ; Input
131 ; BPSDIV - Outpatient Site (#59)
132 ; Output
133 ; "" - No BPSDIV passed in
134 ; NCPDP and NPI separated by a caret
135DIVNCPDP(BPSDIV) ;
136 N BPSPHARM,NPI,NCPDP
137 I '$G(BPSDIV) Q "^"
138 ;
139 ; Get the NCPDP
140 S NCPDP=""
141 S BPSPHARM=$$GETPHARM^BPSUTIL(BPSDIV)
142 I BPSPHARM S NCPDP=$$GET1^DIQ(9002313.56,BPSPHARM_",",.02)
143 ;
144 ; Get the NPI and validate it
145 S NPI=+$$NPI^BPSNPI("Pharmacy_ID",BPSDIV)
146 I NPI=-1 S NPI=""
147 ;
148 Q NCPDP_"^"_NPI
149 ;
150 ;ADDCOMM - Add a comment to a ECME claim
151 ;Input:
152 ; BPRX - ien in file #52
153 ; BPREF - refill number (0,1,2,...)
154 ; BPRCMNT - comment text
155 ;Output:
156 ; 1 - okay
157 ; -1 - failed
158ADDCOMM(BPRX,BPREF,BPRCMNT) ;
159 N BP59,BPNOW,BPLCK,BPREC,BPDA,BPERR
160 N %,%H,%I,X
161 I $L(BPRX)<1 Q -1
162 I $G(BPRCMNT)="" Q -1
163 S BP59=BPRX_$S($L(+BPREF)=1:".000",1:".00")_+BPREF_"1" ;borrowed from CLOSE2 above
164 D NOW^%DTC
165 S BPNOW=%
166 L +^BPST(9002313.59111,+BP59):10
167 S BPLCK=$T
168 I 'BPLCK Q -1 ;quit
169 D INSITEM^BPSCMT01(9002313.59111,+BP59,BPNOW)
170 S BPREC=$O(^BPST(BP59,11,"B",BPNOW,0))
171 I BPREC>0 D
172 . S BPDA(9002313.59111,BPREC_","_BP59_",",.02)=+$G(DUZ)
173 . S BPDA(9002313.59111,BPREC_","_BP59_",",.03)=$E($G(BPRCMNT),1,63)
174 . D FILE^DIE("","BPDA","BPERR")
175 I BPLCK L -^BPST(9002313.59111,+BP59)
176 I BPREC>0,'$D(BPERR) Q 1
177 Q -1
178 ;
179 ;REOPEN - Reopen closed claim
180 ;Input:
181 ; BP59 - ien in BPS TRANSACTION file
182 ; BP02 - ien in BPS CLAIMS file
183 ; BPREOPDT - reopen date/time
184 ; BPDUZ - user DUZ (#200 ien)
185 ; BPCOMM - reopen comment text
186 ;Output:
187 ; 0^message_error - error
188 ; 1 - success
189REOPEN(BP59,BP02,BPREOPDT,BPDUZ,BPCOMM) ;
190 N RECIENS,BPDA,ERRARR,BPREFNO,BPRXIEN,BPFILLDT,BPCLMID,BPZ,BPSARRY,BPDFN,BPRETVAL,BPZ1
191 S BPDFN=$P($G(^BPST(BP59,0)),U,6)
192 S BPREFNO=$P($G(^BPST(BP59,1)),U)
193 I BPREFNO="" Q "0^Null Fill Number"
194 S BPRXIEN=$P($G(^BPST(BP59,1)),U,11)
195 I BPRXIEN="" Q "0^Null RX ien Number"
196 ;in VA there is only one med/claim but in some cases it can different than "1"
197 ;so take the latest one
198 S BPZ=$O(^BPSC(BP02,400,9999999),-1)
199 I BPRXIEN="" Q "0^Database Error"
200 S BPFILLDT=$$YMD2FM^BPSSCRU6(+$P($G(^BPSC(BP02,400,+BPZ,400)),U))
201 S BPCLMID=$$CONVCLID^BPSSCRU6($P($G(^BPSC(BP02,400,+BPZ,400)),U,2))
202 ;============
203 ;Now update ECME database
204 S BPRETVAL=$$UPDREOP^BPSREOP1(BP02,0,BPREOPDT,BPDUZ,BPCOMM)
205 I +BPRETVAL=0 D Q BPRETVAL
206 . ;try to reverse it in case it was done partially
207 . I $$UPDREOP^BPSREOP1(BP02,1,"@",+BPDUZ,"@")
208 ;============
209 ;Now call IB API for "REOPEN" event
210 S BPSARRY("STATUS")="REOPEN"
211 S BPSARRY("FILL DATE")=BPFILLDT
212 S BPSARRY("FILL NUMBER")=BPREFNO
213 S BPSARRY("PRESCRIPTION")=BPRXIEN
214 S BPSARRY("CLAIMID")=BPCLMID
215 S BPSARRY("DRUG")=$$DRUGIEN^BPSSCRU6(BPRXIEN,BPDFN)
216 S BPSARRY("PLAN")=$P($G(^BPST(BP59,10,1,0)),"^")
217 S BPSARRY("USER")=BPDUZ
218 S BPSARRY("REOPEN COMMENT")=BPCOMM
219 S BPSARRY("EPHARM")=$$GET1^DIQ(9002313.59,BP59,1.07,"I")
220 S BPRETVAL=$$STORESP^IBNCPDP(BPDFN,.BPSARRY)
221 ;if successful
222 I +BPRETVAL>0 Q "1^ReOpening Claim: "_$P($G(^BPSC(BP02,0)),U)_" ... OK"
223 ;===========
224 ;if it was unsuccessful
225 ;reverse ECME database (keep the user who made the attempt)
226 I $$UPDREOP^BPSREOP1(BP02,1,"@",+BPDUZ,"@")
227 ;return IB error message
228 Q BPRETVAL
Note: See TracBrowser for help on using the repository browser.