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

PSOERXD3.m

Go to the documentation of this file.
  1. 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
  1. ;
  1. FNM S NM=$E(X,2,4),NM=$TR(NM,"qwertyuioplkjhgfdsazxcvbnm","QWERTYUIOPLKJHGFDSAZXCVBNM")
  1. 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:"")
  1. S:FLDNM="" FLDNM=$S(NM="CON":"CONJUNCTION^*Conjunction",NM="NOU":"NOUN^Noun",NM="VER":"VERB^Verb",1:"")
  1. Q
  1. 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:"")
  1. Q
  1. CNON ;
  1. I $G(NOUN)'="" Q
  1. I '$G(PSORXED("DOSE ORDERED",ENT)) Q
  1. N PSONLT,PSONLL,PSONLG
  1. S PSONLL=$P($G(DOSE("DD",+$G(PSODRUG("IEN")))),"^",9) I PSONLL="" Q
  1. S PSONLG=$L(PSONLL)
  1. I PSONLG'>3 Q
  1. S PSONLT=$E(PSONLL,(PSONLG-2),PSONLG)
  1. I PSONLT'="(S)",PSONLT'="(s)" Q
  1. ;test noun of (S)
  1. K NOUN
  1. I $G(PSORXED("DOSE ORDERED",ENT))>1 S PSORXED("NOUN",ENT)=$E(PSONLL,1,(PSONLG-3))_$E(PSONLT,2) Q
  1. S PSORXED("NOUN",ENT)=$E(PSONLL,1,(PSONLG-3))
  1. Q
  1. RTE2 I $G(DRET) S PSORXED("ROUTE",ENT)=""
  1. N DEFRT I $G(RTE) K RTE
  1. K DIR,DIRUT
  1. S DIR(0)="F^2:45",DIR("A")="ROUTE",DIR("?")="^D HLP^PSOORED4"
  1. I $G(CURTE)="" S DEFRT=$$DEFROUTE^PSOERXUT(+$G(PSODRUG("OI"))) I DEFRT'="" S DIR("B")=DEFRT
  1. I $G(CURTE)'="" S DIR("B")=CURTE
  1. D ^DIR I X[U,$L(X)>1 S FIELD="RTE",JUMP=1 K DIRUT,DTOUT Q
  1. Q:$D(DTOUT)!($D(DUOUT))
  1. I X="@"!(X="") K RTE,ERTE S DRET=1,PSORXED("ROUTE",ENT)="" Q
  1. 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
  1. 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)
  1. S:X'="" PSORXED("ROUTE",ENT)=+Y,RTE=Y(0,0),ERTE=$P(Y(0),"^",2),ERXRTE(ENT)=$P(Y(0),U,3)
  1. Q
  1. SETUNEX ; Setting variable UNEXINS (Broken off from PSOERXD3 due to routine size limit)
  1. N DDONE
  1. I $G(PSORXED("ENT")) D
  1. .S DDONE=0
  1. .F I=1:1:PSORXED("ENT") D Q:DDONE
  1. ..I '$D(PSORXED("DOSE ORDERED",I)) S DDONE=1 Q
  1. ..I '$L($G(UNEXINS)) D Q
  1. ...S UNEXINS=$G(PSORXED("VERB",I))_" "_$G(PSORXED("DOSE ORDERED",I))_" "_$G(PSORXED("NOUN",I))_" "_$G(ERXRTE(I))_" "_$G(PSORXED("SCHEDULE",I))
  1. ...I $L($G(PSORXED("DURATION",I))) S UNEXINS=UNEXINS_" "_$G(PSORXED("DURATION",I))
  1. ...I $L($G(PSORXED("CONJUNCTION",I))) S UNEXINS=UNEXINS_" "_$G(PSORXED("CONJUNCTION",I))_" "
  1. ..S UNEXINS=UNEXINS_$G(PSORXED("VERB",I))_" "_$G(PSORXED("DOSE ORDERED",I))_" "_$G(PSORXED("NOUN",I))_" "_$G(ERXRTE(I))_" "_$G(PSORXED("SCHEDULE",I))
  1. ..I $L($G(PSORXED("DURATION",I))) S UNEXINS=UNEXINS_" "_$G(PSORXED("DURATION",I))
  1. ..I $L($G(PSORXED("CONJUNCTION",I))) S UNEXINS=UNEXINS_" "_$G(PSORXED("CONJUNCTION",I))_" "
  1. Q