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