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**;DEC 1997;Build 107
  1.  ;Reference to DUR1^BPSNCPD3 supported by IA 4560
  1.  ;Reference to $$ADDCOMM^BPSBUTL supported by IA 4719
  1.  ;
  1. SAVE(RX,RFL,REJ,REOPEN) ; - Saves DUR Information in the PRESCRIPTION file
  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
  1.  ;                   subscripts:
  1.  ;                   "CODE"   - Reject Code (79 or 88)
  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.  ;                   "INSURANCE NAME" - Patient's Insurance Company Name
  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.  ;                   "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.  ;Output: REJ("REJECT IEN") 
  1.  ;
  1.  N %,DIC,DR,DA,X,DINUM,DD,DO,DLAYGO
  1.  ;
  1.  I '$D(RFL) S RFL=$$LSTRFL^PSOBPSU1(RX)
  1.  I '$G(PSODIV) S PSODIV=$$RXSITE^PSOBPSUT(RX,RFL)
  1.  ;
  1.  ; - If Reject Code different than 79 or 88, Tricare or an override reject then Quit
  1.  S REJ("CODE")=$G(REJ("CODE"))
  1.  I REJ("CODE")'=79&(REJ("CODE")'=88)&('$G(PSOTRIC))&('$G(REOPEN)) S ERR="",ERR=$$EVAL^PSOREJU4(PSODIV,REJ("CODE"),$G(OPECC),.ERR) Q:'+ERR
  1.  ;
  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("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)
  1.  I $G(REJ("DATE/TIME"))="" D NOW^%DTC S REJ("DATE/TIME")=%
  1.  ;
  1.  S DIC="^PSRX("_RX_",""REJ"",",DA(1)=RX,DIC(0)=""
  1.  ;S X=DATA("CODE")  ;X=+$G(REJ("CODE"))
  1.  S X=$G(REJ("CODE"))
  1.  S DINUM=$O(^PSRX(RX,"REJ",9999),-1)+1
  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.  S DIC("DR")=DIC("DR")_";9///0;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.  ;
  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.  I REJ("OVERRIDE MSG")'="" D SAVECOM^PSOREJP3(RX,REJ("REJECT IEN"),REJ("OVERRIDE MSG"),$G(REJ("DATE/TIME")),$G(DUZ))
  1.  K ERR
  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.  ;       (r) REA  - Close REASON code
  1.  ;       (o) COM  - Close COMMENTS
  1.  ;       (o) USR  - User DUZ responsible for closing all rejects
  1.  ;       (o) COD1 - NCPDP Reason for Service Code for overriding DUR REJECTS
  1.  ;       (o) COD2 - NCPDP Professional Service Code for overriding DUR REJECTS
  1.  ;       (o) COD3 - NCPDP Result of Service Code for overriding DUR REJECTS
  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) 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) ; - 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:
  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:OVERRIDEN W/OUT RE-SUBMISSION
  1.  ;                       7:DISCONTINUED
  1.  ;                       8:RX EDIT
  1.  ;                      99:OTHER
  1.  ;         (o) COM  - Close comments manually entered by the user
  1.  ;         (o) COD1 - NCPDP Reason for Service Code for overriding DUR REJECTS
  1.  ;         (o) COD2 - NCPDP Professional Service Code for overriding DUR REJECTS
  1.  ;         (o) COD3 - NCPDP Result of Service Code for overriding DUR REJECTS
  1.  ;         (o) CLA  - NCPDP Clarification Code for overriding RTS and DUR REJECTS
  1.  ;         (o) PA   - NCPDP Prior Authorization Type and Number (separated by "^")
  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.  ;
  1.  N DQ,DA,DIE,DR,X,Y,REJCOM
  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///"_$G(COD1)_";15///"_$G(COD2)
  1.  S DR=DR_";19///"_$G(COD3)_";24///"_$G(CLA)_";25///"_$P($G(PA),"^")_";26///"_$P($G(PA),"^",2)
  1.  ;
  1.  D ^DIE S X=$$ADDCOMM^BPSBUTL(RX,RFL,COM)
  1.  Q
  1.  ;
  1. FIND(RX,RFL,REJDATA,CODE) ; - Returns whether a prescription/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.  ; 
  1.  ; Output: 1 - Rx contains unresolved Rejects 
  1.  ; 0 - Rx does not contain unresolved Rejects
  1.  ; .REJDATA - Array containing the Reject(s) data (see 
  1.  ; GET^PSOREJU2 for fields documentation)
  1.  ;
  1.  N RCODE,I,REJS
  1.  S REJS=0,RCODE=""
  1.  K REJDATA
  1.  I $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 FEND
  1.  S REJS=$$SINGLE^PSOREJU4(RX,$G(RFL),.REJDATA,$G(CODE),REJS)
  1. FEND ;
  1.  Q $S(REJS:1,1:0)
  1.  ;
  1.  ;
  1. SYNC(RX,RFL,USR) ;
  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.  ;
  1.  N REJ,REJS,REJLST,I,IDX,CODE,DATA,TXT,PSOTRIC,ERR,PSODIV,OPECC,OVREJ
  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)
  1.  S PSOTRIC="" S:$G(REJ(1,"ELIGBLT"))="T" PSOTRIC=1
  1.  S:PSOTRIC="" PSOTRIC=$$TRIC^PSOREJP1(RX,RFL,PSOTRIC)
  1.  K REJS S (OPECC,IDX,ERR)=""
  1.  F  S IDX=$O(REJ(IDX)) Q:IDX=""  D
  1.  . S TXT=$G(REJ(IDX,"REJ CODE LST"))
  1.  . F I=1:1:$L(TXT,",") D
  1.  . . S CODE=$P(TXT,",",I),OVREJ=""
  1.  . . I CODE'="79"&(CODE'="88")&('$G(PSOTRIC)) S ERR=$$EVAL^PSOREJU4(PSODIV,CODE,OPECC,.ERR) Q:'+ERR
  1.  . . S:+$G(ERR) OVREJ=1
  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)=""
  1.  F  S IDX=$O(REJS(IDX)) Q:IDX=""  D
  1.  . F  S CODE=$O(REJS(IDX,CODE)) Q:CODE=""  D
  1.  . . K DATA
  1.  . . I 'OPECC&(CODE'[79)&(CODE'[88) S DATA("OVERRIDE MSG")="Automatically transferred due to override for reject code."
  1.  . . I OPECC&(CODE'[79)&(CODE'[88) S DATA("OVERRIDE MSG")="Transferred by 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("PAYER MESSAGE")=$$CLEAN^PSOREJU1($G(REJ(IDX,"PAYER MESSAGE")))
  1.  . . S DATA("CODE")=CODE
  1.  . . S DATA("REASON")=$$CLEAN^PSOREJU1($G(REJ(IDX,"REASON")))
  1.  . . S DATA("PHARMACIST")=$G(USR)
  1.  . . S DATA("INSURANCE NAME")=$$CLEAN^PSOREJU1($G(REJ(IDX,"INSURANCE NAME")))
  1.  . . S DATA("GROUP NAME")=$$CLEAN^PSOREJU1($G(REJ(IDX,"GROUP NAME")))
  1.  . . S DATA("GROUP NUMBER")=$$CLEAN^PSOREJU1($G(REJ(IDX,"GROUP NUMBER")))
  1.  . . S DATA("CARDHOLDER ID")=$$CLEAN^PSOREJU1($G(REJ(IDX,"CARDHOLDER ID")))
  1.  . . S 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")))
  1.  . . D SAVE(RX,RFL,.DATA)
  1.  L -^PSRX("REJ",RX)
  1.  Q