PSOREJUT ;BIRM/MFR - BPS (ECME) - Clinical Rejects Utilities ;06/07/05
;;7.0;OUTPATIENT PHARMACY;**148,247,260,287,289**;DEC 1997;Build 107
;Reference to DUR1^BPSNCPD3 supported by IA 4560
;Reference to $$ADDCOMM^BPSBUTL supported by IA 4719
;
SAVE(RX,RFL,REJ,REOPEN) ; - Saves DUR Information in the PRESCRIPTION file
; 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:
; "CODE" - Reject Code (79 or 88)
; "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
; "INSURANCE NAME" - Patient's Insurance Company Name
; "GROUP NAME" - Patient's Insurance Group Name
; "GROUP NUMBER" - Patient's Insurance Group Number
; "CARDHOLDER ID" - Patient's Insurance Cardholder ID
; "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
;Output: REJ("REJECT IEN")
;
N %,DIC,DR,DA,X,DINUM,DD,DO,DLAYGO
;
I '$D(RFL) S RFL=$$LSTRFL^PSOBPSU1(RX)
I '$G(PSODIV) S PSODIV=$$RXSITE^PSOBPSUT(RX,RFL)
;
; - If Reject Code different than 79 or 88, Tricare or an override reject then Quit
S REJ("CODE")=$G(REJ("CODE"))
I REJ("CODE")'=79&(REJ("CODE")'=88)&('$G(PSOTRIC))&('$G(REOPEN)) S ERR="",ERR=$$EVAL^PSOREJU4(PSODIV,REJ("CODE"),$G(OPECC),.ERR) 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("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)
I $G(REJ("DATE/TIME"))="" D NOW^%DTC S REJ("DATE/TIME")=%
;
S DIC="^PSRX("_RX_",""REJ"",",DA(1)=RX,DIC(0)=""
;S X=DATA("CODE") ;X=+$G(REJ("CODE"))
S X=$G(REJ("CODE"))
S DINUM=$O(^PSRX(RX,"REJ",9999),-1)+1
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"))
S DIC("DR")=DIC("DR")_";9///0;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"))
;
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"))
I REJ("OVERRIDE MSG")'="" D SAVECOM^PSOREJP3(RX,REJ("REJECT IEN"),REJ("OVERRIDE MSG"),$G(REJ("DATE/TIME")),$G(DUZ))
K ERR
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)
; (r) REA - Close REASON code
; (o) COM - Close COMMENTS
; (o) USR - User DUZ responsible for closing all rejects
; (o) COD1 - NCPDP Reason for Service Code for overriding DUR REJECTS
; (o) COD2 - NCPDP Professional Service Code for overriding DUR REJECTS
; (o) COD3 - NCPDP Result of Service Code for overriding DUR REJECTS
; (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) 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) ; - 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:
; 1:CLAIM RE-SUBMITTED
; 2:RX ON HOLD
; 3:RX SUSPENDED
; 4:RX RETURNED TO STOCK
; 5:RX DELETED
; 6:OVERRIDEN W/OUT RE-SUBMISSION
; 7:DISCONTINUED
; 8:RX EDIT
; 99:OTHER
; (o) COM - Close comments manually entered by the user
; (o) COD1 - NCPDP Reason for Service Code for overriding DUR REJECTS
; (o) COD2 - NCPDP Professional Service Code for overriding DUR REJECTS
; (o) COD3 - NCPDP Result of Service Code for overriding DUR REJECTS
; (o) CLA - NCPDP Clarification Code for overriding RTS and DUR REJECTS
; (o) PA - NCPDP Prior Authorization Type and Number (separated by "^")
;
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
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///"_$G(COD1)_";15///"_$G(COD2)
S DR=DR_";19///"_$G(COD3)_";24///"_$G(CLA)_";25///"_$P($G(PA),"^")_";26///"_$P($G(PA),"^",2)
;
D ^DIE S X=$$ADDCOMM^BPSBUTL(RX,RFL,COM)
Q
;
FIND(RX,RFL,REJDATA,CODE) ; - Returns whether a prescription/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
;
; 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(RFL),$$STATUS^PSOBPSUT(RX,RFL)="" Q 0
I $G(CODE),CODE["," S REJS=$$MULTI^PSOREJU4(RX,$G(RFL),.REJDATA,$G(CODE),REJS) G FEND
S REJS=$$SINGLE^PSOREJU4(RX,$G(RFL),.REJDATA,$G(CODE),REJS)
FEND ;
Q $S(REJS:1,1:0)
;
;
SYNC(RX,RFL,USR) ;
; Input: (r) RX - Rx IEN (#52)
; (o) RFL - Refill # (Default: most recent)
; (o) USR - User using the system when this routine is called
;
N REJ,REJS,REJLST,I,IDX,CODE,DATA,TXT,PSOTRIC,ERR,PSODIV,OPECC,OVREJ
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)
S PSOTRIC="" S:$G(REJ(1,"ELIGBLT"))="T" PSOTRIC=1
S:PSOTRIC="" PSOTRIC=$$TRIC^PSOREJP1(RX,RFL,PSOTRIC)
K REJS S (OPECC,IDX,ERR)=""
F S IDX=$O(REJ(IDX)) Q:IDX="" D
. S TXT=$G(REJ(IDX,"REJ CODE LST"))
. F I=1:1:$L(TXT,",") D
. . S CODE=$P(TXT,",",I),OVREJ=""
. . I CODE'="79"&(CODE'="88")&('$G(PSOTRIC)) S ERR=$$EVAL^PSOREJU4(PSODIV,CODE,OPECC,.ERR) Q:'+ERR
. . S:+$G(ERR) OVREJ=1
. . 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="" D
. . K DATA
. . I 'OPECC&(CODE'[79)&(CODE'[88) S DATA("OVERRIDE MSG")="Automatically transferred due to override for reject code."
. . I OPECC&(CODE'[79)&(CODE'[88) S DATA("OVERRIDE MSG")="Transferred by 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("PAYER MESSAGE")=$$CLEAN^PSOREJU1($G(REJ(IDX,"PAYER MESSAGE")))
. . S DATA("CODE")=CODE
. . S DATA("REASON")=$$CLEAN^PSOREJU1($G(REJ(IDX,"REASON")))
. . S DATA("PHARMACIST")=$G(USR)
. . S DATA("INSURANCE NAME")=$$CLEAN^PSOREJU1($G(REJ(IDX,"INSURANCE NAME")))
. . S DATA("GROUP NAME")=$$CLEAN^PSOREJU1($G(REJ(IDX,"GROUP NAME")))
. . S DATA("GROUP NUMBER")=$$CLEAN^PSOREJU1($G(REJ(IDX,"GROUP NUMBER")))
. . S DATA("CARDHOLDER ID")=$$CLEAN^PSOREJU1($G(REJ(IDX,"CARDHOLDER ID")))
. . S 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")))
. . D SAVE(RX,RFL,.DATA)
L -^PSRX("REJ",RX)
Q
PSOREJUT ;BIRM/MFR - BPS (ECME) - Clinical Rejects Utilities ;06/07/05
+1 ;;7.0;OUTPATIENT PHARMACY;**148,247,260,287,289**;DEC 1997;Build 107
+2 ;Reference to DUR1^BPSNCPD3 supported by IA 4560
+3 ;Reference to $$ADDCOMM^BPSBUTL supported by IA 4719
+4 ;
SAVE(RX,RFL,REJ,REOPEN) ; - Saves DUR Information in the PRESCRIPTION file
+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
+5 ; subscripts:
+6 ; "CODE" - Reject Code (79 or 88)
+7 ; "DATE/TIME" - Date/Time Reject Detected
+8 ; "PAYER MESSAGE" - Message returned by Payer (up to 140 chars long)
+9 ; "REASON" - Reject Reason (up to 100 chars long)
+10 ; "DUR TEXT" - Payer's DUR description
+11 ; "INSURANCE NAME" - Patient's Insurance Company Name
+12 ; "GROUP NAME" - Patient's Insurance Group Name
+13 ; "GROUP NUMBER" - Patient's Insurance Group Number
+14 ; "CARDHOLDER ID" - Patient's Insurance Cardholder ID
+15 ; "PLAN CONTACT" - Patient's Insurance Plan Contact (1-800)
+16 ; "PREVIOUS FILL" - Plan's Previous Fill Date
+17 ; "OTHER REJECTS" - Other Rejects with same Response
+18 ; "PHARMACIST" - Pharmacist DUZ
+19 ; "RESPONSE IEN" - Pointer to the RESPONSE file in ECME
+20 ; "REASON SVC CODE" - Reason for Service Code (pointer to BPS NCPDP REASON FOR SERVICE CODE)
+21 ; "RE-OPENED" - Re-Open Flag
+22 ;Output: REJ("REJECT IEN")
+23 ;
+24 NEW %,DIC,DR,DA,X,DINUM,DD,DO,DLAYGO
+25 ;
+26 IF '$DATA(RFL)
SET RFL=$$LSTRFL^PSOBPSU1(RX)
+27 IF '$GET(PSODIV)
SET PSODIV=$$RXSITE^PSOBPSUT(RX,RFL)
+28 ;
+29 ; - If Reject Code different than 79 or 88, Tricare or an override reject then Quit
+30 SET REJ("CODE")=$GET(REJ("CODE"))
+31 IF REJ("CODE")'=79&(REJ("CODE")'=88)&('$GET(PSOTRIC))&('$GET(REOPEN))
SET ERR=""
SET ERR=$$EVAL^PSOREJU4(PSODIV,REJ("CODE"),$GET(OPECC),.ERR)
IF '+ERR
QUIT
+32 ;
+33 SET REJ("PAYER MESSAGE")=$EXTRACT($GET(REJ("PAYER MESSAGE")),1,140)
SET REJ("REASON")=$EXTRACT($GET(REJ("REASON")),1,100)
+34 SET REJ("DUR TEXT")=$EXTRACT($GET(REJ("DUR TEXT")),1,100)
SET REJ("GROUP NAME")=$EXTRACT($GET(REJ("GROUP NAME")),1,30)
+35 SET REJ("INSURANCE NAME")=$EXTRACT($GET(REJ("INSURANCE NAME")),1,30)
SET REJ("PLAN CONTACT")=$EXTRACT($GET(REJ("PLAN CONTACT")),1,30)
+36 SET REJ("GROUP NUMBER")=$EXTRACT($GET(REJ("GROUP NUMBER")),1,30)
SET REJ("OTHER REJECTS")=$EXTRACT($GET(REJ("OTHER REJECTS")),1,15)
+37 SET REJ("CARDHOLDER ID")=$EXTRACT($GET(REJ("CARDHOLDER ID")),1,20)
+38 IF $GET(REJ("DATE/TIME"))=""
DO NOW^%DTC
SET REJ("DATE/TIME")=%
+39 ;
+40 SET DIC="^PSRX("_RX_",""REJ"","
SET DA(1)=RX
SET DIC(0)=""
+41 ;S X=DATA("CODE") ;X=+$G(REJ("CODE"))
+42 SET X=$GET(REJ("CODE"))
+43 SET DINUM=$ORDER(^PSRX(RX,"REJ",9999),-1)+1
+44 SET DIC("DR")="1///"_$GET(REJ("DATE/TIME"))_";2///"_REJ("PAYER MESSAGE")_";3///"_REJ("REASON")_";4////"_$GET(REJ("PHARMACIST"))_";5///"_RFL
+45 SET DIC("DR")=DIC("DR")_";6///"_REJ("GROUP NAME")_";7///"_REJ("PLAN CONTACT")_";8///"_$GET(REJ("PREVIOUS FILL"))
+46 SET DIC("DR")=DIC("DR")_";9///0;14///"_$GET(REJ("REASON SVC CODE"))_";16///"_$GET(REJ("RESPONSE IEN"))
+47 SET DIC("DR")=DIC("DR")_";17///"_$GET(REJ("OTHER REJECTS"))_";18///"_REJ("DUR TEXT")_";20///"_REJ("INSURANCE NAME")
+48 SET DIC("DR")=DIC("DR")_";21///"_REJ("GROUP NUMBER")_";22///"_REJ("CARDHOLDER ID")_";23///"_$GET(REJ("RE-OPENED"))
+49 ;
+50 FOR
LOCK +^PSRX(RX):5
IF $TEST
QUIT
HANG 15
+51 KILL DD,DO
DO FILE^DICN
KILL DD,DO
SET REJ("REJECT IEN")=+Y
+52 SET REJ("OVERRIDE MSG")=$GET(DATA("OVERRIDE MSG"))
+53 IF REJ("OVERRIDE MSG")'=""
DO SAVECOM^PSOREJP3(RX,REJ("REJECT IEN"),REJ("OVERRIDE MSG"),$GET(REJ("DATE/TIME")),$GET(DUZ))
+54 KILL ERR
+55 LOCK -^PSRX(RX)
+56 QUIT
+57 ;
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 ; (r) REA - Close REASON code
+4 ; (o) COM - Close COMMENTS
+5 ; (o) USR - User DUZ responsible for closing all rejects
+6 ; (o) COD1 - NCPDP Reason for Service Code for overriding DUR REJECTS
+7 ; (o) COD2 - NCPDP Professional Service Code for overriding DUR REJECTS
+8 ; (o) COD3 - NCPDP Result of Service Code for overriding DUR REJECTS
+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)
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) ; - 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:
+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:OVERRIDEN W/OUT RE-SUBMISSION
+12 ; 7:DISCONTINUED
+13 ; 8:RX EDIT
+14 ; 99:OTHER
+15 ; (o) COM - Close comments manually entered by the user
+16 ; (o) COD1 - NCPDP Reason for Service Code for overriding DUR REJECTS
+17 ; (o) COD2 - NCPDP Professional Service Code for overriding DUR REJECTS
+18 ; (o) COD3 - NCPDP Result of Service Code for overriding DUR REJECTS
+19 ; (o) CLA - NCPDP Clarification Code for overriding RTS and DUR REJECTS
+20 ; (o) PA - NCPDP Prior Authorization Type and Number (separated by "^")
+21 ;
+22 IF '$GET(RX)!'$GET(REJ)
QUIT
+23 IF '$DATA(RFL)
SET RFL=$$LSTRFL^PSOBPSU1(RX)
+24 IF '$DATA(^PSRX(RX,"REJ",REJ))
QUIT
+25 IF $$GET1^DIQ(52.25,REJ_","_RX,5)'=+$GET(RFL)
QUIT
+26 IF '$GET(REA)
SET REA=99
SET COM=$TRANSLATE($GET(COM),";^",",,")
+27 ;
+28 NEW DQ,DA,DIE,DR,X,Y,REJCOM
+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///"_$GET(COD1)_";15///"_$GET(COD2)
+33 SET DR=DR_";19///"_$GET(COD3)_";24///"_$GET(CLA)_";25///"_$PIECE($GET(PA),"^")_";26///"_$PIECE($GET(PA),"^",2)
+34 ;
+35 DO ^DIE
SET X=$$ADDCOMM^BPSBUTL(RX,RFL,COM)
+36 QUIT
+37 ;
FIND(RX,RFL,REJDATA,CODE) ; - Returns whether a prescription/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 ;
+5 ; Output: 1 - Rx contains unresolved Rejects
+6 ; 0 - Rx does not contain unresolved Rejects
+7 ; .REJDATA - Array containing the Reject(s) data (see
+8 ; GET^PSOREJU2 for fields documentation)
+9 ;
+10 NEW RCODE,I,REJS
+11 SET REJS=0
SET RCODE=""
+12 KILL REJDATA
+13 IF $GET(RFL)
IF $$STATUS^PSOBPSUT(RX,RFL)=""
QUIT 0
+14 IF $GET(CODE)
IF CODE[","
SET REJS=$$MULTI^PSOREJU4(RX,$GET(RFL),.REJDATA,$GET(CODE),REJS)
GOTO FEND
+15 SET REJS=$$SINGLE^PSOREJU4(RX,$GET(RFL),.REJDATA,$GET(CODE),REJS)
FEND ;
+1 QUIT $SELECT(REJS:1,1:0)
+2 ;
+3 ;
SYNC(RX,RFL,USR) ;
+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 ;
+5 NEW REJ,REJS,REJLST,I,IDX,CODE,DATA,TXT,PSOTRIC,ERR,PSODIV,OPECC,OVREJ
+6 LOCK +^PSRX("REJ",RX):0
IF '$TEST
QUIT
+7 IF '$DATA(RFL)
SET RFL=$$LSTRFL^PSOBPSU1(RX)
+8 SET PSODIV=$$RXSITE^PSOBPSUT(RX,RFL)
+9 DO DUR1^BPSNCPD3(RX,RFL,.REJ)
+10 SET PSOTRIC=""
IF $GET(REJ(1,"ELIGBLT"))="T"
SET PSOTRIC=1
+11 IF PSOTRIC=""
SET PSOTRIC=$$TRIC^PSOREJP1(RX,RFL,PSOTRIC)
+12 KILL REJS
SET (OPECC,IDX,ERR)=""
+13 FOR
SET IDX=$ORDER(REJ(IDX))
IF IDX=""
QUIT
Begin DoDot:1
+14 SET TXT=$GET(REJ(IDX,"REJ CODE LST"))
+15 FOR I=1:1:$LENGTH(TXT,",")
Begin DoDot:2
+16 SET CODE=$PIECE(TXT,",",I)
SET OVREJ=""
+17 IF CODE'="79"&(CODE'="88")&('$GET(PSOTRIC))
SET ERR=$$EVAL^PSOREJU4(PSODIV,CODE,OPECC,.ERR)
IF '+ERR
QUIT
+18 IF +$GET(ERR)
SET OVREJ=1
+19 IF $$DUP^PSOREJU1(RX,+$$CLEAN^PSOREJU1($GET(REJ(IDX,"RESPONSE IEN"))))
QUIT
+20 SET REJS(IDX,CODE)=OVREJ
End DoDot:2
End DoDot:1
+21 IF '$DATA(REJS)
LOCK -^PSRX("REJ",RX)
QUIT
SYNC2 ;
+1 SET (IDX,CODE)=""
+2 FOR
SET IDX=$ORDER(REJS(IDX))
IF IDX=""
QUIT
Begin DoDot:1
+3 FOR
SET CODE=$ORDER(REJS(IDX,CODE))
IF CODE=""
QUIT
Begin DoDot:2
+4 KILL DATA
+5 IF 'OPECC&(CODE'[79)&(CODE'[88)
SET DATA("OVERRIDE MSG")="Automatically transferred due to override for reject code."
+6 IF OPECC&(CODE'[79)&(CODE'[88)
SET DATA("OVERRIDE MSG")="Transferred by OPECC."
+7 IF $DATA(COMMTXT)
IF COMMTXT'=""
SET DATA("OVERRIDE MSG")=DATA("OVERRIDE MSG")_" "_$$CLEAN^PSOREJU1($PIECE(COMMTXT,":",2))
+8 SET DATA("DUR TEXT")=$$CLEAN^PSOREJU1($GET(REJ(IDX,"DUR FREE TEXT DESC")))
+9 SET DATA("PAYER MESSAGE")=$$CLEAN^PSOREJU1($GET(REJ(IDX,"PAYER MESSAGE")))
+10 SET DATA("CODE")=CODE
+11 SET DATA("REASON")=$$CLEAN^PSOREJU1($GET(REJ(IDX,"REASON")))
+12 SET DATA("PHARMACIST")=$GET(USR)
+13 SET DATA("INSURANCE NAME")=$$CLEAN^PSOREJU1($GET(REJ(IDX,"INSURANCE NAME")))
+14 SET DATA("GROUP NAME")=$$CLEAN^PSOREJU1($GET(REJ(IDX,"GROUP NAME")))
+15 SET DATA("GROUP NUMBER")=$$CLEAN^PSOREJU1($GET(REJ(IDX,"GROUP NUMBER")))
+16 SET DATA("CARDHOLDER ID")=$$CLEAN^PSOREJU1($GET(REJ(IDX,"CARDHOLDER ID")))
+17 SET DATA("PLAN CONTACT")=$$CLEAN^PSOREJU1($GET(REJ(IDX,"PLAN CONTACT")))
+18 SET DATA("PREVIOUS FILL")=$$CLEAN^PSOREJU1($$DAT^PSOREJU1($GET(REJ(IDX,"PREVIOUS FILL DATE"))))
+19 SET DATA("OTHER REJECTS")=$$CLEAN^PSOREJU1($$OTH^PSOREJU1(CODE,$GET(REJ(IDX,"REJ CODE LST"))))
+20 SET DATA("RESPONSE IEN")=+$$CLEAN^PSOREJU1($GET(REJ(IDX,"RESPONSE IEN")))
+21 SET DATA("REASON SVC CODE")=$$REASON^PSOREJU2($GET(REJ(IDX,"REASON")))
+22 DO SAVE(RX,RFL,.DATA)
End DoDot:2
End DoDot:1
+23 LOCK -^PSRX("REJ",RX)
+24 QUIT
