PSXRPPL2 ;BIR/WPB - Print From Suspense Utilities ;29-Apr-2013 14:01;PLS
;;2.0;CMOP;**65,1015**;11 Apr 97;Build 62
;Reference to ^PSRX( supported by DBIA #1977
;Reference to ^PS(52.5, supported by DBIA #1978
;Reference to ^PSSLOCK supported by DBIA #2789
;Reference to ^PSOBPSUT supported by DBIA #4701
;Reference to ^PSOBPSU1 supported by DBIA #4702
;Reference to ^PSOBPSU2 supported by DBIA #4970
;Reference to ^PSOREJUT supported by DBIA #4706
;Reference to ^PSOREJU3 supported by DBIA #5186
;Reference to $$DEA^IBNCPDP controlled subscription by IA 4299
;Reference to CHANGE^PSOSUCH1 suppored by DBIA #5427
;
;Modified - IHS/MSC/PLS - 06/01/2010 - Line DSH+1, HOSTREJ+1
; - 04/29/2013 - Line EPHARM+8
CHKDFN(THRDT) ; use the patient 'C' index under RX multiple in file 550.2 to GET dfn to gather Patients' future RXs
;Input: THRDT - THROUGH DATE to run CMOP transmission
;
I '$D(^PSX(550.2,PSXBAT,15,"C")) Q
S (SBTECME)=0 K ^TMP("PSXEPHDFN",$J)
S PSXPTNM="" F S PSXPTNM=$O(^PSX(550.2,PSXBAT,15,"C",PSXPTNM)) Q:PSXPTNM="" D
. S XDFN=0 F S XDFN=$O(^PSX(550.2,PSXBAT,"15","C",PSXPTNM,XDFN)) Q:(XDFN'>0) D
. . S SDT=PRTDT F S SDT=$O(^PS(52.5,"CMP","Q",PSXTYP,PSXTDIV,SDT)),NDFN=0 Q:(SDT>PSXDTRG)!(SDT="") D
. . . F S NDFN=$O(^PS(52.5,"CMP","Q",PSXTYP,PSXTDIV,SDT,NDFN)),REC=0 Q:NDFN'>0 I NDFN=XDFN D
. . . . F S REC=$O(^PS(52.5,"CMP","Q",PSXTYP,PSXTDIV,SDT,NDFN,REC)) Q:REC'>0 D
. . . . . S (PSOLRX,RX)=+$$GET1^DIQ(52.5,REC,.01,"I") I 'RX Q
. . . . . S RFL=$$GET1^DIQ(52.5,REC,9,"I") I RFL="" S RFL=$$LSTRFL^PSOBPSU1(RX)
. . . . . I $$XMIT^PSXBPSUT(REC) D
. . . . . . I SDT>THRDT,'$D(^TMP("PSXEPHDFN",$J,XDFN)) Q
. . . . . . I $$PATCH^XPDUTL("PSO*7.0*148") D
. . . . . . . I $$RETRX^PSOBPSUT(RX,RFL),SDT>DT Q
. . . . . . . I $$DOUBLE^PSXRPPL1(RX,RFL) Q
. . . . . . . I $$FIND^PSOREJUT(RX,RFL,,"79,88") Q
. . . . . . . I '$$RETRX^PSOBPSUT(RX,RFL),'$$ECMESTAT(RX,RFL) Q
. . . . . . . I $$PATCH^XPDUTL("PSO*7.0*289"),'$$DUR(RX,RFL),'$$DSH(REC) Q
. . . . . . . S DOS=$$RXFLDT^PSOBPSUT(RX,RFL) I DOS>DT S DOS=DT
. . . . . . . D ECMESND^PSOBPSU1(RX,RFL,DOS,"PC",,1,,,,.RESP)
. . . . . . . I $$PATCH^XPDUTL("PSO*7.0*287"),$$TRISTA^PSOREJU3(RXN,RFL,.RESP,"PC") S ^TMP("PSXEPHNB",$J,RX,RFL)=$G(RESP)
. . . . . . . I $D(RESP),'RESP S SBTECME=SBTECME+1
. . . . . . .S ^TMP("PSXEPHDFN",$J,XDFN)=""
. . . . . D PSOUL^PSSLOCK(PSOLRX)
K ^TMP("PSXEPHDFN",$J)
I SBTECME>0 H 60+$S((SBTECME*15)>7200:7200,1:(SBTECME*15))
Q
;
EPHARM ; - ePharmacy checks for third party billing
I $$DOUBLE^PSXRPPL1(RXN,RFL) S EPHQT=1 Q
I $$RETRX^PSOBPSUT(RXN,RFL),SDT>DT S EPHQT=1 Q
I $$FIND^PSOREJUT(RXN,RFL,,"79,88") S EPHQT=1 Q
I $$PATCH^XPDUTL("PSO*7.0*287"),$$TRISTA^PSOREJU3(RXN,RFL,.RESP,"PC") D EPH Q
I $$PATCH^XPDUTL("PSO*7.0*287"),$D(^TMP("PSXEPHNB",$J,RXN,RFL)) D EPH Q
I $$STATUS^PSOBPSUT(RXN,RFL)="IN PROGRESS" D EPH Q
;IHS/MSC/PLS - 04/30/13
;I $$PATCH^XPDUTL("PSO*7.0*289"),'$$DSH(REC) S EPHQT=1 Q
I $$PATCH^XPDUTL("PSO*7.0*289"),'$$DUR(RXN,RFL) D EPH Q
Q
;
EPH ; - Store Rx not xmitted to CMOP in XTMP file for MailMan message.
S ^TMP("PSXEPHIN",$J,$$RXSITE^PSOBPSUT(RXN),RXN)=RFL,EPHQT=1
Q
;
;Description:
;This function checks the Rx's ECME Status to determine if it's acceptable to resubmit
;based on reject codes associated with a previous submission. If Rx was rejected with
;host reject errors, and no other rejects exist, then it's OK to resubmit to ECME.
;Input: RX = Prescription file #52 IEN
; RFL = Refill number
;Returns: 1 = OK to resubmit
;0 = Don't resubmit
ECMESTAT(RX,RFL) ;
I '$$PATCH^XPDUTL("PSO*7.0*148") Q 0
N STATUS
S STATUS=$$STATUS^PSOBPSUT(RX,RFL)
; Never submitted before, OK to resubmit
I STATUS="" Q 1
; If status other than E REJECTED, don't resubmit
I STATUS'="E REJECTED" Q 0
; If only host rejects, quit with 1. Otherwise quit with 0
Q $$HOSTREJ(RX,RFL,0)
;
;Description:
;This function determines whether the RX SUSPENSE has a DAYS SUPPLY HOLD
;condition.
;Input: REC = Pointer to Suspense file (#52.5)
;Returns: 1 or 0
;1 (one) if ¾ of days supply has elapsed.
;0 (zero) is returned if ¾ of days supply has not elapsed.
;
DSH(REC) ;ePharmacy API to check for 3/4 days supply hold
Q "" ;IHS/MSC/PLS - 06/01/2010
N PSINSUR,PSARR,SHDT,DSHOLD,DSHDT,PS0,COMM,DIE,DA,DR,RXIEN,RFL,DAYSSUP,LSTFIL,PTDFN,IBINS,DRG
N DEA,DEAOK,ICD,SFN,SDT
S DSHOLD=1,PS0=^PS(52.5,REC,0),RXIEN=$P(PS0,U,1),RFL=$P(PS0,U,13)
S LSTFIL=$$LSTRFL^PSOBPSU1(RXIEN),PTDFN=$$GET1^DIQ(52,RXIEN,"2","I")
S IBSTAT=$$INSUR^IBBAPI(PTDFN,,"E",.IBINS,"1"),DRG=$$GET1^DIQ(52,RXIEN,"6","I")
S (ICD,DEA)="",DEA=$$GET1^DIQ(50,DRG,3)
I $D(^PSRX(RXIEN,"ICD",1,0)) S ICD=^PSRX(RXIEN,"ICD",1,0)
;
; Don't hold Rx where the previous fill was not ebillable
I $$STATUS^BPSOSRX(RXIEN,LSTFIL-1)="" Q DSHOLD
; Don't hold when the Rx has SC/EI flagged
I ICD[1 Q DSHOLD
; Don't hold rx if DEA special Handling code is non billable (i.e. has M or 0 (zero) or I, S, N, and/or 9)) without an E
S DEAOK=$$DEA^IBNCPDP(DEA) I 'DEAOK Q DSHOLD
; Don't hold for zero fill renewals
I 'LSTFIL,$$GET1^DIQ(52,RXIEN_",","PRIOR FILL DATE",,,)="" Q DSHOLD
; Don't hold if no insurance
I 'IBSTAT!(IBSTAT=-1) Q DSHOLD
;
S DSHDT=$$DSHDT(RXIEN) ; 3/4 of days supply date
I DSHDT>DT S DSHOLD=0 D
. I DSHDT'=$P(PS0,U,14) D ; Update Suspense Hold Date and Activity Log
. . S COMM="3/4 of Days Supply SUSPENSE HOLD until "_$$FMTE^XLFDT(DSHDT,"2D")_"."
. . S DAYSSUP=$$LFDS(RXIEN)
. . D RXACT^PSOBPSU2(RXIEN,RFL,COMM,"S",+$G(DUZ)) ; Update Activity Log
. . S DR="10///^S X=DSHDT",DIE="^PS(52.5,",DA=REC D ^DIE ; File Suspense Hold Date
. . N DA,DIE,DR,PSOX,SFN,INDT,DEAD,RXREC,SUB,XOK,OLD
. . S DA=REC,DIE="^PS(52.5,",DR=".02///"_DSHDT D ^DIE
. . S SFN=REC,DEAD=0,INDT=DSHDT D CHANGE^PSOSUCH1(RXIEN,RFL)
Q DSHOLD
;
;Description: ePharmacy
;This function determines the date that 3/4 of the days supply for the
;last refill will occur.
;Input: RXIEN = Prescription file #52 IEN
;Returns: DATE/TIME value
DSHDT(RXIEN) ;
N RXFIL,FILLDT,DAYSSUP,DSH34
I '$D(^PSRX(RXIEN,0)) Q -1
;S RXFIL=$$LSTRFL^PSOBPSU1(RXIEN) ; Last Refill
S FILLDT=$$LDPFDT(RXIEN) ; Last Dispensed Date or Prior Fill Date for renewal
S DAYSSUP=$$LFDS(RXIEN) ; Days Supply of Last Refill
S DSH34=DAYSSUP*.75 ; 3/4 of Days Supply
Q $$FMADD^XLFDT(FILLDT,DSH34) ; Return today plus 3/4 of Days Supply date
;
;Description:
;This function returns the DAYS SUPPLY for the Latest Fill for a Prescription
;Input: RXIEN = Prescription file #52 IEN
;Returns: DAYS SUPPLY for the latest fill or -1 if RXIEN is not valid
LFDS(RXIEN) ;
N RXFIL
Q:'$D(^PSRX(RXIEN)) -1
S RXFIL=$$LSTRFL^PSOBPSU1(RXIEN)
Q $S(RXFIL=0:$P(^PSRX(RXIEN,0),U,8),1:$P(^PSRX(RXIEN,1,RXFIL,0),U,10))
;
LDPFDT(RXIEN) ; Returns PRIOR FILL DATE if renewal otherwise LAST DISPENSED DATE or -1 if not valid
Q $S('$D(^PSRX(RXIEN)):-1,$$PRFDT(RXIEN):$$PRFDT(RXIEN),1:$$LDT(RXIEN))
;
PRFDT(RXIEN) ; Returns PRIOR FILL DATE in internal format
Q $$GET1^DIQ(52,RXIEN_",","PRIOR FILL DATE","I",,)
;
LDT(RXIEN) ; Returns LAST DISPENSED DATE in internal format
Q $$GET1^DIQ(52,RXIEN_",","LAST DISPENSED DATE","I",,)
;
;Description: ePharmacy API to check for host errors.
;Input: RX = Prescription file #52 IEN
; RFL = Refill number
;Returns: A value of 0 (zero) will be returned when reject codes M6, M8,
;NN, and 99 are present OR if on susp hold which means the prescription should not
;be sent to CMOP. Otherwise, a value of 1(one) will be returned.
DUR(RX,RFL) ;
N REJ,IDX,TXT,CODE,SHOLD,SHCODE,SHDT
S SHOLD=1,IDX=""
I '$D(RFL) S RFL=$$LSTRFL^PSOBPSU1(RX)
S SHDT=$$SHDT(RX,RFL) ; Get suspense hold date for rx/refill
; Add one day to compare to prevent from running just after midnight problem.
I SHDT>$$FMADD^XLFDT(DT,1) Q 0 ; Quit with 0 since still on hold
; If a host reject exists and no previous Susp Hold Date or log entry,
; create the log entry and hold rx/fill.
I $$HOSTREJ(RX,RFL,1),SHDT="" S SHOLD=0 D SHDTLOG(RX,RFL)
Q SHOLD
;
;Description: ePharmacy
;This subroutine checks an RX/FILL for Host Reject Errors returned
;from previous ECME submissions. The host reject errors checked are M6, M8, NN, and 99.
;Note that host reject errors do not pass to the pharmacy reject worklist so it's necessary
;to check ECME for these type errors.
;Input:
; RX = Prescription File IEN
; RFL = Refill
; ONE = Either 1 or 0 - Defaults to 1
; If 1, At least ONE reject code associated with the RX/FILL must
; match either M6, M8, NN, or 99.
; If 0, ALL reject codes must match either M6, M8, NN, or 99
;Return:
; RETV = 1 OR 0
; 1 = host reject exists based on ONE parameter
; 0 = no host rejects exists based on ONE parameter
HOSTREJ(RX,RFL,ONE) ;
Q 0 ;IHS/MSC/PLS - 06/01/2010
N REJ,IDX,TXT,CODE,HRCODE,HRQUIT,RETV
S IDX="",(RETV,HRQUIT)=0
I ONE="" S ONE=1
D DUR1^BPSNCPD3(RX,RFL,.REJ) ; Get reject list from last submission
F S IDX=$O(REJ(IDX)) Q:IDX="" D Q:HRQUIT
. S TXT=$G(REJ(IDX,"REJ CODE LST"))
. F I=1:1:$L(TXT,",") S CODE=$P(TXT,",",I) D Q:HRQUIT
. . F HRCODE="M6","M8","NN",99 D Q:HRQUIT
. . . I CODE=HRCODE S RETV=1 I ONE S HRQUIT=1 Q
. . . I CODE'=HRCODE,RETV=1 S RETV=0,HRQUIT=1 Q
Q RETV
;
;Description: This subroutine sets the EPHARMACY SUSPENSE HOLD DATE field
;for the rx or refill to tomorrow and adds an entry to the SUSPENSE Activity Log.
;Input: RX = Prescription File IEN
; RFL = Refill
SHDTLOG(RX,RFL) ;
N DA,DIE,DR,COMM,SHDT
I '$D(RFL) S RFL=$$LSTRFL^PSOBPSU1(RX)
S SHDT=$$FMADD^XLFDT(DT,1)
S COMM="SUSPENSE HOLD until "_$$FMTE^XLFDT(SHDT,"2D")_" due to host reject error."
I RFL=0 S DA=RX,DIE="^PSRX(",DR="86///"_SHDT D ^DIE
E S DA=RFL,DA(1)=RX,DIE="^PSRX("_DA(1)_",1,",DR="86///"_SHDT D ^DIE
D RXACT^PSOBPSU2(RX,RFL,COMM,"S",+$G(DUZ)) ; Create Activity Log entry
Q
;
;Description: This function returns the EPHARMACY SUSPENSE HOLD DATE field
;for the rx or refill
;Input: RX = Prescription File IEN
; RFL = Refill
SHDT(RX,RFL) ;
N FILE,IENS
I '$D(RFL) S RFL=$$LSTRFL^PSOBPSU1(RX)
S FILE=$S(RFL=0:52,1:52.1),IENS=$S(RFL=0:RX_",",1:RFL_","_RX_",")
Q $$GET1^DIQ(FILE,IENS,86,"I")
;
PSXRPPL2 ;BIR/WPB - Print From Suspense Utilities ;29-Apr-2013 14:01;PLS
+1 ;;2.0;CMOP;**65,1015**;11 Apr 97;Build 62
+2 ;Reference to ^PSRX( supported by DBIA #1977
+3 ;Reference to ^PS(52.5, supported by DBIA #1978
+4 ;Reference to ^PSSLOCK supported by DBIA #2789
+5 ;Reference to ^PSOBPSUT supported by DBIA #4701
+6 ;Reference to ^PSOBPSU1 supported by DBIA #4702
+7 ;Reference to ^PSOBPSU2 supported by DBIA #4970
+8 ;Reference to ^PSOREJUT supported by DBIA #4706
+9 ;Reference to ^PSOREJU3 supported by DBIA #5186
+10 ;Reference to $$DEA^IBNCPDP controlled subscription by IA 4299
+11 ;Reference to CHANGE^PSOSUCH1 suppored by DBIA #5427
+12 ;
+13 ;Modified - IHS/MSC/PLS - 06/01/2010 - Line DSH+1, HOSTREJ+1
+14 ; - 04/29/2013 - Line EPHARM+8
CHKDFN(THRDT) ; use the patient 'C' index under RX multiple in file 550.2 to GET dfn to gather Patients' future RXs
+1 ;Input: THRDT - THROUGH DATE to run CMOP transmission
+2 ;
+3 IF '$DATA(^PSX(550.2,PSXBAT,15,"C"))
QUIT
+4 SET (SBTECME)=0
KILL ^TMP("PSXEPHDFN",$JOB)
+5 SET PSXPTNM=""
FOR
SET PSXPTNM=$ORDER(^PSX(550.2,PSXBAT,15,"C",PSXPTNM))
IF PSXPTNM=""
QUIT
Begin DoDot:1
+6 SET XDFN=0
FOR
SET XDFN=$ORDER(^PSX(550.2,PSXBAT,"15","C",PSXPTNM,XDFN))
IF (XDFN'>0)
QUIT
Begin DoDot:2
+7 SET SDT=PRTDT
FOR
SET SDT=$ORDER(^PS(52.5,"CMP","Q",PSXTYP,PSXTDIV,SDT))
SET NDFN=0
IF (SDT>PSXDTRG)!(SDT="")
QUIT
Begin DoDot:3
+8 FOR
SET NDFN=$ORDER(^PS(52.5,"CMP","Q",PSXTYP,PSXTDIV,SDT,NDFN))
SET REC=0
IF NDFN'>0
QUIT
IF NDFN=XDFN
Begin DoDot:4
+9 FOR
SET REC=$ORDER(^PS(52.5,"CMP","Q",PSXTYP,PSXTDIV,SDT,NDFN,REC))
IF REC'>0
QUIT
Begin DoDot:5
+10 SET (PSOLRX,RX)=+$$GET1^DIQ(52.5,REC,.01,"I")
IF 'RX
QUIT
+11 SET RFL=$$GET1^DIQ(52.5,REC,9,"I")
IF RFL=""
SET RFL=$$LSTRFL^PSOBPSU1(RX)
+12 IF $$XMIT^PSXBPSUT(REC)
Begin DoDot:6
+13 IF SDT>THRDT
IF '$DATA(^TMP("PSXEPHDFN",$JOB,XDFN))
QUIT
+14 IF $$PATCH^XPDUTL("PSO*7.0*148")
Begin DoDot:7
+15 IF $$RETRX^PSOBPSUT(RX,RFL)
IF SDT>DT
QUIT
+16 IF $$DOUBLE^PSXRPPL1(RX,RFL)
QUIT
+17 IF $$FIND^PSOREJUT(RX,RFL,,"79,88")
QUIT
+18 IF '$$RETRX^PSOBPSUT(RX,RFL)
IF '$$ECMESTAT(RX,RFL)
QUIT
+19 IF $$PATCH^XPDUTL("PSO*7.0*289")
IF '$$DUR(RX,RFL)
IF '$$DSH(REC)
QUIT
+20 SET DOS=$$RXFLDT^PSOBPSUT(RX,RFL)
IF DOS>DT
SET DOS=DT
+21 DO ECMESND^PSOBPSU1(RX,RFL,DOS,"PC",,1,,,,.RESP)
+22 IF $$PATCH^XPDUTL("PSO*7.0*287")
IF $$TRISTA^PSOREJU3(RXN,RFL,.RESP,"PC")
SET ^TMP("PSXEPHNB",$JOB,RX,RFL)=$GET(RESP)
+23 IF $DATA(RESP)
IF 'RESP
SET SBTECME=SBTECME+1
+24 SET ^TMP("PSXEPHDFN",$JOB,XDFN)=""
End DoDot:7
End DoDot:6
+25 DO PSOUL^PSSLOCK(PSOLRX)
End DoDot:5
End DoDot:4
End DoDot:3
End DoDot:2
End DoDot:1
+26 KILL ^TMP("PSXEPHDFN",$JOB)
+27 IF SBTECME>0
HANG 60+$SELECT((SBTECME*15)>7200:7200,1:(SBTECME*15))
+28 QUIT
+29 ;
EPHARM ; - ePharmacy checks for third party billing
+1 IF $$DOUBLE^PSXRPPL1(RXN,RFL)
SET EPHQT=1
QUIT
+2 IF $$RETRX^PSOBPSUT(RXN,RFL)
IF SDT>DT
SET EPHQT=1
QUIT
+3 IF $$FIND^PSOREJUT(RXN,RFL,,"79,88")
SET EPHQT=1
QUIT
+4 IF $$PATCH^XPDUTL("PSO*7.0*287")
IF $$TRISTA^PSOREJU3(RXN,RFL,.RESP,"PC")
DO EPH
QUIT
+5 IF $$PATCH^XPDUTL("PSO*7.0*287")
IF $DATA(^TMP("PSXEPHNB",$JOB,RXN,RFL))
DO EPH
QUIT
+6 IF $$STATUS^PSOBPSUT(RXN,RFL)="IN PROGRESS"
DO EPH
QUIT
+7 ;IHS/MSC/PLS - 04/30/13
+8 ;I $$PATCH^XPDUTL("PSO*7.0*289"),'$$DSH(REC) S EPHQT=1 Q
+9 IF $$PATCH^XPDUTL("PSO*7.0*289")
IF '$$DUR(RXN,RFL)
DO EPH
QUIT
+10 QUIT
+11 ;
EPH ; - Store Rx not xmitted to CMOP in XTMP file for MailMan message.
+1 SET ^TMP("PSXEPHIN",$JOB,$$RXSITE^PSOBPSUT(RXN),RXN)=RFL
SET EPHQT=1
+2 QUIT
+3 ;
+4 ;Description:
+5 ;This function checks the Rx's ECME Status to determine if it's acceptable to resubmit
+6 ;based on reject codes associated with a previous submission. If Rx was rejected with
+7 ;host reject errors, and no other rejects exist, then it's OK to resubmit to ECME.
+8 ;Input: RX = Prescription file #52 IEN
+9 ; RFL = Refill number
+10 ;Returns: 1 = OK to resubmit
+11 ;0 = Don't resubmit
ECMESTAT(RX,RFL) ;
+1 IF '$$PATCH^XPDUTL("PSO*7.0*148")
QUIT 0
+2 NEW STATUS
+3 SET STATUS=$$STATUS^PSOBPSUT(RX,RFL)
+4 ; Never submitted before, OK to resubmit
+5 IF STATUS=""
QUIT 1
+6 ; If status other than E REJECTED, don't resubmit
+7 IF STATUS'="E REJECTED"
QUIT 0
+8 ; If only host rejects, quit with 1. Otherwise quit with 0
+9 QUIT $$HOSTREJ(RX,RFL,0)
+10 ;
+11 ;Description:
+12 ;This function determines whether the RX SUSPENSE has a DAYS SUPPLY HOLD
+13 ;condition.
+14 ;Input: REC = Pointer to Suspense file (#52.5)
+15 ;Returns: 1 or 0
+16 ;1 (one) if ¾ of days supply has elapsed.
+17 ;0 (zero) is returned if ¾ of days supply has not elapsed.
+18 ;
DSH(REC) ;ePharmacy API to check for 3/4 days supply hold
+1 ;IHS/MSC/PLS - 06/01/2010
QUIT ""
+2 NEW PSINSUR,PSARR,SHDT,DSHOLD,DSHDT,PS0,COMM,DIE,DA,DR,RXIEN,RFL,DAYSSUP,LSTFIL,PTDFN,IBINS,DRG
+3 NEW DEA,DEAOK,ICD,SFN,SDT
+4 SET DSHOLD=1
SET PS0=^PS(52.5,REC,0)
SET RXIEN=$PIECE(PS0,U,1)
SET RFL=$PIECE(PS0,U,13)
+5 SET LSTFIL=$$LSTRFL^PSOBPSU1(RXIEN)
SET PTDFN=$$GET1^DIQ(52,RXIEN,"2","I")
+6 SET IBSTAT=$$INSUR^IBBAPI(PTDFN,,"E",.IBINS,"1")
SET DRG=$$GET1^DIQ(52,RXIEN,"6","I")
+7 SET (ICD,DEA)=""
SET DEA=$$GET1^DIQ(50,DRG,3)
+8 IF $DATA(^PSRX(RXIEN,"ICD",1,0))
SET ICD=^PSRX(RXIEN,"ICD",1,0)
+9 ;
+10 ; Don't hold Rx where the previous fill was not ebillable
+11 IF $$STATUS^BPSOSRX(RXIEN,LSTFIL-1)=""
QUIT DSHOLD
+12 ; Don't hold when the Rx has SC/EI flagged
+13 IF ICD[1
QUIT DSHOLD
+14 ; Don't hold rx if DEA special Handling code is non billable (i.e. has M or 0 (zero) or I, S, N, and/or 9)) without an E
+15 SET DEAOK=$$DEA^IBNCPDP(DEA)
IF 'DEAOK
QUIT DSHOLD
+16 ; Don't hold for zero fill renewals
+17 IF 'LSTFIL
IF $$GET1^DIQ(52,RXIEN_",","PRIOR FILL DATE",,,)=""
QUIT DSHOLD
+18 ; Don't hold if no insurance
+19 IF 'IBSTAT!(IBSTAT=-1)
QUIT DSHOLD
+20 ;
+21 ; 3/4 of days supply date
SET DSHDT=$$DSHDT(RXIEN)
+22 IF DSHDT>DT
SET DSHOLD=0
Begin DoDot:1
+23 ; Update Suspense Hold Date and Activity Log
IF DSHDT'=$PIECE(PS0,U,14)
Begin DoDot:2
+24 SET COMM="3/4 of Days Supply SUSPENSE HOLD until "_$$FMTE^XLFDT(DSHDT,"2D")_"."
+25 SET DAYSSUP=$$LFDS(RXIEN)
+26 ; Update Activity Log
DO RXACT^PSOBPSU2(RXIEN,RFL,COMM,"S",+$GET(DUZ))
+27 ; File Suspense Hold Date
SET DR="10///^S X=DSHDT"
SET DIE="^PS(52.5,"
SET DA=REC
DO ^DIE
+28 NEW DA,DIE,DR,PSOX,SFN,INDT,DEAD,RXREC,SUB,XOK,OLD
+29 SET DA=REC
SET DIE="^PS(52.5,"
SET DR=".02///"_DSHDT
DO ^DIE
+30 SET SFN=REC
SET DEAD=0
SET INDT=DSHDT
DO CHANGE^PSOSUCH1(RXIEN,RFL)
End DoDot:2
End DoDot:1
+31 QUIT DSHOLD
+32 ;
+33 ;Description: ePharmacy
+34 ;This function determines the date that 3/4 of the days supply for the
+35 ;last refill will occur.
+36 ;Input: RXIEN = Prescription file #52 IEN
+37 ;Returns: DATE/TIME value
DSHDT(RXIEN) ;
+1 NEW RXFIL,FILLDT,DAYSSUP,DSH34
+2 IF '$DATA(^PSRX(RXIEN,0))
QUIT -1
+3 ;S RXFIL=$$LSTRFL^PSOBPSU1(RXIEN) ; Last Refill
+4 ; Last Dispensed Date or Prior Fill Date for renewal
SET FILLDT=$$LDPFDT(RXIEN)
+5 ; Days Supply of Last Refill
SET DAYSSUP=$$LFDS(RXIEN)
+6 ; 3/4 of Days Supply
SET DSH34=DAYSSUP*.75
+7 ; Return today plus 3/4 of Days Supply date
QUIT $$FMADD^XLFDT(FILLDT,DSH34)
+8 ;
+9 ;Description:
+10 ;This function returns the DAYS SUPPLY for the Latest Fill for a Prescription
+11 ;Input: RXIEN = Prescription file #52 IEN
+12 ;Returns: DAYS SUPPLY for the latest fill or -1 if RXIEN is not valid
LFDS(RXIEN) ;
+1 NEW RXFIL
+2 IF '$DATA(^PSRX(RXIEN))
QUIT -1
+3 SET RXFIL=$$LSTRFL^PSOBPSU1(RXIEN)
+4 QUIT $SELECT(RXFIL=0:$PIECE(^PSRX(RXIEN,0),U,8),1:$PIECE(^PSRX(RXIEN,1,RXFIL,0),U,10))
+5 ;
LDPFDT(RXIEN) ; Returns PRIOR FILL DATE if renewal otherwise LAST DISPENSED DATE or -1 if not valid
+1 QUIT $SELECT('$DATA(^PSRX(RXIEN)):-1,$$PRFDT(RXIEN):$$PRFDT(RXIEN),1:$$LDT(RXIEN))
+2 ;
PRFDT(RXIEN) ; Returns PRIOR FILL DATE in internal format
+1 QUIT $$GET1^DIQ(52,RXIEN_",","PRIOR FILL DATE","I",,)
+2 ;
LDT(RXIEN) ; Returns LAST DISPENSED DATE in internal format
+1 QUIT $$GET1^DIQ(52,RXIEN_",","LAST DISPENSED DATE","I",,)
+2 ;
+3 ;Description: ePharmacy API to check for host errors.
+4 ;Input: RX = Prescription file #52 IEN
+5 ; RFL = Refill number
+6 ;Returns: A value of 0 (zero) will be returned when reject codes M6, M8,
+7 ;NN, and 99 are present OR if on susp hold which means the prescription should not
+8 ;be sent to CMOP. Otherwise, a value of 1(one) will be returned.
DUR(RX,RFL) ;
+1 NEW REJ,IDX,TXT,CODE,SHOLD,SHCODE,SHDT
+2 SET SHOLD=1
SET IDX=""
+3 IF '$DATA(RFL)
SET RFL=$$LSTRFL^PSOBPSU1(RX)
+4 ; Get suspense hold date for rx/refill
SET SHDT=$$SHDT(RX,RFL)
+5 ; Add one day to compare to prevent from running just after midnight problem.
+6 ; Quit with 0 since still on hold
IF SHDT>$$FMADD^XLFDT(DT,1)
QUIT 0
+7 ; If a host reject exists and no previous Susp Hold Date or log entry,
+8 ; create the log entry and hold rx/fill.
+9 IF $$HOSTREJ(RX,RFL,1)
IF SHDT=""
SET SHOLD=0
DO SHDTLOG(RX,RFL)
+10 QUIT SHOLD
+11 ;
+12 ;Description: ePharmacy
+13 ;This subroutine checks an RX/FILL for Host Reject Errors returned
+14 ;from previous ECME submissions. The host reject errors checked are M6, M8, NN, and 99.
+15 ;Note that host reject errors do not pass to the pharmacy reject worklist so it's necessary
+16 ;to check ECME for these type errors.
+17 ;Input:
+18 ; RX = Prescription File IEN
+19 ; RFL = Refill
+20 ; ONE = Either 1 or 0 - Defaults to 1
+21 ; If 1, At least ONE reject code associated with the RX/FILL must
+22 ; match either M6, M8, NN, or 99.
+23 ; If 0, ALL reject codes must match either M6, M8, NN, or 99
+24 ;Return:
+25 ; RETV = 1 OR 0
+26 ; 1 = host reject exists based on ONE parameter
+27 ; 0 = no host rejects exists based on ONE parameter
HOSTREJ(RX,RFL,ONE) ;
+1 ;IHS/MSC/PLS - 06/01/2010
QUIT 0
+2 NEW REJ,IDX,TXT,CODE,HRCODE,HRQUIT,RETV
+3 SET IDX=""
SET (RETV,HRQUIT)=0
+4 IF ONE=""
SET ONE=1
+5 ; Get reject list from last submission
DO DUR1^BPSNCPD3(RX,RFL,.REJ)
+6 FOR
SET IDX=$ORDER(REJ(IDX))
IF IDX=""
QUIT
Begin DoDot:1
+7 SET TXT=$GET(REJ(IDX,"REJ CODE LST"))
+8 FOR I=1:1:$LENGTH(TXT,",")
SET CODE=$PIECE(TXT,",",I)
Begin DoDot:2
+9 FOR HRCODE="M6","M8","NN",99
Begin DoDot:3
+10 IF CODE=HRCODE
SET RETV=1
IF ONE
SET HRQUIT=1
QUIT
+11 IF CODE'=HRCODE
IF RETV=1
SET RETV=0
SET HRQUIT=1
QUIT
End DoDot:3
IF HRQUIT
QUIT
End DoDot:2
IF HRQUIT
QUIT
End DoDot:1
IF HRQUIT
QUIT
+12 QUIT RETV
+13 ;
+14 ;Description: This subroutine sets the EPHARMACY SUSPENSE HOLD DATE field
+15 ;for the rx or refill to tomorrow and adds an entry to the SUSPENSE Activity Log.
+16 ;Input: RX = Prescription File IEN
+17 ; RFL = Refill
SHDTLOG(RX,RFL) ;
+1 NEW DA,DIE,DR,COMM,SHDT
+2 IF '$DATA(RFL)
SET RFL=$$LSTRFL^PSOBPSU1(RX)
+3 SET SHDT=$$FMADD^XLFDT(DT,1)
+4 SET COMM="SUSPENSE HOLD until "_$$FMTE^XLFDT(SHDT,"2D")_" due to host reject error."
+5 IF RFL=0
SET DA=RX
SET DIE="^PSRX("
SET DR="86///"_SHDT
DO ^DIE
+6 IF '$TEST
SET DA=RFL
SET DA(1)=RX
SET DIE="^PSRX("_DA(1)_",1,"
SET DR="86///"_SHDT
DO ^DIE
+7 ; Create Activity Log entry
DO RXACT^PSOBPSU2(RX,RFL,COMM,"S",+$GET(DUZ))
+8 QUIT
+9 ;
+10 ;Description: This function returns the EPHARMACY SUSPENSE HOLD DATE field
+11 ;for the rx or refill
+12 ;Input: RX = Prescription File IEN
+13 ; RFL = Refill
SHDT(RX,RFL) ;
+1 NEW FILE,IENS
+2 IF '$DATA(RFL)
SET RFL=$$LSTRFL^PSOBPSU1(RX)
+3 SET FILE=$SELECT(RFL=0:52,1:52.1)
SET IENS=$SELECT(RFL=0:RX_",",1:RFL_","_RX_",")
+4 QUIT $$GET1^DIQ(FILE,IENS,86,"I")
+5 ;
