Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: IBAMTS1

IBAMTS1.m

Go to the documentation of this file.
  1. IBAMTS1 ;ALB/CPM - PROCESS NEW OUTPATIENT ENCOUNTERS ; 22-JUL-93
  1. ;;2.0;INTEGRATED BILLING;**20,52,132,153,166,156,167,247,339,614,760**;21-MAR-94;Build 25
  1. ;;Per VHA Directive 2004-038, this routine should not be modified.
  1. ;
  1. NEW ; Appointment fully processed - prepare a new charge.
  1. ;
  1. ; ibbilled is set to 1 if the patient has already been billed on this
  1. ; date. if the date is after 12/5/01, check the type of bill to see
  1. ; if it is an upgrade from primary (1st bill) to specialty (new bill)
  1. I IBBILLED D:IBDAT'<3011206 CHKPRIM I IBBILLED G NEWQ
  1. ;
  1. ; - for registrations, get disposition, and use log-out date/time
  1. I IBORG=3 D G:'IBDISP NEWQ
  1. .S IBDISP=+$P($G(^TMP("SDEVT",$J,SDHDL,IBORG,"DIS",0,"AFTER")),"^",7)
  1. .Q:'IBDISP
  1. .S IBTEMP=+$P($G(^TMP("SDEVT",$J,SDHDL,IBORG,"DIS",0,"AFTER")),"^",6)
  1. .S:IBTEMP IBDT=IBTEMP,IBDAT=$P(IBDT,".")
  1. ;
  1. I '$$BIL^DGMTUB(DFN,IBDT) G NEWQ ; patient is not Means Test billable
  1. ;
  1. ; - perform batch of edits
  1. I '$$CHKS G NEWQ
  1. ;
  1. ; - quit if AO/IR/SWA/MST/HNC/CV/SHAD exposure is indicated, or SC related
  1. D CLSF(0,.IBCLSF)
  1. I IBCLSF[1 G NEWQ
  1. ;
  1. ; - quit if the Pt is Visit Copay exempt based on HRfS flag (IB*2.0*614)
  1. I $$CHKHRFS^IBAMTS3(DFN,IBDAT) G NEWQ
  1. ;
  1. S IBSL="409.68:"_IBOE
  1. ;
  1. BLD ; - build the charge. May also enter from IBAMTS2 (requires IBSL)
  1. ;
  1. ; find the clinic stop code in 409.68 (dbia402) and find the matching
  1. ; entry in file 352.5. the 352.5 entry is populated in the 350 field
  1. ; for reference using the ibstopda variable
  1. N %,IBSTOPDA,IBTYPE
  1. S %=$$GETSC^IBEMTSCU(IBSL,IBDAT) I % S IBSTOPDA=%
  1. ;
  1. ; get the rate, ibtype = primary or specialty
  1. S IBTYPE=$P($G(^IBE(352.5,+$G(IBSTOPDA),0)),"^",3) I IBTYPE=0 Q
  1. ; if the type is not defined, must be a local created sc, set it to primary
  1. I 'IBTYPE S IBTYPE=1
  1. S IBX="O" D TYPE^IBAUTL2 G:IBY<0 NEWQ
  1. S IBUNIT=1,(IBFR,IBTO)=IBDAT,IBEVDA="*"
  1. D ADD^IBECEAU3 G:IBY<0 NEWQ
  1. ;
  1. ; - if enctr is exempt from classification, but patient isn't, send msg
  1. I $$EXOE^SDCOU2($S($G(IBOEN):IBOEN,1:IBOE)),$$CLPT(DFN,IBDAT) D BULL^IBAMTS
  1. ;
  1. ; - if the opt billing rate is over a year old, place the charge on hold
  1. ;I $$OLDRATE(IBRTED,IBFR) D G CLOCK
  1. ;.S DIE="^IB(",DA=IBN,DR=".05////20" D ^DIE K DIE,DA,DR
  1. ;
  1. ; - drop the charge into the background filer
  1. D IBFLR G:IBY<0 NEWQ
  1. ;
  1. ; - if there is no active billing clock, add one
  1. CLOCK I '$D(^IBE(351,"ACT",DFN)) S IBCLDT=IBDAT D CLADD^IBAUTL3
  1. ;
  1. NEWQ I IBY<0 D ^IBAERR1
  1. K IBDISP,IBCLSF,IBCLDA,IBMED,IBCLDT,IBN,IBBS,IBTEMP
  1. K IBUNIT,IBFR,IBTO,IBSL,IBEVDA,IBX,IBDESC,IBATYP,IBCHG
  1. Q
  1. ;
  1. CHKS() ; Perform a batch of edits to determine whether to bill.
  1. ; Input variables required: IBEVT -- encounter
  1. ; IBAPTY -- appt type
  1. ; IBDAT -- appt date
  1. ; IBDT -- appt date/time
  1. ; IBORG -- originating process
  1. ; IBDISP -- disposition (if registration)
  1. N IBRESULT
  1. ;
  1. ; default is fail the checks
  1. S IBRESULT=0
  1. ;
  1. ; for appts prior to 12/6/2001
  1. I IBDAT<3011206 D Q IBRESULT
  1. . ; - non-count clinic
  1. . I $P($G(^SC(+$P(IBEVT,"^",4),0)),"^",17)="Y" Q
  1. . ;
  1. . ; - non-billable appointment type
  1. . I $$IGN^IBEFUNC(IBAPTY,IBDAT) Q
  1. . ;
  1. . ; - non-billable disposition/stop code/clinic
  1. . I IBORG=1!(IBORG=2),$$NBCL^IBEFUNC(+$P(IBEVT,"^",4),IBDT) Q
  1. . I IBORG=1!(IBORG=2),$$NBCSC^IBEFUNC(+$P(IBEVT,"^",3),IBDT) Q
  1. . I IBORG=3,$$NBDIS^IBEFUNC(IBDISP,IBDT) Q
  1. . ;
  1. . ; - ignore if checked out late and pt was an inpatient at midnight
  1. . I DT>IBDAT,$$INPT(DFN,IBDAT_".2359") Q
  1. . ;
  1. . ; pass the checks
  1. . S IBRESULT=1
  1. ;
  1. ; for appts on or after 12/6/2001
  1. ;
  1. ; - non-billable appointment type
  1. I $$IGN^IBEFUNC(IBAPTY,IBDAT) Q 0
  1. ;
  1. ; - non-count clinic
  1. I $P($G(^SC(+$P(IBEVT,"^",4),0)),"^",17)="Y" Q 0
  1. ;
  1. ; - ignore if checked out late and pt was an inpatient at midnight
  1. I DT>IBDAT,$$INPT(DFN,IBDAT_".2359") Q 0
  1. ;
  1. ; pass the checks
  1. Q 1
  1. ;
  1. ;
  1. IBFLR ; Drop the charge into the IB Background filer.
  1. N IBSEQNO,IBNOS,IBNOW,IBTOTL,IBSERV,IBWHER,IBFAC,IBSITE,IBAFY,IBARTYP,IBIL,IBTRAN
  1. D NOW^%DTC S IBNOW=%,IBNOS=IBN
  1. S IBSEQNO=$P($G(^IBE(350.1,+IBATYP,0)),"^",5) I 'IBSEQNO S IBY="-1^IB023"
  1. I IBY>0 D ^IBAFIL
  1. Q
  1. ;
  1. CLPT(DFN,VDATE) ; Should the patient be asked the classification questions?
  1. ; Input: DFN -- Pointer to the patient in file #2
  1. ; VDATE -- Visit date
  1. N IBARR D CL^SDCO21(DFN,VDATE,"",.IBARR)
  1. Q $D(IBARR)>0
  1. ;
  1. INPT(DFN,VAINDT) ; Was the patient an inpatient at VAINDT?
  1. ; Input: DFN -- Pointer to the patient in file #2
  1. ; VAINDT -- Date/time to check for inpatient status
  1. ; Output: 1 - inpatient | 0 - not an inpatient
  1. N VADMVT D ADM^VADPT2
  1. Q VADMVT>0
  1. ;
  1. CLSF(IBUPD,Y) ; Examine classification questions.
  1. ; Input: IBUPD -- 0 if event just checked out
  1. ; 1 if event is being updated
  1. ; Y -- array to place output
  1. ; Output: indicators returned as ao^ir^sc^swa^mst^hnc^cv^shad [1|yes, 0|no]
  1. ; if IBUPD=0, Y is returned as a single string
  1. ; if IBUPD=1, Y("BEFORE"),Y("AFTER") are defined.
  1. N X,ZA,ZB S:'$G(IBUPD) Y="" S:$G(IBUPD) (Y("BEFORE"),Y("AFTER"))=""
  1. 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
  1. .I '$G(IBUPD) S:ZA $P(Y,"^",+ZA)=+$P(ZA,"^",3) Q
  1. .S $P(Y("BEFORE"),"^",+ZB)=+$P(ZB,"^",3),$P(Y("AFTER"),"^",+ZA)=+$P(ZA,"^",3)
  1. Q
  1. ;
  1. OLDRATE(IBRTED,IBFR) ; See if the copay rate effective date is too old.
  1. ; Input: IBRTED -- Charge Effective Date
  1. ; IBFR -- Visit Date
  1. ; Output: 1 -- Effective Date is too old
  1. ; 0 -- Not
  1. ;
  1. N IBNUM,IBYR
  1. S IBNUM=$$FMDIFF^XLFDT(IBFR,IBRTED),IBYR=$E(IBFR,1,3)
  1. Q IBYR#4&(IBNUM>364)!(IBYR#4=0&(IBNUM>365))
  1. ;
  1. ;
  1. CHKPRIM ; check to see if patient has been billed for primary
  1. ; and this is a specialty stop. if so, cancel the primary
  1. ; bill and let the software create the new specialty charge
  1. ; input ibbilled = last parent bill to check (ien 350)
  1. ; used to check the rate
  1. ; output ibbilled = last parent bill number to prevent
  1. ; adding specialty charge
  1. N %,IBSTOPDA,IBTYPE,IBCRES,IBI,IBS
  1. ;
  1. ; get the stop code for the 2nd visit on the same day
  1. S IBSTOPDA=$$GETSC^IBEMTSCU("409.68:"_IBOE,IBDAT) I 'IBSTOPDA Q
  1. ;
  1. ; get the rate, ibtype = primary or specialty
  1. S IBTYPE=$P(^IBE(352.5,IBSTOPDA,0),"^",3)
  1. ; if the new appt is not specialty, quit ... no need to create
  1. ; a new charge
  1. I IBTYPE'=2 Q
  1. ;
  1. ; if the last charge was billed at specialty, quit
  1. I $P($G(^IBE(352.5,+$P($G(^IB(+IBBILLED,0)),"^",20),0)),"^",3)=2 Q
  1. ;
  1. ; cancel the charge
  1. ; cancellation reason = billed at higher tier rate
  1. S IBCRES=6,IBS=$P($G(^IB(+IBBILLED,0)),"^",5)
  1. ;
  1. ; if not billed, on hold, or cancelled wait
  1. 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
  1. ;
  1. D CANC^IBAMTS2
  1. D UPDCANC^IBAMTC(+IBBILLED) ; update MH visit tracking for cancelled charge IB*2.0*760
  1. ;
  1. ; set ibbilled = 0 to create the specialty charge
  1. S IBBILLED=0
  1. Q
  1. ;