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

PSORREF.m

Go to the documentation of this file.
  1. PSORREF ;AITC/BWF - Remote RX retrieval API ;12/12/16 3:21pm
  1. ;;7.0;OUTPATIENT PHARMACY;**454,475,497,643,740**;DEC 1997;Build 18
  1. ;
  1. Q
  1. ; RET - return data
  1. ; RXNUM - RX Number from remote system
  1. ; FDATE - Fill Date
  1. ; MW - Mail/Window - Default of 'W' for now.
  1. ; RPHARM - Pharmacist from remote site
  1. ; RPHONE - Contact number
  1. ; RSITE - Filling site number
  1. ;
  1. REMREF(RET,RXNUM,FDATE,MW,RPHARM,RPHONE,RSITE,RX0,RX2,RXSTA,RPROV,RSIG,RREF0,ROR1,RX3) ;
  1. ;
  1. N MSG,BACK,PSOPAR,RRXIEN,PSOSIEN,DSUPP,LASTREF,XTMPLOC,PASSLOC,HFSIEN,FULLPTH,HFSDONE,PTHDAT,PTHPIECE,FOUND,STRT,STATION,FTGOPEN,PPL1,PSOSITE
  1. N PSOX,PTHFILE,SITENUM,X,X1,X2,HDRUG,CSVAL,PSISSDT,TFILLS,OFFSET,CHKDT,DINACT,DEL,FTGSTRT,PDIR,PFIL,PSODTCUT,PSOEXREP,PSOPHDUZ
  1. N PSODFDIR,PSOFNAME,PAR,DELARR,RREFIEN
  1. N PSOBBC,PSOBBC1,PSODIR,PSOMVH,CLOZVAL,NOONEVA
  1. ; check 3rd party payer rejects. Send message to initiating site if applicable.
  1. S $ETRAP="D ^%ZTER Q"
  1. S RET(0)=""
  1. S RRXIEN=$O(^PSRX("B",RXNUM,0)),PSOSIEN=$$GET1^DIQ(52,RRXIEN,20,"I")
  1. I '$$GET1^DIQ(59.7,1,101,"I") D Q
  1. .S RET(1)="The OneVA pharmacy flag is turned 'OFF' at this facility."
  1. .S RET(2)="Unable to process refill/partial fill requests."
  1. .D RET0
  1. ; PSO*7*497 - trade name block/titration block
  1. I $$GET1^DIQ(52,RRXIEN,6.5,"E")]"" D Q
  1. .D RET0
  1. .S RET(1)="This prescription cannot be refilled or partial filled because it has a value"
  1. .S RET(2)="entered in the Rx trade name field. Please follow local policy for obtaining"
  1. .S RET(3)="a new prescription."
  1. I $$TITRX^PSOUTL(RRXIEN)="t" S RET(1)="Cannot refill prescription - type is Titration. You may request a partial fill." D RET0 Q
  1. ; PSO*7*497 - end trade name/titration block
  1. S PSOPHDUZ=$$GET1^DIQ(52,RRXIEN,23,"I") I 'PSOPHDUZ S PSOPHDUZ=.5
  1. S HDRUG=$$GET1^DIQ(52,RRXIEN,6,"I")
  1. I '$$VALIDDRUG(HDRUG) D RET0 Q ;Validate entry in file 50
  1. S PSOPAR=$G(^PS(59,PSOSIEN,1)),PSOSITE=PSOSIEN
  1. S RPHONE=$G(RPHONE,"")
  1. ; check to see if this action will throw the prescription into suspense. If so, quit and return a message
  1. S DSUPP=$$GET1^DIQ(52,RRXIEN,8,"I")
  1. S X2=-120,X1=DT D C^%DTC S PSODTCUT=X
  1. S (PSODFN,PSOREF("PSODFN"))=$$GET1^DIQ(52,RRXIEN,2,"I") K PSOSD D ^PSOBUILD
  1. N RXN K PSORX("FILL DATE") S PSOFROM="REFILL" S PSOREF("DFLG")=0,PSOREF("IRXN")=$O(^PSRX("B",RXNUM,0)),PSOREF("QFLG")=0
  1. I $$LMREJ^PSOREJU1(RXNUM,,.MSG,.BACK) S RET(1)=MSG D RET0 Q
  1. S PSORX("FILL DATE")=FDATE
  1. K PSOID D START^PSORREF1(FDATE) I PSOREF("DFLG") D EOJ Q
  1. ; check ability to refill given issue date/days supply
  1. S PSISSDT=$$GET1^DIQ(52,RRXIEN,1,"I")
  1. S TFILLS=$O(^PSRX(RRXIEN,1,"A"),-1)+1
  1. S OFFSET=DSUPP*TFILLS,OFFSET=OFFSET-10
  1. S CHKDT=$$FMADD^XLFDT(PSISSDT,OFFSET)
  1. I PSORX("FILL DATE")<CHKDT D RET0 S RET(1)="Cannot refill Rx# "_RXNUM_". Next possible fill date is "_$$FMTE^XLFDT(CHKDT,"5D") Q
  1. I PSORX("FILL DATE")>$$GET1^DIQ(52,RRXIEN,26,"I") D RET0 S RET(1)="Cannot refill Rx# "_RXNUM_".",RET(2)="Cannot refill after expiration date "_$$GET1^DIQ(52,RRXIEN,11,"E") Q
  1. D PROCESS^PSORREF0(.RET)
  1. ; make sure not errors are returned
  1. I $D(RET(1)) D EOJ Q
  1. I '$D(RET(1)) D
  1. .; bwf 8/14/14 - set up needed variables for label printing
  1. .S PSODFN=$P(^PSRX(RRXIEN,0),U,2)
  1. .S PSORX("IRXN")=RXNUM
  1. .S PSORX("PSOL",1)=RRXIEN_","
  1. .S PSORX("MAIL/WINDOW")="WINDOW"
  1. .S PSORX("NAME")=$$GET1^DIQ(2,PSODFN,.01)
  1. .S PSORX("QFLG")=0
  1. .S PSORX("METHOD OF PICKUP")=""
  1. .S PSOX=$G(^PS(55,PSODFN,"PS")) I PSOX]"" S PSORX("PATIENT STATUS")=$P($G(^PS(53,PSOX,0)),"^")
  1. .S PPL1=RRXIEN
  1. .; bwf 8/14/14 - end setup for label printing.
  1. .S PSODFDIR=$$DEFDIR^%ZISH()
  1. .S PSOFNAME="PSOLBL_"_RXNUM_"_"_PSOSITE_"_"_DT_".DAT"
  1. .S FULLPTH=PSODFDIR_PSOFNAME
  1. .S HFSDONE=0,PTHDAT=""
  1. .; preserve IO
  1. .D SAVDEV^%ZISUTL("ONEVAHLIO")
  1. .S DELARR("PSOLBL_"_RXNUM_"_"_PSOSITE_"_"_DT_".DAT")="" S DEL=$$DEL^%ZISH(PSODFDIR,$NA(DELARR))
  1. .S PSOEXREP=1
  1. .; call out to generate label
  1. .D LABEL^PSORWRAP(RRXIEN,"HFS",PSOSITE,PSOPHDUZ,"",PSOFNAME)
  1. .S XTMPLOC="^XTMP(""PSORLBL"","_HLINSTN_","_+RXNUM_",1,0)"
  1. .S PASSLOC="XTMP(""PSORLBL"","_HLINSTN_","_+RXNUM_")"
  1. .K ^XTMP("PSORLBL",HLINSTN,+RXNUM,0)
  1. .S ^XTMP("PSORLBL",HLINSTN,+RXNUM,0)=DT_U_$$FMADD^XLFDT(DT,30)
  1. .; looks like we have to wait a moment before the file shows up.
  1. .S FTGSTRT=$$NOW^XLFDT,(FOUND,FTGOPEN)=0
  1. .N PAR S PAR=0
  1. .F D Q:$$NOW^XLFDT>$$FMADD^XLFDT(FTGSTRT,,,,15)!(FOUND)!(FTGOPEN)
  1. ..S FTGOPEN=$$FTG^%ZISH(PSODFDIR,PSOFNAME,XTMPLOC,4)
  1. ..I $O(^XTMP("PSORLBL",HLINSTN,+RXNUM,0)) S FOUND=1
  1. .S DELARR("PSOLBL_"_RXNUM_"_"_PSOSITE_"_"_DT_".DAT")="" S DEL=$$DEL^%ZISH(PSODFDIR,$NA(DELARR))
  1. .; restore IO
  1. .D USE^%ZISUTL("ONEVAHLIO"),RMDEV^%ZISUTL("ONEVAHLIO")
  1. .D UPDREF(.RET,RRXIEN,RPHARM,RPHONE,RSITE,PASSLOC)
  1. .S RET(1)="Rx # "_RXNUM_" refilled."
  1. .S RX0=$G(^PSRX(RRXIEN,0)),RX2=$G(^PSRX(RRXIEN,2)),RX3=$G(^PSRX(RRXIEN,3))
  1. .S RXSTA=$G(^PSRX(RRXIEN,"STA")),RPROV=$$GET1^DIQ(200,$P(RX0,U,4),.01,"E")_U_$$GET1^DIQ(200,$P(RX0,U,16),.01,"E")
  1. .S RSIG=$G(^PSRX(RRXIEN,"SIG"))
  1. .S RREFIEN=$O(^PSRX(RRXIEN,1,"A"),-1)
  1. .I RREFIEN S RREF0=$G(^PSRX(RRXIEN,1,RREFIEN,0))
  1. .S ROR1=$G(^PSRX(RRXIEN,"OR1"))
  1. D EOJ
  1. Q
  1. VALIDDRUG(DRUGIEN) ;
  1. S DINACT=$$GET1^DIQ(50,DRUGIEN,100,"I")
  1. I DINACT>0,($$DT^XLFDT>DINACT) S RET(1)="Drug is inactive for Rx# "_RXNUM_". Cannot refill." D RET0 Q 0
  1. S CSVAL=$$GET1^DIQ(50,DRUGIEN,3,"E"),CSVAL=$E(CSVAL,1)
  1. I CSVAL,CSVAL>0,CSVAL<6 D RET0 S RET(1)="Rx #"_RXNUM_" cannot be refilled.",RET(2)="The associated drug is considered a controlled substance",RET(3)="at the host facility." Q 0
  1. S CLOZVAL=$$GET1^DIQ(50,DRUGIEN,17.5) ; Clozapine Check PSO*7*740
  1. I CLOZVAL="PSOCLO1" S RET(1)="This is a Clozapine prescription.",RET(2)="Cannot refill Rx # "_RXNUM_"." Q 0
  1. ;
  1. S NOONEVA=$$GET1^DIQ(50,DRUGIEN,907)
  1. I NOONEVA="YES" S RET(1)="Remote Site Drug is restricted from OneVA Pharmacy processing.",RET(2)="Cannot refill Rx # "_RXNUM_"." Q 0
  1. Q 1
  1. EOJ ;
  1. D RET0
  1. K PSOMSG,PSOREF,PSORX("BAR CODE"),PSOLIST,LFD,MAX,MIN,NODE,PS,PSOERR,REF,RF,RXO,RXN,RXP,RXS,SD,VAERR,PSORX("FILL DATE")
  1. K PSOFROM,PSODFN,PSORX
  1. Q
  1. ; build ret(0) if needed
  1. RET0 ;
  1. I '$L(RET(0)) S RET(0)=0_U_RXNUM_U_RRXIEN_U_U_FDATE,$P(RET(0),U,15)=$G(RPHARM),$P(RET(0),U,16)=$G(RPHONE),$P(RET(0),U,17)=$G(RSITE)
  1. Q
  1. ;
  1. ULK ;
  1. Q
  1. ; successful refill. Update data, and build response
  1. UPDREF(PSOMSG,PSOIEN,RPHARM,RPHONE,RSITE,PASSLOC) ;
  1. N REFIEN,REFIENS,REFDATA,FIL,RXNUM,RFILLDT,QTY,DSUPP,CLERK,LOGDATE,IDIV,EDIV,DISPDT,NDC,FDA,DNAME,DIEN,DAT
  1. S FIL=52.1
  1. ; get last refill data node
  1. S REFIEN=$O(^PSRX(PSOIEN,1,"B",DT,""),-1)
  1. S RXNUM=$$GET1^DIQ(52,PSOIEN,.01,"E")
  1. S DNAME=$$GET1^DIQ(52,PSOIEN,6,"E")
  1. S DIEN=$$GET1^DIQ(52,PSOIEN,6,"I")
  1. S REFIENS=REFIEN_","_PSOIEN_","
  1. ; first, set in the remote pharmacist data
  1. S FDA(FIL,REFIENS,91)=RSITE
  1. S FDA(FIL,REFIENS,92)=RPHARM
  1. S FDA(FIL,REFIENS,93)=RPHONE
  1. D FILE^DIE(,"FDA") K FDA
  1. ; now query data and build RET(0) holding accurate information from the refill multiple
  1. D GETS^DIQ(FIL,REFIENS,"**","IE","REFDATA")
  1. S RFILLDT=$G(REFDATA(FIL,REFIENS,.01,"I"))
  1. S QTY=$G(REFDATA(FIL,REFIENS,1,"I"))
  1. S DSUPP=$G(REFDATA(FIL,REFIENS,1.1,"I"))
  1. S CLERK=$G(REFDATA(FIL,REFIENS,6,"E"))
  1. S LOGDATE=$G(REFDATA(FIL,REFIENS,7,"I"))
  1. ; internal division number (IEN to PSO SITE file)
  1. S IDIV=$G(REFDATA(FIL,REFIENS,8,"I"))
  1. S EDIV=$G(REFDATA(FIL,REFIENS,8,"E"))
  1. S DISPDT=$G(REFDATA(FIL,REFIENS,10.1,"I"))
  1. S NDC=$G(REFDATA(FIL,REFIENS,11,"E"))
  1. S RSITE=$G(REFDATA(FIL,REFIENS,91,"I"))
  1. S RPHARM=$G(REFDATA(FIL,REFIENS,92,"E"))
  1. S RPHONE=$G(REFDATA(FIL,REFIENS,93,"E"))
  1. S $P(DAT(1),U,3)=RXNUM,$P(DAT(1),U,4)=RSITE,$P(DAT(1),U,7)=QTY,$P(DAT(1),U,8)=DISPDT,$P(DAT(1),U,9)=DNAME,$P(DAT(1),U,10)=DSUPP,$P(DAT(1),U,11)=RPHARM,$P(DAT(1),U,12)=RFILLDT
  1. D LOGDATA^PSORWRAP($NA(DAT),"OR",,,PSOIEN,REFIEN)
  1. S PSOMSG(0)=1_U_RXNUM_U_PSOIEN_U_REFIEN_U_RFILLDT_U_DNAME_U_QTY_U_DSUPP_U_CLERK_U_LOGDATE_U_IDIV_U_EDIV_U_DISPDT_U_NDC_U_RPHARM_U_RPHONE_U_RSITE_U_PASSLOC
  1. Q
  1. ;
  1. ACT(PSORTYPE,PSORIEN,PSORFILL) ;
  1. ;Add activity log entry at Host Site for Dispensing Site OPAI send
  1. N PSOJ,PSOIR
  1. S PSOIR=0 F PSOJ=0:0 S PSOJ=$O(^PSRX(PSORIEN,"A",PSOJ)) Q:'PSOJ S PSOIR=PSOJ
  1. S PSOIR=PSOIR+1,^PSRX(PSORIEN,"A",0)="^52.3DA^"_PSOIR_"^"_PSOIR
  1. S ^PSRX(PSORIEN,"A",PSOIR,0)=DT_"^"_"X^^"_PSORFILL_"^"_$S(PSORTYPE="R":"Refill",1:"Partial")_" sent to external interface."
  1. Q
  1. ;
  1. ACTD(PSOREASN,PSOMSG) ;Update Activity log at host site for OPAI Dispensed Fill, called from PSORLLLI
  1. ;PSOREASN - the actvity log reason (N - FOR DISPENSE COMPLETION or X - FOR INTERFACE)
  1. N PSOJ,PSOIR
  1. S PSOIR=0 F PSOJ=0:0 S PSOJ=$O(^PSRX(PSOHIENR,"A",PSOJ)) Q:'PSOJ S PSOIR=PSOJ
  1. S PSOIR=PSOIR+1,^PSRX(PSOHIENR,"A",0)="^52.3DA^"_PSOIR_"^"_PSOIR
  1. S ^PSRX(PSOHIENR,"A",PSOIR,0)=DT_"^"_$G(PSOREASN)_"^^"_$S(PSOHTPE="RF":PSOHSUBR,1:6)_"^"_$G(PSOMSG)
  1. Q
  1. ;
  1. UPDH ;continue update of Dispensing Information at Host Site, called from PSORLLLI
  1. I PSOHTPE="RF" D Q
  1. .Q:'$D(^PSRX(PSOHIENR,1,PSOHSUB,0))
  1. .S $P(^PSRX(PSOHIENR,1,PSOHSUB,"RF"),"^",5)=$G(PSOHCHEK)
  1. .S $P(^PSRX(PSOHIENR,1,PSOHSUB,"RF"),"^",6)=$G(PSOHFILL)
  1. .S $P(^PSRX(PSOHIENR,1,PSOHSUB,0),"^",6)=$G(PSOHFLOT)
  1. .S $P(^PSRX(PSOHIENR,1,PSOHSUB,0),"^",14)=$G(PSOHSMAN)
  1. .S $P(^PSRX(PSOHIENR,1,PSOHSUB,0),"^",15)=$G(PSOHSEXP)
  1. Q:'$D(^PSRX(PSOHIENR,"P",PSOHSUB,0))
  1. S $P(^PSRX(PSOHIENR,"P",PSOHSUB,"PF"),"^",5)=$G(PSOHCHEK)
  1. S $P(^PSRX(PSOHIENR,"P",PSOHSUB,"PF"),"^",6)=$G(PSOHFILL)
  1. S $P(^PSRX(PSOHIENR,"P",PSOHSUB,0),"^",6)=$G(PSOHFLOT)
  1. S $P(^PSRX(PSOHIENR,"P",PSOHSUB,0),"^",12)=$G(PSOHSNDC)
  1. S $P(^PSRX(PSOHIENR,"P",PSOHSUB,1),"^")=$G(PSOHSMAN)
  1. S $P(^PSRX(PSOHIENR,"P",PSOHSUB,1),"^",5)=$G(PSOHSEXP)
  1. Q