- IBTRKR31 ;ALB/AAS - CLAIMS TRACKING - DBLCHK RX FILLS ; 13-AUG-93
- ;;2.0;INTEGRATED BILLING;**33,121,160,309,347,405**;21-MAR-94;Build 4
- ;;Per VHA Directive 2004-038, 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,IBY,IBDFN
- S IBX=0
- S IBTRND=$G(^IBT(356,+IBTRN,0)) I IBTRND="" G DBLCHKQ
- S IBRXN=$P(IBTRND,"^",8),IBFILL=$P(IBTRND,"^",10),IBFILLD=""
- ;
- S IBDFN=$$FILE^IBRXUTL(IBRXN,2)
- I IBFILL=0 S IBY=$$RXSEC^IBRXUTL(IBDFN,IBRXN),IBFILLD=$P(IBY,U,2)_U_$P(IBY,U,13)_U_$P(IBY,U,15)
- 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)
- ;
- I (IBFILL'>0&(IBFILL'=0))!(IBRXN<1) S IBRMARK="INVALID PRESCRIPTION ENTRY" G DBLCHKQ
- ;
- S IBRXDATA=$$RXZERO^IBRXUTL(IBDFN,IBRXN),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
- ;
- ; -- refill not released or returned to stock
- I '$P(IBFILLD,"^",2) S IBRMARK="PRESCRIPTION NOT RELEASED" G DBLCHKQ
- I $P(IBFILLD,"^",3) S IBRMARK="PRESCRIPTION NOT RELEASED" G DBLCHKQ
- ;
- ; -- check drug (not investigational, supply, or over the counter drug
- S IBDRUG=$P(IBRXDATA,"^",6)
- D ZERO^IBRXUTL(IBDRUG)
- S IBDEA=$G(^TMP($J,"IBDRUG",+IBDRUG,3))
- I IBDEA["I"!(IBDEA["S")!(IBDEA["9")!(IBDEA["N") S IBRMARK="DRUG NOT BILLABLE" G DBLCHKQ ; investigational drug, supply or otc
- ;
- S IBX=1
- K ^TMP($J,"IBDRUG")
- ;
- 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
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HIBTRKR31 2745 printed Mar 13, 2025@21:33:39 Page 2
- IBTRKR31 ;ALB/AAS - CLAIMS TRACKING - DBLCHK RX FILLS ; 13-AUG-93
- +1 ;;2.0;INTEGRATED BILLING;**33,121,160,309,347,405**;21-MAR-94;Build 4
- +2 ;;Per VHA Directive 2004-038, 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,IBY,IBDFN
- +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)
- SET IBFILLD=""
- +5 ;
- +6 SET IBDFN=$$FILE^IBRXUTL(IBRXN,2)
- +7 IF IBFILL=0
- SET IBY=$$RXSEC^IBRXUTL(IBDFN,IBRXN)
- SET IBFILLD=$PIECE(IBY,U,2)_U_$PIECE(IBY,U,13)_U_$PIECE(IBY,U,15)
- +8 IF IBFILL>0
- SET IBY=$$ZEROSUB^IBRXUTL(IBDFN,IBRXN,IBFILL)
- SET IBFILLD=$PIECE(IBY,U,1)_U_$PIECE(IBY,U,18)_U_$PIECE(IBY,U,16)
- +9 ;
- +10 IF (IBFILL'>0&(IBFILL'=0))!(IBRXN<1)
- SET IBRMARK="INVALID PRESCRIPTION ENTRY"
- GOTO DBLCHKQ
- +11 ;
- +12 SET IBRXDATA=$$RXZERO^IBRXUTL(IBDFN,IBRXN)
- SET IBRXSTAT=$PIECE(IBRXDATA,"^",15)
- +13 ;S DFN=+$P(IBRXDATA,"^",2),IBDT=+IBFILLD
- +14 ;I IBDT=$P($O(^DPT(DFN,"S",(IBDT-.00001))),".") S IBRMARK="REFILL ON VISIT DATE" G DBLCHKQ
- +15 ;
- +16 ; -- check rx status (not deleted)
- +17 IF IBRXSTAT=13
- SET IBRMARK="PRESCRIPTION DELETED"
- GOTO DBLCHKQ
- +18 ;
- +19 ; -- refill not released or returned to stock
- +20 IF '$PIECE(IBFILLD,"^",2)
- SET IBRMARK="PRESCRIPTION NOT RELEASED"
- GOTO DBLCHKQ
- +21 IF $PIECE(IBFILLD,"^",3)
- SET IBRMARK="PRESCRIPTION NOT RELEASED"
- GOTO DBLCHKQ
- +22 ;
- +23 ; -- check drug (not investigational, supply, or over the counter drug
- +24 SET IBDRUG=$PIECE(IBRXDATA,"^",6)
- +25 DO ZERO^IBRXUTL(IBDRUG)
- +26 SET IBDEA=$GET(^TMP($JOB,"IBDRUG",+IBDRUG,3))
- +27 ; investigational drug, supply or otc
- IF IBDEA["I"!(IBDEA["S")!(IBDEA["9")!(IBDEA["N")
- SET IBRMARK="DRUG NOT BILLABLE"
- GOTO DBLCHKQ
- +28 ;
- +29 SET IBX=1
- +30 KILL ^TMP($JOB,"IBDRUG")
- +31 ;
- 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
