source: FOIAVistA/trunk/r/INTEGRATED_BILLING-IB-PRQ--IBD--IBQ--PRQS/IBECUS3.m@ 1801

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

initial load of FOIAVistA 6/30/08 version
File size: 3.1 KB
Line 
1IBECUS3 ;RLM/DVAMC - CANCEL TRICARE PHARMACY TRANSACTION ; 14-AUG-96
2 ;;2.0;INTEGRATED BILLING;**52,89,240**;21-MAR-94
3 ;
4EN ; Transmit a cancellation transaction.
5 ; Input: IBKEY -- 1 ; 2, where
6 ; 1 = Pointer to the prescription in file #52
7 ; 2 = Pointer to the refill in file #52.1, or
8 ; 0 for the original fill
9 ; IBKEYD -- 1 ^ 2 ^ 3 ^ 4, where
10 ; 1 = Rx label printing device
11 ; 2 = Pointer to the Pharmacy in file #59
12 ; 3 = Pointer to the Pharmacy user in file #200
13 ; 4 = Pointer to the billing transaction
14 ; in file #351.5 (cancellations only)
15 ;
16 ; - bleed off queue
17 F R *IBI:0 Q:IBI=-1
18 ;
19 ; - get rx data; make sure there is an NDC
20 K IBDRX,IBERR
21 I $$TRANS^PSOCPTRI(+IBKEY,+$P(IBKEY,";",2),.IBDRX)<0 S IBERR=1 G ENQ
22 ;
23 ; - must be a billing transaction for the cancellation
24 S IBCHTRN=+$P(IBKEYD,"^",4)
25 S IBCHTRND=$G(^IBA(351.5,IBCHTRN,0))
26 I 'IBCHTRND S IBERR=8 G ENQ
27 S DFN=+$P(IBCHTRND,"^",2)
28 I 'DFN S IBERR=4 G ENQ
29 ;
30 ; - is patient covered by TRICARE?
31 S IBCDFN=$$CUS^IBACUS(DFN,DT)
32 I 'IBCDFN S IBERR=2 G ENQ
33 ;
34 ; - get the BIN Number for the insurance company
35 S IBCDFND=$G(^DPT(DFN,.312,IBCDFN,0))
36 S IBBIN=$P($G(^DIC(36,+IBCDFND,3)),"^",3)
37 I $L(IBBIN)'=6 S IBERR=5 G ENQ
38 ;
39 ; - build transmission:
40 ; o pharmacy division
41 ; o FI identifier (bin number)
42 ; o commercial software package version (32)
43 ; o cancellation transaction code (11)
44 ; o control # (currently 10 spaces)
45 ; o pharmacy # (currently 12 spaces)
46 ; o rx fill date
47 ; o prescription number
48 ;
49 ; (pharmacy number [abp] ??)
50 ; S JADNUM=$S($P(JADPSRX(2),"^",9)=1:7745017,1:7745029),JADLEN=12 D LJUST^JADNC S JADNABP=JADNUM
51 ;
52 S IBLINE(1)=$$FILL^IBECUS2(IBDRX("DIV"),2)_IBBIN_"3211"_$J("",10)_$J("",12)
53 S IBLINE(1)=IBLINE(1)_$$DATE^IBECUS2(IBDRX("FDT"))
54 S IBLINE(1)=IBLINE(1)_$$FILL^IBECUS2(IBDRX("RX#"),7)
55 ;
56 ; - transmit
57 W IBLINE(1),!
58 ;
59 ; - receive
60 R IBRESP(1)#100:120 I '$L(IBRESP(1)) S IBERR=6 G ENQ
61 ;
62 ; - handle errors
63 I $E(IBRESP(1),1,3) D ERROR^IBECUS22 G ENQ
64 ;
65 ; - handle rejects
66 S IBRESP(1)=$E(IBRESP(1),3,999)
67 I $E(IBRESP(1),5)="R" D REJECT G ENQ
68 ;
69 ; - update cancellation auth number and user
70 S ^IBA(351.5,IBCHTRN,6)=$E(IBRESP(1),6,19)_"^"_+$P(IBKEYD,"^",3)
71 K ^IBA(351.5,"APOST",IBKEY)
72 ;
73 ; - Queue task to cancel charges
74 D TASK^IBECUS2("RXCAN;Rx Cancellation")
75 ;
76ENQ I $G(IBERR) D ERROR^IBECUS22
77 Q
78 ;
79 ;
80REJECT ; Send alert for a reject.
81 S IBREJ=""
82 F IBRJ=8:2 S IBRJA=$E(IBRESP(1),IBRJ,IBRJ+1) Q:IBRJA=" "!(IBRJA="") D
83 .S IBERRP=$$ERRIEN^IBECUS22("UNIVERSAL",IBRJA)
84 .I IBERRP S IBREJ=IBREJ_","_IBERRP
85 S IBREJ=$E(IBREJ,2,999)
86 ;
87 S XQA("G.IB CHAMP RX REJ")="",XQA(+$P(IBKEYD,"^",3))=""
88 S XQAMSG="Reversal for prescription #"_IBDRX("RX#")_" rejected for reason #"_IBREJ
89 S XQADATA=IBDRX("RX#")_"^"_IBREJ_"^"_DFN,XQAROU="DISP^IBECUS22"
90 D SETUP^XQALERT
91 ;
92 ; - update transaction file with reject codes
93 S $P(^IBA(351.5,IBCHTRN,6),"^",3)=IBREJ
94 ;
95 K IBERRP,IBREJ,IBRJ,IBRJA
96 Q
Note: See TracBrowser for help on using the repository browser.