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

PSOERXD2.m

Go to the documentation of this file.
PSOERXD2 ;ALB/BWF - eRx Drug edit actions ; 5/26/2017 9:57am
 ;;7.0;OUTPATIENT PHARMACY;**467,506,520,508,551,581**;DEC 1997;Build 126
 ;
 Q
SBN ;
 N Y,ERXIEN
 S Y=$P(XQORNOD(0),"=",2)
 I Y']"" S VALMBCK="R" Q
 D EDIT^PSOERX1A("D",Y)
 S VALMBCK="R"
 Q
VDRG1(PSOIEN,PSOIENS) ;
 N VANDRG,VAODRG,DIE,DA,DR,AUTOVAL,DIC,Y,QTLOOP,SELDRG,VDRG,VANDRG,VAOI,PATINST,FIELD,MTYPE,RESTYPE,ERXSTAT
 Q:'$G(PSOIEN)
 S VAODRG=$$GET1^DIQ(52.49,PSOIEN,3.2,"I")
 S AUTOVAL=$$GET1^DIQ(52.49,PSOIEN,1.4,"I")
 S MTYPE=$$GET1^DIQ(52.49,PSOIEN,.08,"I")
 S RESTYPE=$$GET1^DIQ(52.49,PSOIEN,52.1,"E")
 S ERXSTAT=$$GET1^DIQ(52.49,PSOIEN,1,"E")
 I '$$GET1^DIQ(52.49,PSOIEN,3.2,"I") S XQORM("B")="Edit"
 I VAODRG W !,"Current Vista Drug: "_$$GET1^DIQ(50,VAODRG,.01,"E")
 ; for now allow user to search by drug name. may enhance screening in the future.
 S DIC(0)="AEMQ",DIC=50,DIC("S")="I $$ACTIVE^PSOERXA0(Y),($$OUTPAT^PSOERXA0(Y)),('$$INVCOMP^PSOERXA0(Y)),('$$CS^PSOERXA0(Y))"
 I VAODRG]"" S DIC("B")=VAODRG
 D ^DIC K DIC
 I $G(DUOUT)!($P(Y,U)<1) S PQUIT=1 Q
 S SELDRG=Y
 W !!,"You have selected: "_$P(Y,U,2),!,"Would you like to use this drug/supply?" S DIR(0)="YO" D ^DIR K DIR
 I Y="^"!(Y<1) S PQUIT=1 Q
 S DIE="^PS(52.49,",DA=PSOIEN,DR="3.2///"_$P(SELDRG,U,1) D ^DIE
 ; set the manual validation flag if the drug has been selected.
 S VANDRG=$$GET1^DIQ(52.49,PSOIEN,3.2,"I")
 I ERXSTAT="N" D UPDSTAT^PSOERXU1(PSOIEN,"I")
 I MTYPE="RE",ERXSTAT'="RXI" D UPDSTAT^PSOERXU1(PSOIEN,"RXI")
 ; if the drug has changed, update the manual validation by and date/time
 I VANDRG'="",VAODRG'=VANDRG D
 .S QTLOOP=0 F  S QTLOOP=$O(^PS(52.49,PSOIEN,21,QTLOOP)) Q:'QTLOOP  D
 ..S FDA(52.4921,QTLOOP_","_PSOIENS,.01)="@" D FILE^DIE(,"FDA") K FDA
 .; if the drug is the same, leave the manual validation,otherwise delete it.
 .S FDA(52.49,PSOIENS,1.5)="",FDA(52.49,PSOIENS,1.11)="",FDA(52.49,PSOIENS,1.12)="",FDA(52.49,PSOIENS,20.3)="",FDA(52.49,PSOIENS,20.4)=""
 .S FDA(52.49,PSOIENS,27)="",FDA(52.49,PSOIENS,20.1)="",FDA(52.49,PSOIENS,20.2)="",FDA(52.49,PSOIENS,20.3)="",FDA(52.49,PSOIENS,20.4)="",FDA(52.49,PSOIENS,20.5)=""
 .D FILE^DIE(,"FDA") K FDA
 .I MTYPE="N" D UPDSTAT^PSOERXU1(PSOIEN,"I")
 ; get and file patient instructions
 S VDRG=VANDRG
 S VAOI=$$GET1^DIQ(50,VDRG,2.1,"I")
 S PATINST=$$GET1^DIQ(50.7,VAOI,7,"E")
 I $L(PATINST) D
 .S FDA(52.49,PSOIENS,27)=$G(PATINST)
 D FILE^DIE(,"FDA") K FDA
 Q
VDRG2(PSOIEN,PSOIENS) ;
 N PSOQTS,PSOFROM,PSODOSE,PSONEW,PSODRUG,PSORXED,VERB,QTIEN,SFIENS,DOSE,PSODFN,CURDOSE,NEWDOSE,IENS
 S IENS=1_","_PSOIEN_","
 S PSODFN=$$GET1^DIQ(52.49,PSOIEN,.05,"I")
 I 'PSODFN D  Q
 .W !,"Cannot continue with dosing instructions until patient has been matched." D DIRE^PSOERXX1
 .S PQUIT=1
 ; drug ien and orderable item ien
 D DERX1(PSOIEN,PSOIENS,1)
 S PSODRUG("IEN")=$$GET1^DIQ(52.49,PSOIEN,3.2,"I") Q:'PSODRUG("IEN")
 S PSODRUG("OI")=$$GET1^DIQ(50,PSODRUG("IEN"),2.1,"I") Q:'PSODRUG("OI")
 S CURDOSE=$$GET1^DIQ(52.4921,IENS,9,"E")
 S (PSORXED("ENT"),ENT)=1
 ; SET PSOFROM=PENDING so the dosage list will activate and present to the user
 S PSOFROM="PENDING"
 D DOSE^PSSORPH(.DOSE,PSODRUG("IEN"),"O",PSODFN)
 D ASK^PSOBKDED
 I $G(DOSE)']"" S PQUIT=1 Q
 I $$GET1^DIQ(52.49,PSOIEN,1,"E")="N" D UPDSTAT^PSOERXU1(PSOIEN,"I")
 I $G(VERB)]"" S PSORXED("VERB",ENT)=VERB G DUPD
VER ;
 D DERX1(PSOIEN,PSOIENS,1)
 ;below logic brought over from VER^PSOOREDX
 D KV S DIR(0)="52.0113,8"
 S:$G(PSORXED("VERB",ENT))]"" DIR("B")=PSORXED("VERB",ENT)
 D ^DIR
 I X[U,$L(X)>1 S FIELD="VER" G JUMP
 G:$D(DTOUT)!($D(DUOUT)) EXQ
 I X="@" K PSORXED("VERB",ENT),VERB G DUPD
 S:X'="" (PSORXED("VERB",ENT),VERB)=X
DUPD ;
 I $G(PSORXED("DOSE",ENT))'?.N&($G(PSORXED("DOSE",ENT))'?.N1".".N)!'DOSE("LD") K PSORXED("DOSE ORDERED",ENT),DUPD G NOU1
 ; below logic brought over from DUPD^PSOOREDX
 D KV S DIR(0)="52.0113,1",DIR("A")="DISPENSE UNITS PER DOSE"_$S($G(PSORXED("NOUN",ENT))]"":"("_PSORXED("NOUN",ENT)_")",1:"")
 I '$G(PSORXED("DOSE",ENT)),$G(PSORXED("DOSE",ENT-1)) S PSORXED("DOSE",ENT)=PSORXED("DOSE",ENT-1)
 S DIR("B")=$S($G(PSORXED("DOSE ORDERED",ENT))]"":PSORXED("DOSE ORDERED",ENT),1:1) S:$E($G(DIR("B")),1)="." DIR("B")="0"_$G(DIR("B")) K:DIR("B")="" DIR("B")
 D ^DIR I X[U,$L(X)>1 S FIELD="DUPD" G JUMP
 G:$D(DTOUT)!($D(DUOUT)) EXQ
 I X="@"!(X=0) W !,"Dispense Units Per Dose is Required!!",! G DUPD
 ;below logic brought over from STR^PSOOREDX
 S:+STRE>0&(X>0) PSORXED("DOSE",ENT)=(X*STRE) W !,"Dosage Ordered: "_$S($E(PSORXED("DOSE",ENT),1)=".":"0",1:"")_PSORXED("DOSE",ENT)_UNITN,!
 S:X'="" (PSORXED("DOSE ORDERED",ENT),DUPD)=X
NOU1 ;
 G:'$G(PSORXED("DOSE ORDERED",ENT)) RTE
 D CNON
 N PSONDEF
 I $G(NOUN)]"" S PSORXED("NOUN",ENT)=NOUN
NOU ;
 ;below logic brought over from NOU^PSOOREDX
 D KV S DIR(0)="52.0113,3"
 S DIR("B")=$S($G(NOUN)]"":NOUN,1:$G(PSORXED("NOUN",ENT))) K:DIR("B")="" DIR("B")
 S PSONDEF=$G(DIR("B"))
 D ^DIR
 I X[U,$L(X)>1 S FIELD="NOU" G JUMP
 G:$D(DTOUT)!($D(DUOUT)) EXQ
 I X="@" K PSORXED("NOUN",ENT),NOUN G RTE
 I X'="",$G(PSONDEF)="" S NOUN=X
 I X'="",$G(PSONDEF)'=X S NOUN=X
 S:X'="" PSORXED("NOUN",ENT)=X
 ;
RTE ;
 N CURTE,ERXRTE
 S CURTE=$$GET1^DIQ(52.4921,ENT_","_PSOIEN_",",10,"E") S PSORXED("ROUTE",ENT)=CURTE
 K JUMP
 S ROU="PSOERXD2" D RTE2 K ROU
 K ROU
 I $G(JUMP) K JUMP G JUMP
 G:$D(DTOUT)!($D(DUOUT)) EXQ
 ;
SCH ;
 K PSOSCH,DIR,CURSCH,NEWSCH
 I '$D(ENT) S ENT=PSORXED("ENT")
 S CURSCH=$$GET1^DIQ(52.4921,ENT_","_PSOIEN_",",1,"E") I CURSCH]"" S DIR("B")=CURSCH
 S DIR("?")="^D SCHLP^PSOORED4",DIR("A")="Schedule: ",DIR(0)="FA^1:20^I X[""""""""!(X?.E1C.E)!($A(X)=45)!($L(X,"" "")>$S(X[""PRN"":4,1:3))!($L(X)>20)!($L(X)<1) K X"
 D ^DIR
 I X[U,$L(X)>1 S FIELD="SCH" G JUMP
 G:$D(DTOUT)!($D(DUOUT)) EXQ
 S SCH=$$SCHASL^PSOORED5(Y) D SCH^PSOSIG I $G(SCH)']""!($D(DTOUT))!($D(DUOUT)) G SCH
 S PSORXED("SCHEDULE",ENT)=SCH IF $G(SCHEX)'="" W " ("_SCHEX_")" K SCH,SCHEX,X,Y,PSOSCH
 S:PSORXED("ENT")<ENT PSORXED("ENT")=ENT
 S PSORXED("SCHEDULE",ENT)=$$UP^XLFSTR(PSORXED("SCHEDULE",ENT))
DUR ;
 N SIG,SIGDAT,SLOOP,P01,I,DDONE,EDFLG
 S X=$G(PSORXED("INS")) D SIG^PSOHELP S:$G(INS1)]"" PSORXED("SIG")=$E(INS1,2,9999999)
 D EN^PSOFSIG(.PSORXED)
 ; delete existing SIG
 S SLOOP=0 F  S SLOOP=$O(^PS(52.49,PSOIEN,"SIG",SLOOP)) Q:'SLOOP  D
 .S FDA(52.4926,SLOOP_","_PSOIEN_",",.01)="@"
 I $D(FDA) D FILE^DIE(,"FDA") K FDA
 ; file sig into VA DISPENSING INSTRUCTIONS multiple
 S SLOOP=0 F  S SLOOP=$O(SIG(SLOOP)) Q:'SLOOP  D
 .S SIGDAT=$G(SIG(SLOOP)) Q:SIGDAT=""
 .S SFDA(52.4926,"+1,"_PSOIENS,.01)=SIGDAT D UPDATE^DIE(,"SFDA",,"SERR") K SFDA
 S QTIEN=$O(^PS(52.49,PSOIEN,21,0))
 S SFIENS=$S(QTIEN:QTIEN_",",1:"+1,")
 S P01=$S($L($G(PSORXED("DOSE ORDERED",ENT))):$G(PSORXED("DOSE ORDERED",ENT))_"&"_$G(PSORXED("NOUN",ENT)),1:$G(PSORXED("DOSE",ENT)))
 I '$L(P01) D  Q
 .W !,"Dosage is required. Please re-enter the dosing instructions." S DIR(0)="W" D ^DIR D EX Q 
 S FDA(52.4921,SFIENS_PSOIENS,.01)=P01
 S FDA(52.4921,SFIENS_PSOIENS,1)=$G(PSORXED("SCHEDULE",ENT))
 S FDA(52.4921,SFIENS_PSOIENS,2)=$G(PSORXED("DURATION",ENT))
 S FDA(52.4921,SFIENS_PSOIENS,8)=$G(PSORXED("DOSE",ENT))
 S FDA(52.4921,SFIENS_PSOIENS,9)=$G(PSORXED("DOSE ORDERED",ENT))
 S FDA(52.4921,SFIENS_PSOIENS,10)=$G(PSORXED("ROUTE",ENT))
 S FDA(52.4921,SFIENS_PSOIENS,11)=$G(PSORXED("UNITS",ENT))
 S FDA(52.4921,SFIENS_PSOIENS,12)=$G(PSORXED("NOUN",ENT))
 S FDA(52.4921,SFIENS_PSOIENS,13)=$G(PSORXED("VERB",ENT))
 ; VA INSTRUCTIONS
 N UNEXINS,UNEXARY,DDONE
 I $G(PSORXED("ENT")) D
 .S DDONE=0
 .F I=1:1:PSORXED("ENT")  D  Q:DDONE
 ..I '$D(PSORXED("DOSE ORDERED",I)) S DDONE=1 Q
 ..I '$L($G(UNEXINS)) D  Q
 ...S UNEXINS=$G(PSORXED("VERB",I))_" "_$G(PSORXED("DOSE ORDERED",I))_" "_$G(PSORXED("NOUN",I))_" "_$G(ERXRTE(I))_" "_$G(PSORXED("SCHEDULE",I))
 ...I $L($G(PSORXED("DURATION",I))) S UNEXINS=UNEXINS_" "_$G(PSORXED("DURATION",I))
 ...I $L($G(PSORXED("CONJUNCTION",I))) S UNEXINS=UNEXINS_" "_$G(PSORXED("CONJUNCTION",I))
 ..S UNEXINS=UNEXINS_$G(PSORXED("VERB",I))_" "_$G(PSORXED("DOSE ORDERED",I))_" "_$G(PSORXED("NOUN",I))_" "_$G(ERXRTE(I))_" "_$G(PSORXED("SCHEDULE",I))
 ..I $L($G(PSORXED("DURATION",I))) S UNEXINS=UNEXINS_" "_$G(PSORXED("DURATION",I))
 ..I $L($G(PSORXED("CONJUNCTION",I))) S UNEXINS=UNEXINS_" "_$G(PSORXED("CONJUNCTION",I))
 I $L($G(UNEXINS)) D
 .D TXT2ARY^PSOERXD1(.UNEXARY,UNEXINS,,80)
 .D WP^DIE(52.49,PSOIEN_",",31,"K","UNEXARY","BWFERR")
 I SFIENS["+" D UPDATE^DIE(,"FDA",,"ERR") K FDA
 ; if there is a quantity/timing entry, overwrite the data (we are not using complex dosing in this phase)
 I SFIENS'["+" D FILE^DIE(,"FDA") K FDAG
EX ;
 K PSOBDR,PSOBDRG,PSOSCH,DUPD,STRE,UNITN,SCH,VERB,NOUN,DOSEOR,RTE,DUR,X,Y,ENTS,PSODOSE,OLENT,FIELD,FLDNM,AR,NM,ENT,STRE,UNITN,PSODOSE,ERTE,ROU,AR1,INS1
KV K DTOUT,DUOUT,DIR,DIRUT
 Q
EXQ ;
 K PSORXED,PSOSIGFL M PSORXED=PSODOSE D EN^PSOFSIG(.PSORXED) D MP1
 I $D(PSOBDR) M PSODRUG=PSOBDR K PSOBDR,PSOBDRG
 S PQUIT=1
 G EX Q
MP1 ;
 S VALMSG="eRx Not Updated!"
 Q
JUMP ;jump to fields
 I $L($E(X,2,99))<3 W !,"Field Name Must Be At Least 3 Characters in Length",! G @FIELD
 D FNM
 I FLDNM']"" K X,NM,FLDNM W !,"INVALID FIELD NAME.  PLEASE TRY AGAIN!",! G @FIELD
 F AR=1:1:PSORXED("ENT") W !,AR_". "_$P(FLDNM,"^",2)_": "_$S(NM="ROU"&($G(PSORXED($P(FLDNM,"^"),AR))):$P(^PS(51.2,PSORXED($P(FLDNM,"^"),AR),0),"^"),1:$G(PSORXED($P(FLDNM,"^"),AR))) S AR1=AR
 D KV S DIR("A",1)="* Indicates which fields will create a New Order",DIR("A")="Select Field to Edit by number",DIR(0)="NO^1:"_AR1 D ^DIR G:$D(DIRUT) @FIELD
 D JFN G:FLDNM="" @FIELD G @FLDNM
 G EX
 Q
FNM S NM=$E(X,2,4),NM=$TR(NM,"qwertyuioplkjhgfdsazxcvbnm","QWERTYUIOPLKJHGFDSAZXCVBNM")
 S FLDNM=$S(NM="DOS":"DOSE^*Dosage",NM="DIS":"DOSE ORDERED^Dispense Units",NM="ROU":"ROUTE^*Route",NM="SCH":"SCHEDULE^*Schedule",NM="DUR"!(NM="LIM"):"DURATION^*Duration",1:"")
 S:FLDNM="" FLDNM=$S(NM="CON":"CONJUNCTION^*Conjunction",NM="NOU":"NOUN^Noun",NM="VER":"VERB^Verb",1:"")
 Q
JFN K FLDNM,AR S ENT=+Y,FLDNM=$S(NM="NOU":"NOU",NM="VER":"VER",NM="DOS":"ASK",NM="DIS":"DUPD",NM="ROU":"RTE",NM="SCH":"SCH",NM="DUR"!(NM="LIM"):"DUR",NM="CON":"CON",1:"")
 Q
CNON ;
 I $G(NOUN)'="" Q
 I '$G(PSORXED("DOSE ORDERED",ENT)) Q
 N PSONLT,PSONLL,PSONLG
 S PSONLL=$P($G(DOSE("DD",+$G(PSODRUG("IEN")))),"^",9) I PSONLL="" Q
 S PSONLG=$L(PSONLL)
 I PSONLG'>3 Q
 S PSONLT=$E(PSONLL,(PSONLG-2),PSONLG)
 I PSONLT'="(S)",PSONLT'="(s)" Q
 ;test noun of (S)
 K NOUN
 I $G(PSORXED("DOSE ORDERED",ENT))>1 S PSORXED("NOUN",ENT)=$E(PSONLL,1,(PSONLG-3))_$E(PSONLT,2) Q
 S PSORXED("NOUN",ENT)=$E(PSONLL,1,(PSONLG-3))
 Q
RTE2 I $G(DRET) S PSORXED("ROUTE",ENT)=""
 I $G(RTE) K RTE
 K DIR,DIRUT S DIR(0)="F^2:45",DIR("A")="ROUTE",DIR("?")="^D HLP^PSOORED4"
 S DIR("B")=$G(CURTE)
 D ^DIR I X[U,$L(X)>1 S FIELD="RTE",JUMP=1 K DIRUT,DTOUT Q
 Q:$D(DTOUT)!($D(DUOUT))
 I X="@"!(X="") K RTE,ERTE S DRET=1,PSORXED("ROUTE",ENT)="" Q
 K DRET I X=$P($G(^PS(51.2,+$G(PSORXED("ROUTE",ENT)),0)),"^") S RTE=$P(^PS(51.2,PSORXED("ROUTE",ENT),0),"^"),ERTE=$P(^PS(51.2,PSORXED("ROUTE",ENT),0),"^",2) W X_" "_$G(ERTE) Q
 S DIC=51.2,DIC(0)="QEZM",DIC("S")="I $P(^(0),""^"",4)" D ^DIC Q:X[U  G:Y=-1 RTE2 W "  "_$P(Y(0),"^",2)
 S:X'="" PSORXED("ROUTE",ENT)=+Y,RTE=Y(0,0),ERTE=$P(Y(0),"^",2),ERXRTE(ENT)=$P(Y(0),U,3)
 Q
VDRG3(PSOIEN,PSOIENS) ;
 N DIR,Y,PATINST,ERXDRUG,VDRG,VAOI,FDA
 D DERX1(PSOIEN,PSOIENS,1)
 S ERXDRUG=$$GET1^DIQ(52.49,PSOIEN,3.2,"I")
 S PATINST=$$GET1^DIQ(52.49,PSOIEN,27,"E")
 I '$L(PATINST) D
 .S VDRG=$$GET1^DIQ(52.49,PSOIEN,3.2,"I") Q:'VDRG
 .S VAOI=$$GET1^DIQ(50,VDRG,2.1,"I") Q:'VAOI
 .S PATINST=$$GET1^DIQ(50.7,VAOI,7,"E")
 K DIR
 S DIR(0)="52.49,27",DIR("A")="VA PATIENT INSTRUCTIONS"
 I $L(PATINST) S DIR("B")=PATINST
 D ^DIR K DIR
 I Y["^" S PQUIT=1 Q
 S FDA(52.49,PSOIEN_",",27)=$$UP^XLFSTR(Y) D FILE^DIE(,"FDA") K FDA
 Q
VDRG4(PSOIEN,PSOIENS) ;
 N DIR,Y,USERCOMM,VPATINST,UFLAG,VAPCOMM,ERXPCOMM,FDA
 ; POSSIBLE FUTURE IMPLEMENTATION OF ERX DETAILS
 S VPATINST=$$GET1^DIQ(52.49,PSOIEN,27,"E")
 S ERXPCOMM=$$GET1^DIQ(52.49,PSOIEN,8,"E")
 S VAPCOMM=$$GET1^DIQ(52.49,PSOIEN,30,"E")
 S DIR(0)="FO^1:240",DIR("A")="VA Provider Comments",DIR("B")=$S($L(VAPCOMM):VAPCOMM,1:ERXPCOMM)
 D ^DIR K DIR
 I Y["^" S PQUIT=1 Q
 S USERCOMM=$$UP^XLFSTR(Y) K Y
 S FDA(52.49,PSOIEN_",",30)=$$UP^XLFSTR(USERCOMM) D FILE^DIE(,"FDA") K FDA
 Q
VDRG5(PSOIEN,PSOIENS) ;
 N PATIEN,PS55IEN,Y,DIE,DR,DA,FDA,ANS,PATSTAT,DONE
 S PATIEN=$$GET1^DIQ(52.49,PSOIEN,.05,"I")
 I 'PATIEN W !!,"Patient has not been validated, cannot edit patient status",! Q
 S PSODFN=$$GET1^DIQ(52.49,PSOIEN,.05,"I")
 S PATSTAT=$$GET1^DIQ(55,PSODFN,3,"E")
 S DIR("B")=PATSTAT
 S DIR(0)="55,3",DIR("A")="PATIENT STATUS"
 D ^DIR K DIR
 I 'PATSTAT,'+Y D
 .S DONE=0
 .F  D  Q:DONE
 ..W !,"This is a required response. Enter '^' to exit"
 ..S DIR(0)="55,3",DIR("A")="PATIENT STATUS" D ^DIR K DIR
 ..I +Y S DONE=1 Q
 ..I Y["^" S PQUIT=1,DONE=1 Q
 S ANS=$P(Y,"^",1)
 S FDA(55,PSODFN_",",3)=ANS
 D FILE^DIE(,"FDA","ERR") K FDA,ERR
 Q
 ;PSO*7.0*551 - BEGIN CHANGE - SWITCHING THE ORDER OF VDRG6 AND VDRG7. QUANTITY PROMPT WILL NOW COME BEFORE DAY SUPPLY.
VDRG6(PSOIEN,PSOIENS) ;
 N DIR,PSODRG,DRGMSG,ERXQTY,VAQTY,DIE,DA,DR
 S PSODRG=$$GET1^DIQ(52.49,PSOIEN,3.2,"I")
 I PSODRG S DRGMSG=$$GET1^DIQ(50,PSODRG,215,"E")
 S ERXQTY=$$GET1^DIQ(52.49,PSOIEN,5.1,"E")
 W !,"eRx Quantity: "_ERXQTY
 S VAQTY=$$GET1^DIQ(52.49,PSOIEN,20.1,"E")
 S PQUIT=$$QTYDSRFL^PSOERXU4(PSOIEN,2)
 Q
VDRG7(PSOIEN,PSOIENS) ;
 N Y,ERXDS,DIE,DR,DA
 ; dont prompt for days supply if we are editing 'all' fields or quantity (since quantity prompts for days supply)
 S ERXDS=$$GET1^DIQ(52.49,PSOIEN,5.5,"E")
 W !,"eRx Days Supply: "_ERXDS
 S PQUIT=$$QTYDSRFL^PSOERXU4(PSOIEN,1)
 Q
VDRG8(PSOIEN,PSOIENS) ;
 N Y,ERXRFLS,DIE,DR,DA
 S ERXRFLS=$$GET1^DIQ(52.49,PSOIEN,5.6,"E")
 I $$GET1^DIQ(52.49,PSOIEN,.08,"I")="RE",$$GET1^DIQ(52.49,PSOIEN,52.1,"I")="R" S ERXRFLS=ERXRFLS-1 I ERXRFLS<1 S ERXRFLS=0
 W !,"eRx Refills: "_ERXRFLS
 S PQUIT=$$QTYDSRFL^PSOERXU4(PSOIEN,3)
 Q
VDRG9(PSOIEN,PSOIENS) ;
 N Y,DIR,DIE,DR,DA
 S DIR("A")="PICKUP ROUTING"
 S DIR(0)="SO^M:MAIL;W:WINDOW",DIR("B")="M" D ^DIR K DIR
 I Y["^" S PQUIT=1 Q
 S DIE="^PS(52.49,",DA=PSOIEN,DR="20.4///"_Y D ^DIE K DIE,DR,DA
 Q
VDRG10(PSOIEN,PSOIENS) ;
 N DIC,Y,VACLIN,CURCLIN,DIE,DR,DA
 S CURCLIN=$$GET1^DIQ(52.49,PSOIEN,20.6,"E")
 I '$L(CURCLIN) S CURCLIN=$$GET1^DIQ(59,PSOSITE,10,"E")
 S DIC("B")=CURCLIN
 S DIC="^SC(",DIC(0)="QEAMZ",DIC("A")="Select CLINIC: " D ^DIC K DIC
 I Y<1 Q
 I ($D(DTOUT))!($D(DUOUT)) S PQUIT=1 Q
 S VACLIN=$P(Y,U)
 S DIE="^PS(52.49,",DA=PSOIEN,DR="20.6///"_VACLIN D ^DIE K DIE,DR,DA
 K DTOUT,DUOUT
 Q
VDRG11(PSOIEN,PSOIENS) ;
 N DIE,DR,DA,Y
 S DIE="^PS(52.49,",DA=PSOIEN,DR="8" D ^DIE K DIE,DR,DA
 I $O(Y(0)) S PQUIT=1
 Q
 ; display erx info
 ; DFLG - display flag
 ;          1 - drug sig comments
 ;          ""- all        
DERX1(PSOIEN,PSOIENS,DFLG) ;
 D DERX1^PSOERXU4(PSOIEN,PSOIENS,$G(DFLG))
 Q