PSOREJUT ;BIRM/MFR - BPS (ECME) - Clinical Rejects Utilities ;06/07/05
 ;;7.0;OUTPATIENT PHARMACY;**148,247,260**;DEC 1997;Build 84
 ;Reference to DUR1^BPSNCPD3 supported by IA 4560
 ;Reference to $$ADDCOMM^BPSBUTL supported by IA 4719
 ;
SAVE(RX,RFL,REJ) ; - Saves DUR Information in the PRESCRIPTION file
 ; Input:  (r) RX  - Rx IEN (#52) 
 ;         (o) RFL - Refill # (Default: most recent)
 ;         (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)
 ;
 ; - If Reject Code different than 79 or 88, Quit
 S REJ("CODE")=+$G(REJ("CODE")) I REJ("CODE")'=79,REJ("CODE")'=88 Q
 ;
 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=+$G(REJ("CODE")),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
 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
 ;                      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 - Specific Reject Code to be checked
 ;         
 ; Output: 1 - Rx contains unresoveld Rejects 
 ;         0 - Rx does not contain unresolved Rejects
 ;         .REJDATA - Array containing the Reject(s) data (see 
 ;                    GET^PSOREJU2 for fields documentation)
 ;
 I $G(RFL),$$STATUS^PSOBPSUT(RX,RFL)="" Q 0
 ;
 K REJDATA
 I $G(RFL) D
 . D GET^PSOREJU2(RX,RFL,.REJDATA,,,$G(CODE))
 E  S RFL=0 D  I '$D(REJDATA) F  S RFL=$O(^PSRX(RX,1,RFL)) Q:'RFL  D  Q:$D(REJDATA)
 . D GET^PSOREJU2(RX,RFL,.REJDATA,,,$G(CODE))
 ;
 Q $S($D(REJDATA):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,I,IDX,CODE,DATA,TXT
 L +^PSRX("REJ",RX):0 Q:'$T
 I '$D(RFL) S RFL=$$LSTRFL^PSOBPSU1(RX)
 D DUR1^BPSNCPD3(RX,RFL,.REJ)
 K REJS S IDX=""
 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) I CODE'=79,CODE'=88 Q
 . . I $$DUP^PSOREJU1(RX,+$$CLEAN^PSOREJU1($G(REJ(IDX,"RESPONSE IEN")))) Q
 . . S REJS(IDX,CODE)=""
 I '$D(REJS) L -^PSRX("REJ",RX) Q
 ;
 S (IDX,CODE)=""
 F  S IDX=$O(REJS(IDX)) Q:IDX=""  D
 . F  S CODE=$O(REJS(IDX,CODE)) Q:CODE=""  D
 . . K DATA
 . . 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