BPSNCPD1 ;BHAM ISC/LJE - Pharmacy API part 2 ;06/16/2004
;;1.0;E CLAIMS MGMT ENGINE;**1,3,5,6,7,8,9,10,11,15,19,28**;JUN 2004;Build 22
;;Per VA Directive 6402, this routine should not be modified.
;
; Call to $$NCPDPQTY^PSSBPSUT supported by IA# 4992
; Call to $$RXRLDT^PSOBPSUT supported by IA# 4701
; Call to PSS^PSO59 supported by IA# 4827
; Call to ^XMD supported by IA# 10070
; Call to PRIORITY^XMXEDIT supported by IA# 2730
;
; Procedure STARRAY - Retrieve information for API call to IB and store in BPSARRY
; Incoming Parameters
; BRXIEN - Prescription IEN
; BFILL - Fill Number
; BWHERE - RX action
; BPSARRY - Array that is built (passed by reference)
; BPSITE - OUTPATIENT SITE file #59 ien
; DOS - Date of Service
; BILLNDC - NDC
; Assumed
; DFN - Patient IEN
; DUZ - User IEN
STARRAY(BRXIEN,BFILL,BWHERE,BPSARRY,BPSITE,DOS,BILLNDC) ;
N DRUGIEN,BPARR,BPSARR,QTY
D RXAPI^BPSUTIL1(BRXIEN,"6;7;8;17;31;32.4","BPARR","I")
I BFILL>0 D RXSUBF^BPSUTIL1(BRXIEN,52,52.1,BFILL,"1;1.1;1.2;17;24","BPARR","I")
S BPSARRY("DFN")=DFN
S BPSARRY("DAYS SUPPLY")=$S(BFILL=0:$G(BPARR(52,BRXIEN,8,"I")),1:$G(BPARR(52.1,BFILL,1.1,"I")))
S BPSARRY("IEN")=BRXIEN
S BPSARRY("FILL NUMBER")=BFILL
S BPSARRY("NDC")=BILLNDC
S (BPSARRY("DRUG"),DRUGIEN)=BPARR(52,BRXIEN,6,"I")
S BPSARRY("DEA")=$$DRUGDIE^BPSUTIL1(DRUGIEN,3)
S BPSARRY("COST")=$S(BFILL=0:$G(BPARR(52,BRXIEN,17,"I")),1:$G(BPARR(52.1,BFILL,1.2,"I")))
S BPSARRY("QTY")=$S(BFILL=0:$G(BPARR(52,BRXIEN,7,"I")),1:$G(BPARR(52.1,BFILL,1,"I")))
S BPSARRY("UNITS")=$$DRUGDIE^BPSUTIL1(DRUGIEN,14.5)
; Get the NCPDP quantity and units
S QTY=$$NCPDPQTY^PSSBPSUT(DRUGIEN,BPSARRY("QTY")) ; DBIA# 4992
I +QTY>0 D
. S BPSARRY("NCPDP QTY")=+QTY ; NCPDP Quantity
. S BPSARRY("NCPDP UNITS")=$P(QTY,U,2) ; NCPDP Unit
S BPSARRY("DOS")=DOS
S BPSARRY("RELEASE DATE")=$S(BFILL=0:$G(BPARR(52,BRXIEN,31,"I")),1:$G(BPARR(52.1,BFILL,17,"I")))
S BPSARRY("SC/EI OVR")=0
I BFILL=0 S BPSARRY("ACT DTY OVR")=$G(BPARR(52,BRXIEN,32.4,"I"))
E S BPSARRY("ACT DTY OVR")=$G(BPARR(52.1,BFILL,24,"I"))
; Determine BPS PHARMACY
I $G(BPSITE)>0 S BPSARRY("EPHARM")=$$GETPHARM^BPSUTIL(BPSITE)
;
; Add user so that it is stored correctly in the IB Event Log
; Note: Auto-Reversals (AREV) and CMOP/OPAI (CR*/PC) use postmaster (.5)
I ",AREV,CRLB,CRLX,CRLR,CRRL,PC,"[(","_BWHERE_",") S BPSARRY("USER")=.5
E S BPSARRY("USER")=DUZ
Q
;
; Called by BPSNCPDP to display progress of claim
; BRXIEN = Prescription IEN
; BFILL = Fill Number
; REBILL = rebill flag
; REVONLY = reversal only flag
; BPSTART = date/time
; BWHERE = RX Action (see BPSNCPDP comments above for details)
; BPREQIEN = the BPS REQUESTS (#9002313.77) IEN
; BPSCOB = Primary/Secondary claim indicator
; BPSELIG = Eligibility
; IEN59 = RXIEN
; WFLG = Write flag (1-Write Messages, 2-Do not display messages (this will still
; process until the claim completes or ECME timeout is hit).
;
STATUS(BRXIEN,BFILL,REBILL,REVONLY,BPSTART,BWHERE,BPREQIEN,BPSCOB,BPSELIG,IEN59,WFLG) ;
; Initialization
N CERTUSER,BPSTO,END,IBSEQ,BPQ,CLMSTAT,OCLMSTAT,BPACTTYP
;
S BPACTTYP=$$ACTTYPE^BPSOSRX5(BWHERE)
S (CLMSTAT,OCLMSTAT)=0
;
; Set CERTUSER to true if this user is the certifier
S CERTUSER=^BPS(9002313.99,1,"CERTIFIER")=DUZ
;
; Write Rebill and Status Messages
;
I WFLG=1 W !!,"Claim Status: "
I REBILL,BPACTTYP="UC",WFLG=1 W !,"Reversing and Rebilling a previously submitted claim..." ;,!,"Reversing..."
I REBILL,BPACTTYP="U",WFLG=1 W !,"Reversing..."
;
; Get the ECME Timeout and set the display timeout
S BPSTO=$$GET1^DIQ(9002313.99,"1,",3.01),END=$S(CERTUSER:50,$G(BPSTO)]"":BPSTO,1:5)
;
; For remaining time, loop through and display status
S BPQ=0
F IBSEQ=1:1:END D Q:BPQ=1
. H 1
. ;
. ; Get status of resubmit, last update, and claim status
. S CLMSTAT=$$STATUS^BPSOSRX(BRXIEN,BFILL,1,$G(BPREQIEN),BPSCOB)
. ;
. ; Format status message
. S CLMSTAT=$P(CLMSTAT,"^",1)_$S($P(CLMSTAT,"^",1)["IN PROGRESS":"-"_$P(CLMSTAT,"^",3),1:"")
. ;
. ;If the status has changed, display the new message
. I OCLMSTAT'=CLMSTAT W:WFLG=1 !,CLMSTAT S OCLMSTAT=CLMSTAT I CLMSTAT="E REJECTED",$G(BPSELIG)'="V",WFLG=1 D
.. N BPSRTEXT,BPSRESP,BPSPOS,X
.. S BPSRESP=$P($G(^BPST(IEN59,0)),"^",5) Q:'BPSRESP
.. S BPSPOS=+$O(^BPSR(BPSRESP,1000,":"),-1) Q:'BPSPOS
.. D REJTEXT^BPSOS03(BPSRESP,BPSPOS,.BPSRTEXT)
.. S X=0 F S X=$O(BPSRTEXT(X)) Q:'X W !?4,$P(BPSRTEXT(X),":")," - ",$P(BPSRTEXT(X),":",2)
. ;
. ; If the status is not IN PROGRESS, then we are done
. I CLMSTAT'["IN PROGRESS",'$D(^BPS(9002313.77,"D",BRXIEN,BFILL,BPSCOB)) S BPQ=1
I WFLG=1 W !
Q
;
BULL(RXI,RXR,SITE,DFN,PATNAME,BPST,BPSERTXT,BPSRESP,COB) ; Send a Bulletin to the OPECC
; Input:
; RXI -> IEN of the Rx
; RXR -> Refill #
; SITE -> Site IEN
; DFN -> Patient IEN
; PATNAME -> Patient name
; BPST -> TRICARE/CHAMPVA indicator (T = TRICARE, C = CHAMPVA)
; BPSERTXT -> Claim status/error text
; BPSRESP -> Response flag; used in BULL1 below to determine
; whether to add addition text to the message.
; COB -> Coordination of Benefits indicator
;
; If the Rx-fill has been released, then don't send a message (esg - 12/20/12 - BPS*1*15)
I $$RXRLDT^PSOBPSUT($G(RXI),$G(RXR)) G BULLX ; DBIA# 4701
;
N BTXT,XMSUB,XMY,XMTEXT,XMDUZ,SSN,X,SITENM
I $G(SITE) D
. K ^TMP($J,"BPSARR")
. D PSS^PSO59(SITE,,"BPSARR") ; DBIA# 4827
. S SITENM=$G(^TMP($J,"BPSARR",SITE,.01))
I $G(DFN) D
. S X=$P($G(^DPT(DFN,0)),U,9)
. S SSN=$E(X,$L(X)-3,$L(X))
;
; Need to do in the background
; Mailman calls CMOP which calls EN^BPSNCPDP.
; If BPSNCPDP* (same process) then calls mailman, it gets confused.
N ZTIO,ZTRTN,ZTDTH,ZTSAVE,ZTDESC
N %,%H,%I,X
D NOW^%DTC
S ZTIO="",ZTDTH=%,ZTDESC="IN PROGRESS BULLETIN"
S (ZTSAVE("RXR"),ZTSAVE("RXI"),ZTSAVE("BPSERTXT"))="",ZTSAVE("BPSRESP")=""
S (ZTSAVE("SITENM"),ZTSAVE("PATNAME"),ZTSAVE("SSN"),ZTSAVE("BPST"))=""
S ZTSAVE("COB")=""
S ZTRTN="BULL1^BPSNCPD1"
D ^%ZTLOAD
BULLX ;
Q
;
;
BULL1 ;
N BPSRX,BPSL,XMDUZ,XMY,BPSX,XMZ,XMSUB,BPTYPE,BPSUB,IEN59,ECMENUM
S BPSL=0,BPSRX=$$RXAPI1^BPSUTIL1(RXI,.01,"E")
S BPTYPE=$S($G(BPST)="T":"TRICARE",$G(BPST)="C":"CHAMPVA",1:"")
S ECMENUM=""
S IEN59=$$IEN59^BPSOSRX(RXI,RXR,COB)
I IEN59 S ECMENUM=$$ECMENUM^BPSSCRU2(IEN59)
S XMSUB=BPTYPE_" RX not processed for site "_$G(SITENM)
I $G(BPST)]"" D
. S BPSL=BPSL+1,BPSX(BPSL)="Prescription "_BPSRX_" for fill number "_(+RXR)_" could not be filled because of a"
. S BPSL=BPSL+1,BPSX(BPSL)="delay in processing the third party claim. The Rx was placed on suspense"
. S BPSL=BPSL+1,BPSX(BPSL)="because "_BPTYPE_" Rx's may not be filled unless they have a payable third"
. S BPSL=BPSL+1,BPSX(BPSL)="party claim."
. S BPSL=BPSL+1,BPSX(BPSL)=" "
. S BPSL=BPSL+1,BPSX(BPSL)="Please monitor the progress of the claim. If the claim is eventually"
. S BPSL=BPSL+1,BPSX(BPSL)="returned as payable, the Rx label will be printed when Print from Suspense"
. S BPSL=BPSL+1,BPSX(BPSL)="occurs or it may be Pulled Early from Suspense. If a reject occurs, the"
. S BPSL=BPSL+1,BPSX(BPSL)="Rx will be placed in the appropriate section of the medication profile"
. S BPSL=BPSL+1,BPSX(BPSL)="and placed on the Pharmacy Reject Worklist."
;
I $G(BPSERTXT)'="" S BPSL=BPSL+1,BPSX(BPSL)=BPSERTXT
S BPSL=BPSL+1,BPSX(BPSL)=" "
I $G(BPSRESP)'=4 D
. S BPSL=BPSL+1,BPSX(BPSL)="For more information on this prescription's activity, please view the Claim Log"
. S BPSL=BPSL+1,BPSX(BPSL)="within View ePharmacy Rx (VER)."
. S BPSL=BPSL+1,BPSX(BPSL)=" "
S BPSL=BPSL+1,BPSX(BPSL)=BPTYPE_" Patient Name: "_$G(PATNAME)_" ("_$G(SSN)_")"
S BPSL=BPSL+1,BPSX(BPSL)="Prescription: "_BPSRX_" Fill: "_(+RXR)
S BPSL=BPSL+1,BPSX(BPSL)="ECME: "_ECMENUM
S BPSL=BPSL+1,BPSX(BPSL)="Drug Name: "_$$RXAPI1^BPSUTIL1(RXI,6,"E")
;
S XMDUZ="BPS PACKAGE",XMTEXT="BPSX("
;
S BPSUB=$S(BPTYPE="TRICARE":"G.BPS TRICARE",BPTYPE="CHAMPVA":"G.BPS CHAMPVA",1:"G.BPS OPECC")
S XMY(BPSUB)=""
;
I $G(DUZ)'<1 S XMY(DUZ)=""
D ^XMD ; IA# 10070
I $G(BPST)]"",$G(XMZ) D PRIORITY^XMXEDIT(XMZ) ; IA# 2730
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HBPSNCPD1 8375 printed Nov 22, 2024@17:01:25 Page 2
BPSNCPD1 ;BHAM ISC/LJE - Pharmacy API part 2 ;06/16/2004
+1 ;;1.0;E CLAIMS MGMT ENGINE;**1,3,5,6,7,8,9,10,11,15,19,28**;JUN 2004;Build 22
+2 ;;Per VA Directive 6402, this routine should not be modified.
+3 ;
+4 ; Call to $$NCPDPQTY^PSSBPSUT supported by IA# 4992
+5 ; Call to $$RXRLDT^PSOBPSUT supported by IA# 4701
+6 ; Call to PSS^PSO59 supported by IA# 4827
+7 ; Call to ^XMD supported by IA# 10070
+8 ; Call to PRIORITY^XMXEDIT supported by IA# 2730
+9 ;
+10 ; Procedure STARRAY - Retrieve information for API call to IB and store in BPSARRY
+11 ; Incoming Parameters
+12 ; BRXIEN - Prescription IEN
+13 ; BFILL - Fill Number
+14 ; BWHERE - RX action
+15 ; BPSARRY - Array that is built (passed by reference)
+16 ; BPSITE - OUTPATIENT SITE file #59 ien
+17 ; DOS - Date of Service
+18 ; BILLNDC - NDC
+19 ; Assumed
+20 ; DFN - Patient IEN
+21 ; DUZ - User IEN
STARRAY(BRXIEN,BFILL,BWHERE,BPSARRY,BPSITE,DOS,BILLNDC) ;
+1 NEW DRUGIEN,BPARR,BPSARR,QTY
+2 DO RXAPI^BPSUTIL1(BRXIEN,"6;7;8;17;31;32.4","BPARR","I")
+3 IF BFILL>0
DO RXSUBF^BPSUTIL1(BRXIEN,52,52.1,BFILL,"1;1.1;1.2;17;24","BPARR","I")
+4 SET BPSARRY("DFN")=DFN
+5 SET BPSARRY("DAYS SUPPLY")=$SELECT(BFILL=0:$GET(BPARR(52,BRXIEN,8,"I")),1:$GET(BPARR(52.1,BFILL,1.1,"I")))
+6 SET BPSARRY("IEN")=BRXIEN
+7 SET BPSARRY("FILL NUMBER")=BFILL
+8 SET BPSARRY("NDC")=BILLNDC
+9 SET (BPSARRY("DRUG"),DRUGIEN)=BPARR(52,BRXIEN,6,"I")
+10 SET BPSARRY("DEA")=$$DRUGDIE^BPSUTIL1(DRUGIEN,3)
+11 SET BPSARRY("COST")=$SELECT(BFILL=0:$GET(BPARR(52,BRXIEN,17,"I")),1:$GET(BPARR(52.1,BFILL,1.2,"I")))
+12 SET BPSARRY("QTY")=$SELECT(BFILL=0:$GET(BPARR(52,BRXIEN,7,"I")),1:$GET(BPARR(52.1,BFILL,1,"I")))
+13 SET BPSARRY("UNITS")=$$DRUGDIE^BPSUTIL1(DRUGIEN,14.5)
+14 ; Get the NCPDP quantity and units
+15 ; DBIA# 4992
SET QTY=$$NCPDPQTY^PSSBPSUT(DRUGIEN,BPSARRY("QTY"))
+16 IF +QTY>0
Begin DoDot:1
+17 ; NCPDP Quantity
SET BPSARRY("NCPDP QTY")=+QTY
+18 ; NCPDP Unit
SET BPSARRY("NCPDP UNITS")=$PIECE(QTY,U,2)
End DoDot:1
+19 SET BPSARRY("DOS")=DOS
+20 SET BPSARRY("RELEASE DATE")=$SELECT(BFILL=0:$GET(BPARR(52,BRXIEN,31,"I")),1:$GET(BPARR(52.1,BFILL,17,"I")))
+21 SET BPSARRY("SC/EI OVR")=0
+22 IF BFILL=0
SET BPSARRY("ACT DTY OVR")=$GET(BPARR(52,BRXIEN,32.4,"I"))
+23 IF '$TEST
SET BPSARRY("ACT DTY OVR")=$GET(BPARR(52.1,BFILL,24,"I"))
+24 ; Determine BPS PHARMACY
+25 IF $GET(BPSITE)>0
SET BPSARRY("EPHARM")=$$GETPHARM^BPSUTIL(BPSITE)
+26 ;
+27 ; Add user so that it is stored correctly in the IB Event Log
+28 ; Note: Auto-Reversals (AREV) and CMOP/OPAI (CR*/PC) use postmaster (.5)
+29 IF ",AREV,CRLB,CRLX,CRLR,CRRL,PC,"[(","_BWHERE_",")
SET BPSARRY("USER")=.5
+30 IF '$TEST
SET BPSARRY("USER")=DUZ
+31 QUIT
+32 ;
+33 ; Called by BPSNCPDP to display progress of claim
+34 ; BRXIEN = Prescription IEN
+35 ; BFILL = Fill Number
+36 ; REBILL = rebill flag
+37 ; REVONLY = reversal only flag
+38 ; BPSTART = date/time
+39 ; BWHERE = RX Action (see BPSNCPDP comments above for details)
+40 ; BPREQIEN = the BPS REQUESTS (#9002313.77) IEN
+41 ; BPSCOB = Primary/Secondary claim indicator
+42 ; BPSELIG = Eligibility
+43 ; IEN59 = RXIEN
+44 ; WFLG = Write flag (1-Write Messages, 2-Do not display messages (this will still
+45 ; process until the claim completes or ECME timeout is hit).
+46 ;
STATUS(BRXIEN,BFILL,REBILL,REVONLY,BPSTART,BWHERE,BPREQIEN,BPSCOB,BPSELIG,IEN59,WFLG) ;
+1 ; Initialization
+2 NEW CERTUSER,BPSTO,END,IBSEQ,BPQ,CLMSTAT,OCLMSTAT,BPACTTYP
+3 ;
+4 SET BPACTTYP=$$ACTTYPE^BPSOSRX5(BWHERE)
+5 SET (CLMSTAT,OCLMSTAT)=0
+6 ;
+7 ; Set CERTUSER to true if this user is the certifier
+8 SET CERTUSER=^BPS(9002313.99,1,"CERTIFIER")=DUZ
+9 ;
+10 ; Write Rebill and Status Messages
+11 ;
+12 IF WFLG=1
WRITE !!,"Claim Status: "
+13 ;,!,"Reversing..."
IF REBILL
IF BPACTTYP="UC"
IF WFLG=1
WRITE !,"Reversing and Rebilling a previously submitted claim..."
+14 IF REBILL
IF BPACTTYP="U"
IF WFLG=1
WRITE !,"Reversing..."
+15 ;
+16 ; Get the ECME Timeout and set the display timeout
+17 SET BPSTO=$$GET1^DIQ(9002313.99,"1,",3.01)
SET END=$SELECT(CERTUSER:50,$GET(BPSTO)]"":BPSTO,1:5)
+18 ;
+19 ; For remaining time, loop through and display status
+20 SET BPQ=0
+21 FOR IBSEQ=1:1:END
Begin DoDot:1
+22 HANG 1
+23 ;
+24 ; Get status of resubmit, last update, and claim status
+25 SET CLMSTAT=$$STATUS^BPSOSRX(BRXIEN,BFILL,1,$GET(BPREQIEN),BPSCOB)
+26 ;
+27 ; Format status message
+28 SET CLMSTAT=$PIECE(CLMSTAT,"^",1)_$SELECT($PIECE(CLMSTAT,"^",1)["IN PROGRESS":"-"_$PIECE(CLMSTAT,"^",3),1:"")
+29 ;
+30 ;If the status has changed, display the new message
+31 IF OCLMSTAT'=CLMSTAT
if WFLG=1
WRITE !,CLMSTAT
SET OCLMSTAT=CLMSTAT
IF CLMSTAT="E REJECTED"
IF $GET(BPSELIG)'="V"
IF WFLG=1
Begin DoDot:2
+32 NEW BPSRTEXT,BPSRESP,BPSPOS,X
+33 SET BPSRESP=$PIECE($GET(^BPST(IEN59,0)),"^",5)
if 'BPSRESP
QUIT
+34 SET BPSPOS=+$ORDER(^BPSR(BPSRESP,1000,":"),-1)
if 'BPSPOS
QUIT
+35 DO REJTEXT^BPSOS03(BPSRESP,BPSPOS,.BPSRTEXT)
+36 SET X=0
FOR
SET X=$ORDER(BPSRTEXT(X))
if 'X
QUIT
WRITE !?4,$PIECE(BPSRTEXT(X),":")," - ",$PIECE(BPSRTEXT(X),":",2)
End DoDot:2
+37 ;
+38 ; If the status is not IN PROGRESS, then we are done
+39 IF CLMSTAT'["IN PROGRESS"
IF '$DATA(^BPS(9002313.77,"D",BRXIEN,BFILL,BPSCOB))
SET BPQ=1
End DoDot:1
if BPQ=1
QUIT
+40 IF WFLG=1
WRITE !
+41 QUIT
+42 ;
BULL(RXI,RXR,SITE,DFN,PATNAME,BPST,BPSERTXT,BPSRESP,COB) ; Send a Bulletin to the OPECC
+1 ; Input:
+2 ; RXI -> IEN of the Rx
+3 ; RXR -> Refill #
+4 ; SITE -> Site IEN
+5 ; DFN -> Patient IEN
+6 ; PATNAME -> Patient name
+7 ; BPST -> TRICARE/CHAMPVA indicator (T = TRICARE, C = CHAMPVA)
+8 ; BPSERTXT -> Claim status/error text
+9 ; BPSRESP -> Response flag; used in BULL1 below to determine
+10 ; whether to add addition text to the message.
+11 ; COB -> Coordination of Benefits indicator
+12 ;
+13 ; If the Rx-fill has been released, then don't send a message (esg - 12/20/12 - BPS*1*15)
+14 ; DBIA# 4701
IF $$RXRLDT^PSOBPSUT($GET(RXI),$GET(RXR))
GOTO BULLX
+15 ;
+16 NEW BTXT,XMSUB,XMY,XMTEXT,XMDUZ,SSN,X,SITENM
+17 IF $GET(SITE)
Begin DoDot:1
+18 KILL ^TMP($JOB,"BPSARR")
+19 ; DBIA# 4827
DO PSS^PSO59(SITE,,"BPSARR")
+20 SET SITENM=$GET(^TMP($JOB,"BPSARR",SITE,.01))
End DoDot:1
+21 IF $GET(DFN)
Begin DoDot:1
+22 SET X=$PIECE($GET(^DPT(DFN,0)),U,9)
+23 SET SSN=$EXTRACT(X,$LENGTH(X)-3,$LENGTH(X))
End DoDot:1
+24 ;
+25 ; Need to do in the background
+26 ; Mailman calls CMOP which calls EN^BPSNCPDP.
+27 ; If BPSNCPDP* (same process) then calls mailman, it gets confused.
+28 NEW ZTIO,ZTRTN,ZTDTH,ZTSAVE,ZTDESC
+29 NEW %,%H,%I,X
+30 DO NOW^%DTC
+31 SET ZTIO=""
SET ZTDTH=%
SET ZTDESC="IN PROGRESS BULLETIN"
+32 SET (ZTSAVE("RXR"),ZTSAVE("RXI"),ZTSAVE("BPSERTXT"))=""
SET ZTSAVE("BPSRESP")=""
+33 SET (ZTSAVE("SITENM"),ZTSAVE("PATNAME"),ZTSAVE("SSN"),ZTSAVE("BPST"))=""
+34 SET ZTSAVE("COB")=""
+35 SET ZTRTN="BULL1^BPSNCPD1"
+36 DO ^%ZTLOAD
BULLX ;
+1 QUIT
+2 ;
+3 ;
BULL1 ;
+1 NEW BPSRX,BPSL,XMDUZ,XMY,BPSX,XMZ,XMSUB,BPTYPE,BPSUB,IEN59,ECMENUM
+2 SET BPSL=0
SET BPSRX=$$RXAPI1^BPSUTIL1(RXI,.01,"E")
+3 SET BPTYPE=$SELECT($GET(BPST)="T":"TRICARE",$GET(BPST)="C":"CHAMPVA",1:"")
+4 SET ECMENUM=""
+5 SET IEN59=$$IEN59^BPSOSRX(RXI,RXR,COB)
+6 IF IEN59
SET ECMENUM=$$ECMENUM^BPSSCRU2(IEN59)
+7 SET XMSUB=BPTYPE_" RX not processed for site "_$GET(SITENM)
+8 IF $GET(BPST)]""
Begin DoDot:1
+9 SET BPSL=BPSL+1
SET BPSX(BPSL)="Prescription "_BPSRX_" for fill number "_(+RXR)_" could not be filled because of a"
+10 SET BPSL=BPSL+1
SET BPSX(BPSL)="delay in processing the third party claim. The Rx was placed on suspense"
+11 SET BPSL=BPSL+1
SET BPSX(BPSL)="because "_BPTYPE_" Rx's may not be filled unless they have a payable third"
+12 SET BPSL=BPSL+1
SET BPSX(BPSL)="party claim."
+13 SET BPSL=BPSL+1
SET BPSX(BPSL)=" "
+14 SET BPSL=BPSL+1
SET BPSX(BPSL)="Please monitor the progress of the claim. If the claim is eventually"
+15 SET BPSL=BPSL+1
SET BPSX(BPSL)="returned as payable, the Rx label will be printed when Print from Suspense"
+16 SET BPSL=BPSL+1
SET BPSX(BPSL)="occurs or it may be Pulled Early from Suspense. If a reject occurs, the"
+17 SET BPSL=BPSL+1
SET BPSX(BPSL)="Rx will be placed in the appropriate section of the medication profile"
+18 SET BPSL=BPSL+1
SET BPSX(BPSL)="and placed on the Pharmacy Reject Worklist."
End DoDot:1
+19 ;
+20 IF $GET(BPSERTXT)'=""
SET BPSL=BPSL+1
SET BPSX(BPSL)=BPSERTXT
+21 SET BPSL=BPSL+1
SET BPSX(BPSL)=" "
+22 IF $GET(BPSRESP)'=4
Begin DoDot:1
+23 SET BPSL=BPSL+1
SET BPSX(BPSL)="For more information on this prescription's activity, please view the Claim Log"
+24 SET BPSL=BPSL+1
SET BPSX(BPSL)="within View ePharmacy Rx (VER)."
+25 SET BPSL=BPSL+1
SET BPSX(BPSL)=" "
End DoDot:1
+26 SET BPSL=BPSL+1
SET BPSX(BPSL)=BPTYPE_" Patient Name: "_$GET(PATNAME)_" ("_$GET(SSN)_")"
+27 SET BPSL=BPSL+1
SET BPSX(BPSL)="Prescription: "_BPSRX_" Fill: "_(+RXR)
+28 SET BPSL=BPSL+1
SET BPSX(BPSL)="ECME: "_ECMENUM
+29 SET BPSL=BPSL+1
SET BPSX(BPSL)="Drug Name: "_$$RXAPI1^BPSUTIL1(RXI,6,"E")
+30 ;
+31 SET XMDUZ="BPS PACKAGE"
SET XMTEXT="BPSX("
+32 ;
+33 SET BPSUB=$SELECT(BPTYPE="TRICARE":"G.BPS TRICARE",BPTYPE="CHAMPVA":"G.BPS CHAMPVA",1:"G.BPS OPECC")
+34 SET XMY(BPSUB)=""
+35 ;
+36 IF $GET(DUZ)'<1
SET XMY(DUZ)=""
+37 ; IA# 10070
DO ^XMD
+38 ; IA# 2730
IF $GET(BPST)]""
IF $GET(XMZ)
DO PRIORITY^XMXEDIT(XMZ)
+39 QUIT
