PSOERXD3 ;ALB/BWF - eRx Drug edit actions - Cont'd ; 5/26/2017 9:57am
;;7.0;OUTPATIENT PHARMACY;**651,700,770**;DEC 1997;Build 145
;
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)=""
N DEFRT I $G(RTE) K RTE
K DIR,DIRUT
S DIR(0)="F^2:45",DIR("A")="ROUTE",DIR("?")="^D HLP^PSOORED4"
I $G(CURTE)="" S DEFRT=$$DEFROUTE^PSOERXUT(+$G(PSODRUG("OI"))) I DEFRT'="" S DIR("B")=DEFRT
I $G(CURTE)'="" S DIR("B")=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
SETUNEX ; Setting variable UNEXINS (Broken off from PSOERXD3 due to routine size limit)
N 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))_" "
Q
;
VDRG11(PSOIEN,PSOIENS) ;Indication For Use Edit
N DA,DR,PSODFN,X,Y,DTOUT,DUOUT,DIRUT,DIROUT,PSOEDIT,PSOERXD,PSODRUG,PSODONE,PSODELINS
;
S VDRG=$$GET1^DIQ(52.49,PSOIEN,3.2,"I") Q:'VDRG
S VAOI=$$GET1^DIQ(50,VDRG,2.1,"I") Q:'VAOI
S PSODRUG("OI")=VAOI,PSOERXD("IND")=$$GET1^DIQ(52.49,PSOIEN,29),PSOERXD("INDO")=$$GET1^DIQ(52.49,PSOIEN,29.2)
S PSODFN=+$$GET1^DIQ(52.49,PSOIEN,.05,"I")
S PSOEDIT=1,DIE="^PS(52.49,",DA=PSOIEN
;
I '$P($G(^PS(55,PSODFN,"LAN")),"^") D ;patient does not have other indication
. D INDICAT^PSODIR(.PSOERXD)
. I $G(X)="" S PQUIT=1 Q
. I $G(PSOERXD("DFLG")) S PQUIT=1 Q
. I $G(X)="@" S (PSOERXD("IND"),PSOERXD("INDF"))=$G(X)
. S DR="29////"_$G(PSOERXD("IND"))_";29.1////"_$G(PSOERXD("INDF"))
. D ^DIE K DIE,DR,DA
E D ;patient contain other language indication for use
. D SIND^PSODIR(.PSOERXD,1)
. I $G(X)="" S PQUIT=1 Q
. I $G(PSOERXD("DFLG")) S PQUIT=1 Q
. I $G(X)="@" D
. . I $G(PSOERXD("IND"))'="",$G(PSOERXD("INDO"))'="" Q ;user answered no or entered ^ to the delete prompt confirmation
. . S (PSOERXD("IND"),PSOERXD("INDF"),PSOERXD("INDO"))=$G(X)
. S DR="29////"_$G(PSOERXD("IND"))_";29.1////"_$G(PSOERXD("INDF"))_";29.2////"_$G(PSOERXD("INDO"))
. D ^DIE K DIE,DR,DA
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPSOERXD3 4109 printed Aug 26, 2025@22:44:35 Page 2
PSOERXD3 ;ALB/BWF - eRx Drug edit actions - Cont'd ; 5/26/2017 9:57am
+1 ;;7.0;OUTPATIENT PHARMACY;**651,700,770**;DEC 1997;Build 145
+2 ;
FNM SET NM=$EXTRACT(X,2,4)
SET NM=$TRANSLATE(NM,"qwertyuioplkjhgfdsazxcvbnm","QWERTYUIOPLKJHGFDSAZXCVBNM")
+1 SET FLDNM=$SELECT(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:"")
+2 if FLDNM=""
SET FLDNM=$SELECT(NM="CON":"CONJUNCTION^*Conjunction",NM="NOU":"NOUN^Noun",NM="VER":"VERB^Verb",1:"")
+3 QUIT
JFN KILL FLDNM,AR
SET ENT=+Y
SET FLDNM=$SELECT(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:"")
+1 QUIT
CNON ;
+1 IF $GET(NOUN)'=""
QUIT
+2 IF '$GET(PSORXED("DOSE ORDERED",ENT))
QUIT
+3 NEW PSONLT,PSONLL,PSONLG
+4 SET PSONLL=$PIECE($GET(DOSE("DD",+$GET(PSODRUG("IEN")))),"^",9)
IF PSONLL=""
QUIT
+5 SET PSONLG=$LENGTH(PSONLL)
+6 IF PSONLG'>3
QUIT
+7 SET PSONLT=$EXTRACT(PSONLL,(PSONLG-2),PSONLG)
+8 IF PSONLT'="(S)"
IF PSONLT'="(s)"
QUIT
+9 ;test noun of (S)
+10 KILL NOUN
+11 IF $GET(PSORXED("DOSE ORDERED",ENT))>1
SET PSORXED("NOUN",ENT)=$EXTRACT(PSONLL,1,(PSONLG-3))_$EXTRACT(PSONLT,2)
QUIT
+12 SET PSORXED("NOUN",ENT)=$EXTRACT(PSONLL,1,(PSONLG-3))
+13 QUIT
RTE2 IF $GET(DRET)
SET PSORXED("ROUTE",ENT)=""
+1 NEW DEFRT
IF $GET(RTE)
KILL RTE
+2 KILL DIR,DIRUT
+3 SET DIR(0)="F^2:45"
SET DIR("A")="ROUTE"
SET DIR("?")="^D HLP^PSOORED4"
+4 IF $GET(CURTE)=""
SET DEFRT=$$DEFROUTE^PSOERXUT(+$GET(PSODRUG("OI")))
IF DEFRT'=""
SET DIR("B")=DEFRT
+5 IF $GET(CURTE)'=""
SET DIR("B")=CURTE
+6 DO ^DIR
IF X[U
IF $LENGTH(X)>1
SET FIELD="RTE"
SET JUMP=1
KILL DIRUT,DTOUT
QUIT
+7 if $DATA(DTOUT)!($DATA(DUOUT))
QUIT
+8 IF X="@"!(X="")
KILL RTE,ERTE
SET DRET=1
SET PSORXED("ROUTE",ENT)=""
QUIT
+9 KILL DRET
IF X=$PIECE($GET(^PS(51.2,+$GET(PSORXED("ROUTE",ENT)),0)),"^")
SET RTE=$PIECE(^PS(51.2,PSORXED("ROUTE",ENT),0),"^")
SET ERTE=$PIECE(^PS(51.2,PSORXED("ROUTE",ENT),0),"^",2)
WRITE X_" "_$GET(ERTE)
QUIT
+10 SET DIC=51.2
SET DIC(0)="QEZM"
SET DIC("S")="I $P(^(0),""^"",4)"
DO ^DIC
if X[U
QUIT
if Y=-1
GOTO RTE2
WRITE " "_$PIECE(Y(0),"^",2)
+11 if X'=""
SET PSORXED("ROUTE",ENT)=+Y
SET RTE=Y(0,0)
SET ERTE=$PIECE(Y(0),"^",2)
SET ERXRTE(ENT)=$PIECE(Y(0),U,3)
+12 QUIT
SETUNEX ; Setting variable UNEXINS (Broken off from PSOERXD3 due to routine size limit)
+1 NEW DDONE
+2 IF $GET(PSORXED("ENT"))
Begin DoDot:1
+3 SET DDONE=0
+4 FOR I=1:1:PSORXED("ENT")
Begin DoDot:2
+5 IF '$DATA(PSORXED("DOSE ORDERED",I))
SET DDONE=1
QUIT
+6 IF '$LENGTH($GET(UNEXINS))
Begin DoDot:3
+7 SET UNEXINS=$GET(PSORXED("VERB",I))_" "_$GET(PSORXED("DOSE ORDERED",I))_" "_$GET(PSORXED("NOUN",I))_" "_$GET(ERXRTE(I))_" "_$GET(PSORXED("SCHEDULE",I))
+8 IF $LENGTH($GET(PSORXED("DURATION",I)))
SET UNEXINS=UNEXINS_" "_$GET(PSORXED("DURATION",I))
+9 IF $LENGTH($GET(PSORXED("CONJUNCTION",I)))
SET UNEXINS=UNEXINS_" "_$GET(PSORXED("CONJUNCTION",I))_" "
End DoDot:3
QUIT
+10 SET UNEXINS=UNEXINS_$GET(PSORXED("VERB",I))_" "_$GET(PSORXED("DOSE ORDERED",I))_" "_$GET(PSORXED("NOUN",I))_" "_$GET(ERXRTE(I))_" "_$GET(PSORXED("SCHEDULE",I))
+11 IF $LENGTH($GET(PSORXED("DURATION",I)))
SET UNEXINS=UNEXINS_" "_$GET(PSORXED("DURATION",I))
+12 IF $LENGTH($GET(PSORXED("CONJUNCTION",I)))
SET UNEXINS=UNEXINS_" "_$GET(PSORXED("CONJUNCTION",I))_" "
End DoDot:2
if DDONE
QUIT
End DoDot:1
+13 QUIT
+14 ;
VDRG11(PSOIEN,PSOIENS) ;Indication For Use Edit
+1 NEW DA,DR,PSODFN,X,Y,DTOUT,DUOUT,DIRUT,DIROUT,PSOEDIT,PSOERXD,PSODRUG,PSODONE,PSODELINS
+2 ;
+3 SET VDRG=$$GET1^DIQ(52.49,PSOIEN,3.2,"I")
if 'VDRG
QUIT
+4 SET VAOI=$$GET1^DIQ(50,VDRG,2.1,"I")
if 'VAOI
QUIT
+5 SET PSODRUG("OI")=VAOI
SET PSOERXD("IND")=$$GET1^DIQ(52.49,PSOIEN,29)
SET PSOERXD("INDO")=$$GET1^DIQ(52.49,PSOIEN,29.2)
+6 SET PSODFN=+$$GET1^DIQ(52.49,PSOIEN,.05,"I")
+7 SET PSOEDIT=1
SET DIE="^PS(52.49,"
SET DA=PSOIEN
+8 ;
+9 ;patient does not have other indication
IF '$PIECE($GET(^PS(55,PSODFN,"LAN")),"^")
Begin DoDot:1
+10 DO INDICAT^PSODIR(.PSOERXD)
+11 IF $GET(X)=""
SET PQUIT=1
QUIT
+12 IF $GET(PSOERXD("DFLG"))
SET PQUIT=1
QUIT
+13 IF $GET(X)="@"
SET (PSOERXD("IND"),PSOERXD("INDF"))=$GET(X)
+14 SET DR="29////"_$GET(PSOERXD("IND"))_";29.1////"_$GET(PSOERXD("INDF"))
+15 DO ^DIE
KILL DIE,DR,DA
End DoDot:1
+16 ;patient contain other language indication for use
IF '$TEST
Begin DoDot:1
+17 DO SIND^PSODIR(.PSOERXD,1)
+18 IF $GET(X)=""
SET PQUIT=1
QUIT
+19 IF $GET(PSOERXD("DFLG"))
SET PQUIT=1
QUIT
+20 IF $GET(X)="@"
Begin DoDot:2
+21 ;user answered no or entered ^ to the delete prompt confirmation
IF $GET(PSOERXD("IND"))'=""
IF $GET(PSOERXD("INDO"))'=""
QUIT
+22 SET (PSOERXD("IND"),PSOERXD("INDF"),PSOERXD("INDO"))=$GET(X)
End DoDot:2
+23 SET DR="29////"_$GET(PSOERXD("IND"))_";29.1////"_$GET(PSOERXD("INDF"))_";29.2////"_$GET(PSOERXD("INDO"))
+24 DO ^DIE
KILL DIE,DR,DA
End DoDot:1
+25 QUIT
