PSORRX1 ;AITC/BWF - Remote RX driver ;8/30/16 12:00am
;;7.0;OUTPATIENT PHARMACY;**454,499,509,519,532,594,643**;DEC 1997;Build 0
;
;Reference ^PSDRUG( supported by DBIA 221
;Reference ^PSNDF supported by DBIA 2195
Q
;
REMOTERX(DFN,PSOSITE) ;
N RXRES,MSG,HLARR,CNT,RXDAT,HLARR,HLPROT,DONE,ORFS,ORCS,ORRS,ORES,ORSS,ORQUIT,HLQUIT,HLDAT,TFLIST,HLP,HLNODE,HLNEXT,HLINSTN
N PID1,PID4,PID5,PID6,TFDAT,LOOP,RXMSG,PSORRDAT,PSOHCNT,ERR,HL,PSORRDAT,ORERR,SITE
S HLARR=$NA(^TMP("HLS",$J)) K @HLARR
S HLDAT=$NA(^XTMP("PSORRX1",$J)) K @HLDAT
I 'DFN Q
S SITE=$P($$SITE^VASITE(),U)
S TFSTRING=$$GET1^DIQ(2,DFN,991.01,"I")_"^^^USVHA^NI^"_SITE
S HLPROT="PSO REMOTE RX QBP-Q13 EVENT"
D INIT^HLFNC2(HLPROT,.HL)
D BLDPID^PSOTPHL2(DFN,"",.PSORRDAT,.HL,.ERR)
I $D(ERR) W !,"There was a problem creating the PID segment for this patient.",!,"Please contact technical support.",!
S @HLARR@(1)="QPD^Q13~Active Prescriptions~HL70471^"
S DONE=0
F PSOHCNT=1:1 D Q:DONE
.I '$D(PSORRDAT(PSOHCNT)) S DONE=1 Q
.S @HLARR@(2)=$G(@HLARR@(2))_PSORRDAT(PSOHCNT)
S @HLARR@(3)="RCP^I"
S HLP("SUBSCRIBER")="^^^^200HD~HDR.DOMAIN.EXT~DNS"
D DIRECT^HLMA(HLPROT,"GM",1,.RXDAT,"",.HLP)
S ORFS="^",ORCS=$E($G(HL("ECH")),1),ORRS=$E($G(HL("ECH")),2),ORES=$E($G(HL("ECH")),3),ORSS=$E($G(HL("ECH")),4)
S HLQUIT=0,ORQUIT="",ORERR=""
I ($P(RXDAT,"^",2)]"")!($P(RXDAT,"^",3)]"") D Q
.W !,"The system is down or not responding"_$S($P(RXDAT,"^",3)]"":" ("_$P(RXDAT,"^",3)_").",1:".")
.W !,"Could not query prescriptions at other VA Pharmacy locations.",!
.K DIR S DIR(0)="FO",DIR("A")="Press RETURN to continue" D ^DIR
F X HLNEXT Q:HLQUIT'>0!(ORQUIT'="") D
.N LOOP
.S LOOP=0 F S LOOP=$O(HLNODE(LOOP)) Q:LOOP="" S HLNODE=HLNODE_HLNODE(LOOP)
.I $E(HLNODE,1,3)="MSA"&(($P(HLNODE,ORFS,2)'="CA")) D LOGERR(DFN,.HLNODE,.HLDAT,$P(HLNODE,ORFS,4)) S ORQUIT=$P(HLNODE,ORFS,4)
.I $E(HLNODE,1,3)="ERR" D LOGERR(DFN,.HLNODE,.HLDAT) S ORQUIT=$P(HLNODE,ORFS,4)
.I $E(HLNODE,1,3)="RDT" D
..S @HLDAT@(0)=$$FMADD^XLFDT($$NOW^XLFDT,2)_U_$$NOW^XLFDT
..D RXPRSE(DFN,.HLNODE,.HLDAT)
Q
LOGERR(DFN,DATA,HLDAT,NMSG) ;
N HLERR
S NMSG=$G(NMSG,"")
S HLERR=$S(NMSG'="":NMSG,1:$P(DATA,ORFS,9))
S:'$D(@HLDAT@(0)) @HLDAT@(0)=$$FMADD^XLFDT($$NOW^XLFDT,2)_U_$$NOW^XLFDT
S @HLDAT@(DFN,"ERR")="<"_HLERR_">"
W !!,"When trying to query prescriptions at other VA Pharmacy",!,"Locations the following message was encountered:",!,"***",!,HLERR,!,"***",! K DIR S DIR(0)="FO",DIR("A")="Press RETURN to continue" D ^DIR Q
Q
; parse rx data from RDF segment
RXPRSE(DFN,DATA,HLDAT) ;
;RDF|14|Site Number~Rx Number~Drug Name~Quantity~Refills~Days Supply~Expiration Date
;~Issue Date~Stop Date~Last Fill Date~Sig~Detail~Status~VA Product ID
N RXSITE,RXNUM,DNAME,QTY,REFILLS,DSUPP,EXPDT,ISSDATE,STOPDT,LFDT,SIG,DETAIL,STAT,STATNM,STATERR,DDONE,I,VAPID,VAFQDN,DAT
; put data into one variable. This handles overflow nodes
S DAT=0 F S DAT=$O(DATA(DAT)) Q:'DAT D
.S DATA=$G(DATA)_$G(DATA(DAT))
S RXSITE=$P(DATA,ORFS,2),RXNUM=$P(DATA,ORFS,3),DNAME=$P(DATA,ORFS,4),QTY=$P(DATA,ORFS,5)
Q:DNAME=""
S REFILLS=$P(DATA,ORFS,6),DSUPP=$P(DATA,ORFS,7),EXPDT=$P(DATA,ORFS,8),ISSDATE=$P(DATA,ORFS,9)
S STOPDT=$P(DATA,ORFS,10),LFDT=$P(DATA,ORFS,11),SIG=$P(DATA,ORFS,12),DETAIL=$P(DATA,ORFS,13)
S STAT=$P(DATA,ORFS,14) Q:STAT=""
; VA Product ID
S VAPID=$P(DATA,ORFS,15)
S VAFQDN=$P(DATA,ORFS,16)
Q:STAT=""
Q:'RXSITE!('RXNUM)
S @HLDAT@(DFN,RXSITE,STAT,DNAME,0)=RXNUM_U_QTY_U_REFILLS_U_DSUPP_U_EXPDT_U_ISSDATE_U_STOPDT_U_LFDT_U_STAT_U_VAPID_U_DNAME_U_VAFQDN
S @HLDAT@(DFN,RXSITE,STAT,DNAME,"SIG")=SIG
S @HLDAT@(DFN,RXSITE,STAT,DNAME,"DETAIL")=DETAIL
Q
; build and send refill request
REFREQ ;
N PHARM,PHONE,LOCSITE,DSUPP,MW,FILLDT,MSG,RXNUM,HLSTR,REMSITE,PHARMLN,PHARMFN,PHARMMI,TFSTRING,HLPROT,LOCDRUG,REMDRUG,DINACT
N ORFS,ORCS,ORRS,ORES,ORSS,HLQUIT,ORQUIT,RESP,RETDFN,VAPID,DONE,PSORRDAT,PSOHCNT,DONE,HL,CSVAL,DIR,REMSIEN,PSOHLNK,PSOLNKDN,DOMOVR,RMSDOM,PSOHLSV
S HLARR=$NA(^TMP("HLS",$J)) K @HLARR
S HLDAT=$NA(^XTMP("REFREQ^PSORRX1",$J)) K @HLDAT
S HLPROT="PSO REMOTE RX RDS-O13 EVENT"
S MW="W"
D FULL^VALM1
S LOCSITE=$$STA^XUAF4(DUZ(2))
S PHARM=$$GET1^DIQ(200,DUZ,.01,"E"),PHARMLN=$P(PHARM,","),PHARMFN=$P($P(PHARM,",",2)," "),PHARMMI=$P($P(PHARM,",",2)," ",2)
S PHONE=$$GET1^DIQ(200,DUZ,.132,"E")
S RXNUM=$P(PSOLST(ORN),U,2) I 'RXNUM S MSG(1)="Invalid Rx #. Please contact technical support." Q
I SRXSTAT'="ACTIVE" W !!,"Only 'ACTIVE' remote prescriptions may be refilled at this time." S DIR(0)="FO",DIR("A")="Press RETURN to continue" D ^DIR Q
S REMSITE=$P(PSOLST(ORN),U,4) ;,REMSIEN=$O(^DIC(4,"D",REMSITE,0))
S REMSIEN=$$FIND1^DIC(4,,"X",REMSITE,"D","I $P(^(0),U,11)=""N"",'$P($G(^(99)),U,4)") Q:'REMSIEN
S PSOREF("DFLG")=""
S REMDRUG=$P(REMDATA,U,11),VAPID=$P(REMDATA,U,10)
I '$L(VAPID) W !!,"Missing VA Product ID. Rx# ",RXNUM," cannot be refilled." S DIR(0)="FO",DIR("A")="Press RETURN to continue" D ^DIR Q
S LOCDRUG=$$DRUGMTCH(REMDRUG,VAPID)
I $G(LOCDRUG)=-1 Q ; user entered no so no reason to prompt again
I '$G(LOCDRUG) W !!,"Could not match remote drug to a local drug. Cannot refill Rx# ",RXNUM,"." S DIR(0)="FO",DIR("A")="Press RETURN to continue" D ^DIR Q
S DINACT=$$GET1^DIQ(50,LOCDRUG,100,"I")
I DINACT>0,DINACT<$$NOW^XLFDT W !!,"Matched Drug "_$$GET1^DIQ(50,LOCDRUG,.01,"E")_" is inactive.",!,"Cannot refill." S DIR(0)="FO",DIR("A")="Press RETURN to continue" D ^DIR Q
; ****** controlled substance check
S CSVAL=$$GET1^DIQ(50,LOCDRUG,3,"E"),CSVAL=$E(CSVAL,1)
I CSVAL,CSVAL>0,CSVAL<6 W !!,"This is a controlled substance. Cannot refill Rx#",RXNUM,"." S DIR(0)="FO",DIR("A")="Press RETURN to continue" D ^DIR Q
;
; if we got this far, fill is most likely happening and remote
; worklist needs to be rebuilt when returning, so set flag.
S PSORRBLD=1
;
S (FILLDT,PSOREF("FILL DATE"))=DT
D INIT^HLFNC2(HLPROT,.HL)
D BLDPID^PSOTPHL2(DFN,"",.PSORRDAT,.HL,.ERR)
S DONE=0
F PSOHCNT=1:1 D Q:DONE
.I '$D(PSORRDAT(PSOHCNT)) S DONE=1 Q
.S @HLARR@(1)=$G(@HLARR@(1))_PSORRDAT(PSOHCNT)
;S @HLARR@(2)="ORC^RF^"_RXNUM_"~"_REMSITE_"~"_$$GET1^DIQ(4,REMSIEN,60,"E")_"^^^^^^^"_FILLDT_U_DUZ_"~"_PHARMLN_"~"_PHARMFN_"~"_PHARMMI_"^^^~~~"_LOCSITE_U_PHONE
S @HLARR@(2)="ORC^RF^"_RXNUM_"~"_REMSITE_"~"_$$FQDN^PSORWRAP(,REMSIEN)_"^^^^^^^"_FILLDT_U_DUZ_"~"_PHARMLN_"~"_PHARMFN_"~"_PHARMMI_"^^^~~~"_LOCSITE_U_PHONE
S @HLARR@(3)="RXO^^^^^^^^"_MW_"~"_$$OPAI_"~~"_LOCSITE
W !!,"Processing refill request. Please be patient as it may take a moment"
W !,"for the host site to respond and generate your label data...",!
S RMSDOM=$$FQDN^PSORWRAP(,REMSIEN)
S DOMOVR=REMSITE_"~"_RMSDOM_"~DNS"
S HLP("SUBSCRIBER")="^^^^"_DOMOVR
D DIRECT^HLMA(HLPROT,"GM",1,.RESP,"",.HLP)
D READMSG^PSORRX2(.HLDAT,"RF",LOCDRUG)
K @HLDAT,@HLARR
Q
; build and send partial fill request
PARTIAL() ;
N DIR,DONE,I,PRMPDAT,VAR,PRXNUM,PHARM,PHARMLN,PHARMFN,PHARMMI,PHONE,RXNUM,HLPROT,TFSTRING,HLARR,PHONE,REMSITE,HLDAT,LOCDRUG,EXIT,VAPID,HL,ERR
N PSOHCNT,DONE,PSORRDAT,CSVAL,REMSIEN,PSOHLNK,PSOLNKDN,REMDRUG,Y,DINACT,EXE,DOMOVR,RMSDOM,PSOHLSV
S HLPROT="PSO REMOTE RX RDS-O13 EVENT"
S HLDAT=$NA(^XTMP("PARTIAL^PSORRX1",$J)) K @HLDAT
S HLARR=$NA(^TMP("HLS",$J)) K @HLARR
D FULL^VALM1
I SRXSTAT'="ACTIVE" W !!,"Only 'ACTIVE' remote prescriptions may be actioned at this time." S DIR(0)="FO",DIR("A")="Press RETURN to continue" D ^DIR Q
S LOCSITE=$$STA^XUAF4(DUZ(2))
S PHONE=$$GET1^DIQ(200,DUZ,.132,"E")
S PRXNUM=$P(PSOLST(ORN),U,2) I 'PRXNUM S MSG(1)="Invalid Rx #. Please contact technical support." Q
S REMSITE=$P(PSOLST(ORN),U,4)
S REMSIEN=$$FIND1^DIC(4,,"X",REMSITE,"D","I $P(^(0),U,11)=""N"",'$P($G(^(99)),U,4)") Q:'REMSIEN
S DONE=0,CNT=1
; prompt for fields that would normally be prompted for a local partial fill.
D FULL^VALM1
S REMDRUG=$P(REMDATA,U,11),VAPID=$P(REMDATA,U,10)
I '$L(VAPID) W !!,"Missing VA Product ID. Rx# ",PRXNUM," cannot be refilled." S DIR(0)="FO",DIR("A")="Press RETURN to continue" D ^DIR Q
S LOCDRUG=$$DRUGMTCH(REMDRUG,VAPID)
I $G(LOCDRUG)=-1 Q ; user entered no so no reason to prompt again
I '$G(LOCDRUG) W !!,"Could not match remote drug to a local drug.",!,"Cannot complete partial fill for Rx# ",PRXNUM,"." S DIR(0)="FO",DIR("A")="Press RETURN to continue" D ^DIR Q
S DINACT=$$GET1^DIQ(50,LOCDRUG,100,"I")
I DINACT>0,DINACT<$$NOW^XLFDT W !!,"Matched Drug "_$$GET1^DIQ(50,LOCDRUG,.01,"E")_" is inactive.",!,"Cannot create partial fill request." S DIR(0)="FO",DIR("A")="Press RETURN to continue" D ^DIR Q
; controlled substance check
S CSVAL=$$GET1^DIQ(50,LOCDRUG,3,"E"),CSVAL=$E(CSVAL,1)
I CSVAL,CSVAL>0,CSVAL<6 W !!,"This is a controlled substance. Cannot refill Rx#",PRXNUM,"." S DIR(0)="FO",DIR("A")="Press RETURN to continue" D ^DIR Q
S EXIT=0
S PDATE=DT
S MW="W"
F I=1:1 D Q:DONE!(EXIT)
.S PRMPDAT=$T(PRMPTXT+I)
.S PRMPDAT=$P(PRMPDAT,";;",2)
.I PRMPDAT="Q" S DONE=1 Q
.K DIR
.S DIR(0)=$P(PRMPDAT,"|"),DIR("A")=$P(PRMPDAT,"|",2),VAR=$P(PRMPDAT,"|",4) S:$L($P(PRMPDAT,"|",3)) DIR("B")=$P(PRMPDAT,"|",3)
.I $G(DIR("B"))["~" D
..S EXE=$TR(DIR("B"),"~","^") X EXE S DIR("B")=DEF
.D ^DIR
.I Y="^" S EXIT=1 Q
.S @VAR=$S($P(DIR(0),"^")["P":$P(Y,U,2),1:Y) ;*499
K DEF
I EXIT W !,"Cancelling partial fill request.",! K DIR S DIR(0)="FO",DIR("A")="Press RETURN to continue" D ^DIR Q
; if we got this far, fill attempt is happening and remote worklist
; needs to be rebuilt when returning, so set flag.
S PSORRBLD=1
S PHARMLN=$P(PHARM,","),PHARMFN=$P($P(PHARM,",",2)," "),PHARMMI=$P($P(PHARM,",",2)," ",2)
D INIT^HLFNC2(HLPROT,.HL)
D BLDPID^PSOTPHL2(DFN,"",.PSORRDAT,.HL,.ERR)
S DONE=0
F PSOHCNT=1:1 D Q:DONE
.I '$D(PSORRDAT(PSOHCNT)) S DONE=1 Q
.S @HLARR@(1)=$G(@HLARR@(1))_PSORRDAT(PSOHCNT)
S @HLARR@(2)="ORC^PF^"_PRXNUM_"~"_REMSITE_"~"_$$FQDN^PSORWRAP(,REMSIEN)_"^^^^^^^"_PDATE_"^"_DUZ_"~"_PHARMLN_"~"_PHARMFN_"~"_PHARMMI_"^^^~~~"_LOCSITE_U_PHONE
S @HLARR@(3)="RXO^1^"_QTY_"^^^^^^"_MW_"~"_$$OPAI_"~~"_LOCSITE_"^^^"_DSUPP
S @HLARR@(4)="NTE^1^L^"_REMARKS
W !!,"Processing partial fill request. Please be patient as it may take a moment"
W !,"for the host site to respond and generate your label data...",!
S RMSDOM=$$FQDN^PSORWRAP(,REMSIEN)
S DOMOVR=REMSITE_"~"_RMSDOM_"~DNS"
S HLP("SUBSCRIBER")="^^^^"_DOMOVR
D DIRECT^HLMA(HLPROT,"GM",1,.HL,"",.HLP)
I $P(HL,U,2) D Q
. W !,"An error was encountered when trying to process the results",!,"from the refill/partial fill request.",!!,$P(HL,U,3)
. K DIR S DIR(0)="FO",DIR("A")="Press RETURN to continue" D ^DIR
. D CL
; clean up variables used
D READMSG^PSORRX2(.HLDAT,"PR",LOCDRUG)
CL ;
K PDATE,QTY,DSUPP,PHARM,REMARKS,MW
K @HLDAT,@HLARR
Q
;
DRUGMTCH(DRGNM,VAPID) ;
; returns -1 if a match was found but user said NO
N LDIEN,MATCH,EXIT,VAPIDSTR,DRL,VAPIEN,VAGENER,FOUND,CHECK,DIC,DRGARY,LDNAME,Y,DRGNM2,VAPSTR,MTCHSTR,DRLCNT
S CHECK=""
S VAPIEN=$O(^PSNDF(50.68,"C",VAPID,0))
I 'VAPIEN Q "" ; ID from HDR not found - most likely CMOP ID/VA PID mismatch
S VAPSTR=$$GET1^DIQ(50.68,VAPIEN,2,"E")
S VAPIDSTR=$$GET1^DIQ(50.68,VAPIEN,.01,"E")
W !!,"Remote site drug name: "_DRGNM
I $D(^PSDRUG("B",DRGNM)) S LDIEN=$O(^PSDRUG("B",DRGNM,0))
I $D(LDIEN) D
.S LDNAME=$$GET1^DIQ(50,LDIEN,.01,"E")
.W !,"Matching Drug Found for Dispensing: "_LDNAME
.S CHECK=$$DIR
I $D(LDIEN),'CHECK Q -1 ; match was found but user said NO
I $D(LDIEN) Q LDIEN
S VAGENER=$$GET1^DIQ(50.68,VAPIEN,.05,"I")
; loop through AND index to find drugs associated with this va generic product.
S FOUND=0
S (DRL,DRLCNT)=0 F S DRL=$O(^PSDRUG("AND",VAGENER,DRL)) Q:'DRL!(FOUND) D
.S MTCHSTR=$$GET1^DIQ(50,DRL,901,"E")
.I VAPSTR]"" Q:MTCHSTR'=VAPSTR
.S DRGARY(DRL)="",DRLCNT=DRLCNT+1
; only one match found.
I DRLCNT=1 S LDIEN=$O(DRGARY(0))
I 'DRLCNT W !!,"No local match could be found for "_DRGNM_".",! K DIR S DIR(0)="FO",DIR("A")="Press RETURN to continue" D ^DIR Q -1
I $D(LDIEN) D
.S LDNAME=$$GET1^DIQ(50,LDIEN,.01,"E")
.W !,"Matching Drug Found for Dispensing: "_LDNAME
.S CHECK=$$DIR()
I $D(LDIEN),'CHECK Q -1 ; match was found but user said NO
I $D(LDIEN) Q LDIEN
; list the items that match strength
S (MATCH,EXIT)=0
N PSODRGL,PSODRGLI,PSODRGL0,PSODRGID,PSODRGC S DIR(0)=""
F PSODRGLI=0:0 S PSODRGLI=$O(DRGARY(PSODRGLI)) Q:'PSODRGLI D
.S PSODRGL0=$G(^PSDRUG(PSODRGLI,0)),PSODRGID=$G(^PSDRUG(PSODRGLI,"I"))
.Q:$TR(PSODRGL0,"^")="" S PSODRGC=$G(PSODRGC)+1
.S DIR(0)=DIR(0)_$S(DIR(0)]"":";",1:"")
.; Increased drug name length from 30 to 40 - PSO*7*594
.S DIR(0)=DIR(0)_$G(PSODRGC)_":"_PSODRGLI_" "_$E($P(PSODRGL0,"^"),1,40)_" "_$J($P(PSODRGL0,"^",2),7)_" "_$S(PSODRGID:$E(PSODRGID,4,5)_"-"_$E(PSODRGID,6,7)_"-"_$E(PSODRGID,2,3)_" ",1:"")_$P(PSODRGL0,"^",10)
.S DIR("L",PSODRGC)=PSODRGC_". "_PSODRGLI_" "_$E($P(PSODRGL0,"^"),1,40)_" "_$J($P(PSODRGL0,"^",2),7)_" "_$S(PSODRGID:$E(PSODRGID,4,5)_"-"_$E(PSODRGID,6,7)_"-"_$E(PSODRGID,2,3)_" ",1:"")_$P(PSODRGL0,"^",10)
S DIR(0)="SO^"_DIR(0),DIR("L")="" ;1:$G(PSODRGC)"
S DIR("A")="Select matching local drug"
D ^DIR K DIR
I +Y<1!($D(DUOUT))!($D(DTOUT)) S Y=-1 ;*519
I Y=-1 Q Y
S LDIEN=+Y(0)
I $G(LDIEN) K DIR S DIR(0)="Y",DIR("A")="Would you like to use this drug" D ^DIR I +Y<1!($D(DUOUT))!($D(DTOUT)) Q -1 ;*509 CHECK FOR Y<1 INSTEAD OF Y<0
Q $G(LDIEN)
; TEXT to build prompts
;;DIR(0)|DIR(A)|DIR(B)|VARIABLE
PRMPTXT ;
;;N^^I $D(X),X>$P(REMDATA,U,2) D EN^DDIOL("QTY CANNOT BE GREATER THAN THE ORIGINAL QTY OF "_$P(REMDATA,U,2)) K X|Enter Quantity||QTY
;;N|DAYS SUPPLY||DSUPP
;;P^200:QEAMZ|Select PHARMACIST Name|S DEF=$$GET1~DIQ(200,DUZ,.01,"E")|PHARM
;;F^0:60|REMARKS||REMARKS
;;Q
Q
DIR() ;
N DIR,Y
S DIR(0)="Y",DIR("B")="NO"
S DIR("A",1)="Would you like to use the system matched drug for this"
S DIR("A")="refill/partial fill"
D ^DIR
Q Y
POST ; post init for PSO*7*454
N LIEN,OPSITE,DOMAIN,VAL
; add TCP/IP address for EMI
S DOMAIN=$$FQDN^PSORWRAP(,DUZ(2))
S VAL="PSORRXSEND"
S LIEN=$$FIND1^DIC(870,,"B",.VAL) Q:'LIEN
S FDA(870,LIEN_",",.08)=DOMAIN
S FDA(870,LIEN_",",400.01)="vaaussoalebp2.aac.domain.ext" D FILE^DIE(,"FDA") K FDA
; turn off the OneVA Pharmacy flag for all outpatient sites.
S OPSITE=0 F S OPSITE=$O(^PS(59,OPSITE)) Q:'OPSITE D
.S FDA(59,OPSITE_",",3001)="" D FILE^DIE(,"FDA") K FDA
Q
;
OPAI() ; determine if drug will go through OPAI
N PSOOINT,PSOOMARK
I '$G(PSOSITE) Q 1 ;REMOVE THIS LINE ONCE YOU DETERMINE PSOSITE IS DEFINED FORM THE PROTOCOL
S PSOOINT=$P($G(^PS(59,PSOSITE,1)),"^",30),PSOOMARK=0
S:+$G(LOCDRUG) PSOOMARK=+$G(^PSDRUG(LOCDRUG,6))
I 'PSOOINT Q 0
I PSOOINT=1!(PSOOINT=2) Q 1
I PSOOMARK Q 1
Q 0
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPSORRX1 14746 printed Apr 09, 2024@21:34:10 Page 2
PSORRX1 ;AITC/BWF - Remote RX driver ;8/30/16 12:00am
+1 ;;7.0;OUTPATIENT PHARMACY;**454,499,509,519,532,594,643**;DEC 1997;Build 0
+2 ;
+3 ;Reference ^PSDRUG( supported by DBIA 221
+4 ;Reference ^PSNDF supported by DBIA 2195
+5 QUIT
+6 ;
REMOTERX(DFN,PSOSITE) ;
+1 NEW RXRES,MSG,HLARR,CNT,RXDAT,HLARR,HLPROT,DONE,ORFS,ORCS,ORRS,ORES,ORSS,ORQUIT,HLQUIT,HLDAT,TFLIST,HLP,HLNODE,HLNEXT,HLINSTN
+2 NEW PID1,PID4,PID5,PID6,TFDAT,LOOP,RXMSG,PSORRDAT,PSOHCNT,ERR,HL,PSORRDAT,ORERR,SITE
+3 SET HLARR=$NAME(^TMP("HLS",$JOB))
KILL @HLARR
+4 SET HLDAT=$NAME(^XTMP("PSORRX1",$JOB))
KILL @HLDAT
+5 IF 'DFN
QUIT
+6 SET SITE=$PIECE($$SITE^VASITE(),U)
+7 SET TFSTRING=$$GET1^DIQ(2,DFN,991.01,"I")_"^^^USVHA^NI^"_SITE
+8 SET HLPROT="PSO REMOTE RX QBP-Q13 EVENT"
+9 DO INIT^HLFNC2(HLPROT,.HL)
+10 DO BLDPID^PSOTPHL2(DFN,"",.PSORRDAT,.HL,.ERR)
+11 IF $DATA(ERR)
WRITE !,"There was a problem creating the PID segment for this patient.",!,"Please contact technical support.",!
+12 SET @HLARR@(1)="QPD^Q13~Active Prescriptions~HL70471^"
+13 SET DONE=0
+14 FOR PSOHCNT=1:1
Begin DoDot:1
+15 IF '$DATA(PSORRDAT(PSOHCNT))
SET DONE=1
QUIT
+16 SET @HLARR@(2)=$GET(@HLARR@(2))_PSORRDAT(PSOHCNT)
End DoDot:1
if DONE
QUIT
+17 SET @HLARR@(3)="RCP^I"
+18 SET HLP("SUBSCRIBER")="^^^^200HD~HDR.DOMAIN.EXT~DNS"
+19 DO DIRECT^HLMA(HLPROT,"GM",1,.RXDAT,"",.HLP)
+20 SET ORFS="^"
SET ORCS=$EXTRACT($GET(HL("ECH")),1)
SET ORRS=$EXTRACT($GET(HL("ECH")),2)
SET ORES=$EXTRACT($GET(HL("ECH")),3)
SET ORSS=$EXTRACT($GET(HL("ECH")),4)
+21 SET HLQUIT=0
SET ORQUIT=""
SET ORERR=""
+22 IF ($PIECE(RXDAT,"^",2)]"")!($PIECE(RXDAT,"^",3)]"")
Begin DoDot:1
+23 WRITE !,"The system is down or not responding"_$SELECT($PIECE(RXDAT,"^",3)]"":" ("_$PIECE(RXDAT,"^",3)_").",1:".")
+24 WRITE !,"Could not query prescriptions at other VA Pharmacy locations.",!
+25 KILL DIR
SET DIR(0)="FO"
SET DIR("A")="Press RETURN to continue"
DO ^DIR
End DoDot:1
QUIT
+26 FOR
XECUTE HLNEXT
if HLQUIT'>0!(ORQUIT'="")
QUIT
Begin DoDot:1
+27 NEW LOOP
+28 SET LOOP=0
FOR
SET LOOP=$ORDER(HLNODE(LOOP))
if LOOP=""
QUIT
SET HLNODE=HLNODE_HLNODE(LOOP)
+29 IF $EXTRACT(HLNODE,1,3)="MSA"&(($PIECE(HLNODE,ORFS,2)'="CA"))
DO LOGERR(DFN,.HLNODE,.HLDAT,$PIECE(HLNODE,ORFS,4))
SET ORQUIT=$PIECE(HLNODE,ORFS,4)
+30 IF $EXTRACT(HLNODE,1,3)="ERR"
DO LOGERR(DFN,.HLNODE,.HLDAT)
SET ORQUIT=$PIECE(HLNODE,ORFS,4)
+31 IF $EXTRACT(HLNODE,1,3)="RDT"
Begin DoDot:2
+32 SET @HLDAT@(0)=$$FMADD^XLFDT($$NOW^XLFDT,2)_U_$$NOW^XLFDT
+33 DO RXPRSE(DFN,.HLNODE,.HLDAT)
End DoDot:2
End DoDot:1
+34 QUIT
LOGERR(DFN,DATA,HLDAT,NMSG) ;
+1 NEW HLERR
+2 SET NMSG=$GET(NMSG,"")
+3 SET HLERR=$SELECT(NMSG'="":NMSG,1:$PIECE(DATA,ORFS,9))
+4 if '$DATA(@HLDAT@(0))
SET @HLDAT@(0)=$$FMADD^XLFDT($$NOW^XLFDT,2)_U_$$NOW^XLFDT
+5 SET @HLDAT@(DFN,"ERR")="<"_HLERR_">"
+6 WRITE !!,"When trying to query prescriptions at other VA Pharmacy",!,"Locations the following message was encountered:",!,"***",!,HLERR,!,"***",!
KILL DIR
SET DIR(0)="FO"
SET DIR("A")="Press RETURN to continue"
DO ^DIR
QUIT
+7 QUIT
+8 ; parse rx data from RDF segment
RXPRSE(DFN,DATA,HLDAT) ;
+1 ;RDF|14|Site Number~Rx Number~Drug Name~Quantity~Refills~Days Supply~Expiration Date
+2 ;~Issue Date~Stop Date~Last Fill Date~Sig~Detail~Status~VA Product ID
+3 NEW RXSITE,RXNUM,DNAME,QTY,REFILLS,DSUPP,EXPDT,ISSDATE,STOPDT,LFDT,SIG,DETAIL,STAT,STATNM,STATERR,DDONE,I,VAPID,VAFQDN,DAT
+4 ; put data into one variable. This handles overflow nodes
+5 SET DAT=0
FOR
SET DAT=$ORDER(DATA(DAT))
if 'DAT
QUIT
Begin DoDot:1
+6 SET DATA=$GET(DATA)_$GET(DATA(DAT))
End DoDot:1
+7 SET RXSITE=$PIECE(DATA,ORFS,2)
SET RXNUM=$PIECE(DATA,ORFS,3)
SET DNAME=$PIECE(DATA,ORFS,4)
SET QTY=$PIECE(DATA,ORFS,5)
+8 if DNAME=""
QUIT
+9 SET REFILLS=$PIECE(DATA,ORFS,6)
SET DSUPP=$PIECE(DATA,ORFS,7)
SET EXPDT=$PIECE(DATA,ORFS,8)
SET ISSDATE=$PIECE(DATA,ORFS,9)
+10 SET STOPDT=$PIECE(DATA,ORFS,10)
SET LFDT=$PIECE(DATA,ORFS,11)
SET SIG=$PIECE(DATA,ORFS,12)
SET DETAIL=$PIECE(DATA,ORFS,13)
+11 SET STAT=$PIECE(DATA,ORFS,14)
if STAT=""
QUIT
+12 ; VA Product ID
+13 SET VAPID=$PIECE(DATA,ORFS,15)
+14 SET VAFQDN=$PIECE(DATA,ORFS,16)
+15 if STAT=""
QUIT
+16 if 'RXSITE!('RXNUM)
QUIT
+17 SET @HLDAT@(DFN,RXSITE,STAT,DNAME,0)=RXNUM_U_QTY_U_REFILLS_U_DSUPP_U_EXPDT_U_ISSDATE_U_STOPDT_U_LFDT_U_STAT_U_VAPID_U_DNAME_U_VAFQDN
+18 SET @HLDAT@(DFN,RXSITE,STAT,DNAME,"SIG")=SIG
+19 SET @HLDAT@(DFN,RXSITE,STAT,DNAME,"DETAIL")=DETAIL
+20 QUIT
+21 ; build and send refill request
REFREQ ;
+1 NEW PHARM,PHONE,LOCSITE,DSUPP,MW,FILLDT,MSG,RXNUM,HLSTR,REMSITE,PHARMLN,PHARMFN,PHARMMI,TFSTRING,HLPROT,LOCDRUG,REMDRUG,DINACT
+2 NEW ORFS,ORCS,ORRS,ORES,ORSS,HLQUIT,ORQUIT,RESP,RETDFN,VAPID,DONE,PSORRDAT,PSOHCNT,DONE,HL,CSVAL,DIR,REMSIEN,PSOHLNK,PSOLNKDN,DOMOVR,RMSDOM,PSOHLSV
+3 SET HLARR=$NAME(^TMP("HLS",$JOB))
KILL @HLARR
+4 SET HLDAT=$NAME(^XTMP("REFREQ^PSORRX1",$JOB))
KILL @HLDAT
+5 SET HLPROT="PSO REMOTE RX RDS-O13 EVENT"
+6 SET MW="W"
+7 DO FULL^VALM1
+8 SET LOCSITE=$$STA^XUAF4(DUZ(2))
+9 SET PHARM=$$GET1^DIQ(200,DUZ,.01,"E")
SET PHARMLN=$PIECE(PHARM,",")
SET PHARMFN=$PIECE($PIECE(PHARM,",",2)," ")
SET PHARMMI=$PIECE($PIECE(PHARM,",",2)," ",2)
+10 SET PHONE=$$GET1^DIQ(200,DUZ,.132,"E")
+11 SET RXNUM=$PIECE(PSOLST(ORN),U,2)
IF 'RXNUM
SET MSG(1)="Invalid Rx #. Please contact technical support."
QUIT
+12 IF SRXSTAT'="ACTIVE"
WRITE !!,"Only 'ACTIVE' remote prescriptions may be refilled at this time."
SET DIR(0)="FO"
SET DIR("A")="Press RETURN to continue"
DO ^DIR
QUIT
+13 ;,REMSIEN=$O(^DIC(4,"D",REMSITE,0))
SET REMSITE=$PIECE(PSOLST(ORN),U,4)
+14 SET REMSIEN=$$FIND1^DIC(4,,"X",REMSITE,"D","I $P(^(0),U,11)=""N"",'$P($G(^(99)),U,4)")
if 'REMSIEN
QUIT
+15 SET PSOREF("DFLG")=""
+16 SET REMDRUG=$PIECE(REMDATA,U,11)
SET VAPID=$PIECE(REMDATA,U,10)
+17 IF '$LENGTH(VAPID)
WRITE !!,"Missing VA Product ID. Rx# ",RXNUM," cannot be refilled."
SET DIR(0)="FO"
SET DIR("A")="Press RETURN to continue"
DO ^DIR
QUIT
+18 SET LOCDRUG=$$DRUGMTCH(REMDRUG,VAPID)
+19 ; user entered no so no reason to prompt again
IF $GET(LOCDRUG)=-1
QUIT
+20 IF '$GET(LOCDRUG)
WRITE !!,"Could not match remote drug to a local drug. Cannot refill Rx# ",RXNUM,"."
SET DIR(0)="FO"
SET DIR("A")="Press RETURN to continue"
DO ^DIR
QUIT
+21 SET DINACT=$$GET1^DIQ(50,LOCDRUG,100,"I")
+22 IF DINACT>0
IF DINACT<$$NOW^XLFDT
WRITE !!,"Matched Drug "_$$GET1^DIQ(50,LOCDRUG,.01,"E")_" is inactive.",!,"Cannot refill."
SET DIR(0)="FO"
SET DIR("A")="Press RETURN to continue"
DO ^DIR
QUIT
+23 ; ****** controlled substance check
+24 SET CSVAL=$$GET1^DIQ(50,LOCDRUG,3,"E")
SET CSVAL=$EXTRACT(CSVAL,1)
+25 IF CSVAL
IF CSVAL>0
IF CSVAL<6
WRITE !!,"This is a controlled substance. Cannot refill Rx#",RXNUM,"."
SET DIR(0)="FO"
SET DIR("A")="Press RETURN to continue"
DO ^DIR
QUIT
+26 ;
+27 ; if we got this far, fill is most likely happening and remote
+28 ; worklist needs to be rebuilt when returning, so set flag.
+29 SET PSORRBLD=1
+30 ;
+31 SET (FILLDT,PSOREF("FILL DATE"))=DT
+32 DO INIT^HLFNC2(HLPROT,.HL)
+33 DO BLDPID^PSOTPHL2(DFN,"",.PSORRDAT,.HL,.ERR)
+34 SET DONE=0
+35 FOR PSOHCNT=1:1
Begin DoDot:1
+36 IF '$DATA(PSORRDAT(PSOHCNT))
SET DONE=1
QUIT
+37 SET @HLARR@(1)=$GET(@HLARR@(1))_PSORRDAT(PSOHCNT)
End DoDot:1
if DONE
QUIT
+38 ;S @HLARR@(2)="ORC^RF^"_RXNUM_"~"_REMSITE_"~"_$$GET1^DIQ(4,REMSIEN,60,"E")_"^^^^^^^"_FILLDT_U_DUZ_"~"_PHARMLN_"~"_PHARMFN_"~"_PHARMMI_"^^^~~~"_LOCSITE_U_PHONE
+39 SET @HLARR@(2)="ORC^RF^"_RXNUM_"~"_REMSITE_"~"_$$FQDN^PSORWRAP(,REMSIEN)_"^^^^^^^"_FILLDT_U_DUZ_"~"_PHARMLN_"~"_PHARMFN_"~"_PHARMMI_"^^^~~~"_LOCSITE_U_PHONE
+40 SET @HLARR@(3)="RXO^^^^^^^^"_MW_"~"_$$OPAI_"~~"_LOCSITE
+41 WRITE !!,"Processing refill request. Please be patient as it may take a moment"
+42 WRITE !,"for the host site to respond and generate your label data...",!
+43 SET RMSDOM=$$FQDN^PSORWRAP(,REMSIEN)
+44 SET DOMOVR=REMSITE_"~"_RMSDOM_"~DNS"
+45 SET HLP("SUBSCRIBER")="^^^^"_DOMOVR
+46 DO DIRECT^HLMA(HLPROT,"GM",1,.RESP,"",.HLP)
+47 DO READMSG^PSORRX2(.HLDAT,"RF",LOCDRUG)
+48 KILL @HLDAT,@HLARR
+49 QUIT
+50 ; build and send partial fill request
PARTIAL() ;
+1 NEW DIR,DONE,I,PRMPDAT,VAR,PRXNUM,PHARM,PHARMLN,PHARMFN,PHARMMI,PHONE,RXNUM,HLPROT,TFSTRING,HLARR,PHONE,REMSITE,HLDAT,LOCDRUG,EXIT,VAPID,HL,ERR
+2 NEW PSOHCNT,DONE,PSORRDAT,CSVAL,REMSIEN,PSOHLNK,PSOLNKDN,REMDRUG,Y,DINACT,EXE,DOMOVR,RMSDOM,PSOHLSV
+3 SET HLPROT="PSO REMOTE RX RDS-O13 EVENT"
+4 SET HLDAT=$NAME(^XTMP("PARTIAL^PSORRX1",$JOB))
KILL @HLDAT
+5 SET HLARR=$NAME(^TMP("HLS",$JOB))
KILL @HLARR
+6 DO FULL^VALM1
+7 IF SRXSTAT'="ACTIVE"
WRITE !!,"Only 'ACTIVE' remote prescriptions may be actioned at this time."
SET DIR(0)="FO"
SET DIR("A")="Press RETURN to continue"
DO ^DIR
QUIT
+8 SET LOCSITE=$$STA^XUAF4(DUZ(2))
+9 SET PHONE=$$GET1^DIQ(200,DUZ,.132,"E")
+10 SET PRXNUM=$PIECE(PSOLST(ORN),U,2)
IF 'PRXNUM
SET MSG(1)="Invalid Rx #. Please contact technical support."
QUIT
+11 SET REMSITE=$PIECE(PSOLST(ORN),U,4)
+12 SET REMSIEN=$$FIND1^DIC(4,,"X",REMSITE,"D","I $P(^(0),U,11)=""N"",'$P($G(^(99)),U,4)")
if 'REMSIEN
QUIT
+13 SET DONE=0
SET CNT=1
+14 ; prompt for fields that would normally be prompted for a local partial fill.
+15 DO FULL^VALM1
+16 SET REMDRUG=$PIECE(REMDATA,U,11)
SET VAPID=$PIECE(REMDATA,U,10)
+17 IF '$LENGTH(VAPID)
WRITE !!,"Missing VA Product ID. Rx# ",PRXNUM," cannot be refilled."
SET DIR(0)="FO"
SET DIR("A")="Press RETURN to continue"
DO ^DIR
QUIT
+18 SET LOCDRUG=$$DRUGMTCH(REMDRUG,VAPID)
+19 ; user entered no so no reason to prompt again
IF $GET(LOCDRUG)=-1
QUIT
+20 IF '$GET(LOCDRUG)
WRITE !!,"Could not match remote drug to a local drug.",!,"Cannot complete partial fill for Rx# ",PRXNUM,"."
SET DIR(0)="FO"
SET DIR("A")="Press RETURN to continue"
DO ^DIR
QUIT
+21 SET DINACT=$$GET1^DIQ(50,LOCDRUG,100,"I")
+22 IF DINACT>0
IF DINACT<$$NOW^XLFDT
WRITE !!,"Matched Drug "_$$GET1^DIQ(50,LOCDRUG,.01,"E")_" is inactive.",!,"Cannot create partial fill request."
SET DIR(0)="FO"
SET DIR("A")="Press RETURN to continue"
DO ^DIR
QUIT
+23 ; controlled substance check
+24 SET CSVAL=$$GET1^DIQ(50,LOCDRUG,3,"E")
SET CSVAL=$EXTRACT(CSVAL,1)
+25 IF CSVAL
IF CSVAL>0
IF CSVAL<6
WRITE !!,"This is a controlled substance. Cannot refill Rx#",PRXNUM,"."
SET DIR(0)="FO"
SET DIR("A")="Press RETURN to continue"
DO ^DIR
QUIT
+26 SET EXIT=0
+27 SET PDATE=DT
+28 SET MW="W"
+29 FOR I=1:1
Begin DoDot:1
+30 SET PRMPDAT=$TEXT(PRMPTXT+I)
+31 SET PRMPDAT=$PIECE(PRMPDAT,";;",2)
+32 IF PRMPDAT="Q"
SET DONE=1
QUIT
+33 KILL DIR
+34 SET DIR(0)=$PIECE(PRMPDAT,"|")
SET DIR("A")=$PIECE(PRMPDAT,"|",2)
SET VAR=$PIECE(PRMPDAT,"|",4)
if $LENGTH($PIECE(PRMPDAT,"|",3))
SET DIR("B")=$PIECE(PRMPDAT,"|",3)
+35 IF $GET(DIR("B"))["~"
Begin DoDot:2
+36 SET EXE=$TRANSLATE(DIR("B"),"~","^")
XECUTE EXE
SET DIR("B")=DEF
End DoDot:2
+37 DO ^DIR
+38 IF Y="^"
SET EXIT=1
QUIT
+39 ;*499
SET @VAR=$SELECT($PIECE(DIR(0),"^")["P":$PIECE(Y,U,2),1:Y)
End DoDot:1
if DONE!(EXIT)
QUIT
+40 KILL DEF
+41 IF EXIT
WRITE !,"Cancelling partial fill request.",!
KILL DIR
SET DIR(0)="FO"
SET DIR("A")="Press RETURN to continue"
DO ^DIR
QUIT
+42 ; if we got this far, fill attempt is happening and remote worklist
+43 ; needs to be rebuilt when returning, so set flag.
+44 SET PSORRBLD=1
+45 SET PHARMLN=$PIECE(PHARM,",")
SET PHARMFN=$PIECE($PIECE(PHARM,",",2)," ")
SET PHARMMI=$PIECE($PIECE(PHARM,",",2)," ",2)
+46 DO INIT^HLFNC2(HLPROT,.HL)
+47 DO BLDPID^PSOTPHL2(DFN,"",.PSORRDAT,.HL,.ERR)
+48 SET DONE=0
+49 FOR PSOHCNT=1:1
Begin DoDot:1
+50 IF '$DATA(PSORRDAT(PSOHCNT))
SET DONE=1
QUIT
+51 SET @HLARR@(1)=$GET(@HLARR@(1))_PSORRDAT(PSOHCNT)
End DoDot:1
if DONE
QUIT
+52 SET @HLARR@(2)="ORC^PF^"_PRXNUM_"~"_REMSITE_"~"_$$FQDN^PSORWRAP(,REMSIEN)_"^^^^^^^"_PDATE_"^"_DUZ_"~"_PHARMLN_"~"_PHARMFN_"~"_PHARMMI_"^^^~~~"_LOCSITE_U_PHONE
+53 SET @HLARR@(3)="RXO^1^"_QTY_"^^^^^^"_MW_"~"_$$OPAI_"~~"_LOCSITE_"^^^"_DSUPP
+54 SET @HLARR@(4)="NTE^1^L^"_REMARKS
+55 WRITE !!,"Processing partial fill request. Please be patient as it may take a moment"
+56 WRITE !,"for the host site to respond and generate your label data...",!
+57 SET RMSDOM=$$FQDN^PSORWRAP(,REMSIEN)
+58 SET DOMOVR=REMSITE_"~"_RMSDOM_"~DNS"
+59 SET HLP("SUBSCRIBER")="^^^^"_DOMOVR
+60 DO DIRECT^HLMA(HLPROT,"GM",1,.HL,"",.HLP)
+61 IF $PIECE(HL,U,2)
Begin DoDot:1
+62 WRITE !,"An error was encountered when trying to process the results",!,"from the refill/partial fill request.",!!,$PIECE(HL,U,3)
+63 KILL DIR
SET DIR(0)="FO"
SET DIR("A")="Press RETURN to continue"
DO ^DIR
+64 DO CL
End DoDot:1
QUIT
+65 ; clean up variables used
+66 DO READMSG^PSORRX2(.HLDAT,"PR",LOCDRUG)
CL ;
+1 KILL PDATE,QTY,DSUPP,PHARM,REMARKS,MW
+2 KILL @HLDAT,@HLARR
+3 QUIT
+4 ;
DRUGMTCH(DRGNM,VAPID) ;
+1 ; returns -1 if a match was found but user said NO
+2 NEW LDIEN,MATCH,EXIT,VAPIDSTR,DRL,VAPIEN,VAGENER,FOUND,CHECK,DIC,DRGARY,LDNAME,Y,DRGNM2,VAPSTR,MTCHSTR,DRLCNT
+3 SET CHECK=""
+4 SET VAPIEN=$ORDER(^PSNDF(50.68,"C",VAPID,0))
+5 ; ID from HDR not found - most likely CMOP ID/VA PID mismatch
IF 'VAPIEN
QUIT ""
+6 SET VAPSTR=$$GET1^DIQ(50.68,VAPIEN,2,"E")
+7 SET VAPIDSTR=$$GET1^DIQ(50.68,VAPIEN,.01,"E")
+8 WRITE !!,"Remote site drug name: "_DRGNM
+9 IF $DATA(^PSDRUG("B",DRGNM))
SET LDIEN=$ORDER(^PSDRUG("B",DRGNM,0))
+10 IF $DATA(LDIEN)
Begin DoDot:1
+11 SET LDNAME=$$GET1^DIQ(50,LDIEN,.01,"E")
+12 WRITE !,"Matching Drug Found for Dispensing: "_LDNAME
+13 SET CHECK=$$DIR
End DoDot:1
+14 ; match was found but user said NO
IF $DATA(LDIEN)
IF 'CHECK
QUIT -1
+15 IF $DATA(LDIEN)
QUIT LDIEN
+16 SET VAGENER=$$GET1^DIQ(50.68,VAPIEN,.05,"I")
+17 ; loop through AND index to find drugs associated with this va generic product.
+18 SET FOUND=0
+19 SET (DRL,DRLCNT)=0
FOR
SET DRL=$ORDER(^PSDRUG("AND",VAGENER,DRL))
if 'DRL!(FOUND)
QUIT
Begin DoDot:1
+20 SET MTCHSTR=$$GET1^DIQ(50,DRL,901,"E")
+21 IF VAPSTR]""
if MTCHSTR'=VAPSTR
QUIT
+22 SET DRGARY(DRL)=""
SET DRLCNT=DRLCNT+1
End DoDot:1
+23 ; only one match found.
+24 IF DRLCNT=1
SET LDIEN=$ORDER(DRGARY(0))
+25 IF 'DRLCNT
WRITE !!,"No local match could be found for "_DRGNM_".",!
KILL DIR
SET DIR(0)="FO"
SET DIR("A")="Press RETURN to continue"
DO ^DIR
QUIT -1
+26 IF $DATA(LDIEN)
Begin DoDot:1
+27 SET LDNAME=$$GET1^DIQ(50,LDIEN,.01,"E")
+28 WRITE !,"Matching Drug Found for Dispensing: "_LDNAME
+29 SET CHECK=$$DIR()
End DoDot:1
+30 ; match was found but user said NO
IF $DATA(LDIEN)
IF 'CHECK
QUIT -1
+31 IF $DATA(LDIEN)
QUIT LDIEN
+32 ; list the items that match strength
+33 SET (MATCH,EXIT)=0
+34 NEW PSODRGL,PSODRGLI,PSODRGL0,PSODRGID,PSODRGC
SET DIR(0)=""
+35 FOR PSODRGLI=0:0
SET PSODRGLI=$ORDER(DRGARY(PSODRGLI))
if 'PSODRGLI
QUIT
Begin DoDot:1
+36 SET PSODRGL0=$GET(^PSDRUG(PSODRGLI,0))
SET PSODRGID=$GET(^PSDRUG(PSODRGLI,"I"))
+37 if $TRANSLATE(PSODRGL0,"^")=""
QUIT
SET PSODRGC=$GET(PSODRGC)+1
+38 SET DIR(0)=DIR(0)_$SELECT(DIR(0)]"":";",1:"")
+39 ; Increased drug name length from 30 to 40 - PSO*7*594
+40 SET DIR(0)=DIR(0)_$GET(PSODRGC)_":"_PSODRGLI_" "_$EXTRACT($PIECE(PSODRGL0,"^"),1,40)_" "_$JUSTIFY($PIECE(PSODRGL0,"^",2),7)_" "_$SELECT(PSODRGID:$EXTRACT(PSODRGID,4,5)_"-"_$EXTRACT(PSODRGID,6,7)_"-"_$EXTRACT(PSODRGID,2,3)_" ",1:"")_.
..
... $PIECE(PSODRGL0,"^",10)
+41 SET DIR("L",PSODRGC)=PSODRGC_". "_PSODRGLI_" "_$EXTRACT($PIECE(PSODRGL0,"^"),1,40)_" "_$JUSTIFY($PIECE(PSODRGL0,"^",2),7)_" "_$SELECT(PSODRGID:$EXTRACT(PSODRGID,4,5)_"-"_$EXTRACT(PSODRGID,6,7)_"-"_$EXTRACT(PSODRGID,2,3)_" ",1:"")_..
.
... $PIECE(PSODRGL0,"^",10)
End DoDot:1
+42 ;1:$G(PSODRGC)"
SET DIR(0)="SO^"_DIR(0)
SET DIR("L")=""
+43 SET DIR("A")="Select matching local drug"
+44 DO ^DIR
KILL DIR
+45 ;*519
IF +Y<1!($DATA(DUOUT))!($DATA(DTOUT))
SET Y=-1
+46 IF Y=-1
QUIT Y
+47 SET LDIEN=+Y(0)
+48 ;*509 CHECK FOR Y<1 INSTEAD OF Y<0
IF $GET(LDIEN)
KILL DIR
SET DIR(0)="Y"
SET DIR("A")="Would you like to use this drug"
DO ^DIR
IF +Y<1!($DATA(DUOUT))!($DATA(DTOUT))
QUIT -1
+49 QUIT $GET(LDIEN)
+50 ; TEXT to build prompts
+51 ;;DIR(0)|DIR(A)|DIR(B)|VARIABLE
PRMPTXT ;
+1 ;;N^^I $D(X),X>$P(REMDATA,U,2) D EN^DDIOL("QTY CANNOT BE GREATER THAN THE ORIGINAL QTY OF "_$P(REMDATA,U,2)) K X|Enter Quantity||QTY
+2 ;;N|DAYS SUPPLY||DSUPP
+3 ;;P^200:QEAMZ|Select PHARMACIST Name|S DEF=$$GET1~DIQ(200,DUZ,.01,"E")|PHARM
+4 ;;F^0:60|REMARKS||REMARKS
+5 ;;Q
+6 QUIT
DIR() ;
+1 NEW DIR,Y
+2 SET DIR(0)="Y"
SET DIR("B")="NO"
+3 SET DIR("A",1)="Would you like to use the system matched drug for this"
+4 SET DIR("A")="refill/partial fill"
+5 DO ^DIR
+6 QUIT Y
POST ; post init for PSO*7*454
+1 NEW LIEN,OPSITE,DOMAIN,VAL
+2 ; add TCP/IP address for EMI
+3 SET DOMAIN=$$FQDN^PSORWRAP(,DUZ(2))
+4 SET VAL="PSORRXSEND"
+5 SET LIEN=$$FIND1^DIC(870,,"B",.VAL)
if 'LIEN
QUIT
+6 SET FDA(870,LIEN_",",.08)=DOMAIN
+7 SET FDA(870,LIEN_",",400.01)="vaaussoalebp2.aac.domain.ext"
DO FILE^DIE(,"FDA")
KILL FDA
+8 ; turn off the OneVA Pharmacy flag for all outpatient sites.
+9 SET OPSITE=0
FOR
SET OPSITE=$ORDER(^PS(59,OPSITE))
if 'OPSITE
QUIT
Begin DoDot:1
+10 SET FDA(59,OPSITE_",",3001)=""
DO FILE^DIE(,"FDA")
KILL FDA
End DoDot:1
+11 QUIT
+12 ;
OPAI() ; determine if drug will go through OPAI
+1 NEW PSOOINT,PSOOMARK
+2 ;REMOVE THIS LINE ONCE YOU DETERMINE PSOSITE IS DEFINED FORM THE PROTOCOL
IF '$GET(PSOSITE)
QUIT 1
+3 SET PSOOINT=$PIECE($GET(^PS(59,PSOSITE,1)),"^",30)
SET PSOOMARK=0
+4 if +$GET(LOCDRUG)
SET PSOOMARK=+$GET(^PSDRUG(LOCDRUG,6))
+5 IF 'PSOOINT
QUIT 0
+6 IF PSOOINT=1!(PSOOINT=2)
QUIT 1
+7 IF PSOOMARK
QUIT 1
+8 QUIT 0
