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

IBECEAU6.m

Go to the documentation of this file.
  1. IBECEAU6 ;EDE/YMG - Cancel Charge ; 03/09/2021
  1. ;;2.0;INTEGRATED BILLING;**703**;21-MAR-94;Build 5
  1. ;;Per VA Directive 6402, this routine should not be modified.
  1. ;
  1. Q
  1. ;
  1. CANCEL(IBN,IBCRES,IBCLK,IBCAP) ; cancel a single charge
  1. ;
  1. ; IBN - ien of the charge to cancel (file 350)
  1. ; IBCRES - cancellation reason (from file 350.3)
  1. ; IBCLK - 1 = update billing clock, 0 = leave billing clock alone
  1. ; IBCAP - 1 = update caps, 0 = leave caps alone
  1. ;
  1. ; returns 1 if successful, "-1^[optional error code]^[optional error message]" otherwise
  1. ;
  1. N DFN,IBACT,IBAMC,IBATYP,IBCANTR,IBCHG,IBCOPAY,IBFAC,IBFR,IBIL,IBH,IBND,IBPRNT,IBSEQNO,IBSITE,IBSTAT,IBUC,IBUNIT,IBXA,IBY,SVZTQ
  1. N IBCLDA,IBCLST ; set by CLSTR^IBECEAU1
  1. N IBNOS,IBSERV,Y ; used in ^IBR
  1. ;
  1. S IBY=1
  1. ; perform up-front edits and set variables
  1. D CED I IBY<0 Q IBY
  1. ; check cancellation reason
  1. I +IBCRES'>0 S IBY="-1^^Missing cancellation reason" Q IBY
  1. I $P(^IBE(350.3,IBCRES,0),U,6) S IBY="-1^^Cancellation reason is inactive"
  1. S IBUC=$$GET1^DIQ(350.1,$P(IBND,U,3)_",",.01,"E")["URGENT CARE" ; 1 if urgent care charge
  1. I IBUC,'$P(^IBE(350.3,IBCRES,0),U,4) S IBY="-1^^Please use an Urgent Care cancellation reason." Q IBY
  1. I IBUC,IBSTAT'=8,IBIL="" Q IBY
  1. D SITE^IBAUTL ; set IBSITE and IBFAC vars
  1. S DFN=$P(IBND,U,2) ; patient's DFN
  1. I IBUC D UCVSTDB I IBY<0 Q IBY
  1. ; handle CHAMPVA/TRICARE charges
  1. I IBXA=6!(IBXA=7) D CANC(IBN,IBCRES,1) Q IBY
  1. ; handle cancellation transactions
  1. I IBCANTR D Q IBY
  1. .I IBN=IBPRNT D UPSTAT(IBN,1) Q
  1. .I 'IBIL S IBIL=$P($G(^IB(IBPRNT,0)),U,11) I 'IBIL S IBY="-1^^There is no bill number associated with this charge" Q
  1. .D UPCANC(IBN,IBRES,IBIL)
  1. .; pass the action to Accounts Receivable.
  1. .D ^IBR S IBY=Y
  1. .Q
  1. ; update 354.71 and 354.7 (cap info)
  1. I IBCAP D I IBY<0 Q
  1. .S IBCOPAY=$P(IBND,U,19) ; copay transaction #
  1. .; FOUND^IBARXMA needs ZTQUEUED to be defined in order to suppress the output
  1. .S SVZTQ=0 S:'$D(ZTQUEUED) (SVZTQ,ZTQUEUED)=1
  1. .I IBCOPAY S IBAMC=$$CANCEL^IBARXMN(DFN,IBCOPAY,.IBY) I IBY>0 D:IBAMC FOUND^IBARXMA(.IBY,IBAMC)
  1. .I SVZTQ K ZTQUEUED
  1. .Q
  1. ; handle incomplete and regular transactions
  1. D CANC(IBN,IBCRES,1) I IBY<1 Q IBY
  1. ; handle billing clock
  1. I IBCLK D
  1. .I "^1^2^3^"[(U_IBXA_U),IBCHG D
  1. ..D CLSTR^IBECEAU1(DFN,IBFR) I 'IBCLDA S IBY="-1^^No billing clock found for this charge" Q
  1. ..D CLOCK(-IBCHG,+$P(IBCLST,U,9),-IBUNIT)
  1. ..Q
  1. .Q
  1. ;
  1. Q IBY
  1. ;
  1. CED ; Edits required to cancel a charge.
  1. ;
  1. ; IBN - ien of the charge to cancel (file 350)
  1. ;
  1. S IBND=$G(^IB(IBN,0)) I 'IBND S IBY="-1^IB021" G CEDQ ; node 0 in file 350
  1. S IBPRNT=+$P(IBND,U,9) I '$D(^IB(IBPRNT,0)) S IBY="-1^IB027" G CEDQ ; ptr to parent charge in file 350
  1. ; make sure that we're cancelling the last transaction
  1. I $$LAST^IBECEAU(IBPRNT)'=IBN S IBY="-1^^You can only cancel the last transaction for an original charge" G CEDQ
  1. S IBACT=$G(^IBE(350.1,+$P(IBND,U,3),0)) ; node 0 in file 350.1 for the action type of this charge
  1. S IBSTAT=+$P(IBND,U,5) ; status (350/.05)
  1. S IBH='$P($G(^IBE(350.21,IBSTAT,0)),U,4) ; 1 if charge was not passed to AR
  1. S IBCANTR=$P(IBACT,U,5)=2 ; action type of this action is "cancel"
  1. S IBXA=$P(IBACT,U,11) ; billing group
  1. ;if charge has already been cancelled, and either passed to AR or belongs to billing groups 6,7
  1. I IBCANTR!(IBSTAT=10),'IBH!(IBXA=6!(IBXA=7)) S IBY="-1^^This transaction has already been cancelled." G CEDQ
  1. S IBATYP=$P(IBACT,U,6) ; ptr to cancellation action
  1. I '$D(^IBE(350.1,+IBATYP,0)) S IBY="-1^IB022" G CEDQ
  1. ; make sure that cancellation action has action type defined
  1. S IBSEQNO=$P(^IBE(350.1,+IBATYP,0),U,5) I 'IBSEQNO S IBY="-1^IB023" G CEDQ
  1. S IBIL=$P(IBND,U,11) ; AR bill #
  1. S IBUNIT=+$P(IBND,U,6) ; units
  1. S IBCHG=+$P(IBND,U,7) ; total charge
  1. S IBFR=$P(IBND,U,14) ; billed from
  1. I IBUNIT<1 S IBY="-1^IB025" G CEDQ
  1. I 'IBH,'IBCHG S IBY="-1^^There is no charge amount associated with this action." G CEDQ
  1. I 'IBH,IBIL="" S IBY="-1^IB024"
  1. CEDQ ; exit point
  1. Q
  1. ;
  1. UPDVST(IBCAN) ; update the Visit Tracking file
  1. ;
  1. ; 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,IBVSTIEN,IBREAS,IBRTN,IBERROR,IENS,UCSTAT
  1. ;
  1. S IENS=IBN_","
  1. ;Locate the IEN in the file using the Bill Number
  1. S IBBLNO=$S(IBSTAT=8:"ON HOLD",1:IBIL) S:$E(IBBLNO,1)="K" IBBLNO=IBSITE_"-"_IBBLNO
  1. S IBVSTIEN=$$FNDVST^IBECEA4(IBBLNO,IBFR,DFN)
  1. I +IBVSTIEN=0 Q
  1. ;Set Status and Reason based on update type.
  1. S:IBCAN=1 IBREAS=3,UCSTAT=3 ;Visits Removed
  1. S:IBCAN=2 IBREAS=5,UCSTAT=4 ;Visit set to Visit Only
  1. S:IBCAN=3 IBREAS=1,UCSTAT=1 ;Free visit
  1. S:IBCAN=4 IBREAS=4,UCSTAT=3 ;Duplicate Visit
  1. ;
  1. S IBRTN=$$UPDATE^IBECEA38(IBVSTIEN,UCSTAT,"",IBREAS,1,.IBERROR)
  1. I IBRTN=0 S IBY="-1^^Unable to update UC visit tracking file"
  1. Q
  1. ;
  1. UCVSTDB ; Update the UC Visit Tracking
  1. ;
  1. N IBELIG,IBNOFRVS,IBUCBH
  1. ;
  1. S IBUCBH=$P(^IBE(350.3,IBCRES,0),U,5) ; UC visit processing (350.3/.05)
  1. ;cancellation reasons deemed to be data entry errors
  1. I IBUCBH=1 D UPDVST(1) Q
  1. ;For those cancellation reasons deemed to be duplicate visits
  1. I IBUCBH=4 D UPDVST(4) Q
  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(DFN,IBFR)
  1. I IBELIG'<6 D UPDVST(2) Q ; priority group 6,7, or 8
  1. ;Retrieve # visits
  1. S IBNOFRVS=$P($$GETVST^IBECEA36(DFN,IBFR),U,2)
  1. ;If free visit remain, convert visit to Free Visit
  1. I IBNOFRVS<3 D UPDVST(3) Q
  1. ;Otherwise, visit only.
  1. D UPDVST(2)
  1. Q
  1. ;
  1. CANC(IBCN,IBCRES,IBINC) ; Cancel a charge, after passing all edits
  1. ;
  1. ; IBCN -- Internal entry # of IB Action to cancel
  1. ; IBCRES -- Cancellation reason
  1. ; IBINC -- Try to cancel an incomplete charge? [optional]
  1. ;
  1. N FDA,IBDUZ,IENS,Z
  1. ; handle incomplete transactions
  1. I $G(IBINC),IBH D UPSTAT(IBCN,IBCRES) Q
  1. ; handle regular transactions
  1. L +^IB(0):10 I '$T S IBY="-1^B014" Q
  1. ; create new entry in file 350
  1. S Z=$$ADD350(DFN,IBSITE,IBATYP) I +Z<0 S IBY=Z L -^IB(0) Q
  1. S IENS=Z_",",IBNOS=Z
  1. ;
  1. S IBDUZ=$S($G(DUZ)>0:DUZ,1:.5)
  1. ; populate the new file 350 entry
  1. S FDA(350,IENS,.04)=$P(IBND,U,4)
  1. S FDA(350,IENS,.06)=IBUNIT
  1. S FDA(350,IENS,.07)=IBCHG
  1. S FDA(350,IENS,.08)=$P(IBND,U,8)
  1. S FDA(350,IENS,.09)=IBPRNT
  1. S FDA(350,IENS,.1)=IBCRES
  1. S FDA(350,IENS,.11)=IBIL
  1. S FDA(350,IENS,.13)=$P(IBND,U,13)
  1. S FDA(350,IENS,.14)=IBFR
  1. S FDA(350,IENS,.15)=$P(IBND,U,15)
  1. S FDA(350,IENS,.16)=$P(IBND,U,16)
  1. I IBXA=5 S FDA(350,IENS,.17)=$P(IBND,U,17)
  1. S FDA(350,IENS,.2)=$P(IBND,U,20)
  1. S FDA(350,IENS,.21)=$P(IBND,U,21)
  1. S FDA(350,IENS,.22)=$P(IBND,U,22)
  1. S FDA(350,IENS,11)=IBDUZ
  1. D FILE^DIE("","FDA")
  1. L -^IB(0)
  1. ; pass the action to Accounts Receivable.
  1. D ^IBR S IBY=Y I IBY<0 Q
  1. ; cancel original charge (if it was an updated transaction)
  1. I $D(^IB(IBCN,0)),IBSTAT'=10 D UPSTAT(IBCN,IBCRES)
  1. Q
  1. ;
  1. UPSTAT(IBCN,IBCRES) ; Update the status, cancellation reason of incomplete charges.
  1. ;
  1. ; IBCN -- Internal entry # of IB Action to cancel
  1. ; IBCRES -- Cancellation reason
  1. ;
  1. N DIE,DA,DR,X,Y
  1. S DIE="^IB(",DA=IBCN,DR=".05////10;.1////"_IBCRES
  1. D ^DIE
  1. Q
  1. ;
  1. UPCANC(IBCN,IBRES,IBIL) ; Update cancellation transaction
  1. ;
  1. ; IBCN -- Internal entry # of IB Action to cancel
  1. ; IBCRES -- Cancellation reason
  1. ; IBIL -- AR bill #
  1. ;
  1. N DIE,DA,DR,X,Y
  1. S DIE="^IB(",DA=IBCN,DR=".1////"_IBCRES_";.11////"_IBIL D ^DIE
  1. Q
  1. ;
  1. CLOCK(IBDOL,IBDAYPR,IBDAY) ; Update clock data.
  1. ;
  1. ; IBDOL -- Dollar amount to add or subtract
  1. ; IBDAYPR -- Existing number of inpatient days
  1. ; IBDAY -- Inpatient days to add or subtract
  1. ; Also assumes that IBCLST, IBCLDA, and IBXA are defined.
  1. ;
  1. I IBXA=1!(IBXA=2) D CLAMT(IBCLST,IBDOL,IBCLDA)
  1. I IBXA=3 D CLINP(IBDAYPR,IBDAY,IBCLDA)
  1. Q
  1. ;
  1. CLAMT(STR,AMT,IBCLDA) ; Update Billing Clock Medicare Deductible co-payments
  1. ;
  1. ; STR -- Zeroth node of clock in file #351
  1. ; AMT -- Dollar Amt to add to clock (could be negative)
  1. ; IBCLDA -- Pointer to clock in file #351
  1. ;
  1. N DA,DAYS,DIE,DR,IBCLDT,NEWAMT,PTR
  1. I $G(STR)=""!'$G(AMT)!'$G(IBCLDA) Q
  1. S DAYS=+$P(STR,U,9),PTR=$S(DAYS<91:5,DAYS<181:6,DAYS<271:7,1:8)
  1. S IBCLDT=+$P(STR,U,3),NEWAMT=+$P(STR,U,PTR)+AMT
  1. I NEWAMT<0 S IBY="-1^^Unable to update the clock to reflect negative copayment" Q
  1. S DIE="^IBE(351,",DA=IBCLDA,DR=".0"_PTR_"////"_NEWAMT_";13////"_DUZ_";14///NOW" D ^DIE
  1. Q
  1. ;
  1. CLINP(BEG,DIF,IBCLDA) ; Update Billing Clock Inpatient Days
  1. ;
  1. ; BEG -- Existing number of inpatient days
  1. ; DIF -- Days to add to clock (could be negative)
  1. ; IBCLDA -- Pointer to clock in file #351
  1. ;
  1. N DAYS
  1. I $G(BEG)=""!'$G(DIF)!'$G(IBCLDA) Q
  1. S DAYS=BEG+DIF
  1. I DAYS<0!(DAYS>365) S IBY="-1^^Unable to update the clock - invalid number of inpatient days" Q
  1. S DIE="^IBE(351,",DA=IBCLDA,DR=".09////"_DAYS_";13////"_DUZ_";14///NOW" D ^DIE
  1. Q
  1. ;
  1. ADD350(DFN,IBSITE,IBATYP) ; add new entry to file 350 (wrapper for ADD^IBAUTL)
  1. ;
  1. ; DFN - patient DFN
  1. ; IBSITE - station number
  1. ; IBATYP - action type
  1. ;
  1. ; returns IEN of the new entry on success or "-1^[error code]" on failure
  1. ;
  1. N DA,DD,DIC,DIE,DINUM,DLAYGO,DO,DR,IBN,IBN1,X,Y
  1. D ADD^IBAUTL
  1. ; IBN and Y are set in ADD^IBAUTL
  1. Q $S(+Y<0:Y,1:IBN)