source: FOIAVistA/trunk/r/INTEGRATED_BILLING-IB-PRQ--IBD--IBQ--PRQS/IBAMTS1.m@ 957

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

initial load of FOIAVistA 6/30/08 version
File size: 6.8 KB
Line 
1IBAMTS1 ;ALB/CPM - PROCESS NEW OUTPATIENT ENCOUNTERS ; 22-JUL-93
2 ;;2.0;INTEGRATED BILLING;**20,52,132,153,166,156,167,247,339**;21-MAR-94;Build 2
3 ;;Per VHA Directive 2004-038, this routine should not be modified.
4 ;
5NEW ; Appointment fully processed - prepare a new charge.
6 ;
7 ; ibbilled is set to 1 if the patient has already been billed on this
8 ; date. if the date is after 12/5/01, check the type of bill to see
9 ; if it is an upgrade from primary (1st bill) to specialty (new bill)
10 I IBBILLED D:IBDAT'<3011206 CHKPRIM I IBBILLED G NEWQ
11 ;
12 ; - for registrations, get disposition, and use log-out date/time
13 I IBORG=3 D G:'IBDISP NEWQ
14 .S IBDISP=+$P($G(^TMP("SDEVT",$J,SDHDL,IBORG,"DIS",0,"AFTER")),"^",7)
15 .Q:'IBDISP
16 .S IBTEMP=+$P($G(^TMP("SDEVT",$J,SDHDL,IBORG,"DIS",0,"AFTER")),"^",6)
17 .S:IBTEMP IBDT=IBTEMP,IBDAT=$P(IBDT,".")
18 ;
19 I '$$BIL^DGMTUB(DFN,IBDT) G NEWQ ; patient is not Means Test billable
20 ;
21 ; - perform batch of edits
22 I '$$CHKS G NEWQ
23 ;
24 ; - quit if AO/IR/SWA/MST/HNC/CV/SHAD exposure is indicated, or SC related
25 D CLSF(0,.IBCLSF)
26 I IBCLSF[1 G NEWQ
27 ;
28 S IBSL="409.68:"_IBOE
29 ;
30BLD ; - build the charge. May also enter from IBAMTS2 (requires IBSL)
31 ;
32 ; find the clinic stop code in 409.68 (dbia402) and find the matching
33 ; entry in file 352.5. the 352.5 entry is populated in the 350 field
34 ; for reference using the ibstopda variable
35 N %,IBSTOPDA,IBTYPE
36 S %=$$GETSC^IBEMTSCU(IBSL,IBDAT) I % S IBSTOPDA=%
37 ;
38 ; get the rate, ibtype = primary or specialty
39 S IBTYPE=$P($G(^IBE(352.5,+$G(IBSTOPDA),0)),"^",3) I IBTYPE=0 Q
40 ; if the type is not defined, must be a local created sc, set it to primary
41 I 'IBTYPE S IBTYPE=1
42 S IBX="O" D TYPE^IBAUTL2 G:IBY<0 NEWQ
43 S IBUNIT=1,(IBFR,IBTO)=IBDAT,IBEVDA="*"
44 D ADD^IBECEAU3 G:IBY<0 NEWQ
45 ;
46 ; - if enctr is exempt from classification, but patient isn't, send msg
47 I $$EXOE^SDCOU2($S($G(IBOEN):IBOEN,1:IBOE)),$$CLPT(DFN,IBDAT) D BULL^IBAMTS
48 ;
49 ; - if the opt billing rate is over a year old, place the charge on hold
50 ;I $$OLDRATE(IBRTED,IBFR) D G CLOCK
51 ;.S DIE="^IB(",DA=IBN,DR=".05////20" D ^DIE K DIE,DA,DR
52 ;
53 ; - drop the charge into the background filer
54 D IBFLR G:IBY<0 NEWQ
55 ;
56 ; - if there is no active billing clock, add one
57CLOCK I '$D(^IBE(351,"ACT",DFN)) S IBCLDT=IBDAT D CLADD^IBAUTL3
58 ;
59NEWQ I IBY<0 D ^IBAERR1
60 K IBDISP,IBCLSF,IBCLDA,IBMED,IBCLDT,IBN,IBBS,IBTEMP
61 K IBUNIT,IBFR,IBTO,IBSL,IBEVDA,IBX,IBDESC,IBATYP,IBCHG
62 Q
63 ;
64CHKS() ; Perform a batch of edits to determine whether to bill.
65 ; Input variables required: IBEVT -- encounter
66 ; IBAPTY -- appt type
67 ; IBDAT -- appt date
68 ; IBDT -- appt date/time
69 ; IBORG -- originating process
70 ; IBDISP -- disposition (if registration)
71 N IBRESULT
72 ;
73 ; default is fail the checks
74 S IBRESULT=0
75 ;
76 ; for appts prior to 12/6/2001
77 I IBDAT<3011206 D Q IBRESULT
78 . ; - non-count clinic
79 . I $P($G(^SC(+$P(IBEVT,"^",4),0)),"^",17)="Y" Q
80 . ;
81 . ; - non-billable appointment type
82 . I $$IGN^IBEFUNC(IBAPTY,IBDAT) Q
83 . ;
84 . ; - non-billable disposition/stop code/clinic
85 . I IBORG=1!(IBORG=2),$$NBCL^IBEFUNC(+$P(IBEVT,"^",4),IBDT) Q
86 . I IBORG=1!(IBORG=2),$$NBCSC^IBEFUNC(+$P(IBEVT,"^",3),IBDT) Q
87 . I IBORG=3,$$NBDIS^IBEFUNC(IBDISP,IBDT) Q
88 . ;
89 . ; - ignore if checked out late and pt was an inpatient at midnight
90 . I DT>IBDAT,$$INPT(DFN,IBDAT_".2359") Q
91 . ;
92 . ; pass the checks
93 . S IBRESULT=1
94 ;
95 ; for appts on or after 12/6/2001
96 ;
97 ; - non-billable appointment type
98 I $$IGN^IBEFUNC(IBAPTY,IBDAT) Q 0
99 ;
100 ; - non-count clinic
101 I $P($G(^SC(+$P(IBEVT,"^",4),0)),"^",17)="Y" Q 0
102 ;
103 ; - ignore if checked out late and pt was an inpatient at midnight
104 I DT>IBDAT,$$INPT(DFN,IBDAT_".2359") Q 0
105 ;
106 ; pass the checks
107 Q 1
108 ;
109 ;
110IBFLR ; Drop the charge into the IB Background filer.
111 N IBSEQNO,IBNOS,IBNOW,IBTOTL,IBSERV,IBWHER,IBFAC,IBSITE,IBAFY,IBARTYP,IBIL,IBTRAN
112 D NOW^%DTC S IBNOW=%,IBNOS=IBN
113 S IBSEQNO=$P($G(^IBE(350.1,+IBATYP,0)),"^",5) I 'IBSEQNO S IBY="-1^IB023"
114 I IBY>0 D ^IBAFIL
115 Q
116 ;
117CLPT(DFN,VDATE) ; Should the patient be asked the classification questions?
118 ; Input: DFN -- Pointer to the patient in file #2
119 ; VDATE -- Visit date
120 N IBARR D CL^SDCO21(DFN,VDATE,"",.IBARR)
121 Q $D(IBARR)>0
122 ;
123INPT(DFN,VAINDT) ; Was the patient an inpatient at VAINDT?
124 ; Input: DFN -- Pointer to the patient in file #2
125 ; VAINDT -- Date/time to check for inpatient status
126 ; Output: 1 - inpatient | 0 - not an inpatient
127 N VADMVT D ADM^VADPT2
128 Q VADMVT>0
129 ;
130CLSF(IBUPD,Y) ; Examine classification questions.
131 ; Input: IBUPD -- 0 if event just checked out
132 ; 1 if event is being updated
133 ; Y -- array to place output
134 ; Output: indicators returned as ao^ir^sc^swa^mst^hnc^cv^shad [1|yes, 0|no]
135 ; if IBUPD=0, Y is returned as a single string
136 ; if IBUPD=1, Y("BEFORE"),Y("AFTER") are defined.
137 N X,ZA,ZB S:'$G(IBUPD) Y="" S:$G(IBUPD) (Y("BEFORE"),Y("AFTER"))=""
138 S X=0 F S X=$O(^TMP("SDEVT",$J,SDHDL,IBORG,"SDOE",IBOE,"CL",X)) Q:'X S ZB=$G(^(X,0,"BEFORE")),ZA=$G(^("AFTER")) D
139 .I '$G(IBUPD) S:ZA $P(Y,"^",+ZA)=+$P(ZA,"^",3) Q
140 .S $P(Y("BEFORE"),"^",+ZB)=+$P(ZB,"^",3),$P(Y("AFTER"),"^",+ZA)=+$P(ZA,"^",3)
141 Q
142 ;
143OLDRATE(IBRTED,IBFR) ; See if the copay rate effective date is too old.
144 ; Input: IBRTED -- Charge Effective Date
145 ; IBFR -- Visit Date
146 ; Output: 1 -- Effective Date is too old
147 ; 0 -- Not
148 ;
149 N IBNUM,IBYR
150 S IBNUM=$$FMDIFF^XLFDT(IBFR,IBRTED),IBYR=$E(IBFR,1,3)
151 Q IBYR#4&(IBNUM>364)!(IBYR#4=0&(IBNUM>365))
152 ;
153 ;
154CHKPRIM ; check to see if patient has been billed for primary
155 ; and this is a specialty stop. if so, cancel the primary
156 ; bill and let the software create the new specialty charge
157 ; input ibbilled = last parent bill to check (ien 350)
158 ; used to check the rate
159 ; output ibbilled = last parent bill number to prevent
160 ; adding specialty charge
161 N %,IBSTOPDA,IBTYPE,IBCRES,IBI,IBS
162 ;
163 ; get the stop code for the 2nd visit on the same day
164 S IBSTOPDA=$$GETSC^IBEMTSCU("409.68:"_IBOE,IBDAT) I 'IBSTOPDA Q
165 ;
166 ; get the rate, ibtype = primary or specialty
167 S IBTYPE=$P(^IBE(352.5,IBSTOPDA,0),"^",3)
168 ; if the new appt is not specialty, quit ... no need to create
169 ; a new charge
170 I IBTYPE'=2 Q
171 ;
172 ; if the last charge was billed at specialty, quit
173 I $P($G(^IBE(352.5,+$P($G(^IB(+IBBILLED,0)),"^",20),0)),"^",3)=2 Q
174 ;
175 ; cancel the charge
176 ; cancellation reason = billed at higher tier rate
177 S IBCRES=6,IBS=$P($G(^IB(+IBBILLED,0)),"^",5)
178 ;
179 ; if not billed, on hold, or cacelled wait
180 I IBS'=3!(IBS'=8)!(IBS'=10) F IBI=1:1:10 H 1 S IBS=$P($G(^IB(+IBBILLED,0)),"^",5) I IBS=3!(IBS=8)!(IBS=10) Q
181 ;
182 D CANC^IBAMTS2
183 ;
184 ; set ibbilled = 0 to create the specialty charge
185 S IBBILLED=0
186 Q
Note: See TracBrowser for help on using the repository browser.