source: WorldVistAEHR/trunk/r/E_CLAIMS_MGMT_ENGINE-BPS/BPSSCRU2.m@ 1006

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

initial load of WorldVistAEHR

File size: 7.4 KB
Line 
1BPSSCRU2 ;BHAM ISC/SS - ECME SCREEN UTILITIES ;05-APR-05
2 ;;1.0;E CLAIMS MGMT ENGINE;**1,3,5**;JUN 2004;Build 45
3 ;;Per VHA Directive 2004-038, this routine should not be modified.
4 ;USER SCREEN
5 Q
6 ;/**
7 ;Input:
8 ; BP59 - pointer to file #9002313.59
9 ;Output:
10 ;get filling "location" like "WINDOW/LOCALMAIL/CMOP"
11GETMWC(BP59) ;*/
12 N BP1 S BP1=$$RXREF(BP59)
13 Q:+BP1=0 ""
14 Q $$MWC($P(BP1,U),$P(BP1,U,2))
15 ;
16 ;initially this was designed to convert numbers to letters to display on the screen
17 ;but later the Pharmacy designed API that returns letters instead of numbers
18 ;so now this function just returns what it receives in its parameter, while it does not
19 ;make any sense, we still keep it in order to prevent changes in other four routines:
20 ; BPSREOP1, BPSSCR02, BPSSCR03, BPSSCR04
21MWCNAME(BPMWC) ;
22 Q BPMWC
23 ;/**
24 ;Input:
25 ; BP59 - pointer to file #9002313.59
26 ;Output:
27 ;get RX pointer in file #52 and refill number in its multiple (0 - original refill)
28RXREF(BP59) ;
29 N BPRX,BPREF
30 S BPRX=+$P($G(^BPST(BP59,1)),U,11) ;ptr to RX node in #52
31 S BPREF=+$P($G(^BPST(BP59,1)),U) ;ptr to refill multiple in #52
32 Q BPRX_U_BPREF
33 ; determines if the refill was MAIL/WINDOW/CMOP
34MWC(BPRX,BPREF) ;MAIL/WINDOW/CMOP
35 ;input:
36 ; BPRX ptr to #52 (RX)
37 ; BPREF ptr to #52.1 (refills)
38 ;return value:
39 ; 2-MAIL/3-WINDOW/4-CMOP
40 Q $$MWC^PSOBPSU2(BPRX,BPREF)
41 ;
42 ;
43 ;/**
44 ;Input:
45 ; BP59 - pointer to file #9002313.59
46 ;Output:
47 ; insurance ien ^ name ^ phone
48GETINSUR(BP59) ;get insurance info by the pointer of #9002313.59
49 N BPHONE,BPINSNM,BPINSID,BP57,BPINSN,BPX
50 S BPX=$$NAMEPHON^BPSSCRU3(BP59)
51 S BPINSNM=$P(BPX,U,1)
52 S BPHONE=$P(BPX,U,2)
53 ;Get a temporary ID for the insurance from ^TMP list of insurances.
54 ;If doesn't exist yet then create a new record in ^TMP list of insurances
55 ; for this insurance and return the ID for the record.
56 ;A lifetime for ^TMP list of insurances is the time period the user is using
57 ; the User Screen menu option
58 S BPINSID=$$CHKINSUR^BPSSCR(BPINSNM,BPHONE)
59 I $L(BPHONE)=0 S BPHONE=" "
60 I $L(BPINSNM)=0 S BPINSNM="?NODATA?"
61 Q BPINSID_U_BPINSNM_U_BPHONE
62 ;
63 ;/**
64 ;Input:
65 ; BP59 - pointer to file #9002313.59
66 ;Output:
67 ;transaction date
68TRANDT(BP59) ;
69 Q $P($G(^BPST(BP59,0)),U,8)\1
70 ;
71 ;/**
72 ;Input:
73 ; BP59 - pointer to file #9002313.59
74 ;Output:
75 ;ECME pharmacy division (9002313.56)
76DIVIS(BP59) ;
77 Q $P($G(^BPST(BP59,1)),U,7)
78 ;
79 ;/**
80 ;Input:
81 ; BP59 - pointer to file #9002313.59
82 ;Output:
83 ;patient's DFN (file #2)
84GETPATID(BP59) ;
85 Q $P($G(^BPST(BP59,0)),U,6)
86 ;
87 ;return RX status as ACT/DIS/etc
88RXST(BP59) ;
89 N BPRXREF
90 S BPRXREF=$$RXREF^BPSSCRU2(BP59)
91 ;display status ONLY if the refill is the most recent
92 ;otherwise display blanks (three spaces for sorting purposes)
93 I +$P(BPRXREF,U,2)'=(+$$LSTRFL^PSOBPSU1(+$P(BPRXREF,U,1))) Q "***"
94 Q $$RXSTANAM($$RXSTATUS(+$P(BPRXREF,U,1)))
95 ;/**
96 ;RX status
97 ;Input
98 ; RXNUM:
99 ; ien of file #52 (if MODE=0)
100 ; or RX number (if MODE=1)
101 ;----------
102 ;Output:
103 ; 0 if not found
104 ; status set#
105RXSTATUS(RXNUM) ;*/
106 N BPRET
107 S BPRET=$$RXAPI1^BPSUTIL1(RXNUM,100,"I")
108 I BPRET="" Q -1
109 Q BPRET
110 ;/**
111 ;if RX "valid"
112RXACTIVE(BPRXSTAT) ;*/
113 ; 0 not valid
114 ; 1 valid (i.e. ACTIVE/NON-VERIFIED/REFILL/HOLD/DRUG INTERACTIONS/SUSPENDED)
115 ; -1 doesn't exist
116 Q:BPRXSTAT<6 1 ;active
117 ;/**
118 ;RX status text
119RXSTANAM(BPRXSTAT) ;*/
120 Q:BPRXSTAT=0 "ACT" ; ACTIVE;
121 Q:BPRXSTAT=1 "NVER" ; NON-VERIFIED;
122 Q:BPRXSTAT=3 "HLD" ; HOLD;
123 Q:BPRXSTAT=5 "SUS" ; SUSPENDED;
124 Q:BPRXSTAT=11 "EXP" ; EXPIRED;
125 Q:BPRXSTAT=12 "DIS" ; DISCONTINUED;
126 Q:BPRXSTAT=13 "DEL" ; DELETED;
127 Q:BPRXSTAT=14 "DIS" ; DISCONTINUED BY PROVIDER;
128 Q:BPRXSTAT=15 "DIS" ; DISCONTINUED (EDIT);
129 Q:BPRXSTAT=16 "HLD" ; PROVIDER HOLD;
130 Q:BPRXSTAT=-1 "???"
131 Q ""
132 ;/**
133 ;Input:
134 ; BP59 - pointer to file #9002313.59
135 ;Output:
136 ;returns:
137 ;>0 Released
138 ;0 non released
139 ;-1 error
140ISRXREL(BP59) ;
141 N BP1
142 S BP1=$$REFILINF(BP59)
143 Q:BP1<0 -1
144 Q $P(BP1,U,2) ; i.e. it is non-released if there is no any release date
145 ;
146 ;release status
147RL(BP59) ;
148 Q $S($$ISRXREL(BP59)>0:"RL",1:"NR")
149 ;/**
150 ;get refill (including original refill) info by BP59
151 ;Input:
152 ; BP59 - pointer to file #9002313.59
153 ;Output:
154 ;returns:
155 ;on error : "-1"
156 ;on success : refill# ^ release date ^label print date ^ fill date ^ issue date
157REFILINF(BP59) ;*/
158 N BP1 S BP1=$$RXREF(BP59)
159 N BPRX S BPRX=$P(BP1,U,1) ;ptr to #52
160 N BPREF S BPREF=$P(BP1,U,2) ;ptr in its refill multiple
161 I BPREF,$$IFREFILL(BPRX,BPREF)=0 Q -1 ;if bad data
162 ;original refill
163 I BPREF=0 Q "0"_U_$$RXRELDT(BPRX)_U_U_$$RXFILDT(BPRX)_U_$$RXISSDT(BPRX)
164 ;refill's release date
165 I BPREF>0 Q BPREF_U_$$REFRELDT(BPRX,BPREF)_U_U_$$REFFILDT(BPRX,BPREF)_U_$$REFISSDT(BPRX,BPREF)
166 Q -1
167 ;
168 ;-Prescriptions-----------------------
169 ;RX issue date
170RXISSDT(BPRX) ;
171 Q +$$RXAPI1^BPSUTIL1(BPRX,1,"I")
172 ;
173 ;RX's release date
174RXRELDT(BPRX) ;
175 Q +$$RXAPI1^BPSUTIL1(BPRX,31,"I")
176 ;
177 ;RX's fill date
178RXFILDT(BPRX) ;
179 Q +$$RXAPI1^BPSUTIL1(BPRX,22,"I")
180 ;
181 ;refill's release date
182REFRELDT(BPRX,BPREF) ;
183 Q +$$RXSUBF1^BPSUTIL1(BPRX,52,52.1,BPREF,17,"I")
184 ;
185 ;refill's refill date
186REFFILDT(BPRX,BPREF) ;
187 Q $$RXSUBF1^BPSUTIL1(BPRX,52,52.1,BPREF,.01,"I")
188 ;
189 ;refill's issue date
190REFISSDT(BPRX,BPREF) ;
191 Q $$REFDISDT(BPRX,BPREF)
192 ;
193 ;refill's dispense date
194REFDISDT(BPRX,BPREF) ;
195 Q $$RXSUBF1^BPSUTIL1(BPRX,52,52.1,BPREF,10.1,"I")
196 ;
197 ;if refill exists
198IFREFILL(BPRX,BPREF) ;
199 Q $$RXSUBF1^BPSUTIL1(BPRX,52,52.1,BPREF,.01,"I")'=""
200 ;/**
201 ;input
202 ;ptr to 9002313.59
203 ;output :
204 ; BB - back billing
205 ; RT - all other values in (#1201) RX ACTION field on 9002313.59
206RTBB(BP59) ;*/
207 N BPTRBB
208 S BPTRBB=$P($G(^BPST(BP59,12)),U)
209 I BPTRBB="" Q "**"
210 I BPTRBB="BB" Q "BB"
211 Q "RT"
212 ;
213 ;------------ patient's name
214PATNAME(BPDFN) ;
215 Q $E($P($G(^DPT(BPDFN,0)),U),1,15)
216 ;
217SSN4(DFN) ;last 4 SSN
218 N X
219 S X=$P($G(^DPT(DFN,0)),U,9)
220 Q "("_$E(X,$L(X)-3,$L(X))_")"
221 ;
222 ;get drug generic name
223DRGNAM(BP50) ;
224 ;BP50 - ptr to #50
225 Q $E($$DRUGDIE^BPSUTIL1(BP50,.01,"E"),1,35)
226 ;get drug
227GETDRUG(BP52) ;
228 ;return value:
229 ; 0 - unknown
230 ; n - ptr to DRUG file #50
231 Q +$$RXAPI1^BPSUTIL1(BP52,6,"I")
232 ;
233GETDRG59(BP59) ;
234 N BPX
235 S BPX=$$RXREF(BP59)
236 Q $$GETDRUG(+BPX)
237 ;
238 ;
239 ;review %% for each of claims in the array
240 ;and calculate "overall" "done" status
241 ;input:
242 ; BPARR59 - array of ptr to #9002313.59
243 ;output:
244 ; status
245FINISHST(BPARR59) ;
246 N BPFIN,BP59
247 S BPFIN=1,BP59=0
248 F S BP59=$O(BPARR59(BP59)) Q:+BP59=0 D Q:BPFIN=0
249 . I $$PRCNTG^BPSSCRU3(BP59)<99 S BPFIN=0
250 I BPFIN=1 Q "**FINISHED**"
251 Q ""
252 ;
253 ;/**
254 ;BP59 - ptr to 9002313.59
255 ;output :
256 ;ECME number
257 ; 7 digits of the prescription IEN file 52
258 ;or 7 spaces
259ECMENUM(BP59) ;*/
260 N X
261 S X=$P($G(^BPST(BP59,0)),"^")
262 I X="" Q $$FORMAT(X,7," ",1)
263 Q $$FORMAT(X\1,7,"0",1)
264 ;
265 ;BPRX - ptr to #52
266RXNUM(BPRX) ;
267 Q $$RXAPI1^BPSUTIL1(BPRX,.01,"E")_$S(+$$RXAPI1^BPSUTIL1(BPRX,105,"I"):"$",1:"")
268 ;
269 ;/**
270 ;get NDC
271 ;input
272 ;BPRX - ptr to #52
273 ;BPREF - refill # (0,1,2,3...)
274NDC(BPRX,BPREF) ;*/
275 Q $$GETNDC^PSONDCUT(BPRX,BPREF)
276 ;
277DRGNAME(BP59) ;drug name BP59 -ptr to .59 file
278 N BPRX
279 S BPRX=+$P($G(^BPST(BP59,1)),U,11) ;ptr to RX node in #52
280 Q $E($$DRGNAM($$GETDRUG(BPRX)),1,23)
281 ;
282 ;is the number even?
283 ;1-yes
284 ;0 -no
285ISEVEN(BPNUM) ;
286 Q ((BPNUM/2)-(BPNUM\2))=0
287 ;
288 ;BPSTR - string to format
289 ;BPSMLEN - max lenght
290 ;BPSCHR - char to add
291 ;BPSLFT - 1 - add from the left, 0 - from the right
292FORMAT(BPSTR,BPSMLEN,BPSCHR,BPSLFT) ;
293 N LN S LN=$L(BPSTR)
294 N ZZ S ZZ=""
295 I LN=BPSMLEN Q BPSTR
296 I LN>BPSMLEN Q:BPSLFT $E(BPSTR,LN-BPSMLEN+1,9999) Q $E(BPSTR,1,BPSMLEN)
297 S $P(ZZ,BPSCHR,BPSMLEN-LN+1)=""
298 Q:BPSLFT ZZ_BPSTR
299 Q BPSTR_ZZ
300 ;
Note: See TracBrowser for help on using the repository browser.