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