| 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
|
---|