IBACUS ;ALB/CPM - TRICARE BILLING UTILITIES ; 02-AUG-96
;;2.0;INTEGRATED BILLING;**52,240,274**;21-MAR-94
;;Per VHA Directive 10-93-142, this routine should not be modified.
;
CUS(DFN,IBDT) ; Does the patient have TRICARE coverage?
; Input: DFN -- Pointer to the patient in file #2
; DATE -- Date on which coverage is to be determined
; Output: IBCOV -- 0, if the vet has no billable TRICARE coverage
; >0 => pointer to such coverage in file #2.312
;
N IBCOV,IBPOL,IBI
S IBCOV=0
I '$G(DFN) G CUSQ
S:'$G(IBDT) IBDT=DT
;
; - find a billable TRICARE policy
D ALL^IBCNS1(DFN,"IBPOL",1,IBDT)
S IBI=0 F S IBI=$O(IBPOL(IBI)) Q:'IBI D Q:IBCOV
.Q:$P($G(IBPOL(IBI,3)),"^",4) ; ignore billing this policy
.I $P($G(^IBE(355.1,+$P($G(IBPOL(IBI,355.3)),"^",9),0)),"^",3)=7 S IBCOV=IBI
CUSQ Q IBCOV
;
;
TRI() ; Is the Tricare Billing engine up and running?
; Input: none
; Output: 0 - No 1 - Yes
;
Q $P($G(^IBE(350.9,1,9)),"^",4)>0
;
;
CHPUS(DFN,DATE,IBRX,IBREF,IBLAB,IBRSITE,IBDUZ) ; Bill this patient for TRICARE?
; Input: DFN -- Pointer to the patient in file #2
; DATE -- Date on which coverage is to be determined
; IBRX -- Pointer to the prescription in file #52
; IBREF -- Pointer to the refill in file #52.1, or
; 0 if billing the original prescription
; IBLAB -- Pharmacy label printing device
; IBRSITE -- Pointer to the Pharmacy in file #59
; IBDUZ -- Pointer to the Pharmacy user in file #200
; Output: IBCHK -- 0 => can't bill rx || 1 => bill rx
;
N IBCHK,IBKEY S IBCHK=0
I '$G(DFN) G CHPUSQ
D POL^IBCNSU41(DFN)
;
; - make sure system is running and the patient has TRICARE coverage
I '$$TRI() G CHPUSQ
I '$$CUS(DFN,DATE) G CHPUSQ
;
; - check remaining user input
I '$G(IBRX) G CHPUSQ
I $G(IBREF)="" G CHPUSQ
I $G(IBLAB)=""!('$G(IBRSITE))!('$G(IBDUZ)) G CHPUSQ
;
; - perform all Pharmacy edits
I '$$CHK^PSOCPTRI(IBRX,IBREF) G CHPUSQ
;
; - queue rx for billing
S IBCHK=1,IBKEY=IBRX_";"_IBREF
S ^IBA(351.5,"APOST",IBKEY)=IBLAB_"^"_IBRSITE_"^"_IBDUZ
;
CHPUSQ Q IBCHK
;
;
;
;
; The following three queued entry points are invoked by the
; TRICARE Rx Billing engine. The following two variables are
; defined for each of the jobs:
;
; IBCHTRN -- Pointer to the transaction entry in file #351.5
; IBKEYD -- 1 ^ 2 ^ 3, where
; 1 = Rx label printing device
; 2 = Pointer to the Pharmacy in file #59
; 3 = Pointer to the Pharmacy user in file #200
;
RXLAB ; Queued entry point to print the TRICARE Rx label.
I $G(IBKEYD)="" G RXLABQ
S IBCOP=$J(+$G(^IBA(351.5,+$G(IBCHTRN),2)),0,2)
I 'IBCOP G RXLABQ
D LABEL^PSOCPTRI(+$G(^IBA(351.5,IBCHTRN,0)),$P(IBKEYD,"^"),$P(IBKEYD,"^",2),$P(IBKEYD,"^",3),IBCOP)
RXLABQ K IBCOP
Q
;
;
RXBIL ; Queued entry point to create TRICARE Rx Billing charges.
;
; - check some basic input
I '$$RXSET G RXBILQ
;
; - create copay charge
D BILL^IBACUS1(IBKEY,IBCHTRN)
;
; - create fiscal intermediary claim
D BILL^IBACUS2(IBKEY,IBCHTRN)
;
RXBILQ Q
;
;
RXCAN ; Queued entry point to cancel TRICARE Rx Billing charges.
;
; - check some basic input
I '$$RXSET G RXCANQ
;
; - cancel copay charge
D CANC^IBACUS1(IBCHTRN)
;
; - cancel fiscal intermediary claim
D CANC^IBACUS2(IBCHTRN)
;
RXCANQ Q
;
;
RXSET() ; Establish the session.
N IBOK S IBOK=0
;
; - check some basic input
I '$G(IBCHTRN) G RXSETQ
S IBKEY=$P($G(^IBA(351.5,IBCHTRN,0)),"^")
I IBKEY="" G RXSETQ
S DUZ=+$P(IBKEYD,"^",3)
I $G(^VA(200,DUZ,0))="" G RXSETQ
;
N DIQUIET S DIQUIET=1 D DT^DICRW
S IBOK=1
;
RXSETQ Q IBOK
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HIBACUS 3841 printed Nov 22, 2024@17:15:56 Page 2
IBACUS ;ALB/CPM - TRICARE BILLING UTILITIES ; 02-AUG-96
+1 ;;2.0;INTEGRATED BILLING;**52,240,274**;21-MAR-94
+2 ;;Per VHA Directive 10-93-142, this routine should not be modified.
+3 ;
CUS(DFN,IBDT) ; Does the patient have TRICARE coverage?
+1 ; Input: DFN -- Pointer to the patient in file #2
+2 ; DATE -- Date on which coverage is to be determined
+3 ; Output: IBCOV -- 0, if the vet has no billable TRICARE coverage
+4 ; >0 => pointer to such coverage in file #2.312
+5 ;
+6 NEW IBCOV,IBPOL,IBI
+7 SET IBCOV=0
+8 IF '$GET(DFN)
GOTO CUSQ
+9 if '$GET(IBDT)
SET IBDT=DT
+10 ;
+11 ; - find a billable TRICARE policy
+12 DO ALL^IBCNS1(DFN,"IBPOL",1,IBDT)
+13 SET IBI=0
FOR
SET IBI=$ORDER(IBPOL(IBI))
if 'IBI
QUIT
Begin DoDot:1
+14 ; ignore billing this policy
if $PIECE($GET(IBPOL(IBI,3)),"^",4)
QUIT
+15 IF $PIECE($GET(^IBE(355.1,+$PIECE($GET(IBPOL(IBI,355.3)),"^",9),0)),"^",3)=7
SET IBCOV=IBI
End DoDot:1
if IBCOV
QUIT
CUSQ QUIT IBCOV
+1 ;
+2 ;
TRI() ; Is the Tricare Billing engine up and running?
+1 ; Input: none
+2 ; Output: 0 - No 1 - Yes
+3 ;
+4 QUIT $PIECE($GET(^IBE(350.9,1,9)),"^",4)>0
+5 ;
+6 ;
CHPUS(DFN,DATE,IBRX,IBREF,IBLAB,IBRSITE,IBDUZ) ; Bill this patient for TRICARE?
+1 ; Input: DFN -- Pointer to the patient in file #2
+2 ; DATE -- Date on which coverage is to be determined
+3 ; IBRX -- Pointer to the prescription in file #52
+4 ; IBREF -- Pointer to the refill in file #52.1, or
+5 ; 0 if billing the original prescription
+6 ; IBLAB -- Pharmacy label printing device
+7 ; IBRSITE -- Pointer to the Pharmacy in file #59
+8 ; IBDUZ -- Pointer to the Pharmacy user in file #200
+9 ; Output: IBCHK -- 0 => can't bill rx || 1 => bill rx
+10 ;
+11 NEW IBCHK,IBKEY
SET IBCHK=0
+12 IF '$GET(DFN)
GOTO CHPUSQ
+13 DO POL^IBCNSU41(DFN)
+14 ;
+15 ; - make sure system is running and the patient has TRICARE coverage
+16 IF '$$TRI()
GOTO CHPUSQ
+17 IF '$$CUS(DFN,DATE)
GOTO CHPUSQ
+18 ;
+19 ; - check remaining user input
+20 IF '$GET(IBRX)
GOTO CHPUSQ
+21 IF $GET(IBREF)=""
GOTO CHPUSQ
+22 IF $GET(IBLAB)=""!('$GET(IBRSITE))!('$GET(IBDUZ))
GOTO CHPUSQ
+23 ;
+24 ; - perform all Pharmacy edits
+25 IF '$$CHK^PSOCPTRI(IBRX,IBREF)
GOTO CHPUSQ
+26 ;
+27 ; - queue rx for billing
+28 SET IBCHK=1
SET IBKEY=IBRX_";"_IBREF
+29 SET ^IBA(351.5,"APOST",IBKEY)=IBLAB_"^"_IBRSITE_"^"_IBDUZ
+30 ;
CHPUSQ QUIT IBCHK
+1 ;
+2 ;
+3 ;
+4 ;
+5 ; The following three queued entry points are invoked by the
+6 ; TRICARE Rx Billing engine. The following two variables are
+7 ; defined for each of the jobs:
+8 ;
+9 ; IBCHTRN -- Pointer to the transaction entry in file #351.5
+10 ; IBKEYD -- 1 ^ 2 ^ 3, where
+11 ; 1 = Rx label printing device
+12 ; 2 = Pointer to the Pharmacy in file #59
+13 ; 3 = Pointer to the Pharmacy user in file #200
+14 ;
RXLAB ; Queued entry point to print the TRICARE Rx label.
+1 IF $GET(IBKEYD)=""
GOTO RXLABQ
+2 SET IBCOP=$JUSTIFY(+$GET(^IBA(351.5,+$GET(IBCHTRN),2)),0,2)
+3 IF 'IBCOP
GOTO RXLABQ
+4 DO LABEL^PSOCPTRI(+$GET(^IBA(351.5,IBCHTRN,0)),$PIECE(IBKEYD,"^"),$PIECE(IBKEYD,"^",2),$PIECE(IBKEYD,"^",3),IBCOP)
RXLABQ KILL IBCOP
+1 QUIT
+2 ;
+3 ;
RXBIL ; Queued entry point to create TRICARE Rx Billing charges.
+1 ;
+2 ; - check some basic input
+3 IF '$$RXSET
GOTO RXBILQ
+4 ;
+5 ; - create copay charge
+6 DO BILL^IBACUS1(IBKEY,IBCHTRN)
+7 ;
+8 ; - create fiscal intermediary claim
+9 DO BILL^IBACUS2(IBKEY,IBCHTRN)
+10 ;
RXBILQ QUIT
+1 ;
+2 ;
RXCAN ; Queued entry point to cancel TRICARE Rx Billing charges.
+1 ;
+2 ; - check some basic input
+3 IF '$$RXSET
GOTO RXCANQ
+4 ;
+5 ; - cancel copay charge
+6 DO CANC^IBACUS1(IBCHTRN)
+7 ;
+8 ; - cancel fiscal intermediary claim
+9 DO CANC^IBACUS2(IBCHTRN)
+10 ;
RXCANQ QUIT
+1 ;
+2 ;
RXSET() ; Establish the session.
+1 NEW IBOK
SET IBOK=0
+2 ;
+3 ; - check some basic input
+4 IF '$GET(IBCHTRN)
GOTO RXSETQ
+5 SET IBKEY=$PIECE($GET(^IBA(351.5,IBCHTRN,0)),"^")
+6 IF IBKEY=""
GOTO RXSETQ
+7 SET DUZ=+$PIECE(IBKEYD,"^",3)
+8 IF $GET(^VA(200,DUZ,0))=""
GOTO RXSETQ
+9 ;
+10 NEW DIQUIET
SET DIQUIET=1
DO DT^DICRW
+11 SET IBOK=1
+12 ;
RXSETQ QUIT IBOK
