- IBECEA4 ;ALB/CPM - Cancel/Edit/Add... Cancel a Charge ; 11-MAR-93
- ;;Version 2.0 ; INTEGRATED BILLING ;; 21-MAR-94
- ;;Per VHA Directive 10-93-142, this routine should not be modified.
- ;
- ONE ; Cancel a single charge.
- D HDR^IBECEAU("C A N C E L")
- ;
- ; - perform up-front edits
- D CED^IBECEAU4(IBN) G:IBY<0 ONEQ
- 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
- D REAS^IBECEAU2("C") G:IBCRES<0 ONEQ
- ;
- ; - okay to proceed?
- D PROC^IBECEAU4("cancel") G:IBY<0 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
- ;
- ; - handle incomplete and regular transactions
- D CANC^IBECEAU4(IBN,IBCRES,1) G:IBY<1 ONEQ
- ;
- ; - 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)
- ;
- ONEQ D ERR^IBECEAU4:IBY<0,PAUSE^IBECEAU
- K IBCHG,IBCRES,IBDESC,IBIL,IBND,IBSEQNO,IBTOTL,IBUNIT,IBATYP,IBIDX
- K IBN,IBREB,IBY,IBEVDA,IBPARNT,IBH,IBCANTR,IBXA,IBSL,IBFR,IBTO,IBNOS,IBCANC
- 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
- IBECEA4 ;ALB/CPM - Cancel/Edit/Add... Cancel a Charge ; 11-MAR-93
- +1 ;;Version 2.0 ; INTEGRATED BILLING ;; 21-MAR-94
- +2 ;;Per VHA Directive 10-93-142, this routine should not be modified.
- +3 ;
- ONE ; Cancel a single charge.
- +1 DO HDR^IBECEAU("C A N C E L")
- +2 ;
- +3 ; - perform up-front edits
- +4 DO CED^IBECEAU4(IBN)
- IF IBY<0
- GOTO ONEQ
- +5 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
- +6 IF 'IBH
- IF IBIL=""
- SET IBY="-1^IB024"
- GOTO ONEQ
- +7 ;
- REAS ; - ask for the cancellation reason
- +1 DO REAS^IBECEAU2("C")
- IF IBCRES<0
- GOTO ONEQ
- +2 ;
- +3 ; - okay to proceed?
- +4 DO PROC^IBECEAU4("cancel")
- IF IBY<0
- GOTO ONEQ
- +5 ;
- +6 ; - handle cancellation transactions
- +7 IF IBCANTR
- Begin DoDot:1
- +8 IF IBN=IBPARNT
- DO UPSTAT^IBECEAU4(IBN,1)
- QUIT
- +9 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
- +10 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
- +11 ;
- +12 ; - handle incomplete and regular transactions
- +13 DO CANC^IBECEAU4(IBN,IBCRES,1)
- IF IBY<1
- GOTO ONEQ
- +14 ;
- +15 ; - handle updating of clock
- +16 IF "^1^2^3^"'[("^"_IBXA_"^")
- GOTO ONEQ
- +17 IF 'IBCHG
- GOTO ONEQ
- +18 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."
- GOTO ONEQ
- +19 DO CLOCK^IBECEAU(-IBCHG,+$PIECE(IBCLST,"^",9),-IBUNIT)
- +20 ;
- ONEQ IF IBY<0
- DO ERR^IBECEAU4
- DO PAUSE^IBECEAU
- +1 KILL IBCHG,IBCRES,IBDESC,IBIL,IBND,IBSEQNO,IBTOTL,IBUNIT,IBATYP,IBIDX
- +2 KILL IBN,IBREB,IBY,IBEVDA,IBPARNT,IBH,IBCANTR,IBXA,IBSL,IBFR,IBTO,IBNOS,IBCANC
- +3 QUIT
- +4 ;
- 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
