| [613] | 1 | IBECEAU4 ;ALB/CPM - Cancel/Edit/Add... Cancel Utilities ; 23-APR-93
|
|---|
| 2 | ;;2.0;INTEGRATED BILLING;**52,167,183,341**;21-MAR-94
|
|---|
| 3 | ;;Per VHA Directive 10-93-142, this routine should not be modified.
|
|---|
| 4 | ;
|
|---|
| 5 | CANCH(IBN,IBCRES,IBIND,IBCV) ; Cancel last transaction for a specific charge.
|
|---|
| 6 | ; Input: IBN -- Charge to be cancelled
|
|---|
| 7 | ; IBCRES -- Cancellation reason
|
|---|
| 8 | ; IBIND -- 1=>set MT bulletin flags; 0=>don't set flags
|
|---|
| 9 | ; IBCV -- 1=>use the CHAMPVA error bulletin
|
|---|
| 10 | N IBY,IBHOLDN,IBND,IBPARNT,IBCANC,IBH,IBCANTR,IBXA,IBATYP,IBSEQNO,IBIL,IBUNIT,IBCHG
|
|---|
| 11 | S (IBN,IBHOLDN)=$$LAST^IBECEAU($P(^IB(IBN,0),"^",9)),IBY=1
|
|---|
| 12 | D CED(IBN) I IBCANTR!(IBY<0) G CANCHQ
|
|---|
| 13 | D CANC(IBN,IBCRES,1) I IBY<0 G CANCHQ
|
|---|
| 14 | I $G(IBIND) S IBARR(DT,IBHOLDN)="",(IBCANCEL,IBFND)=1
|
|---|
| 15 | CANCHQ I IBY<1 D @$S($G(IBCV):"ERRMSG^IBACVA2(0,1)",1:"^IBAERR1")
|
|---|
| 16 | Q
|
|---|
| 17 | ;
|
|---|
| 18 | CANC(IBCN,IBCRES,IBINC) ; Cancel a charge, after passing all edits
|
|---|
| 19 | ; Input: IBCN -- Internal entry # of IB Action to cancel
|
|---|
| 20 | ; IBCRES -- Cancellation reason
|
|---|
| 21 | ; IBINC -- Try to cancel an incomplete charge? [optional]
|
|---|
| 22 | N DA,DIK,IBCAN,IBSTOPDA,IBGMTR
|
|---|
| 23 | S IBCAN=$G(^IB(IBCN,0))
|
|---|
| 24 | ;
|
|---|
| 25 | ; - handle incomplete transactions
|
|---|
| 26 | I $G(IBINC) S:'$D(IBH) IBH='$P($G(^IBE(350.21,+$P(IBND,"^",5),0)),"^",4) I IBH D UPSTAT(IBCN,1) G CANCQ
|
|---|
| 27 | ;
|
|---|
| 28 | ; - handle regular transactions
|
|---|
| 29 | S IBATYP=$P($G(^IBE(350.1,+$P(IBCAN,"^",3),0)),"^",6) I IBATYP="" S IBY="-1^IB022" G CANCQ
|
|---|
| 30 | S IBSEQNO=$P($G(^IBE(350.1,IBATYP,0)),"^",5) I 'IBSEQNO S IBY="-1^IB023" G CANCQ
|
|---|
| 31 | W:$G(IBJOB)=4 !!,"Building the cancellation transaction... "
|
|---|
| 32 | D ADD^IBAUTL I Y<1 S IBY=Y G CANCQ
|
|---|
| 33 | S $P(IBCAN,"^",3)=IBATYP,$P(IBCAN,"^",5)=1,$P(IBCAN,"^",10)=IBCRES,$P(IBCAN,"^",12)=""
|
|---|
| 34 | ; if there is a clinic stop, move it over
|
|---|
| 35 | S IBSTOPDA=$P(IBCAN,"^",20)
|
|---|
| 36 | S IBGMTR=$P(IBCAN,"^",21) ; 'GMT RELATED' flag
|
|---|
| 37 | S:IBXA'=5 IBCAN=$P(IBCAN,"^",1,16)
|
|---|
| 38 | S IBCAN=$P(IBCAN,"^",1,17)
|
|---|
| 39 | I IBSTOPDA S $P(IBCAN,"^",20)=IBSTOPDA
|
|---|
| 40 | S $P(^IB(IBN,0),"^",2,20)=$P(IBCAN,"^",2,20)
|
|---|
| 41 | I IBGMTR S $P(^IB(IBN,0),"^",21)=IBGMTR ; Set the 'GMT RELATED' flag
|
|---|
| 42 | ; DUZ may be null if this code is called by a process started by an HL7 multi-threaded listener
|
|---|
| 43 | ; if this condition occurs the approved fix is to use the Postmaster IEN. 2/27/06, IB*2.0*341
|
|---|
| 44 | S $P(^IB(IBN,1),"^")=$S(DUZ:DUZ,1:.5) ;
|
|---|
| 45 | S DA=IBN,DIK="^IB(" D IX1^DIK
|
|---|
| 46 | W:$G(IBJOB)=4 " .. " D PASS
|
|---|
| 47 | ;
|
|---|
| 48 | ; - cancel original charge (if it was an updated transaction)
|
|---|
| 49 | I $D(^IB(IBCN,0)),$P(^(0),"^",5)'=10 D UPSTAT(IBCN)
|
|---|
| 50 | CANCQ Q
|
|---|
| 51 | ;
|
|---|
| 52 | CED(IBN) ; Edits required to cancel a charge.
|
|---|
| 53 | ; Input: IBN -- Internal entry # of charge to be cancelled
|
|---|
| 54 | S IBND=$G(^IB(IBN,0)) I 'IBND S IBY="-1^IB021" G CEDQ
|
|---|
| 55 | S IBPARNT=+$P(IBND,"^",9) I '$D(^IB(IBPARNT,0)) S IBY="-1^IB027" G CEDQ
|
|---|
| 56 | I $$LAST^IBECEAU(IBPARNT)'=IBN S IBY="-1^^You can only cancel the last transaction for an original charge." G CEDQ
|
|---|
| 57 | S IBCANC=$G(^IBE(350.1,+$P(IBND,"^",3),0))
|
|---|
| 58 | S IBH='$P($G(^IBE(350.21,+$P(IBND,"^",5),0)),"^",4),IBCANTR=$P(IBCANC,"^",5)=2
|
|---|
| 59 | S IBXA=$P(IBCANC,"^",11),IBATYP=$P(IBCANC,"^",6)
|
|---|
| 60 | I '$D(^IBE(350.1,+IBATYP,0)) S IBY="-1^IB022" G CEDQ
|
|---|
| 61 | S IBSEQNO=$P(^IBE(350.1,+IBATYP,0),"^",5) I 'IBSEQNO S IBY="-1^IB023" G CEDQ
|
|---|
| 62 | S IBIL=$P(IBND,"^",11),IBUNIT=+$P(IBND,"^",6),IBCHG=+$P(IBND,"^",7),IBFR=$P(IBND,"^",14)
|
|---|
| 63 | I IBUNIT<1 S IBY="-1^IB025" G CEDQ
|
|---|
| 64 | I 'IBH,'IBCHG S IBY="-1^^There is no charge amount associated with this action." G CEDQ
|
|---|
| 65 | I $G(IBJOB)'=4,'IBH,IBIL="" S IBY="-1^IB024"
|
|---|
| 66 | CEDQ Q
|
|---|
| 67 | ;
|
|---|
| 68 | UPSTAT(IBCN,IB) ; Update the status, cancellation reason of incomplete charges.
|
|---|
| 69 | N DIE,DA,DR
|
|---|
| 70 | W:$G(IBJOB)=4&$G(IB) !,"Updating the status of the charge to 'cancelled'... "
|
|---|
| 71 | S DIE="^IB(",DA=IBCN,DR=".05////10;.1////"_IBCRES
|
|---|
| 72 | D ^DIE W:$G(IBJOB)=4&$G(IB) "done."
|
|---|
| 73 | Q
|
|---|
| 74 | ;
|
|---|
| 75 | PASS ; Pass the action to Accounts Receivable.
|
|---|
| 76 | N IBSERV
|
|---|
| 77 | S IBNOS=IBN D ^IBR S IBY=Y I Y>0,$G(IBJOB)=4 W "done."
|
|---|
| 78 | Q
|
|---|
| 79 | ;
|
|---|
| 80 | ERR ; Error Processing.
|
|---|
| 81 | Q:IBY>0
|
|---|
| 82 | I $P(IBY,"^",2)]"" W !,$P($G(^IBE(350.8,+$O(^IBE(350.8,"AC",$P($P(IBY,"^",2),";"),0)),0)),"^",2) Q
|
|---|
| 83 | I $P(IBY,"^",3)]"" W !,$P(IBY,"^",3)
|
|---|
| 84 | Q
|
|---|
| 85 | ;
|
|---|
| 86 | PROC(EVT) ; Okay to proceed with Add, Edit, or Cancel?
|
|---|
| 87 | N DIR,DIRUT,DUOUT,DTOUT,X,Y
|
|---|
| 88 | W ! S DIR(0)="Y",DIR("A")="Okay to "_EVT_" this charge",DIR("?")="Enter 'Y' or 'YES' to "_EVT_" this charge, or 'N', 'NO', or '^' to quit."
|
|---|
| 89 | D ^DIR K DIR I 'Y!($D(DIRUT))!($D(DUOUT)) W !,"This charge will not be ",$S(EVT="cancel":"cancelled",1:EVT_"ed"),"." S IBY=-1 G PROCQ
|
|---|
| 90 | S IBCOMMIT=1
|
|---|
| 91 | PROCQ Q
|
|---|
