PSOBPSU1 ;BIRM/MFR - BPS (ECME) Utilities 1 ;10/15/04
;;7.0;OUTPATIENT PHARMACY;**148,260,281,287,303,289,290,358,359,385,403,427,448,482,512,680,766**;DEC 1997;Build 25
; Reference to $$EN^BPSNCPDP in ICR #4415
; Reference to $$NDCFMT^PSSNDCUT,$$GETNDC^PSSNDCUT in ICR #4707
; Reference to $$ECMEON^BPSUTIL,$$CMOPON^BPSUTIL in ICR #4410
; Reference to $$STORESP^IBNCPDP in ICR #4299
; Reference to $$CLAIM^BPSBUTL in ICR #4719
; Reference to $$RESPONSE^BPSOS03 in ICR #6226
; Reference to $$LOG^BPSOSL in ICR #6764
;
ECMESND(RX,RFL,DATE,FROM,NDC,CMOP,RVTX,OVRC,CNDC,RESP,IGSW,ALTX,CLA,PA,RXCOB,PSOVRIEN,PSOPLAN,PSORTYPE,DIAG) ; - Sends Rx Release
;information to ECME/IB and updates NDC in the files 50 & 52; DBIA4702
;Input: (r) RX - Rx IEN (#52)
; (o) RFL - Refill # (Default: most recent)
; (o) 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 Rx (1-YES/0-NO) (Default: 0)
; (o) RVTX - REVERSE text (e.g., RX EDIT, RX RELEASE-NDC CHANGE, etc)
; (o) OVRC - Three sets of 3 NCPDP override codes separated by "~". Each piece of the set
; is delimited by an "^"
; Piece 1: NCPDP Reason for Service Code for overriding DUR REJECTS
; Piece 2: NCPDP Professional 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(s) for overriding DUR/RTS REJECTS
; (o) PA - NCPDP Prior Authorization Type and Number (separated by "^")
; (o) RXCOB- Payer Sequence
; (o) PSOVRIEN - IEN to BPS NCPDP OVERRIDE (#9002313.511)
; (o) PSOPLAN - IEN to file# 355.3, GROUP INSURANCE PLAN
; (o) PSORTYPE - IEN to file# 399.3, RATE TYPE
; (o) DIAG - Diagnosis Code
;Output: RESP - Response from $$EN^BPSNCPDP api
;
N ACT,NDCACT,DA,PSOELIG,PSOBYPS,ACT1,SMA
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 Act 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
;
; Determine if this has multiple overrides from the SMA action of the reject worklist
S SMA=0
I $G(OVRC)]"",$G(CLA)]"" S SMA=1
I $G(OVRC)]"",$G(PA)]"" S SMA=1
I $G(CLA)]"",$G(PA)]"" S SMA=1
;
; if the reversal reason text exists, remove semi-colons pso*7*448
I $G(RVTX)'="" S RVTX=$TR(RVTX,";","-")
;
; - Creating ECME Act Log in file 52
S ACT=""
I $$STATUS^PSOBPSUT(RX,RFL)="E PAYABLE" S ACT="Rev/Resubmit "
S ACT=ACT_"ECME:"
;
; - Marked any 'unresolved' REJECTS as 'resolved' (Reason: 1 - Claim re-submitted)
N CLSCOM
I 'SMA D
. I $P($G(OVRC),"~")'="" S CLSCOM="DUR Override Codes "_$TR($P(OVRC,"~"),"^","/")_" submitted."
. I $G(CLA)'="" S CLSCOM="Clarification Code(s) "_CLA_" submitted."
. I $G(PA)'="" S CLSCOM="Prior Authorization Code ("_$P(PA,"^")_"/"_$P(PA,"^",2)_") submitted."
. I $G(DIAG)'="" S CLSCOM="Diagnosis Code "_DIAG_" submitted."
D CLSALL^PSOREJUT(RX,RFL,DUZ,1,$G(CLSCOM),$P($G(OVRC),"~",1),$P($G(OVRC),"~",2),$P($G(OVRC),"~",3),$G(CLA),$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"
S RESP=$$EN^BPSNCPDP(RX,RFL,$$DOS(RX,RFL,.DATE),FROM,NDC,$G(RVTX),$G(OVRC),$G(PSOVRIEN),$G(CLA),$G(PA),$G(RXCOB),,,,$G(PSOPLAN),,$G(PSORTYPE),,$G(DIAG))
I $$STATUS^PSOBPSUT(RX,RFL)="E PAYABLE" D
. D SAVNDC^PSONDCUT(RX,RFL,NDC,+$G(CMOP),1,FROM)
. ;
. ; MRD;PSO*7.0*448 - If this is a resubmit of a claim with an RRR
. ; reject, and it came back E PAYABLE, then display some additional
. ; information about the response to the claim, conditional upon the
. ; value of FROM.
. ;
. I ",ED,PE,PP,RF,RN,RRL,"[(","_FROM_","),$$RRR(RX,RFL) D ADDLINFO(RX,RFL,$G(RXCOB))
. ;
. Q
;
; - 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)
;
; Check if this is a bypass RX-claim. If it is, write it to the Bypass-Override Report
S PSOBYPS=$$BYPASS(PSOELIG,$P(RESP,"^",2))
I PSOBYPS D EN^PSOBORP2(RX,RFL,RESP)
;
; If from SMA action, split message across multiple log entries
; The last entry will be filed in the code that follows this section as we append other data
; to the last message.
I SMA,+RESP'=2,+RESP'=6,+RESP'=10 D
. N MSG
. ; If there are DUR overrides, create the message and file it since this will never be the last message
. I $G(OVRC)]"" D
.. S MSG=ACT_"REJECT WORKLIST-DUR OVERRIDE CODES("_$TR(OVRC,"^","/")_")"
.. D RXACT^PSOBPSU2(RX,RFL,MSG,"M",DUZ)
. ; If there are Clarification codes, create the message
. ; Only file it if we also have a Prior Auth message.
. ; Otherwise more data will be added to it and it will be filed below.
. I $G(CLA)]"" D
.. S MSG=ACT_"REJECT WORKLIST-(CLARIF. CODE="_CLA_")"
.. I $G(PA)]"" D RXACT^PSOBPSU2(RX,RFL,MSG,"M",DUZ)
. ; If there are Prior Auth overrides, create the message.
. ; More data will be added to it and it will be filed below.
. I $G(PA)]"" D
.. S ALTX="REJECT WORKLIST-(PRIOR AUTH.="_$TR(PA,"^","/")_")"
;
; - Logging ECME Act Log to file 52
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"!(FROM="CRRL") X="RELEASED RX PREVIOUSLY REVERSED"
. S:FROM="ED" X="RX EDITED"
. S:$G(RVTX)'="" X=RVTX
. I 'SMA,$G(OVRC)'="" S X="DUR OVERRIDE CODES("_$TR(OVRC,"^","/")_")"
. 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
S:PSOELIG="C" ACT="CHAMPVA-"_ACT
S ACT1=""
I $P(RESP,"^",6),$P(RESP,"^",7)'="" S ACT1="-"_$S($P(RESP,"^",6)="2":"s",$P(RESP,"^",6)="3":"t",1:"p")_$P(RESP,"^",7)
S ACT=$E(ACT_ACT1,1,75)
D RXACT^PSOBPSU2(RX,RFL,ACT,"M",DUZ)
D ELOG^PSOBPSU2(RESP) ;-Logs an ECME Act Log if Rx Qty is different than Billing Qty
; If not a bypass RX-claim, then call TRICCHK so the user can process
D LOG^BPSOSL($$IEN59^BPSOSRX(RX,RFL),$T(+0)_"-ECMESND, RESP="_RESP)
D LOG^BPSOSL($$IEN59^BPSOSRX(RX,RFL),$T(+0)_"-ECMESND, FROM="_FROM_" PSOELIG="_PSOELIG_" PSOBYPS="_PSOBYPS)
I PSOELIG="T"!(PSOELIG="C"),'PSOBYPS D TRICCHK^PSOREJU3(RX,RFL,RESP,FROM,$G(RVTX))
Q
;
BYPASS(PSOELIG,REASON) ;PSO*427
; Check if this Rx gets bypassed. Bypassed Rx show up on the TRICARE/CHAMPVA
; Override/Bypass Report and will not get the Reject Notification Screen.
;
; Input:
; POSELIG: Eligibility (C:CHAMPVA, T:TRICARE, V:VETERAN)
; REASON: Non billable reason returned by ECME
; Output:
; 0: Not a Bypass Rx
; 1: Bypass Rx
;
; Check Parameters
I $G(PSOELIG)="" Q 0
I $G(REASON)="" Q 0
;
; Only TRICARE and CHAMPVA are bypassed
I PSOELIG'="T",PSOELIG'="C" Q 0
;
; Check for TRICARE/CHAMPVA and EI (Veteran claims would not have gotten this far)
I ",AGENT ORANGE,IONIZING RADIATION,SC TREATMENT,SOUTHWEST ASIA,MILITARY SEXUAL TRAUMA,HEAD/NECK CANCER,COMBAT VETERAN,PROJECT 112/SHAD,"[(","_REASON_",") Q 1
Q 0
;
RRR(PSORX,PSOFILL) ; Check for an RRR reject on a Prescription/Fill.
; MRD;PSO*7.0*448 - New function to support display of additional
; information for RRR resubmits. Return '1' if this Rx has a reject
; with the RRR flag set, otherwise return '0'.
; Input: (r) PSORX - Rx IEN (#52)
; (o) PSOFILL - Refill#
; Output: '1' if RRR, '0' if not
;
N PSOREJ,PSORRR
;
I '$G(PSORX) Q 0
I $G(PSOFILL)="" S PSOFILL=0
;
; Loop through the Reject Info sub-file. If the Fill# on a Reject is
; the same as PSOFILL, and if the Reject is RRR, then set the flag and
; quit out.
;
S PSORRR=0
S PSOREJ=0
F S PSOREJ=$O(^PSRX(PSORX,"REJ",PSOREJ)) Q:'PSOREJ D Q:PSORRR
. I $$GET1^DIQ(52.25,PSOREJ_","_PSORX,5)'=PSOFILL Q
. I $$GET1^DIQ(52.25,PSOREJ_","_PSORX,30,"I") S PSORRR=1
. Q
;
Q PSORRR
;
ADDLINFO(PSORX,PSOFILL,PSOCOB) ; Display additional information for RRR resubmits.
; MRD;PSO*7.0*448 - Display addition information for a paid claim.
; Input: (r) PSORX - Rx IEN (#52)
; (o) PSOFILL - Refill#
; (o) PSOCOB - Payer Sequence
;
; Use $$RESPONSE^BPSOS03 to pull the following fields from the BPS
; Response file, then display those fields.
; - Total Amount Paid, field #509
; - Ingredient Cost Paid, field #506
; - Amount of Copay/Coinsurance, field #518
; - Dispensing Fee Paid, field #507
; - Amount Applied to Periodic Deductible, field #517
; - Remaining Deductible Amount, field #513
;
N PSORESP,DIR,X,Y,DTOUT,DUOUT,DIRUT,DIROUT
;
I '$G(PSORX) Q ; If no Rx passed in, Quit out.
I $G(PSOFILL)="" S PSOFILL=0 ; Default Fill to 0 if none.
I '$G(PSOCOB) S PSOCOB=1 ; Default COB to 1/primary if none.
;
S PSORESP=$$RESPONSE^BPSOS03(PSORX,PSOFILL,PSOCOB) ; IA 6226.
I PSORESP="" Q
;
W !,"Total Amount Paid: ",$P(PSORESP,U,1)
W ?39,"Ingredient Cost Paid: ",$P(PSORESP,U,2)
W !,"Amount of Copay/Coinsurance: ",$P(PSORESP,U,3)
W ?39,"Dispensing Fee Paid: ",$P(PSORESP,U,4)
W !,"Amount Applied to Periodic Deductible: ",$P(PSORESP,U,5)
W !,"Remaining Deductible Amount: ",$P(PSORESP,U,6)
;
S DIR(0)="E",DIR("A")="Press Return to continue"
W !
D ^DIR
W !
;
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)
I '$D(RFL) S RFL=$$LSTRFL(RX)
N PSOET S PSOET=$$PSOET^PSOREJP3(RX,RFL) ;cnf, PSO*7.0*358
I 'PSOET,$$STATUS^PSOBPSUT(RX,RFL)="" Q ;cnf, PSO*7.0*358, add PSOET check, allow reversal for TRICARE non-billable reject
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 Act Log
I '$G(NOACT),REVECME D
. S ACT=$S(PSOTRIC=1:"TRICARE ",PSOTRIC=2:"CHAMPVA ",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 RELEASE DATE from file 52 if DATE not passed in
I $G(DATE)="" S DATE=$$RXRLDT^PSOBPSUT(RX,RFL)
; - If no date or future date, use today's date
I DATE>DT!'DATE S DATE=$$DT^XLFDT
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)
N IBAR,RXAR,RFAR,PSOIBN
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")=$P($$CLAIM^BPSBUTL(RX,RFL),U,6)
S IBAR("USER")=USR
S IBAR("DRUG")=RXAR(52,RX_",",6,"I"),IBAR("NDC")=$$GETNDC^PSONDCUT(RX,RFL)
S IBAR("FILL NUMBER")=RFL,IBAR("DOS")=$$DOS(RX,RFL),IBAR("RELEASE DATE")=$$RXRLDT^PSOBPSUT(RX,RFL)
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"
S PSOIBN=$$STORESP^IBNCPDP(DFN,.IBAR)
Q
;
LSTRFL(RX) ; - Returns the latest fill for the Rx
; 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 Act to the ECME Act Log (FILE 52)
;Input: (r) RX - Rx IEN (#52)
; (o) RFL - Refill # (Default: most recent)
; (r) COMM - Comments (up to 100 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 Act 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
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPSOBPSU1 15736 printed Sep 23, 2025@20:01:18 Page 2
PSOBPSU1 ;BIRM/MFR - BPS (ECME) Utilities 1 ;10/15/04
+1 ;;7.0;OUTPATIENT PHARMACY;**148,260,281,287,303,289,290,358,359,385,403,427,448,482,512,680,766**;DEC 1997;Build 25
+2 ; Reference to $$EN^BPSNCPDP in ICR #4415
+3 ; Reference to $$NDCFMT^PSSNDCUT,$$GETNDC^PSSNDCUT in ICR #4707
+4 ; Reference to $$ECMEON^BPSUTIL,$$CMOPON^BPSUTIL in ICR #4410
+5 ; Reference to $$STORESP^IBNCPDP in ICR #4299
+6 ; Reference to $$CLAIM^BPSBUTL in ICR #4719
+7 ; Reference to $$RESPONSE^BPSOS03 in ICR #6226
+8 ; Reference to $$LOG^BPSOSL in ICR #6764
+9 ;
ECMESND(RX,RFL,DATE,FROM,NDC,CMOP,RVTX,OVRC,CNDC,RESP,IGSW,ALTX,CLA,PA,RXCOB,PSOVRIEN,PSOPLAN,PSORTYPE,DIAG) ; - Sends Rx Release
+1 ;information to ECME/IB and updates NDC in the files 50 & 52; DBIA4702
+2 ;Input: (r) RX - Rx IEN (#52)
+3 ; (o) RFL - Refill # (Default: most recent)
+4 ; (o) 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 Rx (1-YES/0-NO) (Default: 0)
+8 ; (o) RVTX - REVERSE text (e.g., RX EDIT, RX RELEASE-NDC CHANGE, etc)
+9 ; (o) OVRC - Three sets of 3 NCPDP override codes separated by "~". Each piece of the set
+10 ; is delimited by an "^"
+11 ; Piece 1: NCPDP Reason for Service Code for overriding DUR REJECTS
+12 ; Piece 2: NCPDP Professional Service Code for overriding DUR REJECTS
+13 ; Piece 3: NCPDP Result of Service Code for overriding DUR REJECTS
+14 ; (o) CNDC - Changed NDC? 1 - Yes / 0 - No (Default: NO)
+15 ; (o) IGSW - Ignore Switches (Master and CMOP)? 1 - Yes / 0 - No (Default: NO)
+16 ; (o) ALTX - Alternative Text to be placed in the Rx ECME Activity Log
+17 ; (o) CLA - NCPDP Clarification Code(s) for overriding DUR/RTS REJECTS
+18 ; (o) PA - NCPDP Prior Authorization Type and Number (separated by "^")
+19 ; (o) RXCOB- Payer Sequence
+20 ; (o) PSOVRIEN - IEN to BPS NCPDP OVERRIDE (#9002313.511)
+21 ; (o) PSOPLAN - IEN to file# 355.3, GROUP INSURANCE PLAN
+22 ; (o) PSORTYPE - IEN to file# 399.3, RATE TYPE
+23 ; (o) DIAG - Diagnosis Code
+24 ;Output: RESP - Response from $$EN^BPSNCPDP api
+25 ;
+26 NEW ACT,NDCACT,DA,PSOELIG,PSOBYPS,ACT1,SMA
+27 IF '$DATA(RFL)
SET RFL=$$LSTRFL(RX)
+28 ; - ECME is not turned ON for the Rx's Division
+29 IF '$GET(IGSW)
IF '$$ECMEON^BPSUTIL($$RXSITE^PSOBPSUT(RX,RFL))
SET RESP="-1^ECME SWITCH OFF"
QUIT
+30 ; - ECME CMOP is not turned ON for the Rx's Division
+31 IF '$GET(IGSW)
IF $GET(CMOP)
IF '$$CMOPON^BPSUTIL($$RXSITE^PSOBPSUT(RX,RFL))
SET RESP="-1^CMOP SWITCH OFF"
QUIT
+32 ; - Saving the NDC to be displayed on the ECME Act Log
+33 IF $GET(CNDC)
Begin DoDot:1
+34 IF $GET(NDC)'=""
SET NDCACT=NDC
QUIT
+35 SET NDCACT=$$GETNDC^PSONDCUT(RX,RFL)
End DoDot:1
+36 IF $$NDCFMT^PSSNDCUT($GET(NDC))=""
Begin DoDot:1
+37 SET NDC=$$GETNDC^PSSNDCUT($$GET1^DIQ(52,RX,6,"I"),$$RXSITE^PSOBPSUT(RX,RFL),+$GET(CMOP))
+38 IF $GET(NDC)'=""
DO SAVNDC^PSONDCUT(RX,RFL,NDC,+$GET(CMOP),1)
End DoDot:1
+39 SET PPDU=""
SET PPDU=$$GPPDU^PSONDCUT(RX,RFL,NDC,,1,FROM)
KILL PPDU
+40 ;
+41 ; Determine if this has multiple overrides from the SMA action of the reject worklist
+42 SET SMA=0
+43 IF $GET(OVRC)]""
IF $GET(CLA)]""
SET SMA=1
+44 IF $GET(OVRC)]""
IF $GET(PA)]""
SET SMA=1
+45 IF $GET(CLA)]""
IF $GET(PA)]""
SET SMA=1
+46 ;
+47 ; if the reversal reason text exists, remove semi-colons pso*7*448
+48 IF $GET(RVTX)'=""
SET RVTX=$TRANSLATE(RVTX,";","-")
+49 ;
+50 ; - Creating ECME Act Log in file 52
+51 SET ACT=""
+52 IF $$STATUS^PSOBPSUT(RX,RFL)="E PAYABLE"
SET ACT="Rev/Resubmit "
+53 SET ACT=ACT_"ECME:"
+54 ;
+55 ; - Marked any 'unresolved' REJECTS as 'resolved' (Reason: 1 - Claim re-submitted)
+56 NEW CLSCOM
+57 IF 'SMA
Begin DoDot:1
+58 IF $PIECE($GET(OVRC),"~")'=""
SET CLSCOM="DUR Override Codes "_$TRANSLATE($PIECE(OVRC,"~"),"^","/")_" submitted."
+59 IF $GET(CLA)'=""
SET CLSCOM="Clarification Code(s) "_CLA_" submitted."
+60 IF $GET(PA)'=""
SET CLSCOM="Prior Authorization Code ("_$PIECE(PA,"^")_"/"_$PIECE(PA,"^",2)_") submitted."
+61 IF $GET(DIAG)'=""
SET CLSCOM="Diagnosis Code "_DIAG_" submitted."
End DoDot:1
+62 DO CLSALL^PSOREJUT(RX,RFL,DUZ,1,$GET(CLSCOM),$PIECE($GET(OVRC),"~",1),$PIECE($GET(OVRC),"~",2),$PIECE($GET(OVRC),"~",3),$GET(CLA),$GET(PA))
+63 ; - Call to ECME (NEWing STAT because ECME was overwriting it - Important variable for CMOP release PSXVND)
+64 NEW STAT
+65 IF $GET(RVTX)=""
IF FROM="ED"
SET RVTX="RX EDITED"
+66 SET RESP=$$EN^BPSNCPDP(RX,RFL,$$DOS(RX,RFL,.DATE),FROM,NDC,$GET(RVTX),$GET(OVRC),$GET(PSOVRIEN),$GET(CLA),$GET(PA),$GET(RXCOB),,,,$GET(PSOPLAN),,$GET(PSORTYPE),,$GET(DIAG))
+67 IF $$STATUS^PSOBPSUT(RX,RFL)="E PAYABLE"
Begin DoDot:1
+68 DO SAVNDC^PSONDCUT(RX,RFL,NDC,+$GET(CMOP),1,FROM)
+69 ;
+70 ; MRD;PSO*7.0*448 - If this is a resubmit of a claim with an RRR
+71 ; reject, and it came back E PAYABLE, then display some additional
+72 ; information about the response to the claim, conditional upon the
+73 ; value of FROM.
+74 ;
+75 IF ",ED,PE,PP,RF,RN,RRL,"[(","_FROM_",")
IF $$RRR(RX,RFL)
DO ADDLINFO(RX,RFL,$GET(RXCOB))
+76 ;
+77 QUIT
End DoDot:1
+78 ;
+79 ; - Reseting the Re-transmission flag
+80 DO RETRXF^PSOREJU2(RX,RFL,0)
+81 ; Storing eligibility flag
+82 SET PSOELIG=$PIECE(RESP,"^",3)
if PSOELIG'=""
DO ELIG^PSOBPSU2(RX,RFL,PSOELIG)
+83 ;
+84 ; Check if this is a bypass RX-claim. If it is, write it to the Bypass-Override Report
+85 SET PSOBYPS=$$BYPASS(PSOELIG,$PIECE(RESP,"^",2))
+86 IF PSOBYPS
DO EN^PSOBORP2(RX,RFL,RESP)
+87 ;
+88 ; If from SMA action, split message across multiple log entries
+89 ; The last entry will be filed in the code that follows this section as we append other data
+90 ; to the last message.
+91 IF SMA
IF +RESP'=2
IF +RESP'=6
IF +RESP'=10
Begin DoDot:1
+92 NEW MSG
+93 ; If there are DUR overrides, create the message and file it since this will never be the last message
+94 IF $GET(OVRC)]""
Begin DoDot:2
+95 SET MSG=ACT_"REJECT WORKLIST-DUR OVERRIDE CODES("_$TRANSLATE(OVRC,"^","/")_")"
+96 DO RXACT^PSOBPSU2(RX,RFL,MSG,"M",DUZ)
End DoDot:2
+97 ; If there are Clarification codes, create the message
+98 ; Only file it if we also have a Prior Auth message.
+99 ; Otherwise more data will be added to it and it will be filed below.
+100 IF $GET(CLA)]""
Begin DoDot:2
+101 SET MSG=ACT_"REJECT WORKLIST-(CLARIF. CODE="_CLA_")"
+102 IF $GET(PA)]""
DO RXACT^PSOBPSU2(RX,RFL,MSG,"M",DUZ)
End DoDot:2
+103 ; If there are Prior Auth overrides, create the message.
+104 ; More data will be added to it and it will be filed below.
+105 IF $GET(PA)]""
Begin DoDot:2
+106 SET ALTX="REJECT WORKLIST-(PRIOR AUTH.="_$TRANSLATE(PA,"^","/")_")"
End DoDot:2
End DoDot:1
+107 ;
+108 ; - Logging ECME Act Log to file 52
+109 IF $GET(ALTX)=""
Begin DoDot:1
+110 NEW X,ROUTE
SET (ROUTE,X)=""
+111 SET ROUTE=$SELECT(FROM="RF":$$GET1^DIQ(52.1,RFL_","_RX_",",2),FROM="OF":$$GET1^DIQ(52,RX_",",11),1:"")
+112 if FROM="OF"
SET X=ROUTE_" FILL(NDC:"_$$GETNDC^PSONDCUT(RX,RFL)_")"
+113 if FROM="RF"
SET X=ROUTE_" REFILL(NDC:"_$$GETNDC^PSONDCUT(RX,RFL)_")"
+114 if FROM="RN"
SET X="RX RENEWED(NDC:"_$$GETNDC^PSONDCUT(RX,RFL)_")"
+115 if FROM="PL"
SET X="PRINTED FROM SUSPENSE(NDC:"_$$GETNDC^PSONDCUT(RX,RFL)_")"
+116 if FROM="PE"!(FROM="PP")
SET X="PULLED FROM SUSPENSE(NDC:"_$$GETNDC^PSONDCUT(RX,RFL)_")"
+117 if FROM="PC"
SET X="CMOP TRANSMISSION(NDC:"_$$GETNDC^PSONDCUT(RX,RFL)_")"
+118 if FROM="RRL"!(FROM="CRRL")
SET X="RELEASED RX PREVIOUSLY REVERSED"
+119 if FROM="ED"
SET X="RX EDITED"
+120 if $GET(RVTX)'=""
SET X=RVTX
+121 IF 'SMA
IF $GET(OVRC)'=""
SET X="DUR OVERRIDE CODES("_$TRANSLATE(OVRC,"^","/")_")"
+122 if $GET(CNDC)
SET X=X_"(NDC:"_NDCACT_")"
SET ACT=ACT_X
+123 SET ACT=ACT_$$STS(RX,RFL,RESP)
End DoDot:1
+124 IF $GET(ALTX)'=""
SET ACT=ACT_ALTX_$$STS(RX,RFL,RESP)
+125 IF +RESP=2
SET ACT="Not ECME Billable: "_$PIECE(RESP,"^",2)
+126 IF +RESP=6
SET ACT=$PIECE(RESP,"^",2)
+127 IF +RESP=10
SET ACT="ECME reversed/NOT re-submitted: "_$PIECE(RESP,"^",2)
+128 if PSOELIG="T"
SET ACT="TRICARE-"_ACT
+129 if PSOELIG="C"
SET ACT="CHAMPVA-"_ACT
+130 SET ACT1=""
+131 IF $PIECE(RESP,"^",6)
IF $PIECE(RESP,"^",7)'=""
SET ACT1="-"_$SELECT($PIECE(RESP,"^",6)="2":"s",$PIECE(RESP,"^",6)="3":"t",1:"p")_$PIECE(RESP,"^",7)
+132 SET ACT=$EXTRACT(ACT_ACT1,1,75)
+133 DO RXACT^PSOBPSU2(RX,RFL,ACT,"M",DUZ)
+134 ;-Logs an ECME Act Log if Rx Qty is different than Billing Qty
DO ELOG^PSOBPSU2(RESP)
+135 ; If not a bypass RX-claim, then call TRICCHK so the user can process
+136 DO LOG^BPSOSL($$IEN59^BPSOSRX(RX,RFL),$TEXT(+0)_"-ECMESND, RESP="_RESP)
+137 DO LOG^BPSOSL($$IEN59^BPSOSRX(RX,RFL),$TEXT(+0)_"-ECMESND, FROM="_FROM_" PSOELIG="_PSOELIG_" PSOBYPS="_PSOBYPS)
+138 IF PSOELIG="T"!(PSOELIG="C")
IF 'PSOBYPS
DO TRICCHK^PSOREJU3(RX,RFL,RESP,FROM,$GET(RVTX))
+139 QUIT
+140 ;
BYPASS(PSOELIG,REASON) ;PSO*427
+1 ; Check if this Rx gets bypassed. Bypassed Rx show up on the TRICARE/CHAMPVA
+2 ; Override/Bypass Report and will not get the Reject Notification Screen.
+3 ;
+4 ; Input:
+5 ; POSELIG: Eligibility (C:CHAMPVA, T:TRICARE, V:VETERAN)
+6 ; REASON: Non billable reason returned by ECME
+7 ; Output:
+8 ; 0: Not a Bypass Rx
+9 ; 1: Bypass Rx
+10 ;
+11 ; Check Parameters
+12 IF $GET(PSOELIG)=""
QUIT 0
+13 IF $GET(REASON)=""
QUIT 0
+14 ;
+15 ; Only TRICARE and CHAMPVA are bypassed
+16 IF PSOELIG'="T"
IF PSOELIG'="C"
QUIT 0
+17 ;
+18 ; Check for TRICARE/CHAMPVA and EI (Veteran claims would not have gotten this far)
+19 IF ",AGENT ORANGE,IONIZING RADIATION,SC TREATMENT,SOUTHWEST ASIA,MILITARY SEXUAL TRAUMA,HEAD/NECK CANCER,COMBAT VETERAN,PROJECT 112/SHAD,"[(","_REASON_",")
QUIT 1
+20 QUIT 0
+21 ;
RRR(PSORX,PSOFILL) ; Check for an RRR reject on a Prescription/Fill.
+1 ; MRD;PSO*7.0*448 - New function to support display of additional
+2 ; information for RRR resubmits. Return '1' if this Rx has a reject
+3 ; with the RRR flag set, otherwise return '0'.
+4 ; Input: (r) PSORX - Rx IEN (#52)
+5 ; (o) PSOFILL - Refill#
+6 ; Output: '1' if RRR, '0' if not
+7 ;
+8 NEW PSOREJ,PSORRR
+9 ;
+10 IF '$GET(PSORX)
QUIT 0
+11 IF $GET(PSOFILL)=""
SET PSOFILL=0
+12 ;
+13 ; Loop through the Reject Info sub-file. If the Fill# on a Reject is
+14 ; the same as PSOFILL, and if the Reject is RRR, then set the flag and
+15 ; quit out.
+16 ;
+17 SET PSORRR=0
+18 SET PSOREJ=0
+19 FOR
SET PSOREJ=$ORDER(^PSRX(PSORX,"REJ",PSOREJ))
if 'PSOREJ
QUIT
Begin DoDot:1
+20 IF $$GET1^DIQ(52.25,PSOREJ_","_PSORX,5)'=PSOFILL
QUIT
+21 IF $$GET1^DIQ(52.25,PSOREJ_","_PSORX,30,"I")
SET PSORRR=1
+22 QUIT
End DoDot:1
if PSORRR
QUIT
+23 ;
+24 QUIT PSORRR
+25 ;
ADDLINFO(PSORX,PSOFILL,PSOCOB) ; Display additional information for RRR resubmits.
+1 ; MRD;PSO*7.0*448 - Display addition information for a paid claim.
+2 ; Input: (r) PSORX - Rx IEN (#52)
+3 ; (o) PSOFILL - Refill#
+4 ; (o) PSOCOB - Payer Sequence
+5 ;
+6 ; Use $$RESPONSE^BPSOS03 to pull the following fields from the BPS
+7 ; Response file, then display those fields.
+8 ; - Total Amount Paid, field #509
+9 ; - Ingredient Cost Paid, field #506
+10 ; - Amount of Copay/Coinsurance, field #518
+11 ; - Dispensing Fee Paid, field #507
+12 ; - Amount Applied to Periodic Deductible, field #517
+13 ; - Remaining Deductible Amount, field #513
+14 ;
+15 NEW PSORESP,DIR,X,Y,DTOUT,DUOUT,DIRUT,DIROUT
+16 ;
+17 ; If no Rx passed in, Quit out.
IF '$GET(PSORX)
QUIT
+18 ; Default Fill to 0 if none.
IF $GET(PSOFILL)=""
SET PSOFILL=0
+19 ; Default COB to 1/primary if none.
IF '$GET(PSOCOB)
SET PSOCOB=1
+20 ;
+21 ; IA 6226.
SET PSORESP=$$RESPONSE^BPSOS03(PSORX,PSOFILL,PSOCOB)
+22 IF PSORESP=""
QUIT
+23 ;
+24 WRITE !,"Total Amount Paid: ",$PIECE(PSORESP,U,1)
+25 WRITE ?39,"Ingredient Cost Paid: ",$PIECE(PSORESP,U,2)
+26 WRITE !,"Amount of Copay/Coinsurance: ",$PIECE(PSORESP,U,3)
+27 WRITE ?39,"Dispensing Fee Paid: ",$PIECE(PSORESP,U,4)
+28 WRITE !,"Amount Applied to Periodic Deductible: ",$PIECE(PSORESP,U,5)
+29 WRITE !,"Remaining Deductible Amount: ",$PIECE(PSORESP,U,6)
+30 ;
+31 SET DIR(0)="E"
SET DIR("A")="Press Return to continue"
+32 WRITE !
+33 DO ^DIR
+34 WRITE !
+35 ;
+36 QUIT
+37 ;
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 IF '$DATA(RFL)
SET RFL=$$LSTRFL(RX)
+9 ;cnf, PSO*7.0*358
NEW PSOET
SET PSOET=$$PSOET^PSOREJP3(RX,RFL)
+10 ;cnf, PSO*7.0*358, add PSOET check, allow reversal for TRICARE non-billable reject
IF 'PSOET
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 Act Log
+26 IF '$GET(NOACT)
IF REVECME
Begin DoDot:1
+27 SET ACT=$SELECT(PSOTRIC=1:"TRICARE ",PSOTRIC=2:"CHAMPVA ",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 RELEASE DATE from file 52 if DATE not passed in
+7 IF $GET(DATE)=""
SET DATE=$$RXRLDT^PSOBPSUT(RX,RFL)
+8 ; - If no date or future date, use today's date
+9 IF DATE>DT!'DATE
SET DATE=$$DT^XLFDT
+10 QUIT (DATE\1)
+11 ;
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 NEW IBAR,RXAR,RFAR,PSOIBN
+5 if '$DATA(RFL)
SET RFL=$$LSTRFL(RX)
+6 if '$DATA(USR)
SET USR=.5
+7 DO GETS^DIQ(52,RX_",",".01;2;6;7;8;22","I","RXAR")
+8 SET DFN=+$GET(RXAR(52,RX_",",2,"I"))
+9 SET IBAR("PRESCRIPTION")=RX
SET IBAR("RX NO")=$GET(RXAR(52,RX_",",.01,"I"))
+10 SET IBAR("CLAIMID")=$PIECE($$CLAIM^BPSBUTL(RX,RFL),U,6)
+11 SET IBAR("USER")=USR
+12 SET IBAR("DRUG")=RXAR(52,RX_",",6,"I")
SET IBAR("NDC")=$$GETNDC^PSONDCUT(RX,RFL)
+13 SET IBAR("FILL NUMBER")=RFL
SET IBAR("DOS")=$$DOS(RX,RFL)
SET IBAR("RELEASE DATE")=$$RXRLDT^PSOBPSUT(RX,RFL)
+14 SET IBAR("QTY")=$GET(RXAR(52,RX_",",7,"I"))
SET IBAR("DAYS SUPPLY")=$GET(RXAR(52,RX_",",8,"I"))
+15 IF RFL
Begin DoDot:1
+16 DO GETS^DIQ(52.1,RFL_","_RX_",",".01;1;1.1","I","RFAR")
+17 SET IBAR("QTY")=$GET(RFAR(52.1,RFL_","_RX_",",1,"I"))
+18 SET IBAR("DAYS SUPPLY")=$GET(RFAR(52.1,RFL_","_RX_",",1.1,"I"))
End DoDot:1
+19 SET IBAR("STATUS")="RELEASED"
+20 SET PSOIBN=$$STORESP^IBNCPDP(DFN,.IBAR)
+21 QUIT
+22 ;
LSTRFL(RX) ; - Returns the latest fill for the Rx
+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 Act to the ECME Act Log (FILE 52)
+1 ;Input: (r) RX - Rx IEN (#52)
+2 ; (o) RFL - Refill # (Default: most recent)
+3 ; (r) COMM - Comments (up to 100 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 Act 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
