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

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

initial load of WorldVistAEHR

File size: 2.6 KB
RevLine 
[613]1IBTRKR31 ;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
6DBLCHK(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 ;
38DBLCHKQ 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 ;
48BULL ; -- 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
63BULLQ Q
64 ;
65SEND 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
Note: See TracBrowser for help on using the repository browser.