source: WorldVistAEHR/trunk/r/E_CLAIMS_MGMT_ENGINE-BPS/BPSSCRU5.m@ 1211

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

initial load of WorldVistAEHR

File size: 7.9 KB
Line 
1BPSSCRU5 ;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 ;
7DATETIME(Y) ;EP - convert fileman date.time to printable
8 X ^DD("DD")
9 Q Y
10 ;
11 ;create a history of claims and responses in #9002313.57 file
12 ;record for the specified transaction in #9002313.59 file
13 ;input:
14 ; BP59 - ptr to #9002313.59
15 ; BPHIST - array to return results
16 ;output:
17 ; Array in BPHIST with the format:
18 ; BPHIST(type,timedate,PointerToResponseClaimFile)=PointerTo#9002313.57
19 ; where:
20 ; type "C" - BPS CLAIM file, "R" - BPS RESPONSE file
21 ; PointerToResponseClaimFile - pointer to 9002313.03 or 9002313.02
22MKHIST(BP59,BPHIST) ;
23 N BP57,BPLSTCLM,BPLSTRSP,BPDAT57,BP1,BPSSTDT
24 S BP57=0
25 N BPSARR02
26 N BPSARR03
27 ; -- process BPS LOG OF TRANSACTIONS file
28 F S BP57=$O(^BPSTL("B",BP59,BP57)) Q:+BP57=0 D
29 . ;claim transmissions
30 . S BPDAT57(0)=$G(^BPSTL(BP57,0))
31 . S BPSSTDT=+$P(BPDAT57(0),U,11) ;start time
32 . S BPLSTCLM=+$P(BPDAT57(0),U,4) ;claim
33 . I BPLSTCLM>0 D
34 . . S BP1=+$P($G(^BPSC(BPLSTCLM,0)),U,5) ;transmitted on
35 . . I BP1=0 S BP1=+$P($G(^BPSC(BPLSTCLM,0)),U,6) ;rec created on
36 . . ;old BPS CLAIMS recs don't have dates, so use START TIME from .57 file but
37 . . ;only at the very first time (using $D for this)
38 . . I BP1=0 I '$D(BPSARR02(BPLSTCLM)) S (BPSARR02(BPLSTCLM))=BPSSTDT,BP1=BPSSTDT
39 . . I BP1 S BPHIST("C",BP1,BPLSTCLM)=BP57_U_"C"
40 . S BPLSTRSP=+$P(BPDAT57(0),U,5) ;response
41 . I BPLSTRSP>0 D
42 . . S BP1=+$P($G(^BPSR(BPLSTRSP,0)),U,2) ;received on
43 . . I BP1=0 I '$D(BPSARR03(BPLSTRSP)) S (BPSARR02(BPLSTCLM))=BPSSTDT,BP1=BPSSTDT
44 . . I BP1 S BPHIST("R",BP1,BPLSTRSP)=BP57_U_"C"
45 . ;reversal transmissions
46 . S BPDAT57(4)=$G(^BPSTL(BP57,4))
47 . S BPLSTCLM=+$P(BPDAT57(4),U,1) ;reversal
48 . I BPLSTCLM>0 D
49 . . S BP1=+$P($G(^BPSC(BPLSTCLM,0)),U,5) ;transmitted on
50 . . I BP1=0 S BP1=+$P($G(^BPSC(BPLSTCLM,0)),U,6) ;rec created on
51 . . I BP1=0 I '$D(BPSARR02(BPLSTCLM)) S (BPSARR02(BPLSTCLM))=BPSSTDT,BP1=BPSSTDT
52 . . I BP1 S BPHIST("C",BP1,BPLSTCLM)=BP57_U_"R"
53 . S BPLSTRSP=+$P(BPDAT57(4),U,2) ;reversal response
54 . I BPLSTRSP>0 D
55 . . S BP1=+$P($G(^BPSR(BPLSTRSP,0)),U,2) ;received on
56 . . I BP1=0 I '$D(BPSARR03(BPLSTRSP)) S (BPSARR02(BPLSTCLM))=BPSSTDT,BP1=BPSSTDT
57 . . I BP1 S BPHIST("R",BP1,BPLSTRSP)=BP57_U_"R"
58 ;--------
59 ;sorting: pairs (send/respond) in reversed chronological order
60 N BPCLDT1,BPCLIEN,BPRSDT1,BPRSIEN,BPCLDT2
61 S BPCLDT1=0
62 F S BPCLDT1=$O(BPHIST("C",BPCLDT1)) Q:BPCLDT1="" D
63 . S BPCLIEN=$O(BPHIST("C",BPCLDT1,0)) Q:BPCLIEN="" D
64 . . S BPCLDT2=+$O(BPHIST("C",BPCLDT1))
65 . . I BPCLDT2=0 S BPCLDT2=9999999
66 . . S BPRSDT1=BPCLDT1
67 . . F S BPRSDT1=$O(BPHIST("R",BPRSDT1)) Q:BPRSDT1=""!(BPRSDT1>BPCLDT2) D
68 . . . S BPRSIEN=$O(BPHIST("R",BPRSDT1,0)) Q:BPRSIEN="" D
69 . . . . S BPHIST("C",BPCLDT1,BPCLIEN,"R",BPRSIEN)=BPHIST("R",BPRSDT1,BPRSIEN)
70 ;
71 Q
72 ;returns text for the transaction code in file #9002313.02 -- BPS CLAIMS FILE
73TRTYPE(BPTRCD) ;
74 I BPTRCD="E1" Q "Eligibility Verification"
75 I BPTRCD="B1" Q "REQUEST" ;"Billing"
76 I BPTRCD="B2" Q "REVERSAL" ; "Reversal"
77 I BPTRCD="B3" Q "Rebill"
78 I BPTRCD="P1" Q "P.A. Request & Billing"
79 I BPTRCD="P2" Q "P.A. Reversal"
80 I BPTRCD="P3" Q "P.A. Inquiry"
81 I BPTRCD="P4" Q "P.A. Request Only"
82 I BPTRCD="N1" Q "Information Reporting"
83 I BPTRCD="N2" Q "Information Reporting Reversal"
84 I BPTRCD="N3" Q "Information Reporting Rebill"
85 I BPTRCD="C1" Q "Controlled Substance Reporting"
86 I BPTRCD="C2" Q "Controlled Substance Reporting Reversal"
87 I BPTRCD="C3" Q "Controlled Substance Reporting Rebill"
88 Q ""
89 ;
90 ;get NDC for LOG
91 ;BPIEN02 - IEN in #9002313.02 file
92LNDC(BPIEN02) ;
93 N BPDAT02,BPNDC
94 S BPDAT02(400)=$G(^BPSC(BPIEN02,400,1,400))
95 S BPNDC=$E($P(BPDAT02(400),U,7),3,99)
96 S BPNDC=$E(BPNDC,1,5)_"-"_$E(BPNDC,6,9)_"-"_$E(BPNDC,10,11)
97 Q BPNDC
98 ;prepares array of reject codes
99 ; BPIEN03 - IEN in #9002313.03 file
100 ; BPRCODES - array to return results
101REJCODES(BPIEN03,BPRCODES) ;
102 N BPA,BPR
103 S BPA=0
104 F S BPA=$O(^BPSR(BPIEN03,1000,1,511,BPA)) Q:'BPA D
105 . S BPR=$P(^BPSR(BPIEN03,1000,1,511,BPA,0),U)
106 . I BPR'="" S BPRCODES(BPR)=""
107 Q
108 ;status of the response
109RESPSTAT(BPIEN03) ;
110 N BP1
111 S BP1=$P($G(^BPSR(BPIEN03,1000,1,110)),U,2)
112 Q:BP1="A" "Approved"
113 Q:BP1="C" "Captured"
114 Q:BP1="D" "Duplicate of Paid"
115 Q:BP1="F" "PA Deferred"
116 Q:BP1="P" "Paid"
117 Q:BP1="Q" "Duplicate of Capture"
118 Q:BP1="R" "Rejected"
119 Q:BP1="S" "Duplicate of Approved"
120 Q ""
121 ;
122 ;Electronic payer - ptr to #9002313.92
123 ;BPIEN02 - ptr in #9002313.02
124PYRIEN(BPIEN02) ;
125 Q $P($G(^BPSF(9002313.92,+$P($G(^BPSC(BPIEN02,0)),U,2),0)),U)
126 ;
127 ;BPIEN02 - ptr in #9002313.02
128B2PYRIEN(BPIEN02,BP57) ;
129 N BPX,BPX2
130 S BPX=$G(^BPSF(9002313.92,+$$PYRIEN(BPIEN02),"REVERSAL"))
131 I $L(BPX)=0 D
132 . S BPX2=+$P($G(^BPSTL(BP57,10,+$G(^BPSTL(BP57,9)),0)),U,3)
133 . S BPX=$P($G(^BPSF(9002313.92,BPX2,0)),U)
134 Q BPX
135 ;
136 ;B3 payer sheet
137B3PYRIEN(BPIEN02,BP59,BP57) ;
138 N BPX,BPX2
139 S BPX2=+$P($G(^BPSTL(BP57,10,+$G(^BPSTL(BP57,9)),0)),U,4)
140 S BPX=$P($G(^BPSF(9002313.92,BPX2,0)),U)
141 Q BPX
142 ;
143 ;
144 ;BPLN= line to use in SETLINE
145 ;BPX - long string to display
146 ;BPMLEN - max length
147 ;BPPREFX - prefix string
148 ;BPMARG - left margin
149WRAPLN(BPLN,BPX,BPMLEN,BPPREFX,BPMARG) ;
150 N BPQ,BPLEN,BPXX
151 S BPQ=0
152 S BPLEN=BPMLEN-$L(BPPREFX)
153 S BPXX=$E(BPX,1,BPLEN)
154 D SETLINE^BPSSCRLG(.BPLN,BPPREFX_BPXX)
155 S BPX=$E(BPX,BPLEN+1,9999)
156 I $L(BPX)<1 Q
157 S BPLEN=BPMLEN-BPMARG
158 F D Q:BPQ=1
159 . S BPXX=$E(BPX,1,BPLEN)
160 . D SETLINE^BPSSCRLG(.BPLN,$$SPACES(BPMARG)_BPXX)
161 . S BPX=$E(BPX,BPLEN+1,9999)
162 . I $L(BPX)<1 S BPQ=1
163 Q
164 ;
165 ;to prepare spaces
166SPACES(BPN) ;
167 N BPX
168 S $P(BPX," ",BPN+1)=""
169 Q BPX
170 ;
171 ;BPN= line counter (index)
172 ;BPARR - array for lines
173 ;BPX - long string to display
174 ;BPMLEN - mas length
175 ;BPPREFX - prefix string
176 ;BPMARG - left margin
177WRAPLN2(BPN,BPARR,BPX,BPMLEN,BPPREFX,BPMARG) ;
178 N BPQ,BPLEN,BPXX
179 S BPQ=0
180 S BPLEN=BPMLEN-$L(BPPREFX)
181 S BPXX=$E(BPX,1,BPLEN)
182 D SETLN(.BPN,.BPARR,BPPREFX_BPXX)
183 S BPX=$E(BPX,BPLEN+1,9999)
184 I $L(BPX)<1 Q
185 S BPLEN=BPMLEN-BPMARG
186 F D Q:BPQ=1
187 . S BPXX=$E(BPX,1,BPLEN)
188 . D SETLN(.BPN,.BPARR,$$SPACES(BPMARG)_BPXX)
189 . S BPX=$E(BPX,BPLEN+1,9999)
190 . I $L(BPX)<1 S BPQ=1
191 Q
192 ;
193 ;
194SETLN(BPN,BPARR,BPTXT) ;
195 S BPN=BPN+1,BPARR(BPN)=BPTXT
196 Q
197 ;---
198 ;check 2nd insurance
199 ;if there then ask user and print message
200CH2NDINS(BP59,BPPATNAM,BPINSNAM,BPRXINFO) ;
201 N BPRETV
202 S BPRETV=$$NEXTINS^BPSSCRCL(BP59,BPINSNAM)
203 Q:+BPRETV=0
204 D PRN(BPPATNAM,BPRETV,.BPRXINFO,"S")
205 W !!
206 I $$YESNO^BPSSCRRS("Do you want to print the information (above) concerning additional insurance? (Y/N)")'=1 Q
207 D PRN(BPPATNAM,BPRETV,.BPRXINFO,"P")
208 Q
209 ;
210 ;BPPRNFL
211 ; S- print to screen
212PRN(BPPATNAM,BPRETV,BPRXINFO,BPPRNFL) ;
213 I BPPRNFL="S" W @IOF D MS2NDINS Q
214 D PRINT("MS2NDINS^BPSSCRU5","BPS 2ND INSURANCE INFO","BP*")
215 W !!
216 Q
217 ;
218MS2NDINS ;
219 N Y,Z
220 W !,"This patient HAS additional insurance with Rx Coverage that may be"
221 W !,"used to bill this claim. The system WILL change the CT entry to a"
222 W !,"NON-BILLABLE Episode. If appropriate, please go to Claims Tracking"
223 W !,"to manually create a bill to the additional payer listed below."
224 W !!,"Patient: ",?18,BPPATNAM
225 S Y=$P(BPRETV,U,4)\1 D DD^%DT
226 W !,"Date of service: ",?18,Y
227 W !,"Insurance: ",?18,$P(BPRETV,U,2)
228 W !,"Group number: ",?18,$P(BPRETV,U,3)
229 S Z=0 F S Z=$O(BPRXINFO(Z)) Q:+Z=0 W !,BPRXINFO(Z)
230 Q
231 ;
232 ;Prints report
233 ;propmpts user to choose device (including queuing)
234 ;TXTSRC - name of the report's entry point
235 ;DESCR - description for the Task Manager
236 ;SAVEVARS - mask for vars that need to be available in the report
237 ; (exmpl: "BP*")
238PRINT(TXTSRC,DESCR,SAVEVARS) ;
239 N Y,QUITVAR,SCRFLAG
240 S (QUITVAR,SCRFLAG)=0
241 D DEVICE Q:QUITVAR
242 D @TXTSRC
243 D ^%ZISC
244 I QUITVAR W !,"Cancelled"
245 Q
246 ;
247DEVICE ;
248 N DIR,DIRUT,POP
249 N ZTRTN,ZTIO,ZTSAVE,ZTDESC,%ZIS
250 K IO("Q") S %ZIS="QM"
251 W ! D ^%ZIS
252 I POP S QUITVAR=1 Q
253 S SCRFLAG=$S($E($G(IOST),1,2)="C-":1,1:0)
254 I $D(IO("Q")) D S QUITVAR=1
255 . S ZTRTN=TXTSRC
256 . S ZTIO=ION
257 . S ZTSAVE(SAVEVARS)=""
258 . S ZTDESC=DESCR
259 . D ^%ZTLOAD
260 . W !,$S($D(ZTSK):"REQUEST QUEUED TASK="_ZTSK,1:"REQUEST CANCELLED")
261 . D HOME^%ZIS
262 U IO
263 Q
264 ;
Note: See TracBrowser for help on using the repository browser.