PSOERXA5 ;ALB/BWF - eRx Utilities/RPC's ; 1/20/2018 10:28am
;;7.0;OUTPATIENT PHARMACY;**508,581,631,617,651,770**;DEC 1997;Build 145
;
Q
; ERXIEN - IEN to file 52.49
; MTYPE - message type from field .08 (message type) of file 52.49
MEDDISP(ERXIEN,MTYPE) ;
N DRUG,DRUGIEN,QTY,CLQ,USC,PUC,DAYS,DIRECT,REFQ,REFILLS,WRITDT,LFDATE,EXDATE,EFDATE,F,IENS,GL
N ERR,TYPE
S F=52.4949
S GL=$NA(^TMP($J,"PSOERXO1","Message",0,"Body",0,MTYPE,0,"MedicationDispensed",0))
Q:'$D(@GL)
; this will be enhanced in the future to accept another parameter and loop through medications requested for
; the rxChangeRequest message type.
S DRUG=$G(@GL@("DrugDescription",0))
S QTY=$G(@GL@("Quantity",0,"Value",0))
S CLQ=$G(@GL@("Quantity",0,"CodeListQualifier",0))
S USC=$G(@GL@("Quantity",0,"UnitSourceCode",0))
S PUC=$G(@GL@("Quantity",0,"PotencyUnitCode",0))
S DAYS=$G(@GL@("DaysSupply",0))
S DIRECT=$G(@GL@("Directions",0))
S REFQ=$G(@GL@("Refills",0,"Qualifier",0))
S REFILLS=$G(@GL@("Refills",0,"Value",0))
S WRITDT=$G(@GL@("WrittenDate","Date",0)),WRITDT=$$CONVDTTM^PSOERXA1(WRITDT)
S LFDATE=$G(@GL@("LastFillDate",0,"Date",0)),LFDATE=$$CONVDTTM^PSOERXA1(LFDATE)
S EXDATE=$G(@GL@("ExpirationDate",0,"Date",0)),EXDATE=$$CONVDTTM^PSOERXA1(EXDATE)
S EFDATE=$G(@GL@("EffectiveDate",0,"Date",0)),EFDATE=$$CONVDTTM^PSOERXA1(EFDATE)
; type=D is for medication dispensed
; this could be enhanced to collect both dispensed and requested (set of codes)
S TYPE="D"
S IENS="+1,"_ERXIEN_","
S FDA(F,IENS,.01)=DRUG
S DRUGIEN=$$FIND1^DIC(50,,,DRUG,"B",,"ERR")
; D = DISPENSED, R = REQUESTED
S FDA(F,IENS,.02)=TYPE
S FDA(F,IENS,.03)=DRUGIEN
S FDA(F,IENS,.04)=QTY
S FDA(F,IENS,.05)=DAYS
S FDA(F,IENS,.06)=REFILLS
S FDA(F,IENS,.07)=REFQ
S FDA(F,IENS,1)=DIRECT
S FDA(F,IENS,2.1)=WRITDT
S FDA(F,IENS,2.2)=LFDATE
S FDA(F,IENS,2.3)=EXDATE
S FDA(F,IENS,2.4)=EFDATE
S FDA(F,IENS,2.5)=CLQ
S FDA(F,IENS,2.6)=USC
S FDA(F,IENS,2.7)=PUC
D UPDATE^DIE(,"FDA") K FDA
; file the # of refills requested separately for ease of access
S FDA(52.49,ERXIEN_",",51.2)=REFILLS D FILE^DIE(,"FDA") K FDA
Q
REFRESP(ERXIEN,MTYPE) ;
N GL,REFFDA,RESTYPE,REFNUM,RESNOTE,I,REACODE,IENS,FDA,RESTUP,RESNODE,RESTNODE,REFRES,REFREQ,DELTAS,PSOIEN,RXIEN,COMM
S GL=$NA(^TMP($J,"PSOERXO1","Message",0,"Body",0,MTYPE,0,"Response",0))
S RESTYPE=$O(@GL@("")),RESTUP=$$UP^XLFSTR(RESTYPE),RESTUP=$TR(RESTUP," ",""),RESTUP=$TR(RESTUP,",","")
S RESTNODE=RESTYPE
S REFNUM=$G(@GL@(RESTYPE,0,"ReferenceNumber",0))
S RESTYPE=$S(RESTUP="APPROVED":"A",RESTUP="DENIED":"D",RESTUP="DENIEDNEWPRESCRIPTIONTOFOLLOW":"DNP",RESTUP="APPROVEDWITHCHANGES":"AWC",RESTUP="REPLACE":"R",1:"")
S RESNODE=$S(RESTYPE="A":"ApprovalReason",RESTYPE="R":"Replace",1:"DenialReason")
S RESNOTE=$S(RESTYPE="A"!(RESTYPE="AWC")!(RESTYPE="R")!(RESTYPE="DNP"):$G(@GL@(RESTNODE,0,"Note",0)),1:$G(@GL@(RESTNODE,0,"DenialReason",0)))
S REFFDA(52.49,ERXIEN_",",52.3)=REFNUM
S REFFDA(52.49,ERXIEN_",",52.1)=RESTYPE
S REFFDA(52.49,ERXIEN_",",52.2)=RESNOTE
D FILE^DIE(,"REFFDA") K REFFDA
S I=-1 F S I=$O(@GL@(RESTNODE,I)) Q:I="" D
.S REACODE=$G(@GL@(RESTNODE,0,"ReasonCode",I))
.S REACODE=$$PRESOLV^PSOERXA1(REACODE,"CLQ") Q:'REACODE
.S IENS="+1,"_ERXIEN_","
.S REFFDA(52.4955,IENS,.01)=REACODE
.D UPDATE^DIE(,"REFFDA") K REFFDA
S REFRES=ERXIEN,REFREQ=$$GETREQ^PSOERXU2(ERXIEN)
; If a corresponding eRx was not found for the Response received, update the Response status to RXF and do not process further
I 'REFREQ D Q
.S COMM="Response received was '"_$S(RESTYPE="A":"Approved",RESTYPE="D":"Denied",RESTYPE="DNP":"Denied, New Rx to Follow",RESTYPE="AWC":"Approved with Changes",RESTYPE="R":"Replace",1:$G(RESTUP))
.D UPDSTAT^PSOERXU1(ERXIEN,"RXF",COMM_"' - No corresponding eRx Record found.") Q
S RXIEN=$$GET1^DIQ(52.49,REFREQ,.13,"I")
; If the Rx has been renewed within the VA, update the Response status to RXF and do not process further.
I RXIEN,$$VARENEW^PSOERXU6(RXIEN) D Q
.S COMM="Response received was '"_$S(RESTYPE="A":"Approved",RESTYPE="D":"Denied",RESTYPE="DNP":"Denied, New Rx to Follow",RESTYPE="AWC":"Approved with Changes",RESTYPE="R":"Replace",1:$G(RESTUP))
.D UPDSTAT^PSOERXU1(ERXIEN,"RXF",COMM_"' - Unable to process - eRx already Renewed via Backdoor Pharmacy.") Q
; auto-dc original prescription if this is a denied, new rx to follow
I RESTYPE="DNP"!(RESTYPE="R") D Q
.I RESTYPE="DNP",RXIEN D RXACT^PSOBPSU2(RXIEN,,"RxRenewal response from external provider - Denied, New prescription to follow.","O")
.I RESTYPE="R",RXIEN D RXACT^PSOBPSU2(RXIEN,,"RxRenewal response from external provider - Replace.","O")
.D AUTODC^PSOERXU3(ERXIEN)
; if the response type is approved, process the approval into OP.
I RESTYPE="A" D Q
.D RXACT^PSOBPSU2(RXIEN,,"RxRenewal response from external provider - Approved.","O")
.S PSOIEN=ERXIEN D SETUP^PSOERX1F
S REFRES=ERXIEN,REFREQ=$$GETREQ^PSOERXU2(ERXIEN)
I 'REFREQ!('REFRES) Q
D RRDELTA^PSOERXU2(.DELTAS,REFREQ,REFRES)
; if the type is approved with changes, and the provider hasn't changed, auto-process the renewal
I RESTYPE="AWC",'$D(DELTAS(52.49,"EXTERNAL PROVIDER")) D
.D RXACT^PSOBPSU2(RXIEN,,"RxRenewal response from external provider - Approved with changes.","O")
.S PSOIEN=ERXIEN D SETUP^PSOERX1F
I RESTYPE="AWC",$D(DELTAS(52.49,"EXTERNAL PROVIDER")) D
.D RXACT^PSOBPSU2(RXIEN,,"RxRenewal response from external provider - Approved with provider changes.","O")
I RESTYPE="D" D UPDSTAT^PSOERXU1(ERXIEN,"RXD"),RXACT^PSOBPSU2(RXIEN,,"RxRenewal response from external provider - Denied.","O")
Q
; ERXIEN - IEN from 52.49
; MTYPE - message type (field .08)
; DNB - denied by hub flag
; VAINST - institution
CANRX(ERXIEN,MTYPE,DNB,VAINST) ;
N GL,RELIEN,NODE,ERXIENS,CRTYPE,RETREC,REQREF,CHANGEST,RELIEN,IMTYPE,PSSRET,NRXIEN,NRXSTAT,RXIEN,PENDIEN,ORESP,MES
S ERXIENS=ERXIEN_","
S IMTYPE=$$GET1^DIQ(52.49,ERXIEN,.08,"I")
S NODE=$S(MTYPE="CancelRx":"Request",MTYPE="CancelRxResponse":"Response",1:"") Q:NODE=""
S GL=$NA(^TMP($J,"PSOERXO1","Message",0,"Body",0,MTYPE,0,NODE,0))
S CRTYPE=$G(@GL@("ChangeRequestType",0))
S RETREC=$G(@GL@("ReturnReceipt",0))
S REQREF=$G(@GL@("RequestReferenceNumber",0))
S CHANGEST=$G(@GL@("ChangeofPrescriptionStatusFlag",0))
D CANFIL(ERXIENS,CRTYPE,RETREC,REQREF,CHANGEST)
I IMTYPE="CA" S NRXIEN=$$RESOLV^PSOERXU2(ERXIEN)
I IMTYPE="CN" S RELIEN=$$GETREQ^PSOERXU2(ERXIEN),NRXIEN=$$RESOLV^PSOERXU2(RELIEN)
; if we cannot find the related message, update status, and quit
I IMTYPE="CA",'$G(NRXIEN) D Q
. D UPDSTAT^PSOERXU1(ERXIEN,"CAP")
Q:'$G(NRXIEN)
; Validates if the order is an eRx and Log Activity in AL eRx
S MES=$S(IMTYPE="CA":"Canceled by external provider (eRx)",IMTYPE="CN":"Cancel Response to external provider (eRx)")
S RXIEN=$$GET1^DIQ(52.49,NRXIEN,.13,"I")
I RXIEN D RXACT^PSOBPSU2(RXIEN,,MES,"O")
S NRXSTAT=$$GET1^DIQ(52.49,NRXIEN,1,"E")
;generate automated cancel response on rejected and new status eRxs in the holding queue
I ",RJ,N,"[NRXSTAT D Q
. I NRXSTAT="RJ" D
. . S ORESP="Rx was never dispensed. Rejected at Pharmacy"
. . D POST^PSOERXO1(ERXIEN,.PSSRET,,,,3,VAINST,ORESP)
.I NRXSTAT'="RJ" D POST^PSOERXO1(ERXIEN,.PSSRET,,,,3,VAINST)
. ; if there was an error, quit. we do not want to override the CAX status
. I $D(PSSRET("errorMessage")) D UPDSTAT^PSOERXU1(NRXIEN,"CAN") Q
. D UPDSTAT^PSOERXU1(NRXIEN,"CAN")
. D UPDSTAT^PSOERXU1(ERXIEN,"CAO") I $G(MBMSITE) D UPDSTAT^PSOERXU1(ERXIEN,"CAA") ; Auto-acknowledging CAO's for MbM
;generate automated cancel response on processed eRx's
I NRXSTAT="PR"!(NRXSTAT="CXP")!(NRXSTAT="RXP") D Q
. D CANDC^PSOERXU6(ERXIEN,VAINST,.PSSRET)
; Do we not build a response for the other canceled items?
D UPDSTAT^PSOERXU1(ERXIEN,"CAH")
D UPDSTAT^PSOERXU1(NRXIEN,"CAN")
Q
CANFIL(ERXIENS,CRTYPE,RETREC,REQREF,CHANGEST,STATUS,DNB) ;
N FDA
S FDA(52.49,ERXIENS,80.1)=CRTYPE
S FDA(52.49,ERXIENS,80.2)=RETREC
S FDA(52.49,ERXIENS,80.3)=REQREF
S FDA(52.49,ERXIENS,80.4)=CHANGEST
S FDA(52.49,ERXIENS,80.5)=$G(DNB)
I $L($G(STATUS)) S FDA(52.49,ERXIENS,1)=$$PRESOLV^PSOERXA1(STATUS,"ERX")
D FILE^DIE(,"FDA") K FDA
Q
BFC(ERXIEN) ; benefits coordination
N GL,BFCCNT,CHFN,CHLN,CHMN,CHPRE,CHSUFF,CHID,GRPID,PIDTYP,PIDVAL,CHFN,F,PIEN,NEWPAYER,BFCERR,IENS,CHFULLN,FDA,BSEQ,PNAME,PIDCNT
S F=52.4918
S GL=$NA(^TMP($J,"PSOERXO1","Message",0,"Body",0,"NewRx",0,"BenefitsCoordination"))
; cannot start at 0, since the first entry is on the 0 subscript.
S BSEQ=0
S BFCCNT=-1 F S BFCCNT=$O(@GL@(BFCCNT)) Q:BFCCNT="" D
.S BSEQ=BSEQ+1
.S CHFN=$$UP^XLFSTR($G(@GL@(BFCCNT,"CardHolderName",0,"FirstName",0)))
.S CHLN=$$UP^XLFSTR($G(@GL@(BFCCNT,"CardHolderName",0,"LastName",0)))
.S CHMN=$$UP^XLFSTR($G(@GL@(BFCCNT,"CardHolderName",0,"MiddleName",0)))
.; set up full name - last, first, mi
.S CHFULLN=CHLN_","_CHFN_$S(CHMN]"":" "_CHMN,1:"")
.S CHPRE=$$UP^XLFSTR($G(@GL@(BFCCNT,"CardHolderName",0,"Prefix",0)))
.S CHSUFF=$$UP^XLFSTR($G(@GL@(BFCCNT,"CardHolderName",0,"Suffix",0)))
.S CHID=$G(@GL@(BFCCNT,"CardholderID",0))
.S GRPID=$G(@GL@(BFCCNT,"GroupID",0))
.S PNAME=$G(@GL@(BFCCNT,"PayerName",0))
.S IENS="+1,"_ERXIEN_","
.S FDA(F,IENS,.01)=BSEQ,FDA(F,IENS,7)=CHID,FDA(F,IENS,.02)=GRPID,FDA(F,IENS,.03)=PNAME
.S FDA(F,IENS,1)=CHLN,FDA(F,IENS,2)=CHFN,FDA(F,IENS,3)=CHMN,FDA(F,IENS,4)=CHSUFF,FDA(F,IENS,5)=CHPRE
.K NEWPAYER
.D UPDATE^DIE(,"FDA","NEWPAYER") K FDA
.S PIEN=$O(NEWPAYER(0)),PIEN=$G(NEWPAYER(PIEN)) Q:'PIEN
.S PIDCNT=-1 F S PIDCNT=$O(@GL@(BFCCNT,"PayerIdentification",PIDCNT)) Q:PIDCNT="" D
..S PIDTYP="" F S PIDTYP=$O(@GL@(BFCCNT,"PayerIdentification",PIDCNT,PIDTYP)) Q:PIDTYP="" D
...S PIDVAL=$G(@GL@(BFCCNT,"PayerIdentification",PIDCNT,PIDTYP,0))
...S FDA(52.49186,"+1,"_PIEN_","_ERXIEN_",",.01)=PIDTYP
...S FDA(52.49186,"+1,"_PIEN_","_ERXIEN_",",.02)=PIDVAL
...D UPDATE^DIE(,"FDA") K FDA
.K NEWPAYER,PIEN
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPSOERXA5 9992 printed Sep 23, 2025@20:04:48 Page 2
PSOERXA5 ;ALB/BWF - eRx Utilities/RPC's ; 1/20/2018 10:28am
+1 ;;7.0;OUTPATIENT PHARMACY;**508,581,631,617,651,770**;DEC 1997;Build 145
+2 ;
+3 QUIT
+4 ; ERXIEN - IEN to file 52.49
+5 ; MTYPE - message type from field .08 (message type) of file 52.49
MEDDISP(ERXIEN,MTYPE) ;
+1 NEW DRUG,DRUGIEN,QTY,CLQ,USC,PUC,DAYS,DIRECT,REFQ,REFILLS,WRITDT,LFDATE,EXDATE,EFDATE,F,IENS,GL
+2 NEW ERR,TYPE
+3 SET F=52.4949
+4 SET GL=$NAME(^TMP($JOB,"PSOERXO1","Message",0,"Body",0,MTYPE,0,"MedicationDispensed",0))
+5 if '$DATA(@GL)
QUIT
+6 ; this will be enhanced in the future to accept another parameter and loop through medications requested for
+7 ; the rxChangeRequest message type.
+8 SET DRUG=$GET(@GL@("DrugDescription",0))
+9 SET QTY=$GET(@GL@("Quantity",0,"Value",0))
+10 SET CLQ=$GET(@GL@("Quantity",0,"CodeListQualifier",0))
+11 SET USC=$GET(@GL@("Quantity",0,"UnitSourceCode",0))
+12 SET PUC=$GET(@GL@("Quantity",0,"PotencyUnitCode",0))
+13 SET DAYS=$GET(@GL@("DaysSupply",0))
+14 SET DIRECT=$GET(@GL@("Directions",0))
+15 SET REFQ=$GET(@GL@("Refills",0,"Qualifier",0))
+16 SET REFILLS=$GET(@GL@("Refills",0,"Value",0))
+17 SET WRITDT=$GET(@GL@("WrittenDate","Date",0))
SET WRITDT=$$CONVDTTM^PSOERXA1(WRITDT)
+18 SET LFDATE=$GET(@GL@("LastFillDate",0,"Date",0))
SET LFDATE=$$CONVDTTM^PSOERXA1(LFDATE)
+19 SET EXDATE=$GET(@GL@("ExpirationDate",0,"Date",0))
SET EXDATE=$$CONVDTTM^PSOERXA1(EXDATE)
+20 SET EFDATE=$GET(@GL@("EffectiveDate",0,"Date",0))
SET EFDATE=$$CONVDTTM^PSOERXA1(EFDATE)
+21 ; type=D is for medication dispensed
+22 ; this could be enhanced to collect both dispensed and requested (set of codes)
+23 SET TYPE="D"
+24 SET IENS="+1,"_ERXIEN_","
+25 SET FDA(F,IENS,.01)=DRUG
+26 SET DRUGIEN=$$FIND1^DIC(50,,,DRUG,"B",,"ERR")
+27 ; D = DISPENSED, R = REQUESTED
+28 SET FDA(F,IENS,.02)=TYPE
+29 SET FDA(F,IENS,.03)=DRUGIEN
+30 SET FDA(F,IENS,.04)=QTY
+31 SET FDA(F,IENS,.05)=DAYS
+32 SET FDA(F,IENS,.06)=REFILLS
+33 SET FDA(F,IENS,.07)=REFQ
+34 SET FDA(F,IENS,1)=DIRECT
+35 SET FDA(F,IENS,2.1)=WRITDT
+36 SET FDA(F,IENS,2.2)=LFDATE
+37 SET FDA(F,IENS,2.3)=EXDATE
+38 SET FDA(F,IENS,2.4)=EFDATE
+39 SET FDA(F,IENS,2.5)=CLQ
+40 SET FDA(F,IENS,2.6)=USC
+41 SET FDA(F,IENS,2.7)=PUC
+42 DO UPDATE^DIE(,"FDA")
KILL FDA
+43 ; file the # of refills requested separately for ease of access
+44 SET FDA(52.49,ERXIEN_",",51.2)=REFILLS
DO FILE^DIE(,"FDA")
KILL FDA
+45 QUIT
REFRESP(ERXIEN,MTYPE) ;
+1 NEW GL,REFFDA,RESTYPE,REFNUM,RESNOTE,I,REACODE,IENS,FDA,RESTUP,RESNODE,RESTNODE,REFRES,REFREQ,DELTAS,PSOIEN,RXIEN,COMM
+2 SET GL=$NAME(^TMP($JOB,"PSOERXO1","Message",0,"Body",0,MTYPE,0,"Response",0))
+3 SET RESTYPE=$ORDER(@GL@(""))
SET RESTUP=$$UP^XLFSTR(RESTYPE)
SET RESTUP=$TRANSLATE(RESTUP," ","")
SET RESTUP=$TRANSLATE(RESTUP,",","")
+4 SET RESTNODE=RESTYPE
+5 SET REFNUM=$GET(@GL@(RESTYPE,0,"ReferenceNumber",0))
+6 SET RESTYPE=$SELECT(RESTUP="APPROVED":"A",RESTUP="DENIED":"D",RESTUP="DENIEDNEWPRESCRIPTIONTOFOLLOW":"DNP",RESTUP="APPROVEDWITHCHANGES":"AWC",RESTUP="REPLACE":"R",1:"")
+7 SET RESNODE=$SELECT(RESTYPE="A":"ApprovalReason",RESTYPE="R":"Replace",1:"DenialReason")
+8 SET RESNOTE=$SELECT(RESTYPE="A"!(RESTYPE="AWC")!(RESTYPE="R")!(RESTYPE="DNP"):$GET(@GL@(RESTNODE,0,"Note",0)),1:$GET(@GL@(RESTNODE,0,"DenialReason",0)))
+9 SET REFFDA(52.49,ERXIEN_",",52.3)=REFNUM
+10 SET REFFDA(52.49,ERXIEN_",",52.1)=RESTYPE
+11 SET REFFDA(52.49,ERXIEN_",",52.2)=RESNOTE
+12 DO FILE^DIE(,"REFFDA")
KILL REFFDA
+13 SET I=-1
FOR
SET I=$ORDER(@GL@(RESTNODE,I))
if I=""
QUIT
Begin DoDot:1
+14 SET REACODE=$GET(@GL@(RESTNODE,0,"ReasonCode",I))
+15 SET REACODE=$$PRESOLV^PSOERXA1(REACODE,"CLQ")
if 'REACODE
QUIT
+16 SET IENS="+1,"_ERXIEN_","
+17 SET REFFDA(52.4955,IENS,.01)=REACODE
+18 DO UPDATE^DIE(,"REFFDA")
KILL REFFDA
End DoDot:1
+19 SET REFRES=ERXIEN
SET REFREQ=$$GETREQ^PSOERXU2(ERXIEN)
+20 ; If a corresponding eRx was not found for the Response received, update the Response status to RXF and do not process further
+21 IF 'REFREQ
Begin DoDot:1
+22 SET COMM="Response received was '"_$SELECT(RESTYPE="A":"Approved",RESTYPE="D":"Denied",RESTYPE="DNP":"Denied, New Rx to Follow",RESTYPE="AWC":"Approved with Changes",RESTYPE="R":"Replace",1:$GET(RESTUP))
+23 DO UPDSTAT^PSOERXU1(ERXIEN,"RXF",COMM_"' - No corresponding eRx Record found.")
QUIT
End DoDot:1
QUIT
+24 SET RXIEN=$$GET1^DIQ(52.49,REFREQ,.13,"I")
+25 ; If the Rx has been renewed within the VA, update the Response status to RXF and do not process further.
+26 IF RXIEN
IF $$VARENEW^PSOERXU6(RXIEN)
Begin DoDot:1
+27 SET COMM="Response received was '"_$SELECT(RESTYPE="A":"Approved",RESTYPE="D":"Denied",RESTYPE="DNP":"Denied, New Rx to Follow",RESTYPE="AWC":"Approved with Changes",RESTYPE="R":"Replace",1:$GET(RESTUP))
+28 DO UPDSTAT^PSOERXU1(ERXIEN,"RXF",COMM_"' - Unable to process - eRx already Renewed via Backdoor Pharmacy.")
QUIT
End DoDot:1
QUIT
+29 ; auto-dc original prescription if this is a denied, new rx to follow
+30 IF RESTYPE="DNP"!(RESTYPE="R")
Begin DoDot:1
+31 IF RESTYPE="DNP"
IF RXIEN
DO RXACT^PSOBPSU2(RXIEN,,"RxRenewal response from external provider - Denied, New prescription to follow.","O")
+32 IF RESTYPE="R"
IF RXIEN
DO RXACT^PSOBPSU2(RXIEN,,"RxRenewal response from external provider - Replace.","O")
+33 DO AUTODC^PSOERXU3(ERXIEN)
End DoDot:1
QUIT
+34 ; if the response type is approved, process the approval into OP.
+35 IF RESTYPE="A"
Begin DoDot:1
+36 DO RXACT^PSOBPSU2(RXIEN,,"RxRenewal response from external provider - Approved.","O")
+37 SET PSOIEN=ERXIEN
DO SETUP^PSOERX1F
End DoDot:1
QUIT
+38 SET REFRES=ERXIEN
SET REFREQ=$$GETREQ^PSOERXU2(ERXIEN)
+39 IF 'REFREQ!('REFRES)
QUIT
+40 DO RRDELTA^PSOERXU2(.DELTAS,REFREQ,REFRES)
+41 ; if the type is approved with changes, and the provider hasn't changed, auto-process the renewal
+42 IF RESTYPE="AWC"
IF '$DATA(DELTAS(52.49,"EXTERNAL PROVIDER"))
Begin DoDot:1
+43 DO RXACT^PSOBPSU2(RXIEN,,"RxRenewal response from external provider - Approved with changes.","O")
+44 SET PSOIEN=ERXIEN
DO SETUP^PSOERX1F
End DoDot:1
+45 IF RESTYPE="AWC"
IF $DATA(DELTAS(52.49,"EXTERNAL PROVIDER"))
Begin DoDot:1
+46 DO RXACT^PSOBPSU2(RXIEN,,"RxRenewal response from external provider - Approved with provider changes.","O")
End DoDot:1
+47 IF RESTYPE="D"
DO UPDSTAT^PSOERXU1(ERXIEN,"RXD")
DO RXACT^PSOBPSU2(RXIEN,,"RxRenewal response from external provider - Denied.","O")
+48 QUIT
+49 ; ERXIEN - IEN from 52.49
+50 ; MTYPE - message type (field .08)
+51 ; DNB - denied by hub flag
+52 ; VAINST - institution
CANRX(ERXIEN,MTYPE,DNB,VAINST) ;
+1 NEW GL,RELIEN,NODE,ERXIENS,CRTYPE,RETREC,REQREF,CHANGEST,RELIEN,IMTYPE,PSSRET,NRXIEN,NRXSTAT,RXIEN,PENDIEN,ORESP,MES
+2 SET ERXIENS=ERXIEN_","
+3 SET IMTYPE=$$GET1^DIQ(52.49,ERXIEN,.08,"I")
+4 SET NODE=$SELECT(MTYPE="CancelRx":"Request",MTYPE="CancelRxResponse":"Response",1:"")
if NODE=""
QUIT
+5 SET GL=$NAME(^TMP($JOB,"PSOERXO1","Message",0,"Body",0,MTYPE,0,NODE,0))
+6 SET CRTYPE=$GET(@GL@("ChangeRequestType",0))
+7 SET RETREC=$GET(@GL@("ReturnReceipt",0))
+8 SET REQREF=$GET(@GL@("RequestReferenceNumber",0))
+9 SET CHANGEST=$GET(@GL@("ChangeofPrescriptionStatusFlag",0))
+10 DO CANFIL(ERXIENS,CRTYPE,RETREC,REQREF,CHANGEST)
+11 IF IMTYPE="CA"
SET NRXIEN=$$RESOLV^PSOERXU2(ERXIEN)
+12 IF IMTYPE="CN"
SET RELIEN=$$GETREQ^PSOERXU2(ERXIEN)
SET NRXIEN=$$RESOLV^PSOERXU2(RELIEN)
+13 ; if we cannot find the related message, update status, and quit
+14 IF IMTYPE="CA"
IF '$GET(NRXIEN)
Begin DoDot:1
+15 DO UPDSTAT^PSOERXU1(ERXIEN,"CAP")
End DoDot:1
QUIT
+16 if '$GET(NRXIEN)
QUIT
+17 ; Validates if the order is an eRx and Log Activity in AL eRx
+18 SET MES=$SELECT(IMTYPE="CA":"Canceled by external provider (eRx)",IMTYPE="CN":"Cancel Response to external provider (eRx)")
+19 SET RXIEN=$$GET1^DIQ(52.49,NRXIEN,.13,"I")
+20 IF RXIEN
DO RXACT^PSOBPSU2(RXIEN,,MES,"O")
+21 SET NRXSTAT=$$GET1^DIQ(52.49,NRXIEN,1,"E")
+22 ;generate automated cancel response on rejected and new status eRxs in the holding queue
+23 IF ",RJ,N,"[NRXSTAT
Begin DoDot:1
+24 IF NRXSTAT="RJ"
Begin DoDot:2
+25 SET ORESP="Rx was never dispensed. Rejected at Pharmacy"
+26 DO POST^PSOERXO1(ERXIEN,.PSSRET,,,,3,VAINST,ORESP)
End DoDot:2
+27 IF NRXSTAT'="RJ"
DO POST^PSOERXO1(ERXIEN,.PSSRET,,,,3,VAINST)
+28 ; if there was an error, quit. we do not want to override the CAX status
+29 IF $DATA(PSSRET("errorMessage"))
DO UPDSTAT^PSOERXU1(NRXIEN,"CAN")
QUIT
+30 DO UPDSTAT^PSOERXU1(NRXIEN,"CAN")
+31 ; Auto-acknowledging CAO's for MbM
DO UPDSTAT^PSOERXU1(ERXIEN,"CAO")
IF $GET(MBMSITE)
DO UPDSTAT^PSOERXU1(ERXIEN,"CAA")
End DoDot:1
QUIT
+32 ;generate automated cancel response on processed eRx's
+33 IF NRXSTAT="PR"!(NRXSTAT="CXP")!(NRXSTAT="RXP")
Begin DoDot:1
+34 DO CANDC^PSOERXU6(ERXIEN,VAINST,.PSSRET)
End DoDot:1
QUIT
+35 ; Do we not build a response for the other canceled items?
+36 DO UPDSTAT^PSOERXU1(ERXIEN,"CAH")
+37 DO UPDSTAT^PSOERXU1(NRXIEN,"CAN")
+38 QUIT
CANFIL(ERXIENS,CRTYPE,RETREC,REQREF,CHANGEST,STATUS,DNB) ;
+1 NEW FDA
+2 SET FDA(52.49,ERXIENS,80.1)=CRTYPE
+3 SET FDA(52.49,ERXIENS,80.2)=RETREC
+4 SET FDA(52.49,ERXIENS,80.3)=REQREF
+5 SET FDA(52.49,ERXIENS,80.4)=CHANGEST
+6 SET FDA(52.49,ERXIENS,80.5)=$GET(DNB)
+7 IF $LENGTH($GET(STATUS))
SET FDA(52.49,ERXIENS,1)=$$PRESOLV^PSOERXA1(STATUS,"ERX")
+8 DO FILE^DIE(,"FDA")
KILL FDA
+9 QUIT
BFC(ERXIEN) ; benefits coordination
+1 NEW GL,BFCCNT,CHFN,CHLN,CHMN,CHPRE,CHSUFF,CHID,GRPID,PIDTYP,PIDVAL,CHFN,F,PIEN,NEWPAYER,BFCERR,IENS,CHFULLN,FDA,BSEQ,PNAME,PIDCNT
+2 SET F=52.4918
+3 SET GL=$NAME(^TMP($JOB,"PSOERXO1","Message",0,"Body",0,"NewRx",0,"BenefitsCoordination"))
+4 ; cannot start at 0, since the first entry is on the 0 subscript.
+5 SET BSEQ=0
+6 SET BFCCNT=-1
FOR
SET BFCCNT=$ORDER(@GL@(BFCCNT))
if BFCCNT=""
QUIT
Begin DoDot:1
+7 SET BSEQ=BSEQ+1
+8 SET CHFN=$$UP^XLFSTR($GET(@GL@(BFCCNT,"CardHolderName",0,"FirstName",0)))
+9 SET CHLN=$$UP^XLFSTR($GET(@GL@(BFCCNT,"CardHolderName",0,"LastName",0)))
+10 SET CHMN=$$UP^XLFSTR($GET(@GL@(BFCCNT,"CardHolderName",0,"MiddleName",0)))
+11 ; set up full name - last, first, mi
+12 SET CHFULLN=CHLN_","_CHFN_$SELECT(CHMN]"":" "_CHMN,1:"")
+13 SET CHPRE=$$UP^XLFSTR($GET(@GL@(BFCCNT,"CardHolderName",0,"Prefix",0)))
+14 SET CHSUFF=$$UP^XLFSTR($GET(@GL@(BFCCNT,"CardHolderName",0,"Suffix",0)))
+15 SET CHID=$GET(@GL@(BFCCNT,"CardholderID",0))
+16 SET GRPID=$GET(@GL@(BFCCNT,"GroupID",0))
+17 SET PNAME=$GET(@GL@(BFCCNT,"PayerName",0))
+18 SET IENS="+1,"_ERXIEN_","
+19 SET FDA(F,IENS,.01)=BSEQ
SET FDA(F,IENS,7)=CHID
SET FDA(F,IENS,.02)=GRPID
SET FDA(F,IENS,.03)=PNAME
+20 SET FDA(F,IENS,1)=CHLN
SET FDA(F,IENS,2)=CHFN
SET FDA(F,IENS,3)=CHMN
SET FDA(F,IENS,4)=CHSUFF
SET FDA(F,IENS,5)=CHPRE
+21 KILL NEWPAYER
+22 DO UPDATE^DIE(,"FDA","NEWPAYER")
KILL FDA
+23 SET PIEN=$ORDER(NEWPAYER(0))
SET PIEN=$GET(NEWPAYER(PIEN))
if 'PIEN
QUIT
+24 SET PIDCNT=-1
FOR
SET PIDCNT=$ORDER(@GL@(BFCCNT,"PayerIdentification",PIDCNT))
if PIDCNT=""
QUIT
Begin DoDot:2
+25 SET PIDTYP=""
FOR
SET PIDTYP=$ORDER(@GL@(BFCCNT,"PayerIdentification",PIDCNT,PIDTYP))
if PIDTYP=""
QUIT
Begin DoDot:3
+26 SET PIDVAL=$GET(@GL@(BFCCNT,"PayerIdentification",PIDCNT,PIDTYP,0))
+27 SET FDA(52.49186,"+1,"_PIEN_","_ERXIEN_",",.01)=PIDTYP
+28 SET FDA(52.49186,"+1,"_PIEN_","_ERXIEN_",",.02)=PIDVAL
+29 DO UPDATE^DIE(,"FDA")
KILL FDA
End DoDot:3
End DoDot:2
+30 KILL NEWPAYER,PIEN
End DoDot:1
+31 QUIT
