| [613] | 1 | IBACUS2 ;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 | ;
|
|---|
| 5 | BILL(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 | ;
|
|---|
| 104 | BILLQ 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 | ;
|
|---|
| 111 | CANC(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 | ;
|
|---|
| 134 | CANCQ K DFN,IBIFN,IB,IBIL,IBCHG,IBCRES,IBY,X,Y
|
|---|
| 135 | Q
|
|---|
| 136 | ;
|
|---|
| 137 | ;
|
|---|
| 138 | BULL ; 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
|
|---|
