- 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**;DEC 1997;Build 5
- ; 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) ; - 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
- ;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."
- 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))
- 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 15615 printed Jan 18, 2025@03:26:11 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**;DEC 1997;Build 5
- +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) ; - 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 ;Output: RESP - Response from $$EN^BPSNCPDP api
- +24 ;
- +25 NEW ACT,NDCACT,DA,PSOELIG,PSOBYPS,ACT1,SMA
- +26 IF '$DATA(RFL)
- SET RFL=$$LSTRFL(RX)
- +27 ; - ECME is not turned ON for the Rx's Division
- +28 IF '$GET(IGSW)
- IF '$$ECMEON^BPSUTIL($$RXSITE^PSOBPSUT(RX,RFL))
- SET RESP="-1^ECME SWITCH OFF"
- QUIT
- +29 ; - ECME CMOP is not turned ON for the Rx's Division
- +30 IF '$GET(IGSW)
- IF $GET(CMOP)
- IF '$$CMOPON^BPSUTIL($$RXSITE^PSOBPSUT(RX,RFL))
- SET RESP="-1^CMOP SWITCH OFF"
- QUIT
- +31 ; - Saving the NDC to be displayed on the ECME Act Log
- +32 IF $GET(CNDC)
- Begin DoDot:1
- +33 IF $GET(NDC)'=""
- SET NDCACT=NDC
- QUIT
- +34 SET NDCACT=$$GETNDC^PSONDCUT(RX,RFL)
- End DoDot:1
- +35 IF $$NDCFMT^PSSNDCUT($GET(NDC))=""
- Begin DoDot:1
- +36 SET NDC=$$GETNDC^PSSNDCUT($$GET1^DIQ(52,RX,6,"I"),$$RXSITE^PSOBPSUT(RX,RFL),+$GET(CMOP))
- +37 IF $GET(NDC)'=""
- DO SAVNDC^PSONDCUT(RX,RFL,NDC,+$GET(CMOP),1)
- End DoDot:1
- +38 SET PPDU=""
- SET PPDU=$$GPPDU^PSONDCUT(RX,RFL,NDC,,1,FROM)
- KILL PPDU
- +39 ;
- +40 ; Determine if this has multiple overrides from the SMA action of the reject worklist
- +41 SET SMA=0
- +42 IF $GET(OVRC)]""
- IF $GET(CLA)]""
- SET SMA=1
- +43 IF $GET(OVRC)]""
- IF $GET(PA)]""
- SET SMA=1
- +44 IF $GET(CLA)]""
- IF $GET(PA)]""
- SET SMA=1
- +45 ;
- +46 ; if the reversal reason text exists, remove semi-colons pso*7*448
- +47 IF $GET(RVTX)'=""
- SET RVTX=$TRANSLATE(RVTX,";","-")
- +48 ;
- +49 ; - Creating ECME Act Log in file 52
- +50 SET ACT=""
- +51 IF $$STATUS^PSOBPSUT(RX,RFL)="E PAYABLE"
- SET ACT="Rev/Resubmit "
- +52 SET ACT=ACT_"ECME:"
- +53 ;
- +54 ; - Marked any 'unresolved' REJECTS as 'resolved' (Reason: 1 - Claim re-submitted)
- +55 NEW CLSCOM
- +56 IF 'SMA
- Begin DoDot:1
- +57 IF $PIECE($GET(OVRC),"~")'=""
- SET CLSCOM="DUR Override Codes "_$TRANSLATE($PIECE(OVRC,"~"),"^","/")_" submitted."
- +58 IF $GET(CLA)'=""
- SET CLSCOM="Clarification Code(s) "_CLA_" submitted."
- +59 IF $GET(PA)'=""
- SET CLSCOM="Prior Authorization Code ("_$PIECE(PA,"^")_"/"_$PIECE(PA,"^",2)_") submitted."
- End DoDot:1
- +60 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))
- +61 ; - Call to ECME (NEWing STAT because ECME was overwriting it - Important variable for CMOP release PSXVND)
- +62 NEW STAT
- +63 IF $GET(RVTX)=""
- IF FROM="ED"
- SET RVTX="RX EDITED"
- +64 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))
- +65 IF $$STATUS^PSOBPSUT(RX,RFL)="E PAYABLE"
- Begin DoDot:1
- +66 DO SAVNDC^PSONDCUT(RX,RFL,NDC,+$GET(CMOP),1,FROM)
- +67 ;
- +68 ; MRD;PSO*7.0*448 - If this is a resubmit of a claim with an RRR
- +69 ; reject, and it came back E PAYABLE, then display some additional
- +70 ; information about the response to the claim, conditional upon the
- +71 ; value of FROM.
- +72 ;
- +73 IF ",ED,PE,PP,RF,RN,RRL,"[(","_FROM_",")
- IF $$RRR(RX,RFL)
- DO ADDLINFO(RX,RFL,$GET(RXCOB))
- +74 ;
- +75 QUIT
- End DoDot:1
- +76 ;
- +77 ; - Reseting the Re-transmission flag
- +78 DO RETRXF^PSOREJU2(RX,RFL,0)
- +79 ; Storing eligibility flag
- +80 SET PSOELIG=$PIECE(RESP,"^",3)
- if PSOELIG'=""
- DO ELIG^PSOBPSU2(RX,RFL,PSOELIG)
- +81 ;
- +82 ; Check if this is a bypass RX-claim. If it is, write it to the Bypass-Override Report
- +83 SET PSOBYPS=$$BYPASS(PSOELIG,$PIECE(RESP,"^",2))
- +84 IF PSOBYPS
- DO EN^PSOBORP2(RX,RFL,RESP)
- +85 ;
- +86 ; If from SMA action, split message across multiple log entries
- +87 ; The last entry will be filed in the code that follows this section as we append other data
- +88 ; to the last message.
- +89 IF SMA
- IF +RESP'=2
- IF +RESP'=6
- IF +RESP'=10
- Begin DoDot:1
- +90 NEW MSG
- +91 ; If there are DUR overrides, create the message and file it since this will never be the last message
- +92 IF $GET(OVRC)]""
- Begin DoDot:2
- +93 SET MSG=ACT_"REJECT WORKLIST-DUR OVERRIDE CODES("_$TRANSLATE(OVRC,"^","/")_")"
- +94 DO RXACT^PSOBPSU2(RX,RFL,MSG,"M",DUZ)
- End DoDot:2
- +95 ; If there are Clarification codes, create the message
- +96 ; Only file it if we also have a Prior Auth message.
- +97 ; Otherwise more data will be added to it and it will be filed below.
- +98 IF $GET(CLA)]""
- Begin DoDot:2
- +99 SET MSG=ACT_"REJECT WORKLIST-(CLARIF. CODE="_CLA_")"
- +100 IF $GET(PA)]""
- DO RXACT^PSOBPSU2(RX,RFL,MSG,"M",DUZ)
- End DoDot:2
- +101 ; If there are Prior Auth overrides, create the message.
- +102 ; More data will be added to it and it will be filed below.
- +103 IF $GET(PA)]""
- Begin DoDot:2
- +104 SET ALTX="REJECT WORKLIST-(PRIOR AUTH.="_$TRANSLATE(PA,"^","/")_")"
- End DoDot:2
- End DoDot:1
- +105 ;
- +106 ; - Logging ECME Act Log to file 52
- +107 IF $GET(ALTX)=""
- Begin DoDot:1
- +108 NEW X,ROUTE
- SET (ROUTE,X)=""
- +109 SET ROUTE=$SELECT(FROM="RF":$$GET1^DIQ(52.1,RFL_","_RX_",",2),FROM="OF":$$GET1^DIQ(52,RX_",",11),1:"")
- +110 if FROM="OF"
- SET X=ROUTE_" FILL(NDC:"_$$GETNDC^PSONDCUT(RX,RFL)_")"
- +111 if FROM="RF"
- SET X=ROUTE_" REFILL(NDC:"_$$GETNDC^PSONDCUT(RX,RFL)_")"
- +112 if FROM="RN"
- SET X="RX RENEWED(NDC:"_$$GETNDC^PSONDCUT(RX,RFL)_")"
- +113 if FROM="PL"
- SET X="PRINTED FROM SUSPENSE(NDC:"_$$GETNDC^PSONDCUT(RX,RFL)_")"
- +114 if FROM="PE"!(FROM="PP")
- SET X="PULLED FROM SUSPENSE(NDC:"_$$GETNDC^PSONDCUT(RX,RFL)_")"
- +115 if FROM="PC"
- SET X="CMOP TRANSMISSION(NDC:"_$$GETNDC^PSONDCUT(RX,RFL)_")"
- +116 if FROM="RRL"!(FROM="CRRL")
- SET X="RELEASED RX PREVIOUSLY REVERSED"
- +117 if FROM="ED"
- SET X="RX EDITED"
- +118 if $GET(RVTX)'=""
- SET X=RVTX
- +119 IF 'SMA
- IF $GET(OVRC)'=""
- SET X="DUR OVERRIDE CODES("_$TRANSLATE(OVRC,"^","/")_")"
- +120 if $GET(CNDC)
- SET X=X_"(NDC:"_NDCACT_")"
- SET ACT=ACT_X
- +121 SET ACT=ACT_$$STS(RX,RFL,RESP)
- End DoDot:1
- +122 IF $GET(ALTX)'=""
- SET ACT=ACT_ALTX_$$STS(RX,RFL,RESP)
- +123 IF +RESP=2
- SET ACT="Not ECME Billable: "_$PIECE(RESP,"^",2)
- +124 IF +RESP=6
- SET ACT=$PIECE(RESP,"^",2)
- +125 IF +RESP=10
- SET ACT="ECME reversed/NOT re-submitted: "_$PIECE(RESP,"^",2)
- +126 if PSOELIG="T"
- SET ACT="TRICARE-"_ACT
- +127 if PSOELIG="C"
- SET ACT="CHAMPVA-"_ACT
- +128 SET ACT1=""
- +129 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)
- +130 SET ACT=$EXTRACT(ACT_ACT1,1,75)
- +131 DO RXACT^PSOBPSU2(RX,RFL,ACT,"M",DUZ)
- +132 ;-Logs an ECME Act Log if Rx Qty is different than Billing Qty
- DO ELOG^PSOBPSU2(RESP)
- +133 ; If not a bypass RX-claim, then call TRICCHK so the user can process
- +134 DO LOG^BPSOSL($$IEN59^BPSOSRX(RX,RFL),$TEXT(+0)_"-ECMESND, RESP="_RESP)
- +135 DO LOG^BPSOSL($$IEN59^BPSOSRX(RX,RFL),$TEXT(+0)_"-ECMESND, FROM="_FROM_" PSOELIG="_PSOELIG_" PSOBYPS="_PSOBYPS)
- +136 IF PSOELIG="T"!(PSOELIG="C")
- IF 'PSOBYPS
- DO TRICCHK^PSOREJU3(RX,RFL,RESP,FROM,$GET(RVTX))
- +137 QUIT
- +138 ;
- 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