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