- IBOBCC ;ALB/ARH - UNBILLED APPOINTMENT BASC FOR INSURED PATIENTS ; 2/27/92
- ;;Version 2.0 ; INTEGRATED BILLING ;; 21-MAR-94
- ;
- EN ;get date range then run the report
- ;I $D(XRT0) S:'$D(XRTN) XRTN="IBOBCC" D T1^%ZOSV ;stop rt clock
- ;S XRTL=$ZU(0),XRTN="IBOBCC-1" D T0^%ZOSV ;start rt clock
- S IBHDR="UNBILLED BASC FOR INSURED PATIENT APPOINTMENTS" D HOME^%ZIS
- W @IOF W !!,?15,"Report Unbilled BASC for Insured Patient Appointments",!!!!
- D BDT^IBOUTL G:Y<0!(IBBDT="")!(IBEDT="") EXIT
- DEV ;get the device
- W !!,"Report requires 132 columns."
- S %ZIS="QM",%ZIS("A")="OUTPUT DEVICE: " D ^%ZIS G:POP EXIT
- I $D(IO("Q")) S ZTRTN="EN1^IBOBCC",ZTDESC=IBHDR,ZTSAVE("IB*")="" D ^%ZTLOAD K IO("Q"),ZTSK G EXIT
- U IO D EN1 D ^%ZISC
- ;
- EXIT ;clean up and quit
- ;I $D(XRT0) S:'$D(XRTN) XRTN="IBOBCC" D T1^%ZOSV ;stop clock
- I $D(ZTQUEUED) S ZTREQ="@" Q
- K IBBDT,IBEDT,IBHDR,X,Y,DTOUT,DUOUT,DIRUT,DIROUT
- Q
- ;
- EN1 ;entry pt. for tasked jobs
- ;I $D(XRT0) S:'$D(XRTN) XRTN="IBOBCC" D T1^%ZOSV ;stop rt clock
- ;S XRTL=$ZU(0),XRTN="IBOBCC-2" D T0^%ZOSV ;start rt clock
- ;find, save, and print each BASC entered in scheduling that has not been entered in billing (or doesn't/can't match)
- ;for each patient appointment in scheduling, where patient has active insurance, and billable CPTs entered for appointment
- ;must match between scheduling and billing: DFN, CPT, appointment date (procedure date) (doesn't match clinics)
- APPT ;get all BASC CPTs for appointments in date range for patients with insurance
- S IBE=IBEDT+.3,IBADT=IBBDT-.001,IBQ=0
- F S IBADT=$O(^SDV("AP",IBADT)) Q:'IBADT!(IBADT>IBE)!IBQ S IBX="" D S IBQ=$$STOP
- . F S IBX=$O(^SDV("AP",IBADT,IBX)) Q:'IBX D
- .. S IBAD=$E(IBADT,1,7),(DFN,IBDFN)=^(IBX),IBINDT=IBAD D ^IBCNS Q:'IBINS
- .. S IBPR=$G(^SDV(IBADT,"CS",IBX,"PR")) I IBPR D
- ... F IBI=1:1 S IBCPT=$P(IBPR,"^",IBI) Q:'IBCPT I $$CPTBSTAT^IBEFUNC1(IBCPT,IBAD) D
- .... S ^TMP("IBBC",$J,IBDFN,IBAD,IBCPT)=$G(^TMP("IBBC",$J,IBDFN,IBAD,IBCPT))+1
- K IBE,IBADT,IBDFN,IBAD,IBX,IBPR,IBI,IBCPT,DFN,IBINDT,IBINS
- ;
- G:'$D(^TMP("IBBC",$J))!IBQ PRINT
- BILLED ;determine which BASC procedures from scheduling were actually entered in billing
- ;try to match scheduling and billing, the scheduling appointment date (^SDV) and the billing procedure date (^IB) must be
- ;the same to be able to match procedures between scheduling and billing
- S IBDFN="" F S IBDFN=$O(^TMP("IBBC",$J,IBDFN)) Q:(IBDFN'?1N.N)!IBQ S IBAD="" D S IBQ=$$STOP
- . F S IBAD=$O(^TMP("IBBC",$J,IBDFN,IBAD)) Q:IBAD="" S IBCPT="" D
- .. F S IBCPT=$O(^TMP("IBBC",$J,IBDFN,IBAD,IBCPT)) Q:IBCPT="" S IBCNT=^(IBCPT) I $D(^DGCR(399,"ASD",-IBAD,IBCPT)) D
- ... S IBBN="" F S IBBN=$O(^DGCR(399,"ASD",-IBAD,IBCPT,IBBN)) Q:IBBN=""!(IBCNT'>0) I $D(^DGCR(399,"C",IBDFN,IBBN)) D
- .... S IBX="" F S IBX=$O(^DGCR(399,"ASD",-IBAD,IBCPT,IBBN,IBX)) Q:IBX=""!(IBCNT'>0) S IBCNT=IBCNT-1
- ... I IBCNT'>0 K ^TMP("IBBC",$J,IBDFN,IBAD,IBCPT) Q
- ... S ^TMP("IBBC",$J,IBDFN,IBAD,IBCPT)=IBCNT
- .. I $D(^TMP("IBBC",$J,IBDFN,IBAD)) S ^TMP("IBBC",$J,"N",$P($G(^DPT(IBDFN,0)),"^",1),IBDFN)=""
- K IBDFN,IBAD,IBCPT,IBCNT,IBBN,IBX
- ;
- PRINT G PRINT^IBOBCC1
- Q
- ;
- STOP() ;determine if user requested task to be stopped
- I $D(ZTQUEUED),$$S^%ZTLOAD S ZTSTOP=1 K ZTREQ I +$G(IBPGN) W !!,"TASK STOPPED BY USER",!!
- Q +$G(ZTSTOP)
- IBOBCC ;ALB/ARH - UNBILLED APPOINTMENT BASC FOR INSURED PATIENTS ; 2/27/92
- +1 ;;Version 2.0 ; INTEGRATED BILLING ;; 21-MAR-94
- +2 ;
- EN ;get date range then run the report
- +1 ;I $D(XRT0) S:'$D(XRTN) XRTN="IBOBCC" D T1^%ZOSV ;stop rt clock
- +2 ;S XRTL=$ZU(0),XRTN="IBOBCC-1" D T0^%ZOSV ;start rt clock
- +3 SET IBHDR="UNBILLED BASC FOR INSURED PATIENT APPOINTMENTS"
- DO HOME^%ZIS
- +4 WRITE @IOF
- WRITE !!,?15,"Report Unbilled BASC for Insured Patient Appointments",!!!!
- +5 DO BDT^IBOUTL
- IF Y<0!(IBBDT="")!(IBEDT="")
- GOTO EXIT
- DEV ;get the device
- +1 WRITE !!,"Report requires 132 columns."
- +2 SET %ZIS="QM"
- SET %ZIS("A")="OUTPUT DEVICE: "
- DO ^%ZIS
- IF POP
- GOTO EXIT
- +3 IF $DATA(IO("Q"))
- SET ZTRTN="EN1^IBOBCC"
- SET ZTDESC=IBHDR
- SET ZTSAVE("IB*")=""
- DO ^%ZTLOAD
- KILL IO("Q"),ZTSK
- GOTO EXIT
- +4 USE IO
- DO EN1
- DO ^%ZISC
- +5 ;
- EXIT ;clean up and quit
- +1 ;I $D(XRT0) S:'$D(XRTN) XRTN="IBOBCC" D T1^%ZOSV ;stop clock
- +2 IF $DATA(ZTQUEUED)
- SET ZTREQ="@"
- QUIT
- +3 KILL IBBDT,IBEDT,IBHDR,X,Y,DTOUT,DUOUT,DIRUT,DIROUT
- +4 QUIT
- +5 ;
- EN1 ;entry pt. for tasked jobs
- +1 ;I $D(XRT0) S:'$D(XRTN) XRTN="IBOBCC" D T1^%ZOSV ;stop rt clock
- +2 ;S XRTL=$ZU(0),XRTN="IBOBCC-2" D T0^%ZOSV ;start rt clock
- +3 ;find, save, and print each BASC entered in scheduling that has not been entered in billing (or doesn't/can't match)
- +4 ;for each patient appointment in scheduling, where patient has active insurance, and billable CPTs entered for appointment
- +5 ;must match between scheduling and billing: DFN, CPT, appointment date (procedure date) (doesn't match clinics)
- APPT ;get all BASC CPTs for appointments in date range for patients with insurance
- +1 SET IBE=IBEDT+.3
- SET IBADT=IBBDT-.001
- SET IBQ=0
- +2 FOR
- SET IBADT=$ORDER(^SDV("AP",IBADT))
- IF 'IBADT!(IBADT>IBE)!IBQ
- QUIT
- SET IBX=""
- Begin DoDot:1
- +3 FOR
- SET IBX=$ORDER(^SDV("AP",IBADT,IBX))
- IF 'IBX
- QUIT
- Begin DoDot:2
- +4 SET IBAD=$EXTRACT(IBADT,1,7)
- SET (DFN,IBDFN)=^(IBX)
- SET IBINDT=IBAD
- DO ^IBCNS
- IF 'IBINS
- QUIT
- +5 SET IBPR=$GET(^SDV(IBADT,"CS",IBX,"PR"))
- IF IBPR
- Begin DoDot:3
- +6 FOR IBI=1:1
- SET IBCPT=$PIECE(IBPR,"^",IBI)
- IF 'IBCPT
- QUIT
- IF $$CPTBSTAT^IBEFUNC1(IBCPT,IBAD)
- Begin DoDot:4
- +7 SET ^TMP("IBBC",$JOB,IBDFN,IBAD,IBCPT)=$GET(^TMP("IBBC",$JOB,IBDFN,IBAD,IBCPT))+1
- End DoDot:4
- End DoDot:3
- End DoDot:2
- End DoDot:1
- SET IBQ=$$STOP
- +8 KILL IBE,IBADT,IBDFN,IBAD,IBX,IBPR,IBI,IBCPT,DFN,IBINDT,IBINS
- +9 ;
- +10 IF '$DATA(^TMP("IBBC",$JOB))!IBQ
- GOTO PRINT
- BILLED ;determine which BASC procedures from scheduling were actually entered in billing
- +1 ;try to match scheduling and billing, the scheduling appointment date (^SDV) and the billing procedure date (^IB) must be
- +2 ;the same to be able to match procedures between scheduling and billing
- +3 SET IBDFN=""
- FOR
- SET IBDFN=$ORDER(^TMP("IBBC",$JOB,IBDFN))
- IF (IBDFN'?1N.N)!IBQ
- QUIT
- SET IBAD=""
- Begin DoDot:1
- +4 FOR
- SET IBAD=$ORDER(^TMP("IBBC",$JOB,IBDFN,IBAD))
- IF IBAD=""
- QUIT
- SET IBCPT=""
- Begin DoDot:2
- +5 FOR
- SET IBCPT=$ORDER(^TMP("IBBC",$JOB,IBDFN,IBAD,IBCPT))
- IF IBCPT=""
- QUIT
- SET IBCNT=^(IBCPT)
- IF $DATA(^DGCR(399,"ASD",-IBAD,IBCPT))
- Begin DoDot:3
- +6 SET IBBN=""
- FOR
- SET IBBN=$ORDER(^DGCR(399,"ASD",-IBAD,IBCPT,IBBN))
- IF IBBN=""!(IBCNT'>0)
- QUIT
- IF $DATA(^DGCR(399,"C",IBDFN,IBBN))
- Begin DoDot:4
- +7 SET IBX=""
- FOR
- SET IBX=$ORDER(^DGCR(399,"ASD",-IBAD,IBCPT,IBBN,IBX))
- IF IBX=""!(IBCNT'>0)
- QUIT
- SET IBCNT=IBCNT-1
- End DoDot:4
- +8 IF IBCNT'>0
- KILL ^TMP("IBBC",$JOB,IBDFN,IBAD,IBCPT)
- QUIT
- +9 SET ^TMP("IBBC",$JOB,IBDFN,IBAD,IBCPT)=IBCNT
- End DoDot:3
- +10 IF $DATA(^TMP("IBBC",$JOB,IBDFN,IBAD))
- SET ^TMP("IBBC",$JOB,"N",$PIECE($GET(^DPT(IBDFN,0)),"^",1),IBDFN)=""
- End DoDot:2
- End DoDot:1
- SET IBQ=$$STOP
- +11 KILL IBDFN,IBAD,IBCPT,IBCNT,IBBN,IBX
- +12 ;
- PRINT GOTO PRINT^IBOBCC1
- +1 QUIT
- +2 ;
- STOP() ;determine if user requested task to be stopped
- +1 IF $DATA(ZTQUEUED)
- IF $$S^%ZTLOAD
- SET ZTSTOP=1
- KILL ZTREQ
- IF +$GET(IBPGN)
- WRITE !!,"TASK STOPPED BY USER",!!
- +2 QUIT +$GET(ZTSTOP)
