PSOERXD2 ;ALB/BWF - eRx Drug edit actions ; Jan 06, 2023@08:14:59
;;7.0;OUTPATIENT PHARMACY;**467,506,520,508,551,581,617,651,689,700**;DEC 1997;Build 261
SBN ;
N Y,ERXIEN
S Y=$P(XQORNOD(0),"=",2)
;
I +Y'=1,'$$GET1^DIQ(52.49,PSOIEN,3.2,"I")!'$D(^PS(52.49,PSOIEN,21)) D S VALMBCK="R" Q
. S VALMSG="You must update the Dispense Drug first!" W $C(7)
;
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,ERXSTATA,NEWVAL,ERXMSG
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")_" "_$P($$VADRSCH^PSOERXUT(VAODRG),"^",3)_$S($P(^PSDRUG(VAODRG,0),"^",9):"***(N/F)***",1:"") ;p689
; 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))"
I VAODRG]"" S DIC("B")=VAODRG
S (PQUIT,SELDRG)=0
F D ^DIC D I PQUIT!SELDRG Q
. I $G(DUOUT)!($P(Y,U)<1) S PQUIT=1 Q
. D PRDRVAL^PSOERXUT(.ERXMSG,"ED",PSOIEN,0,$P(Y,U))
. I 'ERXMSG D I $P(ERXMSG,"^",2)="B" S PQUIT=1 D PAUSE^PSOERXUT Q
. . W !,"*********************************",$S($P(ERXMSG,"^",2)="W":" WARNING(S) ",1:"INVALID DRUG"),"***********************************"
. . S I=0 F S I=$O(ERXMSG(I)) Q:'I W !,$P(ERXMSG(I),"^")
. . W !,"********************************************************************************",$C(7)
. S SELDRG=Y K DIC
I PQUIT Q
W !!,"You have selected: "_$P(Y,U,2)_$S($P(^PSDRUG(+Y,0),"^",9):" ***(N/F)***",1:""),!,"Would you like to use this drug/supply?" S DIR(0)="YO" D ^DIR K DIR ;p689
I Y="^"!(Y<1) S PQUIT=1 Q
S DIE="^PS(52.49,",DA=PSOIEN,DR="3.2///"_$P(SELDRG,U,1)
; If VistA Drug change, auto-matched before, change DRUG STAT (AUTO-VAL) #1.4 to 2 (VALIDATED/EDITED)
I +SELDRG'=$$GET1^DIQ(52.49,+PSOIENS,3.2,"I"),$$GET1^DIQ(52.49,+PSOIENS,1.4,"I")=1 S DR=DR_";1.4///2"
D ^DIE
;Saving the eRx Audit Log for the Dispense Drug entered
S NEWVAL(1)=$$GET1^DIQ(50,+SELDRG,.01)_" (NDC#: "_$$GETNDC^PSSNDCUT(+SELDRG)_")"
D AUDLOG^PSOERXUT(+PSOIEN,"DRUG",DUZ,.NEWVAL)
;
; 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.
.N FLD F FLD=1.5,1.11,1.12,20.1,20.2,20.3,20.4,20.5,27 S FDA(52.49,PSOIENS,FLD)="@"
.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)
.;Saving the eRx Audit Log for Patient Instructions from Orderable Item
.S NEWVAL(1)=PATINST
.D AUDLOG^PSOERXUT(+PSOIEN,"PATIENT INSTRUCTIONS",DUZ,.NEWVAL)
;
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,ENT,I
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")
;
; Retrieving Existing Dosage
K PSORXED D ERXDOSE^PSOERUT4(PSOIEN,.PSORXED)
;
S CURDOSE=$$GET1^DIQ(52.4921,IENS,9,"E")
; SET PSOFROM=PENDING so the dosage list will activate and present to the user
S ENT=0,PSOFROM="PENDING"
COMPLEX ; This line tag is used for Complex Doses (Loop back here from below)
S ENT=ENT+1,PSORXED("ENT")=ENT
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^PSOERXD3
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^PSOERXD3 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
I $G(DIR("B"))="",$$GET1^DIQ(50.7,+$G(PSODRUG("OI")),.08)'="" S DIR("B")=$$GET1^DIQ(50.7,+$G(PSODRUG("OI")),.08)
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 D KV K EXP
S DIR(0)="52.0113,4",DIR("A")="LIMITED DURATION (IN DAYS, HOURS OR MINUTES)"
S DIR("B")=$S($G(PSORXED("DURATION",ENT))]"":PSORXED("DURATION",ENT),1:"") K:DIR("B")="" DIR("B")
D ^DIR I X[U,$L(X)>1 S FIELD="DUR" G JUMP
G:$D(DTOUT)!($D(DUOUT)) EXQ
D DUR1^PSOOREDX
;
CON D CON^PSOOREDX I X[U,$L(X)>1 S FIELD="CON" G JUMP
G:$D(DTOUT)!($D(DUOUT)) EXQ
I X="@",$G(PSORXED("CONJUNCTION",ENT))="" W !,?10,"Invalid Entry - nothing to delete!!" G CON
S:X'=""&(X'="@") PSORXED("CONJUNCTION",ENT)=Y
I X="@" D CON1^PSOOREDX G:$D(DIRUT) EXQ G:'Y CON N CKX S CKX=1 D UPD^PSOOREDX G CON
I '$$DUROK^PSOORED3(.PSORXED,ENT) D G DUR
. W !!,"Duration is required for the dosage entered prior to the THEN conjunction.",$C(7),!
I $G(PSORXED("CONJUNCTION",ENT))]"" K DIR G COMPLEX
;
S P01=$S($L($G(PSORXED("DOSE ORDERED",1))):$G(PSORXED("DOSE ORDERED",1))_"&"_$G(PSORXED("NOUN",1)),1:$G(PSORXED("DOSE",1)))
I '$L(P01) D Q
. W !,"Dosage is required. Please re-enter the dosing instructions." S DIR(0)="W" D ^DIR D EX Q
;
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
;
;Saving the eRx Audit Log for the SIG
D AUDLOG^PSOERXUT(+PSOIEN,"SIG",DUZ,.SIG)
;
; Deleting Existing Dosage
N DIK,DA S DIK="^PS(52.49,"_PSOIEN_",21,",DA(1)=PSOIEN
S DA=0 F S DA=$O(^PS(52.49,PSOIEN,21,DA)) Q:'DA D ^DIK
; Saving Edited Dosage
K FDA
F I=1:1:ENT D
. S FDA(52.4921,"+1,"_PSOIENS,.01)=$S($L($G(PSORXED("DOSE ORDERED",1))):$G(PSORXED("DOSE ORDERED",1))_"&"_$G(PSORXED("NOUN",1)),1:$G(PSORXED("DOSE",1)))
. S FDA(52.4921,"+1,"_PSOIENS,1)=$G(PSORXED("SCHEDULE",I))
. S FDA(52.4921,"+1,"_PSOIENS,2)=$G(PSORXED("DURATION",I))
. S FDA(52.4921,"+1,"_PSOIENS,6)=$S($G(PSORXED("CONJUNCTION",I))="T":"S",1:$G(PSORXED("CONJUNCTION",I)))
. S FDA(52.4921,"+1,"_PSOIENS,8)=$G(PSORXED("DOSE",I))
. S FDA(52.4921,"+1,"_PSOIENS,9)=$G(PSORXED("DOSE ORDERED",I))
. S FDA(52.4921,"+1,"_PSOIENS,10)=$G(PSORXED("ROUTE",I))
. S FDA(52.4921,"+1,"_PSOIENS,11)=$G(PSORXED("UNITS",I))
. S FDA(52.4921,"+1,"_PSOIENS,12)=$G(PSORXED("NOUN",I))
. S FDA(52.4921,"+1,"_PSOIENS,13)=$G(PSORXED("VERB",I))
. D UPDATE^DIE("","FDA") K FDA
;
N UNEXINS,UNEXARY
D SETUNEX^PSOERXD3
;
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^PSOERXD3
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")="Select Field to Edit by number",DIR(0)="NO^1:"_AR1 D ^DIR G:$D(DIRUT) @FIELD
D JFN^PSOERXD3
I $G(FLDNM)'="",$T(@FLDNM)'="" G @FLDNM
I $G(FIELD)'="",$T(@FIELD)'="" G @FIELD
G EX
Q
VDRG3(PSOIEN,PSOIENS) ;
N DIR,Y,PATINST,ERXDRUG,VDRG,VAOI,FDA,NEWVAL,DEL
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 (INS1,PSODIR("INS"))="",DEL=0 I X="@" S DEL=1
I 'DEL D
. S (X,PSODIR("INS"))=Y D SIG^PSOHELP S $E(INS1)=""
. I $G(INS1)'="",$$UP^XLFSTR($G(PSODIR("INS")))'=$$UP^XLFSTR(INS1) W !,INS1 H 1
. I $G(INS1)="",$G(PSODIR("INS"))'="" S INS1=PSODIR("INS")
I $G(INS1)'=""!DEL D
. S FDA(52.49,PSOIEN_",",27)=$S(DEL:"@",1:$$UP^XLFSTR($G(INS1))) D FILE^DIE(,"FDA") K FDA
. ;Saving the eRx Audit Log for Patient Instructions (Manually entered)
. S NEWVAL(1)=$$UP^XLFSTR($G(INS1)) D AUDLOG^PSOERXUT(+PSOIEN,"PATIENT INSTRUCTIONS",DUZ,.NEWVAL)
Q
VDRG4(PSOIEN,PSOIENS) ;
N DIR,Y,USERCOMM,VPATINST,UFLAG,VAPCOMM,ERXPCOMM,FDA,NEWVAL
; 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"
I VAPCOMM'=""!(ERXPCOMM'="") S DIR("B")=$$PROVCOMM^PSOERUT4($S($L(VAPCOMM):VAPCOMM,1:ERXPCOMM))
D ^DIR K DIR
I Y["^" S PQUIT=1 Q
S USERCOMM=$$UP^XLFSTR(Y) K Y
I USERCOMM'=$$PROVCOMM^PSOERUT4(USERCOMM) S USERCOMM=$$PROVCOMM^PSOERUT4(USERCOMM) W !,USERCOMM H 1
S FDA(52.49,PSOIEN_",",30)=$$UP^XLFSTR(USERCOMM) D FILE^DIE(,"FDA") K FDA
;Saving the eRx Audit Log for Provider Comments
S NEWVAL(1)=USERCOMM D AUDLOG^PSOERXUT(+PSOIEN,"PROVIDER COMMENTS",DUZ,.NEWVAL)
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,ERXQTYUM
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")
S ERXQTYUM=$$GET1^DIQ(52.49,PSOIEN,42,"E")
W !,"eRx Quantity: "_ERXQTY_$S(ERXQTYUM'="":" ("_ERXQTYUM_")",1:"")
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"
I $$GET1^DIQ(52.49,PSOIEN,20.4,"I")'="" S DIR("B")=$$GET1^DIQ(52.49,PSOIEN,20.4,"I")
E S 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 $$GET1^DIQ(59.7,1,102,"I")="MBM",'CURCLIN,$G(PSOCLNC) S CURCLIN=$$GET1^DIQ(44,PSOCLNC,.01)
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: "
I $$GET1^DIQ(59.7,1,102,"I")="MBM" S DIC("S")="I '$P($G(^(""I"")),U,1)!$P($G(^(""I"")),U,2)"
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
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPSOERXD2 16065 printed Apr 09, 2024@21:27:36 Page 2
PSOERXD2 ;ALB/BWF - eRx Drug edit actions ; Jan 06, 2023@08:14:59
+1 ;;7.0;OUTPATIENT PHARMACY;**467,506,520,508,551,581,617,651,689,700**;DEC 1997;Build 261
SBN ;
+1 NEW Y,ERXIEN
+2 SET Y=$PIECE(XQORNOD(0),"=",2)
+3 ;
+4 IF +Y'=1
IF '$$GET1^DIQ(52.49,PSOIEN,3.2,"I")!'$DATA(^PS(52.49,PSOIEN,21))
Begin DoDot:1
+5 SET VALMSG="You must update the Dispense Drug first!"
WRITE $CHAR(7)
End DoDot:1
SET VALMBCK="R"
QUIT
+6 ;
+7 IF Y']""
SET VALMBCK="R"
QUIT
+8 DO EDIT^PSOERX1A("D",Y)
+9 SET VALMBCK="R"
+10 QUIT
VDRG1(PSOIEN,PSOIENS) ;
+1 NEW VANDRG,VAODRG,DIE,DA,DR,AUTOVAL,DIC,Y,QTLOOP,SELDRG,VDRG,VANDRG,VAOI,PATINST,FIELD,MTYPE,RESTYPE,ERXSTATA,NEWVAL,ERXMSG
+2 if '$GET(PSOIEN)
QUIT
+3 SET VAODRG=$$GET1^DIQ(52.49,PSOIEN,3.2,"I")
+4 SET AUTOVAL=$$GET1^DIQ(52.49,PSOIEN,1.4,"I")
+5 SET MTYPE=$$GET1^DIQ(52.49,PSOIEN,.08,"I")
+6 SET RESTYPE=$$GET1^DIQ(52.49,PSOIEN,52.1,"E")
+7 SET ERXSTAT=$$GET1^DIQ(52.49,PSOIEN,1,"E")
+8 IF '$$GET1^DIQ(52.49,PSOIEN,3.2,"I")
SET XQORM("B")="Edit"
+9 ;p689
IF VAODRG
WRITE !,"Current Vista Drug: "_$$GET1^DIQ(50,VAODRG,.01,"E")_" "_$PIECE($$VADRSCH^PSOERXUT(VAODRG),"^",3)_$SELECT($PIECE(^PSDRUG(VAODRG,0),"^",9):"***(N/F)***",1:"")
+10 ; for now allow user to search by drug name. may enhance screening in the future.
+11 SET DIC(0)="AEMQ"
SET DIC=50
SET DIC("S")="I $$ACTIVE^PSOERXA0(Y),($$OUTPAT^PSOERXA0(Y)),('$$INVCOMP^PSOERXA0(Y))"
+12 IF VAODRG]""
SET DIC("B")=VAODRG
+13 SET (PQUIT,SELDRG)=0
+14 FOR
DO ^DIC
Begin DoDot:1
+15 IF $GET(DUOUT)!($PIECE(Y,U)<1)
SET PQUIT=1
QUIT
+16 DO PRDRVAL^PSOERXUT(.ERXMSG,"ED",PSOIEN,0,$PIECE(Y,U))
+17 IF 'ERXMSG
Begin DoDot:2
+18 WRITE !,"*********************************",$SELECT($PIECE(ERXMSG,"^",2)="W":" WARNING(S) ",1:"INVALID DRUG"),"***********************************"
+19 SET I=0
FOR
SET I=$ORDER(ERXMSG(I))
if 'I
QUIT
WRITE !,$PIECE(ERXMSG(I),"^")
+20 WRITE !,"********************************************************************************",$CHAR(7)
End DoDot:2
IF $PIECE(ERXMSG,"^",2)="B"
SET PQUIT=1
DO PAUSE^PSOERXUT
QUIT
+21 SET SELDRG=Y
KILL DIC
End DoDot:1
IF PQUIT!SELDRG
QUIT
+22 IF PQUIT
QUIT
+23 ;p689
WRITE !!,"You have selected: "_$PIECE(Y,U,2)_$SELECT($PIECE(^PSDRUG(+Y,0),"^",9):" ***(N/F)***",1:""),!,"Would you like to use this drug/supply?"
SET DIR(0)="YO"
DO ^DIR
KILL DIR
+24 IF Y="^"!(Y<1)
SET PQUIT=1
QUIT
+25 SET DIE="^PS(52.49,"
SET DA=PSOIEN
SET DR="3.2///"_$PIECE(SELDRG,U,1)
+26 ; If VistA Drug change, auto-matched before, change DRUG STAT (AUTO-VAL) #1.4 to 2 (VALIDATED/EDITED)
+27 IF +SELDRG'=$$GET1^DIQ(52.49,+PSOIENS,3.2,"I")
IF $$GET1^DIQ(52.49,+PSOIENS,1.4,"I")=1
SET DR=DR_";1.4///2"
+28 DO ^DIE
+29 ;Saving the eRx Audit Log for the Dispense Drug entered
+30 SET NEWVAL(1)=$$GET1^DIQ(50,+SELDRG,.01)_" (NDC#: "_$$GETNDC^PSSNDCUT(+SELDRG)_")"
+31 DO AUDLOG^PSOERXUT(+PSOIEN,"DRUG",DUZ,.NEWVAL)
+32 ;
+33 ; set the manual validation flag if the drug has been selected.
+34 SET VANDRG=$$GET1^DIQ(52.49,PSOIEN,3.2,"I")
+35 IF ERXSTAT="N"
DO UPDSTAT^PSOERXU1(PSOIEN,"I")
+36 IF MTYPE="RE"
IF ERXSTAT'="RXI"
DO UPDSTAT^PSOERXU1(PSOIEN,"RXI")
+37 ; if the drug has changed, update the manual validation by and date/time
+38 IF VANDRG'=""
IF VAODRG'=VANDRG
Begin DoDot:1
+39 SET QTLOOP=0
FOR
SET QTLOOP=$ORDER(^PS(52.49,PSOIEN,21,QTLOOP))
if 'QTLOOP
QUIT
Begin DoDot:2
+40 SET FDA(52.4921,QTLOOP_","_PSOIENS,.01)="@"
DO FILE^DIE(,"FDA")
KILL FDA
End DoDot:2
+41 ; if the drug is the same, leave the manual validation,otherwise delete it.
+42 NEW FLD
FOR FLD=1.5,1.11,1.12,20.1,20.2,20.3,20.4,20.5,27
SET FDA(52.49,PSOIENS,FLD)="@"
+43 DO FILE^DIE(,"FDA")
KILL FDA
+44 IF MTYPE="N"
DO UPDSTAT^PSOERXU1(PSOIEN,"I")
End DoDot:1
+45 ; get and file patient instructions
+46 SET VDRG=VANDRG
+47 SET VAOI=$$GET1^DIQ(50,VDRG,2.1,"I")
+48 SET PATINST=$$GET1^DIQ(50.7,VAOI,7,"E")
+49 IF $LENGTH(PATINST)
Begin DoDot:1
+50 SET FDA(52.49,PSOIENS,27)=$GET(PATINST)
+51 ;Saving the eRx Audit Log for Patient Instructions from Orderable Item
+52 SET NEWVAL(1)=PATINST
+53 DO AUDLOG^PSOERXUT(+PSOIEN,"PATIENT INSTRUCTIONS",DUZ,.NEWVAL)
End DoDot:1
+54 ;
+55 DO FILE^DIE(,"FDA")
KILL FDA
+56 QUIT
VDRG2(PSOIEN,PSOIENS) ;
+1 NEW PSOQTS,PSOFROM,PSODOSE,PSONEW,PSODRUG,PSORXED,VERB,QTIEN,SFIENS,DOSE,PSODFN,CURDOSE,NEWDOSE,IENS,ENT,I
+2 SET IENS=1_","_PSOIEN_","
+3 SET PSODFN=$$GET1^DIQ(52.49,PSOIEN,.05,"I")
+4 IF 'PSODFN
Begin DoDot:1
+5 WRITE !,"Cannot continue with dosing instructions until patient has been matched."
DO DIRE^PSOERXX1
+6 SET PQUIT=1
End DoDot:1
QUIT
+7 ; drug ien and orderable item ien
+8 DO DERX1(PSOIEN,PSOIENS,1)
+9 SET PSODRUG("IEN")=$$GET1^DIQ(52.49,PSOIEN,3.2,"I")
if 'PSODRUG("IEN")
QUIT
+10 SET PSODRUG("OI")=$$GET1^DIQ(50,PSODRUG("IEN"),2.1,"I")
if 'PSODRUG("OI")
QUIT
+11 ;
+12 ; Retrieving Existing Dosage
+13 KILL PSORXED
DO ERXDOSE^PSOERUT4(PSOIEN,.PSORXED)
+14 ;
+15 SET CURDOSE=$$GET1^DIQ(52.4921,IENS,9,"E")
+16 ; SET PSOFROM=PENDING so the dosage list will activate and present to the user
+17 SET ENT=0
SET PSOFROM="PENDING"
COMPLEX ; This line tag is used for Complex Doses (Loop back here from below)
+1 SET ENT=ENT+1
SET PSORXED("ENT")=ENT
+2 DO DOSE^PSSORPH(.DOSE,PSODRUG("IEN"),"O",PSODFN)
+3 DO ASK^PSOBKDED
+4 IF $GET(DOSE)']""
SET PQUIT=1
QUIT
+5 IF $$GET1^DIQ(52.49,PSOIEN,1,"E")="N"
DO UPDSTAT^PSOERXU1(PSOIEN,"I")
+6 IF $GET(VERB)]""
SET PSORXED("VERB",ENT)=VERB
GOTO DUPD
VER ;
+1 DO DERX1(PSOIEN,PSOIENS,1)
+2 ;below logic brought over from VER^PSOOREDX
+3 DO KV
SET DIR(0)="52.0113,8"
+4 if $GET(PSORXED("VERB",ENT))]""
SET DIR("B")=PSORXED("VERB",ENT)
+5 DO ^DIR
+6 IF X[U
IF $LENGTH(X)>1
SET FIELD="VER"
GOTO JUMP
+7 if $DATA(DTOUT)!($DATA(DUOUT))
GOTO EXQ
+8 IF X="@"
KILL PSORXED("VERB",ENT),VERB
GOTO DUPD
+9 if X'=""
SET (PSORXED("VERB",ENT),VERB)=X
DUPD ;
+1 IF $GET(PSORXED("DOSE",ENT))'?.N&($GET(PSORXED("DOSE",ENT))'?.N1".".N)!'DOSE("LD")
KILL PSORXED("DOSE ORDERED",ENT),DUPD
GOTO NOU1
+2 ; below logic brought over from DUPD^PSOOREDX
+3 DO KV
SET DIR(0)="52.0113,1"
SET DIR("A")="DISPENSE UNITS PER DOSE"_$SELECT($GET(PSORXED("NOUN",ENT))]"":"("_PSORXED("NOUN",ENT)_")",1:"")
+4 IF '$GET(PSORXED("DOSE",ENT))
IF $GET(PSORXED("DOSE",ENT-1))
SET PSORXED("DOSE",ENT)=PSORXED("DOSE",ENT-1)
+5 SET DIR("B")=$SELECT($GET(PSORXED("DOSE ORDERED",ENT))]"":PSORXED("DOSE ORDERED",ENT),1:1)
if $EXTRACT($GET(DIR("B")),1)="."
SET DIR("B")="0"_$GET(DIR("B"))
if DIR("B")=""
KILL DIR("B")
+6 DO ^DIR
IF X[U
IF $LENGTH(X)>1
SET FIELD="DUPD"
GOTO JUMP
+7 if $DATA(DTOUT)!($DATA(DUOUT))
GOTO EXQ
+8 IF X="@"!(X=0)
WRITE !,"Dispense Units Per Dose is Required!!",!
GOTO DUPD
+9 ;below logic brought over from STR^PSOOREDX
+10 if +STRE>0&(X>0)
SET PSORXED("DOSE",ENT)=(X*STRE)
WRITE !,"Dosage Ordered: "_$SELECT($EXTRACT(PSORXED("DOSE",ENT),1)=".":"0",1:"")_PSORXED("DOSE",ENT)_UNITN,!
+11 if X'=""
SET (PSORXED("DOSE ORDERED",ENT),DUPD)=X
NOU1 ;
+1 if '$GET(PSORXED("DOSE ORDERED",ENT))
GOTO RTE
+2 DO CNON^PSOERXD3
+3 NEW PSONDEF
+4 IF $GET(NOUN)]""
SET PSORXED("NOUN",ENT)=NOUN
NOU ;
+1 ;below logic brought over from NOU^PSOOREDX
+2 DO KV
SET DIR(0)="52.0113,3"
+3 SET DIR("B")=$SELECT($GET(NOUN)]"":NOUN,1:$GET(PSORXED("NOUN",ENT)))
if DIR("B")=""
KILL DIR("B")
+4 SET PSONDEF=$GET(DIR("B"))
+5 DO ^DIR
+6 IF X[U
IF $LENGTH(X)>1
SET FIELD="NOU"
GOTO JUMP
+7 if $DATA(DTOUT)!($DATA(DUOUT))
GOTO EXQ
+8 IF X="@"
KILL PSORXED("NOUN",ENT),NOUN
GOTO RTE
+9 IF X'=""
IF $GET(PSONDEF)=""
SET NOUN=X
+10 IF X'=""
IF $GET(PSONDEF)'=X
SET NOUN=X
+11 if X'=""
SET PSORXED("NOUN",ENT)=X
+12 ;
RTE ;
+1 NEW CURTE,ERXRTE
+2 SET CURTE=$$GET1^DIQ(52.4921,ENT_","_PSOIEN_",",10,"E")
SET PSORXED("ROUTE",ENT)=CURTE
+3 KILL JUMP
+4 SET ROU="PSOERXD2"
DO RTE2^PSOERXD3
KILL ROU
+5 KILL ROU
+6 IF $GET(JUMP)
KILL JUMP
GOTO JUMP
+7 if $DATA(DTOUT)!($DATA(DUOUT))
GOTO EXQ
+8 ;
SCH ;
+1 KILL PSOSCH,DIR,CURSCH,NEWSCH
+2 IF '$DATA(ENT)
SET ENT=PSORXED("ENT")
+3 SET CURSCH=$$GET1^DIQ(52.4921,ENT_","_PSOIEN_",",1,"E")
IF CURSCH]""
SET DIR("B")=CURSCH
+4 IF $GET(DIR("B"))=""
IF $$GET1^DIQ(50.7,+$GET(PSODRUG("OI")),.08)'=""
SET DIR("B")=$$GET1^DIQ(50.7,+$GET(PSODRUG("OI")),.08)
+5 SET DIR("?")="^D SCHLP^PSOORED4"
SET DIR("A")="Schedule: "
SET 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"
+6 DO ^DIR
+7 IF X[U
IF $LENGTH(X)>1
SET FIELD="SCH"
GOTO JUMP
+8 if $DATA(DTOUT)!($DATA(DUOUT))
GOTO EXQ
+9 SET SCH=$$SCHASL^PSOORED5(Y)
DO SCH^PSOSIG
IF $GET(SCH)']""!($DATA(DTOUT))!($DATA(DUOUT))
GOTO SCH
+10 SET PSORXED("SCHEDULE",ENT)=SCH
IF $GET(SCHEX)'=""
WRITE " ("_SCHEX_")"
KILL SCH,SCHEX,X,Y,PSOSCH
+11 if PSORXED("ENT")<ENT
SET PSORXED("ENT")=ENT
+12 SET PSORXED("SCHEDULE",ENT)=$$UP^XLFSTR(PSORXED("SCHEDULE",ENT))
+13 ;
DUR DO KV
KILL EXP
+1 SET DIR(0)="52.0113,4"
SET DIR("A")="LIMITED DURATION (IN DAYS, HOURS OR MINUTES)"
+2 SET DIR("B")=$SELECT($GET(PSORXED("DURATION",ENT))]"":PSORXED("DURATION",ENT),1:"")
if DIR("B")=""
KILL DIR("B")
+3 DO ^DIR
IF X[U
IF $LENGTH(X)>1
SET FIELD="DUR"
GOTO JUMP
+4 if $DATA(DTOUT)!($DATA(DUOUT))
GOTO EXQ
+5 DO DUR1^PSOOREDX
+6 ;
CON DO CON^PSOOREDX
IF X[U
IF $LENGTH(X)>1
SET FIELD="CON"
GOTO JUMP
+1 if $DATA(DTOUT)!($DATA(DUOUT))
GOTO EXQ
+2 IF X="@"
IF $GET(PSORXED("CONJUNCTION",ENT))=""
WRITE !,?10,"Invalid Entry - nothing to delete!!"
GOTO CON
+3 if X'=""&(X'="@")
SET PSORXED("CONJUNCTION",ENT)=Y
+4 IF X="@"
DO CON1^PSOOREDX
if $DATA(DIRUT)
GOTO EXQ
if 'Y
GOTO CON
NEW CKX
SET CKX=1
DO UPD^PSOOREDX
GOTO CON
+5 IF '$$DUROK^PSOORED3(.PSORXED,ENT)
Begin DoDot:1
+6 WRITE !!,"Duration is required for the dosage entered prior to the THEN conjunction.",$CHAR(7),!
End DoDot:1
GOTO DUR
+7 IF $GET(PSORXED("CONJUNCTION",ENT))]""
KILL DIR
GOTO COMPLEX
+8 ;
+9 SET P01=$SELECT($LENGTH($GET(PSORXED("DOSE ORDERED",1))):$GET(PSORXED("DOSE ORDERED",1))_"&"_$GET(PSORXED("NOUN",1)),1:$GET(PSORXED("DOSE",1)))
+10 IF '$LENGTH(P01)
Begin DoDot:1
+11 WRITE !,"Dosage is required. Please re-enter the dosing instructions."
SET DIR(0)="W"
DO ^DIR
DO EX
QUIT
End DoDot:1
QUIT
+12 ;
+13 NEW SIG,SIGDAT,SLOOP,P01,I,DDONE,EDFLG
+14 SET X=$GET(PSORXED("INS"))
DO SIG^PSOHELP
if $GET(INS1)]""
SET PSORXED("SIG")=$EXTRACT(INS1,2,9999999)
+15 DO EN^PSOFSIG(.PSORXED)
+16 ; delete existing SIG
+17 SET SLOOP=0
FOR
SET SLOOP=$ORDER(^PS(52.49,PSOIEN,"SIG",SLOOP))
if 'SLOOP
QUIT
Begin DoDot:1
+18 SET FDA(52.4926,SLOOP_","_PSOIEN_",",.01)="@"
End DoDot:1
+19 IF $DATA(FDA)
DO FILE^DIE(,"FDA")
KILL FDA
+20 ; file sig into VA DISPENSING INSTRUCTIONS multiple
+21 SET SLOOP=0
FOR
SET SLOOP=$ORDER(SIG(SLOOP))
if 'SLOOP
QUIT
Begin DoDot:1
+22 SET SIGDAT=$GET(SIG(SLOOP))
if SIGDAT=""
QUIT
+23 SET SFDA(52.4926,"+1,"_PSOIENS,.01)=SIGDAT
DO UPDATE^DIE(,"SFDA",,"SERR")
KILL SFDA
End DoDot:1
+24 ;
+25 ;Saving the eRx Audit Log for the SIG
+26 DO AUDLOG^PSOERXUT(+PSOIEN,"SIG",DUZ,.SIG)
+27 ;
+28 ; Deleting Existing Dosage
+29 NEW DIK,DA
SET DIK="^PS(52.49,"_PSOIEN_",21,"
SET DA(1)=PSOIEN
+30 SET DA=0
FOR
SET DA=$ORDER(^PS(52.49,PSOIEN,21,DA))
if 'DA
QUIT
DO ^DIK
+31 ; Saving Edited Dosage
+32 KILL FDA
+33 FOR I=1:1:ENT
Begin DoDot:1
+34 SET FDA(52.4921,"+1,"_PSOIENS,.01)=$SELECT($LENGTH($GET(PSORXED("DOSE ORDERED",1))):$GET(PSORXED("DOSE ORDERED",1))_"&"_$GET(PSORXED("NOUN",1)),1:$GET(PSORXED("DOSE",1)))
+35 SET FDA(52.4921,"+1,"_PSOIENS,1)=$GET(PSORXED("SCHEDULE",I))
+36 SET FDA(52.4921,"+1,"_PSOIENS,2)=$GET(PSORXED("DURATION",I))
+37 SET FDA(52.4921,"+1,"_PSOIENS,6)=$SELECT($GET(PSORXED("CONJUNCTION",I))="T":"S",1:$GET(PSORXED("CONJUNCTION",I)))
+38 SET FDA(52.4921,"+1,"_PSOIENS,8)=$GET(PSORXED("DOSE",I))
+39 SET FDA(52.4921,"+1,"_PSOIENS,9)=$GET(PSORXED("DOSE ORDERED",I))
+40 SET FDA(52.4921,"+1,"_PSOIENS,10)=$GET(PSORXED("ROUTE",I))
+41 SET FDA(52.4921,"+1,"_PSOIENS,11)=$GET(PSORXED("UNITS",I))
+42 SET FDA(52.4921,"+1,"_PSOIENS,12)=$GET(PSORXED("NOUN",I))
+43 SET FDA(52.4921,"+1,"_PSOIENS,13)=$GET(PSORXED("VERB",I))
+44 DO UPDATE^DIE("","FDA")
KILL FDA
End DoDot:1
+45 ;
+46 NEW UNEXINS,UNEXARY
+47 DO SETUNEX^PSOERXD3
+48 ;
EX ;
+1 KILL 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 KILL DTOUT,DUOUT,DIR,DIRUT
+1 QUIT
EXQ ;
+1 KILL PSORXED,PSOSIGFL
MERGE PSORXED=PSODOSE
DO EN^PSOFSIG(.PSORXED)
DO MP1
+2 IF $DATA(PSOBDR)
MERGE PSODRUG=PSOBDR
KILL PSOBDR,PSOBDRG
+3 SET PQUIT=1
+4 GOTO EX
QUIT
MP1 ;
+1 SET VALMSG="eRx Not Updated!"
+2 QUIT
JUMP ;jump to fields
+1 IF $LENGTH($EXTRACT(X,2,99))<3
WRITE !,"Field Name Must Be At Least 3 Characters in Length",!
GOTO @FIELD
+2 DO FNM^PSOERXD3
+3 IF FLDNM']""
KILL X,NM,FLDNM
WRITE !,"INVALID FIELD NAME. PLEASE TRY AGAIN!",!
GOTO @FIELD
+4 FOR AR=1:1:PSORXED("ENT")
WRITE !,AR_". "_$PIECE(FLDNM,"^",2)_": "_$SELECT(NM="ROU"&($GET(PSORXED($PIECE(FLDNM,"^"),AR))):$PIECE(^PS(51.2,PSORXED($PIECE(FLDNM,"^"),AR),0),"^"),1:$GET(PSORXED($PIECE(FLDNM,"^"),AR)))
SET AR1=AR
+5 DO KV
SET DIR("A")="Select Field to Edit by number"
SET DIR(0)="NO^1:"_AR1
DO ^DIR
if $DATA(DIRUT)
GOTO @FIELD
+6 DO JFN^PSOERXD3
+7 IF $GET(FLDNM)'=""
IF $TEXT(@FLDNM)'=""
GOTO @FLDNM
+8 IF $GET(FIELD)'=""
IF $TEXT(@FIELD)'=""
GOTO @FIELD
+9 GOTO EX
+10 QUIT
VDRG3(PSOIEN,PSOIENS) ;
+1 NEW DIR,Y,PATINST,ERXDRUG,VDRG,VAOI,FDA,NEWVAL,DEL
+2 DO DERX1(PSOIEN,PSOIENS,1)
+3 SET ERXDRUG=$$GET1^DIQ(52.49,PSOIEN,3.2,"I")
+4 SET PATINST=$$GET1^DIQ(52.49,PSOIEN,27,"E")
+5 IF '$LENGTH(PATINST)
Begin DoDot:1
+6 SET VDRG=$$GET1^DIQ(52.49,PSOIEN,3.2,"I")
if 'VDRG
QUIT
+7 SET VAOI=$$GET1^DIQ(50,VDRG,2.1,"I")
if 'VAOI
QUIT
+8 SET PATINST=$$GET1^DIQ(50.7,VAOI,7,"E")
End DoDot:1
+9 KILL DIR
+10 SET DIR(0)="52.49,27"
SET DIR("A")="VA PATIENT INSTRUCTIONS"
+11 IF $LENGTH(PATINST)
SET DIR("B")=PATINST
+12 DO ^DIR
KILL DIR
+13 IF Y["^"
SET PQUIT=1
QUIT
+14 SET (INS1,PSODIR("INS"))=""
SET DEL=0
IF X="@"
SET DEL=1
+15 IF 'DEL
Begin DoDot:1
+16 SET (X,PSODIR("INS"))=Y
DO SIG^PSOHELP
SET $EXTRACT(INS1)=""
+17 IF $GET(INS1)'=""
IF $$UP^XLFSTR($GET(PSODIR("INS")))'=$$UP^XLFSTR(INS1)
WRITE !,INS1
HANG 1
+18 IF $GET(INS1)=""
IF $GET(PSODIR("INS"))'=""
SET INS1=PSODIR("INS")
End DoDot:1
+19 IF $GET(INS1)'=""!DEL
Begin DoDot:1
+20 SET FDA(52.49,PSOIEN_",",27)=$SELECT(DEL:"@",1:$$UP^XLFSTR($GET(INS1)))
DO FILE^DIE(,"FDA")
KILL FDA
+21 ;Saving the eRx Audit Log for Patient Instructions (Manually entered)
+22 SET NEWVAL(1)=$$UP^XLFSTR($GET(INS1))
DO AUDLOG^PSOERXUT(+PSOIEN,"PATIENT INSTRUCTIONS",DUZ,.NEWVAL)
End DoDot:1
+23 QUIT
VDRG4(PSOIEN,PSOIENS) ;
+1 NEW DIR,Y,USERCOMM,VPATINST,UFLAG,VAPCOMM,ERXPCOMM,FDA,NEWVAL
+2 ; POSSIBLE FUTURE IMPLEMENTATION OF ERX DETAILS
+3 SET VPATINST=$$GET1^DIQ(52.49,PSOIEN,27,"E")
+4 SET ERXPCOMM=$$GET1^DIQ(52.49,PSOIEN,8,"E")
+5 SET VAPCOMM=$$GET1^DIQ(52.49,PSOIEN,30,"E")
+6 SET DIR(0)="FO^1:240"
SET DIR("A")="VA Provider Comments"
+7 IF VAPCOMM'=""!(ERXPCOMM'="")
SET DIR("B")=$$PROVCOMM^PSOERUT4($SELECT($LENGTH(VAPCOMM):VAPCOMM,1:ERXPCOMM))
+8 DO ^DIR
KILL DIR
+9 IF Y["^"
SET PQUIT=1
QUIT
+10 SET USERCOMM=$$UP^XLFSTR(Y)
KILL Y
+11 IF USERCOMM'=$$PROVCOMM^PSOERUT4(USERCOMM)
SET USERCOMM=$$PROVCOMM^PSOERUT4(USERCOMM)
WRITE !,USERCOMM
HANG 1
+12 SET FDA(52.49,PSOIEN_",",30)=$$UP^XLFSTR(USERCOMM)
DO FILE^DIE(,"FDA")
KILL FDA
+13 ;Saving the eRx Audit Log for Provider Comments
+14 SET NEWVAL(1)=USERCOMM
DO AUDLOG^PSOERXUT(+PSOIEN,"PROVIDER COMMENTS",DUZ,.NEWVAL)
+15 QUIT
VDRG5(PSOIEN,PSOIENS) ;
+1 NEW PATIEN,PS55IEN,Y,DIE,DR,DA,FDA,ANS,PATSTAT,DONE
+2 SET PATIEN=$$GET1^DIQ(52.49,PSOIEN,.05,"I")
+3 IF 'PATIEN
WRITE !!,"Patient has not been validated, cannot edit patient status",!
QUIT
+4 SET PSODFN=$$GET1^DIQ(52.49,PSOIEN,.05,"I")
+5 SET PATSTAT=$$GET1^DIQ(55,PSODFN,3,"E")
+6 SET DIR("B")=PATSTAT
+7 SET DIR(0)="55,3"
SET DIR("A")="PATIENT STATUS"
+8 DO ^DIR
KILL DIR
+9 IF 'PATSTAT
IF '+Y
Begin DoDot:1
+10 SET DONE=0
+11 FOR
Begin DoDot:2
+12 WRITE !,"This is a required response. Enter '^' to exit"
+13 SET DIR(0)="55,3"
SET DIR("A")="PATIENT STATUS"
DO ^DIR
KILL DIR
+14 IF +Y
SET DONE=1
QUIT
+15 IF Y["^"
SET PQUIT=1
SET DONE=1
QUIT
End DoDot:2
if DONE
QUIT
End DoDot:1
+16 SET ANS=$PIECE(Y,"^",1)
+17 SET FDA(55,PSODFN_",",3)=ANS
+18 DO FILE^DIE(,"FDA","ERR")
KILL FDA,ERR
+19 QUIT
+20 ;PSO*7.0*551 - BEGIN CHANGE - SWITCHING THE ORDER OF VDRG6 AND VDRG7. QUANTITY PROMPT WILL NOW COME BEFORE DAY SUPPLY.
VDRG6(PSOIEN,PSOIENS) ;
+1 NEW DIR,PSODRG,DRGMSG,ERXQTY,VAQTY,DIE,DA,DR,ERXQTYUM
+2 SET PSODRG=$$GET1^DIQ(52.49,PSOIEN,3.2,"I")
+3 IF PSODRG
SET DRGMSG=$$GET1^DIQ(50,PSODRG,215,"E")
+4 SET ERXQTY=$$GET1^DIQ(52.49,PSOIEN,5.1,"E")
+5 SET ERXQTYUM=$$GET1^DIQ(52.49,PSOIEN,42,"E")
+6 WRITE !,"eRx Quantity: "_ERXQTY_$SELECT(ERXQTYUM'="":" ("_ERXQTYUM_")",1:"")
+7 SET VAQTY=$$GET1^DIQ(52.49,PSOIEN,20.1,"E")
+8 SET PQUIT=$$QTYDSRFL^PSOERXU4(PSOIEN,2)
+9 QUIT
VDRG7(PSOIEN,PSOIENS) ;
+1 NEW Y,ERXDS,DIE,DR,DA
+2 ; dont prompt for days supply if we are editing 'all' fields or quantity (since quantity prompts for days supply)
+3 SET ERXDS=$$GET1^DIQ(52.49,PSOIEN,5.5,"E")
+4 WRITE !,"eRx Days Supply: "_ERXDS
+5 SET PQUIT=$$QTYDSRFL^PSOERXU4(PSOIEN,1)
+6 QUIT
VDRG8(PSOIEN,PSOIENS) ;
+1 NEW Y,ERXRFLS,DIE,DR,DA
+2 SET ERXRFLS=$$GET1^DIQ(52.49,PSOIEN,5.6,"E")
+3 IF $$GET1^DIQ(52.49,PSOIEN,.08,"I")="RE"
IF $$GET1^DIQ(52.49,PSOIEN,52.1,"I")="R"
SET ERXRFLS=ERXRFLS-1
IF ERXRFLS<1
SET ERXRFLS=0
+4 WRITE !,"eRx Refills: "_ERXRFLS
+5 SET PQUIT=$$QTYDSRFL^PSOERXU4(PSOIEN,3)
+6 QUIT
VDRG9(PSOIEN,PSOIENS) ;
+1 NEW Y,DIR,DIE,DR,DA
+2 SET DIR("A")="PICKUP ROUTING"
+3 SET DIR(0)="SO^M:MAIL;W:WINDOW"
+4 IF $$GET1^DIQ(52.49,PSOIEN,20.4,"I")'=""
SET DIR("B")=$$GET1^DIQ(52.49,PSOIEN,20.4,"I")
+5 IF '$TEST
SET DIR("B")="M"
+6 DO ^DIR
KILL DIR
+7 IF Y["^"
SET PQUIT=1
QUIT
+8 SET DIE="^PS(52.49,"
SET DA=PSOIEN
SET DR="20.4///"_Y
DO ^DIE
KILL DIE,DR,DA
+9 QUIT
VDRG10(PSOIEN,PSOIENS) ;
+1 NEW DIC,Y,VACLIN,CURCLIN,DIE,DR,DA
+2 SET CURCLIN=$$GET1^DIQ(52.49,PSOIEN,20.6,"E")
+3 IF $$GET1^DIQ(59.7,1,102,"I")="MBM"
IF 'CURCLIN
IF $GET(PSOCLNC)
SET CURCLIN=$$GET1^DIQ(44,PSOCLNC,.01)
+4 IF '$LENGTH(CURCLIN)
SET CURCLIN=$$GET1^DIQ(59,PSOSITE,10,"E")
+5 SET DIC("B")=CURCLIN
+6 SET DIC="^SC("
SET DIC(0)="QEAMZ"
SET DIC("A")="Select CLINIC: "
+7 IF $$GET1^DIQ(59.7,1,102,"I")="MBM"
SET DIC("S")="I '$P($G(^(""I"")),U,1)!$P($G(^(""I"")),U,2)"
+8 DO ^DIC
KILL DIC
IF Y<1
QUIT
+9 IF ($DATA(DTOUT))!($DATA(DUOUT))
SET PQUIT=1
QUIT
+10 SET VACLIN=$PIECE(Y,U)
+11 SET DIE="^PS(52.49,"
SET DA=PSOIEN
SET DR="20.6////"_VACLIN
DO ^DIE
KILL DIE,DR,DA
+12 KILL DTOUT,DUOUT
+13 QUIT
VDRG11(PSOIEN,PSOIENS) ;
+1 NEW DIE,DR,DA,Y
+2 SET DIE="^PS(52.49,"
SET DA=PSOIEN
SET DR="8"
DO ^DIE
KILL DIE,DR,DA
+3 IF $ORDER(Y(0))
SET PQUIT=1
+4 QUIT
+5 ; display erx info
+6 ; DFLG - display flag
+7 ; 1 - drug sig comments
+8 ; ""- all
DERX1(PSOIEN,PSOIENS,DFLG) ;
+1 DO DERX1^PSOERXU4(PSOIEN,PSOIENS,$GET(DFLG))
+2 QUIT
