Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: PSXRPPL2

PSXRPPL2.m

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