IBTUBO1 ;ALB/AAS - UNBILLED AMOUNTS - GENERATE UNBILLED REPORTS ;29-SEP-94
;;2.0;INTEGRATED BILLING;**19,31,32,91,123,159,247,155,277,339,399,516,547**;21-MAR-94;Build 119
;;Per VA Directive 6402, this routine should not be modified.
;
OPT(IBOE,IBQUERY) ; - Has the outpatient encounter been billed?
; Input: IBOE=pointer to outpatient encounter in file #409.68
; (NOTE: this value may be null)
; IBQUERY (Passed by reference)=flag that is incremented when
; the Scheduling query API is invoked
; *Pre-set variables: DFN=patient IEN, IBDT=event date, IBRT=bill rate,
; IBEDT=End of reporting period date.
; IBX=ien of CLAIMS TRACKING entry file 356
;
I '$G(DFN)!('$G(IBDT))!('$G(IBRT))!'$G(IBX) G OPTQ
N IBCN,IBCPT,IBCPTSUM,IBCT,IBDATA,IBDAY,IBDIV,IBFL,IBNAME
N IBQUIT,IBNCF,IBTCHRG,IBXX,IBYD,IBYY,IBZ,IBMRA
;
; - Check to be sure the encounter is billable.
I $$INPT^IBAMTS1(DFN,IBDT\1_.2359) G OPTQ ; Became inpatient same day.
I $G(IBOE),$$ENCL^IBAMTS2(IBOE)["1" G OPTQ ; "ao^ir^sc^swa^mst^hnc^cv^shad" encounter.
S IBDAY=$E(IBDT,1,7),IBNAME=$P($G(^DPT(DFN,0)),U),IBQUIT="",IBNCF=0
;
; - Determine the encounter division.
S IBDIV=+$P($$GETOE^SDOE(IBOE),U,11) S:'IBDIV IBDIV=+$$PRIM^VASITE()
; IB*2.0*516 - Added ability to sort by Division.
I $D(^TMP($J,"IBTUB-DIV")),'$D(^TMP($J,"IBTUB-DIV",IBDIV)) G OPTQ ; Not a selected Division
;
; - If no encounter, see if add/edits or registrations are not billable.
I '$G(IBOE) D NOOE G:IBQUIT OPTQ
;
; - If encounter was dated prior to Reasonable Charges (9/1/99) and
; the claim was not authorized before end of reporting period, add
; encounter Tort Rate to Unbilled Outpatient Amount
I IBDAY<2990901 D PRERC,SETUB:'IBQUIT G OPTQ
I '$G(IBOE) G OPTQ ; If still no encounter, quit.
;
; - If encounter was made after start of Reasonable Charges (9/1/99)
; and any of the encounter's procedure codes have no corresponding
; inst. or prof. claims that were not authorized before end of the
; reporting period, add the charges for the procedures to the
; Unbilled Outpatient Amount.
;
; - Gather all procedures associated with the encounter.
D GETCPT^SDOE(IBOE,"IBYY") G:'$G(IBYY) OPTQ ; Check CPT qty.
;
; - Build array of all billable encounter procedures.
S IBXX=0 F S IBXX=$O(IBYY(IBXX)) Q:'IBXX D
. ;
. ; - Get procedure pointer and code.
. S IBZ=+IBYY(IBXX),IBCN=$P($$CPT^ICPTCOD(IBZ),"^",2)
. ;
. ; - Ignore LAB services for vets with Medicare Supplemental coverage.
. I IBCN>79999,IBCN<90000 Q
. ;
. ; - Get the institutional/professional charge components.
. S IBCPT(IBZ,1)=+$$BICOST^IBCRCI(IBRT,3,IBDAY,"PROCEDURE",IBZ,"",IBDIV,"",1)
. S IBCPT(IBZ,2)=+$$BICOST^IBCRCI(IBRT,3,IBDAY,"PROCEDURE",IBZ,"",IBDIV,"",2)
. ;
. ; - Eliminate components without a charge.
. S IBCPTSUM(IBZ)=+$G(IBCPT(IBZ,1))+$G(IBCPT(IBZ,2))
. I 'IBCPT(IBZ,1) K IBCPT(IBZ,1)
. I 'IBCPT(IBZ,2) K IBCPT(IBZ,2)
. Q
;
I '$D(IBCPT) G OPTQ ; Quit if no billable procedures remain.
;
; - Look at all of the vet's bills for the day and eliminate
; from the array those procedures that have been billed.
S IBXX=0
F S IBXX=$O(^DGCR(399,"AOPV",DFN,IBDAY,IBXX)) Q:'IBXX D
. ;
. ; - Perform general checks on the claim.
. S IBDATA=$$CKBIL^IBTUBOU(IBXX) Q:IBDATA=""
. I $P(IBDATA,U,2)=2 S IBMRA(IBXX)=IBDATA ; MRA request
. S IBNCF=IBNCF+1
. ;
. ; If Compile/Store & Not authorized/MRA requested before reporting period - Quit.
. I $G(IBCOMP),$S('$G(IBMRA(IBXX)):$P(IBDATA,U,3),1:$P(IBDATA,U,6))>IBEDT Q
. ;
. ; - The episode has been billed. Check the revenue code multiple for
. ; all procedures billed on the claim.
. S IBYY=0
. F S IBYY=$O(^DGCR(399,IBXX,"RC",IBYY)) Q:'IBYY S IBYD=^(IBYY,0) D
. . ;
. . ; - Get the procedure code and charge type for the revenue code.
. . S IBZ=$P(IBYD,U,6)
. . S IBCT=$S($P(IBYD,U,12):$P(IBYD,U,12),1:$P(IBDATA,U,4))
. . S IBTCHRG=$P(IBYD,U,4)
. . I 'IBZ!('IBCT) Q ; Can't determine code/charge type for procedure.
. . I $G(IBMRA(IBXX))'="" S:$D(IBCPT(IBZ)) IBCPT("MRA",IBZ,IBCT)=1 Q
. . ; Delete procedure from unbilled procedures array.
. . I $G(IBTCHRG)'<$G(IBCPTSUM(IBZ)) K IBCPT(IBZ) Q
. . I $D(IBCPT(IBZ,IBCT)) K IBCPT(IBZ,IBCT) Q
. . K IBCPT(IBZ)
. . Q
. Q
;
; - Again, quit if no billable procedures remain.
I '$D(IBCPT) G OPTQ
;
; If the IBSBD flag is not set, then reset the Division to be
; 999999. This data will still be included, but the report
; will not be sorted by Division.
;
I '$G(IBSBD) S IBDIV=999999
;
; - The encounter has unbilled procedure codes. Increment the counters
; as per the extract specification.
;
; - Count the encounter (element 37N).
S IBMRA=$S($D(IBCPT("MRA")):1,1:0)
I 'IBMRA D
. S IBUNB(IBDIV,"ENCNTRS")=$G(IBUNB(IBDIV,"ENCNTRS"))+1
. S IBUNB("ENCNTRS")=$G(IBUNB("ENCNTRS"))+1
I $G(IBXTRACT) S IB(14)=IB(14)+1
;
; - Look at all the unbilled procedures.
S IBZ=0 F S IBZ=$O(IBCPT(IBZ)) Q:'IBZ D
. ;
. S IBMRA=$S($D(IBCPT("MRA",IBZ)):1,1:0)
. ; - Count the procedure (element 37M).
. I $G(IBXTRACT) S IB(13)=IB(13)+1
. ;
. ; - Count the institutional component (element 37I) and its
. ; corresponding charge amount (element 37J).
. I $G(IBCPT(IBZ,1)) D
. . I IBMRA D
. . . S IBUNB(IBDIV,"CPTMS-I-MRA")=$G(IBUNB(IBDIV,"CPTMS-I-MRA"))+1
. . . S IBUNB("CPTMS-MRA")=$G(IBUNB("CPTMS-MRA"))+1
. . . S IBUNB(IBDIV,"UNBILOP-MRA")=$G(IBUNB(IBDIV,"UNBILOP-MRA"))+IBCPT(IBZ,1)
. . . S IBUNB("UNBILOP-MRA")=$G(IBUNB("UNBILOP-MRA"))+IBCPT(IBZ,1)
. . . Q
. . E D
. . . S IBUNB(IBDIV,"CPTMS-I")=$G(IBUNB(IBDIV,"CPTMS-I"))+1
. . . S IBUNB("CPTMS")=$G(IBUNB("CPTMS"))+1
. . . S IBUNB(IBDIV,"UNBILOP")=$G(IBUNB(IBDIV,"UNBILOP"))+IBCPT(IBZ,1)
. . . S IBUNB("UNBILOP")=$G(IBUNB("UNBILOP"))+IBCPT(IBZ,1)
. . . Q
. . I $G(IBXTRACT) S IB(9)=IB(9)+1,IB(10)=IB(10)+IBCPT(IBZ,1)
. . Q
. ;
. ; - Count the professional component (element 37K) and its
. ; corresponding charge amount (element 37L).
. I $G(IBCPT(IBZ,2)) D
. . I IBMRA D
. . . S IBUNB(IBDIV,"CPTMS-P-MRA")=$G(IBUNB(IBDIV,"CPTMS-P-MRA"))+1
. . . S IBUNB("CPTMS-MRA")=$G(IBUNB("CPTMS-MRA"))+1
. . . S IBUNB(IBDIV,"UNBILOP-MRA")=$G(IBUNB(IBDIV,"UNBILOP-MRA"))+IBCPT(IBZ,2)
. . . S IBUNB("UNBILOP-MRA")=$G(IBUNB("UNBILOP-MRA"))+IBCPT(IBZ,2)
. . . Q
. . E D
. . . S IBUNB(IBDIV,"CPTMS-P")=$G(IBUNB(IBDIV,"CPTMS-P"))+1
. . . S IBUNB("CPTMS")=$G(IBUNB("CPTMS"))+1
. . . S IBUNB(IBDIV,"UNBILOP")=$G(IBUNB(IBDIV,"UNBILOP"))+IBCPT(IBZ,2)
. . . S IBUNB("UNBILOP")=$G(IBUNB("UNBILOP"))+IBCPT(IBZ,2)
. . . Q
. . I $G(IBXTRACT) S IB(11)=IB(11)+1,IB(12)=IB(12)+IBCPT(IBZ,2)
. . Q
. Q
;
D SETUB
;
OPTQ Q
;
PRERC ; - Determine if a pre-9/1/99 visit has been billed.
; Output: IBQUIT will be set to 1 if the visit has been billed.
; *Pre-set variables DFN,IBDAY,IBDET,IBNAME,IBNCF,IBQUIT,IBRT,IBEDT
; and IB/IBUNB arrays required.
; NO MRA Extract code needed for pre-RC processes
;
S IBDIV=0
F S IBDIV=$O(^TMP($J,"IBTUB",IBDIV)) Q:'IBDIV D I IBQUIT Q
. I $D(^TMP($J,"IBTUB",IBDIV,"OPT",IBNAME_"@@"_DFN,IBDAY)) S IBQUIT=1
I IBQUIT G PRCQ
;
; - Check all outpatient claims on event date.
N IBXX S IBXX=0
F S IBXX=$O(^DGCR(399,"AOPV",DFN,IBDAY,IBXX)) Q:'IBXX D Q:IBQUIT
. ;
. ; - Perform general checks on the claim.
. S IBDATA=$$CKBIL^IBTUBOU(IBXX) Q:IBDATA="" S IBNCF=IBNCF+1
. I IBDIV="" S IBDIV=$$GET1^DIQ(399,IBXX_",",.22,"I")
. ;
. ; If Compile/Store & Not authorized before reporting period - Quit.
. I $G(IBCOMP),$P(IBDATA,U,3)>IBEDT Q
. ;
. S IBQUIT=1 ; Episode has been billed-set flag.
. Q
;
I IBQUIT G PRCQ ; Episode was billed.
I IBDIV="" S IBDIV=999999
;
; - The episode was not billed; determine the tort rate for a visit
; and increment the number and amount of unbilled pre-9/1/99 visits.
S IBXX=+$$BICOST^IBCRCI(IBRT,3,IBDAY,"OUTPATIENT VISIT DATE")
S IBUNB(IBDIV,"UNBILOP")=$G(IBUNB(IBDIV,"UNBILOP"))+IBXX
S IBUNB("UNBILOP")=$G(IBUNB("UNBILOP"))+IBXX
S IBUNB(IBDIV,"ENCNTRS")=$G(IBUNB(IBDIV,"ENCNTRS"))+1
S IBUNB("ENCNTRS")=$G(IBUNB("ENCNTRS"))+1
;
I $G(IBXTRACT) S IB(7)=IB(7)+1,IB(8)=IB(8)+IBXX ; For DM extract.
;
PRCQ Q
;
NOOE ; - If there is no encounter, look for add/edits or registrations.
; Output: IBQUIT will be set to 1 if the visit is non-billable.
; *Pre-set variable IBQUIT required.
N IBDATA,IBSC,IBSDV,IBXX,IBZERR
;
; - Check if for a visit at the visit date/time.
S IBXX=$$EXOE^SDOE(DFN,IBDT,IBDT,"","IBZERR")
I IBXX D CKENC^IBTUBOU(IBXX,"",.IBQUIT) G NOOEQ
;
; - Find next add/edit stop code encounter after IBDT.
D SCAN^IBTUBOU(DFN,IBDT,.IBQUERY)
;
NOOEQ Q
;
SETUB ; Set array elements for the detail report.
; Array element format:
; NON-MRA:
; ^TMP($J,"IBTUB",DIVISION,"OPT",NAME@@DFN,DATE,IBX)=bill status^claim type
; ^TMP($J,"IBTUB",DIVISION,"OPT",NAME@@DFN,DATE,IBX,CPT no)=inst rate^prof rate
; MRA:
; ^TMP($J,"IBTUB",DIVISION,"OPT_MRA",NAME@@DFN,DATE,IBX,CPT no)=1 if MRA req
;
N IBCTF,IBCPTNM
I $S($G(IBINMRA):1,1:'$O(IBCPT("MRA",""))) S ^TMP($J,"IBTUB",IBDIV,"OPT",IBNAME_"@@"_DFN,IBDAY,IBX)=IBNCF
I $G(IBINMRA),$O(IBCPT("MRA","")) S ^TMP($J,"IBTUB",IBDIV,"OPT_MRA",IBNAME_"@@"_DFN,IBDAY,IBX)=1
G:'IBDET SETUBQ
I $D(IBCPT) S IBXX=0 F S IBXX=$O(IBCPT(IBXX)) Q:'IBXX D
. S IBCPTNM=$$CODEC^ICPTCOD(IBXX) I IBCPTNM=-1 S IBCPTNM="UNK"
. S IBCTF=$S($G(IBCPT(IBXX,1)):"I",1:"")
. S IBCTF=$S($G(IBCPT(IBXX,2)):$S(IBCTF="I":"I,P",1:"P"),1:IBCTF)
. I $S($G(IBINMRA):1,1:'$O(IBCPT("MRA",""))) S ^TMP($J,"IBTUB",IBDIV,"OPT",IBNAME_"@@"_DFN,IBDAY,IBX,IBCPTNM)=+$G(IBCPT(IBXX,1))_U_+$G(IBCPT(IBXX,2))_U_IBCTF
. I $G(IBINMRA) S:$G(IBCPT("MRA",IBXX)) ^TMP($J,"IBTUB",IBDIV,"OPT_MRA",IBNAME_"@@"_DFN,IBDAY,IBX,IBCPTNM)=1
. Q
;
SETUBQ Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HIBTUBO1 9986 printed Dec 13, 2024@02:29:06 Page 2
IBTUBO1 ;ALB/AAS - UNBILLED AMOUNTS - GENERATE UNBILLED REPORTS ;29-SEP-94
+1 ;;2.0;INTEGRATED BILLING;**19,31,32,91,123,159,247,155,277,339,399,516,547**;21-MAR-94;Build 119
+2 ;;Per VA Directive 6402, this routine should not be modified.
+3 ;
OPT(IBOE,IBQUERY) ; - Has the outpatient encounter been billed?
+1 ; Input: IBOE=pointer to outpatient encounter in file #409.68
+2 ; (NOTE: this value may be null)
+3 ; IBQUERY (Passed by reference)=flag that is incremented when
+4 ; the Scheduling query API is invoked
+5 ; *Pre-set variables: DFN=patient IEN, IBDT=event date, IBRT=bill rate,
+6 ; IBEDT=End of reporting period date.
+7 ; IBX=ien of CLAIMS TRACKING entry file 356
+8 ;
+9 IF '$GET(DFN)!('$GET(IBDT))!('$GET(IBRT))!'$GET(IBX)
GOTO OPTQ
+10 NEW IBCN,IBCPT,IBCPTSUM,IBCT,IBDATA,IBDAY,IBDIV,IBFL,IBNAME
+11 NEW IBQUIT,IBNCF,IBTCHRG,IBXX,IBYD,IBYY,IBZ,IBMRA
+12 ;
+13 ; - Check to be sure the encounter is billable.
+14 ; Became inpatient same day.
IF $$INPT^IBAMTS1(DFN,IBDT\1_.2359)
GOTO OPTQ
+15 ; "ao^ir^sc^swa^mst^hnc^cv^shad" encounter.
IF $GET(IBOE)
IF $$ENCL^IBAMTS2(IBOE)["1"
GOTO OPTQ
+16 SET IBDAY=$EXTRACT(IBDT,1,7)
SET IBNAME=$PIECE($GET(^DPT(DFN,0)),U)
SET IBQUIT=""
SET IBNCF=0
+17 ;
+18 ; - Determine the encounter division.
+19 SET IBDIV=+$PIECE($$GETOE^SDOE(IBOE),U,11)
if 'IBDIV
SET IBDIV=+$$PRIM^VASITE()
+20 ; IB*2.0*516 - Added ability to sort by Division.
+21 ; Not a selected Division
IF $DATA(^TMP($JOB,"IBTUB-DIV"))
IF '$DATA(^TMP($JOB,"IBTUB-DIV",IBDIV))
GOTO OPTQ
+22 ;
+23 ; - If no encounter, see if add/edits or registrations are not billable.
+24 IF '$GET(IBOE)
DO NOOE
if IBQUIT
GOTO OPTQ
+25 ;
+26 ; - If encounter was dated prior to Reasonable Charges (9/1/99) and
+27 ; the claim was not authorized before end of reporting period, add
+28 ; encounter Tort Rate to Unbilled Outpatient Amount
+29 IF IBDAY<2990901
DO PRERC
if 'IBQUIT
DO SETUB
GOTO OPTQ
+30 ; If still no encounter, quit.
IF '$GET(IBOE)
GOTO OPTQ
+31 ;
+32 ; - If encounter was made after start of Reasonable Charges (9/1/99)
+33 ; and any of the encounter's procedure codes have no corresponding
+34 ; inst. or prof. claims that were not authorized before end of the
+35 ; reporting period, add the charges for the procedures to the
+36 ; Unbilled Outpatient Amount.
+37 ;
+38 ; - Gather all procedures associated with the encounter.
+39 ; Check CPT qty.
DO GETCPT^SDOE(IBOE,"IBYY")
if '$GET(IBYY)
GOTO OPTQ
+40 ;
+41 ; - Build array of all billable encounter procedures.
+42 SET IBXX=0
FOR
SET IBXX=$ORDER(IBYY(IBXX))
if 'IBXX
QUIT
Begin DoDot:1
+43 ;
+44 ; - Get procedure pointer and code.
+45 SET IBZ=+IBYY(IBXX)
SET IBCN=$PIECE($$CPT^ICPTCOD(IBZ),"^",2)
+46 ;
+47 ; - Ignore LAB services for vets with Medicare Supplemental coverage.
+48 IF IBCN>79999
IF IBCN<90000
QUIT
+49 ;
+50 ; - Get the institutional/professional charge components.
+51 SET IBCPT(IBZ,1)=+$$BICOST^IBCRCI(IBRT,3,IBDAY,"PROCEDURE",IBZ,"",IBDIV,"",1)
+52 SET IBCPT(IBZ,2)=+$$BICOST^IBCRCI(IBRT,3,IBDAY,"PROCEDURE",IBZ,"",IBDIV,"",2)
+53 ;
+54 ; - Eliminate components without a charge.
+55 SET IBCPTSUM(IBZ)=+$GET(IBCPT(IBZ,1))+$GET(IBCPT(IBZ,2))
+56 IF 'IBCPT(IBZ,1)
KILL IBCPT(IBZ,1)
+57 IF 'IBCPT(IBZ,2)
KILL IBCPT(IBZ,2)
+58 QUIT
End DoDot:1
+59 ;
+60 ; Quit if no billable procedures remain.
IF '$DATA(IBCPT)
GOTO OPTQ
+61 ;
+62 ; - Look at all of the vet's bills for the day and eliminate
+63 ; from the array those procedures that have been billed.
+64 SET IBXX=0
+65 FOR
SET IBXX=$ORDER(^DGCR(399,"AOPV",DFN,IBDAY,IBXX))
if 'IBXX
QUIT
Begin DoDot:1
+66 ;
+67 ; - Perform general checks on the claim.
+68 SET IBDATA=$$CKBIL^IBTUBOU(IBXX)
if IBDATA=""
QUIT
+69 ; MRA request
IF $PIECE(IBDATA,U,2)=2
SET IBMRA(IBXX)=IBDATA
+70 SET IBNCF=IBNCF+1
+71 ;
+72 ; If Compile/Store & Not authorized/MRA requested before reporting period - Quit.
+73 IF $GET(IBCOMP)
IF $SELECT('$GET(IBMRA(IBXX)):$PIECE(IBDATA,U,3),1:$PIECE(IBDATA,U,6))>IBEDT
QUIT
+74 ;
+75 ; - The episode has been billed. Check the revenue code multiple for
+76 ; all procedures billed on the claim.
+77 SET IBYY=0
+78 FOR
SET IBYY=$ORDER(^DGCR(399,IBXX,"RC",IBYY))
if 'IBYY
QUIT
SET IBYD=^(IBYY,0)
Begin DoDot:2
+79 ;
+80 ; - Get the procedure code and charge type for the revenue code.
+81 SET IBZ=$PIECE(IBYD,U,6)
+82 SET IBCT=$SELECT($PIECE(IBYD,U,12):$PIECE(IBYD,U,12),1:$PIECE(IBDATA,U,4))
+83 SET IBTCHRG=$PIECE(IBYD,U,4)
+84 ; Can't determine code/charge type for procedure.
IF 'IBZ!('IBCT)
QUIT
+85 IF $GET(IBMRA(IBXX))'=""
if $DATA(IBCPT(IBZ))
SET IBCPT("MRA",IBZ,IBCT)=1
QUIT
+86 ; Delete procedure from unbilled procedures array.
+87 IF $GET(IBTCHRG)'<$GET(IBCPTSUM(IBZ))
KILL IBCPT(IBZ)
QUIT
+88 IF $DATA(IBCPT(IBZ,IBCT))
KILL IBCPT(IBZ,IBCT)
QUIT
+89 KILL IBCPT(IBZ)
+90 QUIT
End DoDot:2
+91 QUIT
End DoDot:1
+92 ;
+93 ; - Again, quit if no billable procedures remain.
+94 IF '$DATA(IBCPT)
GOTO OPTQ
+95 ;
+96 ; If the IBSBD flag is not set, then reset the Division to be
+97 ; 999999. This data will still be included, but the report
+98 ; will not be sorted by Division.
+99 ;
+100 IF '$GET(IBSBD)
SET IBDIV=999999
+101 ;
+102 ; - The encounter has unbilled procedure codes. Increment the counters
+103 ; as per the extract specification.
+104 ;
+105 ; - Count the encounter (element 37N).
+106 SET IBMRA=$SELECT($DATA(IBCPT("MRA")):1,1:0)
+107 IF 'IBMRA
Begin DoDot:1
+108 SET IBUNB(IBDIV,"ENCNTRS")=$GET(IBUNB(IBDIV,"ENCNTRS"))+1
+109 SET IBUNB("ENCNTRS")=$GET(IBUNB("ENCNTRS"))+1
End DoDot:1
+110 IF $GET(IBXTRACT)
SET IB(14)=IB(14)+1
+111 ;
+112 ; - Look at all the unbilled procedures.
+113 SET IBZ=0
FOR
SET IBZ=$ORDER(IBCPT(IBZ))
if 'IBZ
QUIT
Begin DoDot:1
+114 ;
+115 SET IBMRA=$SELECT($DATA(IBCPT("MRA",IBZ)):1,1:0)
+116 ; - Count the procedure (element 37M).
+117 IF $GET(IBXTRACT)
SET IB(13)=IB(13)+1
+118 ;
+119 ; - Count the institutional component (element 37I) and its
+120 ; corresponding charge amount (element 37J).
+121 IF $GET(IBCPT(IBZ,1))
Begin DoDot:2
+122 IF IBMRA
Begin DoDot:3
+123 SET IBUNB(IBDIV,"CPTMS-I-MRA")=$GET(IBUNB(IBDIV,"CPTMS-I-MRA"))+1
+124 SET IBUNB("CPTMS-MRA")=$GET(IBUNB("CPTMS-MRA"))+1
+125 SET IBUNB(IBDIV,"UNBILOP-MRA")=$GET(IBUNB(IBDIV,"UNBILOP-MRA"))+IBCPT(IBZ,1)
+126 SET IBUNB("UNBILOP-MRA")=$GET(IBUNB("UNBILOP-MRA"))+IBCPT(IBZ,1)
+127 QUIT
End DoDot:3
+128 IF '$TEST
Begin DoDot:3
+129 SET IBUNB(IBDIV,"CPTMS-I")=$GET(IBUNB(IBDIV,"CPTMS-I"))+1
+130 SET IBUNB("CPTMS")=$GET(IBUNB("CPTMS"))+1
+131 SET IBUNB(IBDIV,"UNBILOP")=$GET(IBUNB(IBDIV,"UNBILOP"))+IBCPT(IBZ,1)
+132 SET IBUNB("UNBILOP")=$GET(IBUNB("UNBILOP"))+IBCPT(IBZ,1)
+133 QUIT
End DoDot:3
+134 IF $GET(IBXTRACT)
SET IB(9)=IB(9)+1
SET IB(10)=IB(10)+IBCPT(IBZ,1)
+135 QUIT
End DoDot:2
+136 ;
+137 ; - Count the professional component (element 37K) and its
+138 ; corresponding charge amount (element 37L).
+139 IF $GET(IBCPT(IBZ,2))
Begin DoDot:2
+140 IF IBMRA
Begin DoDot:3
+141 SET IBUNB(IBDIV,"CPTMS-P-MRA")=$GET(IBUNB(IBDIV,"CPTMS-P-MRA"))+1
+142 SET IBUNB("CPTMS-MRA")=$GET(IBUNB("CPTMS-MRA"))+1
+143 SET IBUNB(IBDIV,"UNBILOP-MRA")=$GET(IBUNB(IBDIV,"UNBILOP-MRA"))+IBCPT(IBZ,2)
+144 SET IBUNB("UNBILOP-MRA")=$GET(IBUNB("UNBILOP-MRA"))+IBCPT(IBZ,2)
+145 QUIT
End DoDot:3
+146 IF '$TEST
Begin DoDot:3
+147 SET IBUNB(IBDIV,"CPTMS-P")=$GET(IBUNB(IBDIV,"CPTMS-P"))+1
+148 SET IBUNB("CPTMS")=$GET(IBUNB("CPTMS"))+1
+149 SET IBUNB(IBDIV,"UNBILOP")=$GET(IBUNB(IBDIV,"UNBILOP"))+IBCPT(IBZ,2)
+150 SET IBUNB("UNBILOP")=$GET(IBUNB("UNBILOP"))+IBCPT(IBZ,2)
+151 QUIT
End DoDot:3
+152 IF $GET(IBXTRACT)
SET IB(11)=IB(11)+1
SET IB(12)=IB(12)+IBCPT(IBZ,2)
+153 QUIT
End DoDot:2
+154 QUIT
End DoDot:1
+155 ;
+156 DO SETUB
+157 ;
OPTQ QUIT
+1 ;
PRERC ; - Determine if a pre-9/1/99 visit has been billed.
+1 ; Output: IBQUIT will be set to 1 if the visit has been billed.
+2 ; *Pre-set variables DFN,IBDAY,IBDET,IBNAME,IBNCF,IBQUIT,IBRT,IBEDT
+3 ; and IB/IBUNB arrays required.
+4 ; NO MRA Extract code needed for pre-RC processes
+5 ;
+6 SET IBDIV=0
+7 FOR
SET IBDIV=$ORDER(^TMP($JOB,"IBTUB",IBDIV))
if 'IBDIV
QUIT
Begin DoDot:1
+8 IF $DATA(^TMP($JOB,"IBTUB",IBDIV,"OPT",IBNAME_"@@"_DFN,IBDAY))
SET IBQUIT=1
End DoDot:1
IF IBQUIT
QUIT
+9 IF IBQUIT
GOTO PRCQ
+10 ;
+11 ; - Check all outpatient claims on event date.
+12 NEW IBXX
SET IBXX=0
+13 FOR
SET IBXX=$ORDER(^DGCR(399,"AOPV",DFN,IBDAY,IBXX))
if 'IBXX
QUIT
Begin DoDot:1
+14 ;
+15 ; - Perform general checks on the claim.
+16 SET IBDATA=$$CKBIL^IBTUBOU(IBXX)
if IBDATA=""
QUIT
SET IBNCF=IBNCF+1
+17 IF IBDIV=""
SET IBDIV=$$GET1^DIQ(399,IBXX_",",.22,"I")
+18 ;
+19 ; If Compile/Store & Not authorized before reporting period - Quit.
+20 IF $GET(IBCOMP)
IF $PIECE(IBDATA,U,3)>IBEDT
QUIT
+21 ;
+22 ; Episode has been billed-set flag.
SET IBQUIT=1
+23 QUIT
End DoDot:1
if IBQUIT
QUIT
+24 ;
+25 ; Episode was billed.
IF IBQUIT
GOTO PRCQ
+26 IF IBDIV=""
SET IBDIV=999999
+27 ;
+28 ; - The episode was not billed; determine the tort rate for a visit
+29 ; and increment the number and amount of unbilled pre-9/1/99 visits.
+30 SET IBXX=+$$BICOST^IBCRCI(IBRT,3,IBDAY,"OUTPATIENT VISIT DATE")
+31 SET IBUNB(IBDIV,"UNBILOP")=$GET(IBUNB(IBDIV,"UNBILOP"))+IBXX
+32 SET IBUNB("UNBILOP")=$GET(IBUNB("UNBILOP"))+IBXX
+33 SET IBUNB(IBDIV,"ENCNTRS")=$GET(IBUNB(IBDIV,"ENCNTRS"))+1
+34 SET IBUNB("ENCNTRS")=$GET(IBUNB("ENCNTRS"))+1
+35 ;
+36 ; For DM extract.
IF $GET(IBXTRACT)
SET IB(7)=IB(7)+1
SET IB(8)=IB(8)+IBXX
+37 ;
PRCQ QUIT
+1 ;
NOOE ; - If there is no encounter, look for add/edits or registrations.
+1 ; Output: IBQUIT will be set to 1 if the visit is non-billable.
+2 ; *Pre-set variable IBQUIT required.
+3 NEW IBDATA,IBSC,IBSDV,IBXX,IBZERR
+4 ;
+5 ; - Check if for a visit at the visit date/time.
+6 SET IBXX=$$EXOE^SDOE(DFN,IBDT,IBDT,"","IBZERR")
+7 IF IBXX
DO CKENC^IBTUBOU(IBXX,"",.IBQUIT)
GOTO NOOEQ
+8 ;
+9 ; - Find next add/edit stop code encounter after IBDT.
+10 DO SCAN^IBTUBOU(DFN,IBDT,.IBQUERY)
+11 ;
NOOEQ QUIT
+1 ;
SETUB ; Set array elements for the detail report.
+1 ; Array element format:
+2 ; NON-MRA:
+3 ; ^TMP($J,"IBTUB",DIVISION,"OPT",NAME@@DFN,DATE,IBX)=bill status^claim type
+4 ; ^TMP($J,"IBTUB",DIVISION,"OPT",NAME@@DFN,DATE,IBX,CPT no)=inst rate^prof rate
+5 ; MRA:
+6 ; ^TMP($J,"IBTUB",DIVISION,"OPT_MRA",NAME@@DFN,DATE,IBX,CPT no)=1 if MRA req
+7 ;
+8 NEW IBCTF,IBCPTNM
+9 IF $SELECT($GET(IBINMRA):1,1:'$ORDER(IBCPT("MRA","")))
SET ^TMP($JOB,"IBTUB",IBDIV,"OPT",IBNAME_"@@"_DFN,IBDAY,IBX)=IBNCF
+10 IF $GET(IBINMRA)
IF $ORDER(IBCPT("MRA",""))
SET ^TMP($JOB,"IBTUB",IBDIV,"OPT_MRA",IBNAME_"@@"_DFN,IBDAY,IBX)=1
+11 if 'IBDET
GOTO SETUBQ
+12 IF $DATA(IBCPT)
SET IBXX=0
FOR
SET IBXX=$ORDER(IBCPT(IBXX))
if 'IBXX
QUIT
Begin DoDot:1
+13 SET IBCPTNM=$$CODEC^ICPTCOD(IBXX)
IF IBCPTNM=-1
SET IBCPTNM="UNK"
+14 SET IBCTF=$SELECT($GET(IBCPT(IBXX,1)):"I",1:"")
+15 SET IBCTF=$SELECT($GET(IBCPT(IBXX,2)):$SELECT(IBCTF="I":"I,P",1:"P"),1:IBCTF)
+16 IF $SELECT($GET(IBINMRA):1,1:'$ORDER(IBCPT("MRA","")))
SET ^TMP($JOB,"IBTUB",IBDIV,"OPT",IBNAME_"@@"_DFN,IBDAY,IBX,IBCPTNM)=+$GET(IBCPT(IBXX,1))_U_+$GET(IBCPT(IBXX,2))_U_IBCTF
+17 IF $GET(IBINMRA)
if $GET(IBCPT("MRA",IBXX))
SET ^TMP($JOB,"IBTUB",IBDIV,"OPT_MRA",IBNAME_"@@"_DFN,IBDAY,IBX,IBCPTNM)=1
+18 QUIT
End DoDot:1
+19 ;
SETUBQ QUIT
