IBECUSM ;DVAMC/RLM - TRICARE PHARMACY BILLING OPTIONS; 20-AUG-96
;;2.0;INTEGRATED BILLING;**52,162,240,347**;21-MAR-94;Build 24
;;Per VHA Directive 2004-038, this routine should not be modified.
;
;
REV ; Reverse a claim already submitted to the Fiscal Intermediary.
I '$P($G(^IBE(350.9,1,9)),"^",4) W !!,"Please note that your TRICARE Pharmacy billing interface is not running!",!
REVA N X K DIC S DIC=52,DIC("A")="Enter the RX# you wish to reverse: ",DIC(0)="AEQMN"
W ! D DIC^PSODI(52,.DIC) S IBRX=+Y K DIC
I Y<1!($D(DUOUT))!($D(DIRUT)) G REVQ
W !!,"Prescription: ",$P(Y,"^",2),!," Patient: ",$$FILE^IBRXUTL(+Y,2,"E")
;
; - has this prescription been billed?
K IBARR,IBCAN S (IBKEY,IBKEYS)=IBRX_";"
F S IBKEY=$O(^IBA(351.5,"B",IBKEY)) Q:$E(IBKEY,1,$L(IBKEYS))'=IBKEYS S IBARR(IBKEY)=+$O(^(IBKEY,0))
I '$D(IBARR) W !!,"This prescription has not yet been billed." G REVA
;
; - find all potential transactions
D FINDC^IBECUSMU(.IBARR,1,.IBCAN)
S IBKEY=$O(IBCAN("")) I IBKEY="" G REVA
;
; - there's just one
I $O(IBCAN(IBKEY))="" S IBCHTRN=IBCAN(IBKEY) W !!,$S($P(IBKEY,";",2):"Refill #"_$P(IBKEY,";",2),1:"The original fill")," for this prescription can be cancelled." G OKAYC
;
; - more than 1; must select from the list
W !!,"More than one fill for rx# ",$$FILE^IBRXUTL(IBRX,.01)," may be cancelled."
S IBREF=$$SEL^IBECUSMU(.IBCAN)
I IBREF<0 G REVQ
;
S IBKEY=IBRX_";"_IBREF,IBCHTRN=IBCAN(IBKEY)
;
OKAYC ; - okay to cancel?
S DIR("A")="Is it okay to cancel this prescription"
S DIR(0)="Y" D ^DIR K DIR
I 'Y!($D(DUOUT))!($D(DIRUT)) W !,"The claim reversal was NOT submitted." G REVQ
;
; - queue cancellation for submittal
S ^IBA(351.5,"APOST",IBKEY)="REVERSE^^"_DUZ_"^"_IBCHTRN
W !,"The claim reversal has been submitted."
REVQ K DIROUT,DIRUT,DTOUR,DUOUT,IBRX,IBARR,IBCAN,IBKEY,IBKEYS,IBCHTRN,IBREF
Q
;
;
;
RESUB ; Resubmit a claim to the Fiscal Intermediary.
I '$P($G(^IBE(350.9,1,9)),"^",4) W !!,"Please note that your TRICARE Pharmacy billing interface is not running!",!
RESUBA N X K DIC S DIC=52 S DIC(0)="AEQMN",DIC("A")="Enter the RX# you wish to resubmit: "
W ! D DIC^PSODI(52,.DIC) S IBRX=+Y K DIC
I Y<1!($D(DUOUT))!($D(DIRUT)) G RESUBQ
S DFN=$$FILE^IBRXUTL(+Y,2)
W !!,"Prescription: ",$$FILE^IBRXUTL(IBRX,.01),!," Patient: ",$P($G(^DPT(DFN,0)),"^")
;
; - find all potential transactions
K IBBIL D FINDB^IBECUSMU(IBRX,1,.IBBIL)
S IBKEY=$O(IBBIL("")) I IBKEY="" G RESUBA
;
; - there's just one
I $O(IBBIL(IBKEY))="" W !!,$S($P(IBKEY,";",2):"Refill #"_$P(IBKEY,";",2),1:"The original fill")," for this prescription can be billed." G IBPSR
;
; - more than 1; must select from the list
W !!,"More than one fill for rx# ",$$FILE^IBRXUTL(IBRX,.01)," may be billed."
S IBREF=$$SEL^IBECUSMU(.IBBIL)
I IBREF<0 G RESUBQ
;
S IBKEY=IBRX_";"_IBREF
;
IBPSR ;Ask for the Product Selection Reason
N DIR,DIE,DR,X,Y,DA
S DIR("B")=$S($P($G(^IBA(351.5,+IBBIL(IBKEY),0)),"^",10):$P(^IBA(351.53,$P(^(0),"^",10),0),"^"),1:0)
S DIR(0)="PO^351.53" D ^DIR I Y=-1 W !,"The prescription was NOT submitted for billing." G RESUBQ
S DA=+$G(IBBIL(IBKEY)),DIE="^IBA(351.5,",DR=".10////"_(+Y) D ^DIE
K DIR
OKAYB ; - okay to bill?
S DIR("A")="Is it okay to bill this prescription"
S DIR(0)="Y" D ^DIR
I 'Y!($D(DUOUT))!($D(DIRUT)) W !,"The prescription was NOT submitted for billing." G RESUBQ
;
D:'$D(PSOPAR) ^PSOLSET
I '$D(PSOLAP) W !!,*7,"The label printer is not defined!",!,"The prescription has NOT been submitted for billing." G RESUBQ
S ^IBA(351.5,"APOST",IBKEY)=PSOLAP_"^"_PSOSITE_"^"_DUZ_"^^"_$P($G(^IBA(351.5,+IBBIL(IBKEY),0)),"^",10)
W !,"The prescription has been submitted for billing."
;
RESUBQ K DIROUT,DIRUT,DTOUR,DUOUT,IBRX,DFN,IBBIL,IBKEY,IBREF
K PSOBAR0,PSOBAR1,PSOBARS,PSOCLC,PSOCNT,PSODIV,PSODTCUT
K PSOLAP,PSOPAR,PSOPAR7,PSOPRPAS,PSOSITE
Q
;
;
;
DREJ ; Delete an entry from the Reject (#351.52) file.
I '$P($G(^IBE(350.9,1,9)),"^",4) W !!,"Please note that your TRICARE Pharmacy billing interface is not running!",!
DREJA N X K DIC S DIC=52 S DIC(0)="AEQMN",DIC("A")="Enter the RX# of the rejected transmission: "
W ! D DIC^PSODI(52,.DIC) S IBRX=+Y K DIC
I Y<1!($D(DUOUT))!($D(DIRUT)) G DREJQ
W !!,"Prescription: ",$P(Y,"^",2),!," Patient: ",$$FILE^IBRXUTL(+Y,2,"E")
;
; - is there a reject entry for this prescription?
K IBARR S (IBKEY,IBKEYS)=IBRX_";"
F S IBKEY=$O(^IBA(351.52,"B",IBKEY)) Q:$E(IBKEY,1,$L(IBKEYS))'=IBKEYS S IBARR(IBKEY)=+$O(^(IBKEY,0))
I '$D(IBARR) W !!,"There is no reject entry for this prescription." G DREJA
;
; - select the reject entry to delete
S IBKEY=$O(IBARR("")) I IBKEY="" G DREJA
I $O(IBARR(IBKEY))="" S IBCHREF=+IBARR(IBKEY) W !!,$S($P(IBKEY,";",2):"Refill #"_$P(IBKEY,";",2),1:"The original fill")," for this prescription has been rejected." G OKAYD
;
; - more than 1; must select from the list
W !!,"More than one fill for rx# ",$$FILE^IBRXUTL(IBRX,.01)," has a reject entry."
S IBREF=$$SEL^IBECUSMU(.IBARR)
I IBREF<0 G DREJQ
;
S IBKEY=IBRX_";"_IBREF,IBCHREF=+$G(IBARR(IBKEY))
;
OKAYD ; - okay to delete the reject?
I '$D(^IBA(351.52,IBCHREF,0)) K ^IBA(351.52,"B",IBKEY) W !!,"Sorry, can't find a reject for this prescription!" G DREJQ
S DIR("A")="Is it okay to delete this reject entry"
S DIR(0)="Y" D ^DIR K DIR
I 'Y!($D(DUOUT))!($D(DIRUT)) W !,"The reject entry was NOT deleted." G DREJQ
;
; - delete the entry
S DA=IBCHREF,DIK="^IBA(351.52," D ^DIK K DA,DIK
W !,"The reject entry has been deleted."
DREJQ K DIROUT,DIRUT,DTOUR,DUOUT,IBRX,IBARR,IBKEY,IBKEYS,IBCHREF,IBREF
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HIBECUSM 5654 printed Nov 22, 2024@17:31:54 Page 2
IBECUSM ;DVAMC/RLM - TRICARE PHARMACY BILLING OPTIONS; 20-AUG-96
+1 ;;2.0;INTEGRATED BILLING;**52,162,240,347**;21-MAR-94;Build 24
+2 ;;Per VHA Directive 2004-038, this routine should not be modified.
+3 ;
+4 ;
REV ; Reverse a claim already submitted to the Fiscal Intermediary.
+1 IF '$PIECE($GET(^IBE(350.9,1,9)),"^",4)
WRITE !!,"Please note that your TRICARE Pharmacy billing interface is not running!",!
REVA NEW X
KILL DIC
SET DIC=52
SET DIC("A")="Enter the RX# you wish to reverse: "
SET DIC(0)="AEQMN"
+1 WRITE !
DO DIC^PSODI(52,.DIC)
SET IBRX=+Y
KILL DIC
+2 IF Y<1!($DATA(DUOUT))!($DATA(DIRUT))
GOTO REVQ
+3 WRITE !!,"Prescription: ",$PIECE(Y,"^",2),!," Patient: ",$$FILE^IBRXUTL(+Y,2,"E")
+4 ;
+5 ; - has this prescription been billed?
+6 KILL IBARR,IBCAN
SET (IBKEY,IBKEYS)=IBRX_";"
+7 FOR
SET IBKEY=$ORDER(^IBA(351.5,"B",IBKEY))
if $EXTRACT(IBKEY,1,$LENGTH(IBKEYS))'=IBKEYS
QUIT
SET IBARR(IBKEY)=+$ORDER(^(IBKEY,0))
+8 IF '$DATA(IBARR)
WRITE !!,"This prescription has not yet been billed."
GOTO REVA
+9 ;
+10 ; - find all potential transactions
+11 DO FINDC^IBECUSMU(.IBARR,1,.IBCAN)
+12 SET IBKEY=$ORDER(IBCAN(""))
IF IBKEY=""
GOTO REVA
+13 ;
+14 ; - there's just one
+15 IF $ORDER(IBCAN(IBKEY))=""
SET IBCHTRN=IBCAN(IBKEY)
WRITE !!,$SELECT($PIECE(IBKEY,";",2):"Refill #"_$PIECE(IBKEY,";",2),1:"The original fill")," for this prescription can be cancelled."
GOTO OKAYC
+16 ;
+17 ; - more than 1; must select from the list
+18 WRITE !!,"More than one fill for rx# ",$$FILE^IBRXUTL(IBRX,.01)," may be cancelled."
+19 SET IBREF=$$SEL^IBECUSMU(.IBCAN)
+20 IF IBREF<0
GOTO REVQ
+21 ;
+22 SET IBKEY=IBRX_";"_IBREF
SET IBCHTRN=IBCAN(IBKEY)
+23 ;
OKAYC ; - okay to cancel?
+1 SET DIR("A")="Is it okay to cancel this prescription"
+2 SET DIR(0)="Y"
DO ^DIR
KILL DIR
+3 IF 'Y!($DATA(DUOUT))!($DATA(DIRUT))
WRITE !,"The claim reversal was NOT submitted."
GOTO REVQ
+4 ;
+5 ; - queue cancellation for submittal
+6 SET ^IBA(351.5,"APOST",IBKEY)="REVERSE^^"_DUZ_"^"_IBCHTRN
+7 WRITE !,"The claim reversal has been submitted."
REVQ KILL DIROUT,DIRUT,DTOUR,DUOUT,IBRX,IBARR,IBCAN,IBKEY,IBKEYS,IBCHTRN,IBREF
+1 QUIT
+2 ;
+3 ;
+4 ;
RESUB ; Resubmit a claim to the Fiscal Intermediary.
+1 IF '$PIECE($GET(^IBE(350.9,1,9)),"^",4)
WRITE !!,"Please note that your TRICARE Pharmacy billing interface is not running!",!
RESUBA NEW X
KILL DIC
SET DIC=52
SET DIC(0)="AEQMN"
SET DIC("A")="Enter the RX# you wish to resubmit: "
+1 WRITE !
DO DIC^PSODI(52,.DIC)
SET IBRX=+Y
KILL DIC
+2 IF Y<1!($DATA(DUOUT))!($DATA(DIRUT))
GOTO RESUBQ
+3 SET DFN=$$FILE^IBRXUTL(+Y,2)
+4 WRITE !!,"Prescription: ",$$FILE^IBRXUTL(IBRX,.01),!," Patient: ",$PIECE($GET(^DPT(DFN,0)),"^")
+5 ;
+6 ; - find all potential transactions
+7 KILL IBBIL
DO FINDB^IBECUSMU(IBRX,1,.IBBIL)
+8 SET IBKEY=$ORDER(IBBIL(""))
IF IBKEY=""
GOTO RESUBA
+9 ;
+10 ; - there's just one
+11 IF $ORDER(IBBIL(IBKEY))=""
WRITE !!,$SELECT($PIECE(IBKEY,";",2):"Refill #"_$PIECE(IBKEY,";",2),1:"The original fill")," for this prescription can be billed."
GOTO IBPSR
+12 ;
+13 ; - more than 1; must select from the list
+14 WRITE !!,"More than one fill for rx# ",$$FILE^IBRXUTL(IBRX,.01)," may be billed."
+15 SET IBREF=$$SEL^IBECUSMU(.IBBIL)
+16 IF IBREF<0
GOTO RESUBQ
+17 ;
+18 SET IBKEY=IBRX_";"_IBREF
+19 ;
IBPSR ;Ask for the Product Selection Reason
+1 NEW DIR,DIE,DR,X,Y,DA
+2 SET DIR("B")=$SELECT($PIECE($GET(^IBA(351.5,+IBBIL(IBKEY),0)),"^",10):$PIECE(^IBA(351.53,$PIECE(^(0),"^",10),0),"^"),1:0)
+3 SET DIR(0)="PO^351.53"
DO ^DIR
IF Y=-1
WRITE !,"The prescription was NOT submitted for billing."
GOTO RESUBQ
+4 SET DA=+$GET(IBBIL(IBKEY))
SET DIE="^IBA(351.5,"
SET DR=".10////"_(+Y)
DO ^DIE
+5 KILL DIR
OKAYB ; - okay to bill?
+1 SET DIR("A")="Is it okay to bill this prescription"
+2 SET DIR(0)="Y"
DO ^DIR
+3 IF 'Y!($DATA(DUOUT))!($DATA(DIRUT))
WRITE !,"The prescription was NOT submitted for billing."
GOTO RESUBQ
+4 ;
+5 if '$DATA(PSOPAR)
DO ^PSOLSET
+6 IF '$DATA(PSOLAP)
WRITE !!,*7,"The label printer is not defined!",!,"The prescription has NOT been submitted for billing."
GOTO RESUBQ
+7 SET ^IBA(351.5,"APOST",IBKEY)=PSOLAP_"^"_PSOSITE_"^"_DUZ_"^^"_$PIECE($GET(^IBA(351.5,+IBBIL(IBKEY),0)),"^",10)
+8 WRITE !,"The prescription has been submitted for billing."
+9 ;
RESUBQ KILL DIROUT,DIRUT,DTOUR,DUOUT,IBRX,DFN,IBBIL,IBKEY,IBREF
+1 KILL PSOBAR0,PSOBAR1,PSOBARS,PSOCLC,PSOCNT,PSODIV,PSODTCUT
+2 KILL PSOLAP,PSOPAR,PSOPAR7,PSOPRPAS,PSOSITE
+3 QUIT
+4 ;
+5 ;
+6 ;
DREJ ; Delete an entry from the Reject (#351.52) file.
+1 IF '$PIECE($GET(^IBE(350.9,1,9)),"^",4)
WRITE !!,"Please note that your TRICARE Pharmacy billing interface is not running!",!
DREJA NEW X
KILL DIC
SET DIC=52
SET DIC(0)="AEQMN"
SET DIC("A")="Enter the RX# of the rejected transmission: "
+1 WRITE !
DO DIC^PSODI(52,.DIC)
SET IBRX=+Y
KILL DIC
+2 IF Y<1!($DATA(DUOUT))!($DATA(DIRUT))
GOTO DREJQ
+3 WRITE !!,"Prescription: ",$PIECE(Y,"^",2),!," Patient: ",$$FILE^IBRXUTL(+Y,2,"E")
+4 ;
+5 ; - is there a reject entry for this prescription?
+6 KILL IBARR
SET (IBKEY,IBKEYS)=IBRX_";"
+7 FOR
SET IBKEY=$ORDER(^IBA(351.52,"B",IBKEY))
if $EXTRACT(IBKEY,1,$LENGTH(IBKEYS))'=IBKEYS
QUIT
SET IBARR(IBKEY)=+$ORDER(^(IBKEY,0))
+8 IF '$DATA(IBARR)
WRITE !!,"There is no reject entry for this prescription."
GOTO DREJA
+9 ;
+10 ; - select the reject entry to delete
+11 SET IBKEY=$ORDER(IBARR(""))
IF IBKEY=""
GOTO DREJA
+12 IF $ORDER(IBARR(IBKEY))=""
SET IBCHREF=+IBARR(IBKEY)
WRITE !!,$SELECT($PIECE(IBKEY,";",2):"Refill #"_$PIECE(IBKEY,";",2),1:"The original fill")," for this prescription has been rejected."
GOTO OKAYD
+13 ;
+14 ; - more than 1; must select from the list
+15 WRITE !!,"More than one fill for rx# ",$$FILE^IBRXUTL(IBRX,.01)," has a reject entry."
+16 SET IBREF=$$SEL^IBECUSMU(.IBARR)
+17 IF IBREF<0
GOTO DREJQ
+18 ;
+19 SET IBKEY=IBRX_";"_IBREF
SET IBCHREF=+$GET(IBARR(IBKEY))
+20 ;
OKAYD ; - okay to delete the reject?
+1 IF '$DATA(^IBA(351.52,IBCHREF,0))
KILL ^IBA(351.52,"B",IBKEY)
WRITE !!,"Sorry, can't find a reject for this prescription!"
GOTO DREJQ
+2 SET DIR("A")="Is it okay to delete this reject entry"
+3 SET DIR(0)="Y"
DO ^DIR
KILL DIR
+4 IF 'Y!($DATA(DUOUT))!($DATA(DIRUT))
WRITE !,"The reject entry was NOT deleted."
GOTO DREJQ
+5 ;
+6 ; - delete the entry
+7 SET DA=IBCHREF
SET DIK="^IBA(351.52,"
DO ^DIK
KILL DA,DIK
+8 WRITE !,"The reject entry has been deleted."
DREJQ KILL DIROUT,DIRUT,DTOUR,DUOUT,IBRX,IBARR,IBKEY,IBKEYS,IBCHREF,IBREF
+1 QUIT
