- 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 Jan 18, 2025@03:30:17 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