source: WorldVistAEHR/trunk/r/INTEGRATED_BILLING-IB-PRQ--IBD--IBQ--PRQS/IBACUS1.m@ 1000

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

initial load of WorldVistAEHR

File size: 2.2 KB
Line 
1IBACUS1 ;ALB/CPM - TRICARE PATIENT RX COPAY CHARGES ; 02-AUG-96
2 ;;2.0;INTEGRATED BILLING;**52,240,347**;21-MAR-94;Build 24
3 ;;Per VHA Directive 2004-038, this routine should not be modified.
4 ;
5BILL(IBKEY,IBCHTRN) ; Create the TRICARE Rx copay charge.
6 ; Input: IBKEY -- 1 ; 2, where
7 ; 1 = Pointer to the prescription in file #52
8 ; 2 = Pointer to the refill in file #52.1, or
9 ; 0 for the original fill
10 ; IBCHTRN -- Pointer to the transaction entry in file #351.5
11 ;
12 S IBY=1
13 I '$G(IBKEY) G BILLQ
14 I $$FILE^IBRXUTL(+IBKEY,.01)="" G BILLQ
15 ;
16 ; - need patient
17 S DFN=$$FILE^IBRXUTL(+IBKEY,2)
18 I 'DFN S IBY="-1^IB002" G BILLQ
19 ;
20 ; - need action type
21 S IBATYP=$O(^IBE(350.1,"E","TRICARE RX COPAY",0))
22 I 'IBATYP S IBY="-1^IB008" G BILLQ
23 ;
24 ; - need facility number
25 I '$$CHECK^IBECEAU(0) S IBY="-1^IB009" G BILLQ
26 ;
27 ; - need the Pharmacy service pointer; get from #350.1 and check it
28 S IBSERV=$P($G(^IBE(350.1,1,0)),"^",4)
29 I '$$SERV^IBARX1(IBSERV) S IBY="-1^IB003" G BILLQ
30 ;
31 ; - need a charge amount (from file #351.5)
32 S IBCHG=+$G(^IBA(351.5,IBCHTRN,2))
33 I 'IBCHG S IBY="-1^IB029" G BILLQ
34 ;
35 ; - set remaining variables
36 S IBDESC="TRICARE RX COPAY",IBUNIT=1
37 S IBSL="52:"_+IBKEY S:$P(IBKEY,";",2) IBSL=IBSL_";1:"_$P(IBKEY,";",2)
38 S IBFR=DT
39 ;
40 ; - add the charge to file #350
41 D ADD^IBECEAU3 I IBY<0 G BILLQ
42 ;
43 ; - release the charge to AR
44 D AR^IBR
45 ;
46 ; - update the rx transaction file (#351.5)
47 S DA=IBCHTRN,DIE="^IBA(351.5,",DR=".08////"_IBN D ^DIE K DA,DIE,DR
48 ;
49BILLQ I IBY<0 D ERRMSG^IBACVA2(1,2)
50 K IBY,IBATYP,IBSERV,IBCHG,IBDESC,IBUNIT,IBSL,IBFR
51 Q
52 ;
53 ;
54 ;
55CANC(IBCHTRN) ; Cancel the TRICARE Rx copay charge.
56 ; Input: IBCHTRN -- Pointer to the transaction entry in file #351.5
57 ;
58 S IBY=1,IBDUZ=DUZ
59 S IBCHTRND=$G(^IBA(351.5,IBCHTRN,0)),DFN=+$P(IBCHTRND,"^",2)
60 S IBN=+$P(IBCHTRND,"^",8) I 'IBN G CANCQ
61 I '$$CHECK^IBECEAU(0) S IBY="-1^IB009" G CANCQ
62 S IBCRES=$O(^IBE(350.3,"B","RX CANCELLED",0)) S:'IBCRES IBCRES=5
63 ;
64 ; - cancel the charge
65 D CED^IBECEAU4(IBN) I IBY<0 G CANCQ
66 D CANC^IBECEAU4(IBN,IBCRES,1)
67 ;
68CANCQ I IBY<0 D ERRMSG^IBACVA2(0,2)
69 K IBCHTRND,IBDUZ,IBN,IBCRES,DFN,IBSITE,IBFAC,IBND,IBPARNT,IBCANC,IBH
70 K IBCANTR,IBXA,IBATYP,IBSEQNO,IBIL,IBUNIT,IBCHG,IBFR
71 Q
Note: See TracBrowser for help on using the repository browser.