- 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 Feb 18, 2025@23:54:56 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