PSOBKDED ;BIR/SAB - Edit backdoor Rx Order entry ;Aug 11, 2020@11:13:08
;;7.0;OUTPATIENT PHARMACY;**11,46,91,78,99,117,133,143,268,378,416,282,450,402,518,525,538,457,557,574,598,441**;DEC 1997;Build 208
;Ref PS(50.607 IA 2221
;Ref PS(50.7 IA 2223
;Ref PS(51.2 IA 2226
;Ref PSDRUG( IA 221
;Ref DOSE^PSSORPH IA 3234
;Ref PS(55 IA 2228
1 S %DT="AEX",%DT(0)=-PSONEW("FILL DATE"),Y=PSONEW("ISSUE DATE") X ^DD("DD") S %DT("A")="ISSUE DATE: ",%DT("B")=Y D ^%DT,CID^PSOUTL
I "^"[$E(X) D KX K %DT Q
; PSO*7*538 Added Next Line
I Y=-1 W ! D CIDH^PSOUTL W ! G 1
G:Y=-1 1 S (PSOID,PSONEW("ISSUE DATE"))=Y D KX K %DT
Q
2 S PSONEW("FLD")=2 D FILLDT^PSODIR2(.PSONEW) ;Fdt
Q
3 S:$G(POERR) PSONEW("ISSUE DATE")=PSOID
S PSONEW("FLD")=3 D PTSTAT^PSODIR1(.PSONEW) ;Sta
Q
4 S PSONEW("FLD")=4 D PROV^PSODIR(.PSONEW) ;Pro
Q
5 S PSONEW("FLD")=5 D CLINIC^PSODIR2(.PSONEW) ;Cli
Q
6 S PSONEW("FLD")=6 D ^PSODRG,EN^PSODIAG ;Drg/ICD
D 6^PSODRGN
Q
7 S PSONEW("FLD")=7 D QTY^PSODIR1(.PSONEW) ;Qty
Q
8 S PSONEW("FLD")=8 D DAYS^PSODIR1(.PSONEW) ;Day
K PSMAX,PSTMAX D REF^PSOORNEW S PSONEW("N# REF")=PSONEW("# OF REFILLS")
Q
9 S PSONEW("FLD")=9 D REFILL^PSODIR1(.PSONEW) ;Ref
K PSMAX,PSTMAX
Q
10 S PSONEW("FLD")="3A" N PSOEDDOS S PSOEDDOS=1 D DOSE^PSODIR(.PSONEW) ;Dose
Q
;
Q I $G(COPY),$G(SIGOK) S PSOFDR=1 K PSONEW("SIG")
S PSONEW("FLD")=10 D SIG^PSODIR1(.PSONEW) ;Sig
I $G(COPY) K PSOFDR
S DIR(0)="E",DIR("A")="Press Return to Continue" D ^DIR D KV
Q
INS S PSONEW("FLD")="3B" D INS^PSODIR(.PSONEW) ;Ins
Q
11 S PSONEW("FLD")=11 D COPIES^PSODIR1(.PSONEW) ;Cop
Q
12 S PSONEW("FLD")=12 D MW^PSODIR2(.PSONEW) ;M/W
Q
13 S PSONEW("FLD")=13 D RMK^PSODIR2(.PSONEW) ;Rem
Q
DOSE ;backdoor
I '$G(PSONEW("ENT")) S IEN=IEN+1,^TMP("PSOPO",$J,IEN,0)=" (5) Dosage Ordered: " G INS1
S SD=1 F I=1:1:PSONEW("ENT") D
.I '$G(PSONEW("DOSE ORDERED",I)),$G(PSONEW("VERB",I))]"" S IEN=IEN+1,^TMP("PSOPO",$J,IEN,0)=" Verb: "_$G(PSONEW("VERB",I))
.S:$G(SD)=1 IEN=IEN+1,^TMP("PSOPO",$J,IEN,0)=" (5)",DS=1 K SD
.D DOSE1
INS1 S IEN=IEN+1,^TMP("PSOPO",$J,IEN,0)=" (6)Pat Instruction:"
INS2 I $O(PSONEW("SIG",0)) F D=0:0 S D=$O(PSONEW("SIG",D)) Q:'D D
.F SG=1:1:$L(PSONEW("SIG",D)) S:$L(^TMP("PSOPO",$J,IEN,0)_" "_$P(PSONEW("SIG",D)," ",SG))>80 IEN=IEN+1,$P(^TMP("PSOPO",$J,IEN,0)," ",21)=" " D
..S:$P(PSONEW("SIG",D)," ",SG)'="" ^TMP("PSOPO",$J,IEN,0)=$G(^TMP("PSOPO",$J,IEN,0))_" "_$P(PSONEW("SIG",D)," ",SG)
I $P($G(^PS(55,PSODFN,"LAN")),"^") D
.S IEN=IEN+1,^TMP("PSOPO",$J,IEN,0)=" Other Patient Inst.: "
.I $G(^PSRX(+$G(PSONEW("OIRXN")),"INSS"))]"" S PSONEW("SINS")=^PSRX(PSONEW("OIRXN"),"INSS")
.S ^TMP("PSOPO",$J,IEN,0)=^TMP("PSOPO",$J,IEN,0)_$G(PSONEW("SINS"))
S IEN=IEN+1,^TMP("PSOPO",$J,IEN,0)=" Indications: "_$S($G(PSONEW("IND"))]"":PSONEW("IND"),1:"") ;*441-IND
I $P($G(^PS(55,PSODFN,"LAN")),"^") D
. S IEN=IEN+1,^TMP("PSOPO",$J,IEN,0)=" Other Indications: "_$S($G(PSONEW("INDO"))]"":PSONEW("INDO"),1:"")
Q
;
DOSE1 I $G(DS)=1 D K DS G DU
.S ^TMP("PSOPO",$J,IEN,0)=^TMP("PSOPO",$J,IEN,0)_" Dosage Ordered: "_$S($E(PSONEW("DOSE",I),1)="."&($G(PSONEW("DOSE ORDERED",I))):"0",1:"")_PSONEW("DOSE",I)_$S($G(PSONEW("UNITS",I))'="":" ("_$P(^PS(50.607,PSONEW("UNITS",I),0),"^")_")",1:"")
S IEN=IEN+1,^TMP("PSOPO",$J,IEN,0)=" Dosage Ordered: "_$S($E(PSONEW("DOSE",I),1)="."&($G(PSONEW("DOSE ORDERED",I))):"0",1:"")_PSONEW("DOSE",I)_$S($G(PSONEW("UNITS",I))'="":" ("_$P(^PS(50.607,PSONEW("UNITS",I),0),"^")_")",1:"")
DU I '$G(PSONEW("DOSE ORDERED",I)),$P($G(^PS(55,PSODFN,"LAN")),"^") S IEN=IEN+1,^TMP("PSOPO",$J,IEN,0)=" Oth. Lang. Dosage: "_$G(PSONEW("ODOSE",I))
I $G(PSONEW("DOSE ORDERED",I)),$G(PSONEW("VERB",I))]"" S IEN=IEN+1,^TMP("PSOPO",$J,IEN,0)=" Verb: "_$G(PSONEW("VERB",I))
S:$G(PSONEW("DOSE ORDERED",I)) IEN=IEN+1,^TMP("PSOPO",$J,IEN,0)=" Dispense Units: "_$S($E($G(PSONEW("DOSE ORDERED",I)),1)=".":"0",1:"")_$G(PSONEW("DOSE ORDERED",I))
I $G(PSONEW("DOSE ORDERED",I)),$G(PSONEW("NOUN",I))]"" S IEN=IEN+1,^TMP("PSOPO",$J,IEN,0)=" Noun: "_PSONEW("NOUN",I)
I $G(PSONEW("ROUTE",I)) S IEN=IEN+1,^TMP("PSOPO",$J,IEN,0)=" Route: "_$P(^PS(51.2,PSONEW("ROUTE",I),0),"^")
S IEN=IEN+1,^TMP("PSOPO",$J,IEN,0)=" Schedule: "_$G(PSONEW("SCHEDULE",I))
I $G(PSONEW("DURATION",I))]"" D
.S IEN=IEN+1
.S ^TMP("PSOPO",$J,IEN,0)=" *Duration: "_PSONEW("DURATION",I)_" ("_$S(PSONEW("DURATION",I)["M":"MINUTES",PSONEW("DURATION",I)["W":"WEEKS",PSONEW("DURATION",I)["L":"MONTHS",PSONEW("DURATION",I)["H":"HOURS",1:"DAYS")_")"
I $G(PSONEW("CONJUNCTION",I))]"" S IEN=IEN+1,^TMP("PSOPO",$J,IEN,0)=" Conjunction: "_$S($G(PSONEW("CONJUNCTION",I))="A":"AND",$G(PSONEW("CONJUNCTION",I))="T":"THEN",$G(PSONEW("CONJUNCTION",I))="X":"EXCEPT",1:"")
Q
RTE ;*525
I $G(DRET) S PSORXED("ROUTE",ENT)=""
I $G(RTE) K RTE
D KV N MRSLS,MRX,MRDFV,MRQ S MRQ=0,MRDFV=$S($G(PSORXED("ROUTE",ENT)):$P(^PS(51.2,PSORXED("ROUTE",ENT),0),"^"),$G(RTE)]"":RTE,1:"")
S X=""
W !,"ROUTE: "_MRDFV_"//"
D G:$G(MRSLS) RTEC G:MRQ RTE
. R MRX:DTIME
. I '$T S DTOUT=1
. I MRX="^" S DUOUT=1
. I MRX="?" D MRSL^PSOORED5
. I MRX="",$G(MRDFV)]"" S MRX=$G(MRDFV)
S X=MRX
K MRSLS,MRX,MRDFV,MRQ
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
D CKMRSL^PSOORED5
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
RTEC ;
K DIC S DIC=51.2,DIC(0)="QEZMX",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)
Q
ASK ;
K JUMP,UNITN,DOSE D KV D DOSE^PSSORPH(.DOSE,PSODRUG("IEN"),"O",PSODFN)
N PSODOSCT,PSODOSFL,PSODOSWT D FULL^VALM1 ;402
I $D(DOSE("DD")) D LST2^PSOBKDE1 G ASK1
D:$G(PSOFROM)="NEW"&($G(PSORX("EDIT"))']"")!($G(PSOFROM1))!($G(COPY)) LST^PSOBKDE1:$O(DOSE(0))
ASK1 S STRE=$P($G(DOSE("DD",PSODRUG("IEN"))),"^",5),UNITN=$P($G(DOSE("DD",PSODRUG("IEN"))),"^",6),DOSE("LD")=$P($G(DOSE("DD",PSODRUG("IEN"))),"^",11)
W ! S DIR(0)="F^1:60"
I '$G(PSODOSCT) D
.F I=0:0 S I=$O(DOSE(I)) Q:'I!('$D(DOSE(I))) S PSODOSCT=I
.I PSODOSCT=1,$P(DOSE(1),"^")=""&($P(DOSE("DD",PSODRUG("IEN")),"^",6)="") S PSODOSFL=1
S PSODOSWT="",PSODOSWT=$S($G(PSODOSCT)<1:"",$G(PSODOSCT)=1&($G(PSODOSFL)):"",1:" (1-"_$G(PSODOSCT)_")")
; next 2 lines 402
I PSODOSCT=1,($P($G(DOSE(1)),"^")=""&($P($G(DOSE(1)),"^",3)="")) S PSODOSFL=1
S:$G(PSODOSFL) DIR("A")=" Please Enter a Free Text Dose"
S:'$G(PSODOSFL) DIR("A",1)="Select from list of Available Dosages"_PSODOSWT_", Enter Free Text Dose",DIR("?")="^D LST1^PSOBKDE1",DIR("A")="or Enter a Question Mark (?) to view list"
; PSO*7.0*574 - Defect 1180952 Adding Complex default dose
I $G(PSORXED("DOSE",ENT))]"" S DIR("B")=PSORXED("DOSE",ENT) D
.I $G(PSORXED("UNITS",ENT))]"",DIR("B")'[($P($G(^PS(50.607,PSORXED("UNITS",ENT),0)),"^")) S DIR("B")=DIR("B")_$P($G(^PS(50.607,PSORXED("UNITS",ENT),0)),"^") K:$G(PSOREEDQ)!($G(PSOBDRG)) DIR("B")
D ^DIR
I X[U,$L(X)>1 S FIELD="ASK",JUMP=1 K DIRUT,DTOUT Q
I $D(DIRUT) S:$G(ORD) PSODSPL=1 Q
I X=$G(PSORXED("DOSE",ENT)),$D(DOSE(Y)) S PSORXED("DOSE EDIT")=DOSE(Y) G GD1
I X=$G(PSORXED("DOSE",ENT)) D G DOS
.S DOSE=X,UNITS=$G(PSORXED("UNITS",ENT)),PSORXED("DOSE EDIT")=X
.I $P(DOSE("DD",PSODRUG("IEN")),"^",5) S DUPD=DOSE/$P(DOSE("DD",PSODRUG("IEN")),"^",5),PSORXED("DOSE ORDERED",ENT)=DUPD ;557
.I DOSE'?.N&(DOSE'?.N1".".N)!'DOSE("LD") S (UNITN,UNITS,PSORXED("UNITS",ENT))="" K PSORXED("DOSE ORDERED",ENT),DUPD,PSORXED("NOUN",ENT)
GD1 N PSORXTE
I $D(DOSE(Y)) D G DOS ;from list
.S DOSE=$S($P(DOSE(Y),"^"):$P(DOSE(Y),"^"),$P(DOSE(Y),"^",3)]"":$P(DOSE(Y),"^",3),1:1),DOLST=Y,PSORXED("NEW DOSE")=DOSE
.I $P(DOSE(Y),"^") S UNITS=$P(DOSE(Y),"^",2),DUPD=$P(DOSE(Y),"^",3),UNITN=$P(DOSE("DD",PSODRUG("IEN")),"^",6),PSORXTE("DOSE ORDERED",ENT)=DUPD
.S PSORXTE("NOUN",ENT)=$P(DOSE(Y),"^",6),PSORXTE("VERB",ENT)=$P(DOSE(Y),"^",8)
.I DOSE'?.N&(DOSE'?.N1".".N)!'DOSE("LD") D Q
..S (UNITN,UNITS,PSORXED("UNITS",ENT))="" K PSORXED("DOSE ORDERED",ENT),DUPD,PSORXED("NOUN",ENT)
..I $P($G(^PS(55,PSODFN,"LAN")),"^"),$G(PSOFROM)="PENDING" D LAN^PSOORED5 Q
..I $P($G(^PS(55,PSODFN,"LAN")),"^"),$G(PSOFROM)="NEW" D LAN^PSOORED5
.S PSORXTE("UNITS",ENT)=$G(UNITS)
S DOSE=Y,DOLST=0,PSORXED("DOSE EDIT")=DOSE ;non-numeric and numeric not in list
I DOSE("LD") D
.F I=1:1:$L(DOSE) I $E(DOSE,I)'?.N&($E(DOSE,I)'?1" ")&($E(DOSE,I)'?1".") S DCHK=$G(DCHK)_$E(DOSE,I)
.I $G(DCHK)]"" D
..S DCHK=$TR(DCHK,"qwertyuioplkjhgfdsazxcvbnm","QWERTYUIOPLKJHGFDSAZXCVBNM")
..I DCHK=UNITN S DOSE=+DOSE,PSORXED("DOSE EDIT")=DOSE
K I,DCHK
S PSOINDT=$$GET1^DIQ(50,PSODRUG("IEN"),100,"I") I PSOINDT,DT>PSOINDT G DOS
S PSORXTE("NOUN",ENT)=$P(DOSE("DD",PSODRUG("IEN")),"^",9),PSORXTE("VERB",ENT)=$P(DOSE("DD",PSODRUG("IEN")),"^",10)
I DOSE'?.N&(DOSE'?.N1".".N)!'DOSE("LD") S (UNITN,UNITS,PSORXED("UNITS",ENT))="" K PSORXED("NOUN",ENT),PSORXED("ODOSE",ENT) G DOS
S:$P(DOSE("DD",PSODRUG("IEN")),"^",6)]"" (PSORXTE("UNITS",ENT),UNITS)=$O(^PS(50.607,"B",$P(DOSE("DD",PSODRUG("IEN")),"^",6),0)),UNITN=$P(DOSE("DD",PSODRUG("IEN")),"^",6)
S:$P(DOSE("DD",PSODRUG("IEN")),"^",5) DUPD=DOSE/$P(DOSE("DD",PSODRUG("IEN")),"^",5),PSORXTE("DOSE ORDERED",ENT)=DUPD
DOS W " "_$S($E(DOSE,1)="."&($G(UNITN)'=""):"0",1:"")_DOSE W:$G(UNITN)'="" UNITN
W ! K DIR,DIRUT S DIR(0)="Y",DIR("A")="You entered "_$S($E(DOSE,1)="."&($G(UNITN)'=""):"0",1:"")_DOSE_$S($G(UNITN)'="":UNITN,1:"")_" is this correct",DIR("B")="Yes"
D ^DIR I 'Y D KX K DOSE,UNITS,PSORXTE,PSOINDT G ASK
S PSORXED("DOSE",ENT)=DOSE
S:$G(PSORXTE("DOSE ORDERED",ENT))]"" PSORXED("DOSE ORDERED",ENT)=PSORXTE("DOSE ORDERED",ENT)
S:$G(PSORXTE("NOUN",ENT))]"" PSORXED("NOUN",ENT)=PSORXTE("NOUN",ENT)
I $G(PSORX("EDIT"))']"" D ;PSO*7.0*450
.S:$G(PSORXTE("VERB",ENT))]"" PSORXED("VERB",ENT)=PSORXTE("VERB",ENT)
S:$G(PSORXTE("UNITS",ENT))]"" PSORXED("UNITS",ENT)=PSORXTE("UNITS",ENT)
I $G(PSORXED("DOSE",ENT))'?.N&($G(PSORXED("DOSE",ENT))'?.N1".".N)!'DOSE("LD"),$P($G(^PS(55,PSODFN,"LAN")),"^") D
.K OTHDOS(ENT) D KX S DIR(0)="52.0113,9"
.I '$G(OTHDOS(ENT)),$G(PSORXED("ODOSE",ENT))']"" D LAN^PSOORED5
.I $G(PSORXED("ODOSE",ENT))]"" S DIR("B")=PSORXED("ODOSE",ENT) K:DIR("B")="" DIR("B")
.K DTOUT,DUOUT,DIRUT,Y,X D ^DIR K DIR K:$G(X)="@"!($G(X)="") DIRUT I $D(DIRUT) Q
.I X="@" S OTHDOS(ENT)=1 D KX K PSORXED("ODOSE",ENT) Q
.S:X'="" PSORXED("ODOSE",ENT)=X
Q
;
SCH D KX
;*282 Allow multi-word schedules
S DIR("?")="^D SCHLP^PSOORED4",DIR("A")="Schedule: ",DIR(0)="FA^1:20^I X[""""""""!(X?.E1C.E)!($A(X)=45)!($L(X,"" "")>$S(X[""PRN"":4,1:3))!($L(X)>20)!($L(X)<1) K X"
I '$D(PSOSCH),'$D(PSORXED("SCHEDULE",ENT)),$P(^PS(50.7,PSODRUG("OI"),0),"^",8)]"" S PSOSCH=$P(^PS(50.7,PSODRUG("OI"),0),"^",8)
S DIR("B")=$S($D(PSOSCH)&('$D(PSORXED("SCHEDULE",ENT))):PSOSCH,$G(PSORXED("SCHEDULE",ENT))]"":PSORXED("SCHEDULE",ENT),1:"") K:DIR("B")="" DIR("B")
I $G(PSORXED("SCHEDULE",ENT))']"",$G(PSOREEDT) K DIR("B")
D ^DIR
Q
KX K X,Y
KV K DTOUT,DUOUT,DIR,DIRUT
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPSOBKDED 11229 printed Dec 13, 2024@02:24:50 Page 2
PSOBKDED ;BIR/SAB - Edit backdoor Rx Order entry ;Aug 11, 2020@11:13:08
+1 ;;7.0;OUTPATIENT PHARMACY;**11,46,91,78,99,117,133,143,268,378,416,282,450,402,518,525,538,457,557,574,598,441**;DEC 1997;Build 208
+2 ;Ref PS(50.607 IA 2221
+3 ;Ref PS(50.7 IA 2223
+4 ;Ref PS(51.2 IA 2226
+5 ;Ref PSDRUG( IA 221
+6 ;Ref DOSE^PSSORPH IA 3234
+7 ;Ref PS(55 IA 2228
1 SET %DT="AEX"
SET %DT(0)=-PSONEW("FILL DATE")
SET Y=PSONEW("ISSUE DATE")
XECUTE ^DD("DD")
SET %DT("A")="ISSUE DATE: "
SET %DT("B")=Y
DO ^%DT
DO CID^PSOUTL
+1 IF "^"[$EXTRACT(X)
DO KX
KILL %DT
QUIT
+2 ; PSO*7*538 Added Next Line
+3 IF Y=-1
WRITE !
DO CIDH^PSOUTL
WRITE !
GOTO 1
+4 if Y=-1
GOTO 1
SET (PSOID,PSONEW("ISSUE DATE"))=Y
DO KX
KILL %DT
+5 QUIT
2 ;Fdt
SET PSONEW("FLD")=2
DO FILLDT^PSODIR2(.PSONEW)
+1 QUIT
3 if $GET(POERR)
SET PSONEW("ISSUE DATE")=PSOID
+1 ;Sta
SET PSONEW("FLD")=3
DO PTSTAT^PSODIR1(.PSONEW)
+2 QUIT
4 ;Pro
SET PSONEW("FLD")=4
DO PROV^PSODIR(.PSONEW)
+1 QUIT
5 ;Cli
SET PSONEW("FLD")=5
DO CLINIC^PSODIR2(.PSONEW)
+1 QUIT
6 ;Drg/ICD
SET PSONEW("FLD")=6
DO ^PSODRG
DO EN^PSODIAG
+1 DO 6^PSODRGN
+2 QUIT
7 ;Qty
SET PSONEW("FLD")=7
DO QTY^PSODIR1(.PSONEW)
+1 QUIT
8 ;Day
SET PSONEW("FLD")=8
DO DAYS^PSODIR1(.PSONEW)
+1 KILL PSMAX,PSTMAX
DO REF^PSOORNEW
SET PSONEW("N# REF")=PSONEW("# OF REFILLS")
+2 QUIT
9 ;Ref
SET PSONEW("FLD")=9
DO REFILL^PSODIR1(.PSONEW)
+1 KILL PSMAX,PSTMAX
+2 QUIT
10 ;Dose
SET PSONEW("FLD")="3A"
NEW PSOEDDOS
SET PSOEDDOS=1
DO DOSE^PSODIR(.PSONEW)
+1 QUIT
+2 ;
+3 QUIT
IF $GET(COPY)
IF $GET(SIGOK)
SET PSOFDR=1
KILL PSONEW("SIG")
+4 ;Sig
SET PSONEW("FLD")=10
DO SIG^PSODIR1(.PSONEW)
+5 IF $GET(COPY)
KILL PSOFDR
+6 SET DIR(0)="E"
SET DIR("A")="Press Return to Continue"
DO ^DIR
DO KV
+7 QUIT
INS ;Ins
SET PSONEW("FLD")="3B"
DO INS^PSODIR(.PSONEW)
+1 QUIT
11 ;Cop
SET PSONEW("FLD")=11
DO COPIES^PSODIR1(.PSONEW)
+1 QUIT
12 ;M/W
SET PSONEW("FLD")=12
DO MW^PSODIR2(.PSONEW)
+1 QUIT
13 ;Rem
SET PSONEW("FLD")=13
DO RMK^PSODIR2(.PSONEW)
+1 QUIT
DOSE ;backdoor
+1 IF '$GET(PSONEW("ENT"))
SET IEN=IEN+1
SET ^TMP("PSOPO",$JOB,IEN,0)=" (5) Dosage Ordered: "
GOTO INS1
+2 SET SD=1
FOR I=1:1:PSONEW("ENT")
Begin DoDot:1
+3 IF '$GET(PSONEW("DOSE ORDERED",I))
IF $GET(PSONEW("VERB",I))]""
SET IEN=IEN+1
SET ^TMP("PSOPO",$JOB,IEN,0)=" Verb: "_$GET(PSONEW("VERB",I))
+4 if $GET(SD)=1
SET IEN=IEN+1
SET ^TMP("PSOPO",$JOB,IEN,0)=" (5)"
SET DS=1
KILL SD
+5 DO DOSE1
End DoDot:1
INS1 SET IEN=IEN+1
SET ^TMP("PSOPO",$JOB,IEN,0)=" (6)Pat Instruction:"
INS2 IF $ORDER(PSONEW("SIG",0))
FOR D=0:0
SET D=$ORDER(PSONEW("SIG",D))
if 'D
QUIT
Begin DoDot:1
+1 FOR SG=1:1:$LENGTH(PSONEW("SIG",D))
if $LENGTH(^TMP("PSOPO",$JOB,IEN,0)_" "_$PIECE(PSONEW("SIG",D)," ",SG))>80
SET IEN=IEN+1
SET $PIECE(^TMP("PSOPO",$JOB,IEN,0)," ",21)=" "
Begin DoDot:2
+2 if $PIECE(PSONEW("SIG",D)," ",SG)'=""
SET ^TMP("PSOPO",$JOB,IEN,0)=$GET(^TMP("PSOPO",$JOB,IEN,0))_" "_$PIECE(PSONEW("SIG",D)," ",SG)
End DoDot:2
End DoDot:1
+3 IF $PIECE($GET(^PS(55,PSODFN,"LAN")),"^")
Begin DoDot:1
+4 SET IEN=IEN+1
SET ^TMP("PSOPO",$JOB,IEN,0)=" Other Patient Inst.: "
+5 IF $GET(^PSRX(+$GET(PSONEW("OIRXN")),"INSS"))]""
SET PSONEW("SINS")=^PSRX(PSONEW("OIRXN"),"INSS")
+6 SET ^TMP("PSOPO",$JOB,IEN,0)=^TMP("PSOPO",$JOB,IEN,0)_$GET(PSONEW("SINS"))
End DoDot:1
+7 ;*441-IND
SET IEN=IEN+1
SET ^TMP("PSOPO",$JOB,IEN,0)=" Indications: "_$SELECT($GET(PSONEW("IND"))]"":PSONEW("IND"),1:"")
+8 IF $PIECE($GET(^PS(55,PSODFN,"LAN")),"^")
Begin DoDot:1
+9 SET IEN=IEN+1
SET ^TMP("PSOPO",$JOB,IEN,0)=" Other Indications: "_$SELECT($GET(PSONEW("INDO"))]"":PSONEW("INDO"),1:"")
End DoDot:1
+10 QUIT
+11 ;
DOSE1 IF $GET(DS)=1
Begin DoDot:1
+1 SET ^TMP("PSOPO",$JOB,IEN,0)=^TMP("PSOPO",$JOB,IEN,0)_" Dosage Ordered: "_$SELECT(...
... $EXTRACT(PSONEW("DOSE",I),1)="."&($GET(PSONEW("DOSE ORDERED",I))):"0",1:"")_PSONEW("DOSE",I)_$SELECT($GET(PSONEW("UNITS",I))'="":" ("_$PIECE(^PS(50.607,PSONEW("UNITS",I),0),"^")_")",1:"")
End DoDot:1
KILL DS
GOTO DU
+2 SET IEN=IEN+1
SET ^TMP("PSOPO",$JOB,IEN,0)=" Dosage Ordered: "_$SELECT($EXTRACT(PSONEW("DOSE",I),1)="."&($GET(PSONEW("DOSE ORDERED",I))):"0",1:"")_PSONEW("DOSE",I)_$SELECT($GET(PSONEW("UNITS",I))'="":" ("_$PIECE(^PS(50.607,PSONEW("UNITS",I),0),"^")_")",
1:"")
DU IF '$GET(PSONEW("DOSE ORDERED",I))
IF $PIECE($GET(^PS(55,PSODFN,"LAN")),"^")
SET IEN=IEN+1
SET ^TMP("PSOPO",$JOB,IEN,0)=" Oth. Lang. Dosage: "_$GET(PSONEW("ODOSE",I))
+1 IF $GET(PSONEW("DOSE ORDERED",I))
IF $GET(PSONEW("VERB",I))]""
SET IEN=IEN+1
SET ^TMP("PSOPO",$JOB,IEN,0)=" Verb: "_$GET(PSONEW("VERB",I))
+2 if $GET(PSONEW("DOSE ORDERED",I))
SET IEN=IEN+1
SET ^TMP("PSOPO",$JOB,IEN,0)=" Dispense Units: "_$SELECT($EXTRACT($GET(PSONEW("DOSE ORDERED",I)),1)=".":"0",1:"")_$GET(PSONEW("DOSE ORDERED",I))
+3 IF $GET(PSONEW("DOSE ORDERED",I))
IF $GET(PSONEW("NOUN",I))]""
SET IEN=IEN+1
SET ^TMP("PSOPO",$JOB,IEN,0)=" Noun: "_PSONEW("NOUN",I)
+4 IF $GET(PSONEW("ROUTE",I))
SET IEN=IEN+1
SET ^TMP("PSOPO",$JOB,IEN,0)=" Route: "_$PIECE(^PS(51.2,PSONEW("ROUTE",I),0),"^")
+5 SET IEN=IEN+1
SET ^TMP("PSOPO",$JOB,IEN,0)=" Schedule: "_$GET(PSONEW("SCHEDULE",I))
+6 IF $GET(PSONEW("DURATION",I))]""
Begin DoDot:1
+7 SET IEN=IEN+1
+8 SET ^TMP("PSOPO",$JOB,IEN,0)=" *Duration: "_PSONEW("DURATION",I)_" ("_$SELECT(PSONEW("DURATION",I)["M":"MINUTES",PSONEW("DURATION",I)["W":"WEEKS",PSONEW("DURATION",I)["L":"MONTHS",PSONEW("DURATION",I)["H":"HOURS",1:"DAYS")_")"
End DoDot:1
+9 IF $GET(PSONEW("CONJUNCTION",I))]""
SET IEN=IEN+1
SET ^TMP("PSOPO",$JOB,IEN,0)=" Conjunction: "_$SELECT($GET(PSONEW("CONJUNCTION",I))="A":"AND",$GET(PSONEW("CONJUNCTION",I))="T":"THEN",$GET(PSONEW("CONJUNCTION",I))="X":"EXCEPT",1:"")
+10 QUIT
RTE ;*525
+1 IF $GET(DRET)
SET PSORXED("ROUTE",ENT)=""
+2 IF $GET(RTE)
KILL RTE
+3 DO KV
NEW MRSLS,MRX,MRDFV,MRQ
SET MRQ=0
SET MRDFV=$SELECT($GET(PSORXED("ROUTE",ENT)):$PIECE(^PS(51.2,PSORXED("ROUTE",ENT),0),"^"),$GET(RTE)]"":RTE,1:"")
+4 SET X=""
+5 WRITE !,"ROUTE: "_MRDFV_"//"
+6 Begin DoDot:1
+7 READ MRX:DTIME
+8 IF '$TEST
SET DTOUT=1
+9 IF MRX="^"
SET DUOUT=1
+10 IF MRX="?"
DO MRSL^PSOORED5
+11 IF MRX=""
IF $GET(MRDFV)]""
SET MRX=$GET(MRDFV)
End DoDot:1
if $GET(MRSLS)
GOTO RTEC
if MRQ
GOTO RTE
+12 SET X=MRX
+13 KILL MRSLS,MRX,MRDFV,MRQ
+14 IF X[U
IF $LENGTH(X)>1
SET FIELD="RTE"
SET JUMP=1
KILL DIRUT,DTOUT
QUIT
+15 if $DATA(DTOUT)!($DATA(DUOUT))
QUIT
+16 IF X="@"!(X="")
KILL RTE,ERTE
SET DRET=1
SET PSORXED("ROUTE",ENT)=""
QUIT
+17 DO CKMRSL^PSOORED5
+18 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
RTEC ;
+1 KILL DIC
SET DIC=51.2
SET DIC(0)="QEZMX"
SET DIC("S")="I $P(^(0),""^"",4)"
DO ^DIC
if X[U
QUIT
if Y=-1
GOTO RTE
WRITE " "_$PIECE(Y(0),"^",2)
+2 if X'=""
SET PSORXED("ROUTE",ENT)=+Y
SET RTE=Y(0,0)
SET ERTE=$PIECE(Y(0),"^",2)
+3 QUIT
ASK ;
+1 KILL JUMP,UNITN,DOSE
DO KV
DO DOSE^PSSORPH(.DOSE,PSODRUG("IEN"),"O",PSODFN)
+2 ;402
NEW PSODOSCT,PSODOSFL,PSODOSWT
DO FULL^VALM1
+3 IF $DATA(DOSE("DD"))
DO LST2^PSOBKDE1
GOTO ASK1
+4 if $GET(PSOFROM)="NEW"&($GET(PSORX("EDIT"))']"")!($GET(PSOFROM1))!($GET(COPY))
if $ORDER(DOSE(0))
DO LST^PSOBKDE1
ASK1 SET STRE=$PIECE($GET(DOSE("DD",PSODRUG("IEN"))),"^",5)
SET UNITN=$PIECE($GET(DOSE("DD",PSODRUG("IEN"))),"^",6)
SET DOSE("LD")=$PIECE($GET(DOSE("DD",PSODRUG("IEN"))),"^",11)
+1 WRITE !
SET DIR(0)="F^1:60"
+2 IF '$GET(PSODOSCT)
Begin DoDot:1
+3 FOR I=0:0
SET I=$ORDER(DOSE(I))
if 'I!('$DATA(DOSE(I)))
QUIT
SET PSODOSCT=I
+4 IF PSODOSCT=1
IF $PIECE(DOSE(1),"^")=""&($PIECE(DOSE("DD",PSODRUG("IEN")),"^",6)="")
SET PSODOSFL=1
End DoDot:1
+5 SET PSODOSWT=""
SET PSODOSWT=$SELECT($GET(PSODOSCT)<1:"",$GET(PSODOSCT)=1&($GET(PSODOSFL)):"",1:" (1-"_$GET(PSODOSCT)_")")
+6 ; next 2 lines 402
+7 IF PSODOSCT=1
IF ($PIECE($GET(DOSE(1)),"^")=""&($PIECE($GET(DOSE(1)),"^",3)=""))
SET PSODOSFL=1
+8 if $GET(PSODOSFL)
SET DIR("A")=" Please Enter a Free Text Dose"
+9 if '$GET(PSODOSFL)
SET DIR("A",1)="Select from list of Available Dosages"_PSODOSWT_", Enter Free Text Dose"
SET DIR("?")="^D LST1^PSOBKDE1"
SET DIR("A")="or Enter a Question Mark (?) to view list"
+10 ; PSO*7.0*574 - Defect 1180952 Adding Complex default dose
+11 IF $GET(PSORXED("DOSE",ENT))]""
SET DIR("B")=PSORXED("DOSE",ENT)
Begin DoDot:1
+12 IF $GET(PSORXED("UNITS",ENT))]""
IF DIR("B")'[($PIECE($GET(^PS(50.607,PSORXED("UNITS",ENT),0)),"^"))
SET DIR("B")=DIR("B")_$PIECE($GET(^PS(50.607,PSORXED("UNITS",ENT),0)),"^")
if $GET(PSOREEDQ)!($GET(PSOBDRG))
KILL DIR("B")
End DoDot:1
+13 DO ^DIR
+14 IF X[U
IF $LENGTH(X)>1
SET FIELD="ASK"
SET JUMP=1
KILL DIRUT,DTOUT
QUIT
+15 IF $DATA(DIRUT)
if $GET(ORD)
SET PSODSPL=1
QUIT
+16 IF X=$GET(PSORXED("DOSE",ENT))
IF $DATA(DOSE(Y))
SET PSORXED("DOSE EDIT")=DOSE(Y)
GOTO GD1
+17 IF X=$GET(PSORXED("DOSE",ENT))
Begin DoDot:1
+18 SET DOSE=X
SET UNITS=$GET(PSORXED("UNITS",ENT))
SET PSORXED("DOSE EDIT")=X
+19 ;557
IF $PIECE(DOSE("DD",PSODRUG("IEN")),"^",5)
SET DUPD=DOSE/$PIECE(DOSE("DD",PSODRUG("IEN")),"^",5)
SET PSORXED("DOSE ORDERED",ENT)=DUPD
+20 IF DOSE'?.N&(DOSE'?.N1".".N)!'DOSE("LD")
SET (UNITN,UNITS,PSORXED("UNITS",ENT))=""
KILL PSORXED("DOSE ORDERED",ENT),DUPD,PSORXED("NOUN",ENT)
End DoDot:1
GOTO DOS
GD1 NEW PSORXTE
+1 ;from list
IF $DATA(DOSE(Y))
Begin DoDot:1
+2 SET DOSE=$SELECT($PIECE(DOSE(Y),"^"):$PIECE(DOSE(Y),"^"),$PIECE(DOSE(Y),"^",3)]"":$PIECE(DOSE(Y),"^",3),1:1)
SET DOLST=Y
SET PSORXED("NEW DOSE")=DOSE
+3 IF $PIECE(DOSE(Y),"^")
SET UNITS=$PIECE(DOSE(Y),"^",2)
SET DUPD=$PIECE(DOSE(Y),"^",3)
SET UNITN=$PIECE(DOSE("DD",PSODRUG("IEN")),"^",6)
SET PSORXTE("DOSE ORDERED",ENT)=DUPD
+4 SET PSORXTE("NOUN",ENT)=$PIECE(DOSE(Y),"^",6)
SET PSORXTE("VERB",ENT)=$PIECE(DOSE(Y),"^",8)
+5 IF DOSE'?.N&(DOSE'?.N1".".N)!'DOSE("LD")
Begin DoDot:2
+6 SET (UNITN,UNITS,PSORXED("UNITS",ENT))=""
KILL PSORXED("DOSE ORDERED",ENT),DUPD,PSORXED("NOUN",ENT)
+7 IF $PIECE($GET(^PS(55,PSODFN,"LAN")),"^")
IF $GET(PSOFROM)="PENDING"
DO LAN^PSOORED5
QUIT
+8 IF $PIECE($GET(^PS(55,PSODFN,"LAN")),"^")
IF $GET(PSOFROM)="NEW"
DO LAN^PSOORED5
End DoDot:2
QUIT
+9 SET PSORXTE("UNITS",ENT)=$GET(UNITS)
End DoDot:1
GOTO DOS
+10 ;non-numeric and numeric not in list
SET DOSE=Y
SET DOLST=0
SET PSORXED("DOSE EDIT")=DOSE
+11 IF DOSE("LD")
Begin DoDot:1
+12 FOR I=1:1:$LENGTH(DOSE)
IF $EXTRACT(DOSE,I)'?.N&($EXTRACT(DOSE,I)'?1" ")&($EXTRACT(DOSE,I)'?1".")
SET DCHK=$GET(DCHK)_$EXTRACT(DOSE,I)
+13 IF $GET(DCHK)]""
Begin DoDot:2
+14 SET DCHK=$TRANSLATE(DCHK,"qwertyuioplkjhgfdsazxcvbnm","QWERTYUIOPLKJHGFDSAZXCVBNM")
+15 IF DCHK=UNITN
SET DOSE=+DOSE
SET PSORXED("DOSE EDIT")=DOSE
End DoDot:2
End DoDot:1
+16 KILL I,DCHK
+17 SET PSOINDT=$$GET1^DIQ(50,PSODRUG("IEN"),100,"I")
IF PSOINDT
IF DT>PSOINDT
GOTO DOS
+18 SET PSORXTE("NOUN",ENT)=$PIECE(DOSE("DD",PSODRUG("IEN")),"^",9)
SET PSORXTE("VERB",ENT)=$PIECE(DOSE("DD",PSODRUG("IEN")),"^",10)
+19 IF DOSE'?.N&(DOSE'?.N1".".N)!'DOSE("LD")
SET (UNITN,UNITS,PSORXED("UNITS",ENT))=""
KILL PSORXED("NOUN",ENT),PSORXED("ODOSE",ENT)
GOTO DOS
+20 if $PIECE(DOSE("DD",PSODRUG("IEN")),"^",6)]""
SET (PSORXTE("UNITS",ENT),UNITS)=$ORDER(^PS(50.607,"B",$PIECE(DOSE("DD",PSODRUG("IEN")),"^",6),0))
SET UNITN=$PIECE(DOSE("DD",PSODRUG("IEN")),"^",6)
+21 if $PIECE(DOSE("DD",PSODRUG("IEN")),"^",5)
SET DUPD=DOSE/$PIECE(DOSE("DD",PSODRUG("IEN")),"^",5)
SET PSORXTE("DOSE ORDERED",ENT)=DUPD
DOS WRITE " "_$SELECT($EXTRACT(DOSE,1)="."&($GET(UNITN)'=""):"0",1:"")_DOSE
if $GET(UNITN)'=""
WRITE UNITN
+1 WRITE !
KILL DIR,DIRUT
SET DIR(0)="Y"
SET DIR("A")="You entered "_$SELECT($EXTRACT(DOSE,1)="."&($GET(UNITN)'=""):"0",1:"")_DOSE_$SELECT($GET(UNITN)'="":UNITN,1:"")_" is this correct"
SET DIR("B")="Yes"
+2 DO ^DIR
IF 'Y
DO KX
KILL DOSE,UNITS,PSORXTE,PSOINDT
GOTO ASK
+3 SET PSORXED("DOSE",ENT)=DOSE
+4 if $GET(PSORXTE("DOSE ORDERED",ENT))]""
SET PSORXED("DOSE ORDERED",ENT)=PSORXTE("DOSE ORDERED",ENT)
+5 if $GET(PSORXTE("NOUN",ENT))]""
SET PSORXED("NOUN",ENT)=PSORXTE("NOUN",ENT)
+6 ;PSO*7.0*450
IF $GET(PSORX("EDIT"))']""
Begin DoDot:1
+7 if $GET(PSORXTE("VERB",ENT))]""
SET PSORXED("VERB",ENT)=PSORXTE("VERB",ENT)
End DoDot:1
+8 if $GET(PSORXTE("UNITS",ENT))]""
SET PSORXED("UNITS",ENT)=PSORXTE("UNITS",ENT)
+9 IF $GET(PSORXED("DOSE",ENT))'?.N&($GET(PSORXED("DOSE",ENT))'?.N1".".N)!'DOSE("LD")
IF $PIECE($GET(^PS(55,PSODFN,"LAN")),"^")
Begin DoDot:1
+10 KILL OTHDOS(ENT)
DO KX
SET DIR(0)="52.0113,9"
+11 IF '$GET(OTHDOS(ENT))
IF $GET(PSORXED("ODOSE",ENT))']""
DO LAN^PSOORED5
+12 IF $GET(PSORXED("ODOSE",ENT))]""
SET DIR("B")=PSORXED("ODOSE",ENT)
if DIR("B")=""
KILL DIR("B")
+13 KILL DTOUT,DUOUT,DIRUT,Y,X
DO ^DIR
KILL DIR
if $GET(X)="@"!($GET(X)="")
KILL DIRUT
IF $DATA(DIRUT)
QUIT
+14 IF X="@"
SET OTHDOS(ENT)=1
DO KX
KILL PSORXED("ODOSE",ENT)
QUIT
+15 if X'=""
SET PSORXED("ODOSE",ENT)=X
End DoDot:1
+16 QUIT
+17 ;
SCH DO KX
+1 ;*282 Allow multi-word schedules
+2 SET DIR("?")="^D SCHLP^PSOORED4"
SET DIR("A")="Schedule: "
SET DIR(0)="FA^1:20^I X[""""""""!(X?.E1C.E)!($A(X)=45)!($L(X,"" "")>$S(X[""PRN"":4,1:3))!($L(X)>20)!($L(X)<1) K X"
+3 IF '$DATA(PSOSCH)
IF '$DATA(PSORXED("SCHEDULE",ENT))
IF $PIECE(^PS(50.7,PSODRUG("OI"),0),"^",8)]""
SET PSOSCH=$PIECE(^PS(50.7,PSODRUG("OI"),0),"^",8)
+4 SET DIR("B")=$SELECT($DATA(PSOSCH)&('$DATA(PSORXED("SCHEDULE",ENT))):PSOSCH,$GET(PSORXED("SCHEDULE",ENT))]"":PSORXED("SCHEDULE",ENT),1:"")
if DIR("B")=""
KILL DIR("B")
+5 IF $GET(PSORXED("SCHEDULE",ENT))']""
IF $GET(PSOREEDT)
KILL DIR("B")
+6 DO ^DIR
+7 QUIT
KX KILL X,Y
KV KILL DTOUT,DUOUT,DIR,DIRUT
+1 QUIT
