PSOREJUT ;BIRM/MFR - BPS (ECME) - Clinical Rejects Utilities ;06/07/05
;;7.0;OUTPATIENT PHARMACY;**148,247,260,287,289,290,358,359,385,403,421,427,448,478,528,544,562,702**;DEC 1997;Build 14
; Reference to $$IEN59^BPSOSRX in ICR #4412
; Reference to DUR1^BPSNCPD3 in ICR #4560
; Reference to $$ADDCOMM^BPSBUTL in ICR #4719
;
SAVE(RX,RFL,REJ,REOPEN) ; - Saves DUR Information in the file 52
; Input: (r) RX - Rx IEN (#52)
; (o) RFL - Refill # (Default: most recent)
; (o) REOPEN - value of 1 means claim being reopened; null or no value passed means reopen claim functionality not being used
; (r) REJ - Array containing information about the REJECT on the following subscripts:
; "BIN" - BIN Number
; "PCN" - PCN Number
; "CODE" - Reject Code (79 or 88 or 943)
; "DATE/TIME" - Date/Time Reject Detected
; "PAYER MESSAGE" - Message returned by Payer (up to 140 chars long)
; "REASON" - Reject Reason (up to 100 chars long)
; "DUR TEXT" - Payer's DUR description
; "DUR ADD MSG TEXT" - Payer's DUR additional message text description
; "INSURANCE NAME" - Patient's Insurance Company Name
; "INSURANCE POINTER" - Patient's Insurance Company IEN
; "GROUP NAME" - Patient's Insurance Group Name
; "GROUP NUMBER" - Patient's Insurance Group Number
; "CARDHOLDER ID" - Patient's Insurance Cardholder ID
; "COB" - Coordination of Benefits
; "PLAN CONTACT" - Patient's Insurance Plan Contact (1-800)
; "PREVIOUS FILL" - Plan's Previous Fill Date
; "OTHER REJECTS" - Other Rejects with same Response
; "PHARMACIST" - Pharmacist DUZ
; "RESPONSE IEN" - Pointer to the RESPONSE file in ECME
; "REASON SVC CODE" - Reason for Service Code (pointer to BPS NCPDP REASON FOR SERVICE CODE)
; "RE-OPENED" - Re-Open Flag
; "RRR FLAG" - Reject Resolution Required indicator (expecting 1/0 into SAVE)
; "RRR THRESHOLD AMT" - Reject Resolution Required Dollar Threshold
; "RRR GROSS AMT DUE" - Reject Resolution Required Gross Amount Due
;Output: REJ("REJECT IEN")
N %,DIC,DR,DA,X,DINUM,DD,DO,DLAYGO,ERR,PSOAUTO
I '$D(RFL) S RFL=$$LSTRFL^PSOBPSU1(RX)
I '$G(PSODIV) S PSODIV=$$RXSITE^PSOBPSUT(RX,RFL)
S REJ("BIN")=$E($G(REJ("BIN")),1,6)
S REJ("PCN")=$G(REJ("PCN"))
S REJ("CODE")=$G(REJ("CODE"))
;
; convert REJ("RRR FLAG") into internal format (1/0) if necessary. When coming into SAVE from the Re-open Reject
; action, this flag is in the external format (YES/NO). esg - 3/29/16 - PSO*7*448
I $G(REJ("RRR FLAG"))="YES" S REJ("RRR FLAG")=1
I $G(REJ("RRR FLAG"))="NO" S REJ("RRR FLAG")=0
;
;Ignore this additional Check if reject is Reject Resolution Required reject - PSO*7*421
I '$G(REJ("RRR FLAG")),REJ("CODE")'=79&(REJ("CODE")'=88)&(REJ("CODE")'=943)&('$G(PSOTRIC))&('$G(REOPEN)) S ERR=$$EVAL^PSOREJU4(PSODIV,REJ("CODE"),$G(OPECC)) Q:'+ERR
S REJ("PAYER MESSAGE")=$E($G(REJ("PAYER MESSAGE")),1,140),REJ("REASON")=$E($G(REJ("REASON")),1,100)
S REJ("DUR TEXT")=$E($G(REJ("DUR TEXT")),1,100),REJ("DUR ADD MSG TEXT")=$E($G(REJ("DUR ADD MSG TEXT")),1,100),REJ("GROUP NAME")=$E($G(REJ("GROUP NAME")),1,30)
S REJ("INSURANCE NAME")=$E($G(REJ("INSURANCE NAME")),1,30),REJ("PLAN CONTACT")=$E($G(REJ("PLAN CONTACT")),1,30)
S REJ("GROUP NUMBER")=$E($G(REJ("GROUP NUMBER")),1,30),REJ("OTHER REJECTS")=$E($G(REJ("OTHER REJECTS")),1,15)
S REJ("CARDHOLDER ID")=$E($G(REJ("CARDHOLDER ID")),1,20),REJ("COB")=$G(REJ("COB"))
D NOW^%DTC
I $G(REJ("DATE/TIME"))="" S REJ("DATE/TIME")=%
S DIC="^PSRX("_RX_",""REJ"",",DA(1)=RX,DIC(0)=""
S X=$G(REJ("CODE")),DINUM=$O(^PSRX(RX,"REJ",9999),-1)+1
S PSOAUTO=$$AUTORES(RX,RFL,REJ("CODE"),$G(REJ("REASON SVC CODE")))
S DIC("DR")="1///"_$G(REJ("DATE/TIME"))_";2///"_REJ("PAYER MESSAGE")_";3///"_REJ("REASON")_";4////"_$G(REJ("PHARMACIST"))_";5///"_RFL
S DIC("DR")=DIC("DR")_";6///"_REJ("GROUP NAME")_";7///"_REJ("PLAN CONTACT")_";8///"_$G(REJ("PREVIOUS FILL"))
I PSOAUTO=1 D
. S DIC("DR")=DIC("DR")_";9///1"
. S DIC("DR")=DIC("DR")_";10///"_%
. S DIC("DR")=DIC("DR")_";11///.5"
. S DIC("DR")=DIC("DR")_";12///9"
E S DIC("DR")=DIC("DR")_";9///0"
S DIC("DR")=DIC("DR")_";14///"_$G(REJ("REASON SVC CODE"))_";16///"_$G(REJ("RESPONSE IEN"))
S DIC("DR")=DIC("DR")_";17///"_$G(REJ("OTHER REJECTS"))_";18///"_REJ("DUR TEXT")_";20///"_REJ("INSURANCE NAME")
S DIC("DR")=DIC("DR")_";21///"_REJ("GROUP NUMBER")_";22///"_REJ("CARDHOLDER ID")_";23///"_$G(REJ("RE-OPENED"))
S DIC("DR")=DIC("DR")_";27///"_REJ("COB")
S DIC("DR")=DIC("DR")_";28///"_REJ("DUR ADD MSG TEXT")
S DIC("DR")=DIC("DR")_";29///"_REJ("BIN")
S DIC("DR")=DIC("DR")_";34///"_REJ("PCN")
;Update Reject Resolution Required fields - PSO*7*421
I $G(REJ("RRR FLAG")) D
.S DIC("DR")=DIC("DR")_";30///"_REJ("RRR FLAG")
.S DIC("DR")=DIC("DR")_";31///"_REJ("RRR THRESHOLD AMT")
.S DIC("DR")=DIC("DR")_";32///"_REJ("RRR GROSS AMT DUE")
S DIC("DR")=DIC("DR")_";33///"_REJ("INSURANCE POINTER")
F L +^PSRX(RX):5 Q:$T H 15
K DD,DO D FILE^DICN K DD,DO S REJ("REJECT IEN")=+Y
S REJ("OVERRIDE MSG")=$G(DATA("OVERRIDE MSG"))
;Comments use POSTMASTER as user for auto transfers - PSO*7*421
I REJ("OVERRIDE MSG")'="" D
.N ORIGIN S ORIGIN=$G(DUZ)
.S:REJ("OVERRIDE MSG")["Automatically transferred" ORIGIN=.5
.D SAVECOM^PSOREJP3(RX,REJ("REJECT IEN"),REJ("OVERRIDE MSG"),$G(REJ("DATE/TIME")),ORIGIN)
.;Insert comment for Transfer and RRR Rejects - PSO*7*421
.I REJ("OVERRIDE MSG")["Automatically transferred" D
..N X,TXT
..S TXT="Auto Send to Pharmacy Worklist due to Transfer Reject Code"
..I $G(REJ("RRR FLAG")) S TXT="Auto Send to Pharmacy Worklist due to RRR Code"
..I $G(PSOTRIC) S TXT="Auto Send to Pharmacy Worklist & OPECC - CVA/TRI"
..S X=$$ADDCOMM^BPSBUTL(RX,RFL,TXT,1) ; IA 4719
;
I PSOAUTO=1 D
. N X,TXT
. S TXT="Not transferred to Pharmacy-Unable to Resolve Backbill/Resubmit"
. S X=$$ADDCOMM^BPSBUTL(RX,RFL,TXT,1)
;
L -^PSRX(RX)
Q
;
CLSALL(RX,RFL,USR,REA,COM,COD1,COD2,COD3,CLA,PA) ; Close/Resolve All Rejects
;Input: (r) RX - Rx IEN (#52)
; (o) RFL - Refill # (Default: most recent)
; (o) USR - User DUZ responsible for closing all rejects
; (r) REA - Close REASON code
; (o) COM - Close COMMENTS
; (o) COD1 - First set of DUR overrides (Reason Code^Professional Code^Result Code)
; (o) COD2 - Second set of DUR overrides (Reason Code^Professional Code^Result Code)
; (o) COD3 - Third set of DUR overrides (Reason Code^Professional Code^Result Code)
; (o) CLA - NCPDP Clarification Code for overriding RTS and DUR REJECTS
; (o) PA - NCPDP Prior Authorization Type and Number (separated by "^")
N REJ,REJDATA,DIE,DR,DA
I '$D(RFL) S RFL=$$LSTRFL^PSOBPSU1(RX)
;
; - Closing OPEN/UNRESOLVED rejects
I $$FIND(RX,RFL,.REJDATA,,1) D
. S REJ="" F S REJ=$O(REJDATA(REJ)) Q:'REJ D
. . D CLOSE(RX,RFL,REJ,USR,REA,$G(COM),$G(COD1),$G(COD2),$G(COD3),$G(CLA),$G(PA))
Q
;
CLOSE(RX,RFL,REJ,USR,REA,COM,COD1,COD2,COD3,CLA,PA,IGNR) ; - Mark a DUR/REFILL TOO SOON reject RESOLVED
; Input: (r) RX - Rx IEN (#52)
; (o) RFL - Refill # (Default: most recent)
; (r) REJ - REJECT ID (IEN)
; (o) USR - User (file #200 IEN) responsible for closing the REJECT
; (r) REA - Reason for closing the REJECT (52.25,12):
; 1:CLAIM RE-SUBMITTED
; 2:RX ON HOLD
; 3:RX SUSPENDED
; 4:RX RETURNED TO STOCK
; 5:RX DELETED
; 6:IGNORED - NO RESUBMISSION
; 7:RX DISCONTINUED
; 8:RX EDITED
; 99:OTHER
; (o) COM - Close comments manually entered by the user
; (o) COD1 - First set of DUR overrides (Reason Code^Professional Code^Result Code)
; (o) COD2 - Second set of DUR overrides (Reason Code^Professional Code^Result Code)
; (o) COD3 - Third set of DUR overrides (Reason Code^Professional Code^Result Code)
; (o) CLA - NCPDP Clarification Code for overriding RTS and DUR REJECTS
; (o) PA - NCPDP Prior Authorization Type and Number (separated by "^")
; (o) IGNR - Ignore Flag; 1=IGNORE, 0=NOT IGNORE
;
I '$G(RX)!'$G(REJ) Q
I '$D(RFL) S RFL=$$LSTRFL^PSOBPSU1(RX)
I '$D(^PSRX(RX,"REJ",REJ)) Q
I $$GET1^DIQ(52.25,REJ_","_RX,5)'=+$G(RFL) Q
S:'$G(REA) REA=99 S COM=$TR($G(COM),";^",",,")
N DQ,DA,DIE,DR,X,Y,REJCOM,I,SMACOM,SMA
D NOW^%DTC
S REJCOM="AUTOMATICALLY CLOSED" I REA'=1 S REJCOM=COM
S DA(1)=RX,DA=REJ,DIE="^PSRX("_RX_",""REJ"","
S DR="9///1;10///"_%_";11////"_$G(USR)_";12///"_REA_";13///"_REJCOM_";14///"_$P($G(COD1),"^")_";15///"_$P($G(COD1),"^",2)
S DR=DR_";19///"_$P($G(COD1),"^",3)_";24///"_$G(CLA)_";25///"_$P($G(PA),"^")_";26///"_$P($G(PA),"^",2)
D ^DIE
;
; Add comment to the ECME User Screen
; First check if this is has more than one override value from the SMA action of the reject worklist
; If it is, we will need to enter multiple comments
S SMA=0
I $G(COD1)]"",$G(CLA)]"" S SMA=1
I $G(COD1)]"",$G(PA)]"" S SMA=1
I $G(CLA)]"",$G(PA)]"" S SMA=1
I SMA D Q
. I $G(COD1)]"" D
.. S SMACOM=$TR("DUR Override Codes "_$G(COD1)_"~"_$G(COD2)_"~"_$G(COD3)_" submitted.","^","/")
.. S X=$$ADDCOMM^BPSBUTL(RX,RFL,SMACOM)
. I $G(CLA)]"" D
.. S SMACOM="Clarification Code(s) "_CLA_" submitted."
.. S X=$$ADDCOMM^BPSBUTL(RX,RFL,SMACOM)
. I $G(PA)]"" D
.. S SMACOM="Prior Authorization Code ("_$P(PA,"^")_"/"_$P(PA,"^",2)_") submitted."
.. S X=$$ADDCOMM^BPSBUTL(RX,RFL,SMACOM)
. S SMACOM="Multiple actions taken to resolve. See comments for details."
. S X=$$ADDCOMM^BPSBUTL(RX,RFL,SMACOM)
;
; If not SMA, fall through to here and enter one comment
; If IGNR flag is set, add that to the comment string before sending
S X=$$ADDCOMM^BPSBUTL(RX,RFL,$S($G(IGNR):"IGNORED - ",1:"")_COM)
Q
;
FIND(RX,RFL,REJDATA,CODE,BESC,RRRFLG) ; - Returns whether a Rx/fill contains UNRESOLVED rejects
; Input: (r) RX - Rx IEN (#52)
; (o) RFL - Refill # (If not passed, look original and all refills)
; (o) CODE - Can be null, a specific Reject Code(s) to be checked or multiple codes separated by comma's
; (o) BESC - Bypass ECME Status Check (default behavior is to do the check); pass 1 to skip the check below
; We need to skip this check when looking for non-ECME billable rejects (eT or eC for example)
; (o) RRRFLG - Pass a 1 in this parameter to also look for any unresolved Reject Resolution Required (RRR)
; rejects when CODE is also passed. If CODE is not passed in, then pass a 1 here to ONLY look for
; unresolved RRR rejects.
; The default here is 0 if not passed.
;
; Output: 1 - Rx contains unresolved Rejects
; 0 - Rx does not contain unresolved Rejects
; .REJDATA - Array containing the Reject(s) data (see GET^PSOREJU2 for fields documentation)
;
N RCODE,I,REJS
S REJS=0,RCODE=""
K REJDATA
I '$G(BESC),$G(RFL),$$STATUS^PSOBPSUT(RX,RFL)="" Q 0
I $G(CODE)]"",CODE["," S REJS=$$MULTI^PSOREJU4(RX,$G(RFL),.REJDATA,$G(CODE),REJS,+$G(RRRFLG)) G FEND
S REJS=$$SINGLE^PSOREJU4(RX,$G(RFL),.REJDATA,$G(CODE),REJS,+$G(RRRFLG))
FEND ;
Q $S(REJS:1,1:0)
;
SYNC(RX,RFL,USR,RXCOB) ;
; Input: (r) RX - Rx IEN (#52)
; (o) RFL - Refill # (Default: most recent)
; (o) USR - User using the system when this routine is called
; (o) RXCOB - Coordination of Benefits code
I '$G(RXCOB) S RXCOB=1
N REJ,REJS,REJLST,I,IDX,CODE,DATA,TXT,PSOTRIC,ERR,PSODIV,OPECC,OVREJ,ESH
N REJRRR,RRRVAL ; PSO*7*421
L +^PSRX("REJ",RX):0 Q:'$T
I '$D(RFL) S RFL=$$LSTRFL^PSOBPSU1(RX)
S PSODIV=$$RXSITE^PSOBPSUT(RX,RFL)
D DUR1^BPSNCPD3(RX,RFL,.REJ,"",RXCOB)
S PSOTRIC="" S:$G(REJ(1,"ELIGBLT"))="T" PSOTRIC=1 S:$G(REJ(1,"ELIGBLT"))="C" PSOTRIC=2 S:PSOTRIC="" PSOTRIC=$$TRIC^PSOREJP1(RX,RFL,.PSOTRIC)
K REJS S (OPECC,IDX,ERR)=""
F S IDX=$O(REJ(IDX)) Q:IDX="" S TXT=$G(REJ(IDX,"REJ CODE LST")) D
. F I=1:1:$L(TXT,",") S CODE=$P(TXT,",",I),OVREJ="" D
. . I CODE="" Q
. . I ",M6,M8,99,NN,"[(","_CODE_",") S ESH="",ESH=$$DUR^PSOBPSU2(RX,RFL) Q:'ESH&('PSOTRIC)
. . ;Additional check for Reject Resolution Required included - PSO*7*421
. . I CODE'="79"&(CODE'="88")&(CODE'="943")&('$G(PSOTRIC)) S ERR=$$EVAL^PSOREJU4(PSODIV,CODE,OPECC,RX,RFL,RXCOB,.RRRVAL) Q:'+ERR
. . I +$G(ERR) S OVREJ=1 S:+$G(RRRVAL) REJRRR(IDX)=RRRVAL
. . I $$DUP^PSOREJU1(RX,+$$CLEAN^PSOREJU1($G(REJ(IDX,"RESPONSE IEN")))) Q
. . S REJS(IDX,CODE)=OVREJ
I '$D(REJS) L -^PSRX("REJ",RX) Q
SYNC2 ;
S (IDX,CODE)="" F S IDX=$O(REJS(IDX)) Q:IDX="" D
. F S CODE=$O(REJS(IDX,CODE)) Q:CODE="" K DATA D
. . ;Additional check for Reject Resolution Required - PSO*7*421
. . I 'OPECC&(CODE'=79)&(CODE'=88)&(CODE'=943) D
. . .I '+$G(REJRRR(IDX)) S DATA("OVERRIDE MSG")="Automatically transferred due to override for reject code." Q
. . .;Reject Resolution Required fields
. . .S DATA("RRR FLAG")=1
. . .S DATA("RRR GROSS AMT DUE")=$P(REJRRR(IDX),U,2)
. . .S DATA("RRR THRESHOLD AMT")=$P(REJRRR(IDX),U,3)
. . .S DATA("OVERRIDE MSG")="Automatically transferred due to Reject Resolution Required reject code"
. . I OPECC&(CODE'=79)&(CODE'=88)&(CODE'=943) S DATA("OVERRIDE MSG")="Transferred by "_$S(CODE["eT":"",CODE["eC":"",1:"OPECC.")
. . I $D(COMMTXT) S:COMMTXT'="" DATA("OVERRIDE MSG")=DATA("OVERRIDE MSG")_" "_$$CLEAN^PSOREJU1($P(COMMTXT,":",2))
. . S DATA("DUR TEXT")=$$CLEAN^PSOREJU1($G(REJ(IDX,"DUR FREE TEXT DESC")))
. . S DATA("DUR ADD MSG TEXT")=$$CLEAN^PSOREJU1($G(REJ(IDX,"DUR ADD MSG TEXT")))
. . ; In NCPDP D0, the Payer Additional Message is a repeating field and we want to display as much of the
. . ; data on the reject information screen as possible so we put the messages together up to the field
. . ; length of 140
. . N CNT,MSG
. . S CNT="",DATA("PAYER MESSAGE")=""
. . F S CNT=$O(REJ(IDX,"PAYER MESSAGE",CNT)) Q:CNT=""!($L(DATA("PAYER MESSAGE"))>140) D
. . . S MSG=$$CLEAN^PSOREJU1(REJ(IDX,"PAYER MESSAGE",CNT))
. . . I MSG]"" S DATA("PAYER MESSAGE")=DATA("PAYER MESSAGE")_MSG_" "
. . ; Call CLEAN again to strip the extra trailing spaces we might have added
. . S DATA("PAYER MESSAGE")=$$CLEAN^PSOREJU1(DATA("PAYER MESSAGE"))
. . S DATA("CODE")=CODE,DATA("REASON")=$$CLEAN^PSOREJU1($G(REJ(IDX,"REASON")))
. . S DATA("PHARMACIST")=$G(USR),DATA("INSURANCE NAME")=$$CLEAN^PSOREJU1($G(REJ(IDX,"INSURANCE NAME")))
. . S DATA("INSURANCE POINTER")=$$CLEAN^PSOREJU1($G(REJ(IDX,"INSURANCE POINTER")))
. . S DATA("GROUP NAME")=$$CLEAN^PSOREJU1($G(REJ(IDX,"GROUP NAME"))),DATA("GROUP NUMBER")=$$CLEAN^PSOREJU1($G(REJ(IDX,"GROUP NUMBER")))
. . S DATA("CARDHOLDER ID")=$$CLEAN^PSOREJU1($G(REJ(IDX,"CARDHOLDER ID"))),DATA("PLAN CONTACT")=$$CLEAN^PSOREJU1($G(REJ(IDX,"PLAN CONTACT")))
. . S DATA("PREVIOUS FILL")=$$CLEAN^PSOREJU1($$DAT^PSOREJU1($G(REJ(IDX,"PREVIOUS FILL DATE"))))
. . S DATA("OTHER REJECTS")=$$CLEAN^PSOREJU1($$OTH^PSOREJU1(CODE,$G(REJ(IDX,"REJ CODE LST"))))
. . S DATA("RESPONSE IEN")=+$$CLEAN^PSOREJU1($G(REJ(IDX,"RESPONSE IEN")))
. . S DATA("REASON SVC CODE")=$$REASON^PSOREJU2($G(REJ(IDX,"REASON"))),DATA("COB")=IDX
. . S DATA("MESSAGE")=$$CLEAN^PSOREJU1($G(REJ(IDX,"MESSAGE")))
. . S DATA("DUR RESPONSE DATA")=$$CLEAN^PSOREJU1($G(REJ(IDX,"DUR RESPONSE DATA")))
. . S DATA("BIN")=$$CLEAN^PSOREJU1($G(REJ(IDX,"BIN")))
. . S DATA("PCN")=$$CLEAN^PSOREJU1($G(REJ(IDX,"PCN")))
. . D SAVE(RX,RFL,.DATA)
L -^PSRX("REJ",RX)
Q
;
AUTORES(RX,RFL,REJ,RSC) ; Auto-resolve reject check
; Input: (r) RX - Rx IEN (#52)
; (r) RFL - Refill #
; (r) REJ - Reject Code
; (r) RSC - Reason for Service Code
;
; Identify rejects to automatically resolve:
; * Rx must be released
; * Refills or renewals only, do not consider original fills
; * Back-billed or resubmission prescriptions only
; * If reject 79, auto-resolve without checking Reason for Service Code
; * If reject 88 or 943, limit to Reason for Service Codes of 'ID' or 'ER'
;
N BPS59,RENEW
I '$$RXRLDT^PSOBPSUT(RX,RFL) Q 0
I RFL=0 D I RENEW=0 Q 0
. S RENEW=0
. I $$GET1^DIQ(52,RX,.01)?1.N1.A S RENEW=1
. I $$GET1^DIQ(52,RX,39.4)'="" S RENEW=1
S BPS59=$$IEN59^BPSOSRX(RX,RFL)
I ("^BB^ED^ERES^ERWV^ERNB^P2S^RSNB^")'[("^"_$$GET1^DIQ(9002313.59,BPS59,1201)_"^") Q 0
I REJ=79 Q 1
I (REJ'=88)&(REJ'=943) Q 0
I (RSC'="ID")&(RSC'="ER") Q 0
Q 1
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPSOREJUT 16933 printed Apr 09, 2024@21:35:48 Page 2
PSOREJUT ;BIRM/MFR - BPS (ECME) - Clinical Rejects Utilities ;06/07/05
+1 ;;7.0;OUTPATIENT PHARMACY;**148,247,260,287,289,290,358,359,385,403,421,427,448,478,528,544,562,702**;DEC 1997;Build 14
+2 ; Reference to $$IEN59^BPSOSRX in ICR #4412
+3 ; Reference to DUR1^BPSNCPD3 in ICR #4560
+4 ; Reference to $$ADDCOMM^BPSBUTL in ICR #4719
+5 ;
SAVE(RX,RFL,REJ,REOPEN) ; - Saves DUR Information in the file 52
+1 ; Input: (r) RX - Rx IEN (#52)
+2 ; (o) RFL - Refill # (Default: most recent)
+3 ; (o) REOPEN - value of 1 means claim being reopened; null or no value passed means reopen claim functionality not being used
+4 ; (r) REJ - Array containing information about the REJECT on the following subscripts:
+5 ; "BIN" - BIN Number
+6 ; "PCN" - PCN Number
+7 ; "CODE" - Reject Code (79 or 88 or 943)
+8 ; "DATE/TIME" - Date/Time Reject Detected
+9 ; "PAYER MESSAGE" - Message returned by Payer (up to 140 chars long)
+10 ; "REASON" - Reject Reason (up to 100 chars long)
+11 ; "DUR TEXT" - Payer's DUR description
+12 ; "DUR ADD MSG TEXT" - Payer's DUR additional message text description
+13 ; "INSURANCE NAME" - Patient's Insurance Company Name
+14 ; "INSURANCE POINTER" - Patient's Insurance Company IEN
+15 ; "GROUP NAME" - Patient's Insurance Group Name
+16 ; "GROUP NUMBER" - Patient's Insurance Group Number
+17 ; "CARDHOLDER ID" - Patient's Insurance Cardholder ID
+18 ; "COB" - Coordination of Benefits
+19 ; "PLAN CONTACT" - Patient's Insurance Plan Contact (1-800)
+20 ; "PREVIOUS FILL" - Plan's Previous Fill Date
+21 ; "OTHER REJECTS" - Other Rejects with same Response
+22 ; "PHARMACIST" - Pharmacist DUZ
+23 ; "RESPONSE IEN" - Pointer to the RESPONSE file in ECME
+24 ; "REASON SVC CODE" - Reason for Service Code (pointer to BPS NCPDP REASON FOR SERVICE CODE)
+25 ; "RE-OPENED" - Re-Open Flag
+26 ; "RRR FLAG" - Reject Resolution Required indicator (expecting 1/0 into SAVE)
+27 ; "RRR THRESHOLD AMT" - Reject Resolution Required Dollar Threshold
+28 ; "RRR GROSS AMT DUE" - Reject Resolution Required Gross Amount Due
+29 ;Output: REJ("REJECT IEN")
+30 NEW %,DIC,DR,DA,X,DINUM,DD,DO,DLAYGO,ERR,PSOAUTO
+31 IF '$DATA(RFL)
SET RFL=$$LSTRFL^PSOBPSU1(RX)
+32 IF '$GET(PSODIV)
SET PSODIV=$$RXSITE^PSOBPSUT(RX,RFL)
+33 SET REJ("BIN")=$EXTRACT($GET(REJ("BIN")),1,6)
+34 SET REJ("PCN")=$GET(REJ("PCN"))
+35 SET REJ("CODE")=$GET(REJ("CODE"))
+36 ;
+37 ; convert REJ("RRR FLAG") into internal format (1/0) if necessary. When coming into SAVE from the Re-open Reject
+38 ; action, this flag is in the external format (YES/NO). esg - 3/29/16 - PSO*7*448
+39 IF $GET(REJ("RRR FLAG"))="YES"
SET REJ("RRR FLAG")=1
+40 IF $GET(REJ("RRR FLAG"))="NO"
SET REJ("RRR FLAG")=0
+41 ;
+42 ;Ignore this additional Check if reject is Reject Resolution Required reject - PSO*7*421
+43 IF '$GET(REJ("RRR FLAG"))
IF REJ("CODE")'=79&(REJ("CODE")'=88)&(REJ("CODE")'=943)&('$GET(PSOTRIC))&('$GET(REOPEN))
SET ERR=$$EVAL^PSOREJU4(PSODIV,REJ("CODE"),$GET(OPECC))
if '+ERR
QUIT
+44 SET REJ("PAYER MESSAGE")=$EXTRACT($GET(REJ("PAYER MESSAGE")),1,140)
SET REJ("REASON")=$EXTRACT($GET(REJ("REASON")),1,100)
+45 SET REJ("DUR TEXT")=$EXTRACT($GET(REJ("DUR TEXT")),1,100)
SET REJ("DUR ADD MSG TEXT")=$EXTRACT($GET(REJ("DUR ADD MSG TEXT")),1,100)
SET REJ("GROUP NAME")=$EXTRACT($GET(REJ("GROUP NAME")),1,30)
+46 SET REJ("INSURANCE NAME")=$EXTRACT($GET(REJ("INSURANCE NAME")),1,30)
SET REJ("PLAN CONTACT")=$EXTRACT($GET(REJ("PLAN CONTACT")),1,30)
+47 SET REJ("GROUP NUMBER")=$EXTRACT($GET(REJ("GROUP NUMBER")),1,30)
SET REJ("OTHER REJECTS")=$EXTRACT($GET(REJ("OTHER REJECTS")),1,15)
+48 SET REJ("CARDHOLDER ID")=$EXTRACT($GET(REJ("CARDHOLDER ID")),1,20)
SET REJ("COB")=$GET(REJ("COB"))
+49 DO NOW^%DTC
+50 IF $GET(REJ("DATE/TIME"))=""
SET REJ("DATE/TIME")=%
+51 SET DIC="^PSRX("_RX_",""REJ"","
SET DA(1)=RX
SET DIC(0)=""
+52 SET X=$GET(REJ("CODE"))
SET DINUM=$ORDER(^PSRX(RX,"REJ",9999),-1)+1
+53 SET PSOAUTO=$$AUTORES(RX,RFL,REJ("CODE"),$GET(REJ("REASON SVC CODE")))
+54 SET DIC("DR")="1///"_$GET(REJ("DATE/TIME"))_";2///"_REJ("PAYER MESSAGE")_";3///"_REJ("REASON")_";4////"_$GET(REJ("PHARMACIST"))_";5///"_RFL
+55 SET DIC("DR")=DIC("DR")_";6///"_REJ("GROUP NAME")_";7///"_REJ("PLAN CONTACT")_";8///"_$GET(REJ("PREVIOUS FILL"))
+56 IF PSOAUTO=1
Begin DoDot:1
+57 SET DIC("DR")=DIC("DR")_";9///1"
+58 SET DIC("DR")=DIC("DR")_";10///"_%
+59 SET DIC("DR")=DIC("DR")_";11///.5"
+60 SET DIC("DR")=DIC("DR")_";12///9"
End DoDot:1
+61 IF '$TEST
SET DIC("DR")=DIC("DR")_";9///0"
+62 SET DIC("DR")=DIC("DR")_";14///"_$GET(REJ("REASON SVC CODE"))_";16///"_$GET(REJ("RESPONSE IEN"))
+63 SET DIC("DR")=DIC("DR")_";17///"_$GET(REJ("OTHER REJECTS"))_";18///"_REJ("DUR TEXT")_";20///"_REJ("INSURANCE NAME")
+64 SET DIC("DR")=DIC("DR")_";21///"_REJ("GROUP NUMBER")_";22///"_REJ("CARDHOLDER ID")_";23///"_$GET(REJ("RE-OPENED"))
+65 SET DIC("DR")=DIC("DR")_";27///"_REJ("COB")
+66 SET DIC("DR")=DIC("DR")_";28///"_REJ("DUR ADD MSG TEXT")
+67 SET DIC("DR")=DIC("DR")_";29///"_REJ("BIN")
+68 SET DIC("DR")=DIC("DR")_";34///"_REJ("PCN")
+69 ;Update Reject Resolution Required fields - PSO*7*421
+70 IF $GET(REJ("RRR FLAG"))
Begin DoDot:1
+71 SET DIC("DR")=DIC("DR")_";30///"_REJ("RRR FLAG")
+72 SET DIC("DR")=DIC("DR")_";31///"_REJ("RRR THRESHOLD AMT")
+73 SET DIC("DR")=DIC("DR")_";32///"_REJ("RRR GROSS AMT DUE")
End DoDot:1
+74 SET DIC("DR")=DIC("DR")_";33///"_REJ("INSURANCE POINTER")
+75 FOR
LOCK +^PSRX(RX):5
if $TEST
QUIT
HANG 15
+76 KILL DD,DO
DO FILE^DICN
KILL DD,DO
SET REJ("REJECT IEN")=+Y
+77 SET REJ("OVERRIDE MSG")=$GET(DATA("OVERRIDE MSG"))
+78 ;Comments use POSTMASTER as user for auto transfers - PSO*7*421
+79 IF REJ("OVERRIDE MSG")'=""
Begin DoDot:1
+80 NEW ORIGIN
SET ORIGIN=$GET(DUZ)
+81 if REJ("OVERRIDE MSG")["Automatically transferred"
SET ORIGIN=.5
+82 DO SAVECOM^PSOREJP3(RX,REJ("REJECT IEN"),REJ("OVERRIDE MSG"),$GET(REJ("DATE/TIME")),ORIGIN)
+83 ;Insert comment for Transfer and RRR Rejects - PSO*7*421
+84 IF REJ("OVERRIDE MSG")["Automatically transferred"
Begin DoDot:2
+85 NEW X,TXT
+86 SET TXT="Auto Send to Pharmacy Worklist due to Transfer Reject Code"
+87 IF $GET(REJ("RRR FLAG"))
SET TXT="Auto Send to Pharmacy Worklist due to RRR Code"
+88 IF $GET(PSOTRIC)
SET TXT="Auto Send to Pharmacy Worklist & OPECC - CVA/TRI"
+89 ; IA 4719
SET X=$$ADDCOMM^BPSBUTL(RX,RFL,TXT,1)
End DoDot:2
End DoDot:1
+90 ;
+91 IF PSOAUTO=1
Begin DoDot:1
+92 NEW X,TXT
+93 SET TXT="Not transferred to Pharmacy-Unable to Resolve Backbill/Resubmit"
+94 SET X=$$ADDCOMM^BPSBUTL(RX,RFL,TXT,1)
End DoDot:1
+95 ;
+96 LOCK -^PSRX(RX)
+97 QUIT
+98 ;
CLSALL(RX,RFL,USR,REA,COM,COD1,COD2,COD3,CLA,PA) ; Close/Resolve All Rejects
+1 ;Input: (r) RX - Rx IEN (#52)
+2 ; (o) RFL - Refill # (Default: most recent)
+3 ; (o) USR - User DUZ responsible for closing all rejects
+4 ; (r) REA - Close REASON code
+5 ; (o) COM - Close COMMENTS
+6 ; (o) COD1 - First set of DUR overrides (Reason Code^Professional Code^Result Code)
+7 ; (o) COD2 - Second set of DUR overrides (Reason Code^Professional Code^Result Code)
+8 ; (o) COD3 - Third set of DUR overrides (Reason Code^Professional Code^Result Code)
+9 ; (o) CLA - NCPDP Clarification Code for overriding RTS and DUR REJECTS
+10 ; (o) PA - NCPDP Prior Authorization Type and Number (separated by "^")
+11 NEW REJ,REJDATA,DIE,DR,DA
+12 IF '$DATA(RFL)
SET RFL=$$LSTRFL^PSOBPSU1(RX)
+13 ;
+14 ; - Closing OPEN/UNRESOLVED rejects
+15 IF $$FIND(RX,RFL,.REJDATA,,1)
Begin DoDot:1
+16 SET REJ=""
FOR
SET REJ=$ORDER(REJDATA(REJ))
if 'REJ
QUIT
Begin DoDot:2
+17 DO CLOSE(RX,RFL,REJ,USR,REA,$GET(COM),$GET(COD1),$GET(COD2),$GET(COD3),$GET(CLA),$GET(PA))
End DoDot:2
End DoDot:1
+18 QUIT
+19 ;
CLOSE(RX,RFL,REJ,USR,REA,COM,COD1,COD2,COD3,CLA,PA,IGNR) ; - Mark a DUR/REFILL TOO SOON reject RESOLVED
+1 ; Input: (r) RX - Rx IEN (#52)
+2 ; (o) RFL - Refill # (Default: most recent)
+3 ; (r) REJ - REJECT ID (IEN)
+4 ; (o) USR - User (file #200 IEN) responsible for closing the REJECT
+5 ; (r) REA - Reason for closing the REJECT (52.25,12):
+6 ; 1:CLAIM RE-SUBMITTED
+7 ; 2:RX ON HOLD
+8 ; 3:RX SUSPENDED
+9 ; 4:RX RETURNED TO STOCK
+10 ; 5:RX DELETED
+11 ; 6:IGNORED - NO RESUBMISSION
+12 ; 7:RX DISCONTINUED
+13 ; 8:RX EDITED
+14 ; 99:OTHER
+15 ; (o) COM - Close comments manually entered by the user
+16 ; (o) COD1 - First set of DUR overrides (Reason Code^Professional Code^Result Code)
+17 ; (o) COD2 - Second set of DUR overrides (Reason Code^Professional Code^Result Code)
+18 ; (o) COD3 - Third set of DUR overrides (Reason Code^Professional Code^Result Code)
+19 ; (o) CLA - NCPDP Clarification Code for overriding RTS and DUR REJECTS
+20 ; (o) PA - NCPDP Prior Authorization Type and Number (separated by "^")
+21 ; (o) IGNR - Ignore Flag; 1=IGNORE, 0=NOT IGNORE
+22 ;
+23 IF '$GET(RX)!'$GET(REJ)
QUIT
+24 IF '$DATA(RFL)
SET RFL=$$LSTRFL^PSOBPSU1(RX)
+25 IF '$DATA(^PSRX(RX,"REJ",REJ))
QUIT
+26 IF $$GET1^DIQ(52.25,REJ_","_RX,5)'=+$GET(RFL)
QUIT
+27 if '$GET(REA)
SET REA=99
SET COM=$TRANSLATE($GET(COM),";^",",,")
+28 NEW DQ,DA,DIE,DR,X,Y,REJCOM,I,SMACOM,SMA
+29 DO NOW^%DTC
+30 SET REJCOM="AUTOMATICALLY CLOSED"
IF REA'=1
SET REJCOM=COM
+31 SET DA(1)=RX
SET DA=REJ
SET DIE="^PSRX("_RX_",""REJ"","
+32 SET DR="9///1;10///"_%_";11////"_$GET(USR)_";12///"_REA_";13///"_REJCOM_";14///"_$PIECE($GET(COD1),"^")_";15///"_$PIECE($GET(COD1),"^",2)
+33 SET DR=DR_";19///"_$PIECE($GET(COD1),"^",3)_";24///"_$GET(CLA)_";25///"_$PIECE($GET(PA),"^")_";26///"_$PIECE($GET(PA),"^",2)
+34 DO ^DIE
+35 ;
+36 ; Add comment to the ECME User Screen
+37 ; First check if this is has more than one override value from the SMA action of the reject worklist
+38 ; If it is, we will need to enter multiple comments
+39 SET SMA=0
+40 IF $GET(COD1)]""
IF $GET(CLA)]""
SET SMA=1
+41 IF $GET(COD1)]""
IF $GET(PA)]""
SET SMA=1
+42 IF $GET(CLA)]""
IF $GET(PA)]""
SET SMA=1
+43 IF SMA
Begin DoDot:1
+44 IF $GET(COD1)]""
Begin DoDot:2
+45 SET SMACOM=$TRANSLATE("DUR Override Codes "_$GET(COD1)_"~"_$GET(COD2)_"~"_$GET(COD3)_" submitted.","^","/")
+46 SET X=$$ADDCOMM^BPSBUTL(RX,RFL,SMACOM)
End DoDot:2
+47 IF $GET(CLA)]""
Begin DoDot:2
+48 SET SMACOM="Clarification Code(s) "_CLA_" submitted."
+49 SET X=$$ADDCOMM^BPSBUTL(RX,RFL,SMACOM)
End DoDot:2
+50 IF $GET(PA)]""
Begin DoDot:2
+51 SET SMACOM="Prior Authorization Code ("_$PIECE(PA,"^")_"/"_$PIECE(PA,"^",2)_") submitted."
+52 SET X=$$ADDCOMM^BPSBUTL(RX,RFL,SMACOM)
End DoDot:2
+53 SET SMACOM="Multiple actions taken to resolve. See comments for details."
+54 SET X=$$ADDCOMM^BPSBUTL(RX,RFL,SMACOM)
End DoDot:1
QUIT
+55 ;
+56 ; If not SMA, fall through to here and enter one comment
+57 ; If IGNR flag is set, add that to the comment string before sending
+58 SET X=$$ADDCOMM^BPSBUTL(RX,RFL,$SELECT($GET(IGNR):"IGNORED - ",1:"")_COM)
+59 QUIT
+60 ;
FIND(RX,RFL,REJDATA,CODE,BESC,RRRFLG) ; - Returns whether a Rx/fill contains UNRESOLVED rejects
+1 ; Input: (r) RX - Rx IEN (#52)
+2 ; (o) RFL - Refill # (If not passed, look original and all refills)
+3 ; (o) CODE - Can be null, a specific Reject Code(s) to be checked or multiple codes separated by comma's
+4 ; (o) BESC - Bypass ECME Status Check (default behavior is to do the check); pass 1 to skip the check below
+5 ; We need to skip this check when looking for non-ECME billable rejects (eT or eC for example)
+6 ; (o) RRRFLG - Pass a 1 in this parameter to also look for any unresolved Reject Resolution Required (RRR)
+7 ; rejects when CODE is also passed. If CODE is not passed in, then pass a 1 here to ONLY look for
+8 ; unresolved RRR rejects.
+9 ; The default here is 0 if not passed.
+10 ;
+11 ; Output: 1 - Rx contains unresolved Rejects
+12 ; 0 - Rx does not contain unresolved Rejects
+13 ; .REJDATA - Array containing the Reject(s) data (see GET^PSOREJU2 for fields documentation)
+14 ;
+15 NEW RCODE,I,REJS
+16 SET REJS=0
SET RCODE=""
+17 KILL REJDATA
+18 IF '$GET(BESC)
IF $GET(RFL)
IF $$STATUS^PSOBPSUT(RX,RFL)=""
QUIT 0
+19 IF $GET(CODE)]""
IF CODE[","
SET REJS=$$MULTI^PSOREJU4(RX,$GET(RFL),.REJDATA,$GET(CODE),REJS,+$GET(RRRFLG))
GOTO FEND
+20 SET REJS=$$SINGLE^PSOREJU4(RX,$GET(RFL),.REJDATA,$GET(CODE),REJS,+$GET(RRRFLG))
FEND ;
+1 QUIT $SELECT(REJS:1,1:0)
+2 ;
SYNC(RX,RFL,USR,RXCOB) ;
+1 ; Input: (r) RX - Rx IEN (#52)
+2 ; (o) RFL - Refill # (Default: most recent)
+3 ; (o) USR - User using the system when this routine is called
+4 ; (o) RXCOB - Coordination of Benefits code
+5 IF '$GET(RXCOB)
SET RXCOB=1
+6 NEW REJ,REJS,REJLST,I,IDX,CODE,DATA,TXT,PSOTRIC,ERR,PSODIV,OPECC,OVREJ,ESH
+7 ; PSO*7*421
NEW REJRRR,RRRVAL
+8 LOCK +^PSRX("REJ",RX):0
if '$TEST
QUIT
+9 IF '$DATA(RFL)
SET RFL=$$LSTRFL^PSOBPSU1(RX)
+10 SET PSODIV=$$RXSITE^PSOBPSUT(RX,RFL)
+11 DO DUR1^BPSNCPD3(RX,RFL,.REJ,"",RXCOB)
+12 SET PSOTRIC=""
if $GET(REJ(1,"ELIGBLT"))="T"
SET PSOTRIC=1
if $GET(REJ(1,"ELIGBLT"))="C"
SET PSOTRIC=2
if PSOTRIC=""
SET PSOTRIC=$$TRIC^PSOREJP1(RX,RFL,.PSOTRIC)
+13 KILL REJS
SET (OPECC,IDX,ERR)=""
+14 FOR
SET IDX=$ORDER(REJ(IDX))
if IDX=""
QUIT
SET TXT=$GET(REJ(IDX,"REJ CODE LST"))
Begin DoDot:1
+15 FOR I=1:1:$LENGTH(TXT,",")
SET CODE=$PIECE(TXT,",",I)
SET OVREJ=""
Begin DoDot:2
+16 IF CODE=""
QUIT
+17 IF ",M6,M8,99,NN,"[(","_CODE_",")
SET ESH=""
SET ESH=$$DUR^PSOBPSU2(RX,RFL)
if 'ESH&('PSOTRIC)
QUIT
+18 ;Additional check for Reject Resolution Required included - PSO*7*421
+19 IF CODE'="79"&(CODE'="88")&(CODE'="943")&('$GET(PSOTRIC))
SET ERR=$$EVAL^PSOREJU4(PSODIV,CODE,OPECC,RX,RFL,RXCOB,.RRRVAL)
if '+ERR
QUIT
+20 IF +$GET(ERR)
SET OVREJ=1
if +$GET(RRRVAL)
SET REJRRR(IDX)=RRRVAL
+21 IF $$DUP^PSOREJU1(RX,+$$CLEAN^PSOREJU1($GET(REJ(IDX,"RESPONSE IEN"))))
QUIT
+22 SET REJS(IDX,CODE)=OVREJ
End DoDot:2
End DoDot:1
+23 IF '$DATA(REJS)
LOCK -^PSRX("REJ",RX)
QUIT
SYNC2 ;
+1 SET (IDX,CODE)=""
FOR
SET IDX=$ORDER(REJS(IDX))
if IDX=""
QUIT
Begin DoDot:1
+2 FOR
SET CODE=$ORDER(REJS(IDX,CODE))
if CODE=""
QUIT
KILL DATA
Begin DoDot:2
+3 ;Additional check for Reject Resolution Required - PSO*7*421
+4 IF 'OPECC&(CODE'=79)&(CODE'=88)&(CODE'=943)
Begin DoDot:3
+5 IF '+$GET(REJRRR(IDX))
SET DATA("OVERRIDE MSG")="Automatically transferred due to override for reject code."
QUIT
+6 ;Reject Resolution Required fields
+7 SET DATA("RRR FLAG")=1
+8 SET DATA("RRR GROSS AMT DUE")=$PIECE(REJRRR(IDX),U,2)
+9 SET DATA("RRR THRESHOLD AMT")=$PIECE(REJRRR(IDX),U,3)
+10 SET DATA("OVERRIDE MSG")="Automatically transferred due to Reject Resolution Required reject code"
End DoDot:3
+11 IF OPECC&(CODE'=79)&(CODE'=88)&(CODE'=943)
SET DATA("OVERRIDE MSG")="Transferred by "_$SELECT(CODE["eT":"",CODE["eC":"",1:"OPECC.")
+12 IF $DATA(COMMTXT)
if COMMTXT'=""
SET DATA("OVERRIDE MSG")=DATA("OVERRIDE MSG")_" "_$$CLEAN^PSOREJU1($PIECE(COMMTXT,":",2))
+13 SET DATA("DUR TEXT")=$$CLEAN^PSOREJU1($GET(REJ(IDX,"DUR FREE TEXT DESC")))
+14 SET DATA("DUR ADD MSG TEXT")=$$CLEAN^PSOREJU1($GET(REJ(IDX,"DUR ADD MSG TEXT")))
+15 ; In NCPDP D0, the Payer Additional Message is a repeating field and we want to display as much of the
+16 ; data on the reject information screen as possible so we put the messages together up to the field
+17 ; length of 140
+18 NEW CNT,MSG
+19 SET CNT=""
SET DATA("PAYER MESSAGE")=""
+20 FOR
SET CNT=$ORDER(REJ(IDX,"PAYER MESSAGE",CNT))
if CNT=""!($LENGTH(DATA("PAYER MESSAGE"))>140)
QUIT
Begin DoDot:3
+21 SET MSG=$$CLEAN^PSOREJU1(REJ(IDX,"PAYER MESSAGE",CNT))
+22 IF MSG]""
SET DATA("PAYER MESSAGE")=DATA("PAYER MESSAGE")_MSG_" "
End DoDot:3
+23 ; Call CLEAN again to strip the extra trailing spaces we might have added
+24 SET DATA("PAYER MESSAGE")=$$CLEAN^PSOREJU1(DATA("PAYER MESSAGE"))
+25 SET DATA("CODE")=CODE
SET DATA("REASON")=$$CLEAN^PSOREJU1($GET(REJ(IDX,"REASON")))
+26 SET DATA("PHARMACIST")=$GET(USR)
SET DATA("INSURANCE NAME")=$$CLEAN^PSOREJU1($GET(REJ(IDX,"INSURANCE NAME")))
+27 SET DATA("INSURANCE POINTER")=$$CLEAN^PSOREJU1($GET(REJ(IDX,"INSURANCE POINTER")))
+28 SET DATA("GROUP NAME")=$$CLEAN^PSOREJU1($GET(REJ(IDX,"GROUP NAME")))
SET DATA("GROUP NUMBER")=$$CLEAN^PSOREJU1($GET(REJ(IDX,"GROUP NUMBER")))
+29 SET DATA("CARDHOLDER ID")=$$CLEAN^PSOREJU1($GET(REJ(IDX,"CARDHOLDER ID")))
SET DATA("PLAN CONTACT")=$$CLEAN^PSOREJU1($GET(REJ(IDX,"PLAN CONTACT")))
+30 SET DATA("PREVIOUS FILL")=$$CLEAN^PSOREJU1($$DAT^PSOREJU1($GET(REJ(IDX,"PREVIOUS FILL DATE"))))
+31 SET DATA("OTHER REJECTS")=$$CLEAN^PSOREJU1($$OTH^PSOREJU1(CODE,$GET(REJ(IDX,"REJ CODE LST"))))
+32 SET DATA("RESPONSE IEN")=+$$CLEAN^PSOREJU1($GET(REJ(IDX,"RESPONSE IEN")))
+33 SET DATA("REASON SVC CODE")=$$REASON^PSOREJU2($GET(REJ(IDX,"REASON")))
SET DATA("COB")=IDX
+34 SET DATA("MESSAGE")=$$CLEAN^PSOREJU1($GET(REJ(IDX,"MESSAGE")))
+35 SET DATA("DUR RESPONSE DATA")=$$CLEAN^PSOREJU1($GET(REJ(IDX,"DUR RESPONSE DATA")))
+36 SET DATA("BIN")=$$CLEAN^PSOREJU1($GET(REJ(IDX,"BIN")))
+37 SET DATA("PCN")=$$CLEAN^PSOREJU1($GET(REJ(IDX,"PCN")))
+38 DO SAVE(RX,RFL,.DATA)
End DoDot:2
End DoDot:1
+39 LOCK -^PSRX("REJ",RX)
+40 QUIT
+41 ;
AUTORES(RX,RFL,REJ,RSC) ; Auto-resolve reject check
+1 ; Input: (r) RX - Rx IEN (#52)
+2 ; (r) RFL - Refill #
+3 ; (r) REJ - Reject Code
+4 ; (r) RSC - Reason for Service Code
+5 ;
+6 ; Identify rejects to automatically resolve:
+7 ; * Rx must be released
+8 ; * Refills or renewals only, do not consider original fills
+9 ; * Back-billed or resubmission prescriptions only
+10 ; * If reject 79, auto-resolve without checking Reason for Service Code
+11 ; * If reject 88 or 943, limit to Reason for Service Codes of 'ID' or 'ER'
+12 ;
+13 NEW BPS59,RENEW
+14 IF '$$RXRLDT^PSOBPSUT(RX,RFL)
QUIT 0
+15 IF RFL=0
Begin DoDot:1
+16 SET RENEW=0
+17 IF $$GET1^DIQ(52,RX,.01)?1.N1.A
SET RENEW=1
+18 IF $$GET1^DIQ(52,RX,39.4)'=""
SET RENEW=1
End DoDot:1
IF RENEW=0
QUIT 0
+19 SET BPS59=$$IEN59^BPSOSRX(RX,RFL)
+20 IF ("^BB^ED^ERES^ERWV^ERNB^P2S^RSNB^")'[("^"_$$GET1^DIQ(9002313.59,BPS59,1201)_"^")
QUIT 0
+21 IF REJ=79
QUIT 1
+22 IF (REJ'=88)&(REJ'=943)
QUIT 0
+23 IF (RSC'="ID")&(RSC'="ER")
QUIT 0
+24 QUIT 1
+25 ;
