IBACUS1 ;ALB/CPM - TRICARE PATIENT RX COPAY CHARGES ; 02-AUG-96
;;2.0;INTEGRATED BILLING;**52,240,347**;21-MAR-94;Build 24
;;Per VHA Directive 2004-038, this routine should not be modified.
;
BILL(IBKEY,IBCHTRN) ; Create the TRICARE Rx copay charge.
; Input: IBKEY -- 1 ; 2, where
; 1 = Pointer to the prescription in file #52
; 2 = Pointer to the refill in file #52.1, or
; 0 for the original fill
; IBCHTRN -- Pointer to the transaction entry in file #351.5
;
S IBY=1
I '$G(IBKEY) G BILLQ
I $$FILE^IBRXUTL(+IBKEY,.01)="" G BILLQ
;
; - need patient
S DFN=$$FILE^IBRXUTL(+IBKEY,2)
I 'DFN S IBY="-1^IB002" G BILLQ
;
; - need action type
S IBATYP=$O(^IBE(350.1,"E","TRICARE RX COPAY",0))
I 'IBATYP S IBY="-1^IB008" G BILLQ
;
; - need facility number
I '$$CHECK^IBECEAU(0) S IBY="-1^IB009" G BILLQ
;
; - need the Pharmacy service pointer; get from #350.1 and check it
S IBSERV=$P($G(^IBE(350.1,1,0)),"^",4)
I '$$SERV^IBARX1(IBSERV) S IBY="-1^IB003" G BILLQ
;
; - need a charge amount (from file #351.5)
S IBCHG=+$G(^IBA(351.5,IBCHTRN,2))
I 'IBCHG S IBY="-1^IB029" G BILLQ
;
; - set remaining variables
S IBDESC="TRICARE RX COPAY",IBUNIT=1
S IBSL="52:"_+IBKEY S:$P(IBKEY,";",2) IBSL=IBSL_";1:"_$P(IBKEY,";",2)
S IBFR=DT
;
; - add the charge to file #350
D ADD^IBECEAU3 I IBY<0 G BILLQ
;
; - release the charge to AR
D AR^IBR
;
; - update the rx transaction file (#351.5)
S DA=IBCHTRN,DIE="^IBA(351.5,",DR=".08////"_IBN D ^DIE K DA,DIE,DR
;
BILLQ I IBY<0 D ERRMSG^IBACVA2(1,2)
K IBY,IBATYP,IBSERV,IBCHG,IBDESC,IBUNIT,IBSL,IBFR
Q
;
;
;
CANC(IBCHTRN) ; Cancel the TRICARE Rx copay charge.
; Input: IBCHTRN -- Pointer to the transaction entry in file #351.5
;
S IBY=1,IBDUZ=DUZ
S IBCHTRND=$G(^IBA(351.5,IBCHTRN,0)),DFN=+$P(IBCHTRND,"^",2)
S IBN=+$P(IBCHTRND,"^",8) I 'IBN G CANCQ
I '$$CHECK^IBECEAU(0) S IBY="-1^IB009" G CANCQ
S IBCRES=$O(^IBE(350.3,"B","RX CANCELLED",0)) S:'IBCRES IBCRES=5
;
; - cancel the charge
D CED^IBECEAU4(IBN) I IBY<0 G CANCQ
D CANC^IBECEAU4(IBN,IBCRES,1)
;
CANCQ I IBY<0 D ERRMSG^IBACVA2(0,2)
K IBCHTRND,IBDUZ,IBN,IBCRES,DFN,IBSITE,IBFAC,IBND,IBPARNT,IBCANC,IBH
K IBCANTR,IBXA,IBATYP,IBSEQNO,IBIL,IBUNIT,IBCHG,IBFR
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HIBACUS1 2370 printed Dec 13, 2024@02:05:50 Page 2
IBACUS1 ;ALB/CPM - TRICARE PATIENT RX COPAY CHARGES ; 02-AUG-96
+1 ;;2.0;INTEGRATED BILLING;**52,240,347**;21-MAR-94;Build 24
+2 ;;Per VHA Directive 2004-038, this routine should not be modified.
+3 ;
BILL(IBKEY,IBCHTRN) ; Create the TRICARE Rx copay charge.
+1 ; Input: IBKEY -- 1 ; 2, where
+2 ; 1 = Pointer to the prescription in file #52
+3 ; 2 = Pointer to the refill in file #52.1, or
+4 ; 0 for the original fill
+5 ; IBCHTRN -- Pointer to the transaction entry in file #351.5
+6 ;
+7 SET IBY=1
+8 IF '$GET(IBKEY)
GOTO BILLQ
+9 IF $$FILE^IBRXUTL(+IBKEY,.01)=""
GOTO BILLQ
+10 ;
+11 ; - need patient
+12 SET DFN=$$FILE^IBRXUTL(+IBKEY,2)
+13 IF 'DFN
SET IBY="-1^IB002"
GOTO BILLQ
+14 ;
+15 ; - need action type
+16 SET IBATYP=$ORDER(^IBE(350.1,"E","TRICARE RX COPAY",0))
+17 IF 'IBATYP
SET IBY="-1^IB008"
GOTO BILLQ
+18 ;
+19 ; - need facility number
+20 IF '$$CHECK^IBECEAU(0)
SET IBY="-1^IB009"
GOTO BILLQ
+21 ;
+22 ; - need the Pharmacy service pointer; get from #350.1 and check it
+23 SET IBSERV=$PIECE($GET(^IBE(350.1,1,0)),"^",4)
+24 IF '$$SERV^IBARX1(IBSERV)
SET IBY="-1^IB003"
GOTO BILLQ
+25 ;
+26 ; - need a charge amount (from file #351.5)
+27 SET IBCHG=+$GET(^IBA(351.5,IBCHTRN,2))
+28 IF 'IBCHG
SET IBY="-1^IB029"
GOTO BILLQ
+29 ;
+30 ; - set remaining variables
+31 SET IBDESC="TRICARE RX COPAY"
SET IBUNIT=1
+32 SET IBSL="52:"_+IBKEY
if $PIECE(IBKEY,";",2)
SET IBSL=IBSL_";1:"_$PIECE(IBKEY,";",2)
+33 SET IBFR=DT
+34 ;
+35 ; - add the charge to file #350
+36 DO ADD^IBECEAU3
IF IBY<0
GOTO BILLQ
+37 ;
+38 ; - release the charge to AR
+39 DO AR^IBR
+40 ;
+41 ; - update the rx transaction file (#351.5)
+42 SET DA=IBCHTRN
SET DIE="^IBA(351.5,"
SET DR=".08////"_IBN
DO ^DIE
KILL DA,DIE,DR
+43 ;
BILLQ IF IBY<0
DO ERRMSG^IBACVA2(1,2)
+1 KILL IBY,IBATYP,IBSERV,IBCHG,IBDESC,IBUNIT,IBSL,IBFR
+2 QUIT
+3 ;
+4 ;
+5 ;
CANC(IBCHTRN) ; Cancel the TRICARE Rx copay charge.
+1 ; Input: IBCHTRN -- Pointer to the transaction entry in file #351.5
+2 ;
+3 SET IBY=1
SET IBDUZ=DUZ
+4 SET IBCHTRND=$GET(^IBA(351.5,IBCHTRN,0))
SET DFN=+$PIECE(IBCHTRND,"^",2)
+5 SET IBN=+$PIECE(IBCHTRND,"^",8)
IF 'IBN
GOTO CANCQ
+6 IF '$$CHECK^IBECEAU(0)
SET IBY="-1^IB009"
GOTO CANCQ
+7 SET IBCRES=$ORDER(^IBE(350.3,"B","RX CANCELLED",0))
if 'IBCRES
SET IBCRES=5
+8 ;
+9 ; - cancel the charge
+10 DO CED^IBECEAU4(IBN)
IF IBY<0
GOTO CANCQ
+11 DO CANC^IBECEAU4(IBN,IBCRES,1)
+12 ;
CANCQ IF IBY<0
DO ERRMSG^IBACVA2(0,2)
+1 KILL IBCHTRND,IBDUZ,IBN,IBCRES,DFN,IBSITE,IBFAC,IBND,IBPARNT,IBCANC,IBH
+2 KILL IBCANTR,IBXA,IBATYP,IBSEQNO,IBIL,IBUNIT,IBCHG,IBFR
+3 QUIT
