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

PSOREJUT.m

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