Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: IBECEAU4

IBECEAU4.m

Go to the documentation of this file.
  1. 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
  1. ;;Per VA Directive 6402, this routine should not be modified.
  1. ;
  1. CANCH(IBN,IBCRES,IBIND,IBCV) ; Cancel last transaction for a specific charge.
  1. ; Input: IBN -- Charge to be cancelled
  1. ; IBCRES -- Cancellation reason
  1. ; IBIND -- 1=>set MT bulletin flags; 0=>don't set flags
  1. ; IBCV -- 1=>use the CHAMPVA error bulletin
  1. N IBY,IBHOLDN,IBND,IBPARNT,IBCANC,IBH,IBCANTR,IBXA,IBATYP,IBSEQNO,IBIL,IBUNIT,IBCHG
  1. S (IBN,IBHOLDN)=$$LAST^IBECEAU($P(^IB(IBN,0),"^",9)),IBY=1
  1. D CED(IBN) I IBCANTR!(IBY<0) G CANCHQ
  1. D CANC(IBN,IBCRES,1) I IBY<0 G CANCHQ
  1. I $G(IBIND) S IBARR(DT,IBHOLDN)="",(IBCANCEL,IBFND)=1
  1. CANCHQ I IBY<1 D @$S($G(IBCV):"ERRMSG^IBACVA2(0,1)",1:"^IBAERR1")
  1. Q
  1. ;
  1. CANC(IBCN,IBCRES,IBINC) ; Cancel a charge, after passing all edits
  1. ; Input: IBCN -- Internal entry # of IB Action to cancel
  1. ; IBCRES -- Cancellation reason
  1. ; IBINC -- Try to cancel an incomplete charge? [optional]
  1. N DA,DIK,IBCAN,IBSTOPDA,IBGMTR,IBTIER
  1. S IBCAN=$G(^IB(IBCN,0))
  1. ;
  1. ; - handle incomplete transactions
  1. 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
  1. ;
  1. ; - handle regular transactions
  1. S IBATYP=$P($G(^IBE(350.1,+$P(IBCAN,"^",3),0)),"^",6) I IBATYP="" S IBY="-1^IB022" G CANCQ
  1. S IBSEQNO=$P($G(^IBE(350.1,IBATYP,0)),"^",5) I 'IBSEQNO S IBY="-1^IB023" G CANCQ
  1. W:$G(IBJOB)=4 !!,"Building the cancellation transaction... "
  1. D ADD^IBAUTL I Y<1 S IBY=Y G CANCQ
  1. S $P(IBCAN,"^",3)=IBATYP,$P(IBCAN,"^",5)=1,$P(IBCAN,"^",10)=IBCRES,$P(IBCAN,"^",12)=""
  1. ; if there is a clinic stop, move it over
  1. S IBSTOPDA=$P(IBCAN,"^",20)
  1. S IBGMTR=$P(IBCAN,"^",21),IBTIER=$P(IBCAN,"^",22) ; 'GMT RELATED' flag and Tier value
  1. S:IBXA'=5 IBCAN=$P(IBCAN,"^",1,16)
  1. S IBCAN=$P(IBCAN,"^",1,17)
  1. I IBSTOPDA S $P(IBCAN,"^",20)=IBSTOPDA
  1. S $P(^IB(IBN,0),"^",2,20)=$P(IBCAN,"^",2,20)
  1. I IBGMTR!(IBTIER) S $P(^IB(IBN,0),"^",21,22)=IBGMTR_"^"_IBTIER ; Set the 'GMT RELATED' flag and Tier value
  1. ; DUZ may be null if this code is called by a process started by an HL7 multi-threaded listener
  1. ; if this condition occurs the approved fix is to use the Postmaster IEN. 2/27/06, IB*2.0*341
  1. S $P(^IB(IBN,1),"^")=$S(DUZ:DUZ,1:.5) ;
  1. S DA=IBN,DIK="^IB(" D IX1^DIK
  1. W:$G(IBJOB)=4 " .. " D PASS
  1. ;
  1. ; - cancel original charge (if it was an updated transaction)
  1. I $D(^IB(IBCN,0)),$P(^(0),"^",5)'=10 D UPSTAT(IBCN)
  1. CANCQ Q
  1. ;
  1. CED(IBN) ; Edits required to cancel a charge.
  1. ; Input: IBN -- Internal entry # of charge to be cancelled
  1. S IBND=$G(^IB(IBN,0)) I 'IBND S IBY="-1^IB021" G CEDQ
  1. S IBPARNT=+$P(IBND,"^",9) I '$D(^IB(IBPARNT,0)) S IBY="-1^IB027" G CEDQ
  1. I $$LAST^IBECEAU(IBPARNT)'=IBN S IBY="-1^^You can only cancel the last transaction for an original charge." G CEDQ
  1. S IBCANC=$G(^IBE(350.1,+$P(IBND,"^",3),0))
  1. S IBH='$P($G(^IBE(350.21,+$P(IBND,"^",5),0)),"^",4),IBCANTR=$P(IBCANC,"^",5)=2
  1. S IBXA=$P(IBCANC,"^",11),IBATYP=$P(IBCANC,"^",6)
  1. I '$D(^IBE(350.1,+IBATYP,0)) S IBY="-1^IB022" G CEDQ
  1. S IBSEQNO=$P(^IBE(350.1,+IBATYP,0),"^",5) I 'IBSEQNO S IBY="-1^IB023" G CEDQ
  1. S IBIL=$P(IBND,"^",11),IBUNIT=+$P(IBND,"^",6),IBCHG=+$P(IBND,"^",7),IBFR=$P(IBND,"^",14)
  1. I IBUNIT<1 S IBY="-1^IB025" G CEDQ
  1. I 'IBH,'IBCHG S IBY="-1^^There is no charge amount associated with this action." G CEDQ
  1. I $G(IBJOB)'=4,'IBH,IBIL="" S IBY="-1^IB024"
  1. CEDQ Q
  1. ;
  1. UPSTAT(IBCN,IB) ; Update the status, cancellation reason of incomplete charges.
  1. N DIE,DA,DR
  1. W:$G(IBJOB)=4&$G(IB) !,"Updating the status of the charge to 'cancelled'... "
  1. S DIE="^IB(",DA=IBCN,DR=".05////10;.1////"_IBCRES
  1. D ^DIE W:$G(IBJOB)=4&$G(IB) "done."
  1. Q
  1. ;
  1. PASS ; Pass the action to Accounts Receivable.
  1. N IBSERV
  1. S IBNOS=IBN D ^IBR S IBY=Y I Y>0,$G(IBJOB)=4 W "done."
  1. Q
  1. ;
  1. ERR ; Error Processing.
  1. Q:IBY>0
  1. I $P(IBY,"^",2)]"" W !,$P($G(^IBE(350.8,+$O(^IBE(350.8,"AC",$P($P(IBY,"^",2),";"),0)),0)),"^",2) Q
  1. I $P(IBY,"^",3)]"" W !,$P(IBY,"^",3)
  1. Q
  1. ;
  1. PROC(EVT) ; Okay to proceed with Add, Edit, or Cancel?
  1. N DIR,DIRUT,DUOUT,DTOUT,X,Y
  1. 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."
  1. 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
  1. S IBCOMMIT=1
  1. PROCQ Q