1 | IBTRKR31 ;ALB/AAS - CLAIMS TRACKING - DBLCHK RX FILLS ; 13-AUG-93
|
---|
2 | ;;2.0;INTEGRATED BILLING;**33,121,160,309,347**;21-MAR-94;Build 24
|
---|
3 | ;;Per VHA Directive 2004-038, this routine should not be modified.
|
---|
4 | ;
|
---|
5 | % ; -- Double check rx data routine
|
---|
6 | DBLCHK(IBTRN) ; -- double check rx before billing, input tracking id
|
---|
7 | N IBX,IBFILL,IBFILLD,IBRXN,IBTRND,IBRMARK,IBRXSTAT,IBDEA,IBDRUG,IBRXDATA,X,Y,IBY,IBDFN
|
---|
8 | S IBX=0
|
---|
9 | S IBTRND=$G(^IBT(356,+IBTRN,0)) I IBTRND="" G DBLCHKQ
|
---|
10 | S IBRXN=$P(IBTRND,"^",8),IBFILL=$P(IBTRND,"^",10),IBFILLD=""
|
---|
11 | ;
|
---|
12 | S IBDFN=$$FILE^IBRXUTL(IBRXN,2)
|
---|
13 | I IBFILL=0 S IBY=$$RXSEC^IBRXUTL(IBDFN,IBRXN),IBFILLD=$P(IBY,U,2)_U_$P(IBY,U,13)_U_$P(IBY,U,15)
|
---|
14 | I IBFILL>0 S IBY=$$ZEROSUB^IBRXUTL(IBDFN,IBRXN,IBFILL),IBFILLD=$P(IBY,U,1)_U_$P(IBY,U,18)_U_$P(IBY,U,16)
|
---|
15 | ;
|
---|
16 | I (IBFILL'>0&(IBFILL'=0))!(IBRXN<1) S IBRMARK="INVALID PRESCRIPTION ENTRY" G DBLCHKQ
|
---|
17 | ;
|
---|
18 | S IBRXDATA=$$RXZERO^IBRXUTL(IBDFN,IBRXN),IBRXSTAT=$P(IBRXDATA,"^",15)
|
---|
19 | ;S DFN=+$P(IBRXDATA,"^",2),IBDT=+IBFILLD
|
---|
20 | ;I IBDT=$P($O(^DPT(DFN,"S",(IBDT-.00001))),".") S IBRMARK="REFILL ON VISIT DATE" G DBLCHKQ
|
---|
21 | ;
|
---|
22 | ; -- check rx status (not deleted)
|
---|
23 | I IBRXSTAT=13 S IBRMARK="PRESCRIPTION DELETED" G DBLCHKQ
|
---|
24 | ;
|
---|
25 | ; -- refill not released or returned to stock
|
---|
26 | I '$P(IBFILLD,"^",2) S IBRMARK="PRESCRIPTION NOT RELEASED" G DBLCHKQ
|
---|
27 | I $P(IBFILLD,"^",3) S IBRMARK="PRESCRIPTION NOT RELEASED" G DBLCHKQ
|
---|
28 | ;
|
---|
29 | ; -- check drug (not investigational, supply, or over the counter drug
|
---|
30 | S IBDRUG=$P(IBRXDATA,"^",6)
|
---|
31 | D ZERO^IBRXUTL(IBDRUG)
|
---|
32 | S IBDEA=$G(^TMP($J,"IBDRUG",+IBDRUG,3))
|
---|
33 | I IBDEA["I"!(IBDEA["S")!(IBDEA["9") S IBRMARK="DRUG NOT BILLABLE" G DBLCHKQ ; investigational drug, supply or otc
|
---|
34 | ;
|
---|
35 | S IBX=1
|
---|
36 | K ^TMP($J,"IBDRUG")
|
---|
37 | ;
|
---|
38 | DBLCHKQ I $G(IBRMARK)]"" D
|
---|
39 | .S IBRMARK=$O(^IBE(356.8,"B",IBRMARK,0)) I 'IBRMARK S IBRMARK=999
|
---|
40 | .N DA,DR,DIC,DIE
|
---|
41 | .L +^IBT(356,+IBTRN):5 I '$T Q
|
---|
42 | .S DA=IBTRN,DIE="^IBT(356,",DR=".19////"_IBRMARK
|
---|
43 | .D ^DIE
|
---|
44 | .L -^IBT(356,+IBTRN)
|
---|
45 | Q IBX
|
---|
46 | ;
|
---|
47 | ;
|
---|
48 | BULL ; -- send bulletin
|
---|
49 | ;
|
---|
50 | S XMSUB="Rx Refills added to Claims Tracking Complete"
|
---|
51 | S IBT(1)="The process to automatically add Rx Refills has successfully completed."
|
---|
52 | S IBT(1.1)=""
|
---|
53 | S IBT(2)=" Start Date: "_$$DAT1^IBOUTL(IBTSBDT)
|
---|
54 | S IBT(3)=" End Date: "_$$DAT1^IBOUTL(IBTSEDT)
|
---|
55 | I $D(IBMESS) S IBT(3.1)=IBMESS
|
---|
56 | S IBT(4)=""
|
---|
57 | S IBT(5)=" Total Rx fills checked: "_$G(IBCNT)
|
---|
58 | S IBT(6)="Total NSC Rx fills Added: "_$G(IBCNT1)
|
---|
59 | S IBT(7)=" Total SC Rx fills Added: "_$G(IBCNT2)
|
---|
60 | S IBT(8)=""
|
---|
61 | S IBT(9)="*The fills added as SC require determination and editing to be billed"
|
---|
62 | D SEND
|
---|
63 | BULLQ Q
|
---|
64 | ;
|
---|
65 | SEND S XMDUZ="INTEGRATED BILLING PACKAGE",XMTEXT="IBT("
|
---|
66 | K XMY S XMN=0
|
---|
67 | S XMY(DUZ)=""
|
---|
68 | D ^XMD
|
---|
69 | K X,Y,IBI,IBT,IBGRP,XMDUZ,XMTEXT,XMY,XMSUB
|
---|
70 | Q
|
---|