source: WorldVistAEHR/trunk/r/INTEGRATED_BILLING-IB-PRQ--IBD--IBQ--PRQS/IBCIL0.m@ 703

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

initial load of WorldVistAEHR
File size: 9.2 KB
Line 
1IBCIL0 ;DSI/ESG - CLAIMSMANAGER SKIP LIST ;11-JAN-2001
2 ;;2.0;INTEGRATED BILLING;**161**;21-MAR-94
3 ;;Per VHA Directive 10-93-142, this routine should not be modified.
4 ;
5 ;The skip list is a routine that will allow system managers the
6 ;capabilities to select transactions that errored due to system
7 ;failures. This routine utilizes ListMan functions.
8EN ; -- main entry point for IBCI CLAIMSMANAGER SKIP LIST
9 ;
10 ; Try to get an option-level lock
11 L +^IBCIL0:0
12 E W @IOF,!!!?10,"Another user is currently using this option.",!!?10,"Please try again later.",!! S DIR(0)="E" D ^DIR K DIR Q
13 ;
14 I '$$CK2^IBCIUT1 D Q ; check to see that ClaimsManager working OK
15 . W @IOF,!!!?10,"ClaimsManager is not working right now."
16 . W !!?10,"Please try again later.",!!
17 . S DIR(0)="E" D ^DIR K DIR
18 . L -^IBCIL0
19 . Q
20 ;
21 D EN^VALM("IBCI CLAIMSMANAGER SKIP LIST")
22 KILL ^TMP("IBCIL0",$J),^TMP("IBCIL1",$J),^TMP("IBCIL2",$J)
23 KILL IBCISTAT,IBCISNT,IBCIREDT,IBCIERR,CT
24 L -^IBCIL0
25 Q
26 ;
27HDR ; -- header code
28 S VALMHDR(1)=" Welcome to ClaimsManager Bill Processing"
29 S VALMHDR(2)=" This ListMan will display all skipped bills for processing"
30 Q
31 ;
32INIT ; -- init variables and list array
33 D CLEAN^VALM10
34 K ^TMP("IBCIL0",$J),^TMP("IBCIL1",$J),^TMP("IBCIL2",$J),CT
35 NEW IBCIVAUS,IBCIFDAT,IBCIIEN,IBCIBNUM
36 NEW IBCINAME,IBCIDATE,IBCIUSER,IBCIST0,IBCIST1,IBCIARR
37 NEW IBCISKST,NODE0,IBCIDFN,IBCIXX
38 S IBCIARR=""
39 F IBCISKST=2,6,7,10,11 D
40 .S IBCIIEN=0 F S IBCIIEN=$O(^IBA(351.9,"AST",IBCISKST,IBCIIEN)) Q:'IBCIIEN D
41 ..S NODE0=^IBA(351.9,IBCIIEN,0)
42 ..S IBCIBNUM=$P(^DGCR(399,IBCIIEN,0),U,1)
43 ..S IBCIFDAT=$P($P(^DGCR(399,IBCIIEN,0),U,3),".",1)
44 ..S IBCIDATE=$$FDATE^VALM1(IBCIFDAT)
45 ..S IBCIUSER=$P(NODE0,U,12) ; assigned to peep
46 ..I 'IBCIUSER S IBCIUSER=+$$BILLER^IBCIUT5(IBCIIEN) ; biller
47 ..I 'IBCIUSER S IBCIUSER=$P(NODE0,U,9) ; last edited by
48 ..I 'IBCIUSER S IBCIUSER=$P(NODE0,U,7) ; entered by
49 ..S IBCIVAUS=$P($G(^VA(200,IBCIUSER,0)),U,1)
50 ..I IBCIVAUS="" S IBCIVAUS="UNKNOWN"
51 ..S IBCIDFN=$P(^DGCR(399,IBCIIEN,0),U,2)
52 ..S IBCINAME=$P($G(^DPT(IBCIDFN,0)),U,1)
53 ..S IBCIST0=$P(^DGCR(399,IBCIIEN,0),U,13)
54 ..I IBCIST0=1 S IBCIST1="E/NR"
55 ..I IBCIST0=2 S IBCIST1="R/MRA"
56 ..I IBCIST0=3 S IBCIST1="AUTH"
57 ..I IBCIST0=4 S IBCIST1="PR/TX"
58 ..I IBCIST0=7 S IBCIST1="CANX"
59 ..I IBCIST0=0 S IBCIST1="CLSD",IBCIST0=9
60 ..S ^TMP("IBCIL0",$J,IBCIST0,IBCIVAUS,IBCIBNUM)=IBCIIEN_U_IBCIST1_U_IBCIVAUS_U_IBCIBNUM_U_IBCINAME_U_IBCIDATE
61SRT ;sort
62 S (IBCIST0,CT)=0 F S IBCIST0=$O(^TMP("IBCIL0",$J,IBCIST0)) Q:'IBCIST0 D
63 .S IBCIUSER="" F S IBCIUSER=$O(^TMP("IBCIL0",$J,IBCIST0,IBCIUSER)) Q:IBCIUSER="" D
64 ..S IBCIBNUM="" F S IBCIBNUM=$O(^TMP("IBCIL0",$J,IBCIST0,IBCIUSER,IBCIBNUM)) Q:IBCIBNUM="" D
65 ...S IBCIXX=^TMP("IBCIL0",$J,IBCIST0,IBCIUSER,IBCIBNUM)
66 ...S IBCIARR=$$SETFLD^VALM1($P(IBCIXX,U,2),IBCIARR,"STATUS")
67 ...S IBCIARR=$$SETFLD^VALM1($P(IBCIXX,U,3),IBCIARR,"USER")
68 ...S IBCIARR=$$SETFLD^VALM1($P(IBCIXX,U,4),IBCIARR,"BNUM")
69 ...S IBCIARR=$$SETFLD^VALM1($P(IBCIXX,U,5),IBCIARR,"PT_NAME")
70 ...S IBCIARR=$$SETFLD^VALM1($P(IBCIXX,U,6),IBCIARR,"EVENT_DATE")
71 ...S CT=CT+1
72 ...S ^TMP("IBCIL1",$J,CT)=$P(IBCIXX,U)_U_$P(^IBA(351.9,$P(IBCIXX,U),0),U,2)_U_IBCIST0
73 ...S IBCIARR=$$SETFLD^VALM1(CT,IBCIARR,"ITEM") D SET^VALM10(CT,IBCIARR)
74 S VALMCNT=CT
75 I VALMCNT=0 S VALMSG="No Skipped Claims to Send to ClaimsManager."
76 D EXIT
77 Q
78 ;
79SELB ; select single bill, bill by status, or multiple range of bills
80 ;
81 NEW IBCIENAR,IBCINUMS,IBCIPIEC,IBCIYSUB,IBCIX
82 S VALMBCK="R"
83 I CT=0 D NOBILS,INIT G SELBX
84 D FULL^VALM1
85 S DIR(0)="LO^1:"_CT
86 S DIR("A",1)="You may select one or more claims, or a range."
87 S DIR("A")="Selection"
88 S DIR("?",1)=" You may choose a single bill, a list of bills (i.e. 2,5,9,12), a range"
89 S DIR("?",2)=" of bills (i.e. 3-8), or any combination of these (i.e. 1,3,5,8-12). Only"
90 S DIR("?")=" the bills you select here will be sent to ClaimsManager."
91 D ^DIR K DIR
92 I $D(DIRUT) G SELBX
93 D YESBLS
94 M IBCIENAR=Y KILL X,Y
95 S IBCIYSUB=""
96 F S IBCIYSUB=$O(IBCIENAR(IBCIYSUB)) Q:IBCIYSUB="" D
97 . S IBCINUMS=IBCIENAR(IBCIYSUB)
98 . S IBCINUMS=$E(IBCINUMS,1,$L(IBCINUMS)-1)
99 . F IBCIPIEC=1:1:$L(IBCINUMS,",") S IBCIX=$P(IBCINUMS,",",IBCIPIEC) D N1
100 . Q
101 D SENDMAIL,INIT
102SELBX ;
103 Q
104 ;
105N1 ; check for valid number and send the claim
106 NEW IBCIST1,IBIFN,IBCIMCSB,IBCIMCSL
107 NEW ATP,BILLNO,CHARGES,DFN,DPTDATA,EVENTDT,IBDATA,PATNAME,RESP,RESPNM
108 NEW SSN,TMPDATA
109 NEW IBCIENAR,IBCINUMS,IBCIPIEC,IBCIYSUB
110 ;
111 I 'IBCIX Q
112 I '$D(^TMP("IBCIL1",$J,IBCIX)) Q
113 S IBIFN=$P(^TMP("IBCIL1",$J,IBCIX),U,1)
114 S IBCIST1=$P(^TMP("IBCIL1",$J,IBCIX),U,3) D STATUS
115 ;
116 S IBCIMCSB=+$$BILLER^IBCIUT5(IBIFN) ; current biller
117 S IBCIMCSL=+$P($G(^IBA(351.9,IBIFN,0)),U,5) ; last sent to CM by
118 ;
119 D ST2^IBCIST ; send a single bill to CM
120 W "."
121 ;
122 ; esg - 10/4/01 - If the bill is still editable and it came back
123 ; clean from CM, then build a scratch global so we can send
124 ; a MailMan message to some people about this.
125 ;
126 I IBCISNT=2,IBCISTAT=3 D
127 . S (RESP,ATP)=+$P($G(^IBA(351.9,IBIFN,0)),U,12)
128 . I 'RESP S RESP=IBCIMCSB
129 . I 'RESP S RESP=DUZ
130 . S RESPNM=$P($G(^VA(200,RESP,0)),U,1)
131 . I RESPNM="" S RESPNM="UNKNOWN"
132 . S CHARGES=+$P($G(^DGCR(399,IBIFN,"U1")),U,1)
133 . S IBDATA=$G(^DGCR(399,IBIFN,0))
134 . S BILLNO=$P(IBDATA,U,1)
135 . S DFN=+$P(IBDATA,U,2)
136 . S DPTDATA=$G(^DPT(DFN,0))
137 . S SSN=$E($P(DPTDATA,U,9),6,9)
138 . S PATNAME=$P(DPTDATA,U,1)
139 . S EVENTDT=$P($P(IBDATA,U,3),".",1)
140 . S TMPDATA=BILLNO_U_PATNAME_U_SSN_U_EVENTDT
141 . S ^TMP("IBCIL2",$J,RESPNM,-CHARGES,IBIFN)=TMPDATA
142 . ;
143 . ; these people should get the MailMan message
144 . I ATP S ^TMP("IBCIL2",$J,RESPNM,-CHARGES,IBIFN,ATP)=""
145 . I IBCIMCSB S ^TMP("IBCIL2",$J,RESPNM,-CHARGES,IBIFN,IBCIMCSB)=""
146 . I IBCIMCSL S ^TMP("IBCIL2",$J,RESPNM,-CHARGES,IBIFN,IBCIMCSL)=""
147 . S ^TMP("IBCIL2",$J)=$G(^TMP("IBCIL2",$J))+1
148 . Q
149 Q
150 ;
151STATUS ;set ibcisnt based on criteria
152 K IBCISNT
153 I $$STAT^IBCIUT1(IBIFN)=10 S IBCISNT=4 Q
154 I $$STAT^IBCIUT1(IBIFN)=11 S IBCISNT=5 Q
155 S IBCISNT=$S("^1^"[IBCIST1:2,1:6)
156 Q
157 ;
158ALL ;send all claims
159 NEW IBCIX
160 S VALMBCK="R"
161 I CT=0 D NOBILS,INIT Q
162 I CT>0 D YESBLS
163 S IBCIX=0 F S IBCIX=$O(^TMP("IBCIL1",$J,IBCIX)) Q:'IBCIX D N1
164 D SENDMAIL,INIT
165 Q
166SNA ;send all non authorized claims
167 NEW IBCIX
168 S VALMBCK="R"
169 I CT=0 D NOBILS,INIT Q
170 I CT>0 D YESBLS
171 S IBCIX=0 F S IBCIX=$O(^TMP("IBCIL1",$J,IBCIX)) Q:'IBCIX D
172 . I $P(^TMP("IBCIL1",$J,IBCIX),U,3)<3 D N1
173 . Q
174 D SENDMAIL,INIT
175 Q
176 ;
177SENDMAIL ;
178 ; This procedure is responsible for sending a MailMan message to
179 ; users about the claims that had no ClaimsManager errors. The
180 ; message will list all clean claims and will be sent to the billers,
181 ; assigned to people, current user, and the user who most recently
182 ; sent the bill to CM.
183 ;
184 NEW CHG,IBIFN,L1,TEXT,TMPDATA,USER,XMDUZ,XMSUB,XMTEXT,XMY,XMDUN,XMZ
185 NEW X,Y,X1,X2,X3,X4
186 I '$D(^TMP("IBCIL2",$J)) G SENDX
187 S L1=1
188 S TEXT(L1)="The following bills were sent to ClaimsManager from the Multiple Claim Send",L1=L1+1
189 S TEXT(L1)="option. ClaimsManager did not find any errors with them. These bills have",L1=L1+1
190 S TEXT(L1)="passed both the IB edit checks and the ClaimsManager edit checks. They are",L1=L1+1
191 S TEXT(L1)="ready to be authorized. Please review the bills for which you are responsible",L1=L1+1
192 S TEXT(L1)="(if any) and take the appropriate action.",L1=L1+1
193 S TEXT(L1)=" ",L1=L1+1
194 S TEXT(L1)=$J("EVENT",43),L1=L1+1
195 S TEXT(L1)=" BILL# PATIENT NAME PID DATE CHARGES USER NAME",L1=L1+1
196 S TEXT(L1)=" ------- ------------------ ---- ---------- ---------- ------------------",L1=L1+1
197 ;
198 S USER=""
199 F S USER=$O(^TMP("IBCIL2",$J,USER)) Q:USER="" S CHG="" F S CHG=$O(^TMP("IBCIL2",$J,USER,CHG)) Q:CHG="" S IBIFN=0 F S IBIFN=$O(^TMP("IBCIL2",$J,USER,CHG,IBIFN)) Q:'IBIFN D
200 . M XMY=^TMP("IBCIL2",$J,USER,CHG,IBIFN)
201 . S TMPDATA=XMY,XMY=""
202 . S TEXT(L1)=" "
203 . S X=$P(TMPDATA,U,1),X1=7,X2="L" S TEXT(L1)=TEXT(L1)_$$FILL^IBCIUT2
204 . S TEXT(L1)=TEXT(L1)_" "
205 . S X=$P(TMPDATA,U,2),X1=18,X2="L" S TEXT(L1)=TEXT(L1)_$$FILL^IBCIUT2
206 . S X=$P(TMPDATA,U,3),X1=6,X2="R" S TEXT(L1)=TEXT(L1)_$$FILL^IBCIUT2
207 . S X=$$FMTE^XLFDT($P(TMPDATA,U,4),"5Z"),X1=12,X2="R"
208 . S TEXT(L1)=TEXT(L1)_$$FILL^IBCIUT2
209 . S X="$"_$FN(-CHG,",",2),X1=12,X2="R"
210 . S TEXT(L1)=TEXT(L1)_$$FILL^IBCIUT2
211 . S TEXT(L1)=TEXT(L1)_" "
212 . S X=USER,X1=18,X2="L" S TEXT(L1)=TEXT(L1)_$$FILL^IBCIUT2
213 . S L1=L1+1
214 . Q
215 S TEXT(L1)=" ",L1=L1+1
216 S TEXT(L1)=" ",L1=L1+1
217 ;
218 S XMTEXT="TEXT("
219 S XMDUZ=DUZ
220 S XMSUB="ClaimsManager Clean Claims"
221 S XMY(DUZ)=""
222 D ^XMD
223SENDX ;
224 Q
225 ;
226NOBILS ;msg for no bills
227 D FULL^VALM1
228 W !!,"There are no claims to send ...",!
229 S DIR(0)="E" D ^DIR K DIR
230 Q
231YESBLS ;msg for sending bills
232 W !!,"Sending claims ... please wait.",!
233 Q
234HELP ; -- help code
235 S X="?"
236 D FULL^VALM1
237 D EN^DDIOL(" 'Send All Bills to ClaimsManager' will send all claims listed","","!!")
238 D EN^DDIOL(" to ClaimsManager for processing.")
239 D EN^DDIOL(" 'Send All Non Auth Bills to ClaimsManager' will send only","","!!")
240 D EN^DDIOL(" Non-Authorized claims to ClaimsManager for processing.")
241 D EN^DDIOL(" 'Select Bills to send to ClaimsManager' allows individual and","","!!")
242 D EN^DDIOL(" multiple selection of claims before sending")
243 D EN^DDIOL(" claims to ClaimsManager for processing.")
244 D PAUSE^VALM1
245 S VALMBCK="R"
246 Q
247 ;
248EXIT ; -- exit code
249 D CLEAR^VALM1
250 Q
Note: See TracBrowser for help on using the repository browser.