source: FOIAVistA/trunk/r/INTEGRATED_BILLING-IB-PRQ--IBD--IBQ--PRQS/IBECEAU4.m@ 1693

Last change on this file since 1693 was 628, checked in by George Lilly, 15 years ago

initial load of FOIAVistA 6/30/08 version

File size: 4.2 KB
Line 
1IBECEAU4 ;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 ;
5CANCH(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
15CANCHQ I IBY<1 D @$S($G(IBCV):"ERRMSG^IBACVA2(0,1)",1:"^IBAERR1")
16 Q
17 ;
18CANC(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)
50CANCQ Q
51 ;
52CED(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"
66CEDQ Q
67 ;
68UPSTAT(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 ;
75PASS ; 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 ;
80ERR ; 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 ;
86PROC(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
91PROCQ Q
Note: See TracBrowser for help on using the repository browser.