| 1 | IBAMTS1 ;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 | ;
|
|---|
| 5 | NEW ; 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 | ;
|
|---|
| 30 | BLD ; - 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
|
|---|
| 57 | CLOCK I '$D(^IBE(351,"ACT",DFN)) S IBCLDT=IBDAT D CLADD^IBAUTL3
|
|---|
| 58 | ;
|
|---|
| 59 | NEWQ 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 | ;
|
|---|
| 64 | CHKS() ; 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 | ;
|
|---|
| 110 | IBFLR ; 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 | ;
|
|---|
| 117 | CLPT(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 | ;
|
|---|
| 123 | INPT(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 | ;
|
|---|
| 130 | CLSF(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 | ;
|
|---|
| 143 | OLDRATE(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 | ;
|
|---|
| 154 | CHKPRIM ; 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
|
|---|
