source: FOIAVistA/tag/r/E_CLAIMS_MGMT_ENGINE-BPS/BPSOSRX.m@ 628

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

initial load of FOIAVistA 6/30/08 version

File size: 7.0 KB
Line 
1BPSOSRX ;BHAM ISC/FCS/DRS/FLS - callable from RPMS pharm ;06/01/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 ;
5 ; There are only four callable entry points!
6 ; $$CLAIM^BPSOSRX Submit a claim to ECME
7 ; $$UNCLAIM^BPSOSRX Reverse a previously submitted claim.
8 ; $$STATUS^BPSOSRX Inquire about a claim's status
9 ; SHOWQ^BPSOSRX Display queue of claims to be processed
10 Q
11 ;
12 ; $$CLAIM - Submit a claim to ECME
13 ; Input
14 ; RXI - Prescription IEN
15 ; RXR - Fill Number
16 ; MOREDATA - Array of data needed for transaction/claim
17 ; Return values:
18 ; 1 = accepted for processing
19 ; 0^reason = failure (should never happen)
20 ;
21 ; All this does is to put it on a list and start a background job.
22 ;
23 ; Note: If the claim has already been processed, and it's
24 ; resubmitted, then a reversal will be done first,
25 ; and then the resubmit will be done. Intervening calls
26 ; to $$STATUS may show progress of the reversal before
27 ; the resubmitted claim is processed.
28CLAIM(RXI,RXR,MOREDATA) ;
29 N RETVAL,STAT,TYPE,SUBMITDT
30 I '$G(RXI) Q 0
31 I '$G(RXR) S RXR=0
32 I '$$LOCK("SUBMIT",5) Q 0
33 S TYPE="CLAIM",SUBMITDT=$$NOW
34 N X,X1,X2
35 S X1=DT,X2=30 D C^%DTC
36 K ^XTMP("BPS-PROC",TYPE,RXI,RXR)
37 S ^XTMP("BPS-PROC",0)=X_U_DT_U_"ECME PROCESSING QUEUE"
38 S ^XTMP("BPS-PROC",TYPE,RXI,RXR)=SUBMITDT
39 I $D(MOREDATA) M ^XTMP("BPS-PROC",TYPE,RXI,RXR,"MOREDATA")=MOREDATA
40 S ^XTMP("BPSOSRX",0)=X_U_DT_U_"ECME SUBMIT DATE FOR A RX AND FILL"
41 S ^XTMP("BPSOSRX",RXI,RXR)=SUBMITDT
42 D UNLOCK("SUBMIT")
43 D RUNNING()
44 S RETVAL=1
45 Q RETVAL
46 ;
47 ; $$UNCLAIM - Reverse a previously submitted claim.
48 ; Input
49 ; RXI - Prescription IEN
50 ; RXR - Fill Number
51 ; MOREDATA - Array of data needed for transaction/claim
52 ; Return values:
53 ; 1 = accepted for processing
54 ; 0^reason = failure (should never happen)
55 ;
56 ; All this does is to put it on a list and start a background job.
57 ;
58 ; Note: The reversal will actually be done ONLY if the
59 ; most recent processing of the claim resulted in something
60 ; reversible, namely E PAYABLE or E REVERSAL REJECTED
61UNCLAIM(RXI,RXR,MOREDATA) ;
62 N RETVAL,STAT,RESULT,TYPE,SUBMITDT
63 I '$G(RXI) Q 0
64 I '$G(RXR) S RXR=0
65 I '$$LOCK("SUBMIT",5) Q 0
66 S TYPE="UNCLAIM",SUBMITDT=$$NOW
67 N X,X1,X2
68 S X1=DT,X2=30 D C^%DTC
69 K ^XTMP("BPS-PROC",TYPE,RXI,RXR)
70 S ^XTMP("BPS-PROC",0)=X_U_DT_U_"ECME PROCESSING QUEUE"
71 S ^XTMP("BPS-PROC",TYPE,RXI,RXR)=SUBMITDT
72 I $D(MOREDATA) M ^XTMP("BPS-PROC",TYPE,RXI,RXR,"MOREDATA")=MOREDATA
73 S ^XTMP("BPSOSRX",0)=X_U_DT_U_"ECME SUBMIT DATE FOR A RX AND FILL"
74 S ^XTMP("BPSOSRX",RXI,RXR)=SUBMITDT
75 D UNLOCK("SUBMIT")
76 D RUNNING()
77 S RETVAL=1
78 Q RETVAL
79 ;
80 ; $$STATUS(RXI,RXR,QUE) - Returns the Status of the prescription/fill
81 ; Input
82 ; RXI - Prescription IEN (required)
83 ; RXR - Refill Number (required)
84 ; QUE: 0/null - Do not check if a RX/fill is on the queue (optional)
85 ; 1 - Check if RX/fill is on the queue
86 ;
87 ; Returns
88 ; RESULT^LAST UPDATE DATE/TIME^DESCRIPTION^STATUS %
89 ; Returns null if there's no ECME record of this RX/fill
90 ;
91 ; RESULT is either:
92 ; 1. IN PROGRESS for incomplete claims
93 ; 2. Final status for complete claims. See comments for
94 ; BPSOSUC for complete list of possible statuses.
95 ; LAST UPDATE DATE/TIME is the Fileman date and time of the
96 ; last update to the status of this claim.
97 ; DESCRIPTION is either:
98 ; 1. Incomplete claims will be the status (i.e., Waiting to Start,
99 ; Transmitting)
100 ; 2. Completed claims will have the reason that the ECME process
101 ; was aborted if the result is E OTHER. Otherwise, it will
102 ; be similiar to the RESULT
103 ; STATUS % is the completion percentage. Note that 99 is considered
104 ; complete.
105STATUS(RXI,RXR,QUE) ;
106 ;
107 ; Setup needed variables
108 N IEN59,SDT,A,SUBDT
109 I '$G(RXI) Q ""
110 I $G(RXR)="" Q ""
111 I $G(QUE)="" S QUE=1
112 S IEN59=$$IEN59(RXI,RXR)
113 S SDT=$G(^XTMP("BPSOSRX",RXI,RXR))
114 ;
115 ; ECME record not created
116 I '$D(^BPST(IEN59)) D Q A
117 . I QUE,SDT S A="IN PROGRESS"_U_SDT_U_$$STATI^BPSOSU(0)_U_-1 Q
118 . I QUE,$D(^XTMP("BPS-PROC","CLAIM",RXI,RXR)) S A="IN PROGRESS"_U_SDT_U_$$STATI^BPSOSU(0)_U_-1 Q
119 . S A=""
120 ;
121 ; Loop: Get data, quit if times and status match (no change during gather)
122 N C,T1,T2,S1,S2 F D I T1=T2,S1=S2 Q
123 . S T1=$$LASTUP59(IEN59)
124 . S S1=$$STATUS59(IEN59)
125 . I S1=99 D ; completed
126 . . S A=$$CATEG^BPSOSUC(IEN59)
127 . . S C=$$RESTXT59(IEN59)
128 . I S1'=99 D
129 . . S A="IN PROGRESS"
130 . . S C=$$STATI^BPSOSU(S1)
131 . S T2=$$LASTUP59(IEN59)
132 . S S2=$$STATUS59(IEN59)
133 ;
134 ; If the queue parameter is set and the submit date from the queue
135 ; follows the SUBMIT DATE/LAST UPDATE date from BPS TRANSACTION
136 ; or the RX/fill is still on the queue, then change the response
137 ; to IN PROGRESS^Submit Date^WAITING TO START
138 S SUBDT=$$SUBMIT59(IEN59)
139 I SUBDT="" S SUBDT=T1
140 I $G(QUE),SDT>SUBDT!($D(^XTMP("BPS-PROC","CLAIM",RXI,RXR)))!($D(^XTMP("BPS-PROC","UNCLAIM",RXI,RXR))) S A="IN PROGRESS",T1=SDT,S1=-1,C=$$STATI^BPSOSU(0)
141 ;
142 ; When finishing the reversal of a Reversal/Resubmit, display IN PROGRESS
143 I $P($G(^BPST(IEN59,1)),"^",12)=1,S1=99 S A="IN PROGRESS",S1=98,C=$$STATI^BPSOSU(S1)
144 ;
145 ; Return results
146 Q A_U_T1_U_$E(C,1,255-$L(A)-$L(T1)-2)_U_S1
147 ;
148 ; SHOWQ - Show RX/Fill on the Queue. Since claims are generally processed
149 ; immediately, this report will generally have no output.
150SHOWQ G SHOWQ^BPSOSR2
151 ;
152NOW() N %,%H,%I,X D NOW^%DTC Q %
153 ;
154 ; RESTXT59 - Return first semi-colon piece of the Result Text (202) field
155 ; from BPS Transaction
156RESTXT59(IEN59) ;
157 I '$G(IEN59) Q ""
158 Q $P($P($G(^BPST(IEN59,2)),U,2,99),";",1)
159 ;
160 ; LASTUP59 - Return last update date/time from BPS Transactions
161LASTUP59(IEN59) ;
162 I '$G(IEN59) Q ""
163 Q $P($G(^BPST(IEN59,0)),U,8)
164 ;
165 ; STATUS59 returns STATUS field from BPS Transaction
166 ; Note: 99 means complete
167STATUS59(IEN59) ;
168 I '$G(IEN59) Q ""
169 Q $P($G(^BPST(IEN59,0)),U,2)
170 ;
171 ; SUBMIT59 - Return Submit date/time from BPS Transactions
172SUBMIT59(IEN59) ;
173 I '$G(IEN59) Q ""
174 Q $P($G(^BPST(IEN59,0)),U,7)
175 ;
176 ; RXRDEF - Get last refill
177RXRDEF(RXI) ;
178 I '$G(RXI) Q ""
179 K ^TMP($J)
180 N BPSPT S BPSPT=$$RXAPI1^BPSUTIL1(RXI,2,"I")
181 I BPSPT="" Q ""
182 D RX^PSO52API(BPSPT,"BPSREF",RXI,,"R")
183 Q +$O(^TMP($J,"BPSREF",BPSPT,RXI,"RF",""),-1)
184 ;
185 ; Utilities
186 ;
187 ; LOCKING: Just one user of this routine at a time.
188 ; X = "SUBMIT" to interlock the claim submission
189 ; X = "BACKGROUND" to interlock the background job
190LOCK(X,TIMEOUT) ;EP - BPSOSRB
191 I $G(TIMEOUT)="" S TIMEOUT=0
192 L +^XTMP("BPS-PROC",X):TIMEOUT
193 Q $T
194 ;
195LOCKNOW(X) ;EP - BPSOSRB
196 L +^XTMP("BPS-PROC",X):0
197 Q $T
198 ;
199UNLOCK(X) ;EP - BPSOSRB
200 L -^XTMP("BPS-PROC",X)
201 Q
202 ;
203RUNNING() ;
204 I '$$LOCKNOW("BACKGROUND") Q ; it is running; don't start another
205 D UNLOCK("BACKGROUND") ; it's not running; release our probing lock
206 D TASK
207 Q
208 ;
209IEN59(RXI,RXR) ;EP - from BPSOS, BPSOSRB
210 I '$G(RXI) Q ""
211 I '$G(RXR) S RXR=0
212 Q RXI_"."_$TR($J(RXR,4)," ","0")_"1"
213 ;
214 ; The background job
215TASK N X,Y,%DT
216 S X="N",%DT="ST"
217 D ^%DT,TASKAT(Y)
218 Q
219 ;
220TASKAT(ZTDTH) ;
221 N ZTIO S ZTIO="" ; no device
222 N ZTRTN S ZTRTN="BACKGR^BPSOSRB"
223 D ^%ZTLOAD
224 Q
Note: See TracBrowser for help on using the repository browser.