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

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

initial load of WorldVistAEHR
File size: 5.4 KB
Line 
1IBECUSM ;DVAMC/RLM - TRICARE PHARMACY BILLING OPTIONS; 20-AUG-96
2 ;;2.0;INTEGRATED BILLING;**52,162,240,347**;21-MAR-94;Build 24
3 ;;Per VHA Directive 2004-038, this routine should not be modified.
4 ;
5 ;
6REV ; Reverse a claim already submitted to the Fiscal Intermediary.
7 I '$P($G(^IBE(350.9,1,9)),"^",4) W !!,"Please note that your TRICARE Pharmacy billing interface is not running!",!
8REVA N X K DIC S DIC=52,DIC("A")="Enter the RX# you wish to reverse: ",DIC(0)="AEQMN"
9 W ! D DIC^PSODI(52,.DIC) S IBRX=+Y K DIC
10 I Y<1!($D(DUOUT))!($D(DIRUT)) G REVQ
11 W !!,"Prescription: ",$P(Y,"^",2),!," Patient: ",$$FILE^IBRXUTL(+Y,2,"E")
12 ;
13 ; - has this prescription been billed?
14 K IBARR,IBCAN S (IBKEY,IBKEYS)=IBRX_";"
15 F S IBKEY=$O(^IBA(351.5,"B",IBKEY)) Q:$E(IBKEY,1,$L(IBKEYS))'=IBKEYS S IBARR(IBKEY)=+$O(^(IBKEY,0))
16 I '$D(IBARR) W !!,"This prescription has not yet been billed." G REVA
17 ;
18 ; - find all potential transactions
19 D FINDC^IBECUSMU(.IBARR,1,.IBCAN)
20 S IBKEY=$O(IBCAN("")) I IBKEY="" G REVA
21 ;
22 ; - there's just one
23 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
24 ;
25 ; - more than 1; must select from the list
26 W !!,"More than one fill for rx# ",$$FILE^IBRXUTL(IBRX,.01)," may be cancelled."
27 S IBREF=$$SEL^IBECUSMU(.IBCAN)
28 I IBREF<0 G REVQ
29 ;
30 S IBKEY=IBRX_";"_IBREF,IBCHTRN=IBCAN(IBKEY)
31 ;
32OKAYC ; - okay to cancel?
33 S DIR("A")="Is it okay to cancel this prescription"
34 S DIR(0)="Y" D ^DIR K DIR
35 I 'Y!($D(DUOUT))!($D(DIRUT)) W !,"The claim reversal was NOT submitted." G REVQ
36 ;
37 ; - queue cancellation for submittal
38 S ^IBA(351.5,"APOST",IBKEY)="REVERSE^^"_DUZ_"^"_IBCHTRN
39 W !,"The claim reversal has been submitted."
40REVQ K DIROUT,DIRUT,DTOUR,DUOUT,IBRX,IBARR,IBCAN,IBKEY,IBKEYS,IBCHTRN,IBREF
41 Q
42 ;
43 ;
44 ;
45RESUB ; Resubmit a claim to the Fiscal Intermediary.
46 I '$P($G(^IBE(350.9,1,9)),"^",4) W !!,"Please note that your TRICARE Pharmacy billing interface is not running!",!
47RESUBA N X K DIC S DIC=52 S DIC(0)="AEQMN",DIC("A")="Enter the RX# you wish to resubmit: "
48 W ! D DIC^PSODI(52,.DIC) S IBRX=+Y K DIC
49 I Y<1!($D(DUOUT))!($D(DIRUT)) G RESUBQ
50 S DFN=$$FILE^IBRXUTL(+Y,2)
51 W !!,"Prescription: ",$$FILE^IBRXUTL(IBRX,.01),!," Patient: ",$P($G(^DPT(DFN,0)),"^")
52 ;
53 ; - find all potential transactions
54 K IBBIL D FINDB^IBECUSMU(IBRX,1,.IBBIL)
55 S IBKEY=$O(IBBIL("")) I IBKEY="" G RESUBA
56 ;
57 ; - there's just one
58 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
59 ;
60 ; - more than 1; must select from the list
61 W !!,"More than one fill for rx# ",$$FILE^IBRXUTL(IBRX,.01)," may be billed."
62 S IBREF=$$SEL^IBECUSMU(.IBBIL)
63 I IBREF<0 G RESUBQ
64 ;
65 S IBKEY=IBRX_";"_IBREF
66 ;
67IBPSR ;Ask for the Product Selection Reason
68 N DIR,DIE,DR,X,Y,DA
69 S DIR("B")=$S($P($G(^IBA(351.5,+IBBIL(IBKEY),0)),"^",10):$P(^IBA(351.53,$P(^(0),"^",10),0),"^"),1:0)
70 S DIR(0)="PO^351.53" D ^DIR I Y=-1 W !,"The prescription was NOT submitted for billing." G RESUBQ
71 S DA=+$G(IBBIL(IBKEY)),DIE="^IBA(351.5,",DR=".10////"_(+Y) D ^DIE
72 K DIR
73OKAYB ; - okay to bill?
74 S DIR("A")="Is it okay to bill this prescription"
75 S DIR(0)="Y" D ^DIR
76 I 'Y!($D(DUOUT))!($D(DIRUT)) W !,"The prescription was NOT submitted for billing." G RESUBQ
77 ;
78 D:'$D(PSOPAR) ^PSOLSET
79 I '$D(PSOLAP) W !!,*7,"The label printer is not defined!",!,"The prescription has NOT been submitted for billing." G RESUBQ
80 S ^IBA(351.5,"APOST",IBKEY)=PSOLAP_"^"_PSOSITE_"^"_DUZ_"^^"_$P($G(^IBA(351.5,+IBBIL(IBKEY),0)),"^",10)
81 W !,"The prescription has been submitted for billing."
82 ;
83RESUBQ K DIROUT,DIRUT,DTOUR,DUOUT,IBRX,DFN,IBBIL,IBKEY,IBREF
84 K PSOBAR0,PSOBAR1,PSOBARS,PSOCLC,PSOCNT,PSODIV,PSODTCUT
85 K PSOLAP,PSOPAR,PSOPAR7,PSOPRPAS,PSOSITE
86 Q
87 ;
88 ;
89 ;
90DREJ ; Delete an entry from the Reject (#351.52) file.
91 I '$P($G(^IBE(350.9,1,9)),"^",4) W !!,"Please note that your TRICARE Pharmacy billing interface is not running!",!
92DREJA N X K DIC S DIC=52 S DIC(0)="AEQMN",DIC("A")="Enter the RX# of the rejected transmission: "
93 W ! D DIC^PSODI(52,.DIC) S IBRX=+Y K DIC
94 I Y<1!($D(DUOUT))!($D(DIRUT)) G DREJQ
95 W !!,"Prescription: ",$P(Y,"^",2),!," Patient: ",$$FILE^IBRXUTL(+Y,2,"E")
96 ;
97 ; - is there a reject entry for this prescription?
98 K IBARR S (IBKEY,IBKEYS)=IBRX_";"
99 F S IBKEY=$O(^IBA(351.52,"B",IBKEY)) Q:$E(IBKEY,1,$L(IBKEYS))'=IBKEYS S IBARR(IBKEY)=+$O(^(IBKEY,0))
100 I '$D(IBARR) W !!,"There is no reject entry for this prescription." G DREJA
101 ;
102 ; - select the reject entry to delete
103 S IBKEY=$O(IBARR("")) I IBKEY="" G DREJA
104 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
105 ;
106 ; - more than 1; must select from the list
107 W !!,"More than one fill for rx# ",$$FILE^IBRXUTL(IBRX,.01)," has a reject entry."
108 S IBREF=$$SEL^IBECUSMU(.IBARR)
109 I IBREF<0 G DREJQ
110 ;
111 S IBKEY=IBRX_";"_IBREF,IBCHREF=+$G(IBARR(IBKEY))
112 ;
113OKAYD ; - okay to delete the reject?
114 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
115 S DIR("A")="Is it okay to delete this reject entry"
116 S DIR(0)="Y" D ^DIR K DIR
117 I 'Y!($D(DUOUT))!($D(DIRUT)) W !,"The reject entry was NOT deleted." G DREJQ
118 ;
119 ; - delete the entry
120 S DA=IBCHREF,DIK="^IBA(351.52," D ^DIK K DA,DIK
121 W !,"The reject entry has been deleted."
122DREJQ K DIROUT,DIRUT,DTOUR,DUOUT,IBRX,IBARR,IBKEY,IBKEYS,IBCHREF,IBREF
123 Q
Note: See TracBrowser for help on using the repository browser.