- 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))
