IBAMTS1 ;ALB/CPM - PROCESS NEW OUTPATIENT ENCOUNTERS ; 22-JUL-93
;;Version 2.0 ; INTEGRATED BILLING ;; 21-MAR-94
;;Per VHA Directive 10-93-142, this routine should not be modified.
;
NEW ; Appointment fully processed - prepare a new charge.
;
I IBBILLED G NEWQ ; patient has already been billed on this date
;
; - 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 Category C
;
; - perform batch of edits
I '$$CHKS G NEWQ
;
; - quit if AO/IR/EC exposure is indicated
D CLSF(0,.IBCLSF)
I +IBCLSF!($P(IBCLSF,"^",2))!($P(IBCLSF,"^",4)) G NEWQ
;
S IBSL="409.68:"_IBOE
;
BLD ; - build the charge. May also enter from IBAMTS2 (requires IBSL)
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 stop is exempt from classification, but patient isn't, send msg
I IBORG=2,$$CLPT(DFN,IBDAT),$$EX^SDCOU2(+$P(IBEVT,"^",3),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 Y S Y=0
;
; - non-count clinic
I $P($G(^SC(+$P(IBEVT,"^",4),0)),"^",17)="Y" G CHKSQ
;
; - non-billable appointment type
I $$IGN^IBEFUNC(IBAPTY,IBDAT) G CHKSQ
;
; - non-billable disposition/stop code/clinic
I IBORG=1!(IBORG=2),$$NBCL^IBEFUNC(+$P(IBEVT,"^",4),IBDT) G CHKSQ
I IBORG=2,$$NBCSC^IBEFUNC(+$P(IBEVT,"^",3),IBDT) G CHKSQ
I IBORG=3,$$NBDIS^IBEFUNC(IBDISP,IBDT) G CHKSQ
;
; - ignore if checked out late and pt was an inpatient at midnight
I DT>IBDAT,$$INPT(DFN,IBDAT_".2359") G CHKSQ
;
S Y=1
CHKSQ Q Y
;
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 X D CL^SDCO21(DFN,VDATE,"",.X)
Q $D(X)>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^ec [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))
IBAMTS1 ;ALB/CPM - PROCESS NEW OUTPATIENT ENCOUNTERS ; 22-JUL-93
+1 ;;Version 2.0 ; INTEGRATED BILLING ;; 21-MAR-94
+2 ;;Per VHA Directive 10-93-142, this routine should not be modified.
+3 ;
NEW ; Appointment fully processed - prepare a new charge.
+1 ;
+2 ; patient has already been billed on this date
IF IBBILLED
GOTO NEWQ
+3 ;
+4 ; - for registrations, get disposition, and use log-out date/time
+5 IF IBORG=3
Begin DoDot:1
+6 SET IBDISP=+$PIECE($GET(^TMP("SDEVT",$JOB,SDHDL,IBORG,"DIS",0,"AFTER")),"^",7)
+7 IF 'IBDISP
QUIT
+8 SET IBTEMP=+$PIECE($GET(^TMP("SDEVT",$JOB,SDHDL,IBORG,"DIS",0,"AFTER")),"^",6)
+9 IF IBTEMP
SET IBDT=IBTEMP
SET IBDAT=$PIECE(IBDT,".")
End DoDot:1
IF 'IBDISP
GOTO NEWQ
+10 ;
+11 ; patient is not Category C
IF '$$BIL^DGMTUB(DFN,IBDT)
GOTO NEWQ
+12 ;
+13 ; - perform batch of edits
+14 IF '$$CHKS
GOTO NEWQ
+15 ;
+16 ; - quit if AO/IR/EC exposure is indicated
+17 DO CLSF(0,.IBCLSF)
+18 IF +IBCLSF!($PIECE(IBCLSF,"^",2))!($PIECE(IBCLSF,"^",4))
GOTO NEWQ
+19 ;
+20 SET IBSL="409.68:"_IBOE
+21 ;
BLD ; - build the charge. May also enter from IBAMTS2 (requires IBSL)
+1 SET IBX="O"
DO TYPE^IBAUTL2
IF IBY<0
GOTO NEWQ
+2 SET IBUNIT=1
SET (IBFR,IBTO)=IBDAT
SET IBEVDA="*"
+3 DO ADD^IBECEAU3
IF IBY<0
GOTO NEWQ
+4 ;
+5 ; - if stop is exempt from classification, but patient isn't, send msg
+6 IF IBORG=2
IF $$CLPT(DFN,IBDAT)
IF $$EX^SDCOU2(+$PIECE(IBEVT,"^",3),IBDAT)
DO BULL^IBAMTS
+7 ;
+8 ; - if the opt billing rate is over a year old, place the charge on hold
+9 IF $$OLDRATE(IBRTED,IBFR)
Begin DoDot:1
+10 SET DIE="^IB("
SET DA=IBN
SET DR=".05////20"
DO ^DIE
KILL DIE,DA,DR
End DoDot:1
GOTO CLOCK
+11 ;
+12 ; - drop the charge into the background filer
+13 DO IBFLR
IF IBY<0
GOTO NEWQ
+14 ;
+15 ; - 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 Y
SET Y=0
+8 ;
+9 ; - non-count clinic
+10 IF $PIECE($GET(^SC(+$PIECE(IBEVT,"^",4),0)),"^",17)="Y"
GOTO CHKSQ
+11 ;
+12 ; - non-billable appointment type
+13 IF $$IGN^IBEFUNC(IBAPTY,IBDAT)
GOTO CHKSQ
+14 ;
+15 ; - non-billable disposition/stop code/clinic
+16 IF IBORG=1!(IBORG=2)
IF $$NBCL^IBEFUNC(+$PIECE(IBEVT,"^",4),IBDT)
GOTO CHKSQ
+17 IF IBORG=2
IF $$NBCSC^IBEFUNC(+$PIECE(IBEVT,"^",3),IBDT)
GOTO CHKSQ
+18 IF IBORG=3
IF $$NBDIS^IBEFUNC(IBDISP,IBDT)
GOTO CHKSQ
+19 ;
+20 ; - ignore if checked out late and pt was an inpatient at midnight
+21 IF DT>IBDAT
IF $$INPT(DFN,IBDAT_".2359")
GOTO CHKSQ
+22 ;
+23 SET Y=1
CHKSQ QUIT Y
+1 ;
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 X
DO CL^SDCO21(DFN,VDATE,"",.X)
+4 QUIT $DATA(X)>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^ec [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 NEW IBNUM,IBYR
+6 SET IBNUM=$$FMDIFF^XLFDT(IBFR,IBRTED)
SET IBYR=$EXTRACT(IBFR,1,3)
+7 QUIT IBYR#4&(IBNUM>364)!(IBYR#4=0&(IBNUM>365))
