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

PSORRX1.m

Go to the documentation of this file.
  1. 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
  1. ;
  1. ;Reference ^PSDRUG( supported by DBIA 221
  1. ;Reference ^PSNDF supported by DBIA 2195
  1. Q
  1. ;
  1. REMOTERX(DFN,PSOSITE) ;
  1. N RXRES,MSG,HLARR,CNT,RXDAT,HLARR,HLPROT,DONE,ORFS,ORCS,ORRS,ORES,ORSS,ORQUIT,HLQUIT,HLDAT,TFLIST,HLP,HLNODE,HLNEXT,HLINSTN
  1. N PID1,PID4,PID5,PID6,TFDAT,LOOP,RXMSG,PSORRDAT,PSOHCNT,ERR,HL,PSORRDAT,ORERR,SITE
  1. S HLARR=$NA(^TMP("HLS",$J)) K @HLARR
  1. S HLDAT=$NA(^XTMP("PSORRX1",$J)) K @HLDAT
  1. I 'DFN Q
  1. S SITE=$P($$SITE^VASITE(),U)
  1. S TFSTRING=$$GET1^DIQ(2,DFN,991.01,"I")_"^^^USVHA^NI^"_SITE
  1. S HLPROT="PSO REMOTE RX QBP-Q13 EVENT"
  1. D INIT^HLFNC2(HLPROT,.HL)
  1. D BLDPID^PSOTPHL2(DFN,"",.PSORRDAT,.HL,.ERR)
  1. I $D(ERR) W !,"There was a problem creating the PID segment for this patient.",!,"Please contact technical support.",!
  1. S @HLARR@(1)="QPD^Q13~Active Prescriptions~HL70471^"
  1. S DONE=0
  1. F PSOHCNT=1:1 D Q:DONE
  1. .I '$D(PSORRDAT(PSOHCNT)) S DONE=1 Q
  1. .S @HLARR@(2)=$G(@HLARR@(2))_PSORRDAT(PSOHCNT)
  1. S @HLARR@(3)="RCP^I"
  1. S HLP("SUBSCRIBER")="^^^^200OneVA-HCHS-PSF" ;pso*7*736
  1. D DIRECT^HLMA(HLPROT,"GM",1,.RXDAT,"",.HLP)
  1. 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)
  1. S HLQUIT=0,ORQUIT="",ORERR=""
  1. I ($P(RXDAT,"^",2)]"")!($P(RXDAT,"^",3)]"") D Q
  1. .W !,"The system is down or not responding"_$S($P(RXDAT,"^",3)]"":" ("_$P(RXDAT,"^",3)_").",1:".")
  1. .W !,"Could not query prescriptions at other VA Pharmacy locations.",!
  1. .K DIR S DIR(0)="FO",DIR("A")="Press RETURN to continue" D ^DIR
  1. F X HLNEXT Q:HLQUIT'>0!(ORQUIT'="") D
  1. .N LOOP
  1. .S LOOP=0 F S LOOP=$O(HLNODE(LOOP)) Q:LOOP="" S HLNODE=HLNODE_HLNODE(LOOP)
  1. .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)
  1. .I $E(HLNODE,1,3)="ERR" D LOGERR(DFN,.HLNODE,.HLDAT) S ORQUIT=$P(HLNODE,ORFS,4)
  1. .I $E(HLNODE,1,3)="RDT" D
  1. ..S @HLDAT@(0)=$$FMADD^XLFDT($$NOW^XLFDT,2)_U_$$NOW^XLFDT
  1. ..D RXPRSE(DFN,.HLNODE,.HLDAT)
  1. Q
  1. LOGERR(DFN,DATA,HLDAT,NMSG) ;
  1. N HLERR
  1. S NMSG=$G(NMSG,"")
  1. S HLERR=$S(NMSG'="":NMSG,1:$P(DATA,ORFS,9))
  1. S:'$D(@HLDAT@(0)) @HLDAT@(0)=$$FMADD^XLFDT($$NOW^XLFDT,2)_U_$$NOW^XLFDT
  1. S @HLDAT@(DFN,"ERR")="<"_HLERR_">"
  1. 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
  1. Q
  1. ; parse rx data from RDF segment
  1. RXPRSE(DFN,DATA,HLDAT) ;
  1. ;RDF|14|Site Number~Rx Number~Drug Name~Quantity~Refills~Days Supply~Expiration Date
  1. ;~Issue Date~Stop Date~Last Fill Date~Sig~Detail~Status~VA Product IEN
  1. N RXSITE,RXNUM,DNAME,QTY,REFILLS,DSUPP,EXPDT,ISSDATE,STOPDT,LFDT,SIG,DETAIL,STAT,STATNM,STATERR,DDONE,I,VAPIEN,VAFQDN,DAT
  1. ; p736 - removed code to handle overflow nodes as value is already passed in the correct format
  1. S RXSITE=$P(DATA,ORFS,2),RXNUM=$P(DATA,ORFS,3),DNAME=$P(DATA,ORFS,4),QTY=$P(DATA,ORFS,5)
  1. Q:DNAME=""
  1. S REFILLS=$P(DATA,ORFS,6),DSUPP=$P(DATA,ORFS,7),EXPDT=$P(DATA,ORFS,8),ISSDATE=$P(DATA,ORFS,9)
  1. S STOPDT=$P(DATA,ORFS,10),LFDT=$P(DATA,ORFS,11),SIG=$P(DATA,ORFS,12),DETAIL=$P(DATA,ORFS,13)
  1. S STAT=$P(DATA,ORFS,14) Q:STAT=""
  1. ; VA Product IEN
  1. S VAPIEN=$P(DATA,ORFS,15)
  1. S VAFQDN=$P(DATA,ORFS,16)
  1. Q:STAT=""
  1. Q:'RXSITE!('RXNUM)
  1. 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
  1. S @HLDAT@(DFN,RXSITE,STAT,DNAME,"SIG")=SIG
  1. S @HLDAT@(DFN,RXSITE,STAT,DNAME,"DETAIL")=DETAIL
  1. Q
  1. ; build and send refill request
  1. REFREQ ;
  1. N PHARM,PHONE,LOCSITE,DSUPP,MW,FILLDT,MSG,RXNUM,HLSTR,REMSITE,PHARMLN,PHARMFN,PHARMMI,TFSTRING,HLPROT,LOCDRUG,REMDRUG
  1. N ORFS,ORCS,ORRS,ORES,ORSS,HLQUIT,ORQUIT,RESP,RETDFN,VAPIEN,DONE,PSORRDAT,PSOHCNT,DONE,HL,CSVAL,DIR,REMSIEN,PSOHLNK,PSOLNKDN,DOMOVR,RMSDOM,PSOHLSV
  1. S HLARR=$NA(^TMP("HLS",$J)) K @HLARR
  1. S HLDAT=$NA(^XTMP("REFREQ^PSORRX1",$J)) K @HLDAT
  1. S HLPROT="PSO REMOTE RX RDS-O13 EVENT"
  1. S MW="W"
  1. D FULL^VALM1
  1. S LOCSITE=$$STA^XUAF4(DUZ(2))
  1. S PHARM=$$GET1^DIQ(200,DUZ,.01,"E"),PHARMLN=$P(PHARM,","),PHARMFN=$P($P(PHARM,",",2)," "),PHARMMI=$P($P(PHARM,",",2)," ",2)
  1. S PHONE=$$GET1^DIQ(200,DUZ,.132,"E")
  1. S RXNUM=$P(PSOLST(ORN),U,2) I 'RXNUM S MSG(1)="Invalid Rx #. Please contact technical support." Q
  1. 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
  1. S REMSITE=$P(PSOLST(ORN),U,4) ;,REMSIEN=$O(^DIC(4,"D",REMSITE,0))
  1. S REMSIEN=$$FIND1^DIC(4,,"X",REMSITE,"D","I $P(^(0),U,11)=""N"",'$P($G(^(99)),U,4)") Q:'REMSIEN
  1. S PSOREF("DFLG")=""
  1. S REMDRUG=$P(REMDATA,U,11),VAPID=$P(REMDATA,U,10)
  1. 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
  1. S LOCDRUG=$$DRUGMTCH(REMDRUG,VAPID)
  1. I $G(LOCDRUG)=-1 Q ; user entered no so no reason to prompt again
  1. 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
  1. ; PSO 740
  1. I '$$VALDRGINT^PSORRPA1(LOCDRUG,"R",RXNUM) S DIR(0)="FO",DIR("A")="Press RETURN to continue" D ^DIR Q
  1. ; if we got this far, fill is most likely happening and remote
  1. ; worklist needs to be rebuilt when returning, so set flag.
  1. S PSORRBLD=1
  1. ;
  1. S (FILLDT,PSOREF("FILL DATE"))=DT
  1. D INIT^HLFNC2(HLPROT,.HL)
  1. D BLDPID^PSOTPHL2(DFN,"",.PSORRDAT,.HL,.ERR)
  1. S DONE=0
  1. F PSOHCNT=1:1 D Q:DONE
  1. .I '$D(PSORRDAT(PSOHCNT)) S DONE=1 Q
  1. .S @HLARR@(1)=$G(@HLARR@(1))_PSORRDAT(PSOHCNT)
  1. ;S @HLARR@(2)="ORC^RF^"_RXNUM_"~"_REMSITE_"~"_$$GET1^DIQ(4,REMSIEN,60,"E")_"^^^^^^^"_FILLDT_U_DUZ_"~"_PHARMLN_"~"_PHARMFN_"~"_PHARMMI_"^^^~~~"_LOCSITE_U_PHONE
  1. S @HLARR@(2)="ORC^RF^"_RXNUM_"~"_REMSITE_"~"_$$FQDN^PSORWRAP(,REMSIEN)_"^^^^^^^"_FILLDT_U_DUZ_"~"_PHARMLN_"~"_PHARMFN_"~"_PHARMMI_"^^^~~~"_LOCSITE_U_PHONE
  1. S @HLARR@(3)="RXO^^^^^^^^"_MW_"~"_$$OPAI_"~~"_LOCSITE
  1. W !!,"Processing refill request. Please be patient as it may take a moment"
  1. W !,"for the host site to respond and generate your label data...",!
  1. S RMSDOM=$$FQDN^PSORWRAP(,REMSIEN)
  1. S DOMOVR=REMSITE_"~"_RMSDOM_"~DNS"
  1. S HLP("SUBSCRIBER")="^^^^"_DOMOVR
  1. D DIRECT^HLMA(HLPROT,"GM",1,.RESP,"",.HLP)
  1. D READMSG^PSORRX2(.HLDAT,"RF",LOCDRUG)
  1. K @HLDAT,@HLARR
  1. Q
  1. ; build and send partial fill request
  1. PARTIAL() ;
  1. N DIR,DONE,I,PRMPDAT,VAR,PRXNUM,PHARM,PHARMLN,PHARMFN,PHARMMI,PHONE,RXNUM,HLPROT,TFSTRING,HLARR,PHONE,REMSITE,HLDAT,LOCDRUG,EXIT,VAPIEN,HL,ERR
  1. N PSOHCNT,DONE,PSORRDAT,CSVAL,REMSIEN,PSOHLNK,PSOLNKDN,REMDRUG,Y,EXE,DOMOVR,RMSDOM,PSOHLSV,VAPID
  1. S HLPROT="PSO REMOTE RX RDS-O13 EVENT"
  1. S HLDAT=$NA(^XTMP("PARTIAL^PSORRX1",$J)) K @HLDAT
  1. S HLARR=$NA(^TMP("HLS",$J)) K @HLARR
  1. D FULL^VALM1
  1. 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
  1. S LOCSITE=$$STA^XUAF4(DUZ(2))
  1. S PHONE=$$GET1^DIQ(200,DUZ,.132,"E")
  1. S PRXNUM=$P(PSOLST(ORN),U,2) I 'PRXNUM S MSG(1)="Invalid Rx #. Please contact technical support." Q
  1. S REMSITE=$P(PSOLST(ORN),U,4)
  1. S REMSIEN=$$FIND1^DIC(4,,"X",REMSITE,"D","I $P(^(0),U,11)=""N"",'$P($G(^(99)),U,4)") Q:'REMSIEN
  1. S DONE=0,CNT=1
  1. ; prompt for fields that would normally be prompted for a local partial fill.
  1. D FULL^VALM1
  1. S REMDRUG=$P(REMDATA,U,11),VAPID=$P(REMDATA,U,10)
  1. 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
  1. S LOCDRUG=$$DRUGMTCH(REMDRUG,VAPID)
  1. I $G(LOCDRUG)=-1 Q ; user entered no so no reason to prompt again
  1. 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
  1. ; PSO 740
  1. I '$$VALDRGINT^PSORRPA1(LOCDRUG,"P",PRXNUM) S DIR(0)="FO",DIR("A")="Press RETURN to continue" D ^DIR Q
  1. ; if we got this far, fill is most likely happening and remote
  1. ; worklist needs to be rebuilt when returning, so set flag.
  1. S PSORRBLD=1
  1. S EXIT=0
  1. S PDATE=DT
  1. S MW="W"
  1. F I=1:1 D Q:DONE!(EXIT)
  1. .S PRMPDAT=$T(PRMPTXT+I)
  1. .S PRMPDAT=$P(PRMPDAT,";;",2)
  1. .I PRMPDAT="Q" S DONE=1 Q
  1. .K DIR
  1. .S DIR(0)=$P(PRMPDAT,"|"),DIR("A")=$P(PRMPDAT,"|",2),VAR=$P(PRMPDAT,"|",4) S:$L($P(PRMPDAT,"|",3)) DIR("B")=$P(PRMPDAT,"|",3)
  1. .I $G(DIR("B"))["~" D
  1. ..S EXE=$TR(DIR("B"),"~","^") X EXE S DIR("B")=DEF
  1. .D ^DIR
  1. .I Y="^" S EXIT=1 Q
  1. .S @VAR=$S($P(DIR(0),"^")["P":$P(Y,U,2),1:Y) ;*499
  1. K DEF
  1. I EXIT W !,"Cancelling partial fill request.",! K DIR S DIR(0)="FO",DIR("A")="Press RETURN to continue" D ^DIR Q
  1. ; if we got this far, fill attempt is happening and remote worklist
  1. ; needs to be rebuilt when returning, so set flag.
  1. S PSORRBLD=1
  1. S PHARMLN=$P(PHARM,","),PHARMFN=$P($P(PHARM,",",2)," "),PHARMMI=$P($P(PHARM,",",2)," ",2)
  1. D INIT^HLFNC2(HLPROT,.HL)
  1. D BLDPID^PSOTPHL2(DFN,"",.PSORRDAT,.HL,.ERR)
  1. S DONE=0
  1. F PSOHCNT=1:1 D Q:DONE
  1. .I '$D(PSORRDAT(PSOHCNT)) S DONE=1 Q
  1. .S @HLARR@(1)=$G(@HLARR@(1))_PSORRDAT(PSOHCNT)
  1. S @HLARR@(2)="ORC^PF^"_PRXNUM_"~"_REMSITE_"~"_$$FQDN^PSORWRAP(,REMSIEN)_"^^^^^^^"_PDATE_"^"_DUZ_"~"_PHARMLN_"~"_PHARMFN_"~"_PHARMMI_"^^^~~~"_LOCSITE_U_PHONE
  1. S @HLARR@(3)="RXO^1^"_QTY_"^^^^^^"_MW_"~"_$$OPAI_"~~"_LOCSITE_"^^^"_DSUPP
  1. S @HLARR@(4)="NTE^1^L^"_REMARKS
  1. W !!,"Processing partial fill request. Please be patient as it may take a moment"
  1. W !,"for the host site to respond and generate your label data...",!
  1. S RMSDOM=$$FQDN^PSORWRAP(,REMSIEN)
  1. S DOMOVR=REMSITE_"~"_RMSDOM_"~DNS"
  1. S HLP("SUBSCRIBER")="^^^^"_DOMOVR
  1. D DIRECT^HLMA(HLPROT,"GM",1,.HL,"",.HLP)
  1. I $P(HL,U,2) D Q
  1. . W !,"An error was encountered when trying to process the results",!,"from the refill/partial fill request.",!!,$P(HL,U,3)
  1. . K DIR S DIR(0)="FO",DIR("A")="Press RETURN to continue" D ^DIR
  1. . D CL
  1. ; clean up variables used
  1. D READMSG^PSORRX2(.HLDAT,"PR",LOCDRUG)
  1. CL ;
  1. K PDATE,QTY,DSUPP,PHARM,REMARKS,MW
  1. K @HLDAT,@HLARR
  1. Q
  1. ;
  1. DRUGMTCH(DRGNM,VAPIN) ;p736 - VAPIEN directly passed into DRUGMTCH
  1. ; returns -1 if a match was found but user said NO
  1. ;
  1. I $G(DRGNM)']"" Q "" ; p736 - ensures DRGNM is valid
  1. ;
  1. N LDIEN,MATCH,EXIT,DRL,VAGENER,FOUND,CHECK,DIC,DRGARY,LDNAME,Y,VAPSTR,MTCHSTR,DRLCNT
  1. N DRGNM2,MTCHSTR,DRLCNT,DRSV,CSSCH,VAPIDSTR,VAPIEN,CSPROD,VAPIENCNT,DINACT
  1. S (CHECK,VAPSTR)="",(DRLCNT,DRSV)=0,CSPROD=0,DINACT=""
  1. I +$G(VAPIN) S VAPSTR=$$GET1^DIQ(50.68,+$G(VAPIN),2,"E")
  1. S VAPIDSTR=$$GET1^DIQ(50.68,+$G(VAPIN),6,"E")
  1. W !!,"Remote site drug name: "_$G(DRGNM)
  1. I $L(VAPIDSTR) S VAPIEN=0 F S VAPIEN=$O(^PSNDF(50.68,"C",VAPIDSTR,VAPIEN)) Q:'VAPIEN D
  1. . S CSSCH=$$GET1^DIQ(50.68,VAPIEN,19,"I")
  1. . I '$G(CSPROD),(+CSSCH>0),(+CSSCH<6) D Q
  1. . . S CSPROD=1
  1. . . W !!,"VA Product ID: ",VAPIDSTR," CS FEDERAL SCHEDULE: ",+CSSCH
  1. . . W !!,"Controlled substances are not allowed for ONEVA Pharmacy dispensing.",!
  1. . . D PAUSE^VALM1
  1. . S VAPIEN(VAPIEN)=VAPSTR
  1. ;
  1. I CSPROD=1 Q 0
  1. I '$D(VAPIEN(VAPIN)) W !!,"Remote site VA PRODUCT IDENTIFIER: "_VAPIDSTR_" *** NOT FOUND ***",!
  1. ;
  1. ; Look for drug name
  1. I $D(^PSDRUG("B",DRGNM)) D
  1. . S LDIEN=0 F S LDIEN=$O(^PSDRUG("B",DRGNM,LDIEN)) Q:'LDIEN D
  1. . . S VAPIEN=""
  1. . . ; Filter out inactive, not on outpatient formulary, not Pharmacy orderable, not linked to VAPIDSTR, CS
  1. . . I $$GET1^DIQ(50,LDIEN,63,"I")'["O" Q
  1. . . I $$GET1^DIQ(50,LDIEN,2.1,"I")="" Q
  1. . . S DINACT=$$GET1^DIQ(50,LDIEN,100,"I")
  1. . . I (DINACT>0),($$DT^XLFDT>DINACT) Q
  1. . . S VAPIEN=$$GET1^DIQ(50,LDIEN,22,"I") I VAPIEN="" Q ; 740
  1. . . I $$GET1^DIQ(50,LDIEN,3) I $$GET1^DIQ(50,LDIEN,3)>0&($$GET1^DIQ(50,LDIEN,3)<6) Q
  1. . . I '$D(DRGARY(LDIEN)) S DRGARY(LDIEN)="",DRLCNT=DRLCNT+1
  1. ;
  1. ; Quit if drug matched name and user accepted
  1. I DRLCNT=1 D I CHECK Q LDIEN
  1. . S LDIEN=$O(DRGARY(0))
  1. . S DRSV=LDIEN ;Save single match to filter from displaying from local drug
  1. . S LDNAME=$$GET1^DIQ(50,LDIEN,.01,"E")
  1. . W !,"Matching Drug Found for Dispensing: "_LDNAME
  1. . S CHECK=$$DIR
  1. ;
  1. I DRLCNT=0 W !,"No active drug name match found for "_DRGNM_"."
  1. ;
  1. S CHECK="",DRLCNT=0 K DRGARY
  1. S VAPIEN=0 F S VAPIEN=$O(VAPIEN(VAPIEN)) Q:'VAPIEN D
  1. . S VAPSTR=$$GET1^DIQ(50.68,VAPIEN,2,"E")
  1. . ;Loop thru the APR index in 50
  1. . S LDIEN=0 F S LDIEN=$O(^PSDRUG("APR",VAPIEN,LDIEN)) Q:'LDIEN D
  1. . . ;filter out inactive, drugs not on outpatient formulary, not linked to Pharmacy orderable, 'CS
  1. . . I $$GET1^DIQ(50,LDIEN,100,"I"),(DT'<$$GET1^DIQ(50,LDIEN,100,"I")) Q
  1. . . I $$GET1^DIQ(50,LDIEN,63,"I")'["O" Q
  1. . . I $$GET1^DIQ(50,LDIEN,2.1,"I")="" Q
  1. . . I $$GET1^DIQ(50,LDIEN,3),$$GET1^DIQ(50,LDIEN,3)>0&($$GET1^DIQ(50,LDIEN,3)<6)
  1. . . I '$D(DRGARY(LDIEN)) S DRGARY(LDIEN)=VAPSTR,DRLCNT=DRLCNT+1
  1. ;
  1. ;Filter out drug already presented
  1. I DRSV,$D(DRGARY(DRSV)) K DRGARY(DRSV) S DRLCNT=DRLCNT-1
  1. ;
  1. I DRLCNT D
  1. . W !!,"Drugs matching the VA PRODUCT IDENTIFIER:"
  1. . S (MATCH,EXIT)=0
  1. . N PSODRGL,PSODRGLI,PSODRGL0,PSODRGID,PSODRGC S DIR(0)=""
  1. . F PSODRGLI=0:0 S PSODRGLI=$O(DRGARY(PSODRGLI)) Q:'PSODRGLI D
  1. . . S PSODRGL0=$G(^PSDRUG(PSODRGLI,0)),PSODRGID=$G(^PSDRUG(PSODRGLI,"I"))
  1. . . Q:$TR(PSODRGL0,"^")="" S PSODRGC=$G(PSODRGC)+1
  1. . .S DIR(0)=DIR(0)_$S(DIR(0)]"":";",1:"")
  1. . .; Increased drug name length from 30 to 40 - PSO*7*594
  1. . .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)
  1. . .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)
  1. . S DIR(0)="SO^"_DIR(0),DIR("L")="" ;1:$G(PSODRGC)"
  1. . S DIR("A")="Select Drug from list ("_1_"-"_DRLCNT_") "_"or <enter> to quit processing."
  1. . D ^DIR K DIR
  1. . I +Y<1!($D(DUOUT))!($D(DTOUT)) S Y="",DRLCNT=0
  1. . I Y>0 S LDIEN=+Y(0)
  1. . I $G(LDIEN) K DIR S DIR(0)="Y",DIR("A")="Would you like to use this drug" D ^DIR
  1. . I +Y<1!($D(DUOUT))!($D(DTOUT)) S DRLCNT=0 ;DRLCNT=0 causes Drug: to be prompted for
  1. ;
  1. I DRLCNT,$G(Y) Q LDIEN ;a drug was accepted
  1. ;
  1. ;No VAPIEN, or no drug was selected or no drugs were found
  1. K DIR
  1. W !
  1. W !,"No other local match could be found for "_DRGNM_"."
  1. W !,"You may need to update your Drug file to process this order"
  1. D PAUSE^VALM1
  1. Q 0
  1. ;
  1. ; TEXT to build prompts
  1. ;;DIR(0)|DIR(A)|DIR(B)|VARIABLE
  1. 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
  1. ;;N|DAYS SUPPLY||DSUPP
  1. ;;P^200:QEAMZ|Select PHARMACIST Name|S DEF=$$GET1~DIQ(200,DUZ,.01,"E")|PHARM
  1. ;;F^0:60|REMARKS||REMARKS
  1. ;;Q
  1. Q
  1. DIR() ;
  1. N DIR,Y
  1. S DIR(0)="Y",DIR("B")="NO"
  1. S DIR("A",1)="Would you like to use the system matched drug for this"
  1. S DIR("A")="refill/partial fill"
  1. D ^DIR
  1. Q Y
  1. POST ; post init for PSO*7*454
  1. N LIEN,OPSITE,DOMAIN,VAL
  1. ; add TCP/IP address for EMI
  1. S DOMAIN=$$FQDN^PSORWRAP(,DUZ(2))
  1. S VAL="PSORRXSEND"
  1. S LIEN=$$FIND1^DIC(870,,"B",.VAL) Q:'LIEN
  1. S FDA(870,LIEN_",",.08)=DOMAIN
  1. S FDA(870,LIEN_",",400.01)="vaaussoalebp2.aac.domain.ext" D FILE^DIE(,"FDA") K FDA
  1. ; turn off the OneVA Pharmacy flag for all outpatient sites.
  1. S OPSITE=0 F S OPSITE=$O(^PS(59,OPSITE)) Q:'OPSITE D
  1. .S FDA(59,OPSITE_",",3001)="" D FILE^DIE(,"FDA") K FDA
  1. Q
  1. ;
  1. OPAI() ; determine if drug will go through OPAI
  1. N PSOOINT,PSOOMARK
  1. I '$G(PSOSITE) Q 1 ;REMOVE THIS LINE ONCE YOU DETERMINE PSOSITE IS DEFINED FORM THE PROTOCOL
  1. S PSOOINT=$P($G(^PS(59,PSOSITE,1)),"^",30),PSOOMARK=0
  1. S:+$G(LOCDRUG) PSOOMARK=+$G(^PSDRUG(LOCDRUG,6))
  1. I 'PSOOINT Q 0
  1. I PSOOINT=1!(PSOOINT=2) Q 1
  1. I PSOOMARK Q 1
  1. Q 0