source: FOIAVistA/trunk/r/E_CLAIMS_MGMT_ENGINE-BPS/BPSSCR04.m@ 1444

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

initial load of FOIAVistA 6/30/08 version
File size: 9.0 KB
Line 
1BPSSCR04 ;BHAM ISC/SS - USER SCREEN ;14-FEB-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 ;input:
7 ;BPTMP - TMP global to store data (example : $NA(^TMP($J,"BPSSCR")))
8 ;BPARR - array with user profile information
9COLLECT(BPTMP,BPARR) ;
10 N BPBDT,BPEDT,BPSORT
11 S BPBDT=BPARR("BDT") ;start date
12 S BPEDT=BPARR("EDT") ;end date
13 ;sort type - see SORTIT()
14 S BPSORT=$G(BPARR(1.12))
15 S:BPSORT="" BPSORT="T" ;default
16 ;kill TMP
17 ;look for claims in 3 files
18 ;temporary TMP file
19 N BPTMP1 S BPTMP1=$NA(@BPTMP@("PRE59"))
20 N BPTMP2 S BPTMP2=$NA(@BPTMP@("FILE59"))
21 K @BPTMP1
22 K @BPTMP2
23 ;
24 D LOOK02(BPBDT,BPEDT,BPTMP1,BPSORT)
25 D LOOK57(BPBDT,BPEDT,BPTMP1,BPSORT)
26 D LOOK59(BPBDT,BPEDT,BPTMP1,BPSORT)
27 ;remove all claims that don't match filter criteria
28 D FILTRALL^BPSSCR03(BPTMP1,BPTMP2,.BPARR)
29 ;preliminary sorting for "T" sorting type
30 I BPSORT="T" D TRDFNALL^BPSSCR03(BPTMP)
31 ;final sorting
32 D SORTIT(BPTMP,BPSORT)
33 K @BPTMP1
34 K @BPTMP2
35 Q
36 ;Input:
37 ;BPTMP - TMP global to store data (example : $NA(^TMP($J,"BPSSCR")))
38 ;BPSORT:
39 ;'T' FOR TRANSACTION DATE
40 ;'D' FOR DIVISION (ECME pharmacy)
41 ;'I' FOR INSURANCE
42 ;'C' FOR REJECT CODE
43 ;'P' FOR PATIENT NAME
44 ;'N' FOR DRUG NAME
45 ;'B' FOR BILL TYPE (BB/RT)
46 ;'L' FOR FILL LOCATION (Windows/Mail/CMOP)
47 ;'R' FOR RELEASED/NON-RELEASED RX
48 ;'A' FOR ACTIVE/DISCONTINUED RX
49 ;sort it and prepare the TMP for the user screen
50SORTIT(BPTMP,BPSORT) ;*/
51 ;S BP59=+$G(^TMP($J,"BPSSCR","SRT",BPSRT))
52 ;BPSORT:
53 ;TRANSACTION DATE - the last time when the record
54 ;in the file #9002313.59 -- BPS TRANSACTION FILE has been updated
55 ;F S X=$O(@BPTMP@("SRT",BPSRT))
56 K @BPTMP@("SORT")
57 N BPSRTVAL,BPTRDT,BP59,BPDFN,BPIEN,BPIENNM
58 S BP59=0
59 ;by transaction date -- sort by the patient/insurance combinations,
60 ;which might have more than one claims.
61 ;- the first on the top will be the one which has the claim(s) with the
62 ; most recent date (other claims in this group can have any other date)
63 I BPSORT="T" D
64 . D MKPATINS(BPTMP) ;1st step
65 . D MKTRSORT(BPTMP) ;2nd step
66 ;by patient name (and his/her insurances)
67 I BPSORT="P" D
68 . D MKNAMINS(BPTMP) ;1st step
69 . D MKPTSORT(BPTMP) ;2nd step
70 ;by insurance
71 ;(the name will be shortened up to 10 chars and its
72 ;IEN is added to make the string unique)
73 I BPSORT="I" D
74 . F S BP59=$O(@BPTMP@("FILE59",BP59)) Q:+BP59=0 D
75 . . S BPIEN=$$GETINSUR^BPSSCRU2(+BP59)
76 . . S BPIENNM=$S(+BPIEN>0:$E($P(BPIEN,U,2),1,10)_U_(+BPIEN),1:"0")
77 . . D SETSORT(BPTMP,BPSORT,BPIENNM,BP59)
78 ;by division
79 ;(the name will be shortened up to 10 chars and its
80 ;IEN is added to make the string unique)
81 I BPSORT="D" D
82 . F S BP59=$O(@BPTMP@("FILE59",BP59)) Q:+BP59=0 D
83 . . S BPIEN=+$$DIVIS^BPSSCRU2(+BP59)
84 . . S BPIENNM=$S(BPIEN>0:$E($$DIVNAME^BPSSCRDS(BPIEN),1,10)_U_(BPIEN),1:"0")
85 . . D SETSORT(BPTMP,BPSORT,BPIENNM,BP59)
86 ;by reject code
87 ;the same claim can be listed more than once (under different reject code
88 ;sections) because each claim may have more than one reject code.
89 I BPSORT="C" D
90 . F S BP59=$O(@BPTMP@("FILE59",BP59)) Q:+BP59=0 D
91 . . N BPRJCDS,BPRJ
92 . . D REJCODES^BPSSCRU3(+BP59,.BPRJCDS)
93 . . S BPRJ=""
94 . . F S BPRJ=$O(BPRJCDS(BPRJ)) Q:BPRJ="" D
95 . . . D SETSORT(BPTMP,BPSORT,BPRJ,BP59)
96 ;by drug names
97 ;(the name will be shortened upto 10 chars and its
98 ;IEN is added to make the string unique)
99 I BPSORT="N" D
100 . F S BP59=$O(@BPTMP@("FILE59",BP59)) Q:+BP59=0 D
101 . . S BPIEN=+$$GETDRG59^BPSSCRU2(+BP59)
102 . . S BPIENNM=$S(BPIEN>0:$E($$DRGNAM^BPSSCRU2(BPIEN),1,10)_U_(BPIEN),1:"0")
103 . . D SETSORT(BPTMP,BPSORT,BPIENNM,BP59)
104 ;by claim origination type (BB- backbilling, RT- realtime)
105 I BPSORT="B" D
106 . F S BP59=$O(@BPTMP@("FILE59",BP59)) Q:+BP59=0 D
107 . . D SETSORT(BPTMP,BPSORT,$$RTBB^BPSSCRU2(+BP59),BP59)
108 ;by filling location
109 ;M-MAIL/W-WINDOW/C-CMOP
110 I BPSORT="L" D
111 . F S BP59=$O(@BPTMP@("FILE59",BP59)) Q:+BP59=0 D
112 . . D SETSORT(BPTMP,BPSORT,$$MWCNAME^BPSSCRU2($$GETMWC^BPSSCRU2(+BP59)),BP59)
113 ;by released (1) /non released (0)
114 I BPSORT="R" D
115 . F S BP59=$O(@BPTMP@("FILE59",BP59)) Q:+BP59=0 D
116 . . D SETSORT(BPTMP,BPSORT,$$ISRXREL^BPSSCRU2(+BP59),BP59)
117 ;by status of the fill ACT-active/DIS-discontinued/SUS-suspended/etc
118 I BPSORT="A" D
119 . F S BP59=$O(@BPTMP@("FILE59",BP59)) Q:+BP59=0 D
120 . . D SETSORT(BPTMP,BPSORT,$$RXST^BPSSCRU2(+BP59),BP59)
121 ;
122 ;K @BPTMP@("FILE59")
123 Q
124 ;set SORT node
125SETSORT(BPTMP,BPSORT,BPSRTVAL,BP59) ;*/
126 S:$L(BPSRTVAL)>0 @BPTMP@("SORT",BPSORT,BPSRTVAL,BP59)=""
127 Q
128 ;first look at ^BPSC (#9002313.02) for fill/refill x-ref
129 ; since #9002313.57 is not created at the time of refill
130 ; and since #9002313.59 has the last update date, which can be any kind of date (released/reversal/etc)
131 ;BPBEGDT - start date
132 ;BPENDDT - end date
133 ;BPTMP - tmp global for items found
134 ;BPSORT - sort type (see COLLECT^BPSSCR04)
135LOOK02(BPBEGDT,BPENDDT,BPTMP,BPSORT) ;
136 N BP02,BPENDDT1,BPLDT02,BP59
137 S BP59=0
138 S BPLDT02=$$FM2YMD(BPBEGDT-0.00001)
139 S BPENDDT1=$$FM2YMD(BPENDDT)
140 I BPLDT02="" S BPLDT02=0
141 I BPENDDT1="" S BPENDDT1=99999999
142 F S BPLDT02=+$O(^BPSC("AF",BPLDT02)) Q:BPLDT02=0!(BPLDT02>BPENDDT1) D
143 . S BP02=0 F S BP02=$O(^BPSC("AF",BPLDT02,BP02)) Q:+BP02=0 D
144 . . S BP59=+$O(^BPST("AE",BP02,0))
145 . . Q:BP59=0
146 . . I $D(@BPTMP@(BP59)) Q
147 . . S @BPTMP@(BP59)=$$YMD2FM(BPLDT02)_"^02"
148 Q
149 ; finds claims in #9002313.57 for given date frame
150 ;#9002313.59 has only one entry per claim with, which has a date
151 ; of the latest update for the claim
152 ;#9002313.57 has more than one entries per claim and keep all
153 ; changes made the claim
154 ;so we have to go thru #9002313.57 to find the earliest date
155 ;related to the claim to check it against BPBEGDT
156 ;BPBEGDT - start date
157 ;BPENDDT - end date
158 ;BPTMP - tmp global for items found
159 ;BPSORT - sort type (see COLLECT^BPSSCR04)
160LOOK57(BPBEGDT,BPENDDT,BPTMP,BPSORT) ;
161 N BPLDT57,BP57,BP59
162 S BPLDT57=BPBEGDT-0.00001
163 F S BPLDT57=+$O(^BPSTL("AH",BPLDT57)) Q:BPLDT57=0!(BPLDT57>BPENDDT) D
164 . S BP57=0 F S BP57=$O(^BPSTL("AH",BPLDT57,BP57)) Q:+BP57=0 D
165 . . S BP59=+$G(^BPSTL(BP57,0))
166 . . I $D(@BPTMP@(BP59)) Q ;don't create an entry if the claim is already there
167 . . S @BPTMP@(BP59)=(BPLDT57\1)_"^57-"
168 Q
169 ; finds claims in #9002313.59 for given date frame
170 ;#9002313.59 has only one entry per claim with, which has a date
171 ; of the latest update for the claim
172 ;#9002313.57 has more than one entries per claim and keep all
173 ; changes made the claim
174 ;so we have to go thru #9002313.57 to find the earliest date
175 ;related to the claim to check it against BPBEGDT
176 ;BPBEGDT - start date
177 ;BPENDDT - end date
178 ;BPTMP - tmp global for items found
179 ;BPSORT - sort type (see COLLECT^BPSSCR04)
180LOOK59(BPBEGDT,BPENDDT,BPTMP,BPSORT) ;
181 N BPLDT59,BP59
182 S BPLDT59=BPBEGDT-0.00001
183 F S BPLDT59=+$O(^BPST("AH",BPLDT59)) Q:BPLDT59=0!(BPLDT59>BPENDDT) D
184 . S BP59=0 F S BP59=$O(^BPST("AH",BPLDT59,BP59)) Q:+BP59=0 D
185 . . I $D(@BPTMP@(BP59)) Q ;don't create an entry if the claim is already there
186 . . S @BPTMP@(BP59)=(BPLDT59\1)_"^59-"
187 Q
188 ;
189YMD2FM(BPYMD) ;convert YYYYDDMM to FM date
190 Q (($E(BPYMD,1,4))-1700)_$E(BPYMD,5,8)
191 ;
192FM2YMD(BPFMDT) ;convert FM date to YYYYMMDD
193 N Y,Y1
194 S Y=$E(BPFMDT,2,3),Y1=$E(BPFMDT,1,1) S Y=$S(Y1=3:"20"_Y,Y1=2:"19"_Y,1:"")
195 Q:Y Y_$E(BPFMDT,4,7)
196 Q ""
197 ;make PATIENT -INSURANCE intermediate SORTING
198 ;global for transaction and patient sortings (1st pass)
199 ;example:
200 ;@BPTMP@("SORT","PI",BPDFN,BPINS,BP59)=""
201MKPATINS(BPTMP) ;
202 N BPSRTVAL,BPTRDT,BP59,BPDFN,BPINS
203 S BP59=0
204 F S BP59=+$O(@BPTMP@("FILE59",BP59)) Q:+BP59=0 D
205 . S BPDFN=+$$GETPATID^BPSSCRU2(BP59)
206 . Q:BPDFN=0
207 . S BPINS=+$$GETINSUR^BPSSCRU2(BP59)
208 . S @BPTMP@("SORT","PI",BPDFN,BPINS,BP59)=""
209 Q
210 ;make PATIENT NAME -INSURANCE intermediate SORTING
211 ;global for transaction and patient sortings (1st pass)
212 ;example:
213 ;@BPTMP@("SORT","PNI",BPDFN,BPINS,BP59)=""
214MKNAMINS(BPTMP) ;
215 N BPSRTVAL,BPTRDT,BP59,BPDFN,BPINS
216 S BP59=0
217 F S BP59=+$O(@BPTMP@("FILE59",BP59)) Q:+BP59=0 D
218 . S BPDFN=+$$GETPATID^BPSSCRU2(BP59)
219 . Q:BPDFN=0
220 . S BPINS=+$$GETINSUR^BPSSCRU2(BP59)
221 . S @BPTMP@("SORT","PNI",$E($$PATNAME^BPSSCRU2(BPDFN),1,20)_BPDFN,BPINS,BP59)=""
222 Q
223 ;Transaction type sorting - the 2nd pass
224 ;is called after MKPATINS
225MKTRSORT(BPTMP) ;
226 N BPSRTVAL,BPTRDT,BP59,BPDFN,BPINS
227 S BPTRDT=-99999999,BPSRTVAL=0
228 F S BPTRDT=$O(@BPTMP@("TRDTDFN",BPTRDT)) Q:+BPTRDT=0 D
229 . S BPDFN=0
230 . F S BPDFN=$O(@BPTMP@("TRDTDFN",BPTRDT,BPDFN)) Q:+BPDFN=0 D
231 . . S BPINS=""
232 . . F S BPINS=$O(@BPTMP@("TRDTDFN",BPTRDT,BPDFN,BPINS)) Q:BPINS="" D
233 . . . S BPSRTVAL=BPSRTVAL+1,BPINS=+BPINS
234 . . . S BP59=0
235 . . . F S BP59=$O(@BPTMP@("SORT","PI",BPDFN,BPINS,BP59)) Q:+BP59=0 D
236 . . . . D SETSORT(BPTMP,"T",BPSRTVAL,BP59)
237 Q
238 ;Patient type sorting - the 2nd pass
239 ;is called after MKPATINS
240MKPTSORT(BPTMP) ;
241 N BPSRTVAL,BPTRDT,BP59,BPPATNAM,BPINS
242 S BPPATNAM="",BPSRTVAL=0
243 F S BPPATNAM=$O(@BPTMP@("SORT","PNI",BPPATNAM)) Q:BPPATNAM="" D
244 . S BPINS="" ;"" to handle claims without insurance (corrupted data)
245 . F S BPINS=$O(@BPTMP@("SORT","PNI",BPPATNAM,BPINS)) Q:BPINS="" D
246 . . S BPSRTVAL=BPSRTVAL+1,BPINS=+BPINS
247 . . S BP59=0
248 . . F S BP59=$O(@BPTMP@("SORT","PNI",BPPATNAM,BPINS,BP59)) Q:+BP59=0 D
249 . . . D SETSORT(BPTMP,"P",BPSRTVAL,BP59)
250 Q
251 ;
Note: See TracBrowser for help on using the repository browser.