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)
