Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: PSOBPSU1

PSOBPSU1.m

Go to the documentation of this file.
  1. 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
  1. ; Reference to $$EN^BPSNCPDP in ICR #4415
  1. ; Reference to $$NDCFMT^PSSNDCUT,$$GETNDC^PSSNDCUT in ICR #4707
  1. ; Reference to $$ECMEON^BPSUTIL,$$CMOPON^BPSUTIL in ICR #4410
  1. ; Reference to $$STORESP^IBNCPDP in ICR #4299
  1. ; Reference to $$CLAIM^BPSBUTL in ICR #4719
  1. ; Reference to $$RESPONSE^BPSOS03 in ICR #6226
  1. ; Reference to $$LOG^BPSOSL in ICR #6764
  1. ;
  1. 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
  1. ;Input: (r) RX - Rx IEN (#52)
  1. ; (o) RFL - Refill # (Default: most recent)
  1. ; (o) DATE - Date of Service
  1. ; (r) FROM - Function within OP (See BWHERE param. in EN^BPSNCPDP api)
  1. ; (o) NDC - NDC Number (If not passed, will be retrieved from DRUG file)
  1. ; (o) CMOP - CMOP Rx (1-YES/0-NO) (Default: 0)
  1. ; (o) RVTX - REVERSE text (e.g., RX EDIT, RX RELEASE-NDC CHANGE, etc)
  1. ; (o) OVRC - Three sets of 3 NCPDP override codes separated by "~". Each piece of the set
  1. ; is delimited by an "^"
  1. ; Piece 1: NCPDP Reason for Service Code for overriding DUR REJECTS
  1. ; Piece 2: NCPDP Professional Service Code for overriding DUR REJECTS
  1. ; Piece 3: NCPDP Result of Service Code for overriding DUR REJECTS
  1. ; (o) CNDC - Changed NDC? 1 - Yes / 0 - No (Default: NO)
  1. ; (o) IGSW - Ignore Switches (Master and CMOP)? 1 - Yes / 0 - No (Default: NO)
  1. ; (o) ALTX - Alternative Text to be placed in the Rx ECME Activity Log
  1. ; (o) CLA - NCPDP Clarification Code(s) for overriding DUR/RTS REJECTS
  1. ; (o) PA - NCPDP Prior Authorization Type and Number (separated by "^")
  1. ; (o) RXCOB- Payer Sequence
  1. ; (o) PSOVRIEN - IEN to BPS NCPDP OVERRIDE (#9002313.511)
  1. ; (o) PSOPLAN - IEN to file# 355.3, GROUP INSURANCE PLAN
  1. ; (o) PSORTYPE - IEN to file# 399.3, RATE TYPE
  1. ;Output: RESP - Response from $$EN^BPSNCPDP api
  1. ;
  1. N ACT,NDCACT,DA,PSOELIG,PSOBYPS,ACT1,SMA
  1. I '$D(RFL) S RFL=$$LSTRFL(RX)
  1. ; - ECME is not turned ON for the Rx's Division
  1. I '$G(IGSW),'$$ECMEON^BPSUTIL($$RXSITE^PSOBPSUT(RX,RFL)) S RESP="-1^ECME SWITCH OFF" Q
  1. ; - ECME CMOP is not turned ON for the Rx's Division
  1. I '$G(IGSW),$G(CMOP),'$$CMOPON^BPSUTIL($$RXSITE^PSOBPSUT(RX,RFL)) S RESP="-1^CMOP SWITCH OFF" Q
  1. ; - Saving the NDC to be displayed on the ECME Act Log
  1. I $G(CNDC) D
  1. . I $G(NDC)'="" S NDCACT=NDC Q
  1. . S NDCACT=$$GETNDC^PSONDCUT(RX,RFL)
  1. I $$NDCFMT^PSSNDCUT($G(NDC))="" D
  1. . S NDC=$$GETNDC^PSSNDCUT($$GET1^DIQ(52,RX,6,"I"),$$RXSITE^PSOBPSUT(RX,RFL),+$G(CMOP))
  1. . I $G(NDC)'="" D SAVNDC^PSONDCUT(RX,RFL,NDC,+$G(CMOP),1)
  1. S PPDU="",PPDU=$$GPPDU^PSONDCUT(RX,RFL,NDC,,1,FROM) K PPDU
  1. ;
  1. ; Determine if this has multiple overrides from the SMA action of the reject worklist
  1. S SMA=0
  1. I $G(OVRC)]"",$G(CLA)]"" S SMA=1
  1. I $G(OVRC)]"",$G(PA)]"" S SMA=1
  1. I $G(CLA)]"",$G(PA)]"" S SMA=1
  1. ;
  1. ; if the reversal reason text exists, remove semi-colons pso*7*448
  1. I $G(RVTX)'="" S RVTX=$TR(RVTX,";","-")
  1. ;
  1. ; - Creating ECME Act Log in file 52
  1. S ACT=""
  1. I $$STATUS^PSOBPSUT(RX,RFL)="E PAYABLE" S ACT="Rev/Resubmit "
  1. S ACT=ACT_"ECME:"
  1. ;
  1. ; - Marked any 'unresolved' REJECTS as 'resolved' (Reason: 1 - Claim re-submitted)
  1. N CLSCOM
  1. I 'SMA D
  1. . I $P($G(OVRC),"~")'="" S CLSCOM="DUR Override Codes "_$TR($P(OVRC,"~"),"^","/")_" submitted."
  1. . I $G(CLA)'="" S CLSCOM="Clarification Code(s) "_CLA_" submitted."
  1. . I $G(PA)'="" S CLSCOM="Prior Authorization Code ("_$P(PA,"^")_"/"_$P(PA,"^",2)_") submitted."
  1. 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))
  1. ; - Call to ECME (NEWing STAT because ECME was overwriting it - Important variable for CMOP release PSXVND)
  1. N STAT
  1. I $G(RVTX)="",FROM="ED" S RVTX="RX EDITED"
  1. 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))
  1. I $$STATUS^PSOBPSUT(RX,RFL)="E PAYABLE" D
  1. . D SAVNDC^PSONDCUT(RX,RFL,NDC,+$G(CMOP),1,FROM)
  1. . ;
  1. . ; MRD;PSO*7.0*448 - If this is a resubmit of a claim with an RRR
  1. . ; reject, and it came back E PAYABLE, then display some additional
  1. . ; information about the response to the claim, conditional upon the
  1. . ; value of FROM.
  1. . ;
  1. . I ",ED,PE,PP,RF,RN,RRL,"[(","_FROM_","),$$RRR(RX,RFL) D ADDLINFO(RX,RFL,$G(RXCOB))
  1. . ;
  1. . Q
  1. ;
  1. ; - Reseting the Re-transmission flag
  1. D RETRXF^PSOREJU2(RX,RFL,0)
  1. ; Storing eligibility flag
  1. S PSOELIG=$P(RESP,"^",3) D:PSOELIG'="" ELIG^PSOBPSU2(RX,RFL,PSOELIG)
  1. ;
  1. ; Check if this is a bypass RX-claim. If it is, write it to the Bypass-Override Report
  1. S PSOBYPS=$$BYPASS(PSOELIG,$P(RESP,"^",2))
  1. I PSOBYPS D EN^PSOBORP2(RX,RFL,RESP)
  1. ;
  1. ; If from SMA action, split message across multiple log entries
  1. ; The last entry will be filed in the code that follows this section as we append other data
  1. ; to the last message.
  1. I SMA,+RESP'=2,+RESP'=6,+RESP'=10 D
  1. . N MSG
  1. . ; If there are DUR overrides, create the message and file it since this will never be the last message
  1. . I $G(OVRC)]"" D
  1. .. S MSG=ACT_"REJECT WORKLIST-DUR OVERRIDE CODES("_$TR(OVRC,"^","/")_")"
  1. .. D RXACT^PSOBPSU2(RX,RFL,MSG,"M",DUZ)
  1. . ; If there are Clarification codes, create the message
  1. . ; Only file it if we also have a Prior Auth message.
  1. . ; Otherwise more data will be added to it and it will be filed below.
  1. . I $G(CLA)]"" D
  1. .. S MSG=ACT_"REJECT WORKLIST-(CLARIF. CODE="_CLA_")"
  1. .. I $G(PA)]"" D RXACT^PSOBPSU2(RX,RFL,MSG,"M",DUZ)
  1. . ; If there are Prior Auth overrides, create the message.
  1. . ; More data will be added to it and it will be filed below.
  1. . I $G(PA)]"" D
  1. .. S ALTX="REJECT WORKLIST-(PRIOR AUTH.="_$TR(PA,"^","/")_")"
  1. ;
  1. ; - Logging ECME Act Log to file 52
  1. I $G(ALTX)="" D
  1. . N X,ROUTE S (ROUTE,X)=""
  1. . S ROUTE=$S(FROM="RF":$$GET1^DIQ(52.1,RFL_","_RX_",",2),FROM="OF":$$GET1^DIQ(52,RX_",",11),1:"")
  1. . S:FROM="OF" X=ROUTE_" FILL(NDC:"_$$GETNDC^PSONDCUT(RX,RFL)_")"
  1. . S:FROM="RF" X=ROUTE_" REFILL(NDC:"_$$GETNDC^PSONDCUT(RX,RFL)_")"
  1. . S:FROM="RN" X="RX RENEWED(NDC:"_$$GETNDC^PSONDCUT(RX,RFL)_")"
  1. . S:FROM="PL" X="PRINTED FROM SUSPENSE(NDC:"_$$GETNDC^PSONDCUT(RX,RFL)_")"
  1. . S:FROM="PE"!(FROM="PP") X="PULLED FROM SUSPENSE(NDC:"_$$GETNDC^PSONDCUT(RX,RFL)_")"
  1. . S:FROM="PC" X="CMOP TRANSMISSION(NDC:"_$$GETNDC^PSONDCUT(RX,RFL)_")"
  1. . S:FROM="RRL"!(FROM="CRRL") X="RELEASED RX PREVIOUSLY REVERSED"
  1. . S:FROM="ED" X="RX EDITED"
  1. . S:$G(RVTX)'="" X=RVTX
  1. . I 'SMA,$G(OVRC)'="" S X="DUR OVERRIDE CODES("_$TR(OVRC,"^","/")_")"
  1. . S:$G(CNDC) X=X_"(NDC:"_NDCACT_")" S ACT=ACT_X
  1. . S ACT=ACT_$$STS(RX,RFL,RESP)
  1. I $G(ALTX)'="" S ACT=ACT_ALTX_$$STS(RX,RFL,RESP)
  1. I +RESP=2 S ACT="Not ECME Billable: "_$P(RESP,"^",2)
  1. I +RESP=6 S ACT=$P(RESP,"^",2)
  1. I +RESP=10 S ACT="ECME reversed/NOT re-submitted: "_$P(RESP,"^",2)
  1. S:PSOELIG="T" ACT="TRICARE-"_ACT
  1. S:PSOELIG="C" ACT="CHAMPVA-"_ACT
  1. S ACT1=""
  1. 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)
  1. S ACT=$E(ACT_ACT1,1,75)
  1. D RXACT^PSOBPSU2(RX,RFL,ACT,"M",DUZ)
  1. D ELOG^PSOBPSU2(RESP) ;-Logs an ECME Act Log if Rx Qty is different than Billing Qty
  1. ; If not a bypass RX-claim, then call TRICCHK so the user can process
  1. D LOG^BPSOSL($$IEN59^BPSOSRX(RX,RFL),$T(+0)_"-ECMESND, RESP="_RESP)
  1. D LOG^BPSOSL($$IEN59^BPSOSRX(RX,RFL),$T(+0)_"-ECMESND, FROM="_FROM_" PSOELIG="_PSOELIG_" PSOBYPS="_PSOBYPS)
  1. I PSOELIG="T"!(PSOELIG="C"),'PSOBYPS D TRICCHK^PSOREJU3(RX,RFL,RESP,FROM,$G(RVTX))
  1. Q
  1. ;
  1. BYPASS(PSOELIG,REASON) ;PSO*427
  1. ; Check if this Rx gets bypassed. Bypassed Rx show up on the TRICARE/CHAMPVA
  1. ; Override/Bypass Report and will not get the Reject Notification Screen.
  1. ;
  1. ; Input:
  1. ; POSELIG: Eligibility (C:CHAMPVA, T:TRICARE, V:VETERAN)
  1. ; REASON: Non billable reason returned by ECME
  1. ; Output:
  1. ; 0: Not a Bypass Rx
  1. ; 1: Bypass Rx
  1. ;
  1. ; Check Parameters
  1. I $G(PSOELIG)="" Q 0
  1. I $G(REASON)="" Q 0
  1. ;
  1. ; Only TRICARE and CHAMPVA are bypassed
  1. I PSOELIG'="T",PSOELIG'="C" Q 0
  1. ;
  1. ; Check for TRICARE/CHAMPVA and EI (Veteran claims would not have gotten this far)
  1. I ",AGENT ORANGE,IONIZING RADIATION,SC TREATMENT,SOUTHWEST ASIA,MILITARY SEXUAL TRAUMA,HEAD/NECK CANCER,COMBAT VETERAN,PROJECT 112/SHAD,"[(","_REASON_",") Q 1
  1. Q 0
  1. ;
  1. 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
  1. ; information for RRR resubmits. Return '1' if this Rx has a reject
  1. ; with the RRR flag set, otherwise return '0'.
  1. ; Input: (r) PSORX - Rx IEN (#52)
  1. ; (o) PSOFILL - Refill#
  1. ; Output: '1' if RRR, '0' if not
  1. ;
  1. N PSOREJ,PSORRR
  1. ;
  1. I '$G(PSORX) Q 0
  1. I $G(PSOFILL)="" S PSOFILL=0
  1. ;
  1. ; Loop through the Reject Info sub-file. If the Fill# on a Reject is
  1. ; the same as PSOFILL, and if the Reject is RRR, then set the flag and
  1. ; quit out.
  1. ;
  1. S PSORRR=0
  1. S PSOREJ=0
  1. F S PSOREJ=$O(^PSRX(PSORX,"REJ",PSOREJ)) Q:'PSOREJ D Q:PSORRR
  1. . I $$GET1^DIQ(52.25,PSOREJ_","_PSORX,5)'=PSOFILL Q
  1. . I $$GET1^DIQ(52.25,PSOREJ_","_PSORX,30,"I") S PSORRR=1
  1. . Q
  1. ;
  1. Q PSORRR
  1. ;
  1. ADDLINFO(PSORX,PSOFILL,PSOCOB) ; Display additional information for RRR resubmits.
  1. ; MRD;PSO*7.0*448 - Display addition information for a paid claim.
  1. ; Input: (r) PSORX - Rx IEN (#52)
  1. ; (o) PSOFILL - Refill#
  1. ; (o) PSOCOB - Payer Sequence
  1. ;
  1. ; Use $$RESPONSE^BPSOS03 to pull the following fields from the BPS
  1. ; Response file, then display those fields.
  1. ; - Total Amount Paid, field #509
  1. ; - Ingredient Cost Paid, field #506
  1. ; - Amount of Copay/Coinsurance, field #518
  1. ; - Dispensing Fee Paid, field #507
  1. ; - Amount Applied to Periodic Deductible, field #517
  1. ; - Remaining Deductible Amount, field #513
  1. ;
  1. N PSORESP,DIR,X,Y,DTOUT,DUOUT,DIRUT,DIROUT
  1. ;
  1. I '$G(PSORX) Q ; If no Rx passed in, Quit out.
  1. I $G(PSOFILL)="" S PSOFILL=0 ; Default Fill to 0 if none.
  1. I '$G(PSOCOB) S PSOCOB=1 ; Default COB to 1/primary if none.
  1. ;
  1. S PSORESP=$$RESPONSE^BPSOS03(PSORX,PSOFILL,PSOCOB) ; IA 6226.
  1. I PSORESP="" Q
  1. ;
  1. W !,"Total Amount Paid: ",$P(PSORESP,U,1)
  1. W ?39,"Ingredient Cost Paid: ",$P(PSORESP,U,2)
  1. W !,"Amount of Copay/Coinsurance: ",$P(PSORESP,U,3)
  1. W ?39,"Dispensing Fee Paid: ",$P(PSORESP,U,4)
  1. W !,"Amount Applied to Periodic Deductible: ",$P(PSORESP,U,5)
  1. W !,"Remaining Deductible Amount: ",$P(PSORESP,U,6)
  1. ;
  1. S DIR(0)="E",DIR("A")="Press Return to continue"
  1. W !
  1. D ^DIR
  1. W !
  1. ;
  1. Q
  1. ;
  1. REVERSE(RX,RFL,FROM,RSN,RTXT,IGRL,NDC) ; - Reverse a claim and close all OPEN/UNRESOLVED Rejects
  1. ;Input: (r) RX - Rx IEN (#52)
  1. ; (o) RFL - Refill # (Default: most recent)
  1. ; (r) FROM - Function within OP (See BWHERE param. in EN^BPSNCPDP api)
  1. ; (o) RSN - Close Reason (2:RX ON HOLD;4: RX RETURNED TO STOCK,5:RX DELETED,etc...)
  1. ; (o) RTXT - Close Reason TEXT (Usually no passed if RSN is passed)
  1. ; (o) IGRL - Ignore RELEASE DATE, reverse anyway
  1. ; (o) NDC - NDC number related to the reversal (Note: might be an invalid NDC)
  1. I '$D(RFL) S RFL=$$LSTRFL(RX)
  1. N PSOET S PSOET=$$PSOET^PSOREJP3(RX,RFL) ;cnf, PSO*7.0*358
  1. I 'PSOET,$$STATUS^PSOBPSUT(RX,RFL)="" Q ;cnf, PSO*7.0*358, add PSOET check, allow reversal for TRICARE non-billable reject
  1. N RESP,STS,ACT,STAT,DA,STATUS,NOACT,REVECME S RSN=+$G(RSN),RTXT=$G(RTXT),REVECME=1
  1. I RTXT="",RSN D
  1. . S:RSN=2 RTXT="RX PLACED ON HOLD" S:RSN=3 RTXT="RX SUSPENDED" S:RSN=4 RTXT="RX RETURNED TO STOCK"
  1. . S:RSN=5 RTXT="RX DELETED" S:RSN=7 RTXT="RX DISCONTINUED" S:RSN=8 RTXT="RX EDITED"
  1. D CLSALL^PSOREJUT(RX,RFL,DUZ,RSN,RTXT)
  1. I '$G(IGRL),$$RXRLDT^PSOBPSUT(RX,RFL) Q
  1. ; - Reseting the Re-transmission flag if Rx is being suspended
  1. I RSN=3!($$GET1^DIQ(52,RX,100,"I")=5) D RETRXF^PSOREJU2(RX,RFL,1)
  1. S STATUS=$$STATUS^PSOBPSUT(RX,RFL),NOACT=0
  1. I STATUS'="E PAYABLE",STATUS'="IN PROGRESS",STATUS'="E REVERSAL REJECTED",STATUS'="E REVERSAL STRANDED",STATUS'="E DUPLICATE" S NOACT=1
  1. ; Only perform ECME reversal for a released CMOP if rx/fill is Discontinued.
  1. I FROM="DC",$$CMOP^PSOBPSUT(RX,RFL) S REVECME=0
  1. I REVECME S RESP=$$EN^BPSNCPDP(RX,RFL,$$DOS(RX,RFL),FROM,$$GETNDC^PSONDCUT(RX,RFL),RTXT)
  1. N PSOTRIC S PSOTRIC="",PSOTRIC=$$TRIC^PSOREJP1(RX,RFL,PSOTRIC)
  1. ; - Logging ECME Act Log
  1. I '$G(NOACT),REVECME D
  1. . S ACT=$S(PSOTRIC=1:"TRICARE ",PSOTRIC=2:"CHAMPVA ",1:"")_"Reversal sent to ECME: "_RTXT_$S($G(NDC)'="":" ("_NDC_")",1:"")_$$STS(RX,RFL,+RESP)
  1. . D RXACT^PSOBPSU2(RX,RFL,ACT,"M",DUZ)
  1. Q
  1. ;
  1. DOS(RX,RFL,DATE) ; Return the Date Of Service for ECME
  1. ;Input: (r) RX - Rx IEN (#52)
  1. ; (o) RFL - Refill # (Default: most recent)
  1. ; (o) DATE - Possible Date Of Service
  1. ;Output: DOS - Actual Date Of Service
  1. I '$D(RFL) S RFL=$$LSTRFL(RX)
  1. ; - Retrieving RELEASE DATE from file 52 if DATE not passed in
  1. I $G(DATE)="" S DATE=$$RXRLDT^PSOBPSUT(RX,RFL)
  1. ; - If no date or future date, use today's date
  1. I DATE>DT!'DATE S DATE=$$DT^XLFDT
  1. Q (DATE\1)
  1. ;
  1. RELEASE(RX,RFL,USR) ; - Notifies IB that the Rx was RELEASED
  1. ;Input: (r) RX - Rx IEN (#52)
  1. ; (o) RFL - Refill # (Default: most recent)
  1. ; (o) USR - User responsible for releasing the Rx (Default: .5 - Postmaster)
  1. N IBAR,RXAR,RFAR,PSOIBN
  1. S:'$D(RFL) RFL=$$LSTRFL(RX)
  1. S:'$D(USR) USR=.5
  1. D GETS^DIQ(52,RX_",",".01;2;6;7;8;22","I","RXAR")
  1. S DFN=+$G(RXAR(52,RX_",",2,"I"))
  1. S IBAR("PRESCRIPTION")=RX,IBAR("RX NO")=$G(RXAR(52,RX_",",.01,"I"))
  1. S IBAR("CLAIMID")=$P($$CLAIM^BPSBUTL(RX,RFL),U,6)
  1. S IBAR("USER")=USR
  1. S IBAR("DRUG")=RXAR(52,RX_",",6,"I"),IBAR("NDC")=$$GETNDC^PSONDCUT(RX,RFL)
  1. S IBAR("FILL NUMBER")=RFL,IBAR("DOS")=$$DOS(RX,RFL),IBAR("RELEASE DATE")=$$RXRLDT^PSOBPSUT(RX,RFL)
  1. S IBAR("QTY")=$G(RXAR(52,RX_",",7,"I")),IBAR("DAYS SUPPLY")=$G(RXAR(52,RX_",",8,"I"))
  1. I RFL D
  1. . D GETS^DIQ(52.1,RFL_","_RX_",",".01;1;1.1","I","RFAR")
  1. . S IBAR("QTY")=$G(RFAR(52.1,RFL_","_RX_",",1,"I"))
  1. . S IBAR("DAYS SUPPLY")=$G(RFAR(52.1,RFL_","_RX_",",1.1,"I"))
  1. S IBAR("STATUS")="RELEASED"
  1. S PSOIBN=$$STORESP^IBNCPDP(DFN,.IBAR)
  1. Q
  1. ;
  1. LSTRFL(RX) ; - Returns the latest fill for the Rx
  1. ; Input: (r) RX - Rx IEN (#52)
  1. ;Output: LSTRFL - Most recent refill #
  1. N I,LSTRFL
  1. S (I,LSTRFL)=0 F S I=$O(^PSRX(RX,1,I)) Q:'I S LSTRFL=I
  1. Q LSTRFL
  1. ;
  1. ECMEACT(RX,RFL,COMM,USR) ; - Add an Act to the ECME Act Log (FILE 52)
  1. ;Input: (r) RX - Rx IEN (#52)
  1. ; (o) RFL - Refill # (Default: most recent)
  1. ; (r) COMM - Comments (up to 100 characters)
  1. ; (o) USR - User logging the comments (Default: DUZ)
  1. S:'$D(RFL) RFL=$$LSTRFL^PSOBPSU1(RX)
  1. D RXACT^PSOBPSU2(RX,RFL,COMM,"M",+$G(USR))
  1. Q
  1. ;
  1. STS(RX,RFL,RSP) ; Adds the Status to the ECME Act Log according to Rx/fill claim status Response
  1. N STS
  1. S STS=$S($$STATUS^PSOBPSUT(RX,RFL)'="IN PROGRESS"&($$STATUS^PSOBPSUT(RX,RFL)'=""):"-"_$$STATUS^PSOBPSUT(RX,RFL),1:"")
  1. S:+RSP=1 STS="-NO SUBMISSION THROUGH ECME" S:+RSP=3 STS="-NO REVERSAL NEEDED" S:+RSP=4 STS="-NOT PROCESSED"
  1. S:+RSP=5 STS="-SOFTWARE ERROR"_$S($P($G(RESP),"^",2)'="":" ("_$P(RESP,"^",2)_")",1:"")
  1. I +RSP=2,$$STATUS^PSOBPSUT(RX,RFL)'="" S STS="-NOT BILLABLE:"_$S(PSOELIG="T":"TRICARE",PSOELIG="C":"CHAMPVA",1:"")_":"_$P(RSP,"^",2)
  1. Q STS