PSOBPSU1 ;BIRM/MFR - BPS (ECME) Utilities 1 ;29-May-2012 14:40;PLS
;;7.0;OUTPATIENT PHARMACY;**148,260,281,287,303,289,1015**;DEC 1997;Build 62
;Reference to $$EN^BPSNCPDP supported by IA 4415 & 4304
;References to $$NDCFMT^PSSNDCUT,$$GETNDC^PSSNDCUT supported by IA 4707
;References to $$ECMEON^BPSUTIL,$$CMOPON^BPSUTIL supported by IA 4410
;References to STORESP^IBNCPDP supported by IA 4299
;Modified - IHS/MSC/PLS - 05/20/2010 - Line REVERSE+8
; RELEASE+4
; ECMESND+20
ECMESND(RX,RFL,DATE,FROM,NDC,CMOP,RVTX,OVRC,CNDC,RESP,IGSW,ALTX,CLA,PA) ; - Sends Rx Release
;information to ECME/IB and updates NDC in the DRUG/PRESCRIPTION files; DBIA4304
;Input: (r) RX - Rx IEN (#52)
; (o) RFL - Refill # (Default: most recent)
; (r) DATE - Date of Service
; (r) FROM - Function within OP (See BWHERE param. in EN^BPSNCPDP api)
; (o) NDC - NDC Number (If not passed, will be retrieved from DRUG file)
; (o) CMOP - CMOP Prescription (1-YES/0-NO) (Default: 0)
; (o) RVTX - REVERSE text (e.g., RX EDIT, RX RELEASE-NDC CHANGE, etc)
; (o) OVRC - Set of 3 NCPDP override codes separated by "^":
; Piece 1: NCPDP Professional Service Code for overriding DUR REJECTS
; Piece 2: NCPDP Reason for Service Code for overriding DUR REJECTS
; Piece 3: NCPDP Result of Service Code for overriding DUR REJECTS
; (o) CNDC - Changed NDC? 1 - Yes / 0 - No (Default: NO)
; (o) IGSW - Ignore Switches (Master and CMOP)? 1 - Yes / 0 - No (Default: NO)
; (o) ALTX - Alternative Text to be placed in the Rx ECME Activity Log
; (o) CLA - NCPDP Clarification Code for overriding DUR/RTS REJECTS
; (o) PA - NCPDP Prior Authorization Type and Number (separated by "^")
;Output: RESP - Response from $$EN^BPSNCPDP api
;
Q ;IHS/MSC/PLS - 05/20/2010
N ACT,NDCACT,DA,PSOELIG
I '$D(RFL) S RFL=$$LSTRFL(RX)
; - ECME is not turned ON for the Rx's Division
I '$G(IGSW),'$$ECMEON^BPSUTIL($$RXSITE^PSOBPSUT(RX,RFL)) S RESP="-1^ECME SWITCH OFF" Q
; - ECME CMOP is not turned ON for the Rx's Division
I '$G(IGSW),$G(CMOP),'$$CMOPON^BPSUTIL($$RXSITE^PSOBPSUT(RX,RFL)) S RESP="-1^CMOP SWITCH OFF" Q
; - Saving the NDC to be displayed on the ECME Activity Log
I $G(CNDC) D
. I $G(NDC)'="" S NDCACT=NDC Q
. S NDCACT=$$GETNDC^PSONDCUT(RX,RFL)
I $$NDCFMT^PSSNDCUT($G(NDC))="" D
. S NDC=$$GETNDC^PSSNDCUT($$GET1^DIQ(52,RX,6,"I"),$$RXSITE^PSOBPSUT(RX,RFL),+$G(CMOP))
. I $G(NDC)'="" D SAVNDC^PSONDCUT(RX,RFL,NDC,+$G(CMOP),1)
S PPDU="",PPDU=$$GPPDU^PSONDCUT(RX,RFL,NDC,,1,FROM) K PPDU
; - Creating ECME Activity Log on the PRESCRIPTION file
S ACT="Submitted" I $$STATUS^PSOBPSUT(RX,RFL)="E PAYABLE" S ACT="Rev/Resubmit"
S ACT=ACT_" to ECME:"
; - Marked any 'unresolved' REJECTS as 'resolved' (Reason: 1 - Claim re-submitted)
N CLSCOM,COD1,COD2,COD3
S COD2=$P($G(OVRC),"^"),COD1=$P($G(OVRC),"^",2),COD3=$P($G(OVRC),"^",3)
I $G(COD3)'="" S CLSCOM="DUR Override Codes "_COD1_"/"_COD2_"/"_COD3_" submitted."
I $G(CLA)'="" S CLSCOM="Clarification Code "_$P(CLA,"^",2)_" submitted."
I $G(PA)'="" S CLSCOM="Prior Authorization Code ("_$P(PA,"^")_"/"_$P(PA,"^",2)_") submitted."
D CLSALL^PSOREJUT(RX,RFL,DUZ,1,$G(CLSCOM),$G(COD1),$G(COD2),$G(COD3),$S($G(CLA):$P(CLA,"^",2),1:""),$G(PA))
; - Call to ECME (NEWing STAT because ECME was overwriting it - Important variable for CMOP release PSXVND)
N STAT
I $G(RVTX)="",FROM="ED" S RVTX="RX EDITED"
I $G(CLA) S CLA=$P(CLA,"^")
S RESP=$$EN^BPSNCPDP(RX,RFL,$$DOS(RX,RFL,.DATE),FROM,NDC,$G(RVTX),$G(OVRC),,$G(CLA),$G(PA))
I $$STATUS^PSOBPSUT(RX,RFL)="E PAYABLE" D SAVNDC^PSONDCUT(RX,RFL,NDC,+$G(CMOP),1,FROM)
; - Reseting the Re-transmission flag
D RETRXF^PSOREJU2(RX,RFL,0)
; Storing eligibility flag
S PSOELIG=$P(RESP,"^",3) D:PSOELIG'="" ELIG^PSOBPSU2(RX,RFL,PSOELIG)
; - Logging ECME Activity Log to the PRESCRIPTION file
I $G(ALTX)="" D
. N X,ROUTE S (ROUTE,X)=""
. S ROUTE=$S(FROM="RF":$$GET1^DIQ(52.1,RFL_","_RX_",",2),FROM="OF":$$GET1^DIQ(52,RX_",",11),1:"")
. S:FROM="OF" X=ROUTE_" FILL(NDC:"_$$GETNDC^PSONDCUT(RX,RFL)_")"
. S:FROM="RF" X=ROUTE_" REFILL(NDC:"_$$GETNDC^PSONDCUT(RX,RFL)_")"
. S:FROM="RN" X="RX RENEWED(NDC:"_$$GETNDC^PSONDCUT(RX,RFL)_")"
. S:FROM="PL" X="PRINTED FROM SUSPENSE(NDC:"_$$GETNDC^PSONDCUT(RX,RFL)_")"
. S:FROM="PE"!(FROM="PP") X="PULLED FROM SUSPENSE(NDC:"_$$GETNDC^PSONDCUT(RX,RFL)_")"
. S:FROM="PC" X="CMOP TRANSMISSION(NDC:"_$$GETNDC^PSONDCUT(RX,RFL)_")"
. S:FROM="RRL" X="RELEASED RX PREVIOUSLY REVERSED"
. S:FROM="ED" X="RX EDITED"
. S:$G(RVTX)'="" X=RVTX
. S:$G(OVRC)'="" X="DUR OVERRIDE CODES("_$G(COD1)_"/"_$G(COD2)_"/"_$G(COD3)_")"
. S:$G(CNDC) X=X_"(NDC:"_NDCACT_")" S ACT=ACT_X
. S ACT=ACT_$$STS(RX,RFL,RESP)
I $G(ALTX)'="" S ACT=ACT_ALTX_$$STS(RX,RFL,RESP)
I +RESP=2 S ACT="Not ECME Billable: "_$P(RESP,"^",2)
I +RESP=6 S ACT=$P(RESP,"^",2)
I +RESP=10 S ACT="ECME reversed/NOT re-submitted: "_$P(RESP,"^",2)
S:PSOELIG="T" ACT="TRICARE-"_ACT
D RXACT^PSOBPSU2(RX,RFL,ACT,"M",DUZ)
; -Logs an ECME Activity Log if Rx Qty is different than Billing Qty
D ELOG^PSOBPSU2(RESP)
;
I PSOELIG="T" D TRICCHK^PSOREJU3(RX,RFL,RESP,FROM,$G(RVTX))
Q
;
REVERSE(RX,RFL,FROM,RSN,RTXT,IGRL,NDC) ; - Reverse a claim and close all OPEN/UNRESOLVED Rejects
;Input: (r) RX - Rx IEN (#52)
; (o) RFL - Refill # (Default: most recent)
; (r) FROM - Function within OP (See BWHERE param. in EN^BPSNCPDP api)
; (o) RSN - Close Reason (2:RX ON HOLD;4: RX RETURNED TO STOCK,5:RX DELETED,etc...)
; (o) RTXT - Close Reason TEXT (Usually no passed if RSN is passed)
; (o) IGRL - Ignore RELEASE DATE, reverse anyway
; (o) NDC - NDC number related to the reversal (Note: might be an invalid NDC)
Q ;IHS/MSC/PLS - 05/20/2010
I '$D(RFL) S RFL=$$LSTRFL(RX)
I $$STATUS^PSOBPSUT(RX,RFL)="" Q
N RESP,STS,ACT,STAT,DA,STATUS,NOACT,REVECME S RSN=+$G(RSN),RTXT=$G(RTXT),REVECME=1
I RTXT="",RSN D
. S:RSN=2 RTXT="RX PLACED ON HOLD" S:RSN=3 RTXT="RX SUSPENDED" S:RSN=4 RTXT="RX RETURNED TO STOCK"
. S:RSN=5 RTXT="RX DELETED" S:RSN=7 RTXT="RX DISCONTINUED" S:RSN=8 RTXT="RX EDITED"
D CLSALL^PSOREJUT(RX,RFL,DUZ,RSN,RTXT)
I '$G(IGRL),$$RXRLDT^PSOBPSUT(RX,RFL) Q
; - Reseting the Re-transmission flag if Rx is being suspended
I RSN=3!($$GET1^DIQ(52,RX,100,"I")=5) D RETRXF^PSOREJU2(RX,RFL,1)
S STATUS=$$STATUS^PSOBPSUT(RX,RFL),NOACT=0
I STATUS'="E PAYABLE",STATUS'="IN PROGRESS",STATUS'="E REVERSAL REJECTED",STATUS'="E REVERSAL STRANDED",STATUS'="E DUPLICATE" S NOACT=1
; Only perform ECME reversal for a released CMOP if rx/fill is Discontinued.
I FROM="DC",$$CMOP^PSOBPSUT(RX,RFL) S REVECME=0
I REVECME S RESP=$$EN^BPSNCPDP(RX,RFL,$$DOS(RX,RFL),FROM,$$GETNDC^PSONDCUT(RX,RFL),RTXT)
N PSOTRIC S PSOTRIC="",PSOTRIC=$$TRIC^PSOREJP1(RX,RFL,PSOTRIC)
; - Logging ECME Activity Log
I '$G(NOACT),REVECME D
. S ACT=$S(PSOTRIC:"TRICARE ",1:"")_"Reversal sent to ECME: "_RTXT_$S($G(NDC)'="":" ("_NDC_")",1:"")_$$STS(RX,RFL,+RESP)
. D RXACT^PSOBPSU2(RX,RFL,ACT,"M",DUZ)
Q
;
DOS(RX,RFL,DATE) ; Return the Date Of Service for ECME
;Input: (r) RX - Rx IEN (#52)
; (o) RFL - Refill # (Default: most recent)
; (o) DATE - Possible Date Of Service
;Output: DOS - Actual Date Of Service
I '$D(RFL) S RFL=$$LSTRFL(RX)
; - Retrieving FILL DATE from the PRESCRIPTION file if not passed
I $G(DATE)="" S DATE=$$RXRLDT^PSOBPSUT(RX,RFL)
; - Retrieving FILL DATE from the PRESCRIPTION file if not passed
I 'DATE S DATE=$$RXFLDT^PSOBPSUT(RX,RFL)
; - Future Date not allowed
I DATE>DT!'DATE S DATE=DT
Q (DATE\1)
;
RELEASE(RX,RFL,USR) ; - Notifies IB that the Rx was RELEASED
;Input: (r) RX - Rx IEN (#52)
; (o) RFL - Refill # (Default: most recent)
; (o) USR - User responsible for releasing the Rx (Default: .5 - Postmaster)
Q ;IHS/MSC/PLS - 05/20/2010
N IBAR,RXAR,FLDT,RFAR
S:'$D(RFL) RFL=$$LSTRFL(RX)
S:'$D(USR) USR=.5
D GETS^DIQ(52,RX_",",".01;2;6;7;8;22","I","RXAR")
S DFN=+$G(RXAR(52,RX_",",2,"I"))
S IBAR("PRESCRIPTION")=RX,IBAR("RX NO")=$G(RXAR(52,RX_",",.01,"I"))
S IBAR("CLAIMID")=$E((RX#10000000)+10000000,2,8),IBAR("USER")=USR
S IBAR("DRUG")=RXAR(52,RX_",",6,"I"),IBAR("NDC")=$$GETNDC^PSONDCUT(RX,RFL)
S FLDT=$$RXFLDT^PSOBPSUT(RX,RFL) I FLDT>DT S FLDT=DT
S IBAR("FILL NUMBER")=RFL,IBAR("FILL DATE")=FLDT
S IBAR("QTY")=$G(RXAR(52,RX_",",7,"I")),IBAR("DAYS SUPPLY")=$G(RXAR(52,RX_",",8,"I"))
I RFL D
. D GETS^DIQ(52.1,RFL_","_RX_",",".01;1;1.1","I","RFAR")
. S IBAR("QTY")=$G(RFAR(52.1,RFL_","_RX_",",1,"I"))
. S IBAR("DAYS SUPPLY")=$G(RFAR(52.1,RFL_","_RX_",",1.1,"I"))
S IBAR("STATUS")="RELEASED" D STORESP^IBNCPDP(DFN,.IBAR)
Q
;
LSTRFL(RX) ; - Returns the latest fill for the Prescription
; Input: (r) RX - Rx IEN (#52)
;Output: LSTRFL - Most recent refill #
N I,LSTRFL
S (I,LSTRFL)=0 F S I=$O(^PSRX(RX,1,I)) Q:'I S LSTRFL=I
Q LSTRFL
;
ECMEACT(RX,RFL,COMM,USR) ; - Add an Activity to the ECME Activity Log (PRESCRIPTION file)
;Input: (r) RX - Rx IEN (#52)
; (o) RFL - Refill # (Default: most recent)
; (r) COMM - Comments (up to 75 characters)
; (o) USR - User logging the comments (Default: DUZ)
S:'$D(RFL) RFL=$$LSTRFL^PSOBPSU1(RX)
D RXACT^PSOBPSU2(RX,RFL,COMM,"M",+$G(USR))
Q
;
STS(RX,RFL,RSP) ; Adds the Status to the ECME Activity Log according to Rx/fill claim status Response
N STS
S STS=$S($$STATUS^PSOBPSUT(RX,RFL)'="IN PROGRESS"&($$STATUS^PSOBPSUT(RX,RFL)'=""):"-"_$$STATUS^PSOBPSUT(RX,RFL),1:"")
S:+RSP=1 STS="-NO SUBMISSION THROUGH ECME" S:+RSP=3 STS="-NO REVERSAL NEEDED" S:+RSP=4 STS="-NOT PROCESSED"
S:+RSP=5 STS="-SOFTWARE ERROR"_$S($P($G(RESP),"^",2)'="":" ("_$P(RESP,"^",2)_")",1:"")
I +RSP=2,$$STATUS^PSOBPSUT(RX,RFL)'="" S STS="-NOT BILLABLE:"_$S(PSOELIG="T":"TRICARE",PSOELIG="C":"CHAMPVA",1:"")_":"_$P(RSP,"^",2)
Q STS
PSOBPSU1 ;BIRM/MFR - BPS (ECME) Utilities 1 ;29-May-2012 14:40;PLS
+1 ;;7.0;OUTPATIENT PHARMACY;**148,260,281,287,303,289,1015**;DEC 1997;Build 62
+2 ;Reference to $$EN^BPSNCPDP supported by IA 4415 & 4304
+3 ;References to $$NDCFMT^PSSNDCUT,$$GETNDC^PSSNDCUT supported by IA 4707
+4 ;References to $$ECMEON^BPSUTIL,$$CMOPON^BPSUTIL supported by IA 4410
+5 ;References to STORESP^IBNCPDP supported by IA 4299
+6 ;Modified - IHS/MSC/PLS - 05/20/2010 - Line REVERSE+8
+7 ; RELEASE+4
+8 ; ECMESND+20
ECMESND(RX,RFL,DATE,FROM,NDC,CMOP,RVTX,OVRC,CNDC,RESP,IGSW,ALTX,CLA,PA) ; - Sends Rx Release
+1 ;information to ECME/IB and updates NDC in the DRUG/PRESCRIPTION files; DBIA4304
+2 ;Input: (r) RX - Rx IEN (#52)
+3 ; (o) RFL - Refill # (Default: most recent)
+4 ; (r) DATE - Date of Service
+5 ; (r) FROM - Function within OP (See BWHERE param. in EN^BPSNCPDP api)
+6 ; (o) NDC - NDC Number (If not passed, will be retrieved from DRUG file)
+7 ; (o) CMOP - CMOP Prescription (1-YES/0-NO) (Default: 0)
+8 ; (o) RVTX - REVERSE text (e.g., RX EDIT, RX RELEASE-NDC CHANGE, etc)
+9 ; (o) OVRC - Set of 3 NCPDP override codes separated by "^":
+10 ; Piece 1: NCPDP Professional Service Code for overriding DUR REJECTS
+11 ; Piece 2: NCPDP Reason for Service Code for overriding DUR REJECTS
+12 ; Piece 3: NCPDP Result of Service Code for overriding DUR REJECTS
+13 ; (o) CNDC - Changed NDC? 1 - Yes / 0 - No (Default: NO)
+14 ; (o) IGSW - Ignore Switches (Master and CMOP)? 1 - Yes / 0 - No (Default: NO)
+15 ; (o) ALTX - Alternative Text to be placed in the Rx ECME Activity Log
+16 ; (o) CLA - NCPDP Clarification Code for overriding DUR/RTS REJECTS
+17 ; (o) PA - NCPDP Prior Authorization Type and Number (separated by "^")
+18 ;Output: RESP - Response from $$EN^BPSNCPDP api
+19 ;
+20 ;IHS/MSC/PLS - 05/20/2010
QUIT
+21 NEW ACT,NDCACT,DA,PSOELIG
+22 IF '$DATA(RFL)
SET RFL=$$LSTRFL(RX)
+23 ; - ECME is not turned ON for the Rx's Division
+24 IF '$GET(IGSW)
IF '$$ECMEON^BPSUTIL($$RXSITE^PSOBPSUT(RX,RFL))
SET RESP="-1^ECME SWITCH OFF"
QUIT
+25 ; - ECME CMOP is not turned ON for the Rx's Division
+26 IF '$GET(IGSW)
IF $GET(CMOP)
IF '$$CMOPON^BPSUTIL($$RXSITE^PSOBPSUT(RX,RFL))
SET RESP="-1^CMOP SWITCH OFF"
QUIT
+27 ; - Saving the NDC to be displayed on the ECME Activity Log
+28 IF $GET(CNDC)
Begin DoDot:1
+29 IF $GET(NDC)'=""
SET NDCACT=NDC
QUIT
+30 SET NDCACT=$$GETNDC^PSONDCUT(RX,RFL)
End DoDot:1
+31 IF $$NDCFMT^PSSNDCUT($GET(NDC))=""
Begin DoDot:1
+32 SET NDC=$$GETNDC^PSSNDCUT($$GET1^DIQ(52,RX,6,"I"),$$RXSITE^PSOBPSUT(RX,RFL),+$GET(CMOP))
+33 IF $GET(NDC)'=""
DO SAVNDC^PSONDCUT(RX,RFL,NDC,+$GET(CMOP),1)
End DoDot:1
+34 SET PPDU=""
SET PPDU=$$GPPDU^PSONDCUT(RX,RFL,NDC,,1,FROM)
KILL PPDU
+35 ; - Creating ECME Activity Log on the PRESCRIPTION file
+36 SET ACT="Submitted"
IF $$STATUS^PSOBPSUT(RX,RFL)="E PAYABLE"
SET ACT="Rev/Resubmit"
+37 SET ACT=ACT_" to ECME:"
+38 ; - Marked any 'unresolved' REJECTS as 'resolved' (Reason: 1 - Claim re-submitted)
+39 NEW CLSCOM,COD1,COD2,COD3
+40 SET COD2=$PIECE($GET(OVRC),"^")
SET COD1=$PIECE($GET(OVRC),"^",2)
SET COD3=$PIECE($GET(OVRC),"^",3)
+41 IF $GET(COD3)'=""
SET CLSCOM="DUR Override Codes "_COD1_"/"_COD2_"/"_COD3_" submitted."
+42 IF $GET(CLA)'=""
SET CLSCOM="Clarification Code "_$PIECE(CLA,"^",2)_" submitted."
+43 IF $GET(PA)'=""
SET CLSCOM="Prior Authorization Code ("_$PIECE(PA,"^")_"/"_$PIECE(PA,"^",2)_") submitted."
+44 DO CLSALL^PSOREJUT(RX,RFL,DUZ,1,$GET(CLSCOM),$GET(COD1),$GET(COD2),$GET(COD3),$SELECT($GET(CLA):$PIECE(CLA,"^",2),1:""),$GET(PA))
+45 ; - Call to ECME (NEWing STAT because ECME was overwriting it - Important variable for CMOP release PSXVND)
+46 NEW STAT
+47 IF $GET(RVTX)=""
IF FROM="ED"
SET RVTX="RX EDITED"
+48 IF $GET(CLA)
SET CLA=$PIECE(CLA,"^")
+49 SET RESP=$$EN^BPSNCPDP(RX,RFL,$$DOS(RX,RFL,.DATE),FROM,NDC,$GET(RVTX),$GET(OVRC),,$GET(CLA),$GET(PA))
+50 IF $$STATUS^PSOBPSUT(RX,RFL)="E PAYABLE"
DO SAVNDC^PSONDCUT(RX,RFL,NDC,+$GET(CMOP),1,FROM)
+51 ; - Reseting the Re-transmission flag
+52 DO RETRXF^PSOREJU2(RX,RFL,0)
+53 ; Storing eligibility flag
+54 SET PSOELIG=$PIECE(RESP,"^",3)
IF PSOELIG'=""
DO ELIG^PSOBPSU2(RX,RFL,PSOELIG)
+55 ; - Logging ECME Activity Log to the PRESCRIPTION file
+56 IF $GET(ALTX)=""
Begin DoDot:1
+57 NEW X,ROUTE
SET (ROUTE,X)=""
+58 SET ROUTE=$SELECT(FROM="RF":$$GET1^DIQ(52.1,RFL_","_RX_",",2),FROM="OF":$$GET1^DIQ(52,RX_",",11),1:"")
+59 IF FROM="OF"
SET X=ROUTE_" FILL(NDC:"_$$GETNDC^PSONDCUT(RX,RFL)_")"
+60 IF FROM="RF"
SET X=ROUTE_" REFILL(NDC:"_$$GETNDC^PSONDCUT(RX,RFL)_")"
+61 IF FROM="RN"
SET X="RX RENEWED(NDC:"_$$GETNDC^PSONDCUT(RX,RFL)_")"
+62 IF FROM="PL"
SET X="PRINTED FROM SUSPENSE(NDC:"_$$GETNDC^PSONDCUT(RX,RFL)_")"
+63 IF FROM="PE"!(FROM="PP")
SET X="PULLED FROM SUSPENSE(NDC:"_$$GETNDC^PSONDCUT(RX,RFL)_")"
+64 IF FROM="PC"
SET X="CMOP TRANSMISSION(NDC:"_$$GETNDC^PSONDCUT(RX,RFL)_")"
+65 IF FROM="RRL"
SET X="RELEASED RX PREVIOUSLY REVERSED"
+66 IF FROM="ED"
SET X="RX EDITED"
+67 IF $GET(RVTX)'=""
SET X=RVTX
+68 IF $GET(OVRC)'=""
SET X="DUR OVERRIDE CODES("_$GET(COD1)_"/"_$GET(COD2)_"/"_$GET(COD3)_")"
+69 IF $GET(CNDC)
SET X=X_"(NDC:"_NDCACT_")"
SET ACT=ACT_X
+70 SET ACT=ACT_$$STS(RX,RFL,RESP)
End DoDot:1
+71 IF $GET(ALTX)'=""
SET ACT=ACT_ALTX_$$STS(RX,RFL,RESP)
+72 IF +RESP=2
SET ACT="Not ECME Billable: "_$PIECE(RESP,"^",2)
+73 IF +RESP=6
SET ACT=$PIECE(RESP,"^",2)
+74 IF +RESP=10
SET ACT="ECME reversed/NOT re-submitted: "_$PIECE(RESP,"^",2)
+75 IF PSOELIG="T"
SET ACT="TRICARE-"_ACT
+76 DO RXACT^PSOBPSU2(RX,RFL,ACT,"M",DUZ)
+77 ; -Logs an ECME Activity Log if Rx Qty is different than Billing Qty
+78 DO ELOG^PSOBPSU2(RESP)
+79 ;
+80 IF PSOELIG="T"
DO TRICCHK^PSOREJU3(RX,RFL,RESP,FROM,$GET(RVTX))
+81 QUIT
+82 ;
REVERSE(RX,RFL,FROM,RSN,RTXT,IGRL,NDC) ; - Reverse a claim and close all OPEN/UNRESOLVED Rejects
+1 ;Input: (r) RX - Rx IEN (#52)
+2 ; (o) RFL - Refill # (Default: most recent)
+3 ; (r) FROM - Function within OP (See BWHERE param. in EN^BPSNCPDP api)
+4 ; (o) RSN - Close Reason (2:RX ON HOLD;4: RX RETURNED TO STOCK,5:RX DELETED,etc...)
+5 ; (o) RTXT - Close Reason TEXT (Usually no passed if RSN is passed)
+6 ; (o) IGRL - Ignore RELEASE DATE, reverse anyway
+7 ; (o) NDC - NDC number related to the reversal (Note: might be an invalid NDC)
+8 ;IHS/MSC/PLS - 05/20/2010
QUIT
+9 IF '$DATA(RFL)
SET RFL=$$LSTRFL(RX)
+10 IF $$STATUS^PSOBPSUT(RX,RFL)=""
QUIT
+11 NEW RESP,STS,ACT,STAT,DA,STATUS,NOACT,REVECME
SET RSN=+$GET(RSN)
SET RTXT=$GET(RTXT)
SET REVECME=1
+12 IF RTXT=""
IF RSN
Begin DoDot:1
+13 IF RSN=2
SET RTXT="RX PLACED ON HOLD"
IF RSN=3
SET RTXT="RX SUSPENDED"
IF RSN=4
SET RTXT="RX RETURNED TO STOCK"
+14 IF RSN=5
SET RTXT="RX DELETED"
IF RSN=7
SET RTXT="RX DISCONTINUED"
IF RSN=8
SET RTXT="RX EDITED"
End DoDot:1
+15 DO CLSALL^PSOREJUT(RX,RFL,DUZ,RSN,RTXT)
+16 IF '$GET(IGRL)
IF $$RXRLDT^PSOBPSUT(RX,RFL)
QUIT
+17 ; - Reseting the Re-transmission flag if Rx is being suspended
+18 IF RSN=3!($$GET1^DIQ(52,RX,100,"I")=5)
DO RETRXF^PSOREJU2(RX,RFL,1)
+19 SET STATUS=$$STATUS^PSOBPSUT(RX,RFL)
SET NOACT=0
+20 IF STATUS'="E PAYABLE"
IF STATUS'="IN PROGRESS"
IF STATUS'="E REVERSAL REJECTED"
IF STATUS'="E REVERSAL STRANDED"
IF STATUS'="E DUPLICATE"
SET NOACT=1
+21 ; Only perform ECME reversal for a released CMOP if rx/fill is Discontinued.
+22 IF FROM="DC"
IF $$CMOP^PSOBPSUT(RX,RFL)
SET REVECME=0
+23 IF REVECME
SET RESP=$$EN^BPSNCPDP(RX,RFL,$$DOS(RX,RFL),FROM,$$GETNDC^PSONDCUT(RX,RFL),RTXT)
+24 NEW PSOTRIC
SET PSOTRIC=""
SET PSOTRIC=$$TRIC^PSOREJP1(RX,RFL,PSOTRIC)
+25 ; - Logging ECME Activity Log
+26 IF '$GET(NOACT)
IF REVECME
Begin DoDot:1
+27 SET ACT=$SELECT(PSOTRIC:"TRICARE ",1:"")_"Reversal sent to ECME: "_RTXT_$SELECT($GET(NDC)'="":" ("_NDC_")",1:"")_$$STS(RX,RFL,+RESP)
+28 DO RXACT^PSOBPSU2(RX,RFL,ACT,"M",DUZ)
End DoDot:1
+29 QUIT
+30 ;
DOS(RX,RFL,DATE) ; Return the Date Of Service for ECME
+1 ;Input: (r) RX - Rx IEN (#52)
+2 ; (o) RFL - Refill # (Default: most recent)
+3 ; (o) DATE - Possible Date Of Service
+4 ;Output: DOS - Actual Date Of Service
+5 IF '$DATA(RFL)
SET RFL=$$LSTRFL(RX)
+6 ; - Retrieving FILL DATE from the PRESCRIPTION file if not passed
+7 IF $GET(DATE)=""
SET DATE=$$RXRLDT^PSOBPSUT(RX,RFL)
+8 ; - Retrieving FILL DATE from the PRESCRIPTION file if not passed
+9 IF 'DATE
SET DATE=$$RXFLDT^PSOBPSUT(RX,RFL)
+10 ; - Future Date not allowed
+11 IF DATE>DT!'DATE
SET DATE=DT
+12 QUIT (DATE\1)
+13 ;
RELEASE(RX,RFL,USR) ; - Notifies IB that the Rx was RELEASED
+1 ;Input: (r) RX - Rx IEN (#52)
+2 ; (o) RFL - Refill # (Default: most recent)
+3 ; (o) USR - User responsible for releasing the Rx (Default: .5 - Postmaster)
+4 ;IHS/MSC/PLS - 05/20/2010
QUIT
+5 NEW IBAR,RXAR,FLDT,RFAR
+6 IF '$DATA(RFL)
SET RFL=$$LSTRFL(RX)
+7 IF '$DATA(USR)
SET USR=.5
+8 DO GETS^DIQ(52,RX_",",".01;2;6;7;8;22","I","RXAR")
+9 SET DFN=+$GET(RXAR(52,RX_",",2,"I"))
+10 SET IBAR("PRESCRIPTION")=RX
SET IBAR("RX NO")=$GET(RXAR(52,RX_",",.01,"I"))
+11 SET IBAR("CLAIMID")=$EXTRACT((RX#10000000)+10000000,2,8)
SET IBAR("USER")=USR
+12 SET IBAR("DRUG")=RXAR(52,RX_",",6,"I")
SET IBAR("NDC")=$$GETNDC^PSONDCUT(RX,RFL)
+13 SET FLDT=$$RXFLDT^PSOBPSUT(RX,RFL)
IF FLDT>DT
SET FLDT=DT
+14 SET IBAR("FILL NUMBER")=RFL
SET IBAR("FILL DATE")=FLDT
+15 SET IBAR("QTY")=$GET(RXAR(52,RX_",",7,"I"))
SET IBAR("DAYS SUPPLY")=$GET(RXAR(52,RX_",",8,"I"))
+16 IF RFL
Begin DoDot:1
+17 DO GETS^DIQ(52.1,RFL_","_RX_",",".01;1;1.1","I","RFAR")
+18 SET IBAR("QTY")=$GET(RFAR(52.1,RFL_","_RX_",",1,"I"))
+19 SET IBAR("DAYS SUPPLY")=$GET(RFAR(52.1,RFL_","_RX_",",1.1,"I"))
End DoDot:1
+20 SET IBAR("STATUS")="RELEASED"
DO STORESP^IBNCPDP(DFN,.IBAR)
+21 QUIT
+22 ;
LSTRFL(RX) ; - Returns the latest fill for the Prescription
+1 ; Input: (r) RX - Rx IEN (#52)
+2 ;Output: LSTRFL - Most recent refill #
+3 NEW I,LSTRFL
+4 SET (I,LSTRFL)=0
FOR
SET I=$ORDER(^PSRX(RX,1,I))
IF 'I
QUIT
SET LSTRFL=I
+5 QUIT LSTRFL
+6 ;
ECMEACT(RX,RFL,COMM,USR) ; - Add an Activity to the ECME Activity Log (PRESCRIPTION file)
+1 ;Input: (r) RX - Rx IEN (#52)
+2 ; (o) RFL - Refill # (Default: most recent)
+3 ; (r) COMM - Comments (up to 75 characters)
+4 ; (o) USR - User logging the comments (Default: DUZ)
+5 IF '$DATA(RFL)
SET RFL=$$LSTRFL^PSOBPSU1(RX)
+6 DO RXACT^PSOBPSU2(RX,RFL,COMM,"M",+$GET(USR))
+7 QUIT
+8 ;
STS(RX,RFL,RSP) ; Adds the Status to the ECME Activity Log according to Rx/fill claim status Response
+1 NEW STS
+2 SET STS=$SELECT($$STATUS^PSOBPSUT(RX,RFL)'="IN PROGRESS"&($$STATUS^PSOBPSUT(RX,RFL)'=""):"-"_$$STATUS^PSOBPSUT(RX,RFL),1:"")
+3 IF +RSP=1
SET STS="-NO SUBMISSION THROUGH ECME"
IF +RSP=3
SET STS="-NO REVERSAL NEEDED"
IF +RSP=4
SET STS="-NOT PROCESSED"
+4 IF +RSP=5
SET STS="-SOFTWARE ERROR"_$SELECT($PIECE($GET(RESP),"^",2)'="":" ("_$PIECE(RESP,"^",2)_")",1:"")
+5 IF +RSP=2
IF $$STATUS^PSOBPSUT(RX,RFL)'=""
SET STS="-NOT BILLABLE:"_$SELECT(PSOELIG="T":"TRICARE",PSOELIG="C":"CHAMPVA",1:"")_":"_$PIECE(RSP,"^",2)
+6 QUIT STS
