- 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 Jan 18, 2025@03:22:48 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)