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

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

initial load of WorldVistAEHR

File size: 5.8 KB
RevLine 
[613]1IBACUS2 ;ALB/CPM - TRICARE FISCAL INTERMEDIARY RX CLAIMS ;02-AUG-96
2 ;;2.0;INTEGRATED BILLING;**52,91,51,240,341,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 claim for the Fiscal Intermediary.
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 N IBQUERY
13 S IBY=1 K IBDRX
14 I '$G(IBKEY) G BILLQ
15 I $$FILE^IBRXUTL(+IBKEY,.01)="" G BILLQ
16 S IBAMT=$P($G(^IBA(351.5,+IBCHTRN,2)),"^",5) ; FI portion of charge
17 I 'IBAMT G BILLQ
18 ;
19 ; - derive minimal variables
20 I '$$CHECK^IBECEAU(0) S IBY="-1^IB009" G BILLQ
21 S IBSERV=$P($G(^IBE(350.1,1,0)),"^",4)
22 I '$$SERV^IBARX1(IBSERV) S IBY="-1^IB003" G BILLQ
23 ;
24 ; - establish a stub claim/receivable
25 D SET^IBR I IBY<0 G BILLQ
26 ;
27 ; - set up the following variables for claim establishment:
28 ; .01 BILL #
29 ; .17 ORIG CLAIM
30 ; .2 AUTO?
31 ; .02 DFN
32 ; .06 TIMEFRAME
33 ; .07 RATE TYPE
34 ; .18 SC AT TIME?
35 ; .04 LOCATION (WILL NEED DIVISION THAT DISPENSED)
36 ; .05 BILL CLASSIF (3)
37 ; .03 EVT DATE (FILL DATE)
38 ; 151 BILL FROM
39 ; 152 BILL TO
40 K IB
41 S (IB(.02),DFN,IBDFN)=$$FILE^IBRXUTL(+IBKEY,2)
42 I 'DFN S IBY="-1^IB002" G BILLQ
43 S IB(.07)=$O(^DGCR(399.3,"B","TRICARE",0))
44 I 'IB(.07) S IBY="-1^IB059" G BILLQ
45 I $$TRANS^PSOCPTRI(+IBKEY,+$P(IBKEY,";",2),.IBDRX)<0 S IBY="-1^IB010" G BILLQ
46 ;
47 S IBIFN=PRCASV("ARREC")
48 S IB(.01)=$P(PRCASV("ARBIL"),"-",2)
49 S IB(.17)=""
50 S IB(.2)=0
51 S IB(.06)=1
52 S IB(.18)=$$SC^IBCU3(DFN)
53 S IB(.04)=1 ; how can I get Division? RON...
54 S IB(.05)=3
55 S (IB(.03),IB(151),IB(152))=IBDRX("FDT")
56 ;
57 ; - set 362.4 node to rx#^p50^days sup^fill date^qty^ndc
58 S IB(362.4,+IBKEY,1)=IBDRX("RX#")_"^"_$$FILE^IBRXUTL(+IBKEY,6)_"^"_IBDRX("SUP")_"^"_IBDRX("FDT")_"^"_IBDRX("QTY")_"^"_IBDRX("NDC")
59 ;
60 ; - call the autobiller module to create the claim with a default
61 ; diagnosis and procedure for prescriptions
62 D EN^IBCD3(.IBQUERY)
63 D CLOSE^IBSDU(.IBQUERY)
64 ;
65 ; - add the payor (fiscal intermediary) to the claim
66 S IBCDFN=$$CUS^IBACUS(DFN)
67 I 'IBCDFN S IBY="-1^IB054" G BILLQ
68 S IBINS=+$G(^DPT(DFN,.312,IBCDFN,0))
69 S DIE="^DGCR(399,",DA=IBIFN,DR="112////"_IBCDFN
70 D ^DIE K DA,DR,DIE,DGRVRCAL
71 ;
72 ; - add charge to the claim
73 S IBRVCD=$P($G(^DIC(36,IBINS,0)),"^",15) ; rx refill rev code
74 I IBRVCD="" S IBRVCD=$P($G(^IBE(363.1,+$P($G(^IBE(350.9,1,9)),U,12),0)),U,5) ; CS def rev code
75 I IBRVCD="" S X=250 ; gen'l rx rev code
76 ;
77 S IBBS=$P($G(^IBE(363.1,+$P($G(^IBE(350.9,1,9)),U,12),0)),U,6) ; CS def bedsection
78 S IBUNITS=1 ; one unit
79 S IBCPT=$P($G(^IBE(350.9,1,1)),"^",30) ; def rx refill cpt
80 S IBDIV="" ; division
81 S IBAA=0 ; not auto calc charges
82 S IBTYPE=3 ; rx type
83 S IBITEM="" ; charge item link
84 ;
85 ;
86 S X=$$ADDRC^IBCRBF(IBIFN,IBRVCD,IBBS,IBAMT,IBUNITS,IBCPT,IBDIV,IBAA,IBTYPE,IBITEM)
87 I X<0 S IBY="-1^^Unable to add Revenue Code charge to claim." G BILLQ
88 ;
89 ; - update the authorize/print fields
90 S DIE="^DGCR(399,",DA=IBIFN,DR="9////1" D ^DIE K DA,DR,DIE
91 S DIE="^DGCR(399,",DA=IBIFN,DR="12////"_DT D ^DIE K DA,DR,DIE
92 ;
93 ; - pass the claim to AR
94 D GVAR^IBCBB,ARRAY^IBCBB1,^PRCASVC6,REL^PRCASVC:PRCASV("OKAY")
95 I 'PRCASV("OKAY") S IBY="-1^^Unable to establish receivable in AR." G BILLQ
96 ;
97 ; - update the rx transaction file (#351.5)
98 S DA=IBCHTRN,DIE="^IBA(351.5,",DR=".09////"_IBIFN D ^DIE K DA,DIE,DR
99 ;
100 ; - update the AR status to Active
101 S PRCASV("STATUS")=16
102 D STATUS^PRCASVC1
103 ;
104BILLQ I IBY<0 D ERRMSG^IBACVA2(1,2)
105 K IBRVCD,IBBS,IBUNITS,IBCPT,IBDIV,IBAA,IBTYPE,IBITEM,IBAMT
106 K IBSERV,IBFAC,IBSITE,IBDRX,IB,IBCDFN,IBINS,IBIDS,IBIFN,IBDFN
107 K PRCASV,PRCAERR
108 Q
109 ;
110 ;
111CANC(IBCHTRN) ; Cancel the claim to the Fiscal Intermediary.
112 ; Input: IBCHTRN -- Pointer to the transaction entry in file #351.5
113 ;
114 S IBIFN=+$P($G(^IBA(351.5,IBCHTRN,0)),"^",9)
115 I 'IBIFN G CANCQ
116 F I=0,"S" S IB(I)=$G(^DGCR(399,IBIFN,I))
117 I IB(0)="" G CANCQ
118 I +$P(IB("S"),U,16),$P(IB("S"),U,17)]"" G CANCQ
119 ;
120 S DA=IBIFN,DR="16////1;19////PRESCRIPTION REVERSED",DIE="^DGCR(399,"
121 D ^DIE K DA,DIE,DR
122 ;
123 ; - decrease out the receivable in AR
124 S DFN=+$P(IB(0),"^",2)
125 S IB("U1")=$G(^DGCR(399,IBIFN,"U1"))
126 S IBIL=$P($G(^PRCA(430,IBIFN,0)),"^")
127 S IBCHG=$S(IB("U1")']"":0,$P(IB("U1"),"^",1)]"":$P(IB("U1"),"^",1),1:0)
128 S IBCRES="TRICARE PRESCRIPTION REVERSED"
129 ;
130 S X="21^"_IBCHG_"^"_IBIL_"^"_$S('DUZ:.5,1:DUZ)_"^"_DT_"^"_IBCRES ; *341
131 D ^PRCASER1
132 I Y<0 S IBY=Y D BULL
133 ;
134CANCQ K DFN,IBIFN,IB,IBIL,IBCHG,IBCRES,IBY,X,Y
135 Q
136 ;
137 ;
138BULL ; Generate a bulletin if there is an error in canceling the claim.
139 K IBT S IBPT=$$PT^IBEFUNC(DFN)
140 S XMSUB=$E($P(IBPT,"^"),1,14)_" "_$P(IBPT,"^",3)_" - ERROR ENCOUNTERED"
141 S XMDUZ="INTEGRATED BILLING PACKAGE",XMTEXT="IBT("
142 S XMY(DUZ)=""
143 S IBGRP=$P($G(^XMB(3.8,+$P($G(^IBE(350.9,1,1)),"^",7),0)),"^")
144 I IBGRP]"" S XMY("G."_IBGRP_"@"_^XMB("NETNAME"))=""
145 ;
146 S IBT(1)="An error occurred while cancelling the Pharmacy claim to the TRICARE"
147 S IBT(2)="fiscal intermediary for the following patient:"
148 S IBT(3)=" " S IBC=3
149 S IBDUZ=DUZ D PAT^IBAERR1
150 S IBC=IBC+1,IBT(IBC)=" Bill #: "_IBIL
151 S IBC=IBC+1,IBT(IBC)=" "
152 S IBC=IBC+1,IBT(IBC)="The following error was encountered:"
153 S IBC=IBC+1,IBT(IBC)=" "
154 D ERR^IBAERR1
155 S IBC=IBC+1,IBT(IBC)=" "
156 S IBC=IBC+1,IBT(IBC)="Please review the circumstances surrounding this error and decrease"
157 S IBC=IBC+1,IBT(IBC)="out this receivable in Accounts Receivable if necessary."
158 ;
159 D ^XMD
160 K IBC,IBDUZ,IBT,IBPT,IBGRP,XMDUZ,XMTEXT,XMSUB,XMY
161 Q
Note: See TracBrowser for help on using the repository browser.