Ignore:
Timestamp:
Dec 4, 2009, 12:11:15 AM (14 years ago)
Author:
George Lilly
Message:

revised back to 6/30/08 version

File:
1 edited

Legend:

Unmodified
Added
Removed
  • WorldVistAEHR/trunk/r/OUTPATIENT_PHARMACY-PSO-APSP-HUIP/PSOBPSUT.m

    r613 r623  
    1 PSOBPSUT        ;BIRM/MFR - BPS (ECME) Utilities ; 07 Jun 2005  8:39 PM
    2         ;;7.0;OUTPATIENT PHARMACY;**148,247,260,281**;DEC 1997;Build 41
    3         ;Reference to $$ECMEON^BPSUTIL supported by IA 4410
    4         ;Reference to IBSEND^BPSECMP2 supported by IA 4411
    5         ;Reference to $$STATUS^BPSOSRX supported by IA 4412
    6         ;Reference to $$NDCFMT^PSSNDCUT supported by IA 4707
    7         ;Reference to $$CLAIM^BPSBUTL supported by IA 4719
    8         ;Reference to ^PS(55 supported by IA 2228
    9         ;Reference to ^PSDRUG( supported by IA 221
    10         ;Reference to ^PSDRUG("AQ" supported by IA 3165
    11         ;
    12 ECME(RX)        ; Returns "e" if Rx/Refill is Electronically Billable (3rd party)
    13         Q $S($$STATUS^BPSOSRX(RX,$$LSTRFL^PSOBPSU1(RX))'="":"e",1:"")
    14         ;
    15 STATUS(RX,RFL)  ; Returns the Rx's ECME Status (calls STATUS^BPSOSRX)
    16         ; Input:  (r) RX  - Rx IEN (#52)
    17         ;         (o) RFL - Refill # (Default: most recent)
    18         I '$D(RFL) S RFL=$$LSTRFL^PSOBPSU1(RX)
    19         Q $P($$STATUS^BPSOSRX(RX,RFL),"^")
    20         ;
    21 SUBMIT(RX,RFL,IGRL,IGCMP)       ; Returns whether the Rx should be submitted to ECME at the moment or not
    22         ; Input:  (r) RX   - Rx IEN (#52)
    23         ;         (o) RFL  - Refill # (Def.: most recent)
    24         ;         (o) IGRL - Ignore Release Date? (1-YES/0-NO) (Def.: 0 - NO)
    25         ;         (o) IGCMP- Ignore CMOP/Suspense check? (1-YES/0-NO) (Def.: 0 - NO)
    26         ;
    27         ; - Get the REFILL # (multiple IEN)
    28         N STATUS
    29         I '$D(RFL) S RFL=$$LSTRFL^PSOBPSU1(RX)
    30         ; - Not the latest fill for the prescription
    31         I RFL'=$$LSTRFL^PSOBPSU1(RX) Q 0
    32         ; - Status not ACTIVE, DISCONTINUED, or EXPIRED
    33         S STATUS=$$GET1^DIQ(52,RX,100,"I")
    34         I STATUS'=0&(STATUS'=11)&(STATUS'=12) Q 0
    35         ; Will suspend for CMOP
    36         I '$G(IGCMP),$$CMOP(RX,RFL) Q 0
    37         ; - ECME turned OFF for Rx's site
    38         I '$$ECMEON^BPSUTIL($$RXSITE(RX,RFL)) Q 0
    39         ; - Rx is RELEASED - Do not submit
    40         I '$G(IGRL),$$RXRLDT(RX,RFL) Q 0
    41         ; - Future Fill/AUTO SUSPENSE ON - will suspend
    42         I '$G(IGCMP),$$RXFLDT(RX,RFL)>DT,$$GET1^DIQ(59,$$RXSITE(RX,RFL),.16,"I") Q 0
    43         Q 1
    44         ;
    45 CMOP(RX,RFL)    ; Returns if the Rx will be a CMOP Rx or not
    46         ; Input:  (r) RX  - Rx IEN (#52)
    47         ;         (o) RFL - Refill # (Default: most recent)
    48         ; Output: 1 - CMOP / 0 - NON-CMOP
    49         ;
    50         N DFN,CMOP,MAIL,MAILEXP,DRUG,WARNS,STATUS,MW,A
    51         ; Get the REFILL # (multiple IEN)
    52         I '$D(RFL) S RFL=$$LSTRFL^PSOBPSU1(RX)
    53         ; MAIL=MAIL Code, MAILEXP=Mail Code Expiration Date
    54         S CMOP=0
    55         S DFN=$$GET1^DIQ(52,RX,2,"I"),MAIL=$$GET1^DIQ(55,DFN,.03,"I"),MAILEXP=$$GET1^DIQ(55,DFN,.05,"I")
    56         I MAIL>1,MAILEXP=""!(MAILEXP>DT) G QCMOP
    57         ; Get drug IEN and cheDRUG if CMOP  ,$S($G(MAILEXP)=""!($G(MAILEXP)>DT):1,1:0)
    58         S DRUG=$$GET1^DIQ(52,RX,6,"I") G QCMOP:'DRUG,QCMOP:'$D(^PSDRUG("AQ",DRUG))
    59         ; Not marked for O.P.
    60         I $$GET1^DIQ(50,DRUG,63)'["O" G QCMOP
    61         ; Drug Warning >11
    62         S WARNS=$$GET1^DIQ(50,DRUG,8) I $L(WARNS)>11 G QCMOP
    63         ; If tradename
    64         I $$GET1^DIQ(52,RX,6.5)'="" G QCMOP
    65         ; If Cancelled, Expired, Deleted, Hold
    66         S STATUS=$$GET1^DIQ(52,RX,100,"I") I STATUS>9!(STATUS=4)!(STATUS=3) G QCMOP
    67         ; Rx RELEASED
    68         I $$RXRLDT^PSOBPSUT(RX,RFL) G QCMOP
    69         ; MAIL/WINDOW
    70         S MW=$S('RFL:$$GET1^DIQ(52,RX,11,"I"),1:$$GET1^DIQ(52.1,RFL_","_RX,2,"I"))
    71         ; IF WINDOW/ORIGINAL/FUTURE FILL SETS MW = MAIL
    72         I MW="W",$$RXFLDT^PSOBPSUT(RX,RFL)>DT S MW="M"
    73         ; If not MAIL
    74         I MW'="M" G QCMOP
    75         S CMOP=1
    76         ;
    77 QCMOP   Q CMOP
    78         ;
    79 RXRLDT(RX,RFL)  ; Returns the Rx Release Date
    80         ; Input:  (r) RX  - Rx IEN (#52)
    81         ;         (o) RFL - Refill # (Default: most recent)
    82         ;       
    83         ; Output:  RXRLDT - Rx Release Date
    84         N RXRLDT
    85         I '$G(RX) Q ""
    86         S RXRLDT=$$GET1^DIQ(52,RX,31,"I")
    87         I '$D(RFL) S RFL=$$LSTRFL^PSOBPSU1(RX)
    88         I RFL S RXRLDT=$$GET1^DIQ(52.1,RFL_","_RX,17,"I")
    89         Q RXRLDT
    90         ;
    91 RXFLDT(RX,RFL)  ; Returns the Rx Fill Date
    92         ; Input:  (r) RX  - Rx IEN (#52)
    93         ;         (o) RFL - Refill # (Default: most recent)     
    94         ; Output:  RXFLDT - Rx Fill Date
    95         N RXFLDT
    96         I '$G(RX) Q ""
    97         S RXFLDT=$$GET1^DIQ(52,RX,22,"I")
    98         I '$D(RFL) S RFL=$$LSTRFL^PSOBPSU1(RX)
    99         I RFL S RXFLDT=$$GET1^DIQ(52.1,RFL_","_RX,.01,"I")
    100         Q RXFLDT
    101         ;
    102 RXSUDT(RX,RFL)  ; Returns the prescription/fill Suspense Date for the RX/Reject passed in
    103         ;Input: (r) RX   - Rx IEN (#52)
    104         ;       (o) RFL  - Refill IEN (#52.1)
    105         ;Output: SUSPENSE DATE (External format) or <NULL>, if not suspended
    106         ;
    107         I $G(^PSRX(RX,"STA"))'=5 Q ""
    108         N SURX,SURFL
    109         S SURX=$O(^PS(52.5,"B",RX,0)) I 'SURX Q ""
    110         I $$GET1^DIQ(52.5,SURX,.05,"I") Q ""
    111         S SURFL=+$$GET1^DIQ(52.5,SURX,9) I RFL'=SURFL Q ""
    112         Q $$GET1^DIQ(52.5,SURX,.02,"I")
    113         ;
    114 RXSITE(RX,RFL)  ; Returns the Rx DIVISION
    115         ; Input:  (r) RX  - Rx IEN (#52)
    116         ;         (o) RFL - Refill #
    117         ; Output:  SITE - Rx Fill Date
    118         ;       
    119         N SITE
    120         I '$G(RX) Q ""
    121         I '$D(RFL) S RFL=$$LSTRFL^PSOBPSU1(RX)
    122         I RFL S SITE=$$GET1^DIQ(52.1,RFL_","_RX,8,"I")
    123         I 'RFL!'$G(SITE) S SITE=$$GET1^DIQ(52,RX,20,"I")
    124         Q SITE
    125         ;
    126 MANREL(RX,RFL,PID)      ; ePharmacy Manual Rx Release
    127         ;Input: (r) RX  - Rx IEN (#52)
    128         ;       (o) RFL - Refill # (Default: most recent)
    129         ;       (o) PID - Displays PID/Drug/Rx in the NDC prompts
    130         ;Output: "" (null - OK to Release) OR "^" (User entered "^", or no valid NDC on file for ePharmacy Rx)
    131         ;       
    132         N ACTION
    133         ;
    134         I '$D(RFL) S RFL=$$LSTRFL^PSOBPSU1(RX)
    135         ;
    136         ; - Checking for REJECTS before proceeding to Rx Release
    137         I $$FIND^PSOREJUT(RX,RFL) D  I ACTION="Q"!(ACTION="^") W ! Q "^"
    138         . S ACTION=$$HDLG^PSOREJU1(RX,RFL,"79,88","ED","OIQ","Q")
    139         ;
    140         ; - ePharmacy switch is OFF
    141         I '$$ECMEON^BPSUTIL($$RXSITE^PSOBPSUT(RX,RFL)) Q ""
    142         ;
    143         ; - Not an ePharmacy Rx
    144         I $$STATUS^PSOBPSUT(RX,RFL)="" Q ""
    145         ;
    146         ; - NDC editing before Rx release
    147         S ACTION=$$CHGNDC^PSONDCUT(RX,RFL,$G(PID)) I ACTION="^" D  Q "^"
    148         . W !!,$C(7),"A valid NDC must be entered before the Release function can be completed.",! H 1
    149         ;
    150         ; - Checking for OPEN/UNRESOLVED 3rd. Party Payer Rejects (After possible NDC edit)
    151         I $$FIND^PSOREJUT(RX,RFL) D  I ACTION="Q"!(ACTION="^") W ! Q "^"
    152         . S ACTION=$$HDLG^PSOREJU1(RX,RFL,"79,88","ED","OIQ","Q")
    153         ;
    154         ; - Notifying IB of a Rx RELEASE event
    155         D RELEASE^PSOBPSU1(RX,RFL,DUZ)
    156         ;
    157         Q ""
    158         ;
    159 AUTOREL(RX,RFL,RLDT,NDC,SRC,STS,HNG)    ; Sends Rx Release information to ECME/IB and updates NDC
    160         ;                                 in the DRUG/PRESCRIPTION files
    161         ;Input: (r) RX  - Rx IEN (#52)
    162         ;       (o) RFL - Refill #  (Default: most recent)
    163         ;       (r) RLDT- Release Date
    164         ;       (r) NDC - NDC Number (Must be 11 digits)
    165         ;       (o) SRC - SOURCE: "C" - CMOP / "A" - OPAI
    166         ;       (o) STS - Status: (S)uccessful/(U)nsuccessful Release (Default: "S" - Successful)
    167         ;       (o) HNG - HANG time after resubmission and before checking the status of the claim (Default: 0)
    168         ;       
    169         N RXNDC,SITE
    170         ;
    171         I '$D(RFL) S RFL=$$LSTRFL^PSOBPSU1(RX)
    172         ;
    173         S:'$D(STS) STS="S" S:'$D(SRC) SRC="" S HNG=+$G(HNG)
    174         S RXNDC=$$GETNDC^PSONDCUT(RX,RFL)
    175         ;
    176         ; - Saves the NDC from CMOP/Automated Dispensing Machine in the Prescription file
    177         I $$NDCFMT^PSSNDCUT(NDC)'="" D SAVNDC^PSONDCUT(RX,RFL,$$NDCFMT^PSSNDCUT(NDC),$S(SRC="C":1,1:0))
    178         ;
    179         ; - Not an ePharmacy Rx
    180         I $$STATUS^PSOBPSUT(RX,RFL)="" Q ""
    181         ;
    182         ; - Unsuccessful Release
    183         I STS="U" D  Q
    184         . D REVERSE^PSOBPSU1(RX,RFL,"CRLX",,"UNSUCCESSFUL "_$S(SRC="C":"CMOP",1:"EXT INTERFACE")_" RELEASE",1)
    185         ;
    186         ; - Notifying IB of a Rx RELEASE event
    187         D RELEASE^PSOBPSU1(RX,RFL)
    188         ;
    189         ; - Invalid NDC from Automated Dispensing Machine
    190         I SRC="A",$$NDCFMT^PSSNDCUT(NDC)="" D  Q
    191         . D REVERSE^PSOBPSU1(RX,RFL,"CRLR",,"INVALID EXT INTERFACE NDC",1,NDC)
    192         ;
    193         ; - Invalid NDC number for CMOP
    194         I SRC="C",$$NDCFMT^PSSNDCUT(NDC)="" D  Q
    195         . D REVERSE^PSOBPSU1(RX,RFL,"CRLR",,"INVALID CMOP NDC",1,NDC)
    196         ;
    197         ; - If NDC not equal RXNDC, issue reversal and submit new claim
    198         I SRC="A",$$NDCFMT^PSSNDCUT(NDC)'=RXNDC D  Q
    199         . D ECMESND^PSOBPSU1(RX,RFL,RLDT,"CRLB",$$NDCFMT^PSSNDCUT(NDC),,"AUTO RELEASE",,1,,1)
    200         . H HNG
    201         . ; - If new claim returned PAYABLE, save new NDC in the DRUG/PRESCRIPTION files
    202         . I $$STATUS^PSOBPSUT(RX,RFL)="E PAYABLE" D SAVNDC^PSONDCUT(RX,RFL,$$NDCFMT^PSSNDCUT(NDC),0,1)
    203         ;
    204         ; - If NDC not equal RXNDC, issue reversal and submit new claim
    205         I SRC="C",$$NDCFMT^PSSNDCUT(NDC)'=RXNDC D  Q
    206         . ; - Reverse/Resubmit with correct NDC
    207         . D ECMESND^PSOBPSU1(RX,RFL,RLDT,"CRLB",$$NDCFMT^PSSNDCUT(NDC),1,"CMOP RELEASE",,1,,1)
    208         . ; - Wait for a response from the Payer for the submission above
    209         . H HNG
    210         . ; - If new claim returned PAYABLE, save new NDC in the DRUG/PRESCRIPTION files
    211         . I $$STATUS^PSOBPSUT(RX,RFL)="E PAYABLE" D SAVNDC^PSONDCUT(RX,RFL,$$NDCFMT^PSSNDCUT(NDC),1,1)
    212         ;
    213         ; - Calls ECME api responsible for notifying IB to create a BILL
    214         D IBSEND(RX,RFL)
    215         ;
    216         Q
    217         ;
    218 IBSEND(RX,RFL)  ; Rx Release: Calls ECME, which will call  IB to create a bill
    219         ;Input: (r) RX  - Rx IEN (#52)
    220         ;       (o) RFL - Refill #  (Default: most recent)
    221         ;
    222         I '$D(RFL) S RFL=$$LSTRFL^PSOBPSU1(RX)
    223         ;
    224         ; - ECME turned OFF for Rx's site
    225         I '$$ECMEON^BPSUTIL($$RXSITE^PSOBPSUT(RX,RFL)) Q
    226         ;
    227         ; - Not an ePharmacy Rx
    228         I $$STATUS^PSOBPSUT(RX,RFL)="" Q ""
    229         ;
    230         ; - Calls ECME previously reversed, re-submit the claim to the payer
    231         I $$STATUS^PSOBPSUT(RX,RFL)="E REVERSAL ACCEPTED"!($$STATUS^PSOBPSUT(RX,RFL)="IN PROGRESS") D  Q
    232         . D ECMESND^PSOBPSU1(RX,RFL,$$RXRLDT^PSOBPSUT(RX,RFL),"RRL")
    233         ;
    234         ; - Notifying ECME of a BILLING event
    235         I $$STATUS^PSOBPSUT(RX,RFL)="E PAYABLE" D  Q
    236         . N PSOCLAIM S PSOCLAIM=$$CLAIM^BPSBUTL(RX,RFL)
    237         . D IBSEND^BPSECMP2($P(PSOCLAIM,"^",2),$P(PSOCLAIM,"^",3),"BILL",DUZ)
    238         ;
    239         Q
    240         ;
    241 RETRX(RX,RFL)   ; - Re-transmit a claim for the prescription/fill?
    242         ;Input: (r) RX  - Rx IEN (#52)
    243         ;       (o) RFL - Refill # (Default: most recent)
    244         ;Output: 1 - Re-transmit  /  0 - Don't re-transmit
    245         I '$D(RFL) S RFL=$$LSTRFL^PSOBPSU1(RX)
    246         ;
    247         I RFL Q +$$GET1^DIQ(52.1,RFL_","_RX,82,"I")
    248         Q +$$GET1^DIQ(52,RX,82,"I")
     1PSOBPSUT ;BIRM/MFR - BPS (ECME) Utilities ; 07 Jun 2005  8:39 PM
     2 ;;7.0;OUTPATIENT PHARMACY;**148,247,260**;DEC 1997;Build 84
     3 ;Reference to $$ECMEON^BPSUTIL supported by IA 4410
     4 ;Reference to IBSEND^BPSECMP2 supported by IA 4411
     5 ;Reference to $$STATUS^BPSOSRX supported by IA 4412
     6 ;Reference to $$NDCFMT^PSSNDCUT supported by IA 4707
     7 ;Reference to $$CLAIM^BPSBUTL supported by IA 4719
     8 ;Reference to ^PS(55 supported by IA 2228
     9 ;Reference to ^PSDRUG( supported by IA 221
     10 ;Reference to ^PSDRUG("AQ" supported by IA 3165
     11 ;
     12ECME(RX) ; Returns "e" if Rx/Refill is Electronically Billable (3rd party)
     13 Q $S($$STATUS^BPSOSRX(RX,$$LSTRFL^PSOBPSU1(RX))'="":"e",1:"")
     14 ;
     15STATUS(RX,RFL) ; Returns the Rx's ECME Status (calls STATUS^BPSOSRX)
     16 ; Input:  (r) RX  - Rx IEN (#52)
     17 ;         (o) RFL - Refill # (Default: most recent)
     18 I '$D(RFL) S RFL=$$LSTRFL^PSOBPSU1(RX)
     19 Q $P($$STATUS^BPSOSRX(RX,RFL),"^")
     20 ;
     21SUBMIT(RX,RFL,IGRL,IGCMP) ; Returns whether the Rx should be submitted to ECME at the moment or not
     22 ; Input:  (r) RX   - Rx IEN (#52)
     23 ;         (o) RFL  - Refill # (Def.: most recent)
     24 ;         (o) IGRL - Ignore Release Date? (1-YES/0-NO) (Def.: 0 - NO)
     25 ;         (o) IGCMP- Ignore CMOP/Suspense check? (1-YES/0-NO) (Def.: 0 - NO)
     26 ;
     27 ; - Get the REFILL # (multiple IEN)
     28 I '$D(RFL) S RFL=$$LSTRFL^PSOBPSU1(RX)
     29 ; - Not the latest fill for the prescription
     30 I RFL'=$$LSTRFL^PSOBPSU1(RX) Q 0
     31 ; - Status not ACTIVE
     32 I $$GET1^DIQ(52,RX,100,"I")'=0 Q 0
     33 ; Will suspend for CMOP
     34 I '$G(IGCMP),$$CMOP(RX,RFL) Q 0
     35 ; - ECME turned OFF for Rx's site
     36 I '$$ECMEON^BPSUTIL($$RXSITE(RX,RFL)) Q 0
     37 ; - Rx is RELEASED - Do not submit
     38 I '$G(IGRL),$$RXRLDT(RX,RFL) Q 0
     39 ; - Future Fill/AUTO SUSPENSE ON - will suspend
     40 I '$G(IGCMP),$$RXFLDT(RX,RFL)>DT,$$GET1^DIQ(59,$$RXSITE(RX,RFL),.16,"I") Q 0
     41 Q 1
     42 ;
     43CMOP(RX,RFL) ; Returns if the Rx will be a CMOP Rx or not
     44 ; Input:  (r) RX  - Rx IEN (#52)
     45 ;         (o) RFL - Refill # (Default: most recent)
     46 ; Output: 1 - CMOP / 0 - NON-CMOP
     47 ;
     48 N DFN,CMOP,MAIL,MAILEXP,DRUG,WARNS,STATUS,MW,A
     49 ; Get the REFILL # (multiple IEN)
     50 I '$D(RFL) S RFL=$$LSTRFL^PSOBPSU1(RX)
     51 ; MAIL=MAIL Code, MAILEXP=Mail Code Expiration Date
     52 S CMOP=0
     53 S DFN=$$GET1^DIQ(52,RX,2,"I"),MAIL=$$GET1^DIQ(55,DFN,.03,"I"),MAILEXP=$$GET1^DIQ(55,DFN,.05,"I")
     54 I MAIL>1,MAILEXP=""!(MAILEXP>DT) G QCMOP
     55 ; Get drug IEN and cheDRUG if CMOP  ,$S($G(MAILEXP)=""!($G(MAILEXP)>DT):1,1:0)
     56 S DRUG=$$GET1^DIQ(52,RX,6,"I") G QCMOP:'DRUG,QCMOP:'$D(^PSDRUG("AQ",DRUG))
     57 ; Not marked for O.P.
     58 I $$GET1^DIQ(50,DRUG,63)'["O" G QCMOP
     59 ; Drug Warning >11
     60 S WARNS=$$GET1^DIQ(50,DRUG,8) I $L(WARNS)>11 G QCMOP
     61 ; If tradename
     62 I $$GET1^DIQ(52,RX,6.5)'="" G QCMOP
     63 ; If Cancelled, Expired, Deleted, Hold
     64 S STATUS=$$GET1^DIQ(52,RX,100,"I") I STATUS>9!(STATUS=4)!(STATUS=3) G QCMOP
     65 ; Rx RELEASED
     66 I $$RXRLDT^PSOBPSUT(RX,RFL) G QCMOP
     67 ; MAIL/WINDOW
     68 S MW=$S('RFL:$$GET1^DIQ(52,RX,11,"I"),1:$$GET1^DIQ(52.1,RFL_","_RX,2,"I"))
     69 ; IF WINDOW/ORIGINAL/FUTURE FILL SETS MW = MAIL
     70 I MW="W",$$RXFLDT^PSOBPSUT(RX,RFL)>DT S MW="M"
     71 ; If not MAIL
     72 I MW'="M" G QCMOP
     73 S CMOP=1
     74 ;
     75QCMOP Q CMOP
     76 ;
     77RXRLDT(RX,RFL) ; Returns the Rx Release Date
     78 ; Input:  (r) RX  - Rx IEN (#52)
     79 ;         (o) RFL - Refill # (Default: most recent)
     80 ;       
     81 ; Output:  RXRLDT - Rx Release Date
     82 N RXRLDT
     83 I '$G(RX) Q ""
     84 S RXRLDT=$$GET1^DIQ(52,RX,31,"I")
     85 I '$D(RFL) S RFL=$$LSTRFL^PSOBPSU1(RX)
     86 I RFL S RXRLDT=$$GET1^DIQ(52.1,RFL_","_RX,17,"I")
     87 Q RXRLDT
     88 ;
     89RXFLDT(RX,RFL) ; Returns the Rx Fill Date
     90 ; Input:  (r) RX  - Rx IEN (#52)
     91 ;         (o) RFL - Refill # (Default: most recent)     
     92 ; Output:  RXFLDT - Rx Fill Date
     93 N RXFLDT
     94 I '$G(RX) Q ""
     95 S RXFLDT=$$GET1^DIQ(52,RX,22,"I")
     96 I '$D(RFL) S RFL=$$LSTRFL^PSOBPSU1(RX)
     97 I RFL S RXFLDT=$$GET1^DIQ(52.1,RFL_","_RX,.01,"I")
     98 Q RXFLDT
     99 ;
     100RXSUDT(RX,RFL) ; Returns the prescription/fill Suspense Date for the RX/Reject passed in
     101 ;Input: (r) RX   - Rx IEN (#52)
     102 ;       (o) RFL  - Refill IEN (#52.1)
     103 ;Output: SUSPENSE DATE (External format) or <NULL>, if not suspended
     104 ;
     105 I $G(^PSRX(RX,"STA"))'=5 Q ""
     106 N SURX,SURFL
     107 S SURX=$O(^PS(52.5,"B",RX,0)) I 'SURX Q ""
     108 I $$GET1^DIQ(52.5,SURX,.05,"I") Q ""
     109 S SURFL=+$$GET1^DIQ(52.5,SURX,9) I RFL'=SURFL Q ""
     110 Q $$GET1^DIQ(52.5,SURX,.02,"I")
     111 ;
     112RXSITE(RX,RFL) ; Returns the Rx DIVISION
     113 ; Input:  (r) RX  - Rx IEN (#52)
     114 ;         (o) RFL - Refill #
     115 ; Output:  SITE - Rx Fill Date
     116 ;       
     117 N SITE
     118 I '$G(RX) Q ""
     119 I '$D(RFL) S RFL=$$LSTRFL^PSOBPSU1(RX)
     120 I RFL S SITE=$$GET1^DIQ(52.1,RFL_","_RX,8,"I")
     121 I 'RFL!'$G(SITE) S SITE=$$GET1^DIQ(52,RX,20,"I")
     122 Q SITE
     123 ;
     124MANREL(RX,RFL,PID) ; ePharmacy Manual Rx Release
     125 ;Input: (r) RX  - Rx IEN (#52)
     126 ;       (o) RFL - Refill # (Default: most recent)
     127 ;       (o) PID - Displays PID/Drug/Rx in the NDC prompts
     128 ;Output: "" (null - OK to Release) OR "^" (User entered "^", or no valid NDC on file for ePharmacy Rx)
     129 ;       
     130 N ACTION
     131 ;
     132 I '$D(RFL) S RFL=$$LSTRFL^PSOBPSU1(RX)
     133 ;
     134 ; - Checking for REJECTS before proceeding to Rx Release
     135 I $$FIND^PSOREJUT(RX,RFL) D  I ACTION="Q"!(ACTION="^") W ! Q "^"
     136 . S ACTION=$$HDLG^PSOREJU1(RX,RFL,"79,88","ED","OIQ","Q")
     137 ;
     138 ; - ePharmacy switch is OFF
     139 I '$$ECMEON^BPSUTIL($$RXSITE^PSOBPSUT(RX,RFL)) Q ""
     140 ;
     141 ; - Not an ePharmacy Rx
     142 I $$STATUS^PSOBPSUT(RX,RFL)="" Q ""
     143 ;
     144 ; - NDC editing before Rx release
     145 S ACTION=$$CHGNDC^PSONDCUT(RX,RFL,$G(PID)) I ACTION="^" D  Q "^"
     146 . W !!,$C(7),"A valid NDC must be entered before the Release function can be completed.",! H 1
     147 ;
     148 ; - Checking for OPEN/UNRESOLVED 3rd. Party Payer Rejects (After possible NDC edit)
     149 I $$FIND^PSOREJUT(RX,RFL) D  I ACTION="Q"!(ACTION="^") W ! Q "^"
     150 . S ACTION=$$HDLG^PSOREJU1(RX,RFL,"79,88","ED","OIQ","Q")
     151 ;
     152 ; - Notifying IB of a Rx RELEASE event
     153 D RELEASE^PSOBPSU1(RX,RFL,DUZ)
     154 ;
     155 Q ""
     156 ;
     157AUTOREL(RX,RFL,RLDT,NDC,SRC,STS,HNG) ; Sends Rx Release information to ECME/IB and updates NDC
     158 ;                                 in the DRUG/PRESCRIPTION files
     159 ;Input: (r) RX  - Rx IEN (#52)
     160 ;       (o) RFL - Refill #  (Default: most recent)
     161 ;       (r) RLDT- Release Date
     162 ;       (r) NDC - NDC Number (Must be 11 digits)
     163 ;       (o) SRC - SOURCE: "C" - CMOP / "A" - OPAI
     164 ;       (o) STS - Status: (S)uccessful/(U)nsuccessful Release (Default: "S" - Successful)
     165 ;       (o) HNG - HANG time after resubmission and before checking the status of the claim (Default: 0)
     166 ;       
     167 N RXNDC,SITE
     168 ;
     169 I '$D(RFL) S RFL=$$LSTRFL^PSOBPSU1(RX)
     170 ;
     171 S:'$D(STS) STS="S" S:'$D(SRC) SRC="" S HNG=+$G(HNG)
     172 S RXNDC=$$GETNDC^PSONDCUT(RX,RFL)
     173 ;
     174 ; - Saves the NDC from CMOP/Automated Dispensing Machine in the Prescription file
     175 I $$NDCFMT^PSSNDCUT(NDC)'="" D SAVNDC^PSONDCUT(RX,RFL,$$NDCFMT^PSSNDCUT(NDC),$S(SRC="C":1,1:0))
     176 ;
     177 ; - Not an ePharmacy Rx
     178 I $$STATUS^PSOBPSUT(RX,RFL)="" Q ""
     179 ;
     180 ; - Unsuccessful Release
     181 I STS="U" D  Q
     182 . D REVERSE^PSOBPSU1(RX,RFL,"CRLX",,"UNSUCCESSFUL "_$S(SRC="C":"CMOP",1:"EXT INTERFACE")_" RELEASE",1)
     183 ;
     184 ; - Notifying IB of a Rx RELEASE event
     185 D RELEASE^PSOBPSU1(RX,RFL)
     186 ;
     187 ; - Invalid NDC from Automated Dispensing Machine
     188 I SRC="A",$$NDCFMT^PSSNDCUT(NDC)="" D  Q
     189 . D REVERSE^PSOBPSU1(RX,RFL,"CRLR",,"INVALID EXT INTERFACE NDC",1,NDC)
     190 ;
     191 ; - Invalid NDC number for CMOP
     192 I SRC="C",$$NDCFMT^PSSNDCUT(NDC)="" D  Q
     193 . D REVERSE^PSOBPSU1(RX,RFL,"CRLR",,"INVALID CMOP NDC",1,NDC)
     194 ;
     195 ; - If NDC not equal RXNDC, issue reversal and submit new claim
     196 I SRC="A",$$NDCFMT^PSSNDCUT(NDC)'=RXNDC D  Q
     197 . D ECMESND^PSOBPSU1(RX,RFL,RLDT,"CRLB",$$NDCFMT^PSSNDCUT(NDC),,"AUTO RELEASE",,1,,1)
     198 . H HNG
     199 . ; - If new claim returned PAYABLE, save new NDC in the DRUG/PRESCRIPTION files
     200 . I $$STATUS^PSOBPSUT(RX,RFL)="E PAYABLE" D SAVNDC^PSONDCUT(RX,RFL,$$NDCFMT^PSSNDCUT(NDC),0,1)
     201 ;
     202 ; - If NDC not equal RXNDC, issue reversal and submit new claim
     203 I SRC="C",$$NDCFMT^PSSNDCUT(NDC)'=RXNDC D  Q
     204 . ; - Reverse/Resubmit with correct NDC
     205 . D ECMESND^PSOBPSU1(RX,RFL,RLDT,"CRLB",$$NDCFMT^PSSNDCUT(NDC),1,"CMOP RELEASE",,1,,1)
     206 . ; - Wait for a response from the Payer for the submission above
     207 . H HNG
     208 . ; - If new claim returned PAYABLE, save new NDC in the DRUG/PRESCRIPTION files
     209 . I $$STATUS^PSOBPSUT(RX,RFL)="E PAYABLE" D SAVNDC^PSONDCUT(RX,RFL,$$NDCFMT^PSSNDCUT(NDC),1,1)
     210 ;
     211 ; - Calls ECME api responsible for notifying IB to create a BILL
     212 D IBSEND(RX,RFL)
     213 ;
     214 Q
     215 ;
     216IBSEND(RX,RFL) ; Rx Release: Calls ECME, which will call  IB to create a bill
     217 ;Input: (r) RX  - Rx IEN (#52)
     218 ;       (o) RFL - Refill #  (Default: most recent)
     219 ;
     220 I '$D(RFL) S RFL=$$LSTRFL^PSOBPSU1(RX)
     221 ;
     222 ; - ECME turned OFF for Rx's site
     223 I '$$ECMEON^BPSUTIL($$RXSITE^PSOBPSUT(RX,RFL)) Q
     224 ;
     225 ; - Not an ePharmacy Rx
     226 I $$STATUS^PSOBPSUT(RX,RFL)="" Q ""
     227 ;
     228 ; - Calls ECME previously reversed, re-submit the claim to the payer
     229 I $$STATUS^PSOBPSUT(RX,RFL)="E REVERSAL ACCEPTED"!($$STATUS^PSOBPSUT(RX,RFL)="IN PROGRESS") D  Q
     230 . D ECMESND^PSOBPSU1(RX,RFL,$$RXRLDT^PSOBPSUT(RX,RFL),"RRL")
     231 ;
     232 ; - Notifying ECME of a BILLING event
     233 I $$STATUS^PSOBPSUT(RX,RFL)="E PAYABLE" D  Q
     234 . N PSOCLAIM S PSOCLAIM=$$CLAIM^BPSBUTL(RX,RFL)
     235 . D IBSEND^BPSECMP2($P(PSOCLAIM,"^",2),$P(PSOCLAIM,"^",3),"BILL",DUZ)
     236 ;
     237 Q
     238 ;
     239RETRX(RX,RFL) ; - Re-transmit a claim for the prescription/fill?
     240 ;Input: (r) RX  - Rx IEN (#52)
     241 ;       (o) RFL - Refill # (Default: most recent)
     242 ;Output: 1 - Re-transmit  /  0 - Don't re-transmit
     243 I '$D(RFL) S RFL=$$LSTRFL^PSOBPSU1(RX)
     244 ;
     245 I RFL Q +$$GET1^DIQ(52.1,RFL_","_RX,82,"I")
     246 Q +$$GET1^DIQ(52,RX,82,"I")
Note: See TracChangeset for help on using the changeset viewer.