PSOORED5 ;BIR/SAB-Rxs without dosing info ;29-Mar-2006 07:57;A,A
;;7.0;OUTPATIENT PHARMACY;**46,75,78,100,99,117,133,1005**;DEC 1997
;^PS(51.2 - DBIA 2226
;^PS(50.7 - DBIA 2223
;^PSDRUG - DBIA 221
;^PS(55 - DBIA 2228
;called by psoored2 and psodir
;pre-poe rxs and new backdoor rxs
; Modified - IHS/CIA/PLS - 06/29/04 - Line DOSE+1
DOSE1(PSORXED) ;for new rxs
DOSE ;pre-poe rx
N QUIT ; IHS/CIA/PLS - 06/29/04
D KV K ROU,STRE,FIELD,DOSEOR,DUPD,X,Y,UNITS S ENT=1,OLENT=ENT
ASK S ROU="PSOORED5" D ASK^PSOBKDED K ROU G:$D(DIRUT) EX
I $G(JUMP) K JUMP G JUMP
I $G(QUIT)]"" K QUIT,ROU Q
;
I $G(VERB)]"" S PSORXED("VERB",ENT)=VERB G DUPD
I $G(PSORX("EDIT"))']"" W:$G(PSORXED("VERB",ENT))]"" !,"VERB: "_PSORXED("VERB",ENT) G DUPD
VER D VER^PSOOREDX
I X[U,$L(X)>1 S FIELD="VER" G JUMP
G:$D(DTOUT)!($D(DUOUT)) EX 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
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),$G(DUPD)]"":DUPD,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)) EX
I X="@"!(X=0) W !,"Dispense Units Per Dose is Required!!",! G DUPD
D STR^PSOOREDX
;
NOU1 G:'$D(DUPD) RTE D CNON^PSOORED3 N PSONDEF
I $G(NOUN)]"",$G(PSORX("EDIT"))']"" S PSORXED("NOUN",ENT)=NOUN W !,"NOUN: "_$G(NOUN) G RTE
I $G(PSORX("EDIT"))']"",$G(PSORXED("NOUN",ENT))]"" W !,"NOUN: "_PSORXED("NOUN",ENT) G RTE
NOU D NOU^PSOOREDX I X[U,$L(X)>1 S FIELD="NOU" G JUMP
G:$D(DTOUT)!($D(DUOUT)) EX 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 I $G(ENT)>1,$G(PSORX("EDIT"))']"",$G(PSORXED("ROUTE",ENT-1)),$G(PSORXED("ROUTE",ENT))']"" S PSORXED("ROUTE",ENT)=PSORXED("ROUTE",ENT-1) G SCH
I '$G(DRET),'$G(PSORXED("ROUTE",ENT)),$P(^PS(50.7,PSODRUG("OI"),0),"^",6) S PSORXED("ROUTE",ENT)=$P(^PS(50.7,PSODRUG("OI"),0),"^",6)
I $G(DRET) S PSORXED("ROUTE",ENT)=""
I $G(RTE) K RTE
D KV S DIR(0)="FO^2:45",DIR("A")="ROUTE",DIR("?")="^D HLP^PSOORED4"
S DIR("B")=$S($G(PSORXED("ROUTE",ENT)):$P(^PS(51.2,PSORXED("ROUTE",ENT),0),"^"),$G(RTE)]"":RTE,$G(DRET):"",1:"PO") K:DIR("B")="" DIR("B")
D ^DIR I X[U,$L(X)>1 S FIELD="RTE" G JUMP
I $D(DTOUT)!($D(DUOUT)) S PSODIR("DFLG")=1 Q
I X="@"!(X="") K RTE,ERTE S DRET=1,PSORXED("ROUTE",ENT)="" G SCH
K DRET I X=$P($G(^PS(51.2,+$G(PSORXED("ROUTE",ENT)),0)),"^") S RTE=$P(^PS(51.2,PSORXED("ROUTE",ENT),0),"^") W X_" "_$G(ERTE) G SCH
S DIC=51.2,DIC(0)="QEZM",DIC("S")="I $P(^(0),""^"",4)" D ^DIC Q:X[U G:Y=-1 RTE W " "_$P(Y(0),"^",2)
S:X'="" PSORXED("ROUTE",ENT)=+Y,RTE=Y(0,0),ERTE=$P(Y(0),"^",2)
;
SCH D SCH^PSOBKDED I X[U,$L(X)>1 S FIELD="SCH" G JUMP
G:$D(DTOUT)!($D(DUOUT)) EX S SCH=Y D SCH^PSOSIG I $G(SCH)']"" G SCH
S PSORXED("SCHEDULE",ENT)=SCH W " ("_SCHEX_")" K SCH,SCHEX,X,Y,PSOSCH
S:$G(PSORXED("ENT"))<ENT PSORXED("ENT")=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($D(DUR):DUR,$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)) EX
D DUR1^PSOOREDX
;
CON D CON^PSOOREDX I X[U,$L(X)>1 S FIELD="CON" G JUMP
G:$D(DTOUT)!($D(DUOUT)) EX
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) EX G:'Y CON S:'$G(COPY) PSOSIGFL=1 D UPD^PSOOREDX G CON
I $G(PSORXED("CONJUNCTION",ENT))]"" S ENT=ENT+1 K DIR G ASK
S X=$G(PSORXED("INS")) D SIG^PSOHELP S:$G(INS1)]"" PSORXED("SIG")=$E(INS1,2,9999999)
D EN^PSOFSIG(.PSORXED) I $O(SIG(0)) S PSORXED("ENT")=ENT,SIGOK=1
Q:$G(PSOREEDT)!($G(PSOORRNW))
K QTYHLD S:$G(PSORXED("QTY")) QTYHLD=PSORXED("QTY") D QTY^PSOSIG(.PSORXED) I $G(PSORXED("QTY")) S QTY=1
I $G(QTYHLD),'$G(PSORXED("QTY")) S PSORXED("QTY")=QTYHLD
K QTYHLD Q:$G(PSOFROM)="NEW"!($G(COPY))!($G(PSOFROM))!($G(PSOREEDT))
Q:$G(PSOSIGFL) D
.S D=0 F S D=$O(SIG(D)) Q:'D S ^PSRX(PSORXED("IRXN"),"SIG1",D,0)=SIG(D),$P(^PSRX(PSORXED("IRXN"),"SIG1",0),"^",3)=+$P($G(^PSRX(PSORXED("IRXN"),"SIG1",0)),"^",3)+1,$P(^(0),"^",4)=+$P($G(^(0)),"^",4)+1 Q:'$O(SIG(D))
.S (A,I)=0 F S I=$O(^PSRX(PSORXED("IRXN"),"A",I)) Q:'I S A=A+1
.S:'$D(^PSRX(PSORXED("IRXN"),"A",0)) ^PSRX(PSORXED("IRXN"),"A",0)="^52.3DA^"
.S $P(^PSRX(PSORXED("IRXN"),"A",0),"^",3)=$P($G(^PSRX(PSORXED("IRXN"),"A",0)),"^",3)+1,$P(^(0),"^",4)=$P($G(^(0)),"^",4)+1
.D NOW^%DTC S A=A+1,^PSRX(PSORXED("IRXN"),"A",A,0)=%_"^E^"_DUZ_"^0^New Dosing Instructions Added",^PSRX(PSORXED("IRXN"),"A",A,1)="ORIGINAL SIG^" D
..I '$P(^PSRX(PSORXED("IRXN"),"SIG"),"^",2) S $P(^PSRX(PSORXED("IRXN"),"A",A,1),"^",2)=$P(^PSRX(PSORXED("IRXN"),"SIG"),"^") Q
..F I=0:0 S I=$O(^PSRX(PSORXED("IRXN"),"SIG1",I)) Q:'I S ^PSRX(PSORXED("IRXN"),"A",A,2,I,0)=^PSRX(PSORXED("IRXN"),"SIG1",I,0),^PSRX(PSORXED("IRXN"),"A",A,2,0)="^52.34A^"_I_"^"_I
.S ^PSRX(PSORXED("IRXN"),"SIG")="^1" K SIG,A,I
S ^PSRX(PSORXED("IRXN"),6,0)="^52.0113^"_ENT_"^"_ENT
F I=1:1:ENT S ^PSRX(PSORXED("IRXN"),6,I,0)=PSORXED("DOSE",I)_"^"_$G(PSORXED("DOSE ORDERED",I))_"^"_$G(PSORXED("UNITS",I))_"^"_$G(PSORXED("NOUN",I))_"^" D
.S ^PSRX(PSORXED("IRXN"),6,I,0)=^PSRX(PSORXED("IRXN"),6,I,0)_$G(PSORXED("DURATION",I))_"^"_$G(PSORXED("CONJUNCTION",I))_"^"_$G(PSORXED("ROUTE",I))_"^"_$G(PSORXED("SCHEDULE",I))_"^"_$G(PSORXED("VERB",I))
.I $G(PSORXED("DOSE",I))]"" S ^PSRX(PSORXED("IRXN"),6,I,1)=PSORXED("DOSE",I)
S ^PSRX(PSORXED("IRXN"),"POE")=1 G EX
Q
EX I $D(DUOUT)!($D(DTOUT)) S PSONEW("DFLG")=1
;I $D(DUOUT)!($D(DTOUT)) S:'$G(PSORX("EDIT")) PSONEW("DFLG")=1
G:$G(PSOSIGFL)!($G(PSORX("EDIT")))!($G(PSORXED))!($G(PSOREEDT)) EX1
K PSORXED("DOSE"),PSORXED("NOUN"),PSORXED("VERB"),PSORXED("DOSE ORDERED"),PSORXED("ROUTE"),SIG,PSORXED("SCHEDULE"),PSORXED("DURATION"),PSORXED("CONJUNCTION"),PSORXED("ODOSE")
EX1 K UNITN,STRE,DOSE,DUPD,SCH,VERB,NOUN,DOSEOR,RTE,DUR,X,Y,ENTS,PSOSCH,ENT,PSORTE,DURA,ERTE,ROU
KV K DIR,DIRUT,DTOUT,DUOUT
Q
UPD ;updates dosing array
D UPD^PSOORED6
Q
JUMP ;
I $G(PSORXED("SCHEDULE",1))']"" W $C(7),!!,"All Dosing Instructions must be entered before Jumping to other Fields!",!! G @FIELD
I $L($E(X,2,99))<3 W !,"Field Name Must Be At Least 3 Characters in Length",! G @FIELD
D FNM^PSOOREDX
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
I $G(PSOFROM)'="NEW",'$G(COPY) S DIR("A",1)="* Indicates which fields will create a New Order"
S DIR("A")="Select Field by number",DIR(0)="NO^1:"_AR1 D ^DIR G:$D(DIRUT) @FIELD
D JFN^PSOOREDX G:FLDNM="" @FIELD G @FLDNM
G EX
Q
LAN ;
Q:'$G(PSODRUG("IEN"))
I $G(OR0),'$G(PSONEW("DOSE ORDERED",II)),$P($G(^PS(55,PSODFN,"LAN")),"^") D K QI,QII Q
.Q:$G(OTHDOS(II))
.F QI=0:0 S QI=$O(^PSDRUG(PSODRUG("IEN"),"DOS2",QI)) Q:'QI D Q:$G(QII)
..Q:$G(PSONEW("DOSE",II))']""
..I PSONEW("DOSE",II)=$P(^PSDRUG(PSODRUG("IEN"),"DOS2",QI,0),"^") S PSONEW("ODOSE",II)=$P(^PSDRUG(PSODRUG("IEN"),"DOS2",QI,0),"^",4),QII=1
I $G(Y),$P($G(DOSE(Y)),"^",13)]"" S PSORXED("ODOSE",ENT)=$P(DOSE(Y),"^",13) Q
K QII F I=0:0 S I=$O(^PSDRUG(PSODRUG("IEN"),"DOS2",I)) Q:'I I DOSE=$P(^PSDRUG(PSODRUG("IEN"),"DOS2",I,0),"^") D Q:$G(QII)
.S PSORXED("ODOSE",ENT)=$P(^PSDRUG(PSODRUG("IEN"),"DOS2",I,0),"^",4),QII=1
K QII,I Q
PSOORED5 ;BIR/SAB-Rxs without dosing info ;29-Mar-2006 07:57;A,A
+1 ;;7.0;OUTPATIENT PHARMACY;**46,75,78,100,99,117,133,1005**;DEC 1997
+2 ;^PS(51.2 - DBIA 2226
+3 ;^PS(50.7 - DBIA 2223
+4 ;^PSDRUG - DBIA 221
+5 ;^PS(55 - DBIA 2228
+6 ;called by psoored2 and psodir
+7 ;pre-poe rxs and new backdoor rxs
+8 ; Modified - IHS/CIA/PLS - 06/29/04 - Line DOSE+1
DOSE1(PSORXED) ;for new rxs
DOSE ;pre-poe rx
+1 ; IHS/CIA/PLS - 06/29/04
NEW QUIT
+2 DO KV
KILL ROU,STRE,FIELD,DOSEOR,DUPD,X,Y,UNITS
SET ENT=1
SET OLENT=ENT
ASK SET ROU="PSOORED5"
DO ASK^PSOBKDED
KILL ROU
IF $DATA(DIRUT)
GOTO EX
+1 IF $GET(JUMP)
KILL JUMP
GOTO JUMP
+2 IF $GET(QUIT)]""
KILL QUIT,ROU
QUIT
+3 ;
+4 IF $GET(VERB)]""
SET PSORXED("VERB",ENT)=VERB
GOTO DUPD
+5 IF $GET(PSORX("EDIT"))']""
IF $GET(PSORXED("VERB",ENT))]""
WRITE !,"VERB: "_PSORXED("VERB",ENT)
GOTO DUPD
VER DO VER^PSOOREDX
+1 IF X[U
IF $LENGTH(X)>1
SET FIELD="VER"
GOTO JUMP
+2 IF $DATA(DTOUT)!($DATA(DUOUT))
GOTO EX
IF X="@"
KILL PSORXED("VERB",ENT),VERB
GOTO DUPD
+3 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 DO KV
SET DIR(0)="52.0113,1"
SET DIR("A")="DISPENSE UNITS PER DOSE"_$SELECT($GET(PSORXED("NOUN",ENT))]"":"("_PSORXED("NOUN",ENT)_")",1:"")
+3 IF '$GET(PSORXED("DOSE",ENT))
IF $GET(PSORXED("DOSE",ENT-1))
SET PSORXED("DOSE",ENT)=PSORXED("DOSE",ENT-1)
+4 SET DIR("B")=$SELECT($GET(PSORXED("DOSE ORDERED",ENT))]"":PSORXED("DOSE ORDERED",ENT),$GET(DUPD)]"":DUPD,1:"")
IF $EXTRACT($GET(DIR("B")),1)="."
SET DIR("B")="0"_$GET(DIR("B"))
IF DIR("B")=""
KILL DIR("B")
+5 DO ^DIR
IF X[U
IF $LENGTH(X)>1
SET FIELD="DUPD"
GOTO JUMP
+6 IF $DATA(DTOUT)!($DATA(DUOUT))
GOTO EX
+7 IF X="@"!(X=0)
WRITE !,"Dispense Units Per Dose is Required!!",!
GOTO DUPD
+8 DO STR^PSOOREDX
+9 ;
NOU1 IF '$DATA(DUPD)
GOTO RTE
DO CNON^PSOORED3
NEW PSONDEF
+1 IF $GET(NOUN)]""
IF $GET(PSORX("EDIT"))']""
SET PSORXED("NOUN",ENT)=NOUN
WRITE !,"NOUN: "_$GET(NOUN)
GOTO RTE
+2 IF $GET(PSORX("EDIT"))']""
IF $GET(PSORXED("NOUN",ENT))]""
WRITE !,"NOUN: "_PSORXED("NOUN",ENT)
GOTO RTE
NOU DO NOU^PSOOREDX
IF X[U
IF $LENGTH(X)>1
SET FIELD="NOU"
GOTO JUMP
+1 IF $DATA(DTOUT)!($DATA(DUOUT))
GOTO EX
IF X="@"
KILL PSORXED("NOUN",ENT),NOUN
GOTO RTE
+2 IF X'=""
IF $GET(PSONDEF)=""
SET NOUN=X
+3 IF X'=""
IF $GET(PSONDEF)'=X
SET NOUN=X
+4 IF X'=""
SET PSORXED("NOUN",ENT)=X
+5 ;
RTE IF $GET(ENT)>1
IF $GET(PSORX("EDIT"))']""
IF $GET(PSORXED("ROUTE",ENT-1))
IF $GET(PSORXED("ROUTE",ENT))']""
SET PSORXED("ROUTE",ENT)=PSORXED("ROUTE",ENT-1)
GOTO SCH
+1 IF '$GET(DRET)
IF '$GET(PSORXED("ROUTE",ENT))
IF $PIECE(^PS(50.7,PSODRUG("OI"),0),"^",6)
SET PSORXED("ROUTE",ENT)=$PIECE(^PS(50.7,PSODRUG("OI"),0),"^",6)
+2 IF $GET(DRET)
SET PSORXED("ROUTE",ENT)=""
+3 IF $GET(RTE)
KILL RTE
+4 DO KV
SET DIR(0)="FO^2:45"
SET DIR("A")="ROUTE"
SET DIR("?")="^D HLP^PSOORED4"
+5 SET DIR("B")=$SELECT($GET(PSORXED("ROUTE",ENT)):$PIECE(^PS(51.2,PSORXED("ROUTE",ENT),0),"^"),$GET(RTE)]"":RTE,$GET(DRET):"",1:"PO")
IF DIR("B")=""
KILL DIR("B")
+6 DO ^DIR
IF X[U
IF $LENGTH(X)>1
SET FIELD="RTE"
GOTO JUMP
+7 IF $DATA(DTOUT)!($DATA(DUOUT))
SET PSODIR("DFLG")=1
QUIT
+8 IF X="@"!(X="")
KILL RTE,ERTE
SET DRET=1
SET PSORXED("ROUTE",ENT)=""
GOTO SCH
+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),"^")
WRITE X_" "_$GET(ERTE)
GOTO SCH
+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 RTE
WRITE " "_$PIECE(Y(0),"^",2)
+11 IF X'=""
SET PSORXED("ROUTE",ENT)=+Y
SET RTE=Y(0,0)
SET ERTE=$PIECE(Y(0),"^",2)
+12 ;
SCH DO SCH^PSOBKDED
IF X[U
IF $LENGTH(X)>1
SET FIELD="SCH"
GOTO JUMP
+1 IF $DATA(DTOUT)!($DATA(DUOUT))
GOTO EX
SET SCH=Y
DO SCH^PSOSIG
IF $GET(SCH)']""
GOTO SCH
+2 SET PSORXED("SCHEDULE",ENT)=SCH
WRITE " ("_SCHEX_")"
KILL SCH,SCHEX,X,Y,PSOSCH
+3 IF $GET(PSORXED("ENT"))<ENT
SET PSORXED("ENT")=ENT
+4 ;
DUR DO KV
KILL EXP
SET DIR(0)="52.0113,4"
SET DIR("A")="LIMITED DURATION (IN DAYS, HOURS OR MINUTES)"
+1 SET DIR("B")=$SELECT($DATA(DUR):DUR,$GET(PSORXED("DURATION",ENT))]"":PSORXED("DURATION",ENT),1:"")
IF DIR("B")=""
KILL DIR("B")
+2 DO ^DIR
IF X[U
IF $LENGTH(X)>1
SET FIELD="DUR"
GOTO JUMP
+3 IF $DATA(DTOUT)!($DATA(DUOUT))
GOTO EX
+4 DO DUR1^PSOOREDX
+5 ;
CON DO CON^PSOOREDX
IF X[U
IF $LENGTH(X)>1
SET FIELD="CON"
GOTO JUMP
+1 IF $DATA(DTOUT)!($DATA(DUOUT))
GOTO EX
+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 EX
IF 'Y
GOTO CON
IF '$GET(COPY)
SET PSOSIGFL=1
DO UPD^PSOOREDX
GOTO CON
+5 IF $GET(PSORXED("CONJUNCTION",ENT))]""
SET ENT=ENT+1
KILL DIR
GOTO ASK
+6 SET X=$GET(PSORXED("INS"))
DO SIG^PSOHELP
IF $GET(INS1)]""
SET PSORXED("SIG")=$EXTRACT(INS1,2,9999999)
+7 DO EN^PSOFSIG(.PSORXED)
IF $ORDER(SIG(0))
SET PSORXED("ENT")=ENT
SET SIGOK=1
+8 IF $GET(PSOREEDT)!($GET(PSOORRNW))
QUIT
+9 KILL QTYHLD
IF $GET(PSORXED("QTY"))
SET QTYHLD=PSORXED("QTY")
DO QTY^PSOSIG(.PSORXED)
IF $GET(PSORXED("QTY"))
SET QTY=1
+10 IF $GET(QTYHLD)
IF '$GET(PSORXED("QTY"))
SET PSORXED("QTY")=QTYHLD
+11 KILL QTYHLD
IF $GET(PSOFROM)="NEW"!($GET(COPY))!($GET(PSOFROM))!($GET(PSOREEDT))
QUIT
+12 IF $GET(PSOSIGFL)
QUIT
Begin DoDot:1
+13 SET D=0
FOR
SET D=$ORDER(SIG(D))
IF 'D
QUIT
SET ^PSRX(PSORXED("IRXN"),"SIG1",D,0)=SIG(D)
SET $PIECE(^PSRX(PSORXED("IRXN"),"SIG1",0),"^",3)=+$PIECE($GET(^PSRX(PSORXED("IRXN"),"SIG1",0)),"^",3)+1
SET $PIECE(^(0),"^",4)=+$PIECE($GET(^(0)),"^",4)+1
IF '$ORDER(SIG(D))
QUIT
+14 SET (A,I)=0
FOR
SET I=$ORDER(^PSRX(PSORXED("IRXN"),"A",I))
IF 'I
QUIT
SET A=A+1
+15 IF '$DATA(^PSRX(PSORXED("IRXN"),"A",0))
SET ^PSRX(PSORXED("IRXN"),"A",0)="^52.3DA^"
+16 SET $PIECE(^PSRX(PSORXED("IRXN"),"A",0),"^",3)=$PIECE($GET(^PSRX(PSORXED("IRXN"),"A",0)),"^",3)+1
SET $PIECE(^(0),"^",4)=$PIECE($GET(^(0)),"^",4)+1
+17 DO NOW^%DTC
SET A=A+1
SET ^PSRX(PSORXED("IRXN"),"A",A,0)=%_"^E^"_DUZ_"^0^New Dosing Instructions Added"
SET ^PSRX(PSORXED("IRXN"),"A",A,1)="ORIGINAL SIG^"
Begin DoDot:2
+18 IF '$PIECE(^PSRX(PSORXED("IRXN"),"SIG"),"^",2)
SET $PIECE(^PSRX(PSORXED("IRXN"),"A",A,1),"^",2)=$PIECE(^PSRX(PSORXED("IRXN"),"SIG"),"^")
QUIT
+19 FOR I=0:0
SET I=$ORDER(^PSRX(PSORXED("IRXN"),"SIG1",I))
IF 'I
QUIT
SET ^PSRX(PSORXED("IRXN"),"A",A,2,I,0)=^PSRX(PSORXED("IRXN"),"SIG1",I,0)
SET ^PSRX(PSORXED("IRXN"),"A",A,2,0)="^52.34A^"_I_"^"_I
End DoDot:2
+20 SET ^PSRX(PSORXED("IRXN"),"SIG")="^1"
KILL SIG,A,I
End DoDot:1
+21 SET ^PSRX(PSORXED("IRXN"),6,0)="^52.0113^"_ENT_"^"_ENT
+22 FOR I=1:1:ENT
SET ^PSRX(PSORXED("IRXN"),6,I,0)=PSORXED("DOSE",I)_"^"_$GET(PSORXED("DOSE ORDERED",I))_"^"_$GET(PSORXED("UNITS",I))_"^"_$GET(PSORXED("NOUN",I))_"^"
Begin DoDot:1
+23 SET ^PSRX(PSORXED("IRXN"),6,I,0)=^PSRX(PSORXED("IRXN"),6,I,0)_$GET(PSORXED("DURATION",I))_"^"_$GET(PSORXED("CONJUNCTION",I))_"^"_$GET(PSORXED("ROUTE",I))_"^"_$GET(PSORXED("SCHEDULE",I))_"^"_$GET(PSORXED("VERB",I))
+24 IF $GET(PSORXED("DOSE",I))]""
SET ^PSRX(PSORXED("IRXN"),6,I,1)=PSORXED("DOSE",I)
End DoDot:1
+25 SET ^PSRX(PSORXED("IRXN"),"POE")=1
GOTO EX
+26 QUIT
EX IF $DATA(DUOUT)!($DATA(DTOUT))
SET PSONEW("DFLG")=1
+1 ;I $D(DUOUT)!($D(DTOUT)) S:'$G(PSORX("EDIT")) PSONEW("DFLG")=1
+2 IF $GET(PSOSIGFL)!($GET(PSORX("EDIT")))!($GET(PSORXED))!($GET(PSOREEDT))
GOTO EX1
+3 KILL PSORXED("DOSE"),PSORXED("NOUN"),PSORXED("VERB"),PSORXED("DOSE ORDERED"),PSORXED("ROUTE"),SIG,PSORXED("SCHEDULE"),PSORXED("DURATION"),PSORXED("CONJUNCTION"),PSORXED("ODOSE")
EX1 KILL UNITN,STRE,DOSE,DUPD,SCH,VERB,NOUN,DOSEOR,RTE,DUR,X,Y,ENTS,PSOSCH,ENT,PSORTE,DURA,ERTE,ROU
KV KILL DIR,DIRUT,DTOUT,DUOUT
+1 QUIT
UPD ;updates dosing array
+1 DO UPD^PSOORED6
+2 QUIT
JUMP ;
+1 IF $GET(PSORXED("SCHEDULE",1))']""
WRITE $CHAR(7),!!,"All Dosing Instructions must be entered before Jumping to other Fields!",!!
GOTO @FIELD
+2 IF $LENGTH($EXTRACT(X,2,99))<3
WRITE !,"Field Name Must Be At Least 3 Characters in Length",!
GOTO @FIELD
+3 DO FNM^PSOOREDX
+4 IF FLDNM']""
KILL X,NM,FLDNM
WRITE !,"INVALID FIELD NAME. PLEASE TRY AGAIN!",!
GOTO @FIELD
+5 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
+6 DO KV
+7 IF $GET(PSOFROM)'="NEW"
IF '$GET(COPY)
SET DIR("A",1)="* Indicates which fields will create a New Order"
+8 SET DIR("A")="Select Field by number"
SET DIR(0)="NO^1:"_AR1
DO ^DIR
IF $DATA(DIRUT)
GOTO @FIELD
+9 DO JFN^PSOOREDX
IF FLDNM=""
GOTO @FIELD
GOTO @FLDNM
+10 GOTO EX
+11 QUIT
LAN ;
+1 IF '$GET(PSODRUG("IEN"))
QUIT
+2 IF $GET(OR0)
IF '$GET(PSONEW("DOSE ORDERED",II))
IF $PIECE($GET(^PS(55,PSODFN,"LAN")),"^")
Begin DoDot:1
+3 IF $GET(OTHDOS(II))
QUIT
+4 FOR QI=0:0
SET QI=$ORDER(^PSDRUG(PSODRUG("IEN"),"DOS2",QI))
IF 'QI
QUIT
Begin DoDot:2
+5 IF $GET(PSONEW("DOSE",II))']""
QUIT
+6 IF PSONEW("DOSE",II)=$PIECE(^PSDRUG(PSODRUG("IEN"),"DOS2",QI,0),"^")
SET PSONEW("ODOSE",II)=$PIECE(^PSDRUG(PSODRUG("IEN"),"DOS2",QI,0),"^",4)
SET QII=1
End DoDot:2
IF $GET(QII)
QUIT
End DoDot:1
KILL QI,QII
QUIT
+7 IF $GET(Y)
IF $PIECE($GET(DOSE(Y)),"^",13)]""
SET PSORXED("ODOSE",ENT)=$PIECE(DOSE(Y),"^",13)
QUIT
+8 KILL QII
FOR I=0:0
SET I=$ORDER(^PSDRUG(PSODRUG("IEN"),"DOS2",I))
IF 'I
QUIT
IF DOSE=$PIECE(^PSDRUG(PSODRUG("IEN"),"DOS2",I,0),"^")
Begin DoDot:1
+9 SET PSORXED("ODOSE",ENT)=$PIECE(^PSDRUG(PSODRUG("IEN"),"DOS2",I,0),"^",4)
SET QII=1
End DoDot:1
IF $GET(QII)
QUIT
+10 KILL QII,I
QUIT
