- Timestamp:
- Dec 4, 2009, 12:11:15 AM (14 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
WorldVistAEHR/trunk/r/OUTPATIENT_PHARMACY-PSO-APSP-HUIP/PSOBPSU1.m
r613 r623 1 PSOBPSU1 ;BIRM/MFR - BPS (ECME) Utilities 1 ;10/15/04 2 ;;7.0;OUTPATIENT PHARMACY;**148,260,281**;DEC 1997;Build 41 3 ;Reference to $$EN^BPSNCPDP supported by IA 4415 4 ;References to $$NDCFMT^PSSNDCUT,$$GETNDC^PSSNDCUT supported by IA 4707 5 ;References to $$ECMEON^BPSUTIL,$$CMOPON^BPSUTIL supported by IA 4410 6 ;References to STORESP^IBNCPDP supported by IA 4299 7 ; 8 ECMESND(RX,RFL,DATE,FROM,NDC,CMOP,RVTX,OVRC,CNDC,RESP,IGSW,ALTX,CLA,PA) ; - Sends Rx Release information to ECME/IB and 9 ; updates NDC in the DRUG/PRESCRIPTION files 10 ;Reference to routine EN^BPSNCPDP supported by DBIA #4304 11 ;Input: (r) RX - Rx IEN (#52) 12 ; (o) RFL - Refill # (Default: most recent) 13 ; (r) DATE - Date of Service 14 ; (r) FROM - Function within OP (See BWHERE param. in EN^BPSNCPDP api) 15 ; (o) NDC - NDC Number (If not passed, will be retrieved from DRUG file) 16 ; (o) CMOP - CMOP Prescription (1-YES/0-NO) (Default: 0) 17 ; (o) RVTX - REVERSE text (e.g., RX EDIT, RX RELEASE-NDC CHANGE, etc) 18 ; (o) OVRC - Set of 3 NCPDP override codes separated by "^": 19 ; Piece 1: NCPDP Professional Service Code for overriding DUR REJECTS 20 ; Piece 2: NCPDP Reason for Service Code for overriding DUR REJECTS 21 ; Piece 3: NCPDP Result of Service Code for overriding DUR REJECTS 22 ; (o) CNDC - Changed NDC? 1 - Yes / 0 - No (Default: NO) 23 ; (o) IGSW - Ignore Switches (Master and CMOP)? 1 - Yes / 0 - No (Default: NO) 24 ; (o) ALTX - Alternative Text to be placed in the Rx ECME Activity Log 25 ; (o) CLA - NCPDP Clarification Code for overriding DUR/RTS REJECTS 26 ; (o) PA - NCPDP Prior Authorization Type and Number (separated by "^") 27 ;Output: RESP - Response from $$EN^BPSNCPDP api 28 ; 29 ; - Retrieving the NDC code from the DRUG file if not passed in, then save it in the DRUG file 30 N ACT,NDCACT,DA 31 ; 32 I '$D(RFL) S RFL=$$LSTRFL(RX) 33 ; 34 ; - ECME is not turned ON for the Rx's Division 35 I '$G(IGSW),'$$ECMEON^BPSUTIL($$RXSITE^PSOBPSUT(RX,RFL)) S RESP="-1^ECME SWITCH OFF" Q 36 ; 37 ; - ECME CMOP is not turned ON for the Rx's Division 38 I '$G(IGSW),$G(CMOP),'$$CMOPON^BPSUTIL($$RXSITE^PSOBPSUT(RX,RFL)) S RESP="-1^CMOP SWITCH OFF" Q 39 ; 40 ; - Saving the NDC to be displayed on the ECME Activity Log 41 I $G(CNDC) D 42 . I $G(NDC)'="" S NDCACT=NDC Q 43 . S NDCACT=$$GETNDC^PSONDCUT(RX,RFL) 44 ; 45 I $$NDCFMT^PSSNDCUT($G(NDC))="" D 46 . S NDC=$$GETNDC^PSSNDCUT($$GET1^DIQ(52,RX,6,"I"),$$RXSITE^PSOBPSUT(RX,RFL),+$G(CMOP)) 47 . I $G(NDC)'="" D SAVNDC^PSONDCUT(RX,RFL,NDC,+$G(CMOP),1) 48 ; 49 ; - Creating ECME Activity Log on the PRESCRIPTION file 50 S ACT="Submitted" I $$STATUS^PSOBPSUT(RX,RFL)="E PAYABLE" S ACT="Reversal/Re-submit sent" 51 S ACT=ACT_" to ECME:" 52 ; 53 ; - Marked any 'unresolved' REJECTS as 'resolved' (Reason: 1 - Claim re-submitted) 54 N CLSCOM,COD1,COD2,COD3 55 S COD2=$P($G(OVRC),"^"),COD1=$P($G(OVRC),"^",2),COD3=$P($G(OVRC),"^",3) 56 I $G(COD3)'="" S CLSCOM="DUR Override Codes "_COD1_"/"_COD2_"/"_COD3_" submitted." 57 I $G(CLA)'="" S CLSCOM="Clarification Code "_CLA_" submitted." 58 I $G(PA)'="" S CLSCOM="Prior Authorization Code ("_$P(PA,"^")_"/"_$P(PA,"^",2)_") submitted." 59 D CLSALL^PSOREJUT(RX,RFL,DUZ,1,$G(CLSCOM),$G(COD1),$G(COD2),$G(COD3),$G(CLA),$G(PA)) 60 ; 61 ; - Call to ECME (NEWing STAT because ECME was overwriting it - Important variable for CMOP release PSXVND) 62 N STAT 63 I $G(RVTX)="",FROM="ED" S RVTX="RX EDITED" 64 S RESP=$$EN^BPSNCPDP(RX,RFL,$$DOS(RX,RFL,.DATE),FROM,NDC,$G(RVTX),$G(OVRC),,$G(CLA),$G(PA)) 65 I $$STATUS^PSOBPSUT(RX,RFL)="E PAYABLE" D SAVNDC^PSONDCUT(RX,RFL,NDC,+$G(CMOP),1) 66 ; 67 ; - Reseting the Re-transmission flag 68 D RETRXF^PSOREJU2(RX,RFL,0) 69 ; 70 ; - Logging ECME Activity Log to the PRESCRIPTION file 71 I $G(ALTX)="" D 72 . N X,ROUTE S (ROUTE,X)="" 73 . S ROUTE=$S(FROM="RF":$$GET1^DIQ(52.1,RFL_","_RX_",",2),FROM="OF":$$GET1^DIQ(52,RX_",",11),1:"") 74 . S:FROM="OF" X=ROUTE_" FILL(NDC:"_$$GETNDC^PSONDCUT(RX,RFL)_")" 75 . S:FROM="RF" X=ROUTE_" REFILL(NDC:"_$$GETNDC^PSONDCUT(RX,RFL)_")" 76 . S:FROM="RN" X="RX RENEWED(NDC:"_$$GETNDC^PSONDCUT(RX,RFL)_")" 77 . S:FROM="PL" X="PRINTED FROM SUSPENSE(NDC:"_$$GETNDC^PSONDCUT(RX,RFL)_")" 78 . S:FROM="PE"!(FROM="PP") X="PULLED FROM SUSPENSE(NDC:"_$$GETNDC^PSONDCUT(RX,RFL)_")" 79 . S:FROM="PC" X="CMOP TRANSMISSION(NDC:"_$$GETNDC^PSONDCUT(RX,RFL)_")" 80 . S:FROM="RRL" X="RELEASED RX PREVIOUSLY REVERSED" 81 . S:FROM="ED" X="RX EDITED" 82 . S:$G(RVTX)'="" X=RVTX 83 . S:$G(OVRC)'="" X="DUR OVERRIDE CODES("_$G(COD1)_"/"_$G(COD2)_"/"_$G(COD3)_")" 84 . S:$G(CNDC) X=X_"(NDC:"_NDCACT_")" S ACT=ACT_X 85 . S ACT=ACT_$$STS(RX,RFL,RESP) 86 I $G(ALTX)'="" S ACT=ACT_ALTX_$$STS(RX,RFL,RESP) 87 I +RESP=2 S ACT="Not ECME Billable: "_$P(RESP,"^",2) 88 I +RESP=10 S ACT="ECME reversed/NOT re-submitted: "_$P(RESP,"^",2) 89 D RXACT^PSOBPSU2(RX,RFL,ACT,"M",DUZ) 90 ; 91 ; -Logs an ECME Activity Log if Rx Quantity is different than Billing Quantity 92 I 'RESP,$T(NCPDPQTY^PSSBPSUT)'="" D 93 . N DRUG,RXQTY,BLQTY,BLDU,Z 94 . S DRUG=$$GET1^DIQ(52,RX,6,"I") 95 . S RXQTY=$S('RFL:$$GET1^DIQ(52,RX,7,"I"),1:$$GET1^DIQ(52.1,RFL_","_RX,1))/1 96 . S Z=$$NCPDPQTY^PSSBPSUT(DRUG,RXQTY),BLQTY=Z/1,BLDU=$P(Z,"^",2) 97 . I RXQTY'=BLQTY D 98 . . D RXACT^PSOBPSU2(RX,RFL,"BILLING QUANTITY submitted: "_$J(BLQTY,0,$L($P(BLQTY,".",2)))_" ("_BLDU_")","M",DUZ) 99 ; 100 Q 101 ; 102 REVERSE(RX,RFL,FROM,RSN,RTXT,IGRL,NDC) ; - Reverse a claim and close all OPEN/UNRESOLVED Rejects 103 ;Input: (r) RX - Rx IEN (#52) 104 ; (o) RFL - Refill # (Default: most recent) 105 ; (r) FROM - Function within OP (See BWHERE param. in EN^BPSNCPDP api) 106 ; (o) RSN - Close Reason (2:RX ON HOLD;4: RX RETURNED TO STOCK,5:RX DELETED,etc...) 107 ; (o) RTXT - Close Reason TEXT (Usually no passed if RSN is passed) 108 ; (o) IGRL - Ignore RELEASE DATE, reverse anyway 109 ; (o) NDC - NDC number related to the reversal (Note: might be an invalid NDC) 110 ; 111 I '$D(RFL) S RFL=$$LSTRFL(RX) 112 ; 113 I $$STATUS^PSOBPSUT(RX,RFL)="" Q 114 ; 115 N RESP,STS,ACT,STAT,DA,STATUS,NOACT S RSN=+$G(RSN),RTXT=$G(RTXT) 116 I RTXT="",RSN D 117 . S:RSN=2 RTXT="RX PLACED ON HOLD" S:RSN=3 RTXT="RX SUSPENDED" S:RSN=4 RTXT="RX RETURNED TO STOCK" 118 . S:RSN=5 RTXT="RX DELETED" S:RSN=7 RTXT="RX DISCONTINUED" S:RSN=8 RTXT="RX EDITED" 119 ; 120 D CLSALL^PSOREJUT(RX,RFL,DUZ,RSN,RTXT) 121 ; 122 I '$G(IGRL),$$RXRLDT^PSOBPSUT(RX,RFL) Q 123 ; 124 ; - Reseting the Re-transmission flag if Rx is being suspended 125 I RSN=3!($$GET1^DIQ(52,RX,100,"I")=5) D RETRXF^PSOREJU2(RX,RFL,1) 126 ; 127 S STATUS=$$STATUS^PSOBPSUT(RX,RFL),NOACT=0 128 I STATUS'="E PAYABLE",STATUS'="IN PROGRESS",STATUS'="E REVERSAL REJECTED",STATUS'="E REVERSAL STRANDED",STATUS'="E DUPLICATE" S NOACT=1 129 ; 130 S RESP=$$EN^BPSNCPDP(RX,RFL,$$DOS(RX,RFL),FROM,$$GETNDC^PSONDCUT(RX,RFL),RTXT) 131 ; 132 ; - Logging ECME Activity Log 133 I '$G(NOACT) D 134 . S ACT="Reversal sent to ECME: "_RTXT_$S($G(NDC)'="":" ("_NDC_")",1:"")_$$STS(RX,RFL,+RESP) 135 . D RXACT^PSOBPSU2(RX,RFL,ACT,"M",DUZ) 136 ; 137 Q 138 ; 139 DOS(RX,RFL,DATE) ; Return the Date Of Service for ECME 140 ;Input: (r) RX - Rx IEN (#52) 141 ; (o) RFL - Refill # (Default: most recent) 142 ; (o) DATE - Possible Date Of Service 143 ;Output: DOS - Actual Date Of Service 144 ; 145 I '$D(RFL) S RFL=$$LSTRFL(RX) 146 ; 147 ; - Retrieving FILL DATE from the PRESCRIPTION file if not passed 148 I $G(DATE)="" S DATE=$$RXRLDT^PSOBPSUT(RX,RFL) 149 ; - Retrieving FILL DATE from the PRESCRIPTION file if not passed 150 I 'DATE S DATE=$$RXFLDT^PSOBPSUT(RX,RFL) 151 ; - Future Date not allowed 152 I DATE>DT!'DATE S DATE=DT 153 ; 154 Q (DATE\1) 155 ; 156 RELEASE(RX,RFL,USR) ; - Notifies IB that the Rx was RELEASED 157 ;Input: (r) RX - Rx IEN (#52) 158 ; (o) RFL - Refill # (Default: most recent) 159 ; (o) USR - User responsible for releasing the Rx (Default: .5 - Postmaster) 160 ; 161 N IBAR,RXAR,FLDT,RFAR 162 ; 163 S:'$D(RFL) RFL=$$LSTRFL(RX) 164 S:'$D(USR) USR=.5 165 ; 166 D GETS^DIQ(52,RX_",",".01;2;6;7;8;22","I","RXAR") 167 S DFN=+$G(RXAR(52,RX_",",2,"I")) 168 S IBAR("PRESCRIPTION")=RX,IBAR("RX NO")=$G(RXAR(52,RX_",",.01,"I")) 169 S IBAR("CLAIMID")=$E((RX#10000000)+10000000,2,8),IBAR("USER")=USR 170 S IBAR("DRUG")=RXAR(52,RX_",",6,"I"),IBAR("NDC")=$$GETNDC^PSONDCUT(RX,RFL) 171 S FLDT=$$RXFLDT^PSOBPSUT(RX,RFL) I FLDT>DT S FLDT=DT 172 S IBAR("FILL NUMBER")=RFL,IBAR("FILL DATE")=FLDT 173 S IBAR("QTY")=$G(RXAR(52,RX_",",7,"I")),IBAR("DAYS SUPPLY")=$G(RXAR(52,RX_",",8,"I")) 174 ; 175 I RFL D 176 . D GETS^DIQ(52.1,RFL_","_RX_",",".01;1;1.1","I","RFAR") 177 . S IBAR("QTY")=$G(RFAR(52.1,RFL_","_RX_",",1,"I")) 178 . S IBAR("DAYS SUPPLY")=$G(RFAR(52.1,RFL_","_RX_",",1.1,"I")) 179 ; 180 S IBAR("STATUS")="RELEASED" D STORESP^IBNCPDP(DFN,.IBAR) 181 ; 182 Q 183 ; 184 LSTRFL(RX) ; - Returns the latest fill for the Prescription 185 ; Input: (r) RX - Rx IEN (#52) 186 ;Output: LSTRFL - Most recent refill # 187 N I,LSTRFL 188 S (I,LSTRFL)=0 F S I=$O(^PSRX(RX,1,I)) Q:'I S LSTRFL=I 189 Q LSTRFL 190 ; 191 ECMEACT(RX,RFL,COMM,USR) ; - Add an Activity to the ECME Activity Log (PRESCRIPTION file) 192 ;Input: (r) RX - Rx IEN (#52) 193 ; (o) RFL - Refill # (Default: most recent) 194 ; (r) COMM - Comments (up to 75 characters) 195 ; (o) USR - User logging the comments (Default: DUZ) 196 ; 197 S:'$D(RFL) RFL=$$LSTRFL^PSOBPSU1(RX) 198 D RXACT^PSOBPSU2(RX,RFL,COMM,"M",+$G(USR)) 199 Q 200 ; 201 STS(RX,RFL,RSP) ; Adds the Status to the ECME Activity Log according to Rx/fill claim status Response 202 N STS 203 S STS=$S($$STATUS^PSOBPSUT(RX,RFL)'="IN PROGRESS"&($$STATUS^PSOBPSUT(RX,RFL)'=""):"-"_$$STATUS^PSOBPSUT(RX,RFL),1:"") 204 S:+RSP=1 STS="-NO SUBMISSION THROUGH ECME" S:+RSP=3 STS="-NO REVERSAL NEEDED" S:+RSP=4 STS="-NOT PROCESSED" 205 S:+RSP=5 STS="-SOFTWARE ERROR" 206 I +RSP=2,$$STATUS^PSOBPSUT(RX,RFL)'="" S STS="-NOT BILLABLE:"_$P(RSP,"^",2) 207 Q STS 1 PSOBPSU1 ;BIRM/MFR - BPS (ECME) Utilities 1 ;10/15/04 2 ;;7.0;OUTPATIENT PHARMACY;**148,260**;DEC 1997;Build 84 3 ;Reference to $$EN^BPSNCPDP supported by IA 4415 4 ;References to $$NDCFMT^PSSNDCUT,$$GETNDC^PSSNDCUT supported by IA 4707 5 ;References to $$ECMEON^BPSUTIL,$$CMOPON^BPSUTIL supported by IA 4410 6 ;References to STORESP^IBNCPDP supported by IA 4299 7 ; 8 ECMESND(RX,RFL,DATE,FROM,NDC,CMOP,RVTX,OVRC,CNDC,RESP,IGSW,ALTX,CLA,PA) ; - Sends Rx Release information to ECME/IB and 9 ; updates NDC in the DRUG/PRESCRIPTION files 10 ;Reference to routine EN^BPSNCPDP supported by DBIA #4304 11 ;Input: (r) RX - Rx IEN (#52) 12 ; (o) RFL - Refill # (Default: most recent) 13 ; (r) DATE - Date of Service 14 ; (r) FROM - Function within OP (See BWHERE param. in EN^BPSNCPDP api) 15 ; (o) NDC - NDC Number (If not passed, will be retrieved from DRUG file) 16 ; (o) CMOP - CMOP Prescription (1-YES/0-NO) (Default: 0) 17 ; (o) RVTX - REVERSE text (e.g., RX EDIT, RX RELEASE-NDC CHANGE, etc) 18 ; (o) OVRC - Set of 3 NCPDP override codes separated by "^": 19 ; Piece 1: NCPDP Professional Service Code for overriding DUR REJECTS 20 ; Piece 2: NCPDP Reason for Service Code for overriding DUR REJECTS 21 ; Piece 3: NCPDP Result of Service Code for overriding DUR REJECTS 22 ; (o) CNDC - Changed NDC? 1 - Yes / 0 - No (Default: NO) 23 ; (o) IGSW - Ignore Switches (Master and CMOP)? 1 - Yes / 0 - No (Default: NO) 24 ; (o) ALTX - Alternative Text to be placed in the Rx ECME Activity Log 25 ; (o) CLA - NCPDP Clarification Code for overriding DUR/RTS REJECTS 26 ; (o) PA - NCPDP Prior Authorization Type and Number (separated by "^") 27 ;Output: RESP - Response from $$EN^BPSNCPDP api 28 ; 29 ; - Retrieving the NDC code from the DRUG file if not passed in, then save it in the DRUG file 30 N ACT,NDCACT,DA 31 ; 32 I '$D(RFL) S RFL=$$LSTRFL(RX) 33 ; 34 ; - ECME is not turned ON for the Rx's Division 35 I '$G(IGSW),'$$ECMEON^BPSUTIL($$RXSITE^PSOBPSUT(RX,RFL)) S RESP="-1^ECME SWITCH OFF" Q 36 ; 37 ; - ECME CMOP is not turned ON for the Rx's Division 38 I '$G(IGSW),$G(CMOP),'$$CMOPON^BPSUTIL($$RXSITE^PSOBPSUT(RX,RFL)) S RESP="-1^CMOP SWITCH OFF" Q 39 ; 40 ; - Saving the NDC to be displayed on the ECME Activity Log 41 I $G(CNDC) D 42 . I $G(NDC)'="" S NDCACT=NDC Q 43 . S NDCACT=$$GETNDC^PSONDCUT(RX,RFL) 44 ; 45 I $$NDCFMT^PSSNDCUT($G(NDC))="" D 46 . S NDC=$$GETNDC^PSSNDCUT($$GET1^DIQ(52,RX,6,"I"),$$RXSITE^PSOBPSUT(RX,RFL),+$G(CMOP)) 47 . I $G(NDC)'="" D SAVNDC^PSONDCUT(RX,RFL,NDC,+$G(CMOP)) 48 ; 49 ; - Creating ECME Activity Log on the PRESCRIPTION file 50 S ACT="Submitted" I $$STATUS^PSOBPSUT(RX,RFL)="E PAYABLE" S ACT="Reversal/Re-submit sent" 51 S ACT=ACT_" to ECME:" 52 ; 53 ; - Marked any 'unresolved' REJECTS as 'resolved' (Reason: 1 - Claim re-submitted) 54 N CLSCOM,COD1,COD2,COD3 55 S COD2=$P($G(OVRC),"^"),COD1=$P($G(OVRC),"^",2),COD3=$P($G(OVRC),"^",3) 56 I $G(COD3)'="" S CLSCOM="DUR Override Codes "_COD1_"/"_COD2_"/"_COD3_" submitted." 57 I $G(CLA)'="" S CLSCOM="Clarification Code "_CLA_" submitted." 58 I $G(PA)'="" S CLSCOM="Prior Authorization Code ("_$P(PA,"^")_"/"_$P(PA,"^",2)_") submitted." 59 D CLSALL^PSOREJUT(RX,RFL,DUZ,1,$G(CLSCOM),$G(COD1),$G(COD2),$G(COD3),$G(CLA),$G(PA)) 60 ; 61 ; - Call to ECME (NEWing STAT because ECME was overwriting it - Important variable for CMOP release PSXVND) 62 N STAT 63 I $G(RVTX)="",FROM="ED" S RVTX="RX EDITED" 64 S RESP=$$EN^BPSNCPDP(RX,RFL,$$DOS(RX,RFL,.DATE),FROM,NDC,$G(RVTX),$G(OVRC),,$G(CLA),$G(PA)) 65 ; 66 ; - Reseting the Re-transmission flag 67 D RETRXF^PSOREJU2(RX,RFL,0) 68 ; 69 ; - Logging ECME Activity Log to the PRESCRIPTION file 70 I $G(ALTX)="" D 71 . N X S X="" 72 . S:FROM="OF" X="WINDOW FILL(NDC:"_$$GETNDC^PSONDCUT(RX,RFL)_")" 73 . S:FROM="RF" X="WINDOW REFILL(NDC:"_$$GETNDC^PSONDCUT(RX,RFL)_")" 74 . S:FROM="RN" X="RX RENEWED(NDC:"_$$GETNDC^PSONDCUT(RX,RFL)_")" 75 . S:FROM="PL" X="SUSP LABEL PRINTED(NDC:"_$$GETNDC^PSONDCUT(RX,RFL)_")" 76 . S:FROM="PE"!(FROM="PP") X="PULLED FROM SUSPENSE(NDC:"_$$GETNDC^PSONDCUT(RX,RFL)_")" 77 . S:FROM="PC" X="CMOP TRANSMISSION(NDC:"_$$GETNDC^PSONDCUT(RX,RFL)_")" 78 . S:FROM="RRL" X="RELEASED RX PREVIOUSLY REVERSED" 79 . S:FROM="ED" X="RX EDITED" 80 . S:$G(RVTX)'="" X=RVTX 81 . S:$G(OVRC)'="" X="DUR OVERRIDE CODES("_$G(COD1)_"/"_$G(COD2)_"/"_$G(COD3)_")" 82 . S:$G(CNDC) X=X_"(NDC:"_NDCACT_")" S ACT=ACT_X 83 . S ACT=ACT_$$STS(RX,RFL,RESP) 84 I $G(ALTX)'="" S ACT=ACT_ALTX_$$STS(RX,RFL,RESP) 85 I +RESP=2 S ACT="Not ECME Billable: "_$P(RESP,"^",2) 86 I +RESP=10 S ACT="ECME reversed/NOT re-submitted: "_$P(RESP,"^",2) 87 D RXACT^PSOBPSU2(RX,RFL,ACT,"M",DUZ) 88 ; 89 ; -Logs an ECME Activity Log if Rx Quantity is different than Billing Quantity 90 I 'RESP,$T(NCPDPQTY^PSSBPSUT)'="" D 91 . N DRUG,RXQTY,BLQTY,BLDU,Z 92 . S DRUG=$$GET1^DIQ(52,RX,6,"I") 93 . S RXQTY=$S('RFL:$$GET1^DIQ(52,RX,7,"I"),1:$$GET1^DIQ(52.1,RFL_","_RX,1))/1 94 . S Z=$$NCPDPQTY^PSSBPSUT(DRUG,RXQTY),BLQTY=Z/1,BLDU=$P(Z,"^",2) 95 . I RXQTY'=BLQTY D 96 . . D RXACT^PSOBPSU2(RX,RFL,"BILLING QUANTITY submitted: "_$J(BLQTY,0,$L($P(BLQTY,".",2)))_" ("_BLDU_")","M",DUZ) 97 ; 98 Q 99 ; 100 REVERSE(RX,RFL,FROM,RSN,RTXT,IGRL,NDC) ; - Reverse a claim and close all OPEN/UNRESOLVED Rejects 101 ;Input: (r) RX - Rx IEN (#52) 102 ; (o) RFL - Refill # (Default: most recent) 103 ; (r) FROM - Function within OP (See BWHERE param. in EN^BPSNCPDP api) 104 ; (o) RSN - Close Reason (2:RX ON HOLD;4: RX RETURNED TO STOCK,5:RX DELETED,etc...) 105 ; (o) RTXT - Close Reason TEXT (Usually no passed if RSN is passed) 106 ; (o) IGRL - Ignore RELEASE DATE, reverse anyway 107 ; (o) NDC - NDC number related to the reversal (Note: might be an invalid NDC) 108 ; 109 I '$D(RFL) S RFL=$$LSTRFL(RX) 110 ; 111 I $$STATUS^PSOBPSUT(RX,RFL)="" Q 112 ; 113 N RESP,STS,ACT,STAT,DA,STATUS,NOACT S RSN=+$G(RSN),RTXT=$G(RTXT) 114 I RTXT="",RSN D 115 . S:RSN=2 RTXT="RX PLACED ON HOLD" S:RSN=3 RTXT="RX SUSPENDED" S:RSN=4 RTXT="RX RETURNED TO STOCK" 116 . S:RSN=5 RTXT="RX DELETED" S:RSN=7 RTXT="RX DISCONTINUED" S:RSN=8 RTXT="RX EDITED" 117 ; 118 D CLSALL^PSOREJUT(RX,RFL,DUZ,RSN,RTXT) 119 ; 120 I '$G(IGRL),$$RXRLDT^PSOBPSUT(RX,RFL) Q 121 ; 122 ; - Reseting the Re-transmission flag if Rx is being suspended 123 I RSN=3!($$GET1^DIQ(52,RX,100,"I")=5) D RETRXF^PSOREJU2(RX,RFL,1) 124 ; 125 S STATUS=$$STATUS^PSOBPSUT(RX,RFL),NOACT=0 126 I STATUS'="E PAYABLE",STATUS'="IN PROGRESS",STATUS'="E REVERSAL REJECTED",STATUS'="E REVERSAL STRANDED",STATUS'="E DUPLICATE" S NOACT=1 127 ; 128 S RESP=$$EN^BPSNCPDP(RX,RFL,$$DOS(RX,RFL),FROM,$$GETNDC^PSONDCUT(RX,RFL),RTXT) 129 ; 130 ; - Logging ECME Activity Log 131 I '$G(NOACT) D 132 . S ACT="Reversal sent to ECME: "_RTXT_$S($G(NDC)'="":" ("_NDC_")",1:"")_$$STS(RX,RFL,+RESP) 133 . D RXACT^PSOBPSU2(RX,RFL,ACT,"M",DUZ) 134 ; 135 Q 136 ; 137 DOS(RX,RFL,DATE) ; Return the Date Of Service for ECME 138 ;Input: (r) RX - Rx IEN (#52) 139 ; (o) RFL - Refill # (Default: most recent) 140 ; (o) DATE - Possible Date Of Service 141 ;Output: DOS - Actual Date Of Service 142 ; 143 I '$D(RFL) S RFL=$$LSTRFL(RX) 144 ; 145 ; - Retrieving FILL DATE from the PRESCRIPTION file if not passed 146 I $G(DATE)="" S DATE=$$RXRLDT^PSOBPSUT(RX,RFL) 147 ; - Retrieving FILL DATE from the PRESCRIPTION file if not passed 148 I 'DATE S DATE=$$RXFLDT^PSOBPSUT(RX,RFL) 149 ; - Future Date not allowed 150 I DATE>DT!'DATE S DATE=DT 151 ; 152 Q (DATE\1) 153 ; 154 RELEASE(RX,RFL,USR) ; - Notifies IB that the Rx was RELEASED 155 ;Input: (r) RX - Rx IEN (#52) 156 ; (o) RFL - Refill # (Default: most recent) 157 ; (o) USR - User responsible for releasing the Rx (Default: .5 - Postmaster) 158 ; 159 N IBAR,RXAR,FLDT,RFAR 160 ; 161 S:'$D(RFL) RFL=$$LSTRFL(RX) 162 S:'$D(USR) USR=.5 163 ; 164 D GETS^DIQ(52,RX_",",".01;2;6;7;8;22","I","RXAR") 165 S DFN=+$G(RXAR(52,RX_",",2,"I")) 166 S IBAR("PRESCRIPTION")=RX,IBAR("RX NO")=$G(RXAR(52,RX_",",.01,"I")) 167 S IBAR("CLAIMID")=$E((RX#10000000)+10000000,2,8),IBAR("USER")=USR 168 S IBAR("DRUG")=RXAR(52,RX_",",6,"I"),IBAR("NDC")=$$GETNDC^PSONDCUT(RX,RFL) 169 S FLDT=$$RXFLDT^PSOBPSUT(RX,RFL) I FLDT>DT S FLDT=DT 170 S IBAR("FILL NUMBER")=RFL,IBAR("FILL DATE")=FLDT 171 S IBAR("QTY")=$G(RXAR(52,RX_",",7,"I")),IBAR("DAYS SUPPLY")=$G(RXAR(52,RX_",",8,"I")) 172 ; 173 I RFL D 174 . D GETS^DIQ(52.1,RFL_","_RX_",",".01;1;1.1","I","RFAR") 175 . S IBAR("QTY")=$G(RFAR(52.1,RFL_","_RX_",",1,"I")) 176 . S IBAR("DAYS SUPPLY")=$G(RFAR(52.1,RFL_","_RX_",",1.1,"I")) 177 ; 178 S IBAR("STATUS")="RELEASED" D STORESP^IBNCPDP(DFN,.IBAR) 179 ; 180 Q 181 ; 182 LSTRFL(RX) ; - Returns the latest fill for the Prescription 183 ; Input: (r) RX - Rx IEN (#52) 184 ;Output: LSTRFL - Most recent refill # 185 N I,LSTRFL 186 S (I,LSTRFL)=0 F S I=$O(^PSRX(RX,1,I)) Q:'I S LSTRFL=I 187 Q LSTRFL 188 ; 189 ECMEACT(RX,RFL,COMM,USR) ; - Add an Activity to the ECME Activity Log (PRESCRIPTION file) 190 ;Input: (r) RX - Rx IEN (#52) 191 ; (o) RFL - Refill # (Default: most recent) 192 ; (r) COMM - Comments (up to 75 characters) 193 ; (o) USR - User logging the comments (Default: DUZ) 194 ; 195 S:'$D(RFL) RFL=$$LSTRFL^PSOBPSU1(RX) 196 D RXACT^PSOBPSU2(RX,RFL,COMM,"M",+$G(USR)) 197 Q 198 ; 199 STS(RX,RFL,RSP) ; Adds the Status to the ECME Activity Log according to Rx/fill claim status Response 200 N STS 201 S STS=$S($$STATUS^PSOBPSUT(RX,RFL)'="IN PROGRESS"&($$STATUS^PSOBPSUT(RX,RFL)'=""):"-"_$$STATUS^PSOBPSUT(RX,RFL),1:"") 202 S:+RSP=1 STS="-NO SUBMISSION THROUGH ECME" S:+RSP=3 STS="-NO REVERSAL NEEDED" S:+RSP=4 STS="-NOT PROCESSED" 203 S:+RSP=5 STS="-SOFTWARE ERROR" 204 I +RSP=2,$$STATUS^PSOBPSUT(RX,RFL)'="" S STS="-NOT BILLABLE:"_$P(RSP,"^",2) 205 Q STS
Note:
See TracChangeset
for help on using the changeset viewer.
