PSXRPPL2 ;BIR/WPB - Print From Suspense Utilities ;06/10/08
;;2.0;CMOP;**65,69,73,74,79,81,83,87,91,92,93,95**;11 Apr 97;Build 16
; Reference to ^PSRX( in ICR #1977
; Reference to ^PS(52.5, in ICR #1978
; Reference to ^PSSLOCK in ICR #2789
; Reference to ^PSOBPSUT in ICR #4701
; Reference to ^PSOBPSU1 in ICR #4702
; Reference to ^PSOBPSU2 in ICR #4970
; Reference to ^PSOBPSU4 in ICR #7212
; Reference to ^PSOREJUT in ICR #4706
; Reference to ^PSOREJU3 in ICR #5186
; Reference to CHANGE^PSOSUCH1 in ICR #5427
; Reference to PREVRX^PSOREJP2 in ICR #5912
; Reference to $$BILLABLE^IBNCPDP in ICR #6243
; Reference to LOG^BPSOSL in ICR #6764
; Reference to IEN59^BPSOSRX in ICR #4412
;
; CHKDFN makes a second pass through the suspense queue, looking for
; any additional prescriptions for patients who already have an Rx
; included in the current batch. To accomplish this, it loops through
; all the patients in the batch - ^PSX(550.2,Batch,15,"C",Name,DFN) -
; and then loops through the suspense queue, starting with the day
; after the through date used by SBTECME^PSXRPPL1 and going through
; that date plus the 'look ahead' date in the site parameters (see
; DRIV^PSXRSUS). The logic inside the loops is largely identical to
; that in SBTECME^PSXRPPL1.
;
CHKDFN(THRDT) ;
;Input: THRDT - THROUGH DATE to run CMOP transmission
;
; This procedure assumes the following variables to exist:
; PRTDT = Transmit/Print data through this date
; PSXBAT = Batch, pointer to file#550.2, CMOP Transmission
; PSXDTRG = Pull ahead through date
; PSXTDIV = Division
; PSXTYP = "C" if running for Controlled Substance, "N" otherwise
;
N PSOLRX,PSXPTNM,REC,RESP,RFL,RX,SBTECME,SDT,XDFN
;
; If there are no prescriptions in the current batch, then Quit.
;
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)) Q:(SDT>PSXDTRG)!(SDT="") D
. . . S REC=0
. . . F S REC=$O(^PS(52.5,"CMP","Q",PSXTYP,PSXTDIV,SDT,XDFN,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,943",,1) Q
. . . . . . ;
. . . . . . ; If TRI/CVA and the Rx already has a closed eT/eC
. . . . . . ; pseudo-reject, then do not send another claim.
. . . . . . ;
. . . . . . I $$TRICVANB^PSXRPPL1(RX,RFL) D Q
. . . . . . . D LOG^BPSOSL($$IEN59^BPSOSRX(RX,RFL),$T(+0)_"-CHKDFN, $$TRICVANB returned 1") ; ICR #4412,6764
. . . . . . ;
. . . . . . I '$$RETRX^PSOBPSUT(RX,RFL),'$$ECMESTAT(RX,RFL) Q
. . . . . . I $$PATCH^XPDUTL("PSO*7.0*289") Q:'$$DUR(RX,RFL) ; ePharm Host error hold
. . . . . . I $$PATCH^XPDUTL("PSO*7.0*289") Q:'$$DSH(REC,1) ; ePharm 3/4 days supply
. . . . . . ;
. . . . . . ; ECMESND^PSOBPSU1 initiates the claim submission process.
. . . . . . ;
. . . . . . D ECMESND^PSOBPSU1(RX,RFL,"","PC",,1,,,,.RESP)
. . . . . . ;
. . . . . . D LOG^BPSOSL($$IEN59^BPSOSRX(RX,RFL),$T(+0)_"-CHKDFN, RESP="_$G(RESP)) ; ICR #4412,6764
. . . . . . ;
. . . . . . I $G(RESP)'["IN PROGRESS",$$PATCH^XPDUTL("PSO*7.0*287"),$$TRISTA^PSOREJU3(RX,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 is called only by GETDATA^PSXRPPL. The variable EPHQT is
; Newed in GETDATA. If EPHQT is set to 1 here, then GETDATA does
; not continue processing the current Rx/Fill; this Rx/Fill will
; not be sent to CMOP if EPHQT is set to 1 here.
;
EPHARM ; - ePharmacy checks for third party billing
;
; If CMOP is still processing the previous fill ($$DOUBLE), or if the
; RE-TRANSMIT flag is 'Yes' and the send date is in the future, or if
; this prescription has an unresolved 79,88,943, or RRR reject, then
; Set EPHQT to 1 and Quit. This Rx/Fill will not be sent to CMOP.
;
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,943",,1) S EPHQT=1 Q
;
; If an Open/Unresolved eC/eT reject on claim, don't send to CMOP.
;
I $$ECETREJ(RXN) D EPH Q
;
; $$TRISTA performs checks specific to TRICARE/CHAMPVA. If the claim
; was rejected or is still "IN PROGRESS", or if it is non-billable,
; then add this Rx to the ^TMP("PSXEPHIN") array and quit.
;
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
;
; If the claim is still "IN PROGRESS", then add this Rx to the
; ^TMP("PSXEPHIN") array and quit.
;
I $$STATUS^PSOBPSUT(RXN,RFL)="IN PROGRESS" D EPH Q
;
; If this Prescription violates the 3/4 supply (i.e. if it is too soon
; to refill), then Set EPHQT to 1 and Quit. This Rx/Fill will not be
; sent to CMOP.
;
I $$PATCH^XPDUTL("PSO*7.0*289"),'$$DSH(REC,0) D S EPHQT=1 Q
. D LOG^BPSOSL($$IEN59^BPSOSRX(RXN,RFL),$T(+0)_"-EPHARM, Failed DSH") ; ICR #4412,6764
;
; If there is a host reject for this Rx/Fill, then add this Rx to the
; ^TMP("PSXEPHIN") array and quit.
;
I $$PATCH^XPDUTL("PSO*7.0*289"),'$$DUR(RXN,RFL) D EPH Q
Q
;
; EPH is called only by EPHARM, above. It adds a prescriptions to the
; ^TMP("PSXEPHIN") array. Of those Prescriptions not sent to the CMOP
; facility and left in the suspense queue, some are added to this
; array. Those in this array will be listed in the email sent to users
; indicating that they were left in the queue (see ^PSXBPSMS). That
; email states these Rxs were not transmitted to the CMOP facility
; because either a) a response from the payer was not received, or b)
; the Rx is non-billable.
;
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
;
; ECMESTAT 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 CHDAT,HERR,PSXECET,PSXIEN,PSXREJ,STATUS
;
; If an Open/Unresolved eC/eT reject on claim, don't resubmit
I $$ECETREJ(RX) Q 0
;
S STATUS=$$STATUS^PSOBPSUT(RX,RFL)
; Never submitted before, OK to resubmit
I STATUS=""!(STATUS["UNSTRANDED") Q 1
; If status other than E REJECTED, don't resubmit
I STATUS'="E REJECTED" Q 0
;
; check for a previous host reject:
; 0 - if not expired, don't resubmit
; 1 - if host reject & date expired, allow to resubmit
; 2 - if not defined, allow to continue with evaluation for new host reject
S CHDAT=$$CHHEDT(RX,RFL)
I CHDAT=0 Q 0 ; The host reject has not expired, so do not resubmit.
;
;*****************************************************************************************************
; NOTE: MAKE SURE THAT IGNORED REJECTS WILL PROCESS WHENEVER MODIFICATIONS ARE MADE TO HOST REJECT
; Ignored rejects are handled by default when this subroutine Q 0 at the end.
;*****************************************************************************************************
; check host rejects
S HERR=$$HOSTREJ(RX,RFL,0)
I HERR&(CHDAT=2) D SHDTLOG(RX,RFL) Q 0 ;Host reject and no suspense hold date defined yet; define it and don't resubmit
I HERR&(CHDAT) Q 1 ;Host reject & suspense hold date has expired; resubmit
Q 0 ;NOTE - IF YOU CHANGE THIS Q 0, IGNORED REJECTS WILL RESUBMIT AND REJECT AGAIN WHICH IS VERY BAD.
;
; DSH determines whether a prescription has a 3/4 days supply hold
; condition.
; Input: REC = Pointer to Suspense file (#52.5)
; ACT = 1 or 0, indicating whether an entry should be made
; in the activity log if the 3/4 logic is bypassed.
; Returns: 1 or 0
; 1 (one) if 3/4 of days supply has elapsed.
; 0 (zero) if 3/4 of days supply has not elapsed.
;
DSH(REC,ACT) ;ePharmacy API to check for 3/4 days supply hold
;
N COMM,DA,DAYSSUP,DIE,DR,DSHDT,DSHOLD
N PREVRX,PSARR,PSINSUR,PSXCOMMENT,RFL,RXIEN,SDT,SFN,SHDT
;
S DSHOLD=1
S RXIEN=$$GET1^DIQ(52.5,REC,.01,"I")
S RFL=$$GET1^DIQ(52.5,REC,9,"I")
I RFL="" S RFL=$$LSTRFL^PSOBPSU1(RXIEN)
;
; If the Rx/Fill is not e-billable, then Quit out.
;
I '$$EBILLABLE^PSOSULB2(RXIEN,RFL) Q DSHOLD
;
; If the Bypass 3/4 Day Supply flag is set to "YES", then Quit with
; 1 after adding a comment to the Activity Log.
;
I $$FLAG^PSOBPSU4(RXIEN,RFL)="YES" D Q DSHOLD ; ICR #7212
. I '$G(ACT) Q
. S PSXCOMMENT="3/4 Day Supply logic bypassed during CMOP processing"
. D RXACT^PSOBPSU2(RXIEN,RFL,PSXCOMMENT,"S",DUZ)
. Q
;
S DSHDT=$$DSHDT(RXIEN,RFL) ; 3/4 of days supply date
S PREVRX=$P(DSHDT,U,2)
S DSHDT=$P(DSHDT,U)
I DSHDT>DT S DSHOLD=0 D
. I DSHDT'=$$GET1^DIQ(52.5,REC,10,"I") D ; Update Suspense Hold Date and Activity Log
. . ; If a previous Rx is used in the 3/4 days' supply calculation,
. . ; capture that Rx in the activity log.
. . S COMM="3/4 of Days Supply SUSPENSE HOLD until "_$$FMTE^XLFDT(DSHDT,"2D")
. . I PREVRX'="" S COMM=COMM_" (prior Rx "_PREVRX_")"
. . S COMM=COMM_"."
. . 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,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
. Q
;
Q DSHOLD
;
DSHDT(RXIEN,RFL) ; ePharmacy function to determine the 3/4 of the days supply date
; Input: RXIEN = Prescription file #52 ien
; RFL = fill#
; Returns: DATE value of last date of service plus 3/4 of days supply
; PREVRX = Previous Rx if PREVRX^PSOREJP2 identified one that
; should be used in the 3/4 days' supply calculation.
;
N FILLDT,DAYSSUP,DSH34,PREVRX
I '$D(^PSRX(RXIEN,0)) Q -1
I $G(RFL)="" Q -1
;
D PREVRX^PSOREJP2(RXIEN,RFL,,.FILLDT,.DAYSSUP,.PREVRX)
I FILLDT="" Q -1
;
S DSH34=DAYSSUP*.75 ; 3/4 of Days Supply
S:DSH34["." DSH34=(DSH34+1)\1
; Return last date of service plus 3/4 of Days Supply date
; and the previous Rx used in the calculation, if any.
Q $$FMADD^XLFDT(FILLDT,DSH34)_U_PREVRX
;
; LFDS returns the DAYS SUPPLY for the latest fill for a prescription.
; Input: RXIEN = Prescription file #52 IEN
; Returns: DAYS SUPPLY for the latest fill
; -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))
;
; DUR checks for host errors and the suspense hold date.
; Input:
; RX = Prescription file #52 IEN
; RFL = Refill number
; Returns: A value of 0 (zero) will be returned when reject code M6,
; M8, NN, or 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,SHCODE,SHDT,CHDAT1
S IDX=""
I '$D(RFL) S RFL=$$LSTRFL^PSOBPSU1(RX)
;
; check for a previous host reject:
; 0 - host reject date not expired; don't print
; 1 - host reject date expired; allow to print
; 2 - host reject not define; allow to continue with evaluation
; for new host reject
S CHDAT1=$$CHHEDT(RX,RFL)
I CHDAT1=1 Q 1
I CHDAT1=0 Q 0
;
; If a host reject exists and no previous Susp Hold Date or log entry,
; create the log entry and hold rx/fill.
S HERR=$$HOSTREJ(RX,RFL,1)
I HERR,SHDT="" D SHDTLOG(RX,RFL)
I HERR Q 0
Q 1
;
CHHEDT(RX,RFL) ;
; RX = Prescription File IEN
; RFL = Refill
;Returns:
; 0 = host reject date not expired
; 1 = host reject has expired
; 2 = host reject not defined
;
S SHDT=$$SHDT(RX,RFL) ; Get suspense hold date for rx/refill
I SHDT="" Q 2
I DT'<SHDT Q 1
Q 0
;
; HOSTREJ checks an RX/FILL for Host Reject Errors returned from
; previous ECME submissions. The host reject errors checked are M6,
; M8, NN, and 99. Host reject errors do not pass to the pharmacy
; 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) ;
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
;
; SHDTLOG 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
;
; SHDT returns the EPHARMACY SUSPENSE HOLD DATE field for the rx or
; the 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")
;
;
; ECETREJ checks for open/unresolved eC/eT reject on the Rx
; Input: (r) RX - Prescription IEN
; Output: 0 - No open/unresovled eC/eT Reject on Rx
; 1 - Open/unresolved eC/eT Reject on Rx
ECETREJ(RX) ;
N PSXECET,PSXIEN,PSXREJ
S PSXREJ=0
F PSXECET="eC","eT" S PSXIEN="" D
. F S PSXIEN=$O(^PSRX(RX,"REJ","B",PSXECET,PSXIEN)) Q:'PSXIEN D
. . I $$GET1^DIQ(52.25,PSXIEN_","_RX,9,"I")=0 S PSXREJ=1
Q PSXREJ
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPSXRPPL2 15447 printed Dec 13, 2024@01:44:58 Page 2
PSXRPPL2 ;BIR/WPB - Print From Suspense Utilities ;06/10/08
+1 ;;2.0;CMOP;**65,69,73,74,79,81,83,87,91,92,93,95**;11 Apr 97;Build 16
+2 ; Reference to ^PSRX( in ICR #1977
+3 ; Reference to ^PS(52.5, in ICR #1978
+4 ; Reference to ^PSSLOCK in ICR #2789
+5 ; Reference to ^PSOBPSUT in ICR #4701
+6 ; Reference to ^PSOBPSU1 in ICR #4702
+7 ; Reference to ^PSOBPSU2 in ICR #4970
+8 ; Reference to ^PSOBPSU4 in ICR #7212
+9 ; Reference to ^PSOREJUT in ICR #4706
+10 ; Reference to ^PSOREJU3 in ICR #5186
+11 ; Reference to CHANGE^PSOSUCH1 in ICR #5427
+12 ; Reference to PREVRX^PSOREJP2 in ICR #5912
+13 ; Reference to $$BILLABLE^IBNCPDP in ICR #6243
+14 ; Reference to LOG^BPSOSL in ICR #6764
+15 ; Reference to IEN59^BPSOSRX in ICR #4412
+16 ;
+17 ; CHKDFN makes a second pass through the suspense queue, looking for
+18 ; any additional prescriptions for patients who already have an Rx
+19 ; included in the current batch. To accomplish this, it loops through
+20 ; all the patients in the batch - ^PSX(550.2,Batch,15,"C",Name,DFN) -
+21 ; and then loops through the suspense queue, starting with the day
+22 ; after the through date used by SBTECME^PSXRPPL1 and going through
+23 ; that date plus the 'look ahead' date in the site parameters (see
+24 ; DRIV^PSXRSUS). The logic inside the loops is largely identical to
+25 ; that in SBTECME^PSXRPPL1.
+26 ;
CHKDFN(THRDT) ;
+1 ;Input: THRDT - THROUGH DATE to run CMOP transmission
+2 ;
+3 ; This procedure assumes the following variables to exist:
+4 ; PRTDT = Transmit/Print data through this date
+5 ; PSXBAT = Batch, pointer to file#550.2, CMOP Transmission
+6 ; PSXDTRG = Pull ahead through date
+7 ; PSXTDIV = Division
+8 ; PSXTYP = "C" if running for Controlled Substance, "N" otherwise
+9 ;
+10 NEW PSOLRX,PSXPTNM,REC,RESP,RFL,RX,SBTECME,SDT,XDFN
+11 ;
+12 ; If there are no prescriptions in the current batch, then Quit.
+13 ;
+14 IF '$DATA(^PSX(550.2,PSXBAT,15,"C"))
QUIT
+15 ;
+16 SET SBTECME=0
+17 KILL ^TMP("PSXEPHDFN",$JOB)
+18 SET PSXPTNM=""
+19 FOR
SET PSXPTNM=$ORDER(^PSX(550.2,PSXBAT,15,"C",PSXPTNM))
if PSXPTNM=""
QUIT
Begin DoDot:1
+20 SET XDFN=0
+21 FOR
SET XDFN=$ORDER(^PSX(550.2,PSXBAT,"15","C",PSXPTNM,XDFN))
if (XDFN'>0)
QUIT
Begin DoDot:2
+22 SET SDT=PRTDT
+23 FOR
SET SDT=$ORDER(^PS(52.5,"CMP","Q",PSXTYP,PSXTDIV,SDT))
if (SDT>PSXDTRG)!(SDT="")
QUIT
Begin DoDot:3
+24 SET REC=0
+25 FOR
SET REC=$ORDER(^PS(52.5,"CMP","Q",PSXTYP,PSXTDIV,SDT,XDFN,REC))
if REC'>0
QUIT
Begin DoDot:4
+26 SET (PSOLRX,RX)=+$$GET1^DIQ(52.5,REC,.01,"I")
IF 'RX
QUIT
+27 SET RFL=$$GET1^DIQ(52.5,REC,9,"I")
IF RFL=""
SET RFL=$$LSTRFL^PSOBPSU1(RX)
+28 IF $$XMIT^PSXBPSUT(REC)
Begin DoDot:5
+29 IF SDT>THRDT
IF '$DATA(^TMP("PSXEPHDFN",$JOB,XDFN))
QUIT
+30 IF $$PATCH^XPDUTL("PSO*7.0*148")
Begin DoDot:6
+31 IF $$RETRX^PSOBPSUT(RX,RFL)
IF SDT>DT
QUIT
+32 IF $$DOUBLE^PSXRPPL1(RX,RFL)
QUIT
+33 IF $$FIND^PSOREJUT(RX,RFL,,"79,88,943",,1)
QUIT
+34 ;
+35 ; If TRI/CVA and the Rx already has a closed eT/eC
+36 ; pseudo-reject, then do not send another claim.
+37 ;
+38 IF $$TRICVANB^PSXRPPL1(RX,RFL)
Begin DoDot:7
+39 ; ICR #4412,6764
DO LOG^BPSOSL($$IEN59^BPSOSRX(RX,RFL),$TEXT(+0)_"-CHKDFN, $$TRICVANB returned 1")
End DoDot:7
QUIT
+40 ;
+41 IF '$$RETRX^PSOBPSUT(RX,RFL)
IF '$$ECMESTAT(RX,RFL)
QUIT
+42 ; ePharm Host error hold
IF $$PATCH^XPDUTL("PSO*7.0*289")
if '$$DUR(RX,RFL)
QUIT
+43 ; ePharm 3/4 days supply
IF $$PATCH^XPDUTL("PSO*7.0*289")
if '$$DSH(REC,1)
QUIT
+44 ;
+45 ; ECMESND^PSOBPSU1 initiates the claim submission process.
+46 ;
+47 DO ECMESND^PSOBPSU1(RX,RFL,"","PC",,1,,,,.RESP)
+48 ;
+49 ; ICR #4412,6764
DO LOG^BPSOSL($$IEN59^BPSOSRX(RX,RFL),$TEXT(+0)_"-CHKDFN, RESP="_$GET(RESP))
+50 ;
+51 IF $GET(RESP)'["IN PROGRESS"
IF $$PATCH^XPDUTL("PSO*7.0*287")
IF $$TRISTA^PSOREJU3(RX,RFL,.RESP,"PC")
SET ^TMP("PSXEPHNB",$JOB,RX,RFL)=$GET(RESP)
+52 ;
+53 IF $DATA(RESP)
IF 'RESP
SET SBTECME=SBTECME+1
+54 SET ^TMP("PSXEPHDFN",$JOB,XDFN)=""
End DoDot:6
End DoDot:5
+55 DO PSOUL^PSSLOCK(PSOLRX)
End DoDot:4
End DoDot:3
End DoDot:2
End DoDot:1
+56 KILL ^TMP("PSXEPHDFN",$JOB)
+57 IF SBTECME>0
HANG 60+$SELECT((SBTECME*15)>7200:7200,1:(SBTECME*15))
+58 QUIT
+59 ;
+60 ; EPHARM is called only by GETDATA^PSXRPPL. The variable EPHQT is
+61 ; Newed in GETDATA. If EPHQT is set to 1 here, then GETDATA does
+62 ; not continue processing the current Rx/Fill; this Rx/Fill will
+63 ; not be sent to CMOP if EPHQT is set to 1 here.
+64 ;
EPHARM ; - ePharmacy checks for third party billing
+1 ;
+2 ; If CMOP is still processing the previous fill ($$DOUBLE), or if the
+3 ; RE-TRANSMIT flag is 'Yes' and the send date is in the future, or if
+4 ; this prescription has an unresolved 79,88,943, or RRR reject, then
+5 ; Set EPHQT to 1 and Quit. This Rx/Fill will not be sent to CMOP.
+6 ;
+7 IF $$DOUBLE^PSXRPPL1(RXN,RFL)
SET EPHQT=1
QUIT
+8 IF $$RETRX^PSOBPSUT(RXN,RFL)
IF SDT>DT
SET EPHQT=1
QUIT
+9 IF $$FIND^PSOREJUT(RXN,RFL,,"79,88,943",,1)
SET EPHQT=1
QUIT
+10 ;
+11 ; If an Open/Unresolved eC/eT reject on claim, don't send to CMOP.
+12 ;
+13 IF $$ECETREJ(RXN)
DO EPH
QUIT
+14 ;
+15 ; $$TRISTA performs checks specific to TRICARE/CHAMPVA. If the claim
+16 ; was rejected or is still "IN PROGRESS", or if it is non-billable,
+17 ; then add this Rx to the ^TMP("PSXEPHIN") array and quit.
+18 ;
+19 IF $$PATCH^XPDUTL("PSO*7.0*287")
IF $$TRISTA^PSOREJU3(RXN,RFL,.RESP,"PC")
DO EPH
QUIT
+20 IF $$PATCH^XPDUTL("PSO*7.0*287")
IF $DATA(^TMP("PSXEPHNB",$JOB,RXN,RFL))
DO EPH
QUIT
+21 ;
+22 ; If the claim is still "IN PROGRESS", then add this Rx to the
+23 ; ^TMP("PSXEPHIN") array and quit.
+24 ;
+25 IF $$STATUS^PSOBPSUT(RXN,RFL)="IN PROGRESS"
DO EPH
QUIT
+26 ;
+27 ; If this Prescription violates the 3/4 supply (i.e. if it is too soon
+28 ; to refill), then Set EPHQT to 1 and Quit. This Rx/Fill will not be
+29 ; sent to CMOP.
+30 ;
+31 IF $$PATCH^XPDUTL("PSO*7.0*289")
IF '$$DSH(REC,0)
Begin DoDot:1
+32 ; ICR #4412,6764
DO LOG^BPSOSL($$IEN59^BPSOSRX(RXN,RFL),$TEXT(+0)_"-EPHARM, Failed DSH")
End DoDot:1
SET EPHQT=1
QUIT
+33 ;
+34 ; If there is a host reject for this Rx/Fill, then add this Rx to the
+35 ; ^TMP("PSXEPHIN") array and quit.
+36 ;
+37 IF $$PATCH^XPDUTL("PSO*7.0*289")
IF '$$DUR(RXN,RFL)
DO EPH
QUIT
+38 QUIT
+39 ;
+40 ; EPH is called only by EPHARM, above. It adds a prescriptions to the
+41 ; ^TMP("PSXEPHIN") array. Of those Prescriptions not sent to the CMOP
+42 ; facility and left in the suspense queue, some are added to this
+43 ; array. Those in this array will be listed in the email sent to users
+44 ; indicating that they were left in the queue (see ^PSXBPSMS). That
+45 ; email states these Rxs were not transmitted to the CMOP facility
+46 ; because either a) a response from the payer was not received, or b)
+47 ; the Rx is non-billable.
+48 ;
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 ; ECMESTAT checks the Rx's ECME Status to determine if it's acceptable
+5 ; to resubmit based on reject codes associated with a previous
+6 ; submission. If Rx was rejected with host reject errors, and no other
+7 ; rejects exist, then it's OK to resubmit to ECME.
+8 ; Input:
+9 ; RX = Prescription file #52 IEN
+10 ; RFL = Refill number
+11 ; Returns:
+12 ; 1 = OK to resubmit
+13 ; 0 = Don't resubmit
+14 ;
ECMESTAT(RX,RFL) ;
+1 IF '$$PATCH^XPDUTL("PSO*7.0*148")
QUIT 0
+2 NEW CHDAT,HERR,PSXECET,PSXIEN,PSXREJ,STATUS
+3 ;
+4 ; If an Open/Unresolved eC/eT reject on claim, don't resubmit
+5 IF $$ECETREJ(RX)
QUIT 0
+6 ;
+7 SET STATUS=$$STATUS^PSOBPSUT(RX,RFL)
+8 ; Never submitted before, OK to resubmit
+9 IF STATUS=""!(STATUS["UNSTRANDED")
QUIT 1
+10 ; If status other than E REJECTED, don't resubmit
+11 IF STATUS'="E REJECTED"
QUIT 0
+12 ;
+13 ; check for a previous host reject:
+14 ; 0 - if not expired, don't resubmit
+15 ; 1 - if host reject & date expired, allow to resubmit
+16 ; 2 - if not defined, allow to continue with evaluation for new host reject
+17 SET CHDAT=$$CHHEDT(RX,RFL)
+18 ; The host reject has not expired, so do not resubmit.
IF CHDAT=0
QUIT 0
+19 ;
+20 ;*****************************************************************************************************
+21 ; NOTE: MAKE SURE THAT IGNORED REJECTS WILL PROCESS WHENEVER MODIFICATIONS ARE MADE TO HOST REJECT
+22 ; Ignored rejects are handled by default when this subroutine Q 0 at the end.
+23 ;*****************************************************************************************************
+24 ; check host rejects
+25 SET HERR=$$HOSTREJ(RX,RFL,0)
+26 ;Host reject and no suspense hold date defined yet; define it and don't resubmit
IF HERR&(CHDAT=2)
DO SHDTLOG(RX,RFL)
QUIT 0
+27 ;Host reject & suspense hold date has expired; resubmit
IF HERR&(CHDAT)
QUIT 1
+28 ;NOTE - IF YOU CHANGE THIS Q 0, IGNORED REJECTS WILL RESUBMIT AND REJECT AGAIN WHICH IS VERY BAD.
QUIT 0
+29 ;
+30 ; DSH determines whether a prescription has a 3/4 days supply hold
+31 ; condition.
+32 ; Input: REC = Pointer to Suspense file (#52.5)
+33 ; ACT = 1 or 0, indicating whether an entry should be made
+34 ; in the activity log if the 3/4 logic is bypassed.
+35 ; Returns: 1 or 0
+36 ; 1 (one) if 3/4 of days supply has elapsed.
+37 ; 0 (zero) if 3/4 of days supply has not elapsed.
+38 ;
DSH(REC,ACT) ;ePharmacy API to check for 3/4 days supply hold
+1 ;
+2 NEW COMM,DA,DAYSSUP,DIE,DR,DSHDT,DSHOLD
+3 NEW PREVRX,PSARR,PSINSUR,PSXCOMMENT,RFL,RXIEN,SDT,SFN,SHDT
+4 ;
+5 SET DSHOLD=1
+6 SET RXIEN=$$GET1^DIQ(52.5,REC,.01,"I")
+7 SET RFL=$$GET1^DIQ(52.5,REC,9,"I")
+8 IF RFL=""
SET RFL=$$LSTRFL^PSOBPSU1(RXIEN)
+9 ;
+10 ; If the Rx/Fill is not e-billable, then Quit out.
+11 ;
+12 IF '$$EBILLABLE^PSOSULB2(RXIEN,RFL)
QUIT DSHOLD
+13 ;
+14 ; If the Bypass 3/4 Day Supply flag is set to "YES", then Quit with
+15 ; 1 after adding a comment to the Activity Log.
+16 ;
+17 ; ICR #7212
IF $$FLAG^PSOBPSU4(RXIEN,RFL)="YES"
Begin DoDot:1
+18 IF '$GET(ACT)
QUIT
+19 SET PSXCOMMENT="3/4 Day Supply logic bypassed during CMOP processing"
+20 DO RXACT^PSOBPSU2(RXIEN,RFL,PSXCOMMENT,"S",DUZ)
+21 QUIT
End DoDot:1
QUIT DSHOLD
+22 ;
+23 ; 3/4 of days supply date
SET DSHDT=$$DSHDT(RXIEN,RFL)
+24 SET PREVRX=$PIECE(DSHDT,U,2)
+25 SET DSHDT=$PIECE(DSHDT,U)
+26 IF DSHDT>DT
SET DSHOLD=0
Begin DoDot:1
+27 ; Update Suspense Hold Date and Activity Log
IF DSHDT'=$$GET1^DIQ(52.5,REC,10,"I")
Begin DoDot:2
+28 ; If a previous Rx is used in the 3/4 days' supply calculation,
+29 ; capture that Rx in the activity log.
+30 SET COMM="3/4 of Days Supply SUSPENSE HOLD until "_$$FMTE^XLFDT(DSHDT,"2D")
+31 IF PREVRX'=""
SET COMM=COMM_" (prior Rx "_PREVRX_")"
+32 SET COMM=COMM_"."
+33 SET DAYSSUP=$$LFDS(RXIEN)
+34 ; Update Activity Log
DO RXACT^PSOBPSU2(RXIEN,RFL,COMM,"S",+$GET(DUZ))
+35 ; File Suspense Hold Date
SET DR="10///^S X=DSHDT"
SET DIE="^PS(52.5,"
SET DA=REC
DO ^DIE
+36 NEW DA,DIE,DR,PSOX,SFN,INDT,DEAD,SUB,XOK,OLD
+37 SET DA=REC
SET DIE="^PS(52.5,"
SET DR=".02///"_DSHDT
DO ^DIE
+38 SET SFN=REC
SET DEAD=0
SET INDT=DSHDT
DO CHANGE^PSOSUCH1(RXIEN,RFL)
+39 QUIT
End DoDot:2
+40 QUIT
End DoDot:1
+41 ;
+42 QUIT DSHOLD
+43 ;
DSHDT(RXIEN,RFL) ; ePharmacy function to determine the 3/4 of the days supply date
+1 ; Input: RXIEN = Prescription file #52 ien
+2 ; RFL = fill#
+3 ; Returns: DATE value of last date of service plus 3/4 of days supply
+4 ; PREVRX = Previous Rx if PREVRX^PSOREJP2 identified one that
+5 ; should be used in the 3/4 days' supply calculation.
+6 ;
+7 NEW FILLDT,DAYSSUP,DSH34,PREVRX
+8 IF '$DATA(^PSRX(RXIEN,0))
QUIT -1
+9 IF $GET(RFL)=""
QUIT -1
+10 ;
+11 DO PREVRX^PSOREJP2(RXIEN,RFL,,.FILLDT,.DAYSSUP,.PREVRX)
+12 IF FILLDT=""
QUIT -1
+13 ;
+14 ; 3/4 of Days Supply
SET DSH34=DAYSSUP*.75
+15 if DSH34["."
SET DSH34=(DSH34+1)\1
+16 ; Return last date of service plus 3/4 of Days Supply date
+17 ; and the previous Rx used in the calculation, if any.
+18 QUIT $$FMADD^XLFDT(FILLDT,DSH34)_U_PREVRX
+19 ;
+20 ; LFDS returns the DAYS SUPPLY for the latest fill for a prescription.
+21 ; Input: RXIEN = Prescription file #52 IEN
+22 ; Returns: DAYS SUPPLY for the latest fill
+23 ; -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 ;
+6 ; DUR checks for host errors and the suspense hold date.
+7 ; Input:
+8 ; RX = Prescription file #52 IEN
+9 ; RFL = Refill number
+10 ; Returns: A value of 0 (zero) will be returned when reject code M6,
+11 ; M8, NN, or 99 are present OR if on susp hold which means the
+12 ; prescription should not be sent to CMOP.
+13 ; Otherwise, a value of 1(one) will be returned.
DUR(RX,RFL) ;
+1 NEW REJ,IDX,TXT,CODE,SHCODE,SHDT,CHDAT1
+2 SET IDX=""
+3 IF '$DATA(RFL)
SET RFL=$$LSTRFL^PSOBPSU1(RX)
+4 ;
+5 ; check for a previous host reject:
+6 ; 0 - host reject date not expired; don't print
+7 ; 1 - host reject date expired; allow to print
+8 ; 2 - host reject not define; allow to continue with evaluation
+9 ; for new host reject
+10 SET CHDAT1=$$CHHEDT(RX,RFL)
+11 IF CHDAT1=1
QUIT 1
+12 IF CHDAT1=0
QUIT 0
+13 ;
+14 ; If a host reject exists and no previous Susp Hold Date or log entry,
+15 ; create the log entry and hold rx/fill.
+16 SET HERR=$$HOSTREJ(RX,RFL,1)
+17 IF HERR
IF SHDT=""
DO SHDTLOG(RX,RFL)
+18 IF HERR
QUIT 0
+19 QUIT 1
+20 ;
CHHEDT(RX,RFL) ;
+1 ; RX = Prescription File IEN
+2 ; RFL = Refill
+3 ;Returns:
+4 ; 0 = host reject date not expired
+5 ; 1 = host reject has expired
+6 ; 2 = host reject not defined
+7 ;
+8 ; Get suspense hold date for rx/refill
SET SHDT=$$SHDT(RX,RFL)
+9 IF SHDT=""
QUIT 2
+10 IF DT'<SHDT
QUIT 1
+11 QUIT 0
+12 ;
+13 ; HOSTREJ checks an RX/FILL for Host Reject Errors returned from
+14 ; previous ECME submissions. The host reject errors checked are M6,
+15 ; M8, NN, and 99. Host reject errors do not pass to the pharmacy
+16 ; worklist so it's necessary 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 NEW REJ,IDX,TXT,CODE,HRCODE,HRQUIT,RETV
+2 SET IDX=""
SET (RETV,HRQUIT)=0
+3 IF ONE=""
SET ONE=1
+4 ; Get reject list from last submission
DO DUR1^BPSNCPD3(RX,RFL,.REJ)
+5 FOR
SET IDX=$ORDER(REJ(IDX))
if IDX=""
QUIT
Begin DoDot:1
+6 SET TXT=$GET(REJ(IDX,"REJ CODE LST"))
+7 FOR I=1:1:$LENGTH(TXT,",")
SET CODE=$PIECE(TXT,",",I)
Begin DoDot:2
+8 FOR HRCODE="M6","M8","NN",99
Begin DoDot:3
+9 IF CODE=HRCODE
SET RETV=1
IF ONE
SET HRQUIT=1
QUIT
+10 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
+11 QUIT RETV
+12 ;
+13 ; SHDTLOG sets the EPHARMACY SUSPENSE HOLD DATE field for the rx or
+14 ; refill to tomorrow and adds an entry to the SUSPENSE Activity Log.
+15 ; Input: RX = Prescription File IEN
+16 ; 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 ; SHDT returns the EPHARMACY SUSPENSE HOLD DATE field for the rx or
+11 ; the 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 ;
+6 ;
+7 ; ECETREJ checks for open/unresolved eC/eT reject on the Rx
+8 ; Input: (r) RX - Prescription IEN
+9 ; Output: 0 - No open/unresovled eC/eT Reject on Rx
+10 ; 1 - Open/unresolved eC/eT Reject on Rx
ECETREJ(RX) ;
+1 NEW PSXECET,PSXIEN,PSXREJ
+2 SET PSXREJ=0
+3 FOR PSXECET="eC","eT"
SET PSXIEN=""
Begin DoDot:1
+4 FOR
SET PSXIEN=$ORDER(^PSRX(RX,"REJ","B",PSXECET,PSXIEN))
if 'PSXIEN
QUIT
Begin DoDot:2
+5 IF $$GET1^DIQ(52.25,PSXIEN_","_RX,9,"I")=0
SET PSXREJ=1
End DoDot:2
End DoDot:1
+6 QUIT PSXREJ
+7 ;