- IBECEA4 ;ALB/CPM - Cancel/Edit/Add... Cancel a Charge ;11-MAR-93
- ;;2.0;INTEGRATED BILLING;**27,52,150,240,663,671,669,678,682,784,760**;21-MAR-94;Build 25
- ;;Per VHA Directive 6402, this routine should not be modified.
- ;
- ONE ; Cancel a single charge.
- N IBLPFLG
- ;
- D:'+$G(IBAPI) HDR^IBECEAU("C A N C E L")
- ;
- ; - perform up-front edits
- D CED^IBECEAU4(IBN) G:IBY<0 ONEQ
- I IBXA=6!(IBXA=7) D G ONEQ:$G(IBCC),REAS
- .I IBCANTR!($P(IBND,"^",5)=10) S IBCC=1 W !,"This transaction has already been cancelled.",!
- I IBCANTR!($P(IBND,"^",5)=10) W !,$S(IBH:"Please note that this cancellation action has not yet been passed to AR.",1:"This transaction has already been cancelled."),! G ONEQ:'IBH,REAS
- I 'IBH,IBIL="" S IBY="-1^IB024" G ONEQ
- ;
- REAS ; - ask for the cancellation reason
- N IBSVIEN ; IB*2.0*682
- N IBOENC,IBOEEVDT,IBSTCD,IBSTOPDA,NUMVSTFL
- ;
- S IBLPFLG=0 ;Set the reason loop flag for bad Cancel Reason selections
- ;
- S IBFLG=0
- D REAS^IBECEAU2("C")
- ;IB*2.0*678 - Correct error or no reason functionality
- I IBCRES<0 D G ONEQ
- . S IBY=-1
- ;
- ;IB*2.0*669
- ; Temporary inactive flag check until IB*2.0*653 is released. Then need to move the inactive check to
- ; the DIC("S") variable in REAS^IBECEAU2.
- ; cHECK INACTIVE FLAG
- ; If Cancel reason is inactive, the post message to user and try again.
- I $$GET1^DIQ(350.3,IBCRES_",",.06,"I") D G:IBY<0 REAS
- . S IBY=-1
- . W !!,"The selected cancellation reason is inactive."
- . W !,"Please select another cancellation reason.",!!
- ;
- ;Check to see if it is an Urgent Care
- I ('$$GET1^DIQ(350.3,IBCRES_",",.04,"I")),($$GET1^DIQ(350.1,$P(IBND,U,3)_",",.01,"E")["URGENT CARE") D G:IBY<0 ONEQ
- . S IBY=-1
- . W !!,"This is an Urgent Care Copayment. Please use an Urgent Care cancellation reason.",!,"This transaction cannot be completed.",!
- ;
- ;IB*2.0*784 - Cleland-Dole Benefit Check
- S IBSTCHCK=0
- ; Check to see if Bill is eligible for Cleland-Dole tracking.
- I $P($G(^IBE(350.1,$P(IBND,U,3),0)),U,11)=4 D ;Only Outpatient Copays are eligible for C-D tracking.
- . I +$O(^IBMH(351.83,"D",IBN,"")) S IBSTCHCK=1 Q ;Bill currently in DB
- . I $P($G(^IBE(350.1,$P(IBND,U,3),0)),U)["CC MH" S IBSTCHCK=1 Q
- . S IBSTOPDA=$P(IBND,U,20) ;Get the stop code
- . ;Get encounter info.
- . S IBOEEVDT=$P(IBND,U,17),IBOENC=$P($P(IBND,U,4),";")
- . I IBSTOPDA'="" D
- . . S IBSTCD=$$GET1^DIQ(352.5,IBSTOPDA_",",.01,"E")
- . . S IBSTCHCK=$$CDCHK^IBECEAMH(IBSTCD,$P(IBND,U,17)) ;Check for C-D eligibility for Stop Code
- . . I 'IBSTCHCK,$$ISCDELIG^IBECEAMH(IBFR) I $P(IBOENC,":")="409.68" S IBSTCHCK=$$CHKST44^IBECEAMH($P(IBOENC,":",2))
- . ; Eligible for Cleland Dole, proceed with Cancel.
- . Q:IBSTCHCK ;C-D eligible.
- . ; If OutP Encounter, check the encounter.
- . I $P(IBOENC,":")=409.68 S IBSTCHCK=$$OECHK^IBECEAMH($P(IBOENC,":",2),IBOEEVDT)
- ;
- I IBSTCHCK,'$$GET1^DIQ(350.3,IBCRES_",",.08,"I") D G ONEQ ; check if cancellation reason can be used for C-D copay IB*2.0*784
- .S IBY=-1
- .W !!,"This is a Cleland-Dole eligible Copayment. Please use an appropriate cancellation reason.",!,"This transaction cannot be completed.",!
- .Q
- ;
- ;Check to see if the Cleland-Dole cancellation reason was chosen. If so, check to see if the copays was Cleland dole eligible and process accordingly
- I 'IBSTCHCK,($$GET1^DIQ(350.3,IBCRES_",",.01,"E")="CLELAND-DOLE") D G REAS
- . D MESS3^IBECEAMH(0)
- ;
- ;Check # C-D free visits
- I IBSTCHCK D G:IBLPFLG REAS
- . S NUMVSTFL=$$NUMVSTCK^IBECEAMH(DFN,IBFR) ; Visit Check Flag
- . Q:NUMVSTFL ; Free visits available. Continue with Cancellation.
- . ;
- . ;Check to see if the Cleland Dole Cancellation reason was chosen, but no more free visits are available.
- . I ($$GET1^DIQ(350.3,IBCRES_",",.01,"E")="CLELAND-DOLE") D Q
- . . D MESS3^IBECEAMH(1)
- . . S IBLPFLG=1
- . ; Code in place if a DoS sequence to the benefit is needed vs the current FIFO sequence
- . ;S IBCDEVDT=$P(IBND,U,17)
- . ;I $$DTCHK^IBECEAMH(DFN,IBCDEVDT) D Q
- . ;. S IBY=-1
- . ;. D MESS2A^IBECEAMH ;Alert user to review Bill cancellation sequence for Cleland-Dole before cancelling this bill.
- ;end IB*2.0*784
- ;
- ; - okay to proceed?
- D PROC^IBECEAU4("cancel") G:IBY<0 ONEQ
- ;
- ;If Copay being cancelled is CC URGENT CARE check to see if it can be cancelled and do the processing.
- I $$GET1^DIQ(350.1,$P(IBND,U,3)_",",.01,"E")["URGENT CARE" D UCVSTDB G:IBY<0 ONEQ
- ;
- ; - handle CHAMPVA/TRICARE charges
- I IBXA=6!(IBXA=7) D CANC^IBECEAU4(IBN,IBCRES,1) G ONEQ
- ;
- ; - handle cancellation transactions
- I IBCANTR D G ONEQ
- .I IBN=IBPARNT D UPSTAT^IBECEAU4(IBN,1) Q
- .I 'IBIL S IBIL=$P($G(^IB(IBPARNT,0)),"^",11) I 'IBIL W !!,"There is no bill number associated with this charge.",!,"The charge cannot be cancelled." Q
- .S DIE="^IB(",DA=IBN,DR=".1////"_IBCRES_";.11////"_IBIL D ^DIE,PASS K DIE,DA,DR
- ;
- ; - update 354.71 and 354.7 (cap info)
- I $P(IBND,"^",19) S IBAMC=$$CANCEL^IBARXMN(DFN,$P(IBND,"^",19),.IBY) G:IBY<1 ONEQ I IBAMC D FOUND^IBARXMA(.IBY,IBAMC)
- ;
- S IBSVIEN=IBN ; save off file 350 ien, because in some cases it gets overwritten in the cancellation code IB*2.0*682
- ; - handle incomplete and regular transactions
- D CANC^IBECEAU4(IBN,IBCRES,1) G:IBY<1 ONEQ
- ;
- ;IB*2.0*784
- ;If performing a C-D cancellation, Update the tracking DB.
- I IBSTCHCK D
- .S IBCNMH=$$GET1^DIQ(350.3,IBCRES_",",.07,"I") ; Find out how the Mental Health DB should be updated.
- .I IBCNMH D ; IB*2.0*760
- ..I $$GETMHFR^IBAMTC(DFN,IBFR) S IBCNMH=2 ; if there's already a free visit on this date, update MH DB to "visit only"
- ..D UPDVST^IBECEAMH(IBSVIEN,IBCNMH) ; Update If the Mental Health DB
- ..Q
- .Q
- ;End IB*2.0*784
- ;
- ; - handle updating of clock
- ;I "^1^2^3^"'[("^"_IBXA_"^") G ONEQ
- ;I 'IBCHG G ONEQ
- ;D CLSTR^IBECEAU1(DFN,IBFR) I 'IBCLDA W !!,"Please note that there is no billing clock which would cover this charge.",!,"Be sure that this patient's billing clock is correct." G ONEQ
- ;D CLOCK^IBECEAU(-IBCHG,+$P(IBCLST,"^",9),-IBUNIT)
- I "^1^2^3^"[(U_IBXA_U),IBCHG D ; IB*2.0*682
- .D CLSTR^IBECEAU1(DFN,IBFR) I 'IBCLDA W !!,"Please note that there is no billing clock which would cover this charge.",!,"Be sure that this patient's billing clock is correct." Q
- .D CLOCK^IBECEAU(-IBCHG,+$P(IBCLST,"^",9),-IBUNIT)
- .Q
- ; re-bill previous charge
- I IBSVIEN,'$G(IBAPI) D REBILL(DFN,$P(^IB(IBSVIEN,0),U,17),IBSVIEN) ; IB*2.0*682
- ;
- ONEQ ;Exit utility
- I $G(IBAPI) S IBCNRSLT=IBY
- D ERR^IBECEAU4:IBY<0,PAUSE^IBECEAU
- K IBCHG,IBCRES,IBDESC,IBIL,IBND,IBSEQNO,IBTOTL,IBUNIT,IBATYP,IBIDX,IBCC
- K IBN,IBREB,IBY,IBEVDA,IBPARNT,IBH,IBCANTR,IBXA,IBSL,IBFR,IBTO,IBNOS,IBCANC,IBAMC,IBSTCHCK,IBCNMH
- Q
- ;
- PASS ; Pass the action to Accounts Receivable.
- N IBSERV
- W !,"Passing the cancellation action to AR... "
- S IBNOS=IBN D ^IBR S IBY=Y W:Y>0 "done."
- Q
- ;
- UPDVST(IBCAN) ; update the Visit Tracking file
- ;
- ;INPUT - IBCAN - Type of Update to perform
- ; 1 - Remove with Entered in Error Message
- ; 2 - Visit Only Update
- ; 3 - Free (if free not used) or Visit Only
- ; 4 - Remove with Duplicate Error message
- ;
- N IBBLNO,IBSTAT,IBVSTIEN,IBREAS,IBRTN,IBERROR,IBSTAT
- S IBERROR=""
- ;Locate the IEN in the file using the Bill Number
- S IBBLNO=$$GET1^DIQ(350,IBN_",",.11,"E")
- S:$E(IBBLNO,1)="K" IBBLNO=IBSITE_"-"_IBBLNO
- S IBSTAT=$$GET1^DIQ(350,IBN_",",.05,"I")
- S:IBSTAT=8 IBBLNO="ON HOLD"
- S IBVSTIEN=$$FNDVST(IBBLNO,$$GET1^DIQ(350,IBN_",",.14,"I"),$$GET1^DIQ(350,IBN_",",.02,"I"))
- I +IBVSTIEN=0 D Q
- . W !!,"Unable to locate the bill in the Urgent Care Visit Tracking Database"
- . W !,"for this veteran. Please review and update the Urgent Care Visit "
- . W !,"Tracking Maintenance Utility.",!
- ;
- ;Set Status and Reason based on update type.
- S:IBCAN=1 IBREAS=3,IBSTAT=3 ;Visits Removed
- S:IBCAN=2 IBREAS=5,IBSTAT=4 ;Visit set to Visit Only
- S:IBCAN=3 IBREAS=1,IBSTAT=1 ;Free visit
- S:IBCAN=4 IBREAS=4,IBSTAT=3 ;Duplicate Visit
- ;
- S IBRTN=$$UPDATE^IBECEA38(IBVSTIEN,IBSTAT,"",IBREAS,1,IBERROR)
- ;
- Q
- ;
- FNDVST(IBBLNO,IBVSTDT,IBN) ; Locate the Visit IEN
- ;
- N IBVSTIEN,IBVSTD,IBFOUND
- S IBVSTIEN=0,IBFOUND=0
- F S IBVSTIEN=$O(^IBUC(351.82,"C",IBBLNO,IBVSTIEN)) Q:IBVSTIEN="" D Q:IBFOUND=1
- . S IBVSTD=$G(^IBUC(351.82,IBVSTIEN,0))
- . I (IBVSTDT=$P(IBVSTD,U,3)),(IBN=$P(IBVSTD,U)) S IBFOUND=1
- Q +IBVSTIEN
- ;
- UCVSTDB ; Update the UC Visit Tracking DB if the Cancellation Reason is usable on UC copays
- ;
- N IBUCBH,IBELIG,IBNOFRVS
- I +$$GET1^DIQ(350.3,IBCRES_",",.04,"I")=0 D Q
- . S IBY=-1
- . W !!,"The selected Cancellation Reason cannot be used when cancelling"
- . W !,"an Urgent Care Copay."
- ;
- S IBUCBH=$$GET1^DIQ(350.3,IBCRES_",",.05,"I")
- ;
- ;For those cancellation reasons deemed to be data entry errors
- I IBUCBH=1 D UPDVST(1) Q
- ;
- ;For those cancellation reasons deemed to be duplicate visits
- I IBUCBH=4 D UPDVST(4) Q
- ;
- ;For those cancellation reasons that need to keep the visit as visit only....
- I IBUCBH=2 D UPDVST(2) Q
- ;
- ;For other valid UC cancellation reasons, assuming that they are 3's (need free visit check)
- S IBELIG=$$GETELGP^IBECEA36($P(IBND,U,2),$P(IBND,U,14))
- I IBELIG=6 D Q
- . D UPDVST(2)
- . W !!,"Patient is in Enrollment Group 6 on the day of this visit."
- . W !,"Urgent Care Visit Tracking for this visit is set to Visit Only."
- . W !,"If this needs to be a free visit, please update the visit using"
- . W !,"the Urgent Care Visit Tracking Maintenance Option after RUR review."
- ;
- ;If still PG 7 or 8 update to Visit Only and quit.
- I IBELIG>6 D UPDVST(2) Q
- ;
- ;Retrieve # visits
- S IBNOFRVS=$P($$GETVST^IBECEA36($P(IBND,U,2),$P(IBND,U,14)),U,2)
- ;
- ;If free visit remain, convert visit to Free Visit
- I IBNOFRVS<3 D UPDVST(3) Q
- ;
- ;Otherwise, visit only.
- D UPDVST(2)
- ;
- Q
- ;IB*2.0*678 - Create API entry point for cancelling a copay
- CANCAPI(IBN) ;Cancel a copay given a Copay IEN.
- ;
- ;INPUT - IEN of the copay to cancel
- ;OUTPUT -
- ; -1 - Error (Error handled within cancel but still part of the return)
- ; 0 - Not cancelled
- ; 1 - Cancelled
- ;
- N IBND,IBPARNT,IBCANC,IBH,IBCANTR,IBXA,IBATYP,IBSEQNO,IBIL,IBUNIT,IBCHG,IBFR,IBJOB,IBCRES
- N IBDESC,IBIL,IBSEQNO,IBTOTL,IBIDX,IBCC,IBREB,IBY,IBEVDA,IBPARNT,IBH,IBSL,IBTO,IBNOS,IBCANC,IBAMC
- N IBAPI,IBCNRSLT
- ;
- ;Initialize the job type.
- S IBJOB=4,IBAPI=1,IBY=""
- ;
- D ONE
- Q IBCNRSLT
- ;
- REBILL(IBDFN,IBEVDT,IBCRNT) ; Re-bill one of cancelled charges on a given date IB*2.0*682
- ;
- ; IBDFN - patient's DFN
- ; IBEVDT - event date (350/.17)
- ; IBCRNT - current charge (the one being cancelled) to be excluded from the list (file 350 ien)
- ;
- N IB0,IBACT,IBCNT,IBDASH,IBDT,IBEDT,IBHASUC,IBIENS,IBINPT,IBLINES,IBREBILL,IBSDT,IBUC0,IBUCFLG,IBUCIEN,IBUCSKIP,IBZ
- ; get cancelled charges
- S IBHASUC=0 ; set to 1 below if there's at least one cancelled UC charge
- S (IBUCSKIP,IBCNT)=0
- S IBACT=+$P($G(IBND),U,3)
- I $$ISRX(IBACT) Q ; don't re-bill if cancelling an RX charge
- S IBINPT=$$ISINPT(IBACT) ; 1 if inpatient charge
- S IBUCFLG=$S($$GET1^DIQ(350,IBCRNT_",",.03)["URGENT CARE":1,1:0) ; 1 if UC charge
- S IBSDT=$S(IBINPT:$P(IBND,U,14),1:IBEVDT)
- S IBEDT=$S(IBINPT:$P(IBND,U,15),1:IBEVDT)
- I IBSDT,IBEDT F IBDT=IBSDT:1:IBEDT D
- .S IBZ=0 F S IBZ=$O(^IB("AFDT",IBDFN,-IBDT,IBZ)) Q:'IBZ D
- ..S IBIENS=IBZ_","
- ..I $$GET1^DIQ(350,IBIENS,.05)'="CANCELLED" Q ; only include cancelled charges
- ..I IBZ=IBCRNT Q ; don't include the charge currently being cancelled
- ..S IB0=$G(^IB(IBZ,0)) I $$ISRX(+$P(IB0,U,3)) Q ; don't include RX charges
- ..S IBCNT=IBCNT+1
- ..; IBLINES(n) = string formatted for display
- ..; IBLINES(n,"IEN") = corresponding file 350 ien
- ..; IBLINES(n,"UC") = corresponding file 351.82 ien (for "visit only" UC entries)
- ..S IBLINES(IBCNT)=$$FMTE^XLFDT($P(IB0,U,14),"2DZ") ; bill from (350/.14)
- ..S $P(IBLINES(IBCNT),U,2)=$$FMTE^XLFDT($P(IB0,U,15),"2DZ") ; bill to (350/.15)
- ..S $P(IBLINES(IBCNT),U,3)=$$GET1^DIQ(350,IBIENS,.03) ; charge type (350/.03)
- ..I $P(IBLINES(IBCNT),U,3)["URGENT CARE" S IBHASUC=1
- ..S $P(IBLINES(IBCNT),U,4)=$P($P(IB0,U,11),"-",2) ; bill # (350/.11)
- ..S $P(IBLINES(IBCNT),U,5)=$$GET1^DIQ(350,IBIENS,.1) ; cancel reason (350/.1)
- ..S $P(IBLINES(IBCNT),U,6)=$P(IB0,U,7) ; charge amount (350/.07)
- ..S $P(IBLINES(IBCNT),U,7)=$$GET1^DIQ(350,IBIENS,.2) ; clinic stop code (350/.2)
- ..S IBLINES(IBCNT,"IEN")=IBZ
- ..S IBUCIEN=$$FNDUCV(IBDFN,IBEVDT,$S($G(IBFAC)>0:IBFAC,1:+$$SITE^VASITE())) ; IBFAC is defined elsewhere, comes from a call to SITE^IBAUTL
- ..I IBUCIEN S IBLINES(IBCNT,"UC")=IBUCIEN
- ..Q
- .; get UC "visit only" entries
- .I 'IBHASUC S IBZ=0 F S IBZ=$O(^IBUC(351.82,"B",IBDFN,IBZ)) Q:'IBZ D
- ..S IBUC0=$G(^IBUC(351.82,IBZ,0))
- ..I $P(IBUC0,U,3)'=IBDT Q ; wrong event date, skip
- ..I $P(IBUC0,U,4)'=4 Q ; status is not "visit only", skip
- ..I $P(IBUC0,U,2)'=IBFAC Q ; wrong site, skip
- ..; if UC charge is being cancelled, corresponding 351.82 entry is converted to "visit only", so one of "visit only" entries
- ..; needs to be excluded
- ..I IBUCFLG,'IBUCSKIP S IBUCSKIP=1 Q
- ..S IBCNT=IBCNT+1
- ..S (IBLINES(IBCNT),$P(IBLINES(IBCNT),U,2))=$$FMTE^XLFDT($P(IBUC0,U,3),"2DZ") ; bill from / to contain visit date (351.82/.03)
- ..S $P(IBLINES(IBCNT),U,3)="Urgent Care" ; no charge for UC Visit Only entries
- ..S $P(IBLINES(IBCNT),U,5)="Visit Only"
- ..S IBLINES(IBCNT,"UC")=IBZ
- ..Q
- .Q
- I IBCNT'>0 Q ; nothing to display
- ; display charges
- S $P(IBDASH,"-",81)=""
- W !!,"The following copay charges from the same date may be re-billed:"
- W !!," Bill From Bill To Charge Type Bill # Cancel Reason Stop Charge"
- W !,IBDASH
- F IBZ=1:1:IBCNT D
- .W !,$$RJ^XLFSTR(IBZ,2),?3,$P(IBLINES(IBZ),U),?13,$P(IBLINES(IBZ),U,2),?22,$E($P(IBLINES(IBZ),U,3),1,16)
- .W ?39,$P(IBLINES(IBZ),U,4),?49,$E($P(IBLINES(IBZ),U,5),1,16),?66,$P(IBLINES(IBZ),U,7)
- .W ?74,$S(+$P(IBLINES(IBZ),U,6)>0:$$RJ^XLFSTR("$"_$P(IBLINES(IBZ),U,6),6),1:"")
- .Q
- W !
- ; If cancelling an inpatient charge, just display message and quit
- I IBINPT W !,"Please review this patient's copayments during this period for potential re-billing." Q
- ; Check for IB EDIT key
- I '$D(^XUSEC("IB EDIT",DUZ)) D Q
- .W !!,"IB EDIT Key required to Add a Charge."
- .W !!,"Please notify 1st party billing for review and potential re-bill of the above copayment(s), if needed."
- .Q
- ; prompt for a charge to re-bill
- S IBZ=$$ASKRB(IBCNT) I 'IBZ Q
- ; re-bill selected charge
- ; UC Visit Only
- I $G(IBLINES(IBZ,"IEN"))'>0 D Q
- .S (IBREBILL("EVDT"),IBREBILL("BILLFR"),IBREBILL("BILLTO"))=$P(^IBUC(351.82,IBLINES(IBZ,"UC"),0),U,3)
- .S IBREBILL("CHRGTYPE")="CC URGENT CARE"
- .S IBREBILL("UC")=IBLINES(IBZ,"UC")
- .D ADD^IBECEA3
- .Q
- ; regular charge
- S IBIENS=IBLINES(IBZ,"IEN")_","
- ; populate array of default values to pass to ^IBECEA3 (Add charge)
- S IBREBILL("EVDT")=$P(^IB(IBLINES(IBZ,"IEN"),0),U,17)
- S IBREBILL("BILLFR")=$P(^IB(IBLINES(IBZ,"IEN"),0),U,14)
- S IBREBILL("BILLTO")=$P(^IB(IBLINES(IBZ,"IEN"),0),U,15)
- S IBREBILL("CHRGTYPE")=$$GET1^DIQ(350.1,$P(^IB(IBLINES(IBZ,"IEN"),0),U,3),.08)
- S IBREBILL("CHRGAMT")=$$GET1^DIQ(350,IBIENS,.07)
- I $G(IBLINES(IBZ,"UC")) S IBREBILL("UC")=IBLINES(IBZ,"UC")
- D ADD^IBECEA3
- Q
- ;
- ASKRB(IBNUM) ; Prompt for re-billing of a cancelled charge IB*2.0*682
- ;
- ; IBNUM - number of entries in the list
- ;
- N DIR,DIRUT,DIROUT,DTOUT,DUOUT,RES,X,Y
- S DIR(0)="FA^1:"_IBNUM_"^I +X<1!(+X>"_IBNUM_") K X"
- S DIR("A",1)="Please review the above list of potentially (re)billable items."
- S DIR("A")="Select charge to re-bill (1 - "_IBNUM_") or type '^' to skip this step: "
- S DIR("?")="Select a charge to re-bill from the list above (1 - "_IBNUM_"), or type '^' to skip re-billing."
- D ^DIR
- Q +Y
- ;
- ISINPT(IBACT) ; check if given charge is an inpatient charge
- ;
- ; IBACT - ien in file 350.1 for the charge in question
- ;
- ; returns 1 if inpatient charge, 0 otherwise
- ;
- N RES
- S RES=0
- I IBACT,"^1^2^3^9^"[(U_$P($G(^IBE(350.1,IBACT,0)),U,11)_U) S RES=1
- Q RES
- ;
- ISRX(IBACT) ; check if given charge is an RX charge
- ;
- ; IBACT - ien in file 350.1 for the charge in question
- ;
- ; returns 1 if RX charge, 0 otherwise
- ;
- N RES
- S RES=0
- I IBACT,$P($G(^IBE(350.1,IBACT,0)),U,11)=5 S RES=1
- Q RES
- ;
- FNDUCV(IBDFN,IBEVDT,IBSITE) ; find "visit only" entry in file 351.82
- ;
- ; IBDFN - patient's DFN
- ; IBEVDT - event date (350/.17)
- ; IBSITE - local facility (file 4 ien)
- ;
- ; Returns ien in file 351.82 if an entry was found, 0 otherwise
- ;
- N IBFOUND,IBRES,IBUC0,IBZ
- S IBRES=0
- I IBDFN'>0!(IBEVDT'>0)!(IBSITE'>0) Q IBRES
- S (IBFOUND,IBZ)=0 F S IBZ=$O(^IBUC(351.82,"VD",IBEVDT,IBZ)) Q:'IBZ D Q:IBFOUND
- .S IBUC0=^IBUC(351.82,IBZ,0)
- .I $P(IBUC0,U)'=IBDFN Q ; wrong patient
- .I $P(IBUC0,U,4)'=4 Q ; status is not "visit only"
- .I $P(IBUC0,U,2)'=IBSITE Q ; wrong site
- .S IBFOUND=1,IBRES=IBZ
- .Q
- Q IBRES
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HIBECEA4 17076 printed Jan 18, 2025@03:22:38 Page 2
- IBECEA4 ;ALB/CPM - Cancel/Edit/Add... Cancel a Charge ;11-MAR-93
- +1 ;;2.0;INTEGRATED BILLING;**27,52,150,240,663,671,669,678,682,784,760**;21-MAR-94;Build 25
- +2 ;;Per VHA Directive 6402, this routine should not be modified.
- +3 ;
- ONE ; Cancel a single charge.
- +1 NEW IBLPFLG
- +2 ;
- +3 if '+$GET(IBAPI)
- DO HDR^IBECEAU("C A N C E L")
- +4 ;
- +5 ; - perform up-front edits
- +6 DO CED^IBECEAU4(IBN)
- if IBY<0
- GOTO ONEQ
- +7 IF IBXA=6!(IBXA=7)
- Begin DoDot:1
- +8 IF IBCANTR!($PIECE(IBND,"^",5)=10)
- SET IBCC=1
- WRITE !,"This transaction has already been cancelled.",!
- End DoDot:1
- if $GET(IBCC)
- GOTO ONEQ
- GOTO REAS
- +9 IF IBCANTR!($PIECE(IBND,"^",5)=10)
- WRITE !,$SELECT(IBH:"Please note that this cancellation action has not yet been passed to AR.",1:"This transaction has already been cancelled."),!
- if 'IBH
- GOTO ONEQ
- GOTO REAS
- +10 IF 'IBH
- IF IBIL=""
- SET IBY="-1^IB024"
- GOTO ONEQ
- +11 ;
- REAS ; - ask for the cancellation reason
- +1 ; IB*2.0*682
- NEW IBSVIEN
- +2 NEW IBOENC,IBOEEVDT,IBSTCD,IBSTOPDA,NUMVSTFL
- +3 ;
- +4 ;Set the reason loop flag for bad Cancel Reason selections
- SET IBLPFLG=0
- +5 ;
- +6 SET IBFLG=0
- +7 DO REAS^IBECEAU2("C")
- +8 ;IB*2.0*678 - Correct error or no reason functionality
- +9 IF IBCRES<0
- Begin DoDot:1
- +10 SET IBY=-1
- End DoDot:1
- GOTO ONEQ
- +11 ;
- +12 ;IB*2.0*669
- +13 ; Temporary inactive flag check until IB*2.0*653 is released. Then need to move the inactive check to
- +14 ; the DIC("S") variable in REAS^IBECEAU2.
- +15 ; cHECK INACTIVE FLAG
- +16 ; If Cancel reason is inactive, the post message to user and try again.
- +17 IF $$GET1^DIQ(350.3,IBCRES_",",.06,"I")
- Begin DoDot:1
- +18 SET IBY=-1
- +19 WRITE !!,"The selected cancellation reason is inactive."
- +20 WRITE !,"Please select another cancellation reason.",!!
- End DoDot:1
- if IBY<0
- GOTO REAS
- +21 ;
- +22 ;Check to see if it is an Urgent Care
- +23 IF ('$$GET1^DIQ(350.3,IBCRES_",",.04,"I"))
- IF ($$GET1^DIQ(350.1,$PIECE(IBND,U,3)_",",.01,"E")["URGENT CARE")
- Begin DoDot:1
- +24 SET IBY=-1
- +25 WRITE !!,"This is an Urgent Care Copayment. Please use an Urgent Care cancellation reason.",!,"This transaction cannot be completed.",!
- End DoDot:1
- if IBY<0
- GOTO ONEQ
- +26 ;
- +27 ;IB*2.0*784 - Cleland-Dole Benefit Check
- +28 SET IBSTCHCK=0
- +29 ; Check to see if Bill is eligible for Cleland-Dole tracking.
- +30 ;Only Outpatient Copays are eligible for C-D tracking.
- IF $PIECE($GET(^IBE(350.1,$PIECE(IBND,U,3),0)),U,11)=4
- Begin DoDot:1
- +31 ;Bill currently in DB
- IF +$ORDER(^IBMH(351.83,"D",IBN,""))
- SET IBSTCHCK=1
- QUIT
- +32 IF $PIECE($GET(^IBE(350.1,$PIECE(IBND,U,3),0)),U)["CC MH"
- SET IBSTCHCK=1
- QUIT
- +33 ;Get the stop code
- SET IBSTOPDA=$PIECE(IBND,U,20)
- +34 ;Get encounter info.
- +35 SET IBOEEVDT=$PIECE(IBND,U,17)
- SET IBOENC=$PIECE($PIECE(IBND,U,4),";")
- +36 IF IBSTOPDA'=""
- Begin DoDot:2
- +37 SET IBSTCD=$$GET1^DIQ(352.5,IBSTOPDA_",",.01,"E")
- +38 ;Check for C-D eligibility for Stop Code
- SET IBSTCHCK=$$CDCHK^IBECEAMH(IBSTCD,$PIECE(IBND,U,17))
- +39 IF 'IBSTCHCK
- IF $$ISCDELIG^IBECEAMH(IBFR)
- IF $PIECE(IBOENC,":")="409.68"
- SET IBSTCHCK=$$CHKST44^IBECEAMH($PIECE(IBOENC,":",2))
- End DoDot:2
- +40 ; Eligible for Cleland Dole, proceed with Cancel.
- +41 ;C-D eligible.
- if IBSTCHCK
- QUIT
- +42 ; If OutP Encounter, check the encounter.
- +43 IF $PIECE(IBOENC,":")=409.68
- SET IBSTCHCK=$$OECHK^IBECEAMH($PIECE(IBOENC,":",2),IBOEEVDT)
- End DoDot:1
- +44 ;
- +45 ; check if cancellation reason can be used for C-D copay IB*2.0*784
- IF IBSTCHCK
- IF '$$GET1^DIQ(350.3,IBCRES_",",.08,"I")
- Begin DoDot:1
- +46 SET IBY=-1
- +47 WRITE !!,"This is a Cleland-Dole eligible Copayment. Please use an appropriate cancellation reason.",!,"This transaction cannot be completed.",!
- +48 QUIT
- End DoDot:1
- GOTO ONEQ
- +49 ;
- +50 ;Check to see if the Cleland-Dole cancellation reason was chosen. If so, check to see if the copays was Cleland dole eligible and process accordingly
- +51 IF 'IBSTCHCK
- IF ($$GET1^DIQ(350.3,IBCRES_",",.01,"E")="CLELAND-DOLE")
- Begin DoDot:1
- +52 DO MESS3^IBECEAMH(0)
- End DoDot:1
- GOTO REAS
- +53 ;
- +54 ;Check # C-D free visits
- +55 IF IBSTCHCK
- Begin DoDot:1
- +56 ; Visit Check Flag
- SET NUMVSTFL=$$NUMVSTCK^IBECEAMH(DFN,IBFR)
- +57 ; Free visits available. Continue with Cancellation.
- if NUMVSTFL
- QUIT
- +58 ;
- +59 ;Check to see if the Cleland Dole Cancellation reason was chosen, but no more free visits are available.
- +60 IF ($$GET1^DIQ(350.3,IBCRES_",",.01,"E")="CLELAND-DOLE")
- Begin DoDot:2
- +61 DO MESS3^IBECEAMH(1)
- +62 SET IBLPFLG=1
- End DoDot:2
- QUIT
- +63 ; Code in place if a DoS sequence to the benefit is needed vs the current FIFO sequence
- +64 ;S IBCDEVDT=$P(IBND,U,17)
- +65 ;I $$DTCHK^IBECEAMH(DFN,IBCDEVDT) D Q
- +66 ;. S IBY=-1
- +67 ;. D MESS2A^IBECEAMH ;Alert user to review Bill cancellation sequence for Cleland-Dole before cancelling this bill.
- End DoDot:1
- if IBLPFLG
- GOTO REAS
- +68 ;end IB*2.0*784
- +69 ;
- +70 ; - okay to proceed?
- +71 DO PROC^IBECEAU4("cancel")
- if IBY<0
- GOTO ONEQ
- +72 ;
- +73 ;If Copay being cancelled is CC URGENT CARE check to see if it can be cancelled and do the processing.
- +74 IF $$GET1^DIQ(350.1,$PIECE(IBND,U,3)_",",.01,"E")["URGENT CARE"
- DO UCVSTDB
- if IBY<0
- GOTO ONEQ
- +75 ;
- +76 ; - handle CHAMPVA/TRICARE charges
- +77 IF IBXA=6!(IBXA=7)
- DO CANC^IBECEAU4(IBN,IBCRES,1)
- GOTO ONEQ
- +78 ;
- +79 ; - handle cancellation transactions
- +80 IF IBCANTR
- Begin DoDot:1
- +81 IF IBN=IBPARNT
- DO UPSTAT^IBECEAU4(IBN,1)
- QUIT
- +82 IF 'IBIL
- SET IBIL=$PIECE($GET(^IB(IBPARNT,0)),"^",11)
- IF 'IBIL
- WRITE !!,"There is no bill number associated with this charge.",!,"The charge cannot be cancelled."
- QUIT
- +83 SET DIE="^IB("
- SET DA=IBN
- SET DR=".1////"_IBCRES_";.11////"_IBIL
- DO ^DIE
- DO PASS
- KILL DIE,DA,DR
- End DoDot:1
- GOTO ONEQ
- +84 ;
- +85 ; - update 354.71 and 354.7 (cap info)
- +86 IF $PIECE(IBND,"^",19)
- SET IBAMC=$$CANCEL^IBARXMN(DFN,$PIECE(IBND,"^",19),.IBY)
- if IBY<1
- GOTO ONEQ
- IF IBAMC
- DO FOUND^IBARXMA(.IBY,IBAMC)
- +87 ;
- +88 ; save off file 350 ien, because in some cases it gets overwritten in the cancellation code IB*2.0*682
- SET IBSVIEN=IBN
- +89 ; - handle incomplete and regular transactions
- +90 DO CANC^IBECEAU4(IBN,IBCRES,1)
- if IBY<1
- GOTO ONEQ
- +91 ;
- +92 ;IB*2.0*784
- +93 ;If performing a C-D cancellation, Update the tracking DB.
- +94 IF IBSTCHCK
- Begin DoDot:1
- +95 ; Find out how the Mental Health DB should be updated.
- SET IBCNMH=$$GET1^DIQ(350.3,IBCRES_",",.07,"I")
- +96 ; IB*2.0*760
- IF IBCNMH
- Begin DoDot:2
- +97 ; if there's already a free visit on this date, update MH DB to "visit only"
- IF $$GETMHFR^IBAMTC(DFN,IBFR)
- SET IBCNMH=2
- +98 ; Update If the Mental Health DB
- DO UPDVST^IBECEAMH(IBSVIEN,IBCNMH)
- +99 QUIT
- End DoDot:2
- +100 QUIT
- End DoDot:1
- +101 ;End IB*2.0*784
- +102 ;
- +103 ; - handle updating of clock
- +104 ;I "^1^2^3^"'[("^"_IBXA_"^") G ONEQ
- +105 ;I 'IBCHG G ONEQ
- +106 ;D CLSTR^IBECEAU1(DFN,IBFR) I 'IBCLDA W !!,"Please note that there is no billing clock which would cover this charge.",!,"Be sure that this patient's billing clock is correct." G ONEQ
- +107 ;D CLOCK^IBECEAU(-IBCHG,+$P(IBCLST,"^",9),-IBUNIT)
- +108 ; IB*2.0*682
- IF "^1^2^3^"[(U_IBXA_U)
- IF IBCHG
- Begin DoDot:1
- +109 DO CLSTR^IBECEAU1(DFN,IBFR)
- IF 'IBCLDA
- WRITE !!,"Please note that there is no billing clock which would cover this charge.",!,"Be sure that this patient's billing clock is correct."
- QUIT
- +110 DO CLOCK^IBECEAU(-IBCHG,+$PIECE(IBCLST,"^",9),-IBUNIT)
- +111 QUIT
- End DoDot:1
- +112 ; re-bill previous charge
- +113 ; IB*2.0*682
- IF IBSVIEN
- IF '$GET(IBAPI)
- DO REBILL(DFN,$PIECE(^IB(IBSVIEN,0),U,17),IBSVIEN)
- +114 ;
- ONEQ ;Exit utility
- +1 IF $GET(IBAPI)
- SET IBCNRSLT=IBY
- +2 if IBY<0
- DO ERR^IBECEAU4
- DO PAUSE^IBECEAU
- +3 KILL IBCHG,IBCRES,IBDESC,IBIL,IBND,IBSEQNO,IBTOTL,IBUNIT,IBATYP,IBIDX,IBCC
- +4 KILL IBN,IBREB,IBY,IBEVDA,IBPARNT,IBH,IBCANTR,IBXA,IBSL,IBFR,IBTO,IBNOS,IBCANC,IBAMC,IBSTCHCK,IBCNMH
- +5 QUIT
- +6 ;
- PASS ; Pass the action to Accounts Receivable.
- +1 NEW IBSERV
- +2 WRITE !,"Passing the cancellation action to AR... "
- +3 SET IBNOS=IBN
- DO ^IBR
- SET IBY=Y
- if Y>0
- WRITE "done."
- +4 QUIT
- +5 ;
- UPDVST(IBCAN) ; update the Visit Tracking file
- +1 ;
- +2 ;INPUT - IBCAN - Type of Update to perform
- +3 ; 1 - Remove with Entered in Error Message
- +4 ; 2 - Visit Only Update
- +5 ; 3 - Free (if free not used) or Visit Only
- +6 ; 4 - Remove with Duplicate Error message
- +7 ;
- +8 NEW IBBLNO,IBSTAT,IBVSTIEN,IBREAS,IBRTN,IBERROR,IBSTAT
- +9 SET IBERROR=""
- +10 ;Locate the IEN in the file using the Bill Number
- +11 SET IBBLNO=$$GET1^DIQ(350,IBN_",",.11,"E")
- +12 if $EXTRACT(IBBLNO,1)="K"
- SET IBBLNO=IBSITE_"-"_IBBLNO
- +13 SET IBSTAT=$$GET1^DIQ(350,IBN_",",.05,"I")
- +14 if IBSTAT=8
- SET IBBLNO="ON HOLD"
- +15 SET IBVSTIEN=$$FNDVST(IBBLNO,$$GET1^DIQ(350,IBN_",",.14,"I"),$$GET1^DIQ(350,IBN_",",.02,"I"))
- +16 IF +IBVSTIEN=0
- Begin DoDot:1
- +17 WRITE !!,"Unable to locate the bill in the Urgent Care Visit Tracking Database"
- +18 WRITE !,"for this veteran. Please review and update the Urgent Care Visit "
- +19 WRITE !,"Tracking Maintenance Utility.",!
- End DoDot:1
- QUIT
- +20 ;
- +21 ;Set Status and Reason based on update type.
- +22 ;Visits Removed
- if IBCAN=1
- SET IBREAS=3
- SET IBSTAT=3
- +23 ;Visit set to Visit Only
- if IBCAN=2
- SET IBREAS=5
- SET IBSTAT=4
- +24 ;Free visit
- if IBCAN=3
- SET IBREAS=1
- SET IBSTAT=1
- +25 ;Duplicate Visit
- if IBCAN=4
- SET IBREAS=4
- SET IBSTAT=3
- +26 ;
- +27 SET IBRTN=$$UPDATE^IBECEA38(IBVSTIEN,IBSTAT,"",IBREAS,1,IBERROR)
- +28 ;
- +29 QUIT
- +30 ;
- FNDVST(IBBLNO,IBVSTDT,IBN) ; Locate the Visit IEN
- +1 ;
- +2 NEW IBVSTIEN,IBVSTD,IBFOUND
- +3 SET IBVSTIEN=0
- SET IBFOUND=0
- +4 FOR
- SET IBVSTIEN=$ORDER(^IBUC(351.82,"C",IBBLNO,IBVSTIEN))
- if IBVSTIEN=""
- QUIT
- Begin DoDot:1
- +5 SET IBVSTD=$GET(^IBUC(351.82,IBVSTIEN,0))
- +6 IF (IBVSTDT=$PIECE(IBVSTD,U,3))
- IF (IBN=$PIECE(IBVSTD,U))
- SET IBFOUND=1
- End DoDot:1
- if IBFOUND=1
- QUIT
- +7 QUIT +IBVSTIEN
- +8 ;
- UCVSTDB ; Update the UC Visit Tracking DB if the Cancellation Reason is usable on UC copays
- +1 ;
- +2 NEW IBUCBH,IBELIG,IBNOFRVS
- +3 IF +$$GET1^DIQ(350.3,IBCRES_",",.04,"I")=0
- Begin DoDot:1
- +4 SET IBY=-1
- +5 WRITE !!,"The selected Cancellation Reason cannot be used when cancelling"
- +6 WRITE !,"an Urgent Care Copay."
- End DoDot:1
- QUIT
- +7 ;
- +8 SET IBUCBH=$$GET1^DIQ(350.3,IBCRES_",",.05,"I")
- +9 ;
- +10 ;For those cancellation reasons deemed to be data entry errors
- +11 IF IBUCBH=1
- DO UPDVST(1)
- QUIT
- +12 ;
- +13 ;For those cancellation reasons deemed to be duplicate visits
- +14 IF IBUCBH=4
- DO UPDVST(4)
- QUIT
- +15 ;
- +16 ;For those cancellation reasons that need to keep the visit as visit only....
- +17 IF IBUCBH=2
- DO UPDVST(2)
- QUIT
- +18 ;
- +19 ;For other valid UC cancellation reasons, assuming that they are 3's (need free visit check)
- +20 SET IBELIG=$$GETELGP^IBECEA36($PIECE(IBND,U,2),$PIECE(IBND,U,14))
- +21 IF IBELIG=6
- Begin DoDot:1
- +22 DO UPDVST(2)
- +23 WRITE !!,"Patient is in Enrollment Group 6 on the day of this visit."
- +24 WRITE !,"Urgent Care Visit Tracking for this visit is set to Visit Only."
- +25 WRITE !,"If this needs to be a free visit, please update the visit using"
- +26 WRITE !,"the Urgent Care Visit Tracking Maintenance Option after RUR review."
- End DoDot:1
- QUIT
- +27 ;
- +28 ;If still PG 7 or 8 update to Visit Only and quit.
- +29 IF IBELIG>6
- DO UPDVST(2)
- QUIT
- +30 ;
- +31 ;Retrieve # visits
- +32 SET IBNOFRVS=$PIECE($$GETVST^IBECEA36($PIECE(IBND,U,2),$PIECE(IBND,U,14)),U,2)
- +33 ;
- +34 ;If free visit remain, convert visit to Free Visit
- +35 IF IBNOFRVS<3
- DO UPDVST(3)
- QUIT
- +36 ;
- +37 ;Otherwise, visit only.
- +38 DO UPDVST(2)
- +39 ;
- +40 QUIT
- +41 ;IB*2.0*678 - Create API entry point for cancelling a copay
- CANCAPI(IBN) ;Cancel a copay given a Copay IEN.
- +1 ;
- +2 ;INPUT - IEN of the copay to cancel
- +3 ;OUTPUT -
- +4 ; -1 - Error (Error handled within cancel but still part of the return)
- +5 ; 0 - Not cancelled
- +6 ; 1 - Cancelled
- +7 ;
- +8 NEW IBND,IBPARNT,IBCANC,IBH,IBCANTR,IBXA,IBATYP,IBSEQNO,IBIL,IBUNIT,IBCHG,IBFR,IBJOB,IBCRES
- +9 NEW IBDESC,IBIL,IBSEQNO,IBTOTL,IBIDX,IBCC,IBREB,IBY,IBEVDA,IBPARNT,IBH,IBSL,IBTO,IBNOS,IBCANC,IBAMC
- +10 NEW IBAPI,IBCNRSLT
- +11 ;
- +12 ;Initialize the job type.
- +13 SET IBJOB=4
- SET IBAPI=1
- SET IBY=""
- +14 ;
- +15 DO ONE
- +16 QUIT IBCNRSLT
- +17 ;
- REBILL(IBDFN,IBEVDT,IBCRNT) ; Re-bill one of cancelled charges on a given date IB*2.0*682
- +1 ;
- +2 ; IBDFN - patient's DFN
- +3 ; IBEVDT - event date (350/.17)
- +4 ; IBCRNT - current charge (the one being cancelled) to be excluded from the list (file 350 ien)
- +5 ;
- +6 NEW IB0,IBACT,IBCNT,IBDASH,IBDT,IBEDT,IBHASUC,IBIENS,IBINPT,IBLINES,IBREBILL,IBSDT,IBUC0,IBUCFLG,IBUCIEN,IBUCSKIP,IBZ
- +7 ; get cancelled charges
- +8 ; set to 1 below if there's at least one cancelled UC charge
- SET IBHASUC=0
- +9 SET (IBUCSKIP,IBCNT)=0
- +10 SET IBACT=+$PIECE($GET(IBND),U,3)
- +11 ; don't re-bill if cancelling an RX charge
- IF $$ISRX(IBACT)
- QUIT
- +12 ; 1 if inpatient charge
- SET IBINPT=$$ISINPT(IBACT)
- +13 ; 1 if UC charge
- SET IBUCFLG=$SELECT($$GET1^DIQ(350,IBCRNT_",",.03)["URGENT CARE":1,1:0)
- +14 SET IBSDT=$SELECT(IBINPT:$PIECE(IBND,U,14),1:IBEVDT)
- +15 SET IBEDT=$SELECT(IBINPT:$PIECE(IBND,U,15),1:IBEVDT)
- +16 IF IBSDT
- IF IBEDT
- FOR IBDT=IBSDT:1:IBEDT
- Begin DoDot:1
- +17 SET IBZ=0
- FOR
- SET IBZ=$ORDER(^IB("AFDT",IBDFN,-IBDT,IBZ))
- if 'IBZ
- QUIT
- Begin DoDot:2
- +18 SET IBIENS=IBZ_","
- +19 ; only include cancelled charges
- IF $$GET1^DIQ(350,IBIENS,.05)'="CANCELLED"
- QUIT
- +20 ; don't include the charge currently being cancelled
- IF IBZ=IBCRNT
- QUIT
- +21 ; don't include RX charges
- SET IB0=$GET(^IB(IBZ,0))
- IF $$ISRX(+$PIECE(IB0,U,3))
- QUIT
- +22 SET IBCNT=IBCNT+1
- +23 ; IBLINES(n) = string formatted for display
- +24 ; IBLINES(n,"IEN") = corresponding file 350 ien
- +25 ; IBLINES(n,"UC") = corresponding file 351.82 ien (for "visit only" UC entries)
- +26 ; bill from (350/.14)
- SET IBLINES(IBCNT)=$$FMTE^XLFDT($PIECE(IB0,U,14),"2DZ")
- +27 ; bill to (350/.15)
- SET $PIECE(IBLINES(IBCNT),U,2)=$$FMTE^XLFDT($PIECE(IB0,U,15),"2DZ")
- +28 ; charge type (350/.03)
- SET $PIECE(IBLINES(IBCNT),U,3)=$$GET1^DIQ(350,IBIENS,.03)
- +29 IF $PIECE(IBLINES(IBCNT),U,3)["URGENT CARE"
- SET IBHASUC=1
- +30 ; bill # (350/.11)
- SET $PIECE(IBLINES(IBCNT),U,4)=$PIECE($PIECE(IB0,U,11),"-",2)
- +31 ; cancel reason (350/.1)
- SET $PIECE(IBLINES(IBCNT),U,5)=$$GET1^DIQ(350,IBIENS,.1)
- +32 ; charge amount (350/.07)
- SET $PIECE(IBLINES(IBCNT),U,6)=$PIECE(IB0,U,7)
- +33 ; clinic stop code (350/.2)
- SET $PIECE(IBLINES(IBCNT),U,7)=$$GET1^DIQ(350,IBIENS,.2)
- +34 SET IBLINES(IBCNT,"IEN")=IBZ
- +35 ; IBFAC is defined elsewhere, comes from a call to SITE^IBAUTL
- SET IBUCIEN=$$FNDUCV(IBDFN,IBEVDT,$SELECT($GET(IBFAC)>0:IBFAC,1:+$$SITE^VASITE()))
- +36 IF IBUCIEN
- SET IBLINES(IBCNT,"UC")=IBUCIEN
- +37 QUIT
- End DoDot:2
- +38 ; get UC "visit only" entries
- +39 IF 'IBHASUC
- SET IBZ=0
- FOR
- SET IBZ=$ORDER(^IBUC(351.82,"B",IBDFN,IBZ))
- if 'IBZ
- QUIT
- Begin DoDot:2
- +40 SET IBUC0=$GET(^IBUC(351.82,IBZ,0))
- +41 ; wrong event date, skip
- IF $PIECE(IBUC0,U,3)'=IBDT
- QUIT
- +42 ; status is not "visit only", skip
- IF $PIECE(IBUC0,U,4)'=4
- QUIT
- +43 ; wrong site, skip
- IF $PIECE(IBUC0,U,2)'=IBFAC
- QUIT
- +44 ; if UC charge is being cancelled, corresponding 351.82 entry is converted to "visit only", so one of "visit only" entries
- +45 ; needs to be excluded
- +46 IF IBUCFLG
- IF 'IBUCSKIP
- SET IBUCSKIP=1
- QUIT
- +47 SET IBCNT=IBCNT+1
- +48 ; bill from / to contain visit date (351.82/.03)
- SET (IBLINES(IBCNT),$PIECE(IBLINES(IBCNT),U,2))=$$FMTE^XLFDT($PIECE(IBUC0,U,3),"2DZ")
- +49 ; no charge for UC Visit Only entries
- SET $PIECE(IBLINES(IBCNT),U,3)="Urgent Care"
- +50 SET $PIECE(IBLINES(IBCNT),U,5)="Visit Only"
- +51 SET IBLINES(IBCNT,"UC")=IBZ
- +52 QUIT
- End DoDot:2
- +53 QUIT
- End DoDot:1
- +54 ; nothing to display
- IF IBCNT'>0
- QUIT
- +55 ; display charges
- +56 SET $PIECE(IBDASH,"-",81)=""
- +57 WRITE !!,"The following copay charges from the same date may be re-billed:"
- +58 WRITE !!," Bill From Bill To Charge Type Bill # Cancel Reason Stop Charge"
- +59 WRITE !,IBDASH
- +60 FOR IBZ=1:1:IBCNT
- Begin DoDot:1
- +61 WRITE !,$$RJ^XLFSTR(IBZ,2),?3,$PIECE(IBLINES(IBZ),U),?13,$PIECE(IBLINES(IBZ),U,2),?22,$EXTRACT($PIECE(IBLINES(IBZ),U,3),1,16)
- +62 WRITE ?39,$PIECE(IBLINES(IBZ),U,4),?49,$EXTRACT($PIECE(IBLINES(IBZ),U,5),1,16),?66,$PIECE(IBLINES(IBZ),U,7)
- +63 WRITE ?74,$SELECT(+$PIECE(IBLINES(IBZ),U,6)>0:$$RJ^XLFSTR("$"_$PIECE(IBLINES(IBZ),U,6),6),1:"")
- +64 QUIT
- End DoDot:1
- +65 WRITE !
- +66 ; If cancelling an inpatient charge, just display message and quit
- +67 IF IBINPT
- WRITE !,"Please review this patient's copayments during this period for potential re-billing."
- QUIT
- +68 ; Check for IB EDIT key
- +69 IF '$DATA(^XUSEC("IB EDIT",DUZ))
- Begin DoDot:1
- +70 WRITE !!,"IB EDIT Key required to Add a Charge."
- +71 WRITE !!,"Please notify 1st party billing for review and potential re-bill of the above copayment(s), if needed."
- +72 QUIT
- End DoDot:1
- QUIT
- +73 ; prompt for a charge to re-bill
- +74 SET IBZ=$$ASKRB(IBCNT)
- IF 'IBZ
- QUIT
- +75 ; re-bill selected charge
- +76 ; UC Visit Only
- +77 IF $GET(IBLINES(IBZ,"IEN"))'>0
- Begin DoDot:1
- +78 SET (IBREBILL("EVDT"),IBREBILL("BILLFR"),IBREBILL("BILLTO"))=$PIECE(^IBUC(351.82,IBLINES(IBZ,"UC"),0),U,3)
- +79 SET IBREBILL("CHRGTYPE")="CC URGENT CARE"
- +80 SET IBREBILL("UC")=IBLINES(IBZ,"UC")
- +81 DO ADD^IBECEA3
- +82 QUIT
- End DoDot:1
- QUIT
- +83 ; regular charge
- +84 SET IBIENS=IBLINES(IBZ,"IEN")_","
- +85 ; populate array of default values to pass to ^IBECEA3 (Add charge)
- +86 SET IBREBILL("EVDT")=$PIECE(^IB(IBLINES(IBZ,"IEN"),0),U,17)
- +87 SET IBREBILL("BILLFR")=$PIECE(^IB(IBLINES(IBZ,"IEN"),0),U,14)
- +88 SET IBREBILL("BILLTO")=$PIECE(^IB(IBLINES(IBZ,"IEN"),0),U,15)
- +89 SET IBREBILL("CHRGTYPE")=$$GET1^DIQ(350.1,$PIECE(^IB(IBLINES(IBZ,"IEN"),0),U,3),.08)
- +90 SET IBREBILL("CHRGAMT")=$$GET1^DIQ(350,IBIENS,.07)
- +91 IF $GET(IBLINES(IBZ,"UC"))
- SET IBREBILL("UC")=IBLINES(IBZ,"UC")
- +92 DO ADD^IBECEA3
- +93 QUIT
- +94 ;
- ASKRB(IBNUM) ; Prompt for re-billing of a cancelled charge IB*2.0*682
- +1 ;
- +2 ; IBNUM - number of entries in the list
- +3 ;
- +4 NEW DIR,DIRUT,DIROUT,DTOUT,DUOUT,RES,X,Y
- +5 SET DIR(0)="FA^1:"_IBNUM_"^I +X<1!(+X>"_IBNUM_") K X"
- +6 SET DIR("A",1)="Please review the above list of potentially (re)billable items."
- +7 SET DIR("A")="Select charge to re-bill (1 - "_IBNUM_") or type '^' to skip this step: "
- +8 SET DIR("?")="Select a charge to re-bill from the list above (1 - "_IBNUM_"), or type '^' to skip re-billing."
- +9 DO ^DIR
- +10 QUIT +Y
- +11 ;
- ISINPT(IBACT) ; check if given charge is an inpatient charge
- +1 ;
- +2 ; IBACT - ien in file 350.1 for the charge in question
- +3 ;
- +4 ; returns 1 if inpatient charge, 0 otherwise
- +5 ;
- +6 NEW RES
- +7 SET RES=0
- +8 IF IBACT
- IF "^1^2^3^9^"[(U_$PIECE($GET(^IBE(350.1,IBACT,0)),U,11)_U)
- SET RES=1
- +9 QUIT RES
- +10 ;
- ISRX(IBACT) ; check if given charge is an RX charge
- +1 ;
- +2 ; IBACT - ien in file 350.1 for the charge in question
- +3 ;
- +4 ; returns 1 if RX charge, 0 otherwise
- +5 ;
- +6 NEW RES
- +7 SET RES=0
- +8 IF IBACT
- IF $PIECE($GET(^IBE(350.1,IBACT,0)),U,11)=5
- SET RES=1
- +9 QUIT RES
- +10 ;
- FNDUCV(IBDFN,IBEVDT,IBSITE) ; find "visit only" entry in file 351.82
- +1 ;
- +2 ; IBDFN - patient's DFN
- +3 ; IBEVDT - event date (350/.17)
- +4 ; IBSITE - local facility (file 4 ien)
- +5 ;
- +6 ; Returns ien in file 351.82 if an entry was found, 0 otherwise
- +7 ;
- +8 NEW IBFOUND,IBRES,IBUC0,IBZ
- +9 SET IBRES=0
- +10 IF IBDFN'>0!(IBEVDT'>0)!(IBSITE'>0)
- QUIT IBRES
- +11 SET (IBFOUND,IBZ)=0
- FOR
- SET IBZ=$ORDER(^IBUC(351.82,"VD",IBEVDT,IBZ))
- if 'IBZ
- QUIT
- Begin DoDot:1
- +12 SET IBUC0=^IBUC(351.82,IBZ,0)
- +13 ; wrong patient
- IF $PIECE(IBUC0,U)'=IBDFN
- QUIT
- +14 ; status is not "visit only"
- IF $PIECE(IBUC0,U,4)'=4
- QUIT
- +15 ; wrong site
- IF $PIECE(IBUC0,U,2)'=IBSITE
- QUIT
- +16 SET IBFOUND=1
- SET IBRES=IBZ
- +17 QUIT
- End DoDot:1
- if IBFOUND
- QUIT
- +18 QUIT IBRES