IBECEAU4 ;ALB/CPM - Cancel/Edit/Add... Cancel Utilities ; 23-APR-93
;;2.0;INTEGRATED BILLING;**52,167,183,341,563,678**;21-MAR-94;Build 7
;;Per VA Directive 6402, this routine should not be modified.
;
CANCH(IBN,IBCRES,IBIND,IBCV) ; Cancel last transaction for a specific charge.
; Input: IBN -- Charge to be cancelled
; IBCRES -- Cancellation reason
; IBIND -- 1=>set MT bulletin flags; 0=>don't set flags
; IBCV -- 1=>use the CHAMPVA error bulletin
N IBY,IBHOLDN,IBND,IBPARNT,IBCANC,IBH,IBCANTR,IBXA,IBATYP,IBSEQNO,IBIL,IBUNIT,IBCHG
S (IBN,IBHOLDN)=$$LAST^IBECEAU($P(^IB(IBN,0),"^",9)),IBY=1
D CED(IBN) I IBCANTR!(IBY<0) G CANCHQ
D CANC(IBN,IBCRES,1) I IBY<0 G CANCHQ
I $G(IBIND) S IBARR(DT,IBHOLDN)="",(IBCANCEL,IBFND)=1
CANCHQ I IBY<1 D @$S($G(IBCV):"ERRMSG^IBACVA2(0,1)",1:"^IBAERR1")
Q
;
CANC(IBCN,IBCRES,IBINC) ; Cancel a charge, after passing all edits
; Input: IBCN -- Internal entry # of IB Action to cancel
; IBCRES -- Cancellation reason
; IBINC -- Try to cancel an incomplete charge? [optional]
N DA,DIK,IBCAN,IBSTOPDA,IBGMTR,IBTIER
S IBCAN=$G(^IB(IBCN,0))
;
; - handle incomplete transactions
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
;
; - handle regular transactions
S IBATYP=$P($G(^IBE(350.1,+$P(IBCAN,"^",3),0)),"^",6) I IBATYP="" S IBY="-1^IB022" G CANCQ
S IBSEQNO=$P($G(^IBE(350.1,IBATYP,0)),"^",5) I 'IBSEQNO S IBY="-1^IB023" G CANCQ
W:$G(IBJOB)=4 !!,"Building the cancellation transaction... "
D ADD^IBAUTL I Y<1 S IBY=Y G CANCQ
S $P(IBCAN,"^",3)=IBATYP,$P(IBCAN,"^",5)=1,$P(IBCAN,"^",10)=IBCRES,$P(IBCAN,"^",12)=""
; if there is a clinic stop, move it over
S IBSTOPDA=$P(IBCAN,"^",20)
S IBGMTR=$P(IBCAN,"^",21),IBTIER=$P(IBCAN,"^",22) ; 'GMT RELATED' flag and Tier value
S:IBXA'=5 IBCAN=$P(IBCAN,"^",1,16)
S IBCAN=$P(IBCAN,"^",1,17)
I IBSTOPDA S $P(IBCAN,"^",20)=IBSTOPDA
S $P(^IB(IBN,0),"^",2,20)=$P(IBCAN,"^",2,20)
I IBGMTR!(IBTIER) S $P(^IB(IBN,0),"^",21,22)=IBGMTR_"^"_IBTIER ; Set the 'GMT RELATED' flag and Tier value
; DUZ may be null if this code is called by a process started by an HL7 multi-threaded listener
; if this condition occurs the approved fix is to use the Postmaster IEN. 2/27/06, IB*2.0*341
S $P(^IB(IBN,1),"^")=$S(DUZ:DUZ,1:.5) ;
S DA=IBN,DIK="^IB(" D IX1^DIK
W:$G(IBJOB)=4 " .. " D PASS
;
; - cancel original charge (if it was an updated transaction)
I $D(^IB(IBCN,0)),$P(^(0),"^",5)'=10 D UPSTAT(IBCN)
CANCQ Q
;
CED(IBN) ; Edits required to cancel a charge.
; Input: IBN -- Internal entry # of charge to be cancelled
S IBND=$G(^IB(IBN,0)) I 'IBND S IBY="-1^IB021" G CEDQ
S IBPARNT=+$P(IBND,"^",9) I '$D(^IB(IBPARNT,0)) S IBY="-1^IB027" G CEDQ
I $$LAST^IBECEAU(IBPARNT)'=IBN S IBY="-1^^You can only cancel the last transaction for an original charge." G CEDQ
S IBCANC=$G(^IBE(350.1,+$P(IBND,"^",3),0))
S IBH='$P($G(^IBE(350.21,+$P(IBND,"^",5),0)),"^",4),IBCANTR=$P(IBCANC,"^",5)=2
S IBXA=$P(IBCANC,"^",11),IBATYP=$P(IBCANC,"^",6)
I '$D(^IBE(350.1,+IBATYP,0)) S IBY="-1^IB022" G CEDQ
S IBSEQNO=$P(^IBE(350.1,+IBATYP,0),"^",5) I 'IBSEQNO S IBY="-1^IB023" G CEDQ
S IBIL=$P(IBND,"^",11),IBUNIT=+$P(IBND,"^",6),IBCHG=+$P(IBND,"^",7),IBFR=$P(IBND,"^",14)
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 $G(IBJOB)'=4,'IBH,IBIL="" S IBY="-1^IB024"
CEDQ Q
;
UPSTAT(IBCN,IB) ; Update the status, cancellation reason of incomplete charges.
N DIE,DA,DR
W:$G(IBJOB)=4&$G(IB) !,"Updating the status of the charge to 'cancelled'... "
S DIE="^IB(",DA=IBCN,DR=".05////10;.1////"_IBCRES
D ^DIE W:$G(IBJOB)=4&$G(IB) "done."
Q
;
PASS ; Pass the action to Accounts Receivable.
N IBSERV
S IBNOS=IBN D ^IBR S IBY=Y I Y>0,$G(IBJOB)=4 W "done."
Q
;
ERR ; Error Processing.
Q:IBY>0
I $P(IBY,"^",2)]"" W !,$P($G(^IBE(350.8,+$O(^IBE(350.8,"AC",$P($P(IBY,"^",2),";"),0)),0)),"^",2) Q
I $P(IBY,"^",3)]"" W !,$P(IBY,"^",3)
Q
;
PROC(EVT) ; Okay to proceed with Add, Edit, or Cancel?
N DIR,DIRUT,DUOUT,DTOUT,X,Y
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."
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
S IBCOMMIT=1
PROCQ Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HIBECEAU4 4507 printed Dec 13, 2024@02:21:34 Page 2
IBECEAU4 ;ALB/CPM - Cancel/Edit/Add... Cancel Utilities ; 23-APR-93
+1 ;;2.0;INTEGRATED BILLING;**52,167,183,341,563,678**;21-MAR-94;Build 7
+2 ;;Per VA Directive 6402, this routine should not be modified.
+3 ;
CANCH(IBN,IBCRES,IBIND,IBCV) ; Cancel last transaction for a specific charge.
+1 ; Input: IBN -- Charge to be cancelled
+2 ; IBCRES -- Cancellation reason
+3 ; IBIND -- 1=>set MT bulletin flags; 0=>don't set flags
+4 ; IBCV -- 1=>use the CHAMPVA error bulletin
+5 NEW IBY,IBHOLDN,IBND,IBPARNT,IBCANC,IBH,IBCANTR,IBXA,IBATYP,IBSEQNO,IBIL,IBUNIT,IBCHG
+6 SET (IBN,IBHOLDN)=$$LAST^IBECEAU($PIECE(^IB(IBN,0),"^",9))
SET IBY=1
+7 DO CED(IBN)
IF IBCANTR!(IBY<0)
GOTO CANCHQ
+8 DO CANC(IBN,IBCRES,1)
IF IBY<0
GOTO CANCHQ
+9 IF $GET(IBIND)
SET IBARR(DT,IBHOLDN)=""
SET (IBCANCEL,IBFND)=1
CANCHQ IF IBY<1
DO @$SELECT($GET(IBCV):"ERRMSG^IBACVA2(0,1)",1:"^IBAERR1")
+1 QUIT
+2 ;
CANC(IBCN,IBCRES,IBINC) ; Cancel a charge, after passing all edits
+1 ; Input: IBCN -- Internal entry # of IB Action to cancel
+2 ; IBCRES -- Cancellation reason
+3 ; IBINC -- Try to cancel an incomplete charge? [optional]
+4 NEW DA,DIK,IBCAN,IBSTOPDA,IBGMTR,IBTIER
+5 SET IBCAN=$GET(^IB(IBCN,0))
+6 ;
+7 ; - handle incomplete transactions
+8 IF $GET(IBINC)
if '$DATA(IBH)
SET IBH='$PIECE($GET(^IBE(350.21,+$PIECE(IBND,"^",5),0)),"^",4)
IF IBH
DO UPSTAT(IBCN,1)
GOTO CANCQ
+9 ;
+10 ; - handle regular transactions
+11 SET IBATYP=$PIECE($GET(^IBE(350.1,+$PIECE(IBCAN,"^",3),0)),"^",6)
IF IBATYP=""
SET IBY="-1^IB022"
GOTO CANCQ
+12 SET IBSEQNO=$PIECE($GET(^IBE(350.1,IBATYP,0)),"^",5)
IF 'IBSEQNO
SET IBY="-1^IB023"
GOTO CANCQ
+13 if $GET(IBJOB)=4
WRITE !!,"Building the cancellation transaction... "
+14 DO ADD^IBAUTL
IF Y<1
SET IBY=Y
GOTO CANCQ
+15 SET $PIECE(IBCAN,"^",3)=IBATYP
SET $PIECE(IBCAN,"^",5)=1
SET $PIECE(IBCAN,"^",10)=IBCRES
SET $PIECE(IBCAN,"^",12)=""
+16 ; if there is a clinic stop, move it over
+17 SET IBSTOPDA=$PIECE(IBCAN,"^",20)
+18 ; 'GMT RELATED' flag and Tier value
SET IBGMTR=$PIECE(IBCAN,"^",21)
SET IBTIER=$PIECE(IBCAN,"^",22)
+19 if IBXA'=5
SET IBCAN=$PIECE(IBCAN,"^",1,16)
+20 SET IBCAN=$PIECE(IBCAN,"^",1,17)
+21 IF IBSTOPDA
SET $PIECE(IBCAN,"^",20)=IBSTOPDA
+22 SET $PIECE(^IB(IBN,0),"^",2,20)=$PIECE(IBCAN,"^",2,20)
+23 ; Set the 'GMT RELATED' flag and Tier value
IF IBGMTR!(IBTIER)
SET $PIECE(^IB(IBN,0),"^",21,22)=IBGMTR_"^"_IBTIER
+24 ; DUZ may be null if this code is called by a process started by an HL7 multi-threaded listener
+25 ; if this condition occurs the approved fix is to use the Postmaster IEN. 2/27/06, IB*2.0*341
+26 ;
SET $PIECE(^IB(IBN,1),"^")=$SELECT(DUZ:DUZ,1:.5)
+27 SET DA=IBN
SET DIK="^IB("
DO IX1^DIK
+28 if $GET(IBJOB)=4
WRITE " .. "
DO PASS
+29 ;
+30 ; - cancel original charge (if it was an updated transaction)
+31 IF $DATA(^IB(IBCN,0))
IF $PIECE(^(0),"^",5)'=10
DO UPSTAT(IBCN)
CANCQ QUIT
+1 ;
CED(IBN) ; Edits required to cancel a charge.
+1 ; Input: IBN -- Internal entry # of charge to be cancelled
+2 SET IBND=$GET(^IB(IBN,0))
IF 'IBND
SET IBY="-1^IB021"
GOTO CEDQ
+3 SET IBPARNT=+$PIECE(IBND,"^",9)
IF '$DATA(^IB(IBPARNT,0))
SET IBY="-1^IB027"
GOTO CEDQ
+4 IF $$LAST^IBECEAU(IBPARNT)'=IBN
SET IBY="-1^^You can only cancel the last transaction for an original charge."
GOTO CEDQ
+5 SET IBCANC=$GET(^IBE(350.1,+$PIECE(IBND,"^",3),0))
+6 SET IBH='$PIECE($GET(^IBE(350.21,+$PIECE(IBND,"^",5),0)),"^",4)
SET IBCANTR=$PIECE(IBCANC,"^",5)=2
+7 SET IBXA=$PIECE(IBCANC,"^",11)
SET IBATYP=$PIECE(IBCANC,"^",6)
+8 IF '$DATA(^IBE(350.1,+IBATYP,0))
SET IBY="-1^IB022"
GOTO CEDQ
+9 SET IBSEQNO=$PIECE(^IBE(350.1,+IBATYP,0),"^",5)
IF 'IBSEQNO
SET IBY="-1^IB023"
GOTO CEDQ
+10 SET IBIL=$PIECE(IBND,"^",11)
SET IBUNIT=+$PIECE(IBND,"^",6)
SET IBCHG=+$PIECE(IBND,"^",7)
SET IBFR=$PIECE(IBND,"^",14)
+11 IF IBUNIT<1
SET IBY="-1^IB025"
GOTO CEDQ
+12 IF 'IBH
IF 'IBCHG
SET IBY="-1^^There is no charge amount associated with this action."
GOTO CEDQ
+13 IF $GET(IBJOB)'=4
IF 'IBH
IF IBIL=""
SET IBY="-1^IB024"
CEDQ QUIT
+1 ;
UPSTAT(IBCN,IB) ; Update the status, cancellation reason of incomplete charges.
+1 NEW DIE,DA,DR
+2 if $GET(IBJOB)=4&$GET(IB)
WRITE !,"Updating the status of the charge to 'cancelled'... "
+3 SET DIE="^IB("
SET DA=IBCN
SET DR=".05////10;.1////"_IBCRES
+4 DO ^DIE
if $GET(IBJOB)=4&$GET(IB)
WRITE "done."
+5 QUIT
+6 ;
PASS ; Pass the action to Accounts Receivable.
+1 NEW IBSERV
+2 SET IBNOS=IBN
DO ^IBR
SET IBY=Y
IF Y>0
IF $GET(IBJOB)=4
WRITE "done."
+3 QUIT
+4 ;
ERR ; Error Processing.
+1 if IBY>0
QUIT
+2 IF $PIECE(IBY,"^",2)]""
WRITE !,$PIECE($GET(^IBE(350.8,+$ORDER(^IBE(350.8,"AC",$PIECE($PIECE(IBY,"^",2),";"),0)),0)),"^",2)
QUIT
+3 IF $PIECE(IBY,"^",3)]""
WRITE !,$PIECE(IBY,"^",3)
+4 QUIT
+5 ;
PROC(EVT) ; Okay to proceed with Add, Edit, or Cancel?
+1 NEW DIR,DIRUT,DUOUT,DTOUT,X,Y
+2 WRITE !
SET DIR(0)="Y"
SET DIR("A")="Okay to "_EVT_" this charge"
SET DIR("?")="Enter 'Y' or 'YES' to "_EVT_" this charge, or 'N', 'NO', or '^' to quit."
+3 DO ^DIR
KILL DIR
IF 'Y!($DATA(DIRUT))!($DATA(DUOUT))
WRITE !,"This charge will not be ",$SELECT(EVT="cancel":"cancelled",1:EVT_"ed"),"."
SET IBY=-1
GOTO PROCQ
+4 SET IBCOMMIT=1
PROCQ QUIT
