source: WorldVistAEHR/trunk/r/E_CLAIMS_MGMT_ENGINE-BPS/BPSSCRU3.m@ 1076

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

initial load of WorldVistAEHR

File size: 7.1 KB
Line 
1BPSSCRU3 ;BHAM ISC/SS - ECME SCREEN UTILITIES ;05-APR-05
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 ;USER SCREEN
5 Q
6 ;get comment from BPS TRANSACTION file
7 ;BP59 - ien in that file
8COMMENT(BP59) ;
9 N BPCMNT,BPX
10 S BPCMNT=$O(^BPST(BP59,11,999999),-1)
11 I BPCMNT="" Q ""
12 S BPX=$G(^BPST(BP59,11,BPCMNT,0))
13 Q $$DATTIM($P(BPX,U,1)\1)_" - "_$P(BPX,U,3)_U_$$USERNAM^BPSCMT01($P(BPX,U,2))
14 ;
15DATTIM(X) ;Convert FM date to displayable (mm/dd/yy HH:MM) format.
16 I +X=0 W ""
17 N DATE,YR,BPT,BPM,BPH,BPAP
18 I $G(X) S YR=$E(X,2,3)
19 I $G(X) S DATE=$S(X:$E(X,4,5)_"/"_$E(X,6,7)_"/"_YR,1:"")
20 S BPT=$P(X,".",2) S:$L(BPT)<4 BPT=BPT_$E("0000",1,4-$L(BPT))
21 S BPH=$E(BPT,1,2),BPM=$E(BPT,3,4)
22 S BPAP="a" I BPH>12 S BPH=BPH-12,BPAP="p" S:$L(BPH)<2 BPH="0"_BPH
23 I BPT S:'BPH BPH=12 S DATE=DATE_" "_BPH_":"_BPM_BPAP
24 Q $G(DATE)
25 ;/**
26 ;BP59 - ptr to 9002313.59
27 ;returns the string with none, one or more than one of the following:
28 ; PB - payable
29 ; RJ - rejected
30 ; RA - reversal accepted
31 ; RR
32 ; AR - autoreversal
33 ; SR - stranded
34 ; example: "^RV^AR"
35CLAIMST(BP59,BPDESRC) ;*/
36 N BPX,BPRET,BPSTATUS
37 S BPRET="^"
38 S BPX=$$RXREF^BPSSCRU2(BP59)
39 S BPSTATUS=$$STATUS^BPSOSRX(+BPX,$P(BPX,U,2))
40 Q $P(BPSTATUS,U,1,3)
41 ;Q $P(BPSTATUS,U,1)_U_$P(BPSTATUS,U,2)_U_$P(BPSTATUS,U,3)
42 ;/**
43 ;BP59 - ptr to 9002313.59
44 ;returns the string with none, one or more tha one of the following:
45 ; PB - payable
46 ; RJ - rejected
47 ; RV - reversal
48 ; AR - autoreversal
49 ; SR - stranded
50 ; example: "^RV^AR"
51CLAIMST2(BP59) ;*/
52 N BPX,BPRET,BPSTATUS
53 S BPRET="^"
54 S BPX=$$RXREF^BPSSCRU2(BP59)
55 S BPSTATUS=$$STATUS^BPSOSRX(+BPX,$P(BPX,U,2))
56 I BPSTATUS["E REVERSAL" S BPRET=BPRET_"RV^"
57 I BPSTATUS["E PAYABLE" S BPRET=BPRET_"PB^"
58 I BPSTATUS["E REJECTED" S BPRET=BPRET_"RJ^"
59 I BPSTATUS["E STRANDED" S BPRET=BPRET_"SR^"
60 I BPSTATUS["E REVERSAL STRANDED" S BPRET=BPRET_"SR^"
61 Q BPRET
62 ;/**
63 ;pointers for RESPONSE file (#9002313.03) by pointer in TRANSACTION file #9002313.59
64 ;B59 - ptr to #9002313.59
65 ;BPRESP - ptr to #9002313.03
66 ;BPPOS - position inside #9002313.03 (i.e. the number
67 ;of the claim in the transmission - currently we always have only 1
68GRESPPOS(BP59,BPRESP,BPPOS) ;*/
69 I $G(^BPST(BP59,4)) D ; reversal kind of message
70 . S BPRESP=+$P(^BPST(BP59,4),U,2)
71 . S BPPOS=1
72 E D
73 . S BPRESP=+$P($G(^BPST(BP59,0)),U,5)
74 . S BPPOS=+$P($G(^BPST(BP59,0)),U,9)
75 Q:+BPRESP=0 0
76 Q:+BPPOS=0 0
77 Q 1
78 ;
79 ;/**
80 ;reject message from RESPONSE file
81 ;BP59 - ptr to 9002313.59
82 ;BPTOP - top level index (for exmpl "504" for ^BPSR(D0,504)= (#504) Message [1F]
83 ;BPDEEP - lower level (for exmpl BPTOP=1000 and BPDEEP=525 for
84 ; ^BPSR(D0,1000,D1,525)= (#525) DUR Response Data [1F]
85 ;
86GETMESS(BPTOP,BPDEEP,BP59) ;
87 N BP59DAT,BPRESP,BPPOS
88 N BP1
89 ;S (BPRESP,BPPOS)=0
90 ;get response and position in the BPS RESPONSE file
91 I $$GRESPPOS(BP59,.BPRESP,.BPPOS)=0 Q ""
92 ; -------- transmission specific message ----------
93 I BPTOP=504 Q $P($G(^BPSR(BPRESP,504)),U)
94 ;
95 ; -------claim specific message-----------
96 ;assuming there is only one claim/response per transmission
97 S BP1=$O(^BPSR(BPRESP,BPTOP,0))
98 I BP1=0 Q ""
99 ;---525: DUR
100 ;---526: Additional Message Information
101 ;---504: Message for the claim
102 I (BPDEEP=525)!(BPDEEP=526)!(BPDEEP=504) Q $P($G(^BPSR(BPRESP,1000,BPPOS,BPDEEP)),U)
103 Q ""
104 ;
105 ;reject message from RESPONSE file
106 ;BP59 - ptr to 9002313.59
107 ;BPARR1 - array to return messages (by ref)
108 ;BPN1 - index for the array (by ref - will
109 ; be incremented if more than one node added)
110 ;BPMLEN - max length for each string
111 ;PBPREF - for prefix string
112 ;. D GETMESS^BPSSCRU3(1000,504,BP59,.BPARR,.BPN,50)
113 ;compare GETRJCOD from BPSSCRu2
114GETRJCOD(BP59,BPARR1,BPN1,BPMLEN,PBPREF) ;
115 N BP59DAT S BP59DAT=$G(^BPST(BP59,0))
116 N BPRESP,BPPOS
117 N BPRJCOD
118 N BPRJTXT
119 N BPSTR
120 N BPRJ
121 ;pointers for RESPONSE file (#9002313.03) by pointer in TRANSACTION file #9002313.59
122 ;get response and position
123 I $$GRESPPOS(BP59,.BPRESP,.BPPOS)=0 Q
124 S BPRJ=0
125 S BPSTR=""
126 F S BPRJ=$O(^BPSR(BPRESP,1000,BPPOS,511,BPRJ)) Q:+BPRJ=0 D
127 . S BPRJCOD=$P($G(^BPSR(BPRESP,1000,BPPOS,511,BPRJ,0)),U)
128 . Q:$L(BPRJCOD)=0
129 . S BPRJTXT=$$GETRJNAM(BPRJCOD)
130 . S BPN1=BPN1+1,BPARR1(BPN1)=PBPREF_BPRJTXT
131 Q BPN1
132 ;/**
133 ;Input:
134 ; BP59 - pointer to file #9002313.59
135 ;Output:
136 ; BPRCODES - array for reject codes by reference
137REJCODES(BP59,BPRCODES) ;get reject codes
138 N BPRESP,BPPOS,BPA,BPR
139 ;pointers for RESPONSE file (#9002313.03) by pointer in TRANSACTION file #9002313.59
140 ;get response and position
141 I $$GRESPPOS(BP59,.BPRESP,.BPPOS)=0 Q
142 ;
143 S BPA=0
144 F S BPA=$O(^BPSR(BPRESP,1000,BPPOS,511,BPA)) Q:'BPA D
145 . S BPR=$P(^BPSR(BPRESP,1000,BPPOS,511,BPA,0),U)
146 . I BPR'="" S BPRCODES(BPR)=""
147 Q
148 ;/**
149 ;BPRJCODE - code
150GETRJNAM(BPRJCODE) ;*/
151 N BPRJIEN
152 S BPRJIEN=$O(^BPSF(9002313.93,"B",BPRJCODE,0))
153 Q:+BPRJIEN=0 ""
154 Q BPRJCODE_":"_$P($G(^BPSF(9002313.93,BPRJIEN,0)),U,2)
155 ;/**
156 ;BP59 - ptr to 9002313.59
157 ;was the claim ever autoreversed ?
158AUTOREV(BP59) ;*/
159 N BP02
160 S BP02=+$P($G(^BPST(BP59,0)),U,4)
161 Q +$P($G(^BPSC(BP02,0)),U,7)
162 ;
163 ;/**
164 ;BP59 - ptr to 9002313.59
165 ;returns :
166 ;0 Waiting to start
167 ;10 Gathering claim info
168 ;19 Special Grouping
169 ;30 Waiting for packet build
170 ;31 Wait for retry (insurer asleep)
171 ;40 Packet being built
172 ;50 Waiting for transmit
173 ;51 Wait for retry (comms error)
174 ;60 Transmitting
175 ;70 Receiving Response
176 ;80 Waiting to process response
177 ;90 Processing response
178 ;99 Done
179 ;
180PRCNTG(BP59) ;*/
181 Q +$P($G(^BPST(BP59,0)),U,2)
182 ;
183 ;
184LINE(BPN,BPCH) ;
185 N BP1
186 S $P(BP1,BPCH,BPN+1)=""
187 Q BP1
188 ;
189DTTIME(X) ;Convert FM date to displayable (mm/dd/yy HH:MM) format.
190 I +X=0 W ""
191 N DATE,YR,BPT,BPM,BPH,BPAP,BPS
192 I $G(X) S YR=$E(X,1,3)+1700
193 I $G(X) S DATE=$S(X:$E(X,4,5)_"/"_$E(X,6,7)_"/"_YR,1:"")
194 S BPT=$P(X,".",2)
195 I BPT S:$L(BPT)<6 BPT=BPT_$E("000000",1,6-$L(BPT))
196 S BPH=$E(BPT,1,2),BPM=$E(BPT,3,4),BPS=$E(BPT,5,6)
197 I BPT S DATE=DATE_"@"_BPH_":"_BPM_":"_BPS
198 Q $G(DATE)
199 ;
200 ;call IB API to get insurance data, then select proper insurance by its name
201 ;get its phone number
202 ;input:
203 ; DFN - patient IEN in #2
204 ; BPDOS - date of service
205 ; BPINSNM - insurance name
206 ;output: insurance ien^insurance name^phone
207GETPHONE(BPDFN,BPDOS,BPINSNM) ;
208 N BPX,BPZZ,BP1,BPPHONE
209 S BPPHONE=""
210 I $$INSUR^IBBAPI(BPDFN,BPDOS,,.BPZZ,"1,6")'=1 Q ""
211 S BP1="" F S BP1=$O(BPZZ("IBBAPI","INSUR",BP1)) Q:+BP1=0 D
212 . I BPINSNM=$P($G(BPZZ("IBBAPI","INSUR",BP1,1)),U,2) S BPPHONE=$G(BPZZ("IBBAPI","INSUR",BP1,6)) Q
213 Q BPPHONE
214 ;
215 ;try to get insurance name and phone from #9002313.59, #9002313.57 and from INSUR^IBBAPI
216 ;input: BP59 - ien in #9002313.59
217 ;return insurance_name^phone#
218NAMEPHON(BP59) ;
219 N BPHONE,BPINSNM,BPINSID,BP57,BPINSN
220 S BPHONE=$P($G(^BPST(BP59,10,+$G(^BPST(BP59,9)),3)),U,2)
221 S BPINSNM=$P($G(^BPST(BP59,10,+$G(^BPST(BP59,9)),0)),U,7)
222 S BP57=0
223 F Q:(BPHONE'="")&(BPINSNM'="") S BP57=$O(^BPSTL("B",BP59,BP57)) Q:+BP57=0 D
224 . S BPINSN=+$G(^BPSTL(BP57,9))
225 . S:BPHONE="" BPHONE=$P($G(^BPSTL(BP57,10,BPINSN,3)),U,2)
226 . S:BPINSNM="" BPINSNM=$P($G(^BPSTL(BP57,10,BPINSN,0)),U,7)
227 ;
228 I (BPINSNM'="")&(BPHONE="") D
229 . S BPDOS=+$P($G(^BPST(BP59,12)),U,2)\1
230 . I BPDOS=0 S BPDOS=+$P($G(^BPST(BP59,0)),U,8)\1
231 . S BPDFN=+$P($G(^BPST(BP59,0)),U,6)
232 . S BPHONE=$$GETPHONE(BPDFN,BPDOS,BPINSNM)
233 Q BPINSNM_U_BPHONE
234 ;
Note: See TracBrowser for help on using the repository browser.