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