source: FOIAVistA/trunk/r/OUTPATIENT_PHARMACY-PSO-APSP-HUIP/PSOBPSUT.m@ 1397

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

initial load of FOIAVistA 6/30/08 version
File size: 9.2 KB
Line 
1PSOBPSUT ;BIRM/MFR - BPS (ECME) Utilities ; 07 Jun 2005 8:39 PM
2 ;;7.0;OUTPATIENT PHARMACY;**148,247,260,281**;DEC 1997;Build 41
3 ;Reference to $$ECMEON^BPSUTIL supported by IA 4410
4 ;Reference to IBSEND^BPSECMP2 supported by IA 4411
5 ;Reference to $$STATUS^BPSOSRX supported by IA 4412
6 ;Reference to $$NDCFMT^PSSNDCUT supported by IA 4707
7 ;Reference to $$CLAIM^BPSBUTL supported by IA 4719
8 ;Reference to ^PS(55 supported by IA 2228
9 ;Reference to ^PSDRUG( supported by IA 221
10 ;Reference to ^PSDRUG("AQ" supported by IA 3165
11 ;
12ECME(RX) ; Returns "e" if Rx/Refill is Electronically Billable (3rd party)
13 Q $S($$STATUS^BPSOSRX(RX,$$LSTRFL^PSOBPSU1(RX))'="":"e",1:"")
14 ;
15STATUS(RX,RFL) ; Returns the Rx's ECME Status (calls STATUS^BPSOSRX)
16 ; Input: (r) RX - Rx IEN (#52)
17 ; (o) RFL - Refill # (Default: most recent)
18 I '$D(RFL) S RFL=$$LSTRFL^PSOBPSU1(RX)
19 Q $P($$STATUS^BPSOSRX(RX,RFL),"^")
20 ;
21SUBMIT(RX,RFL,IGRL,IGCMP) ; Returns whether the Rx should be submitted to ECME at the moment or not
22 ; Input: (r) RX - Rx IEN (#52)
23 ; (o) RFL - Refill # (Def.: most recent)
24 ; (o) IGRL - Ignore Release Date? (1-YES/0-NO) (Def.: 0 - NO)
25 ; (o) IGCMP- Ignore CMOP/Suspense check? (1-YES/0-NO) (Def.: 0 - NO)
26 ;
27 ; - Get the REFILL # (multiple IEN)
28 N STATUS
29 I '$D(RFL) S RFL=$$LSTRFL^PSOBPSU1(RX)
30 ; - Not the latest fill for the prescription
31 I RFL'=$$LSTRFL^PSOBPSU1(RX) Q 0
32 ; - Status not ACTIVE, DISCONTINUED, or EXPIRED
33 S STATUS=$$GET1^DIQ(52,RX,100,"I")
34 I STATUS'=0&(STATUS'=11)&(STATUS'=12) Q 0
35 ; Will suspend for CMOP
36 I '$G(IGCMP),$$CMOP(RX,RFL) Q 0
37 ; - ECME turned OFF for Rx's site
38 I '$$ECMEON^BPSUTIL($$RXSITE(RX,RFL)) Q 0
39 ; - Rx is RELEASED - Do not submit
40 I '$G(IGRL),$$RXRLDT(RX,RFL) Q 0
41 ; - Future Fill/AUTO SUSPENSE ON - will suspend
42 I '$G(IGCMP),$$RXFLDT(RX,RFL)>DT,$$GET1^DIQ(59,$$RXSITE(RX,RFL),.16,"I") Q 0
43 Q 1
44 ;
45CMOP(RX,RFL) ; Returns if the Rx will be a CMOP Rx or not
46 ; Input: (r) RX - Rx IEN (#52)
47 ; (o) RFL - Refill # (Default: most recent)
48 ; Output: 1 - CMOP / 0 - NON-CMOP
49 ;
50 N DFN,CMOP,MAIL,MAILEXP,DRUG,WARNS,STATUS,MW,A
51 ; Get the REFILL # (multiple IEN)
52 I '$D(RFL) S RFL=$$LSTRFL^PSOBPSU1(RX)
53 ; MAIL=MAIL Code, MAILEXP=Mail Code Expiration Date
54 S CMOP=0
55 S DFN=$$GET1^DIQ(52,RX,2,"I"),MAIL=$$GET1^DIQ(55,DFN,.03,"I"),MAILEXP=$$GET1^DIQ(55,DFN,.05,"I")
56 I MAIL>1,MAILEXP=""!(MAILEXP>DT) G QCMOP
57 ; Get drug IEN and cheDRUG if CMOP ,$S($G(MAILEXP)=""!($G(MAILEXP)>DT):1,1:0)
58 S DRUG=$$GET1^DIQ(52,RX,6,"I") G QCMOP:'DRUG,QCMOP:'$D(^PSDRUG("AQ",DRUG))
59 ; Not marked for O.P.
60 I $$GET1^DIQ(50,DRUG,63)'["O" G QCMOP
61 ; Drug Warning >11
62 S WARNS=$$GET1^DIQ(50,DRUG,8) I $L(WARNS)>11 G QCMOP
63 ; If tradename
64 I $$GET1^DIQ(52,RX,6.5)'="" G QCMOP
65 ; If Cancelled, Expired, Deleted, Hold
66 S STATUS=$$GET1^DIQ(52,RX,100,"I") I STATUS>9!(STATUS=4)!(STATUS=3) G QCMOP
67 ; Rx RELEASED
68 I $$RXRLDT^PSOBPSUT(RX,RFL) G QCMOP
69 ; MAIL/WINDOW
70 S MW=$S('RFL:$$GET1^DIQ(52,RX,11,"I"),1:$$GET1^DIQ(52.1,RFL_","_RX,2,"I"))
71 ; IF WINDOW/ORIGINAL/FUTURE FILL SETS MW = MAIL
72 I MW="W",$$RXFLDT^PSOBPSUT(RX,RFL)>DT S MW="M"
73 ; If not MAIL
74 I MW'="M" G QCMOP
75 S CMOP=1
76 ;
77QCMOP Q CMOP
78 ;
79RXRLDT(RX,RFL) ; Returns the Rx Release Date
80 ; Input: (r) RX - Rx IEN (#52)
81 ; (o) RFL - Refill # (Default: most recent)
82 ;
83 ; Output: RXRLDT - Rx Release Date
84 N RXRLDT
85 I '$G(RX) Q ""
86 S RXRLDT=$$GET1^DIQ(52,RX,31,"I")
87 I '$D(RFL) S RFL=$$LSTRFL^PSOBPSU1(RX)
88 I RFL S RXRLDT=$$GET1^DIQ(52.1,RFL_","_RX,17,"I")
89 Q RXRLDT
90 ;
91RXFLDT(RX,RFL) ; Returns the Rx Fill Date
92 ; Input: (r) RX - Rx IEN (#52)
93 ; (o) RFL - Refill # (Default: most recent)
94 ; Output: RXFLDT - Rx Fill Date
95 N RXFLDT
96 I '$G(RX) Q ""
97 S RXFLDT=$$GET1^DIQ(52,RX,22,"I")
98 I '$D(RFL) S RFL=$$LSTRFL^PSOBPSU1(RX)
99 I RFL S RXFLDT=$$GET1^DIQ(52.1,RFL_","_RX,.01,"I")
100 Q RXFLDT
101 ;
102RXSUDT(RX,RFL) ; Returns the prescription/fill Suspense Date for the RX/Reject passed in
103 ;Input: (r) RX - Rx IEN (#52)
104 ; (o) RFL - Refill IEN (#52.1)
105 ;Output: SUSPENSE DATE (External format) or <NULL>, if not suspended
106 ;
107 I $G(^PSRX(RX,"STA"))'=5 Q ""
108 N SURX,SURFL
109 S SURX=$O(^PS(52.5,"B",RX,0)) I 'SURX Q ""
110 I $$GET1^DIQ(52.5,SURX,.05,"I") Q ""
111 S SURFL=+$$GET1^DIQ(52.5,SURX,9) I RFL'=SURFL Q ""
112 Q $$GET1^DIQ(52.5,SURX,.02,"I")
113 ;
114RXSITE(RX,RFL) ; Returns the Rx DIVISION
115 ; Input: (r) RX - Rx IEN (#52)
116 ; (o) RFL - Refill #
117 ; Output: SITE - Rx Fill Date
118 ;
119 N SITE
120 I '$G(RX) Q ""
121 I '$D(RFL) S RFL=$$LSTRFL^PSOBPSU1(RX)
122 I RFL S SITE=$$GET1^DIQ(52.1,RFL_","_RX,8,"I")
123 I 'RFL!'$G(SITE) S SITE=$$GET1^DIQ(52,RX,20,"I")
124 Q SITE
125 ;
126MANREL(RX,RFL,PID) ; ePharmacy Manual Rx Release
127 ;Input: (r) RX - Rx IEN (#52)
128 ; (o) RFL - Refill # (Default: most recent)
129 ; (o) PID - Displays PID/Drug/Rx in the NDC prompts
130 ;Output: "" (null - OK to Release) OR "^" (User entered "^", or no valid NDC on file for ePharmacy Rx)
131 ;
132 N ACTION
133 ;
134 I '$D(RFL) S RFL=$$LSTRFL^PSOBPSU1(RX)
135 ;
136 ; - Checking for REJECTS before proceeding to Rx Release
137 I $$FIND^PSOREJUT(RX,RFL) D I ACTION="Q"!(ACTION="^") W ! Q "^"
138 . S ACTION=$$HDLG^PSOREJU1(RX,RFL,"79,88","ED","OIQ","Q")
139 ;
140 ; - ePharmacy switch is OFF
141 I '$$ECMEON^BPSUTIL($$RXSITE^PSOBPSUT(RX,RFL)) Q ""
142 ;
143 ; - Not an ePharmacy Rx
144 I $$STATUS^PSOBPSUT(RX,RFL)="" Q ""
145 ;
146 ; - NDC editing before Rx release
147 S ACTION=$$CHGNDC^PSONDCUT(RX,RFL,$G(PID)) I ACTION="^" D Q "^"
148 . W !!,$C(7),"A valid NDC must be entered before the Release function can be completed.",! H 1
149 ;
150 ; - Checking for OPEN/UNRESOLVED 3rd. Party Payer Rejects (After possible NDC edit)
151 I $$FIND^PSOREJUT(RX,RFL) D I ACTION="Q"!(ACTION="^") W ! Q "^"
152 . S ACTION=$$HDLG^PSOREJU1(RX,RFL,"79,88","ED","OIQ","Q")
153 ;
154 ; - Notifying IB of a Rx RELEASE event
155 D RELEASE^PSOBPSU1(RX,RFL,DUZ)
156 ;
157 Q ""
158 ;
159AUTOREL(RX,RFL,RLDT,NDC,SRC,STS,HNG) ; Sends Rx Release information to ECME/IB and updates NDC
160 ; in the DRUG/PRESCRIPTION files
161 ;Input: (r) RX - Rx IEN (#52)
162 ; (o) RFL - Refill # (Default: most recent)
163 ; (r) RLDT- Release Date
164 ; (r) NDC - NDC Number (Must be 11 digits)
165 ; (o) SRC - SOURCE: "C" - CMOP / "A" - OPAI
166 ; (o) STS - Status: (S)uccessful/(U)nsuccessful Release (Default: "S" - Successful)
167 ; (o) HNG - HANG time after resubmission and before checking the status of the claim (Default: 0)
168 ;
169 N RXNDC,SITE
170 ;
171 I '$D(RFL) S RFL=$$LSTRFL^PSOBPSU1(RX)
172 ;
173 S:'$D(STS) STS="S" S:'$D(SRC) SRC="" S HNG=+$G(HNG)
174 S RXNDC=$$GETNDC^PSONDCUT(RX,RFL)
175 ;
176 ; - Saves the NDC from CMOP/Automated Dispensing Machine in the Prescription file
177 I $$NDCFMT^PSSNDCUT(NDC)'="" D SAVNDC^PSONDCUT(RX,RFL,$$NDCFMT^PSSNDCUT(NDC),$S(SRC="C":1,1:0))
178 ;
179 ; - Not an ePharmacy Rx
180 I $$STATUS^PSOBPSUT(RX,RFL)="" Q ""
181 ;
182 ; - Unsuccessful Release
183 I STS="U" D Q
184 . D REVERSE^PSOBPSU1(RX,RFL,"CRLX",,"UNSUCCESSFUL "_$S(SRC="C":"CMOP",1:"EXT INTERFACE")_" RELEASE",1)
185 ;
186 ; - Notifying IB of a Rx RELEASE event
187 D RELEASE^PSOBPSU1(RX,RFL)
188 ;
189 ; - Invalid NDC from Automated Dispensing Machine
190 I SRC="A",$$NDCFMT^PSSNDCUT(NDC)="" D Q
191 . D REVERSE^PSOBPSU1(RX,RFL,"CRLR",,"INVALID EXT INTERFACE NDC",1,NDC)
192 ;
193 ; - Invalid NDC number for CMOP
194 I SRC="C",$$NDCFMT^PSSNDCUT(NDC)="" D Q
195 . D REVERSE^PSOBPSU1(RX,RFL,"CRLR",,"INVALID CMOP NDC",1,NDC)
196 ;
197 ; - If NDC not equal RXNDC, issue reversal and submit new claim
198 I SRC="A",$$NDCFMT^PSSNDCUT(NDC)'=RXNDC D Q
199 . D ECMESND^PSOBPSU1(RX,RFL,RLDT,"CRLB",$$NDCFMT^PSSNDCUT(NDC),,"AUTO RELEASE",,1,,1)
200 . H HNG
201 . ; - If new claim returned PAYABLE, save new NDC in the DRUG/PRESCRIPTION files
202 . I $$STATUS^PSOBPSUT(RX,RFL)="E PAYABLE" D SAVNDC^PSONDCUT(RX,RFL,$$NDCFMT^PSSNDCUT(NDC),0,1)
203 ;
204 ; - If NDC not equal RXNDC, issue reversal and submit new claim
205 I SRC="C",$$NDCFMT^PSSNDCUT(NDC)'=RXNDC D Q
206 . ; - Reverse/Resubmit with correct NDC
207 . D ECMESND^PSOBPSU1(RX,RFL,RLDT,"CRLB",$$NDCFMT^PSSNDCUT(NDC),1,"CMOP RELEASE",,1,,1)
208 . ; - Wait for a response from the Payer for the submission above
209 . H HNG
210 . ; - If new claim returned PAYABLE, save new NDC in the DRUG/PRESCRIPTION files
211 . I $$STATUS^PSOBPSUT(RX,RFL)="E PAYABLE" D SAVNDC^PSONDCUT(RX,RFL,$$NDCFMT^PSSNDCUT(NDC),1,1)
212 ;
213 ; - Calls ECME api responsible for notifying IB to create a BILL
214 D IBSEND(RX,RFL)
215 ;
216 Q
217 ;
218IBSEND(RX,RFL) ; Rx Release: Calls ECME, which will call IB to create a bill
219 ;Input: (r) RX - Rx IEN (#52)
220 ; (o) RFL - Refill # (Default: most recent)
221 ;
222 I '$D(RFL) S RFL=$$LSTRFL^PSOBPSU1(RX)
223 ;
224 ; - ECME turned OFF for Rx's site
225 I '$$ECMEON^BPSUTIL($$RXSITE^PSOBPSUT(RX,RFL)) Q
226 ;
227 ; - Not an ePharmacy Rx
228 I $$STATUS^PSOBPSUT(RX,RFL)="" Q ""
229 ;
230 ; - Calls ECME previously reversed, re-submit the claim to the payer
231 I $$STATUS^PSOBPSUT(RX,RFL)="E REVERSAL ACCEPTED"!($$STATUS^PSOBPSUT(RX,RFL)="IN PROGRESS") D Q
232 . D ECMESND^PSOBPSU1(RX,RFL,$$RXRLDT^PSOBPSUT(RX,RFL),"RRL")
233 ;
234 ; - Notifying ECME of a BILLING event
235 I $$STATUS^PSOBPSUT(RX,RFL)="E PAYABLE" D Q
236 . N PSOCLAIM S PSOCLAIM=$$CLAIM^BPSBUTL(RX,RFL)
237 . D IBSEND^BPSECMP2($P(PSOCLAIM,"^",2),$P(PSOCLAIM,"^",3),"BILL",DUZ)
238 ;
239 Q
240 ;
241RETRX(RX,RFL) ; - Re-transmit a claim for the prescription/fill?
242 ;Input: (r) RX - Rx IEN (#52)
243 ; (o) RFL - Refill # (Default: most recent)
244 ;Output: 1 - Re-transmit / 0 - Don't re-transmit
245 I '$D(RFL) S RFL=$$LSTRFL^PSOBPSU1(RX)
246 ;
247 I RFL Q +$$GET1^DIQ(52.1,RFL_","_RX,82,"I")
248 Q +$$GET1^DIQ(52,RX,82,"I")
Note: See TracBrowser for help on using the repository browser.