- PSORRX1 ;AITC/BWF - Remote RX driver ;8/30/16 12:00am
- ;;7.0;OUTPATIENT PHARMACY;**454,499,509,519,532,594,643,736,740**;DEC 1997;Build 18
- ;
- ;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")="^^^^200OneVA-HCHS-PSF" ;pso*7*736
- 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 IEN
- N RXSITE,RXNUM,DNAME,QTY,REFILLS,DSUPP,EXPDT,ISSDATE,STOPDT,LFDT,SIG,DETAIL,STAT,STATNM,STATERR,DDONE,I,VAPIEN,VAFQDN,DAT
- ; p736 - removed code to handle overflow nodes as value is already passed in the correct format
- 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 IEN
- S VAPIEN=$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_VAPIEN_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
- N ORFS,ORCS,ORRS,ORES,ORSS,HLQUIT,ORQUIT,RESP,RETDFN,VAPIEN,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 IEN. 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
- ; PSO 740
- I '$$VALDRGINT^PSORRPA1(LOCDRUG,"R",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,VAPIEN,HL,ERR
- N PSOHCNT,DONE,PSORRDAT,CSVAL,REMSIEN,PSOHLNK,PSOLNKDN,REMDRUG,Y,EXE,DOMOVR,RMSDOM,PSOHLSV,VAPID
- 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 process a partial fill." 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 process a partial fill for Rx # ",PRXNUM,"." S DIR(0)="FO",DIR("A")="Press RETURN to continue" D ^DIR Q
- ; PSO 740
- I '$$VALDRGINT^PSORRPA1(LOCDRUG,"P",PRXNUM) 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 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,VAPIN) ;p736 - VAPIEN directly passed into DRUGMTCH
- ; returns -1 if a match was found but user said NO
- ;
- I $G(DRGNM)']"" Q "" ; p736 - ensures DRGNM is valid
- ;
- N LDIEN,MATCH,EXIT,DRL,VAGENER,FOUND,CHECK,DIC,DRGARY,LDNAME,Y,VAPSTR,MTCHSTR,DRLCNT
- N DRGNM2,MTCHSTR,DRLCNT,DRSV,CSSCH,VAPIDSTR,VAPIEN,CSPROD,VAPIENCNT,DINACT
- S (CHECK,VAPSTR)="",(DRLCNT,DRSV)=0,CSPROD=0,DINACT=""
- I +$G(VAPIN) S VAPSTR=$$GET1^DIQ(50.68,+$G(VAPIN),2,"E")
- S VAPIDSTR=$$GET1^DIQ(50.68,+$G(VAPIN),6,"E")
- W !!,"Remote site drug name: "_$G(DRGNM)
- I $L(VAPIDSTR) S VAPIEN=0 F S VAPIEN=$O(^PSNDF(50.68,"C",VAPIDSTR,VAPIEN)) Q:'VAPIEN D
- . S CSSCH=$$GET1^DIQ(50.68,VAPIEN,19,"I")
- . I '$G(CSPROD),(+CSSCH>0),(+CSSCH<6) D Q
- . . S CSPROD=1
- . . W !!,"VA Product ID: ",VAPIDSTR," CS FEDERAL SCHEDULE: ",+CSSCH
- . . W !!,"Controlled substances are not allowed for ONEVA Pharmacy dispensing.",!
- . . D PAUSE^VALM1
- . S VAPIEN(VAPIEN)=VAPSTR
- ;
- I CSPROD=1 Q 0
- I '$D(VAPIEN(VAPIN)) W !!,"Remote site VA PRODUCT IDENTIFIER: "_VAPIDSTR_" *** NOT FOUND ***",!
- ;
- ; Look for drug name
- I $D(^PSDRUG("B",DRGNM)) D
- . S LDIEN=0 F S LDIEN=$O(^PSDRUG("B",DRGNM,LDIEN)) Q:'LDIEN D
- . . S VAPIEN=""
- . . ; Filter out inactive, not on outpatient formulary, not Pharmacy orderable, not linked to VAPIDSTR, CS
- . . I $$GET1^DIQ(50,LDIEN,63,"I")'["O" Q
- . . I $$GET1^DIQ(50,LDIEN,2.1,"I")="" Q
- . . S DINACT=$$GET1^DIQ(50,LDIEN,100,"I")
- . . I (DINACT>0),($$DT^XLFDT>DINACT) Q
- . . S VAPIEN=$$GET1^DIQ(50,LDIEN,22,"I") I VAPIEN="" Q ; 740
- . . I $$GET1^DIQ(50,LDIEN,3) I $$GET1^DIQ(50,LDIEN,3)>0&($$GET1^DIQ(50,LDIEN,3)<6) Q
- . . I '$D(DRGARY(LDIEN)) S DRGARY(LDIEN)="",DRLCNT=DRLCNT+1
- ;
- ; Quit if drug matched name and user accepted
- I DRLCNT=1 D I CHECK Q LDIEN
- . S LDIEN=$O(DRGARY(0))
- . S DRSV=LDIEN ;Save single match to filter from displaying from local drug
- . S LDNAME=$$GET1^DIQ(50,LDIEN,.01,"E")
- . W !,"Matching Drug Found for Dispensing: "_LDNAME
- . S CHECK=$$DIR
- ;
- I DRLCNT=0 W !,"No active drug name match found for "_DRGNM_"."
- ;
- S CHECK="",DRLCNT=0 K DRGARY
- S VAPIEN=0 F S VAPIEN=$O(VAPIEN(VAPIEN)) Q:'VAPIEN D
- . S VAPSTR=$$GET1^DIQ(50.68,VAPIEN,2,"E")
- . ;Loop thru the APR index in 50
- . S LDIEN=0 F S LDIEN=$O(^PSDRUG("APR",VAPIEN,LDIEN)) Q:'LDIEN D
- . . ;filter out inactive, drugs not on outpatient formulary, not linked to Pharmacy orderable, 'CS
- . . I $$GET1^DIQ(50,LDIEN,100,"I"),(DT'<$$GET1^DIQ(50,LDIEN,100,"I")) Q
- . . I $$GET1^DIQ(50,LDIEN,63,"I")'["O" Q
- . . I $$GET1^DIQ(50,LDIEN,2.1,"I")="" Q
- . . I $$GET1^DIQ(50,LDIEN,3),$$GET1^DIQ(50,LDIEN,3)>0&($$GET1^DIQ(50,LDIEN,3)<6)
- . . I '$D(DRGARY(LDIEN)) S DRGARY(LDIEN)=VAPSTR,DRLCNT=DRLCNT+1
- ;
- ;Filter out drug already presented
- I DRSV,$D(DRGARY(DRSV)) K DRGARY(DRSV) S DRLCNT=DRLCNT-1
- ;
- I DRLCNT D
- . W !!,"Drugs matching the VA PRODUCT IDENTIFIER:"
- . 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 Drug from list ("_1_"-"_DRLCNT_") "_"or <enter> to quit processing."
- . D ^DIR K DIR
- . I +Y<1!($D(DUOUT))!($D(DTOUT)) S Y="",DRLCNT=0
- . I Y>0 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)) S DRLCNT=0 ;DRLCNT=0 causes Drug: to be prompted for
- ;
- I DRLCNT,$G(Y) Q LDIEN ;a drug was accepted
- ;
- ;No VAPIEN, or no drug was selected or no drugs were found
- K DIR
- W !
- W !,"No other local match could be found for "_DRGNM_"."
- W !,"You may need to update your Drug file to process this order"
- D PAUSE^VALM1
- Q 0
- ;
- ; 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 15913 printed Jan 18, 2025@03:35:29 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,736,740**;DEC 1997;Build 18
- +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 ;pso*7*736
- SET HLP("SUBSCRIBER")="^^^^200OneVA-HCHS-PSF"
- +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 IEN
- +3 NEW RXSITE,RXNUM,DNAME,QTY,REFILLS,DSUPP,EXPDT,ISSDATE,STOPDT,LFDT,SIG,DETAIL,STAT,STATNM,STATERR,DDONE,I,VAPIEN,VAFQDN,DAT
- +4 ; p736 - removed code to handle overflow nodes as value is already passed in the correct format
- +5 SET RXSITE=$PIECE(DATA,ORFS,2)
- SET RXNUM=$PIECE(DATA,ORFS,3)
- SET DNAME=$PIECE(DATA,ORFS,4)
- SET QTY=$PIECE(DATA,ORFS,5)
- +6 if DNAME=""
- QUIT
- +7 SET REFILLS=$PIECE(DATA,ORFS,6)
- SET DSUPP=$PIECE(DATA,ORFS,7)
- SET EXPDT=$PIECE(DATA,ORFS,8)
- SET ISSDATE=$PIECE(DATA,ORFS,9)
- +8 SET STOPDT=$PIECE(DATA,ORFS,10)
- SET LFDT=$PIECE(DATA,ORFS,11)
- SET SIG=$PIECE(DATA,ORFS,12)
- SET DETAIL=$PIECE(DATA,ORFS,13)
- +9 SET STAT=$PIECE(DATA,ORFS,14)
- if STAT=""
- QUIT
- +10 ; VA Product IEN
- +11 SET VAPIEN=$PIECE(DATA,ORFS,15)
- +12 SET VAFQDN=$PIECE(DATA,ORFS,16)
- +13 if STAT=""
- QUIT
- +14 if 'RXSITE!('RXNUM)
- QUIT
- +15 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_VAPIEN_U_DNAME_U_VAFQDN
- +16 SET @HLDAT@(DFN,RXSITE,STAT,DNAME,"SIG")=SIG
- +17 SET @HLDAT@(DFN,RXSITE,STAT,DNAME,"DETAIL")=DETAIL
- +18 QUIT
- +19 ; 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
- +2 NEW ORFS,ORCS,ORRS,ORES,ORSS,HLQUIT,ORQUIT,RESP,RETDFN,VAPIEN,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 IEN. 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 ; PSO 740
- +22 IF '$$VALDRGINT^PSORRPA1(LOCDRUG,"R",RXNUM)
- SET DIR(0)="FO"
- SET DIR("A")="Press RETURN to continue"
- DO ^DIR
- QUIT
- +23 ; if we got this far, fill is most likely happening and remote
- +24 ; worklist needs to be rebuilt when returning, so set flag.
- +25 SET PSORRBLD=1
- +26 ;
- +27 SET (FILLDT,PSOREF("FILL DATE"))=DT
- +28 DO INIT^HLFNC2(HLPROT,.HL)
- +29 DO BLDPID^PSOTPHL2(DFN,"",.PSORRDAT,.HL,.ERR)
- +30 SET DONE=0
- +31 FOR PSOHCNT=1:1
- Begin DoDot:1
- +32 IF '$DATA(PSORRDAT(PSOHCNT))
- SET DONE=1
- QUIT
- +33 SET @HLARR@(1)=$GET(@HLARR@(1))_PSORRDAT(PSOHCNT)
- End DoDot:1
- if DONE
- QUIT
- +34 ;S @HLARR@(2)="ORC^RF^"_RXNUM_"~"_REMSITE_"~"_$$GET1^DIQ(4,REMSIEN,60,"E")_"^^^^^^^"_FILLDT_U_DUZ_"~"_PHARMLN_"~"_PHARMFN_"~"_PHARMMI_"^^^~~~"_LOCSITE_U_PHONE
- +35 SET @HLARR@(2)="ORC^RF^"_RXNUM_"~"_REMSITE_"~"_$$FQDN^PSORWRAP(,REMSIEN)_"^^^^^^^"_FILLDT_U_DUZ_"~"_PHARMLN_"~"_PHARMFN_"~"_PHARMMI_"^^^~~~"_LOCSITE_U_PHONE
- +36 SET @HLARR@(3)="RXO^^^^^^^^"_MW_"~"_$$OPAI_"~~"_LOCSITE
- +37 WRITE !!,"Processing refill request. Please be patient as it may take a moment"
- +38 WRITE !,"for the host site to respond and generate your label data...",!
- +39 SET RMSDOM=$$FQDN^PSORWRAP(,REMSIEN)
- +40 SET DOMOVR=REMSITE_"~"_RMSDOM_"~DNS"
- +41 SET HLP("SUBSCRIBER")="^^^^"_DOMOVR
- +42 DO DIRECT^HLMA(HLPROT,"GM",1,.RESP,"",.HLP)
- +43 DO READMSG^PSORRX2(.HLDAT,"RF",LOCDRUG)
- +44 KILL @HLDAT,@HLARR
- +45 QUIT
- +46 ; 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,VAPIEN,HL,ERR
- +2 NEW PSOHCNT,DONE,PSORRDAT,CSVAL,REMSIEN,PSOHLNK,PSOLNKDN,REMDRUG,Y,EXE,DOMOVR,RMSDOM,PSOHLSV,VAPID
- +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 process a partial fill."
- 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 process a partial fill for Rx # ",PRXNUM,"."
- SET DIR(0)="FO"
- SET DIR("A")="Press RETURN to continue"
- DO ^DIR
- QUIT
- +21 ; PSO 740
- +22 IF '$$VALDRGINT^PSORRPA1(LOCDRUG,"P",PRXNUM)
- SET DIR(0)="FO"
- SET DIR("A")="Press RETURN to continue"
- DO ^DIR
- QUIT
- +23 ; if we got this far, fill is most likely happening and remote
- +24 ; worklist needs to be rebuilt when returning, so set flag.
- +25 SET PSORRBLD=1
- +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,VAPIN) ;p736 - VAPIEN directly passed into DRUGMTCH
- +1 ; returns -1 if a match was found but user said NO
- +2 ;
- +3 ; p736 - ensures DRGNM is valid
- IF $GET(DRGNM)']""
- QUIT ""
- +4 ;
- +5 NEW LDIEN,MATCH,EXIT,DRL,VAGENER,FOUND,CHECK,DIC,DRGARY,LDNAME,Y,VAPSTR,MTCHSTR,DRLCNT
- +6 NEW DRGNM2,MTCHSTR,DRLCNT,DRSV,CSSCH,VAPIDSTR,VAPIEN,CSPROD,VAPIENCNT,DINACT
- +7 SET (CHECK,VAPSTR)=""
- SET (DRLCNT,DRSV)=0
- SET CSPROD=0
- SET DINACT=""
- +8 IF +$GET(VAPIN)
- SET VAPSTR=$$GET1^DIQ(50.68,+$GET(VAPIN),2,"E")
- +9 SET VAPIDSTR=$$GET1^DIQ(50.68,+$GET(VAPIN),6,"E")
- +10 WRITE !!,"Remote site drug name: "_$GET(DRGNM)
- +11 IF $LENGTH(VAPIDSTR)
- SET VAPIEN=0
- FOR
- SET VAPIEN=$ORDER(^PSNDF(50.68,"C",VAPIDSTR,VAPIEN))
- if 'VAPIEN
- QUIT
- Begin DoDot:1
- +12 SET CSSCH=$$GET1^DIQ(50.68,VAPIEN,19,"I")
- +13 IF '$GET(CSPROD)
- IF (+CSSCH>0)
- IF (+CSSCH<6)
- Begin DoDot:2
- +14 SET CSPROD=1
- +15 WRITE !!,"VA Product ID: ",VAPIDSTR," CS FEDERAL SCHEDULE: ",+CSSCH
- +16 WRITE !!,"Controlled substances are not allowed for ONEVA Pharmacy dispensing.",!
- +17 DO PAUSE^VALM1
- End DoDot:2
- QUIT
- +18 SET VAPIEN(VAPIEN)=VAPSTR
- End DoDot:1
- +19 ;
- +20 IF CSPROD=1
- QUIT 0
- +21 IF '$DATA(VAPIEN(VAPIN))
- WRITE !!,"Remote site VA PRODUCT IDENTIFIER: "_VAPIDSTR_" *** NOT FOUND ***",!
- +22 ;
- +23 ; Look for drug name
- +24 IF $DATA(^PSDRUG("B",DRGNM))
- Begin DoDot:1
- +25 SET LDIEN=0
- FOR
- SET LDIEN=$ORDER(^PSDRUG("B",DRGNM,LDIEN))
- if 'LDIEN
- QUIT
- Begin DoDot:2
- +26 SET VAPIEN=""
- +27 ; Filter out inactive, not on outpatient formulary, not Pharmacy orderable, not linked to VAPIDSTR, CS
- +28 IF $$GET1^DIQ(50,LDIEN,63,"I")'["O"
- QUIT
- +29 IF $$GET1^DIQ(50,LDIEN,2.1,"I")=""
- QUIT
- +30 SET DINACT=$$GET1^DIQ(50,LDIEN,100,"I")
- +31 IF (DINACT>0)
- IF ($$DT^XLFDT>DINACT)
- QUIT
- +32 ; 740
- SET VAPIEN=$$GET1^DIQ(50,LDIEN,22,"I")
- IF VAPIEN=""
- QUIT
- +33 IF $$GET1^DIQ(50,LDIEN,3)
- IF $$GET1^DIQ(50,LDIEN,3)>0&($$GET1^DIQ(50,LDIEN,3)<6)
- QUIT
- +34 IF '$DATA(DRGARY(LDIEN))
- SET DRGARY(LDIEN)=""
- SET DRLCNT=DRLCNT+1
- End DoDot:2
- End DoDot:1
- +35 ;
- +36 ; Quit if drug matched name and user accepted
- +37 IF DRLCNT=1
- Begin DoDot:1
- +38 SET LDIEN=$ORDER(DRGARY(0))
- +39 ;Save single match to filter from displaying from local drug
- SET DRSV=LDIEN
- +40 SET LDNAME=$$GET1^DIQ(50,LDIEN,.01,"E")
- +41 WRITE !,"Matching Drug Found for Dispensing: "_LDNAME
- +42 SET CHECK=$$DIR
- End DoDot:1
- IF CHECK
- QUIT LDIEN
- +43 ;
- +44 IF DRLCNT=0
- WRITE !,"No active drug name match found for "_DRGNM_"."
- +45 ;
- +46 SET CHECK=""
- SET DRLCNT=0
- KILL DRGARY
- +47 SET VAPIEN=0
- FOR
- SET VAPIEN=$ORDER(VAPIEN(VAPIEN))
- if 'VAPIEN
- QUIT
- Begin DoDot:1
- +48 SET VAPSTR=$$GET1^DIQ(50.68,VAPIEN,2,"E")
- +49 ;Loop thru the APR index in 50
- +50 SET LDIEN=0
- FOR
- SET LDIEN=$ORDER(^PSDRUG("APR",VAPIEN,LDIEN))
- if 'LDIEN
- QUIT
- Begin DoDot:2
- +51 ;filter out inactive, drugs not on outpatient formulary, not linked to Pharmacy orderable, 'CS
- +52 IF $$GET1^DIQ(50,LDIEN,100,"I")
- IF (DT'<$$GET1^DIQ(50,LDIEN,100,"I"))
- QUIT
- +53 IF $$GET1^DIQ(50,LDIEN,63,"I")'["O"
- QUIT
- +54 IF $$GET1^DIQ(50,LDIEN,2.1,"I")=""
- QUIT
- +55 IF $$GET1^DIQ(50,LDIEN,3)
- IF $$GET1^DIQ(50,LDIEN,3)>0&($$GET1^DIQ(50,LDIEN,3)<6)
- +56 IF '$DATA(DRGARY(LDIEN))
- SET DRGARY(LDIEN)=VAPSTR
- SET DRLCNT=DRLCNT+1
- End DoDot:2
- End DoDot:1
- +57 ;
- +58 ;Filter out drug already presented
- +59 IF DRSV
- IF $DATA(DRGARY(DRSV))
- KILL DRGARY(DRSV)
- SET DRLCNT=DRLCNT-1
- +60 ;
- +61 IF DRLCNT
- Begin DoDot:1
- +62 WRITE !!,"Drugs matching the VA PRODUCT IDENTIFIER:"
- +63 SET (MATCH,EXIT)=0
- +64 NEW PSODRGL,PSODRGLI,PSODRGL0,PSODRGID,PSODRGC
- SET DIR(0)=""
- +65 FOR PSODRGLI=0:0
- SET PSODRGLI=$ORDER(DRGARY(PSODRGLI))
- if 'PSODRGLI
- QUIT
- Begin DoDot:2
- +66 SET PSODRGL0=$GET(^PSDRUG(PSODRGLI,0))
- SET PSODRGID=$GET(^PSDRUG(PSODRGLI,"I"))
- +67 if $TRANSLATE(PSODRGL0,"^")=""
- QUIT
- SET PSODRGC=$GET(PSODRGC)+1
- +68 SET DIR(0)=DIR(0)_$SELECT(DIR(0)]"":";",1:"")
- +69 ; Increased drug name length from 30 to 40 - PSO*7*594
- +70 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)
- +71 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:2
- +72 ;1:$G(PSODRGC)"
- SET DIR(0)="SO^"_DIR(0)
- SET DIR("L")=""
- +73 SET DIR("A")="Select Drug from list ("_1_"-"_DRLCNT_") "_"or <enter> to quit processing."
- +74 DO ^DIR
- KILL DIR
- +75 IF +Y<1!($DATA(DUOUT))!($DATA(DTOUT))
- SET Y=""
- SET DRLCNT=0
- +76 IF Y>0
- SET LDIEN=+Y(0)
- +77 IF $GET(LDIEN)
- KILL DIR
- SET DIR(0)="Y"
- SET DIR("A")="Would you like to use this drug"
- DO ^DIR
- +78 ;DRLCNT=0 causes Drug: to be prompted for
- IF +Y<1!($DATA(DUOUT))!($DATA(DTOUT))
- SET DRLCNT=0
- End DoDot:1
- +79 ;
- +80 ;a drug was accepted
- IF DRLCNT
- IF $GET(Y)
- QUIT LDIEN
- +81 ;
- +82 ;No VAPIEN, or no drug was selected or no drugs were found
- +83 KILL DIR
- +84 WRITE !
- +85 WRITE !,"No other local match could be found for "_DRGNM_"."
- +86 WRITE !,"You may need to update your Drug file to process this order"
- +87 DO PAUSE^VALM1
- +88 QUIT 0
- +89 ;
- +90 ; TEXT to build prompts
- +91 ;;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