IBTRKR31 ;ALB/AAS - CLAIMS TRACKING - DBLCHK RX FILLS ; 13-AUG-93
;;Version 2.0 ; INTEGRATED BILLING ;; 21-MAR-94
;;Per VHA Directive 10-93-142, this routine should not be modified.
;
% ; -- Double check rx data routine
DBLCHK(IBTRN) ; -- double check rx before billing, input tracking id
N IBX,IBFILL,IBFILLD,IBRXN,IBTRND,IBRMARK,IBRXSTAT,IBDEA,IBDRUG,IBRXDATA,X,Y
S IBX=0
S IBTRND=$G(^IBT(356,+IBTRN,0)) I IBTRND="" G DBLCHKQ
S IBRXN=$P(IBTRND,"^",8),IBFILL=$P(IBTRND,"^",10)
S IBFILLD=$G(^PSRX(+IBRXN,1,+IBFILL,0))
;
I IBFILL<1!(IBRXN<1) S IBRMARK="INVALID PRESCRIPTION ENTRY" G DBLCHKQ
;
S IBRXDATA=$G(^PSRX(IBRXN,0)),IBRXSTAT=$P(IBRXDATA,"^",15)
S DFN=+$P(IBRXDATA,"^",2),IBDT=+IBFILLD
I IBDT=$P($O(^DPT(DFN,"S",(IBDT-.00001))),".") S IBRMARK="REFILL ON VISIT DATE" G DBLCHKQ
;
; -- check rx status (not deleted)
I IBRXSTAT=13 S IBRMARK="PRESCRIPTION DELETED" G DBLCHKQ
;
; -- Version 6 and refill not released or returned to stock
I +$G(^PS(59.7,1,49.99))'<6,'$P(IBFILLD,"^",18) S IBRMARK=4 G DBLCHKQ
I $P(IBFILLD,"^",16) S IBRMARK="PRESCRIPTION NOT RELEASED" G DBLCHKQ
;
; -- check drug (not investigational, supply, or over the counter drug
S IBDRUG=$P(IBRXDATA,"^",6)
S IBDEA=$P($G(^PSDRUG(+$P(IBRXDATA,"^",6),0)),"^",3)
I IBDEA["I"!(IBDEA["S")!(IBDEA["9") S IBRMARK="DRUG NOT BILLABLE" G DBLCHKQ ; investigational drug, supply or otc
;
S IBX=1
;
DBLCHKQ I $G(IBRMARK) D
.S IBRMARK=$O(^IBE(356.8,"B",IBRMARK,0)) I 'IBRMARK S IBRMARK=999
.N DA,DR,DIC,DIE
.L +^IBT(356,+IBTRN):5 I '$T Q
.S DA=IBTRN,DIE="^IBT(356,",DR=".19////"_IBRMARK
.D ^DIE
.L -^IBT(356,+IBTRN)
Q IBX
;
;
BULL ; -- send bulletin
;
S XMSUB="Rx Refills added to Claims Tracking Complete"
S IBT(1)="The process to automatically add Rx Refills has successfully completed."
S IBT(1.1)=""
S IBT(2)=" Start Date: "_$$DAT1^IBOUTL(IBTSBDT)
S IBT(3)=" End Date: "_$$DAT1^IBOUTL(IBTSEDT)
I $D(IBMESS) S IBT(3.1)=IBMESS
S IBT(4)=""
S IBT(5)=" Total Rx fills checked: "_$G(IBCNT)
S IBT(6)="Total NSC Rx fills Added: "_$G(IBCNT1)
S IBT(7)=" Total SC Rx fills Added: "_$G(IBCNT2)
S IBT(8)=""
S IBT(9)="*The fills added as SC require determination and editing to be billed"
D SEND
BULLQ Q
;
SEND S XMDUZ="INTEGRATED BILLING PACKAGE",XMTEXT="IBT("
K XMY S XMN=0
S XMY(DUZ)=""
D ^XMD
K X,Y,IBI,IBT,IBGRP,XMDUZ,XMTEXT,XMY,XMSUB
Q
IBTRKR31 ;ALB/AAS - CLAIMS TRACKING - DBLCHK RX FILLS ; 13-AUG-93
+1 ;;Version 2.0 ; INTEGRATED BILLING ;; 21-MAR-94
+2 ;;Per VHA Directive 10-93-142, this routine should not be modified.
+3 ;
% ; -- Double check rx data routine
DBLCHK(IBTRN) ; -- double check rx before billing, input tracking id
+1 NEW IBX,IBFILL,IBFILLD,IBRXN,IBTRND,IBRMARK,IBRXSTAT,IBDEA,IBDRUG,IBRXDATA,X,Y
+2 SET IBX=0
+3 SET IBTRND=$GET(^IBT(356,+IBTRN,0))
IF IBTRND=""
GOTO DBLCHKQ
+4 SET IBRXN=$PIECE(IBTRND,"^",8)
SET IBFILL=$PIECE(IBTRND,"^",10)
+5 SET IBFILLD=$GET(^PSRX(+IBRXN,1,+IBFILL,0))
+6 ;
+7 IF IBFILL<1!(IBRXN<1)
SET IBRMARK="INVALID PRESCRIPTION ENTRY"
GOTO DBLCHKQ
+8 ;
+9 SET IBRXDATA=$GET(^PSRX(IBRXN,0))
SET IBRXSTAT=$PIECE(IBRXDATA,"^",15)
+10 SET DFN=+$PIECE(IBRXDATA,"^",2)
SET IBDT=+IBFILLD
+11 IF IBDT=$PIECE($ORDER(^DPT(DFN,"S",(IBDT-.00001))),".")
SET IBRMARK="REFILL ON VISIT DATE"
GOTO DBLCHKQ
+12 ;
+13 ; -- check rx status (not deleted)
+14 IF IBRXSTAT=13
SET IBRMARK="PRESCRIPTION DELETED"
GOTO DBLCHKQ
+15 ;
+16 ; -- Version 6 and refill not released or returned to stock
+17 IF +$GET(^PS(59.7,1,49.99))'<6
IF '$PIECE(IBFILLD,"^",18)
SET IBRMARK=4
GOTO DBLCHKQ
+18 IF $PIECE(IBFILLD,"^",16)
SET IBRMARK="PRESCRIPTION NOT RELEASED"
GOTO DBLCHKQ
+19 ;
+20 ; -- check drug (not investigational, supply, or over the counter drug
+21 SET IBDRUG=$PIECE(IBRXDATA,"^",6)
+22 SET IBDEA=$PIECE($GET(^PSDRUG(+$PIECE(IBRXDATA,"^",6),0)),"^",3)
+23 ; investigational drug, supply or otc
IF IBDEA["I"!(IBDEA["S")!(IBDEA["9")
SET IBRMARK="DRUG NOT BILLABLE"
GOTO DBLCHKQ
+24 ;
+25 SET IBX=1
+26 ;
DBLCHKQ IF $GET(IBRMARK)
Begin DoDot:1
+1 SET IBRMARK=$ORDER(^IBE(356.8,"B",IBRMARK,0))
IF 'IBRMARK
SET IBRMARK=999
+2 NEW DA,DR,DIC,DIE
+3 LOCK +^IBT(356,+IBTRN):5
IF '$TEST
QUIT
+4 SET DA=IBTRN
SET DIE="^IBT(356,"
SET DR=".19////"_IBRMARK
+5 DO ^DIE
+6 LOCK -^IBT(356,+IBTRN)
End DoDot:1
+7 QUIT IBX
+8 ;
+9 ;
BULL ; -- send bulletin
+1 ;
+2 SET XMSUB="Rx Refills added to Claims Tracking Complete"
+3 SET IBT(1)="The process to automatically add Rx Refills has successfully completed."
+4 SET IBT(1.1)=""
+5 SET IBT(2)=" Start Date: "_$$DAT1^IBOUTL(IBTSBDT)
+6 SET IBT(3)=" End Date: "_$$DAT1^IBOUTL(IBTSEDT)
+7 IF $DATA(IBMESS)
SET IBT(3.1)=IBMESS
+8 SET IBT(4)=""
+9 SET IBT(5)=" Total Rx fills checked: "_$GET(IBCNT)
+10 SET IBT(6)="Total NSC Rx fills Added: "_$GET(IBCNT1)
+11 SET IBT(7)=" Total SC Rx fills Added: "_$GET(IBCNT2)
+12 SET IBT(8)=""
+13 SET IBT(9)="*The fills added as SC require determination and editing to be billed"
+14 DO SEND
BULLQ QUIT
+1 ;
SEND SET XMDUZ="INTEGRATED BILLING PACKAGE"
SET XMTEXT="IBT("
+1 KILL XMY
SET XMN=0
+2 SET XMY(DUZ)=""
+3 DO ^XMD
+4 KILL X,Y,IBI,IBT,IBGRP,XMDUZ,XMTEXT,XMY,XMSUB
+5 QUIT
