source: FOIAVistA/tag/r/E_CLAIMS_MGMT_ENGINE-BPS/BPSSCR03.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: 8.4 KB
Line 
1BPSSCR03 ;BHAM ISC/SS - ECME USR 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 Q
5 ;/**
6 ;BP59 - ptr to 9002313.59
7 ; BPARR to return formatted info via ref
8 ; BPMLEM - max len for each line
9 ; BPMODE - mode
10 ; R -regular for main screen, will show only latest comment
11 ; C - comment mode - show all comments
12ADDINF(BP59,BPARR,BPMLEN,BPMODE) ;to return additional information about the claim*/
13 N BPX,BPN,BPTXT1,BPTXT2,BPTXT3,BPTXT4,BPX1,BPPRCNTG,BPN2,BPSTATUS
14 S BPN=0,(BPTXT1,BPTXT2,BPTXT3,BPTXT4,BPX1)=""
15 I BPMODE="R" D
16 . S BPX=$$COMMENT^BPSSCRU3(BP59)
17 . I $L(BPX)>0 S BPN=BPN+1,BPARR(BPN)=$P(BPX,U)
18 . I $P(BPX,U,2)]"" S BPN=BPN+1,BPARR(BPN)="("_$P(BPX,U,2)_")"
19 E D
20 . N BPCMNT,BPX1 S BPCMNT=99999999
21 . F S BPCMNT=$O(^BPST(BP59,11,BPCMNT),-1) Q:+BPCMNT=0 D
22 . . S BPX1=$G(^BPST(BP59,11,BPCMNT,0))
23 . . I BPX1="" Q
24 . . S BPX=$$DATTIM^BPSSCRU3($P(BPX1,U,1)\1)_" - "_$P(BPX1,U,3)
25 . . I $L(BPX)>0 S BPN=BPN+1,BPARR(BPN)=BPX
26 . . I +$P(BPX1,U,2)]"" D
27 . . . S BPX=$$USERNAM^BPSCMT01(+$P(BPX1,U,2))
28 . . . I BPX'="" S BPX="("_BPX_")",BPN=BPN+1,BPARR(BPN)=BPX
29 S BPX=$$CLAIMST^BPSSCRU3(BP59)
30 S BPSTATUS=$P(BPX,U)
31 S BPPRCNTG=$$LJ^BPSSCR02("("_$$PRCNTG^BPSSCRU3(BP59)_"%) ",6)
32 ;I BPX["AR" S BPARR(BPN)="Auto-Reversal",BPN=BPN+1
33 I BPSTATUS["E REVERSAL ACCEPTED" S BPTXT1=BPTXT1_"Reversal accepted "
34 I BPSTATUS["E REVERSAL REJECTED" S BPTXT1=BPTXT1_"Reversal rejected "
35 I BPSTATUS["E PAYABLE" S BPTXT1=BPTXT1_"Payable "
36 I BPSTATUS["E REJECTED" S BPTXT1=BPTXT1_"Rejected "
37 I BPSTATUS["E STRANDED" S BPTXT1=BPTXT1_"Stranded "
38 I BPSTATUS["E REVERSAL STRANDED" S BPTXT1=BPTXT1_"Stranded reversal"
39 I BPSTATUS["E CAPTURED" S BPTXT1=BPTXT1_"Captured "
40 I BPSTATUS["E DUPLICATE" S BPTXT1=BPTXT1_"Duplicate "
41 I BPSTATUS["E OTHER" S BPTXT1=BPTXT1_"Other "
42 I BPSTATUS["IN PROGRESS" S BPTXT1=BPTXT1_"In progress "
43 I BPSTATUS["CORRUPT" S BPTXT1=BPTXT1_"Corrupt "
44 I BPSTATUS["E REVERSAL OTHER" S BPTXT1=BPTXT1_"Reversal Other "
45 I BPTXT1="" S BPTXT1="Unknown status "
46 ;
47 I (BPSTATUS["E REJECTED")!(BPSTATUS["E REVERSAL REJECTED") D
48 . I $L(BPTXT1)>0 S BPN=BPN+1,BPARR(BPN)=BPTXT1
49 . S BPTXT1=""
50 . S BPN2=BPN
51 . D GETRJCOD^BPSSCRU3(BP59,.BPARR,.BPN,74,"")
52 . D WRAPLN2^BPSSCRU5(.BPN,.BPARR,$$GETMESS^BPSSCRU3(1000,504,BP59),74,"",0)
53 . D WRAPLN2^BPSSCRU5(.BPN,.BPARR,$$GETMESS^BPSSCRU3(1000,526,BP59),74,"",0)
54 . D WRAPLN2^BPSSCRU5(.BPN,.BPARR,$$GETMESS^BPSSCRU3(504,0,BP59),74,"",0)
55 . I BPN>BPN2 Q ;reject codes are enough
56 . ;S BPX1=$P($P(BPX,U,3),"[") I BPTXT1=BPX1 S BPX1=""
57 . S:BPX1="" BPX1=$$GETMESS^BPSSCRU3(504,0,BP59)
58 . I $L(BPX1)>0 S BPTXT1=BPTXT1_"- "_$TR(BPX1,"]","")
59 ;
60 I (BPSTATUS["E OTHER")!(BPSTATUS["IN PROGRESS")!(BPSTATUS["E STRANDED")!(BPSTATUS["E CAPTURED")!(BPSTATUS["E REVERSAL STRANDED") D
61 . I (BPSTATUS["E OTHER")!(BPSTATUS["IN PROGRESS") S BPX1=$P(BPX,U,3) I BPTXT1=BPX1 S BPX1=""
62 . S:BPX1="" BPX1=$$GETMESS^BPSSCRU3(504,0,BP59)
63 . I $L(BPX1)>0 S BPTXT1=BPTXT1_"- "_$TR(BPX1,"]","")
64 ;
65 S BPTXT2=$E(BPTXT1,1,BPMLEN)
66 S BPTXT3=$E(BPTXT1,BPMLEN+1,2*BPMLEN)
67 S BPTXT4=$E(BPTXT1,(2*BPMLEN)+1,3*BPMLEN)
68 I $L(BPTXT2)>0 S BPN=BPN+1,BPARR(BPN)=BPTXT2
69 I $L(BPTXT3)>0 S BPN=BPN+1,BPARR(BPN)=BPTXT3
70 I $L(BPTXT4)>0 S BPN=BPN+1,BPARR(BPN)=BPTXT4
71 Q BPN
72 ;
73CLMINF(BP59) ;ptr to #9002313.59
74 W !,"Claim info. Press a key"
75 D PAUSE^VALM1
76 Q
77 ;
78 ;
79COMM(BP59) ;ptr to #9002313.59
80 W !,"the latest comment. Press a key"
81 D PAUSE^VALM1
82 Q
83 ;
84RESP(BP59) ;Payer Response Information
85 W !,"payer Response Information. Press a key"
86 D PAUSE^VALM1
87 Q
88 ;
89 ;/**
90 ;Checks if the CLAIM for specific Transaction is CLOSED?
91 ;BPCLAIM - ptr to #9002313.02
92 ;see also CLOSED^BPSSCRU1
93CLOSED02(BPCLAIM) ;*/
94 ; get closed status
95 Q +$P($G(^BPSC(BPCLAIM,900)),U)=1 ;Q $$GET1^DIQ(9002313.02,CLAIM,901,"I")
96 ;
97 ;return:
98 ; 1 - okay. matches criteria
99 ; 0- not okay, doesn't match criteria
100FILTER(BP59,BPARR) ;
101 N BPST0,BPST1,BPRXREF,BPRX52,BPREFNUM
102 N BPRET
103 S BPRET=1 ;1 - okay bt default
104 S BPST0=$G(^BPST(BP59,0))
105 S BPST1=$G(^BPST(BP59,1))
106 S BPRXREF=$$RXREF^BPSSCRU2(BP59)
107 S BPRX52=+$P(BPRXREF,U) ;ptr to #52
108 S BPREFNUM=$P(BPRXREF,U,2) ;refill #
109 ;if closed
110 I $$CLOSED02(+$P(BPST0,U,4)) Q 0
111 ;user
112 I $G(BPARR(1.01))="U",$$FLTUSR(BPST0,.BPARR)=0 Q 0
113 ;patient
114 I $G(BPARR(1.02))="P",$$FLTPAT(BPST0,.BPARR)=0 Q 0
115 ;RX
116 I $G(BPARR(1.03))="R",$$FLTRX(BPST1,.BPARR)=0 Q 0
117 ;only rejected
118 I $G(BPARR(1.06))="R",$$REJECTED^BPSSCR02(BP59)=0 Q 0
119 ;only payable
120 I $G(BPARR(1.06))="P",$$PAYABLE^BPSSCR02(BP59)=0 Q 0
121 ;released
122 I $G(BPARR(1.07))="R",$$RL^BPSSCRU2(BP59)'="RL" Q 0
123 ;non released
124 I $G(BPARR(1.07))="N",$$RL^BPSSCRU2(BP59)="RL" Q 0
125 ;window/cmop/mail
126 I $G(BPARR(1.08))'="A",$$ISMWC(BPRX52,BPREFNUM,$G(BPARR(1.08)))=0 Q 0
127 ;Back billing
128 I $G(BPARR(1.09))="B",$$RTBB^BPSSCRU2(BP59)'="BB" Q 0
129 ;real time
130 I $G(BPARR(1.09))="R",$$RTBB^BPSSCRU2(BP59)="BB" Q 0
131 ;if only rejected and only specific rejected codes should be displayed
132 I $G(BPARR(1.06))="R",$G(BPARR(1.1))="R",$$FLTREJ(BP59,.BPARR)=0 Q 0
133 ;insurance
134 I $G(BPARR(1.11))="I",$G(BPARR(1.14))'="",$P($$GETINSUR^BPSSCRU2(+BP59),U,2)'=$G(BPARR(1.14)) Q 0
135 ;divisions - ECME pharmacies
136 I $G(BPARR(1.13))="D",BPARR("DIVS")'[(";"_$P(BPST1,U,7)_";") Q 0
137 Q 1
138 ;
139 ;check user filter
140 ;input:
141 ;BPST0 - zero node of #9002313.59
142 ;BPARR array with user's preferences
143 ;returns :
144 ;1 -okay, leave in the list
145 ;0 -not okay, exclude from the list
146FLTUSR(BPST0,BPARR) ;
147 I $L($G(BPARR(1.16)))=0 Q 0
148 I $P(BPST0,U,10)'=$G(BPARR(1.16)) Q 0
149 Q 1
150 ;check patient filter
151 ;input:
152 ;BPST0 - zero node of #9002313.59
153 ;BPARR array with user's preferences
154 ;returns :
155 ;1 -okay, leave in the list
156 ;0 -not okay, exclude from the list
157FLTPAT(BPST0,BPARR) ;
158 I $L($G(BPARR(1.17)))=0 Q 0
159 I $P(BPST0,U,6)'=$G(BPARR(1.17)) Q 0
160 Q 1
161 ;check RX filter
162 ;input:
163 ;BPST1 - 1st node of #9002313.59
164 ;BPARR array with user's preferences
165 ;returns :
166 ;1 -okay, leave in the list
167 ;0 -not okay, exclude from the list
168FLTRX(BPST1,BPARR) ;
169 I $L($G(BPARR(1.18)))=0 Q 0
170 I $P(BPST1,U,11)'=$G(BPARR(1.18)) Q 0
171 Q 1
172 ;input:
173 ;BP59 - zero node of #9002313.59
174 ;BPARR array with user's preferences
175 ;returns :
176 ;1 -okay, leave in the list
177 ;0 -not okay, exclude from the list
178FLTREJ(BP59,BPARR) ;
179 N BPRCODES
180 N BPRJCD
181 S BPRJCD=$P($G(^BPSF(9002313.93,+$G(BPARR(1.15)),0)),U)
182 I $L(BPRJCD)=0 Q 0
183 D REJCODES^BPSSCRU3(BP59,.BPRCODES)
184 I $D(BPRCODES(BPRJCD)) Q 1
185 Q 0
186 ;check W(indow)/C(mop)/M(ail)
187 ;input:
188 ;BPRX52 - ptr to #52
189 ;BPREFNUM - refill #
190 ;BPMWC - given value from CMOP/MAIL/WINDOW instance 1.08 of BPS USRSCR parameters
191 ;returns :
192 ;1 -okay, leave in the list
193 ;0 -not okay, exclude from the list
194ISMWC(BPRX52,BPREFNUM,BPMWC) ;
195 I $$MWCNAME^BPSSCRU2($$MWC^BPSSCRU2(BPRX52,BPREFNUM))=BPMWC Q 1
196 Q 0
197 ;
198FILTRALL(BPTMP1,BPTMP2,BPARR) ;
199 N BP59
200 S BP59=0
201 F S BP59=+$O(@BPTMP1@(BP59)) Q:+BP59=0 D
202 . I $$FILTER(BP59,.BPARR) S @BPTMP2@(BP59)=""
203 Q
204 ;
205 ;go thru all FILE59 entries and run SETTRDFN for each of them
206 ;
207TRDFNALL(BPTMP) ;
208 N BP59
209 S BP59=0
210 F S BP59=+$O(@BPTMP@("FILE59",BP59)) Q:+BP59=0 D
211 . D SETTRDFN(BPTMP,BP59)
212 Q
213 ;
214 ;sorting for "TRANSACTION DATE" type is
215 ;actually sorting by patients , but patient should be sorted not in alphabetical order:
216 ;the first patient is the one which has the most recent transaction and so on
217 ;BPTMP - TMP global
218 ;BP59 - ptr to #9002313.59
219SETTRDFN(BPTMP,BP59) ;
220 ;the following stores the latest transaction date of the claims, which
221 ;was found for this particular combination of patient and insurance
222 ;@BPTMP@("DFN-TRDT",BPDFN,BPINSUR)=BPTRDT
223 ;the following stores the latest transaction date BPTRDT,patient BPDFN and
224 ;insurance BPINSUR to provide a proper order
225 ;@BPTMP@("TRDTDFN",BPTRDT,BPDFN,BPINSUR)=""
226 N BPZERO,BPTRDT,BPDFN,BPPREV,BPINSUR
227 S BPZERO=$G(^BPST(BP59,0)) ;
228 S BPTRDT=-$P(BPZERO,U,8) ;"transaction" date
229 S BPDFN=+$P(BPZERO,U,6) ;patient ptr to #2
230 S BPINSUR=+$$GETINSUR^BPSSCRU2(BP59) ;insurance ien
231 ;in the beginning we don't have any "DFN-TRDT" and "TRDTDFN"
232 ;so create them and quit
233 I '$D(@BPTMP@("DFN-TRDT",BPDFN,BPINSUR)) D Q
234 . S @BPTMP@("DFN-TRDT",BPDFN,BPINSUR)=BPTRDT
235 . S @BPTMP@("TRDTDFN",BPTRDT,BPDFN,BPINSUR)=""
236 ;if we already have them then get the latest into BPPREV
237 S BPPREV=+$G(@BPTMP@("DFN-TRDT",BPDFN,BPINSUR))
238 ;and compare it against the BPTRDT for this BP59
239 ;if the BPTRDT is greater then replace the values in "DFN-TRDT"
240 ;and "TRDTDFN"
241 I BPTRDT<BPPREV D
242 . S @BPTMP@("TRDTDFN",BPTRDT,BPDFN,BPINSUR)=""
243 . S @BPTMP@("DFN-TRDT",BPDFN,BPINSUR)=BPTRDT
244 . K @BPTMP@("TRDTDFN",BPPREV,BPDFN,BPINSUR)
245 Q
Note: See TracBrowser for help on using the repository browser.