PSOERXD3 ;ALB/BWF - eRx Drug edit actions - Cont'd ; 5/26/2017 9:57am
;;7.0;OUTPATIENT PHARMACY;**651,700**;DEC 1997;Build 261
;
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
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPSOERXD3 2851 printed Dec 13, 2024@02:28:30 Page 2
PSOERXD3 ;ALB/BWF - eRx Drug edit actions - Cont'd ; 5/26/2017 9:57am
+1 ;;7.0;OUTPATIENT PHARMACY;**651,700**;DEC 1997;Build 261
+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
