- IBECEAU ;ALB/CPM - Cancel/Edit/Add... Utilities ;11-MAR-93
- ;;2.0;INTEGRATED BILLING;**91,249,402,651,663,678,715**;21-MAR-94;Build 25
- ;;Per VHA Directive 6402, this routine should not be modified.
- ;
- CHECK(TALK) ; Retrieve the institution and MAS Service pointer.
- ; Input: TALK -- 1 : do i/o (writes)
- ; 0 : no i/o
- N IBY,Y S (IBY,Y)=1
- D SITE^IBAUTL I Y<1 S IBY=Y W:$G(TALK) !!,"You must define your facility in the IB SITE PARAMETER file before proceeding!",!
- I IBY>0 D SERV^IBAUTL2 I IBY<1 W:$G(TALK) !!,"You must define the MAS Service Pointer in the IB SITE PARAMETER file",!,"before proceeding!",!
- Q IBY>0
- ;
- PAUSE ; Go to end of page to pause.
- N DIR,DIRUT,DUOUT,DTOUT,X,Y
- W ! F Y=$Y:1:21 W !
- S DIR("A")="Press RETURN to process the next charge or to return to the list"
- S DIR(0)="E" D ^DIR K DIR
- Q
- ;
- INPT(DAYS) ; Return a description for Billing Clock days.
- ; Input: DAYS -- Number of days in a billing clock
- ; Output: "1st", "2nd", "3rd", "4th"
- Q $S(DAYS>270:"4th",DAYS>180:"3rd",DAYS>90:"2nd",1:"1st")
- ;
- LAST(PAR) ; Find last action filed for any parent action.
- ; Input: PAR -- Parent IB Action
- ; Output: Last action filed for parent (or parent if none)
- N IBL,IBLDT,IBLAST
- S IBLAST="",IBLDT=$O(^IB("APDT",PAR,"")) I +IBLDT S IBL=0 F S IBL=$O(^IB("APDT",PAR,IBLDT,IBL)) Q:'IBL S IBLAST=IBL
- Q $S(IBLAST:IBLAST,1:PAR)
- ;
- BFO(DFN,DATE) ; Patient Billed For OPT Copay on a specified date?
- ; Input: DFN -- Pointer to the patient in file #2
- ; DATE -- Date of the Outpatient Visit
- ; Output: 0 -- Not billed the OPT copay on the visit date
- ; >0 -- Pointer to charge in file #350 that was billed
- N IBATYP,IBATYPN,IBL,IBND,IBN,Y
- I '$G(DFN)!'$G(DATE) G BFOQ
- S IBN=0 F S IBN=$O(^IB("AFDT",DFN,-DATE,IBN)) Q:'IBN D I ($P(IBATYPN,"^",11)=4)!($P(IBATYPN,"^",11)=8),"^1^3^"[("^"_$P(IBATYP,"^",5)_"^"),"^1^2^3^4^8^20^"[("^"_+$P(IBND,"^",5)_"^") S Y=IBL Q
- .S IBL=$$LAST(+$P($G(^IB(IBN,0)),"^",9)),IBND=$G(^IB(IBL,0))
- .S IBATYP=$G(^IBE(350.1,+$P(IBND,"^",3),0))
- .S IBATYPN=$G(^IBE(350.1,+$P(IBATYP,"^",9),0))
- BFOQ Q +$G(Y)
- ;
- CNP(DFN,DATE) ; Did the patient have a C&P Exam on a specified date?
- ; Input: DFN -- Pointer to the patient in file #2
- ; DATE -- Date of the Outpatient Visit
- ; Output: 0 -- Patient did not have a C&P Exam on the visit date
- ; 1 -- Patient had a C&P Exam on the visit date
- N I,IBD,IBSD,Y,IBVAL,IBCBK,IBFILTER,IBCNP,Z
- I '$G(DFN)!'$G(DATE) G CNPQ
- ; - check appts, stop codes
- S IBVAL("DFN")=DFN,IBVAL("BDT")=DATE,IBVAL("EDT")=DATE+.9999
- ; Only parent appt or add/edit encounters
- S IBFILTER=""
- S IBCBK="I '$P(Y0,U,6),$P(Y0,U,8)<3 N Z S Z=$P(Y0,U,8) I $S(Z=1:$P(Y0,U,10)=1&($P(Y0,U,12)<3),Z=2:$P(Y0,U,10)=1,1:0) S (IBCNP,SDSTOP)=1"
- S IBCNP=0
- D SCAN^IBSDU("PATIENT/DATE",.IBVAL,IBFILTER,IBCBK,1) K ^TMP("DIERR",$J)
- I IBCNP S Y=1
- CNPQ Q +$G(Y)
- ;
- HDR(OPT) ; Display the header for an action
- ; Input: OPT -- Action Header
- N ADD,HDR S ADD=OPT="A D D"
- D CLEAR^VALM1 S IBY=1,HDR=OPT_" A C H A R G E"
- I 'ADD S IBIDX=$G(^TMP("IBACMIDX",$J,IBNBR)),IBN=+$P(IBIDX,"^",4),IBND=$G(^IB(IBN,0))
- W !?(80-$L(HDR)\2),HDR W:'ADD !?29,"Processing Charge #",IBNBR
- W !,$$LINE,!?3,"Name: ",$P(IBNAM,"^") W:'ADD ?41,"Type: ",$P(IBIDX,"^",3)
- I ADD W ?41,"** " W:'IBCLDA "NO " W "ACTIVE BILLING CLOCK **"
- W !?5,"ID: ",$P(IBNAM,"^",2) W:'ADD ?42,"Amt:",$P(IBIDX,"^",5)," (",$P(IBIDX,"^",6),")"
- I ADD,IBCLDA W ?44,"Clock Begin Date: ",$$DAT1^IBOUTL(IBCLDT)
- W !,$$LINE,!
- Q
- ;
- LINE() ; Write a line.
- Q $TR($J("",80)," ","-")
- ;
- CLOCK(IBDOL,IBDAYPR,IBDAY) ; Display and update clock data.
- ; Input: IBDOL -- Dollar amount to add or subtract
- ; IBDAYPR -- Existing number of inpatient days
- ; IBDAY -- Inpatient days to add or subtract
- ; Also assumes that IBCLST,IBNAM, IBCLDA, and IBXA are defined.
- D CLDSP^IBECEAU1(IBCLST,IBNAM) I $P(IBCLST,"^",4)'=1 W !,"** Please note that an active billing clock was not selected for updating **"
- I IBXA=1!(IBXA=2) D CLAMT^IBECEAU1(IBCLST,IBDOL,IBCLDA)
- I IBXA=3 D CLINP^IBECEAU1(IBDAYPR,IBDAY,IBCLDA)
- Q
- ;
- ;IB*2.0*651 - added new duplicate check for medical copays for the date period listed by the copay.
- ;
- BFCHK(DFN,DATE,EDATE) ;
- ; Input: DFN -- Pointer to the patient in file #2
- ; SDATE -- Start Date of the Patient Visit (inpatient or outpatient)
- ; EDATE -- (Optional) End Date of the Patient Visit (inpatient only)
- ;
- ; Output: 0 -- Not billed the OPT copay on the visit date
- ; >0 -- Pointer to charge in file #350 that was billed
- ;
- N IBATYP,IBATYPN,IBATYPNM,IBL,IBND,IBN,Y,SDATE,IBFLG,EDATEH,DATEH,IBLPDT,IBSTAT,IBSEQNM,IBAT,IBATBG,DATEL
- N IBFDT,IBTDT,IBJ,IBDATA,IBTO
- I '$G(DFN)!'$G(DATE) G BFCHKQ
- S EDATE=$G(EDATE) ; ensuring optional end date is initialized.
- S:EDATE="" EDATE=$G(IBTO) ; use the To date
- I EDATE="" S EDATE=DATE ; if no To Date, assume 1 day, use the From date
- ;
- ;Pharmacy copays are allowed to duplicate with other Medical Copays.
- Q:IBXA=5 0
- ;
- ; Check for entries within the given start and end date range
- ;convert to internal dates
- S DATEH=$P($$F2H^XLFDT(DATE),","),EDATEH=$P($$F2H^XLFDT(EDATE),",")
- F IBLPDT=DATEH:1:EDATEH D G:+$G(Y) BFCHKQ
- .S Y=0
- .;Convert looping date back to Fileman Date Format
- .S SDATE=$$H2F^XLFDT(IBLPDT)
- .;Set the correct starting date for the lookup
- .S SDATE=$S($D(^IB("AFDT",DFN,-SDATE)):-SDATE,1:$O(^IB("AFDT",DFN,-SDATE)))
- .Q:SDATE=""
- .S IBN=0 F S IBN=$O(^IB("AFDT",DFN,SDATE,IBN)) Q:'IBN D I 'IBFLG I $P(IBATYPN,U,11)'=5,"^1^3^"[(U_$P(IBATYP,U,5)_U),"^1^2^3^4^8^20^"[(U_+$P(IBND,U,5)_U) S Y=IBL Q
- ..S IBFLG=0
- ..S IBL=$$LAST(+$P($G(^IB(IBN,0)),U,9)),IBND=$G(^IB(IBL,0)),IBFDT=$P(IBND,U,14),IBTDT=$P(IBND,U,15)
- ..S DATEL=-SDATE
- ..I (IBFDT=""),(IBTDT="") S IBFLG=1 Q ;This is a parent Admission (VA/CC/LTC Record. Does not Dup check.
- ..I EDATE<IBFDT S IBFLG=1 Q ;The end date of the bill is prior to the start date of the copay being entered.
- ..I DATE>IBTDT S IBFLG=1 Q ;The start date of the copay being entered is before the end date of the copay being checked.
- ..S IBATYP=$G(^IBE(350.1,+$P(IBND,U,3),0)) ;Grab the action type for the Copay
- ..S IBATYPN=$G(^IBE(350.1,+$P(IBATYP,U,9),0)) ;Grab the associated new Action Type for the Copay
- ..I IBXA=3,$P(IBATYPN,U,11)<3 S IBFLG=1 Q ;Allow Inpatient Per Diem on an Inpatient Copay
- ..; check for Tricare duplicates IB*2.0*715
- ..I IBXA=7 D
- ...I $P(IBATYPN,U,11)'=IBXA S IBFLG=1 Q ; non-Tricare charge is not a duplicate
- ...S IBATYPNM=$P(IBATYPN,U)
- ...I IBATYPNM["RX" S IBFLG=1 Q ; Tricare RX is not a duplicate
- ...Q
- ..;
- ..Q
- .Q
- I IBXA=7 Q 0 ; skip Per Diem check, if copay being charged is Tricare IB*2.0*715
- ;
- ;If the copay being charged is an Inpatient Copay (Bill groups 1 and 2) then skip the Per Diem check, no dup found
- I +IBXA<3,+IBXA>0 Q 0
- ;
- ;IB*2.0*663
- ;Check for an existing duplicate Inpatient Per Diem separately.
- S Y=0
- S IBJ=0 F S IBJ=$O(^IB("C",DFN,IBJ)) Q:'IBJ D Q:+$G(Y)
- . S IBDATA=$G(^IB(IBJ,0)),IBFDT=$P(IBDATA,U,14),IBTDT=$P(IBDATA,U,15),IBAT=$P(IBDATA,U,3),IBSTAT=$P(IBDATA,U,5)
- . Q:IBAT=""
- . S IBATBG=$P($G(^IBE(350.1,IBAT,0)),U,11)
- . Q:IBATBG'=3
- . S IBSEQNM=$P($G(^IBE(350.1,IBAT,0)),U,5)
- . I '$$CHKSTAT(IBSTAT) Q
- . I (IBSEQNM=1)!(IBSEQNM=3) D
- . . Q:EDATE<IBFDT ;The end date of the bill is prior to the start date of the copay being entered.
- . . Q:DATE>IBTDT ;The start date of the copay being entered is before the end date of the copay being checked.
- . . S Y=IBJ
- ;
- BFCHKQ Q +$G(Y)
- ;
- CHKSTAT(IBSTAT) ; Check to see if the status on the copay allows for the copay to be checked for a duplicate
- ;
- ;INPUT: IBSTAT - The status on the copay being evaluated
- ;RETURNS: 1 - Allow the duplicate copay check to continue (for the INCOMPLETE, COMPLETE, BILLED, UPDATED, ON HOLD, HOLD - RATE statuses)
- ; 0 - Don't check for duplication
- ;
- Q:IBSTAT=1 1 ; INCOMPLETE
- Q:IBSTAT=2 1 ; COMPLETE
- Q:IBSTAT=3 1 ; BILLED
- Q:IBSTAT=4 1 ; UPDATED
- Q:IBSTAT=8 1 ; ON HOLD
- Q:IBSTAT=20 1 ; HOLD - RATE status
- Q 0
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HIBECEAU 8336 printed Feb 18, 2025@23:47:54 Page 2
- IBECEAU ;ALB/CPM - Cancel/Edit/Add... Utilities ;11-MAR-93
- +1 ;;2.0;INTEGRATED BILLING;**91,249,402,651,663,678,715**;21-MAR-94;Build 25
- +2 ;;Per VHA Directive 6402, this routine should not be modified.
- +3 ;
- CHECK(TALK) ; Retrieve the institution and MAS Service pointer.
- +1 ; Input: TALK -- 1 : do i/o (writes)
- +2 ; 0 : no i/o
- +3 NEW IBY,Y
- SET (IBY,Y)=1
- +4 DO SITE^IBAUTL
- IF Y<1
- SET IBY=Y
- if $GET(TALK)
- WRITE !!,"You must define your facility in the IB SITE PARAMETER file before proceeding!",!
- +5 IF IBY>0
- DO SERV^IBAUTL2
- IF IBY<1
- if $GET(TALK)
- WRITE !!,"You must define the MAS Service Pointer in the IB SITE PARAMETER file",!,"before proceeding!",!
- +6 QUIT IBY>0
- +7 ;
- PAUSE ; Go to end of page to pause.
- +1 NEW DIR,DIRUT,DUOUT,DTOUT,X,Y
- +2 WRITE !
- FOR Y=$Y:1:21
- WRITE !
- +3 SET DIR("A")="Press RETURN to process the next charge or to return to the list"
- +4 SET DIR(0)="E"
- DO ^DIR
- KILL DIR
- +5 QUIT
- +6 ;
- INPT(DAYS) ; Return a description for Billing Clock days.
- +1 ; Input: DAYS -- Number of days in a billing clock
- +2 ; Output: "1st", "2nd", "3rd", "4th"
- +3 QUIT $SELECT(DAYS>270:"4th",DAYS>180:"3rd",DAYS>90:"2nd",1:"1st")
- +4 ;
- LAST(PAR) ; Find last action filed for any parent action.
- +1 ; Input: PAR -- Parent IB Action
- +2 ; Output: Last action filed for parent (or parent if none)
- +3 NEW IBL,IBLDT,IBLAST
- +4 SET IBLAST=""
- SET IBLDT=$ORDER(^IB("APDT",PAR,""))
- IF +IBLDT
- SET IBL=0
- FOR
- SET IBL=$ORDER(^IB("APDT",PAR,IBLDT,IBL))
- if 'IBL
- QUIT
- SET IBLAST=IBL
- +5 QUIT $SELECT(IBLAST:IBLAST,1:PAR)
- +6 ;
- BFO(DFN,DATE) ; Patient Billed For OPT Copay on a specified date?
- +1 ; Input: DFN -- Pointer to the patient in file #2
- +2 ; DATE -- Date of the Outpatient Visit
- +3 ; Output: 0 -- Not billed the OPT copay on the visit date
- +4 ; >0 -- Pointer to charge in file #350 that was billed
- +5 NEW IBATYP,IBATYPN,IBL,IBND,IBN,Y
- +6 IF '$GET(DFN)!'$GET(DATE)
- GOTO BFOQ
- +7 SET IBN=0
- FOR
- SET IBN=$ORDER(^IB("AFDT",DFN,-DATE,IBN))
- if 'IBN
- QUIT
- Begin DoDot:1
- +8 SET IBL=$$LAST(+$PIECE($GET(^IB(IBN,0)),"^",9))
- SET IBND=$GET(^IB(IBL,0))
- +9 SET IBATYP=$GET(^IBE(350.1,+$PIECE(IBND,"^",3),0))
- +10 SET IBATYPN=$GET(^IBE(350.1,+$PIECE(IBATYP,"^",9),0))
- End DoDot:1
- IF ($PIECE(IBATYPN,"^",11)=4)!($PIECE(IBATYPN,"^",11)=8)
- IF "^1^3^"[("^"_$PIECE(IBATYP,"^",5)_"^")
- IF "^1^2^3^4^8^20^"[("^"_+$PIECE(IBND,"^",5)_"^")
- SET Y=IBL
- QUIT
- BFOQ QUIT +$GET(Y)
- +1 ;
- CNP(DFN,DATE) ; Did the patient have a C&P Exam on a specified date?
- +1 ; Input: DFN -- Pointer to the patient in file #2
- +2 ; DATE -- Date of the Outpatient Visit
- +3 ; Output: 0 -- Patient did not have a C&P Exam on the visit date
- +4 ; 1 -- Patient had a C&P Exam on the visit date
- +5 NEW I,IBD,IBSD,Y,IBVAL,IBCBK,IBFILTER,IBCNP,Z
- +6 IF '$GET(DFN)!'$GET(DATE)
- GOTO CNPQ
- +7 ; - check appts, stop codes
- +8 SET IBVAL("DFN")=DFN
- SET IBVAL("BDT")=DATE
- SET IBVAL("EDT")=DATE+.9999
- +9 ; Only parent appt or add/edit encounters
- +10 SET IBFILTER=""
- +11 SET IBCBK="I '$P(Y0,U,6),$P(Y0,U,8)<3 N Z S Z=$P(Y0,U,8) I $S(Z=1:$P(Y0,U,10)=1&($P(Y0,U,12)<3),Z=2:$P(Y0,U,10)=1,1:0) S (IBCNP,SDSTOP)=1"
- +12 SET IBCNP=0
- +13 DO SCAN^IBSDU("PATIENT/DATE",.IBVAL,IBFILTER,IBCBK,1)
- KILL ^TMP("DIERR",$JOB)
- +14 IF IBCNP
- SET Y=1
- CNPQ QUIT +$GET(Y)
- +1 ;
- HDR(OPT) ; Display the header for an action
- +1 ; Input: OPT -- Action Header
- +2 NEW ADD,HDR
- SET ADD=OPT="A D D"
- +3 DO CLEAR^VALM1
- SET IBY=1
- SET HDR=OPT_" A C H A R G E"
- +4 IF 'ADD
- SET IBIDX=$GET(^TMP("IBACMIDX",$JOB,IBNBR))
- SET IBN=+$PIECE(IBIDX,"^",4)
- SET IBND=$GET(^IB(IBN,0))
- +5 WRITE !?(80-$LENGTH(HDR)\2),HDR
- if 'ADD
- WRITE !?29,"Processing Charge #",IBNBR
- +6 WRITE !,$$LINE,!?3,"Name: ",$PIECE(IBNAM,"^")
- if 'ADD
- WRITE ?41,"Type: ",$PIECE(IBIDX,"^",3)
- +7 IF ADD
- WRITE ?41,"** "
- if 'IBCLDA
- WRITE "NO "
- WRITE "ACTIVE BILLING CLOCK **"
- +8 WRITE !?5,"ID: ",$PIECE(IBNAM,"^",2)
- if 'ADD
- WRITE ?42,"Amt:",$PIECE(IBIDX,"^",5)," (",$PIECE(IBIDX,"^",6),")"
- +9 IF ADD
- IF IBCLDA
- WRITE ?44,"Clock Begin Date: ",$$DAT1^IBOUTL(IBCLDT)
- +10 WRITE !,$$LINE,!
- +11 QUIT
- +12 ;
- LINE() ; Write a line.
- +1 QUIT $TRANSLATE($JUSTIFY("",80)," ","-")
- +2 ;
- CLOCK(IBDOL,IBDAYPR,IBDAY) ; Display and update clock data.
- +1 ; Input: IBDOL -- Dollar amount to add or subtract
- +2 ; IBDAYPR -- Existing number of inpatient days
- +3 ; IBDAY -- Inpatient days to add or subtract
- +4 ; Also assumes that IBCLST,IBNAM, IBCLDA, and IBXA are defined.
- +5 DO CLDSP^IBECEAU1(IBCLST,IBNAM)
- IF $PIECE(IBCLST,"^",4)'=1
- WRITE !,"** Please note that an active billing clock was not selected for updating **"
- +6 IF IBXA=1!(IBXA=2)
- DO CLAMT^IBECEAU1(IBCLST,IBDOL,IBCLDA)
- +7 IF IBXA=3
- DO CLINP^IBECEAU1(IBDAYPR,IBDAY,IBCLDA)
- +8 QUIT
- +9 ;
- +10 ;IB*2.0*651 - added new duplicate check for medical copays for the date period listed by the copay.
- +11 ;
- BFCHK(DFN,DATE,EDATE) ;
- +1 ; Input: DFN -- Pointer to the patient in file #2
- +2 ; SDATE -- Start Date of the Patient Visit (inpatient or outpatient)
- +3 ; EDATE -- (Optional) End Date of the Patient Visit (inpatient only)
- +4 ;
- +5 ; Output: 0 -- Not billed the OPT copay on the visit date
- +6 ; >0 -- Pointer to charge in file #350 that was billed
- +7 ;
- +8 NEW IBATYP,IBATYPN,IBATYPNM,IBL,IBND,IBN,Y,SDATE,IBFLG,EDATEH,DATEH,IBLPDT,IBSTAT,IBSEQNM,IBAT,IBATBG,DATEL
- +9 NEW IBFDT,IBTDT,IBJ,IBDATA,IBTO
- +10 IF '$GET(DFN)!'$GET(DATE)
- GOTO BFCHKQ
- +11 ; ensuring optional end date is initialized.
- SET EDATE=$GET(EDATE)
- +12 ; use the To date
- if EDATE=""
- SET EDATE=$GET(IBTO)
- +13 ; if no To Date, assume 1 day, use the From date
- IF EDATE=""
- SET EDATE=DATE
- +14 ;
- +15 ;Pharmacy copays are allowed to duplicate with other Medical Copays.
- +16 if IBXA=5
- QUIT 0
- +17 ;
- +18 ; Check for entries within the given start and end date range
- +19 ;convert to internal dates
- +20 SET DATEH=$PIECE($$F2H^XLFDT(DATE),",")
- SET EDATEH=$PIECE($$F2H^XLFDT(EDATE),",")
- +21 FOR IBLPDT=DATEH:1:EDATEH
- Begin DoDot:1
- +22 SET Y=0
- +23 ;Convert looping date back to Fileman Date Format
- +24 SET SDATE=$$H2F^XLFDT(IBLPDT)
- +25 ;Set the correct starting date for the lookup
- +26 SET SDATE=$SELECT($DATA(^IB("AFDT",DFN,-SDATE)):-SDATE,1:$ORDER(^IB("AFDT",DFN,-SDATE)))
- +27 if SDATE=""
- QUIT
- +28 SET IBN=0
- FOR
- SET IBN=$ORDER(^IB("AFDT",DFN,SDATE,IBN))
- if 'IBN
- QUIT
- Begin DoDot:2
- +29 SET IBFLG=0
- +30 SET IBL=$$LAST(+$PIECE($GET(^IB(IBN,0)),U,9))
- SET IBND=$GET(^IB(IBL,0))
- SET IBFDT=$PIECE(IBND,U,14)
- SET IBTDT=$PIECE(IBND,U,15)
- +31 SET DATEL=-SDATE
- +32 ;This is a parent Admission (VA/CC/LTC Record. Does not Dup check.
- IF (IBFDT="")
- IF (IBTDT="")
- SET IBFLG=1
- QUIT
- +33 ;The end date of the bill is prior to the start date of the copay being entered.
- IF EDATE<IBFDT
- SET IBFLG=1
- QUIT
- +34 ;The start date of the copay being entered is before the end date of the copay being checked.
- IF DATE>IBTDT
- SET IBFLG=1
- QUIT
- +35 ;Grab the action type for the Copay
- SET IBATYP=$GET(^IBE(350.1,+$PIECE(IBND,U,3),0))
- +36 ;Grab the associated new Action Type for the Copay
- SET IBATYPN=$GET(^IBE(350.1,+$PIECE(IBATYP,U,9),0))
- +37 ;Allow Inpatient Per Diem on an Inpatient Copay
- IF IBXA=3
- IF $PIECE(IBATYPN,U,11)<3
- SET IBFLG=1
- QUIT
- +38 ; check for Tricare duplicates IB*2.0*715
- +39 IF IBXA=7
- Begin DoDot:3
- +40 ; non-Tricare charge is not a duplicate
- IF $PIECE(IBATYPN,U,11)'=IBXA
- SET IBFLG=1
- QUIT
- +41 SET IBATYPNM=$PIECE(IBATYPN,U)
- +42 ; Tricare RX is not a duplicate
- IF IBATYPNM["RX"
- SET IBFLG=1
- QUIT
- +43 QUIT
- End DoDot:3
- +44 ;
- +45 QUIT
- End DoDot:2
- IF 'IBFLG
- IF $PIECE(IBATYPN,U,11)'=5
- IF "^1^3^"[(U_$PIECE(IBATYP,U,5)_U)
- IF "^1^2^3^4^8^20^"[(U_+$PIECE(IBND,U,5)_U)
- SET Y=IBL
- QUIT
- +46 QUIT
- End DoDot:1
- if +$GET(Y)
- GOTO BFCHKQ
- +47 ; skip Per Diem check, if copay being charged is Tricare IB*2.0*715
- IF IBXA=7
- QUIT 0
- +48 ;
- +49 ;If the copay being charged is an Inpatient Copay (Bill groups 1 and 2) then skip the Per Diem check, no dup found
- +50 IF +IBXA<3
- IF +IBXA>0
- QUIT 0
- +51 ;
- +52 ;IB*2.0*663
- +53 ;Check for an existing duplicate Inpatient Per Diem separately.
- +54 SET Y=0
- +55 SET IBJ=0
- FOR
- SET IBJ=$ORDER(^IB("C",DFN,IBJ))
- if 'IBJ
- QUIT
- Begin DoDot:1
- +56 SET IBDATA=$GET(^IB(IBJ,0))
- SET IBFDT=$PIECE(IBDATA,U,14)
- SET IBTDT=$PIECE(IBDATA,U,15)
- SET IBAT=$PIECE(IBDATA,U,3)
- SET IBSTAT=$PIECE(IBDATA,U,5)
- +57 if IBAT=""
- QUIT
- +58 SET IBATBG=$PIECE($GET(^IBE(350.1,IBAT,0)),U,11)
- +59 if IBATBG'=3
- QUIT
- +60 SET IBSEQNM=$PIECE($GET(^IBE(350.1,IBAT,0)),U,5)
- +61 IF '$$CHKSTAT(IBSTAT)
- QUIT
- +62 IF (IBSEQNM=1)!(IBSEQNM=3)
- Begin DoDot:2
- +63 ;The end date of the bill is prior to the start date of the copay being entered.
- if EDATE<IBFDT
- QUIT
- +64 ;The start date of the copay being entered is before the end date of the copay being checked.
- if DATE>IBTDT
- QUIT
- +65 SET Y=IBJ
- End DoDot:2
- End DoDot:1
- if +$GET(Y)
- QUIT
- +66 ;
- BFCHKQ QUIT +$GET(Y)
- +1 ;
- CHKSTAT(IBSTAT) ; Check to see if the status on the copay allows for the copay to be checked for a duplicate
- +1 ;
- +2 ;INPUT: IBSTAT - The status on the copay being evaluated
- +3 ;RETURNS: 1 - Allow the duplicate copay check to continue (for the INCOMPLETE, COMPLETE, BILLED, UPDATED, ON HOLD, HOLD - RATE statuses)
- +4 ; 0 - Don't check for duplication
- +5 ;
- +6 ; INCOMPLETE
- if IBSTAT=1
- QUIT 1
- +7 ; COMPLETE
- if IBSTAT=2
- QUIT 1
- +8 ; BILLED
- if IBSTAT=3
- QUIT 1
- +9 ; UPDATED
- if IBSTAT=4
- QUIT 1
- +10 ; ON HOLD
- if IBSTAT=8
- QUIT 1
- +11 ; HOLD - RATE status
- if IBSTAT=20
- QUIT 1
- +12 QUIT 0
