Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: IBECEA4

IBECEA4.m

Go to the documentation of this file.
  1. 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
  1. ;;Per VHA Directive 6402, this routine should not be modified.
  1. ;
  1. ONE ; Cancel a single charge.
  1. N IBLPFLG
  1. ;
  1. D:'+$G(IBAPI) HDR^IBECEAU("C A N C E L")
  1. ;
  1. ; - perform up-front edits
  1. D CED^IBECEAU4(IBN) G:IBY<0 ONEQ
  1. I IBXA=6!(IBXA=7) D G ONEQ:$G(IBCC),REAS
  1. .I IBCANTR!($P(IBND,"^",5)=10) S IBCC=1 W !,"This transaction has already been cancelled.",!
  1. 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
  1. I 'IBH,IBIL="" S IBY="-1^IB024" G ONEQ
  1. ;
  1. REAS ; - ask for the cancellation reason
  1. N IBSVIEN ; IB*2.0*682
  1. N IBOENC,IBOEEVDT,IBSTCD,IBSTOPDA,NUMVSTFL
  1. ;
  1. S IBLPFLG=0 ;Set the reason loop flag for bad Cancel Reason selections
  1. ;
  1. S IBFLG=0
  1. D REAS^IBECEAU2("C")
  1. ;IB*2.0*678 - Correct error or no reason functionality
  1. I IBCRES<0 D G ONEQ
  1. . S IBY=-1
  1. ;
  1. ;IB*2.0*669
  1. ; Temporary inactive flag check until IB*2.0*653 is released. Then need to move the inactive check to
  1. ; the DIC("S") variable in REAS^IBECEAU2.
  1. ; cHECK INACTIVE FLAG
  1. ; If Cancel reason is inactive, the post message to user and try again.
  1. I $$GET1^DIQ(350.3,IBCRES_",",.06,"I") D G:IBY<0 REAS
  1. . S IBY=-1
  1. . W !!,"The selected cancellation reason is inactive."
  1. . W !,"Please select another cancellation reason.",!!
  1. ;
  1. ;Check to see if it is an Urgent Care
  1. 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
  1. . S IBY=-1
  1. . W !!,"This is an Urgent Care Copayment. Please use an Urgent Care cancellation reason.",!,"This transaction cannot be completed.",!
  1. ;
  1. ;IB*2.0*784 - Cleland-Dole Benefit Check
  1. S IBSTCHCK=0
  1. ; Check to see if Bill is eligible for Cleland-Dole tracking.
  1. I $P($G(^IBE(350.1,$P(IBND,U,3),0)),U,11)=4 D ;Only Outpatient Copays are eligible for C-D tracking.
  1. . I +$O(^IBMH(351.83,"D",IBN,"")) S IBSTCHCK=1 Q ;Bill currently in DB
  1. . I $P($G(^IBE(350.1,$P(IBND,U,3),0)),U)["CC MH" S IBSTCHCK=1 Q
  1. . S IBSTOPDA=$P(IBND,U,20) ;Get the stop code
  1. . ;Get encounter info.
  1. . S IBOEEVDT=$P(IBND,U,17),IBOENC=$P($P(IBND,U,4),";")
  1. . I IBSTOPDA'="" D
  1. . . S IBSTCD=$$GET1^DIQ(352.5,IBSTOPDA_",",.01,"E")
  1. . . S IBSTCHCK=$$CDCHK^IBECEAMH(IBSTCD,$P(IBND,U,17)) ;Check for C-D eligibility for Stop Code
  1. . . I 'IBSTCHCK,$$ISCDELIG^IBECEAMH(IBFR) I $P(IBOENC,":")="409.68" S IBSTCHCK=$$CHKST44^IBECEAMH($P(IBOENC,":",2))
  1. . ; Eligible for Cleland Dole, proceed with Cancel.
  1. . Q:IBSTCHCK ;C-D eligible.
  1. . ; If OutP Encounter, check the encounter.
  1. . I $P(IBOENC,":")=409.68 S IBSTCHCK=$$OECHK^IBECEAMH($P(IBOENC,":",2),IBOEEVDT)
  1. ;
  1. 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
  1. .S IBY=-1
  1. .W !!,"This is a Cleland-Dole eligible Copayment. Please use an appropriate cancellation reason.",!,"This transaction cannot be completed.",!
  1. .Q
  1. ;
  1. ;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
  1. I 'IBSTCHCK,($$GET1^DIQ(350.3,IBCRES_",",.01,"E")="CLELAND-DOLE") D G REAS
  1. . D MESS3^IBECEAMH(0)
  1. ;
  1. ;Check # C-D free visits
  1. I IBSTCHCK D G:IBLPFLG REAS
  1. . S NUMVSTFL=$$NUMVSTCK^IBECEAMH(DFN,IBFR) ; Visit Check Flag
  1. . Q:NUMVSTFL ; Free visits available. Continue with Cancellation.
  1. . ;
  1. . ;Check to see if the Cleland Dole Cancellation reason was chosen, but no more free visits are available.
  1. . I ($$GET1^DIQ(350.3,IBCRES_",",.01,"E")="CLELAND-DOLE") D Q
  1. . . D MESS3^IBECEAMH(1)
  1. . . S IBLPFLG=1
  1. . ; Code in place if a DoS sequence to the benefit is needed vs the current FIFO sequence
  1. . ;S IBCDEVDT=$P(IBND,U,17)
  1. . ;I $$DTCHK^IBECEAMH(DFN,IBCDEVDT) D Q
  1. . ;. S IBY=-1
  1. . ;. D MESS2A^IBECEAMH ;Alert user to review Bill cancellation sequence for Cleland-Dole before cancelling this bill.
  1. ;end IB*2.0*784
  1. ;
  1. ; - okay to proceed?
  1. D PROC^IBECEAU4("cancel") G:IBY<0 ONEQ
  1. ;
  1. ;If Copay being cancelled is CC URGENT CARE check to see if it can be cancelled and do the processing.
  1. I $$GET1^DIQ(350.1,$P(IBND,U,3)_",",.01,"E")["URGENT CARE" D UCVSTDB G:IBY<0 ONEQ
  1. ;
  1. ; - handle CHAMPVA/TRICARE charges
  1. I IBXA=6!(IBXA=7) D CANC^IBECEAU4(IBN,IBCRES,1) G ONEQ
  1. ;
  1. ; - handle cancellation transactions
  1. I IBCANTR D G ONEQ
  1. .I IBN=IBPARNT D UPSTAT^IBECEAU4(IBN,1) Q
  1. .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
  1. .S DIE="^IB(",DA=IBN,DR=".1////"_IBCRES_";.11////"_IBIL D ^DIE,PASS K DIE,DA,DR
  1. ;
  1. ; - update 354.71 and 354.7 (cap info)
  1. I $P(IBND,"^",19) S IBAMC=$$CANCEL^IBARXMN(DFN,$P(IBND,"^",19),.IBY) G:IBY<1 ONEQ I IBAMC D FOUND^IBARXMA(.IBY,IBAMC)
  1. ;
  1. S IBSVIEN=IBN ; save off file 350 ien, because in some cases it gets overwritten in the cancellation code IB*2.0*682
  1. ; - handle incomplete and regular transactions
  1. D CANC^IBECEAU4(IBN,IBCRES,1) G:IBY<1 ONEQ
  1. ;
  1. ;IB*2.0*784
  1. ;If performing a C-D cancellation, Update the tracking DB.
  1. I IBSTCHCK D
  1. .S IBCNMH=$$GET1^DIQ(350.3,IBCRES_",",.07,"I") ; Find out how the Mental Health DB should be updated.
  1. .I IBCNMH D ; IB*2.0*760
  1. ..I $$GETMHFR^IBAMTC(DFN,IBFR) S IBCNMH=2 ; if there's already a free visit on this date, update MH DB to "visit only"
  1. ..D UPDVST^IBECEAMH(IBSVIEN,IBCNMH) ; Update If the Mental Health DB
  1. ..Q
  1. .Q
  1. ;End IB*2.0*784
  1. ;
  1. ; - handle updating of clock
  1. ;I "^1^2^3^"'[("^"_IBXA_"^") G ONEQ
  1. ;I 'IBCHG G ONEQ
  1. ;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
  1. ;D CLOCK^IBECEAU(-IBCHG,+$P(IBCLST,"^",9),-IBUNIT)
  1. I "^1^2^3^"[(U_IBXA_U),IBCHG D ; IB*2.0*682
  1. .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
  1. .D CLOCK^IBECEAU(-IBCHG,+$P(IBCLST,"^",9),-IBUNIT)
  1. .Q
  1. ; re-bill previous charge
  1. I IBSVIEN,'$G(IBAPI) D REBILL(DFN,$P(^IB(IBSVIEN,0),U,17),IBSVIEN) ; IB*2.0*682
  1. ;
  1. ONEQ ;Exit utility
  1. I $G(IBAPI) S IBCNRSLT=IBY
  1. D ERR^IBECEAU4:IBY<0,PAUSE^IBECEAU
  1. K IBCHG,IBCRES,IBDESC,IBIL,IBND,IBSEQNO,IBTOTL,IBUNIT,IBATYP,IBIDX,IBCC
  1. K IBN,IBREB,IBY,IBEVDA,IBPARNT,IBH,IBCANTR,IBXA,IBSL,IBFR,IBTO,IBNOS,IBCANC,IBAMC,IBSTCHCK,IBCNMH
  1. Q
  1. ;
  1. PASS ; Pass the action to Accounts Receivable.
  1. N IBSERV
  1. W !,"Passing the cancellation action to AR... "
  1. S IBNOS=IBN D ^IBR S IBY=Y W:Y>0 "done."
  1. Q
  1. ;
  1. UPDVST(IBCAN) ; update the Visit Tracking file
  1. ;
  1. ;INPUT - IBCAN - Type of Update to perform
  1. ; 1 - Remove with Entered in Error Message
  1. ; 2 - Visit Only Update
  1. ; 3 - Free (if free not used) or Visit Only
  1. ; 4 - Remove with Duplicate Error message
  1. ;
  1. N IBBLNO,IBSTAT,IBVSTIEN,IBREAS,IBRTN,IBERROR,IBSTAT
  1. S IBERROR=""
  1. ;Locate the IEN in the file using the Bill Number
  1. S IBBLNO=$$GET1^DIQ(350,IBN_",",.11,"E")
  1. S:$E(IBBLNO,1)="K" IBBLNO=IBSITE_"-"_IBBLNO
  1. S IBSTAT=$$GET1^DIQ(350,IBN_",",.05,"I")
  1. S:IBSTAT=8 IBBLNO="ON HOLD"
  1. S IBVSTIEN=$$FNDVST(IBBLNO,$$GET1^DIQ(350,IBN_",",.14,"I"),$$GET1^DIQ(350,IBN_",",.02,"I"))
  1. I +IBVSTIEN=0 D Q
  1. . W !!,"Unable to locate the bill in the Urgent Care Visit Tracking Database"
  1. . W !,"for this veteran. Please review and update the Urgent Care Visit "
  1. . W !,"Tracking Maintenance Utility.",!
  1. ;
  1. ;Set Status and Reason based on update type.
  1. S:IBCAN=1 IBREAS=3,IBSTAT=3 ;Visits Removed
  1. S:IBCAN=2 IBREAS=5,IBSTAT=4 ;Visit set to Visit Only
  1. S:IBCAN=3 IBREAS=1,IBSTAT=1 ;Free visit
  1. S:IBCAN=4 IBREAS=4,IBSTAT=3 ;Duplicate Visit
  1. ;
  1. S IBRTN=$$UPDATE^IBECEA38(IBVSTIEN,IBSTAT,"",IBREAS,1,IBERROR)
  1. ;
  1. Q
  1. ;
  1. FNDVST(IBBLNO,IBVSTDT,IBN) ; Locate the Visit IEN
  1. ;
  1. N IBVSTIEN,IBVSTD,IBFOUND
  1. S IBVSTIEN=0,IBFOUND=0
  1. F S IBVSTIEN=$O(^IBUC(351.82,"C",IBBLNO,IBVSTIEN)) Q:IBVSTIEN="" D Q:IBFOUND=1
  1. . S IBVSTD=$G(^IBUC(351.82,IBVSTIEN,0))
  1. . I (IBVSTDT=$P(IBVSTD,U,3)),(IBN=$P(IBVSTD,U)) S IBFOUND=1
  1. Q +IBVSTIEN
  1. ;
  1. UCVSTDB ; Update the UC Visit Tracking DB if the Cancellation Reason is usable on UC copays
  1. ;
  1. N IBUCBH,IBELIG,IBNOFRVS
  1. I +$$GET1^DIQ(350.3,IBCRES_",",.04,"I")=0 D Q
  1. . S IBY=-1
  1. . W !!,"The selected Cancellation Reason cannot be used when cancelling"
  1. . W !,"an Urgent Care Copay."
  1. ;
  1. S IBUCBH=$$GET1^DIQ(350.3,IBCRES_",",.05,"I")
  1. ;
  1. ;For those cancellation reasons deemed to be data entry errors
  1. I IBUCBH=1 D UPDVST(1) Q
  1. ;
  1. ;For those cancellation reasons deemed to be duplicate visits
  1. I IBUCBH=4 D UPDVST(4) Q
  1. ;
  1. ;For those cancellation reasons that need to keep the visit as visit only....
  1. I IBUCBH=2 D UPDVST(2) Q
  1. ;
  1. ;For other valid UC cancellation reasons, assuming that they are 3's (need free visit check)
  1. S IBELIG=$$GETELGP^IBECEA36($P(IBND,U,2),$P(IBND,U,14))
  1. I IBELIG=6 D Q
  1. . D UPDVST(2)
  1. . W !!,"Patient is in Enrollment Group 6 on the day of this visit."
  1. . W !,"Urgent Care Visit Tracking for this visit is set to Visit Only."
  1. . W !,"If this needs to be a free visit, please update the visit using"
  1. . W !,"the Urgent Care Visit Tracking Maintenance Option after RUR review."
  1. ;
  1. ;If still PG 7 or 8 update to Visit Only and quit.
  1. I IBELIG>6 D UPDVST(2) Q
  1. ;
  1. ;Retrieve # visits
  1. S IBNOFRVS=$P($$GETVST^IBECEA36($P(IBND,U,2),$P(IBND,U,14)),U,2)
  1. ;
  1. ;If free visit remain, convert visit to Free Visit
  1. I IBNOFRVS<3 D UPDVST(3) Q
  1. ;
  1. ;Otherwise, visit only.
  1. D UPDVST(2)
  1. ;
  1. Q
  1. ;IB*2.0*678 - Create API entry point for cancelling a copay
  1. CANCAPI(IBN) ;Cancel a copay given a Copay IEN.
  1. ;
  1. ;INPUT - IEN of the copay to cancel
  1. ;OUTPUT -
  1. ; -1 - Error (Error handled within cancel but still part of the return)
  1. ; 0 - Not cancelled
  1. ; 1 - Cancelled
  1. ;
  1. N IBND,IBPARNT,IBCANC,IBH,IBCANTR,IBXA,IBATYP,IBSEQNO,IBIL,IBUNIT,IBCHG,IBFR,IBJOB,IBCRES
  1. N IBDESC,IBIL,IBSEQNO,IBTOTL,IBIDX,IBCC,IBREB,IBY,IBEVDA,IBPARNT,IBH,IBSL,IBTO,IBNOS,IBCANC,IBAMC
  1. N IBAPI,IBCNRSLT
  1. ;
  1. ;Initialize the job type.
  1. S IBJOB=4,IBAPI=1,IBY=""
  1. ;
  1. D ONE
  1. Q IBCNRSLT
  1. ;
  1. REBILL(IBDFN,IBEVDT,IBCRNT) ; Re-bill one of cancelled charges on a given date IB*2.0*682
  1. ;
  1. ; IBDFN - patient's DFN
  1. ; IBEVDT - event date (350/.17)
  1. ; IBCRNT - current charge (the one being cancelled) to be excluded from the list (file 350 ien)
  1. ;
  1. N IB0,IBACT,IBCNT,IBDASH,IBDT,IBEDT,IBHASUC,IBIENS,IBINPT,IBLINES,IBREBILL,IBSDT,IBUC0,IBUCFLG,IBUCIEN,IBUCSKIP,IBZ
  1. ; get cancelled charges
  1. S IBHASUC=0 ; set to 1 below if there's at least one cancelled UC charge
  1. S (IBUCSKIP,IBCNT)=0
  1. S IBACT=+$P($G(IBND),U,3)
  1. I $$ISRX(IBACT) Q ; don't re-bill if cancelling an RX charge
  1. S IBINPT=$$ISINPT(IBACT) ; 1 if inpatient charge
  1. S IBUCFLG=$S($$GET1^DIQ(350,IBCRNT_",",.03)["URGENT CARE":1,1:0) ; 1 if UC charge
  1. S IBSDT=$S(IBINPT:$P(IBND,U,14),1:IBEVDT)
  1. S IBEDT=$S(IBINPT:$P(IBND,U,15),1:IBEVDT)
  1. I IBSDT,IBEDT F IBDT=IBSDT:1:IBEDT D
  1. .S IBZ=0 F S IBZ=$O(^IB("AFDT",IBDFN,-IBDT,IBZ)) Q:'IBZ D
  1. ..S IBIENS=IBZ_","
  1. ..I $$GET1^DIQ(350,IBIENS,.05)'="CANCELLED" Q ; only include cancelled charges
  1. ..I IBZ=IBCRNT Q ; don't include the charge currently being cancelled
  1. ..S IB0=$G(^IB(IBZ,0)) I $$ISRX(+$P(IB0,U,3)) Q ; don't include RX charges
  1. ..S IBCNT=IBCNT+1
  1. ..; IBLINES(n) = string formatted for display
  1. ..; IBLINES(n,"IEN") = corresponding file 350 ien
  1. ..; IBLINES(n,"UC") = corresponding file 351.82 ien (for "visit only" UC entries)
  1. ..S IBLINES(IBCNT)=$$FMTE^XLFDT($P(IB0,U,14),"2DZ") ; bill from (350/.14)
  1. ..S $P(IBLINES(IBCNT),U,2)=$$FMTE^XLFDT($P(IB0,U,15),"2DZ") ; bill to (350/.15)
  1. ..S $P(IBLINES(IBCNT),U,3)=$$GET1^DIQ(350,IBIENS,.03) ; charge type (350/.03)
  1. ..I $P(IBLINES(IBCNT),U,3)["URGENT CARE" S IBHASUC=1
  1. ..S $P(IBLINES(IBCNT),U,4)=$P($P(IB0,U,11),"-",2) ; bill # (350/.11)
  1. ..S $P(IBLINES(IBCNT),U,5)=$$GET1^DIQ(350,IBIENS,.1) ; cancel reason (350/.1)
  1. ..S $P(IBLINES(IBCNT),U,6)=$P(IB0,U,7) ; charge amount (350/.07)
  1. ..S $P(IBLINES(IBCNT),U,7)=$$GET1^DIQ(350,IBIENS,.2) ; clinic stop code (350/.2)
  1. ..S IBLINES(IBCNT,"IEN")=IBZ
  1. ..S IBUCIEN=$$FNDUCV(IBDFN,IBEVDT,$S($G(IBFAC)>0:IBFAC,1:+$$SITE^VASITE())) ; IBFAC is defined elsewhere, comes from a call to SITE^IBAUTL
  1. ..I IBUCIEN S IBLINES(IBCNT,"UC")=IBUCIEN
  1. ..Q
  1. .; get UC "visit only" entries
  1. .I 'IBHASUC S IBZ=0 F S IBZ=$O(^IBUC(351.82,"B",IBDFN,IBZ)) Q:'IBZ D
  1. ..S IBUC0=$G(^IBUC(351.82,IBZ,0))
  1. ..I $P(IBUC0,U,3)'=IBDT Q ; wrong event date, skip
  1. ..I $P(IBUC0,U,4)'=4 Q ; status is not "visit only", skip
  1. ..I $P(IBUC0,U,2)'=IBFAC Q ; wrong site, skip
  1. ..; if UC charge is being cancelled, corresponding 351.82 entry is converted to "visit only", so one of "visit only" entries
  1. ..; needs to be excluded
  1. ..I IBUCFLG,'IBUCSKIP S IBUCSKIP=1 Q
  1. ..S IBCNT=IBCNT+1
  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)
  1. ..S $P(IBLINES(IBCNT),U,3)="Urgent Care" ; no charge for UC Visit Only entries
  1. ..S $P(IBLINES(IBCNT),U,5)="Visit Only"
  1. ..S IBLINES(IBCNT,"UC")=IBZ
  1. ..Q
  1. .Q
  1. I IBCNT'>0 Q ; nothing to display
  1. ; display charges
  1. S $P(IBDASH,"-",81)=""
  1. W !!,"The following copay charges from the same date may be re-billed:"
  1. W !!," Bill From Bill To Charge Type Bill # Cancel Reason Stop Charge"
  1. W !,IBDASH
  1. F IBZ=1:1:IBCNT D
  1. .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)
  1. .W ?39,$P(IBLINES(IBZ),U,4),?49,$E($P(IBLINES(IBZ),U,5),1,16),?66,$P(IBLINES(IBZ),U,7)
  1. .W ?74,$S(+$P(IBLINES(IBZ),U,6)>0:$$RJ^XLFSTR("$"_$P(IBLINES(IBZ),U,6),6),1:"")
  1. .Q
  1. W !
  1. ; If cancelling an inpatient charge, just display message and quit
  1. I IBINPT W !,"Please review this patient's copayments during this period for potential re-billing." Q
  1. ; Check for IB EDIT key
  1. I '$D(^XUSEC("IB EDIT",DUZ)) D Q
  1. .W !!,"IB EDIT Key required to Add a Charge."
  1. .W !!,"Please notify 1st party billing for review and potential re-bill of the above copayment(s), if needed."
  1. .Q
  1. ; prompt for a charge to re-bill
  1. S IBZ=$$ASKRB(IBCNT) I 'IBZ Q
  1. ; re-bill selected charge
  1. ; UC Visit Only
  1. I $G(IBLINES(IBZ,"IEN"))'>0 D Q
  1. .S (IBREBILL("EVDT"),IBREBILL("BILLFR"),IBREBILL("BILLTO"))=$P(^IBUC(351.82,IBLINES(IBZ,"UC"),0),U,3)
  1. .S IBREBILL("CHRGTYPE")="CC URGENT CARE"
  1. .S IBREBILL("UC")=IBLINES(IBZ,"UC")
  1. .D ADD^IBECEA3
  1. .Q
  1. ; regular charge
  1. S IBIENS=IBLINES(IBZ,"IEN")_","
  1. ; populate array of default values to pass to ^IBECEA3 (Add charge)
  1. S IBREBILL("EVDT")=$P(^IB(IBLINES(IBZ,"IEN"),0),U,17)
  1. S IBREBILL("BILLFR")=$P(^IB(IBLINES(IBZ,"IEN"),0),U,14)
  1. S IBREBILL("BILLTO")=$P(^IB(IBLINES(IBZ,"IEN"),0),U,15)
  1. S IBREBILL("CHRGTYPE")=$$GET1^DIQ(350.1,$P(^IB(IBLINES(IBZ,"IEN"),0),U,3),.08)
  1. S IBREBILL("CHRGAMT")=$$GET1^DIQ(350,IBIENS,.07)
  1. I $G(IBLINES(IBZ,"UC")) S IBREBILL("UC")=IBLINES(IBZ,"UC")
  1. D ADD^IBECEA3
  1. Q
  1. ;
  1. ASKRB(IBNUM) ; Prompt for re-billing of a cancelled charge IB*2.0*682
  1. ;
  1. ; IBNUM - number of entries in the list
  1. ;
  1. N DIR,DIRUT,DIROUT,DTOUT,DUOUT,RES,X,Y
  1. S DIR(0)="FA^1:"_IBNUM_"^I +X<1!(+X>"_IBNUM_") K X"
  1. S DIR("A",1)="Please review the above list of potentially (re)billable items."
  1. S DIR("A")="Select charge to re-bill (1 - "_IBNUM_") or type '^' to skip this step: "
  1. S DIR("?")="Select a charge to re-bill from the list above (1 - "_IBNUM_"), or type '^' to skip re-billing."
  1. D ^DIR
  1. Q +Y
  1. ;
  1. ISINPT(IBACT) ; check if given charge is an inpatient charge
  1. ;
  1. ; IBACT - ien in file 350.1 for the charge in question
  1. ;
  1. ; returns 1 if inpatient charge, 0 otherwise
  1. ;
  1. N RES
  1. S RES=0
  1. I IBACT,"^1^2^3^9^"[(U_$P($G(^IBE(350.1,IBACT,0)),U,11)_U) S RES=1
  1. Q RES
  1. ;
  1. ISRX(IBACT) ; check if given charge is an RX charge
  1. ;
  1. ; IBACT - ien in file 350.1 for the charge in question
  1. ;
  1. ; returns 1 if RX charge, 0 otherwise
  1. ;
  1. N RES
  1. S RES=0
  1. I IBACT,$P($G(^IBE(350.1,IBACT,0)),U,11)=5 S RES=1
  1. Q RES
  1. ;
  1. FNDUCV(IBDFN,IBEVDT,IBSITE) ; find "visit only" entry in file 351.82
  1. ;
  1. ; IBDFN - patient's DFN
  1. ; IBEVDT - event date (350/.17)
  1. ; IBSITE - local facility (file 4 ien)
  1. ;
  1. ; Returns ien in file 351.82 if an entry was found, 0 otherwise
  1. ;
  1. N IBFOUND,IBRES,IBUC0,IBZ
  1. S IBRES=0
  1. I IBDFN'>0!(IBEVDT'>0)!(IBSITE'>0) Q IBRES
  1. S (IBFOUND,IBZ)=0 F S IBZ=$O(^IBUC(351.82,"VD",IBEVDT,IBZ)) Q:'IBZ D Q:IBFOUND
  1. .S IBUC0=^IBUC(351.82,IBZ,0)
  1. .I $P(IBUC0,U)'=IBDFN Q ; wrong patient
  1. .I $P(IBUC0,U,4)'=4 Q ; status is not "visit only"
  1. .I $P(IBUC0,U,2)'=IBSITE Q ; wrong site
  1. .S IBFOUND=1,IBRES=IBZ
  1. .Q
  1. Q IBRES