PSOORED3 ;BIR/SAB-edit finished orders through backdoor ;29-May-2012 14:56;PLS
;;7.0;OUTPATIENT PHARMACY;**46,78,99,117,133,1006,148,249,1015**;DEC 1997;Build 62
;External reference to PS(51.2 supported by DBIA 2226
;
; Modified - IHS/MSC/PLS - 12/04/07 - Line DOSE+2
;
;called from psoored2
D DOLST
;
DOSE ;adds dosing info
I '$G(PSORXED("ENT")) F S I=$O(PSORXED("DOSE",I)) Q:'I S PSORXED("ENT")=$G(PSORXED("ENT"))+1
S:'$D(PSORXED("ENT")) PSORXED("ENT")=0 ;IHS/MSC/PLS - 12/04/07
K ROU,UNITN,STRE,PSODOSE,RTE,NOUN,VERB M PSODOSE=PSORXED
D KV K FIELD,DOSEOR,DOOR,X,Y,UNITS S ENT=1
ASK S ROU="PSOORED3" D ASK^PSOBKDED K ROU I $G(JUMP) K JUMP G JUMP
G:$D(DIRUT) EXQ
I $G(QUIT)]"" K QUIT,ROU Q
;
I $G(VERB)]"" S PSORXED("VERB",ENT)=VERB G DUPD
VER D VER^PSOOREDX I X[U,$L(X)>1 S FIELD="VER" G JUMP
G:$D(DTOUT)!($D(DUOUT)) EXQ
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 DUPD^PSOOREDX
S DIR("B")=$S($G(PSORXED("DOSE ORDERED",ENT))]"":PSORXED("DOSE ORDERED",ENT),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)) EXQ
I X="@"!(X=0) W !,"Dispense Units Per Dose is Required!!",! G DUPD
D STR^PSOOREDX
NOU1 G:'$G(PSORXED("DOSE ORDERED",ENT)) RTE
D CNON
N PSONDEF
I $G(NOUN)]"" S PSORXED("NOUN",ENT)=NOUN
NOU D NOU^PSOOREDX I X[U,$L(X)>1 S FIELD="NOU" G JUMP
G:$D(DTOUT)!($D(DUOUT)) EXQ
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 S:$G(PSORXED("ROUTE",ENT))']"" DRET=1
K JUMP S ROU="PSOORED3" D RTE^PSOBKDED K ROU
I $G(JUMP) K JUMP G JUMP
G:$D(DTOUT)!($D(DUOUT)) EXQ
I $G(QUIT) K QUIT,ROU Q
;
SCH D SCH^PSOBKDED I X[U,$L(X)>1 S FIELD="SCH" G JUMP
G:$D(DTOUT)!($D(DUOUT)) EXQ
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:PSORXED("ENT")<ENT PSORXED("ENT")=ENT
;
DUR D KV K EXP S DIR(0)="52.0113,4",DIR("A")="LIMITED DURATION (IN MONTHS, WEEKS, DAYS, HOURS OR MINUTES)"
S DIR("B")=$S($G(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)) EXQ
D DUR1^PSOOREDX
;
CON D CON^PSOOREDX I X[U,$L(X)>1 S FIELD="CON" G JUMP
G:$D(DTOUT)!($D(DUOUT)) EXQ
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) EXQ G:'Y CON N CKX S CKX=1 D UPD^PSOOREDX G CON
I $G(PSORXED("CONJUNCTION",ENT))]"" S ENT=ENT+1 K DIR G ASK
S DENT=$O(PSORXED("DOSE",ENT)) I DENT,(ENT+1)'=DENT D
.K PSORXED("DOSE",DENT),PSORXED("NOUN",DENT),PSORXED("VERB",DENT),PSORXED("DOSE ORDERED",DENT),PSORXED("ROUTE",DENT),PSORXED("ODOSE",DENT)
.K PSORXED("SCHEDULE",DENT),PSORXED("DURATION",DENT),PSORXED("CONJUNCTION",DENT),DENT
I $G(FIELD)]"" K FIELD S QUIT=1
I $O(^PSRX(PSORXED("IRXN"),"INS1",0)) D
.F D=0:0 S D=$O(^PSRX(PSORXED("IRXN"),"INS1",D)) Q:'D S PSORXED("SIG",D)=^PSRX(PSORXED("IRXN"),"INS1",D,0)
D EN^PSOFSIG(.PSORXED) D VER^PSOORED7:'$G(PSOVER) I $G(CKX),'$G(PSOSIGFL) D M1 K CKX
I $G(PSOSIGFL)=1 S PSORXED("ENT")=ENT,SIGOK=1 G EX1
K QTY,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(PSOVER)!($G(PSOREEDQ))
UDSIG I $O(SIG(0)) 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
.D NOW^%DTC I $G(QTY) S A=A+1,^PSRX(PSORXED("IRXN"),"A",A,0)=%_"^E^"_DUZ_"^0^Quantity Updated "_"("_$P(^PSRX(PSORXED("IRXN"),0),"^",7)_")",$P(^PSRX(PSORXED("IRXN"),0),"^",7)=$G(PSORXED("QTY")) K QTY
.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($G(^PSRX(PSORXED("IRXN"),"SIG")),"^",2) S $P(^PSRX(PSORXED("IRXN"),"A",A,1),"^",2)=$P($G(^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))
.S ^PSRX(PSORXED("IRXN"),6,I,1)=$G(PSORXED("ODOSE",I))
S ^PSRX(PSORXED("IRXN"),"POE")=1
G EX
Q
EX ;
K PSORXED("DOSE"),DOSE,DUPD,SCH,PSORXED("NOUN"),PSORXED("VERB"),VERB,NOUN,PSORXED("DOSE ORDERED"),DOSEOR,PSORXED("ROUTE"),ENT,PSORTE,SIG,PSODOSE
K PSORXED("SCHEDULE"),PSORXED("DURATION"),PSORXED("CONJUNCTION"),DURA,X,Y,PSORXED("ODOSE")
EX1 K STRE,UNITN,DOSE,DUPD,SCH,VERB,NOUN,DOSEOR,RTE,DUR,X,Y,ENTS,PSOSCH,ERTE,ROU
KV K DIR,DIRUT,DUOUT,DTOUT
Q
EXQ K PSORXED,PSOSIGFL M PSORXED=PSODOSE D EN^PSOFSIG(.PSORXED) S PSORXED("DFLG")=1 D M1 G EX
Q
M1 D M1^PSOOREDX
Q
DOLST1(PSORXED) ;
;
DOLST F I=0:0 S I=$O(^PSRX(PSORXED("IRXN"),6,I)) Q:'I S INST=^(I,0) D
.S PSORXED("DOSE",I)=$P(INST,"^"),PSORXED("DOSE ORDERED",I)=$P(INST,"^",2),PSORXED("UNITS",I)=$P(INST,"^",3),PSORXED("NOUN",I)=$P(INST,"^",4)
.I $P(INST,"^",5)]"" D
..S PSORXED("DURATION",I)=$S($E($P(INST,"^",5),1)'?.N:$E($P(INST,"^",5),2,99)_$E($P(INST,"^",5),1),1:$P(INST,"^",5))
.S PSORXED("ROUTE",I)=$P(INST,"^",7),PSORXED("SCHEDULE",I)=$P(INST,"^",8)
.S PSORXED("CONJUNCTION",I)=$P(INST,"^",6),PSORXED("VERB",I)=$P(INST,"^",9),OLENT=I
.S PSORXED("ODOSE",I)=$G(^PSRX(PSORXED("IRXN"),6,I,1))
K:'$O(PSORXED("DOSE",0)) PSORXED("ENT"),OLENT
S PSORXED("INS")=$G(^PSRX(PSORXED("IRXN"),"INS"))
Q
UPDSIG ;updates sig
K ^PSRX(PSORXED("IRXN"),"SIG1") S ^PSRX(PSORXED("IRXN"),"SIG1",0)="^52.04A^^"
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
S ^PSRX(PSORXED("IRXN"),"SIG")="^1"
Q
JUMP ;jump to fields
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 S DIR("A",1)="* Indicates which fields will create a New Order",DIR("A")="Select Field to Edit by number",DIR(0)="NO^1:"_AR1 D ^DIR G:$D(DIRUT) @FIELD
D JFN^PSOOREDX G:FLDNM="" @FIELD G @FLDNM
G EX
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 ; NOT SURE ABOUT THIS???
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
PSOORED3 ;BIR/SAB-edit finished orders through backdoor ;29-May-2012 14:56;PLS
+1 ;;7.0;OUTPATIENT PHARMACY;**46,78,99,117,133,1006,148,249,1015**;DEC 1997;Build 62
+2 ;External reference to PS(51.2 supported by DBIA 2226
+3 ;
+4 ; Modified - IHS/MSC/PLS - 12/04/07 - Line DOSE+2
+5 ;
+6 ;called from psoored2
+7 DO DOLST
+8 ;
DOSE ;adds dosing info
+1 IF '$GET(PSORXED("ENT"))
FOR
SET I=$ORDER(PSORXED("DOSE",I))
IF 'I
QUIT
SET PSORXED("ENT")=$GET(PSORXED("ENT"))+1
+2 ;IHS/MSC/PLS - 12/04/07
IF '$DATA(PSORXED("ENT"))
SET PSORXED("ENT")=0
+3 KILL ROU,UNITN,STRE,PSODOSE,RTE,NOUN,VERB
MERGE PSODOSE=PSORXED
+4 DO KV
KILL FIELD,DOSEOR,DOOR,X,Y,UNITS
SET ENT=1
ASK SET ROU="PSOORED3"
DO ASK^PSOBKDED
KILL ROU
IF $GET(JUMP)
KILL JUMP
GOTO JUMP
+1 IF $DATA(DIRUT)
GOTO EXQ
+2 IF $GET(QUIT)]""
KILL QUIT,ROU
QUIT
+3 ;
+4 IF $GET(VERB)]""
SET PSORXED("VERB",ENT)=VERB
GOTO DUPD
VER DO VER^PSOOREDX
IF X[U
IF $LENGTH(X)>1
SET FIELD="VER"
GOTO JUMP
+1 IF $DATA(DTOUT)!($DATA(DUOUT))
GOTO EXQ
+2 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 DUPD^PSOOREDX
+3 SET DIR("B")=$SELECT($GET(PSORXED("DOSE ORDERED",ENT))]"":PSORXED("DOSE ORDERED",ENT),1:"")
IF $EXTRACT($GET(DIR("B")),1)="."
SET DIR("B")="0"_$GET(DIR("B"))
IF DIR("B")=""
KILL DIR("B")
+4 DO ^DIR
IF X[U
IF $LENGTH(X)>1
SET FIELD="DUPD"
GOTO JUMP
+5 IF $DATA(DTOUT)!($DATA(DUOUT))
GOTO EXQ
+6 IF X="@"!(X=0)
WRITE !,"Dispense Units Per Dose is Required!!",!
GOTO DUPD
+7 DO STR^PSOOREDX
NOU1 IF '$GET(PSORXED("DOSE ORDERED",ENT))
GOTO RTE
+1 DO CNON
+2 NEW PSONDEF
+3 IF $GET(NOUN)]""
SET PSORXED("NOUN",ENT)=NOUN
NOU DO NOU^PSOOREDX
IF X[U
IF $LENGTH(X)>1
SET FIELD="NOU"
GOTO JUMP
+1 IF $DATA(DTOUT)!($DATA(DUOUT))
GOTO EXQ
+2 IF X="@"
KILL PSORXED("NOUN",ENT),NOUN
GOTO RTE
+3 IF X'=""
IF $GET(PSONDEF)=""
SET NOUN=X
+4 IF X'=""
IF $GET(PSONDEF)'=X
SET NOUN=X
+5 IF X'=""
SET PSORXED("NOUN",ENT)=X
RTE IF $GET(PSORXED("ROUTE",ENT))']""
SET DRET=1
+1 KILL JUMP
SET ROU="PSOORED3"
DO RTE^PSOBKDED
KILL ROU
+2 IF $GET(JUMP)
KILL JUMP
GOTO JUMP
+3 IF $DATA(DTOUT)!($DATA(DUOUT))
GOTO EXQ
+4 IF $GET(QUIT)
KILL QUIT,ROU
QUIT
+5 ;
SCH DO SCH^PSOBKDED
IF X[U
IF $LENGTH(X)>1
SET FIELD="SCH"
GOTO JUMP
+1 IF $DATA(DTOUT)!($DATA(DUOUT))
GOTO EXQ
+2 SET SCH=Y
DO SCH^PSOSIG
IF $GET(SCH)']""
GOTO SCH
+3 SET PSORXED("SCHEDULE",ENT)=SCH
WRITE " ("_SCHEX_")"
KILL SCH,SCHEX,X,Y,PSOSCH
+4 IF PSORXED("ENT")<ENT
SET PSORXED("ENT")=ENT
+5 ;
DUR DO KV
KILL EXP
SET DIR(0)="52.0113,4"
SET DIR("A")="LIMITED DURATION (IN MONTHS, WEEKS, DAYS, HOURS OR MINUTES)"
+1 SET DIR("B")=$SELECT($GET(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 EXQ
+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 EXQ
+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 EXQ
IF 'Y
GOTO CON
NEW CKX
SET CKX=1
DO UPD^PSOOREDX
GOTO CON
+5 IF $GET(PSORXED("CONJUNCTION",ENT))]""
SET ENT=ENT+1
KILL DIR
GOTO ASK
+6 SET DENT=$ORDER(PSORXED("DOSE",ENT))
IF DENT
IF (ENT+1)'=DENT
Begin DoDot:1
+7 KILL PSORXED("DOSE",DENT),PSORXED("NOUN",DENT),PSORXED("VERB",DENT),PSORXED("DOSE ORDERED",DENT),PSORXED("ROUTE",DENT),PSORXED("ODOSE",DENT)
+8 KILL PSORXED("SCHEDULE",DENT),PSORXED("DURATION",DENT),PSORXED("CONJUNCTION",DENT),DENT
End DoDot:1
+9 IF $GET(FIELD)]""
KILL FIELD
SET QUIT=1
+10 IF $ORDER(^PSRX(PSORXED("IRXN"),"INS1",0))
Begin DoDot:1
+11 FOR D=0:0
SET D=$ORDER(^PSRX(PSORXED("IRXN"),"INS1",D))
IF 'D
QUIT
SET PSORXED("SIG",D)=^PSRX(PSORXED("IRXN"),"INS1",D,0)
End DoDot:1
+12 DO EN^PSOFSIG(.PSORXED)
IF '$GET(PSOVER)
DO VER^PSOORED7
IF $GET(CKX)
IF '$GET(PSOSIGFL)
DO M1
KILL CKX
+13 IF $GET(PSOSIGFL)=1
SET PSORXED("ENT")=ENT
SET SIGOK=1
GOTO EX1
+14 KILL QTY,QTYHLD
IF $GET(PSORXED("QTY"))
SET QTYHLD=PSORXED("QTY")
DO QTY^PSOSIG(.PSORXED)
IF $GET(PSORXED("QTY"))
SET QTY=1
+15 IF $GET(QTYHLD)
IF '$GET(PSORXED("QTY"))
SET PSORXED("QTY")=QTYHLD
+16 KILL QTYHLD
IF $GET(PSOVER)!($GET(PSOREEDQ))
QUIT
UDSIG IF $ORDER(SIG(0))
Begin DoDot:1
+1 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
+2 SET (A,I)=0
FOR
SET I=$ORDER(^PSRX(PSORXED("IRXN"),"A",I))
IF 'I
QUIT
SET A=A+1
+3 DO NOW^%DTC
IF $GET(QTY)
SET A=A+1
SET ^PSRX(PSORXED("IRXN"),"A",A,0)=%_"^E^"_DUZ_"^0^Quantity Updated "_"("_$PIECE(^PSRX(PSORXED("IRXN"),0),"^",7)_")"
SET $PIECE(^PSRX(PSORXED("IRXN"),0),"^",7)=$GET(PSORXED("QTY"))
KILL QTY
+4 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
+5 IF '$PIECE($GET(^PSRX(PSORXED("IRXN"),"SIG")),"^",2)
SET $PIECE(^PSRX(PSORXED("IRXN"),"A",A,1),"^",2)=$PIECE($GET(^PSRX(PSORXED("IRXN"),"SIG")),"^")
QUIT
+6 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
+7 SET ^PSRX(PSORXED("IRXN"),"SIG")="^1"
+8 KILL SIG,A,I
End DoDot:1
+9 SET ^PSRX(PSORXED("IRXN"),6,0)="^52.0113^"_ENT_"^"_ENT
+10 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
+11 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))
+12 SET ^PSRX(PSORXED("IRXN"),6,I,1)=$GET(PSORXED("ODOSE",I))
End DoDot:1
+13 SET ^PSRX(PSORXED("IRXN"),"POE")=1
+14 GOTO EX
+15 QUIT
EX ;
+1 KILL PSORXED("DOSE"),DOSE,DUPD,SCH,PSORXED("NOUN"),PSORXED("VERB"),VERB,NOUN,PSORXED("DOSE ORDERED"),DOSEOR,PSORXED("ROUTE"),ENT,PSORTE,SIG,PSODOSE
+2 KILL PSORXED("SCHEDULE"),PSORXED("DURATION"),PSORXED("CONJUNCTION"),DURA,X,Y,PSORXED("ODOSE")
EX1 KILL STRE,UNITN,DOSE,DUPD,SCH,VERB,NOUN,DOSEOR,RTE,DUR,X,Y,ENTS,PSOSCH,ERTE,ROU
KV KILL DIR,DIRUT,DUOUT,DTOUT
+1 QUIT
EXQ KILL PSORXED,PSOSIGFL
MERGE PSORXED=PSODOSE
DO EN^PSOFSIG(.PSORXED)
SET PSORXED("DFLG")=1
DO M1
GOTO EX
+1 QUIT
M1 DO M1^PSOOREDX
+1 QUIT
DOLST1(PSORXED) ;
+1 ;
DOLST FOR I=0:0
SET I=$ORDER(^PSRX(PSORXED("IRXN"),6,I))
IF 'I
QUIT
SET INST=^(I,0)
Begin DoDot:1
+1 SET PSORXED("DOSE",I)=$PIECE(INST,"^")
SET PSORXED("DOSE ORDERED",I)=$PIECE(INST,"^",2)
SET PSORXED("UNITS",I)=$PIECE(INST,"^",3)
SET PSORXED("NOUN",I)=$PIECE(INST,"^",4)
+2 IF $PIECE(INST,"^",5)]""
Begin DoDot:2
+3 SET PSORXED("DURATION",I)=$SELECT($EXTRACT($PIECE(INST,"^",5),1)'?.N:$EXTRACT($PIECE(INST,"^",5),2,99)_$EXTRACT($PIECE(INST,"^",5),1),1:$PIECE(INST,"^",5))
End DoDot:2
+4 SET PSORXED("ROUTE",I)=$PIECE(INST,"^",7)
SET PSORXED("SCHEDULE",I)=$PIECE(INST,"^",8)
+5 SET PSORXED("CONJUNCTION",I)=$PIECE(INST,"^",6)
SET PSORXED("VERB",I)=$PIECE(INST,"^",9)
SET OLENT=I
+6 SET PSORXED("ODOSE",I)=$GET(^PSRX(PSORXED("IRXN"),6,I,1))
End DoDot:1
+7 IF '$ORDER(PSORXED("DOSE",0))
KILL PSORXED("ENT"),OLENT
+8 SET PSORXED("INS")=$GET(^PSRX(PSORXED("IRXN"),"INS"))
+9 QUIT
UPDSIG ;updates sig
+1 KILL ^PSRX(PSORXED("IRXN"),"SIG1")
SET ^PSRX(PSORXED("IRXN"),"SIG1",0)="^52.04A^^"
+2 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
+3 SET ^PSRX(PSORXED("IRXN"),"SIG")="^1"
+4 QUIT
JUMP ;jump to fields
+1 IF $LENGTH($EXTRACT(X,2,99))<3
WRITE !,"Field Name Must Be At Least 3 Characters in Length",!
GOTO @FIELD
+2 DO FNM^PSOOREDX
+3 IF FLDNM']""
KILL X,NM,FLDNM
WRITE !,"INVALID FIELD NAME. PLEASE TRY AGAIN!",!
GOTO @FIELD
+4 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
+5 DO KV
SET DIR("A",1)="* Indicates which fields will create a New Order"
SET DIR("A")="Select Field to Edit by number"
SET DIR(0)="NO^1:"_AR1
DO ^DIR
IF $DATA(DIRUT)
GOTO @FIELD
+6 DO JFN^PSOOREDX
IF FLDNM=""
GOTO @FIELD
GOTO @FLDNM
+7 GOTO EX
+8 QUIT
+9 ;
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 ; NOT SURE ABOUT THIS???
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
