- 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 Feb 18, 2025@23:47:57 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