IBECEA4.m

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