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

PSOBPSUT.m

Go to the documentation of this file. 
  1. PSOBPSUT ;BIRM/MFR - BPS (ECME) Utilities ;29-May-2012 14:40;PLS
  1.  ;;7.0;OUTPATIENT PHARMACY;**148,247,260,281,287,289,1015**;DEC 1997;Build 62
  1.  ;Reference to $$ECMEON^BPSUTIL supported by IA 4410
  1.  ;Reference to IBSEND^BPSECMP2 supported by IA 4411
  1.  ;Reference to $$STATUS^BPSOSRX supported by IA 4412
  1.  ;Reference to $$NDCFMT^PSSNDCUT supported by IA 4707
  1.  ;Reference to $$CLAIM^BPSBUTL supported by IA 4719
  1.  ;Reference to ^PS(55 supported by IA 2228
  1.  ;Reference to ^PSDRUG( supported by IA 221
  1.  ;Reference to ^PSDRUG("AQ" supported by IA 3165
  1.  ;
  1.  ;Modified - IHS/MSC/PLS - 05/20/2010 - Line SUBMIT+7
  1.  ;                                           ECME+1
  1.  ;                                           STATUS+3
  1.  ;                         05/26/2010 - Line MANREL+6
  1.  ;                         06/01/2010 - Line AUTOREL+10
  1. ECME(RX) ; Returns "e" if Rx/Refill is Electronically Billable (3rd party)
  1.  Q ""  ;IHS/MSC/PLS - 5/20/2010
  1.  Q $S($$STATUS^BPSOSRX(RX,$$LSTRFL^PSOBPSU1(RX))'="":"e",1:"")
  1.  ;
  1. STATUS(RX,RFL) ; Returns the Rx's ECME Status (calls STATUS^BPSOSRX)
  1.  ; Input:  (r) RX  - Rx IEN (#52)
  1.  ;         (o) RFL - Refill # (Default: most recent)
  1.  Q ""  ;IHS/MSC/PLS - 05/20/2010
  1.  I '$D(RFL) S RFL=$$LSTRFL^PSOBPSU1(RX)
  1.  Q $P($$STATUS^BPSOSRX(RX,RFL),"^")
  1.  ;
  1. SUBMIT(RX,RFL,IGRL,IGCMP) ; Returns whether the Rx should be submitted to ECME at the moment or not
  1.  ; Input:  (r) RX   - Rx IEN (#52)
  1.  ;         (o) RFL  - Refill # (Def.: most recent)
  1.  ;         (o) IGRL - Ignore Release Date? (1-YES/0-NO) (Def.: 0 - NO)
  1.  ;         (o) IGCMP- Ignore CMOP/Suspense check? (1-YES/0-NO) (Def.: 0 - NO)
  1.  ;
  1.  ; - Get the REFILL # (multiple IEN)
  1.  Q 0  ;IHS/MSC/PLS - 05/20/2010
  1.  N STATUS
  1.  I '$D(RFL) S RFL=$$LSTRFL^PSOBPSU1(RX)
  1.  ; - Not the latest fill for the prescription
  1.  I RFL'=$$LSTRFL^PSOBPSU1(RX) Q 0
  1.  ; - Status not ACTIVE, DISCONTINUED, or EXPIRED
  1.  S STATUS=$$GET1^DIQ(52,RX,100,"I")
  1.  I ",0,11,12,14,15,"'[(","_STATUS_",") Q 0
  1.  ; Will suspend for CMOP
  1.  I '$G(IGCMP),$$CMOP(RX,RFL) Q 0
  1.  ; - ECME turned OFF for Rx's site
  1.  I '$$ECMEON^BPSUTIL($$RXSITE(RX,RFL)) Q 0
  1.  ; - Rx is RELEASED - Do not submit
  1.  I '$G(IGRL),$$RXRLDT(RX,RFL) Q 0
  1.  ; - Future Fill/AUTO SUSPENSE ON - will suspend
  1.  I '$G(IGCMP),$$RXFLDT(RX,RFL)>DT,$$GET1^DIQ(59,$$RXSITE(RX,RFL),.16,"I") Q 0
  1.  Q 1
  1.  ;
  1. CMOP(RX,RFL) ; Returns if the Rx will be a CMOP Rx or not
  1.  ; Input:  (r) RX  - Rx IEN (#52)
  1.  ;         (o) RFL - Refill # (Default: most recent)
  1.  ; Output: 1 - CMOP / 0 - NON-CMOP
  1.  ;
  1.  N DFN,CMOP,MAIL,MAILEXP,DRUG,WARNS,STATUS,MW,A
  1.  ; Get the REFILL # (multiple IEN)
  1.  I '$D(RFL) S RFL=$$LSTRFL^PSOBPSU1(RX)
  1.  ; MAIL=MAIL Code, MAILEXP=Mail Code Expiration Date
  1.  S CMOP=0
  1.  S DFN=$$GET1^DIQ(52,RX,2,"I"),MAIL=$$GET1^DIQ(55,DFN,.03,"I"),MAILEXP=$$GET1^DIQ(55,DFN,.05,"I")
  1.  I MAIL>1,MAILEXP=""!(MAILEXP>DT) G QCMOP
  1.  ; Get drug IEN and check DRUG if CMOP  ,$S($G(MAILEXP)=""!($G(MAILEXP)>DT):1,1:0)
  1.  S DRUG=$$GET1^DIQ(52,RX,6,"I") G QCMOP:'DRUG,QCMOP:'$D(^PSDRUG("AQ",DRUG))
  1.  ; Not marked for O.P.
  1.  I $$GET1^DIQ(50,DRUG,63)'["O" G QCMOP
  1.  ; Drug Warning >11
  1.  S WARNS=$$GET1^DIQ(50,DRUG,8) I $L(WARNS)>11 G QCMOP
  1.  ; If tradename
  1.  I $$GET1^DIQ(52,RX,6.5)'="" G QCMOP
  1.  ; If Cancelled, Expired, Deleted, Hold
  1.  S STATUS=$$GET1^DIQ(52,RX,100,"I") I (STATUS>9&(",14,15,"'[(","_STATUS_",")))!(STATUS=4)!(STATUS=3) G QCMOP
  1.  ; Rx RELEASED
  1.  I $$RXRLDT^PSOBPSUT(RX,RFL) G QCMOP
  1.  ; MAIL/WINDOW
  1.  S MW=$S('RFL:$$GET1^DIQ(52,RX,11,"I"),1:$$GET1^DIQ(52.1,RFL_","_RX,2,"I"))
  1.  ; IF WINDOW/ORIGINAL/FUTURE FILL SETS MW = MAIL
  1.  I MW="W",$$RXFLDT^PSOBPSUT(RX,RFL)>DT S MW="M"
  1.  ; If not MAIL
  1.  I MW'="M" G QCMOP
  1.  S CMOP=1
  1.  ;
  1. QCMOP Q CMOP
  1.  ;
  1. RXRLDT(RX,RFL) ; Returns the Rx Release Date
  1.  ; Input:  (r) RX  - Rx IEN (#52)
  1.  ;         (o) RFL - Refill # (Default: most recent)
  1.  ;
  1.  ; Output:  RXRLDT - Rx Release Date
  1.  N RXRLDT
  1.  I '$G(RX) Q ""
  1.  S RXRLDT=$$GET1^DIQ(52,RX,31,"I")
  1.  I '$D(RFL) S RFL=$$LSTRFL^PSOBPSU1(RX)
  1.  I RFL S RXRLDT=$$GET1^DIQ(52.1,RFL_","_RX,17,"I")
  1.  Q RXRLDT
  1.  ;
  1. RXFLDT(RX,RFL) ; Returns the Rx Fill Date
  1.  ; Input:  (r) RX  - Rx IEN (#52)
  1.  ;         (o) RFL - Refill # (Default: most recent)
  1.  ; Output:  RXFLDT - Rx Fill Date
  1.  N RXFLDT
  1.  I '$G(RX) Q ""
  1.  S RXFLDT=$$GET1^DIQ(52,RX,22,"I")
  1.  I '$D(RFL) S RFL=$$LSTRFL^PSOBPSU1(RX)
  1.  I RFL S RXFLDT=$$GET1^DIQ(52.1,RFL_","_RX,.01,"I")
  1.  Q RXFLDT
  1.  ;
  1. RXSUDT(RX,RFL) ; Returns the prescription/fill Suspense Date for the RX/Reject passed in
  1.  ;Input: (r) RX   - Rx IEN (#52)
  1.  ;       (o) RFL  - Refill IEN (#52.1)
  1.  ;Output: SUSPENSE DATE (External format) or <NULL>, if not suspended
  1.  ;
  1.  I $G(^PSRX(RX,"STA"))'=5 Q ""
  1.  N SURX,SURFL
  1.  S SURX=$O(^PS(52.5,"B",RX,0)) I 'SURX Q ""
  1.  I $$GET1^DIQ(52.5,SURX,.05,"I") Q ""
  1.  S SURFL=+$$GET1^DIQ(52.5,SURX,9) I RFL'=SURFL Q ""
  1.  Q $$GET1^DIQ(52.5,SURX,.02,"I")
  1.  ;
  1. RXSITE(RX,RFL) ; Returns the Rx DIVISION
  1.  ; Input:  (r) RX  - Rx IEN (#52)
  1.  ;         (o) RFL - Refill #
  1.  ; Output:  SITE - Rx Fill Date
  1.  ;
  1.  N SITE
  1.  I '$G(RX) Q ""
  1.  I '$D(RFL) S RFL=$$LSTRFL^PSOBPSU1(RX)
  1.  I RFL S SITE=$$GET1^DIQ(52.1,RFL_","_RX,8,"I")
  1.  I 'RFL!'$G(SITE) S SITE=$$GET1^DIQ(52,RX,20,"I")
  1.  Q SITE
  1.  ;
  1. MANREL(RX,RFL,PID) ; ePharmacy Manual Rx Release
  1.  ;Input: (r) RX  - Rx IEN (#52)
  1.  ;       (o) RFL - Refill # (Default: most recent)
  1.  ;       (o) PID - Displays PID/Drug/Rx in the NDC prompts
  1.  ;Output: "" (null - OK to Release) OR "^" (User entered "^", or no valid NDC on file for ePharmacy Rx)
  1.  ;
  1.  Q ""  ;IHS/MSC/PLS - 05/26/2010
  1.  N ACTION
  1.  I '$D(RFL) S RFL=$$LSTRFL^PSOBPSU1(RX)
  1.  ; - Checking for REJECTS before proceeding to Rx Release
  1.  I $$FIND^PSOREJUT(RX,RFL) D  I ACTION="Q"!(ACTION="^") W ! Q "^"
  1.  . S ACTION=$$HDLG^PSOREJU1(RX,RFL,"79,88","ED","OIQ","Q")
  1.  ; - ePharmacy switch is OFF
  1.  I '$$ECMEON^BPSUTIL($$RXSITE^PSOBPSUT(RX,RFL)) Q ""
  1.  ; - Not an ePharmacy Rx
  1.  I $$STATUS^PSOBPSUT(RX,RFL)="" Q ""
  1.  I '$D(PSOTRIC) N PSOTRIC S PSOTRIC="",PSOTRIC=$$TRIC^PSOREJP1(RX,RFL,PSOTRIC)
  1.  ; - NDC editing before Rx release
  1.  S ACTION=$$CHGNDC^PSONDCUT(RX,RFL,$G(PID))
  1.  I ACTION="^"!(ACTION=2) D  Q "^"
  1.  . W:ACTION="^" !!,$C(7),"A valid NDC must be entered before the Release function can be completed.",! H 1
  1.  . I $G(PSOTRIC) D:ACTION=2 TRIC
  1.  ; - Checking for OPEN/UNRESOLVED 3rd. Party Payer Rejects (After possible NDC edit)
  1.  I $$FIND^PSOREJUT(RX,RFL) D  I ACTION="Q"!(ACTION="^") W ! Q "^"
  1.  . S ACTION=$$HDLG^PSOREJU1(RX,RFL,"79,88","ED","OIQ","Q")
  1.  I $G(PSOTRIC),$$STATUS^PSOBPSUT(RX,RFL)["IN PROGRESS" D TRIC Q "^"
  1.  ; - Notifying IB of a Rx RELEASE event
  1.  D RELEASE^PSOBPSU1(RX,RFL,DUZ)
  1.  Q ""
  1.  ;
  1. TRIC ;
  1.  W !!,$C(7),"TRICARE Rx remains in 'IN PROGRESS' status for ECME, and cannot be released.",! H 1
  1.  Q
  1.  ;
  1. AUTOREL(RX,RFL,RLDT,NDC,SRC,STS,HNG) ; Sends Rx Release information to ECME/IB and updates NDC
  1.  ;                                 in the DRUG/PRESCRIPTION files
  1.  ;Input: (r) RX  - Rx IEN (#52)
  1.  ;       (o) RFL - Refill #  (Default: most recent)
  1.  ;       (r) RLDT- Release Date
  1.  ;       (r) NDC - NDC Number (Must be 11 digits)
  1.  ;       (o) SRC - SOURCE: "C" - CMOP / "A" - OPAI
  1.  ;       (o) STS - Status: (S)uccessful/(U)nsuccessful Release (Default: "S" - Successful)
  1.  ;       (o) HNG - HANG time after resubmission and before checking the status of the claim (Default: 0)
  1.  ;
  1.  Q  ;IHS/MSC/PLS - 06/01/2010
  1.  N RXNDC,SITE
  1.  I '$D(RFL) S RFL=$$LSTRFL^PSOBPSU1(RX)
  1.  S:'$D(STS) STS="S" S:'$D(SRC) SRC="" S HNG=+$G(HNG)
  1.  S RXNDC=$$GETNDC^PSONDCUT(RX,RFL)
  1.  ; - Saves the NDC from CMOP/Automated Dispensing Machine in the Prescription file
  1.  I $$NDCFMT^PSSNDCUT(NDC)'="" D SAVNDC^PSONDCUT(RX,RFL,$$NDCFMT^PSSNDCUT(NDC),$S(SRC="C":1,1:0))
  1.  ; - Not an ePharmacy Rx
  1.  I $$STATUS^PSOBPSUT(RX,RFL)="" Q ""
  1.  ; - Unsuccessful Release
  1.  I STS="U" D  Q
  1.  . D REVERSE^PSOBPSU1(RX,RFL,"CRLX",,"UNSUCCESSFUL "_$S(SRC="C":"CMOP",1:"EXT INTERFACE")_" RELEASE",1)
  1.  ; - Notifying IB of a Rx RELEASE event
  1.  D RELEASE^PSOBPSU1(RX,RFL)
  1.  ; - Invalid NDC from Automated Dispensing Machine
  1.  I SRC="A",$$NDCFMT^PSSNDCUT(NDC)="" D  Q
  1.  . D REVERSE^PSOBPSU1(RX,RFL,"CRLR",,"INVALID EXT INTERFACE NDC",1,NDC)
  1.  ; - Invalid NDC number for CMOP
  1.  I SRC="C",$$NDCFMT^PSSNDCUT(NDC)="" D  Q
  1.  . D REVERSE^PSOBPSU1(RX,RFL,"CRLR",,"INVALID CMOP NDC",1,NDC)
  1.  ; - If NDC not equal RXNDC, issue reversal and submit new claim
  1.  I SRC="A",$$NDCFMT^PSSNDCUT(NDC)'=RXNDC D  Q
  1.  . D ECMESND^PSOBPSU1(RX,RFL,RLDT,"CRLB",$$NDCFMT^PSSNDCUT(NDC),,"AUTO RELEASE",,1,,1),UPDFL^PSOBPSU2(RX,RFL,RLDT)
  1.  . H HNG
  1.  . ; - If new claim returned PAYABLE, save new NDC in the DRUG/PRESCRIPTION files
  1.  . I $$STATUS^PSOBPSUT(RX,RFL)="E PAYABLE" D SAVNDC^PSONDCUT(RX,RFL,$$NDCFMT^PSSNDCUT(NDC),0,1)
  1.  ; - If NDC not equal RXNDC, issue reversal and submit new claim
  1.  I SRC="C",$$NDCFMT^PSSNDCUT(NDC)'=RXNDC D  Q
  1.  . ; - Reverse/Resubmit with correct NDC
  1.  . D ECMESND^PSOBPSU1(RX,RFL,RLDT,"CRLB",$$NDCFMT^PSSNDCUT(NDC),1,"CMOP RELEASE",,1,,1),UPDFL^PSOBPSU2(RX,RFL,RLDT)
  1.  . ; - Wait for a response from the Payer for the submission above
  1.  . H HNG
  1.  . ; - If new claim returned PAYABLE, save new NDC in the DRUG/PRESCRIPTION files
  1.  . I $$STATUS^PSOBPSUT(RX,RFL)="E PAYABLE" D SAVNDC^PSONDCUT(RX,RFL,$$NDCFMT^PSSNDCUT(NDC),1,1)
  1.  ; - Calls ECME api responsible for notifying IB to create a BILL
  1.  D IBSEND(RX,RFL)
  1.  Q
  1.  ;
  1. IBSEND(RX,RFL) ; Rx Release: Calls ECME, which will call  IB to create a bill
  1.  ;Input: (r) RX  - Rx IEN (#52)
  1.  ;       (o) RFL - Refill #  (Default: most recent)
  1.  ;
  1.  Q  ;IHS/MSC/PLS - 05/26/2010
  1.  I '$D(RFL) S RFL=$$LSTRFL^PSOBPSU1(RX)
  1.  ; - ECME turned OFF for Rx's site
  1.  I '$$ECMEON^BPSUTIL($$RXSITE^PSOBPSUT(RX,RFL)) Q
  1.  ; - Not an ePharmacy Rx
  1.  I $$STATUS^PSOBPSUT(RX,RFL)="" Q ""
  1.  ; - Calls ECME previously reversed, re-submit the claim to the payer
  1.  I $$STATUS^PSOBPSUT(RX,RFL)="E REVERSAL ACCEPTED"!($$STATUS^PSOBPSUT(RX,RFL)="IN PROGRESS") D  Q
  1.  . D ECMESND^PSOBPSU1(RX,RFL,$$RXRLDT^PSOBPSUT(RX,RFL),"RRL")
  1.  ; - Notifying ECME of a BILLING event
  1.  I $$STATUS^PSOBPSUT(RX,RFL)="E PAYABLE" D  Q
  1.  . N PSOCLAIM S PSOCLAIM=$$CLAIM^BPSBUTL(RX,RFL)
  1.  . D IBSEND^BPSECMP2($P(PSOCLAIM,"^",2),$P(PSOCLAIM,"^",3),"BILL",DUZ)
  1.  Q
  1.  ;
  1. RETRX(RX,RFL) ; - Re-transmit a claim for the prescription/fill?
  1.  ;Input: (r) RX  - Rx IEN (#52)
  1.  ;       (o) RFL - Refill # (Default: most recent)
  1.  ;Output: 1 - Re-transmit  /  0 - Don't re-transmit
  1.  I '$D(RFL) S RFL=$$LSTRFL^PSOBPSU1(RX)
  1.  I RFL Q +$$GET1^DIQ(52.1,RFL_","_RX,82,"I")
  1.  Q +$$GET1^DIQ(52,RX,82,"I")