ORCDPS2 ;SLC/MKB-Pharmacy dialog utilities ;25-Mar-2013 09:41;DU
;;3.0;ORDER ENTRY/RESULTS REPORTING;**94,116,125,131,243,1010,1011**;Dec 17, 1997;Build 2
;
; Modified - IHS/MSC/PLS - 02/15/2012 - Line RTE+5
; Modified - IHS/MSC/MGH - 02/25/2013 - Line CHDOSE+3
; Modified - IHS/MSC/MGH - 08/30/2012 - Patch 1011 to modified pt instructions
COMPLEX() ; -- Single or complex?
N X,Y,DIR,DUOUT,DTOUT,COMPLX
S COMPLX=$S($O(ORDIALOG(PROMPT,"?"),-1)>1:1,$L($G(ORDIALOG($$PTR("DURATION"),1))):1,1:0)
I $G(ORTYPE)="Q",$O(ORDIALOG(PROMPT,0)),FIRST Q COMPLX
I $D(ORENEW)!$D(OREWRITE)!$D(ORXFER)!COMPLX Q COMPLX
I $D(OREDIT) Q:$D(ORCOMPLX)!COMPLX COMPLX G CP1 ;Q if complex or 'first, else ask
I 'FIRST S Y=$S($D(ORCOMPLX):ORCOMPLX,1:COMPLX) Q Y
CP1 S DIR(0)="YA",DIR("A")="Complex dose? ",DIR("B")="NO"
S DIR("?")="Enter YES if you wish to enter multiple sets of dosage instructions, a tapering dose, or to limit the duration of a single dose."
D ^DIR S:$D(DTOUT) Y="^"
Q Y
;
DOSES ; -- Available common doses
;S $P(ORDIALOG(PROMPT,0),U,2)=$S(ORCAT="I":"1:20",1:"1:80")
S ORDIALOG(PROMPT,"A")="Dose"_$S(ORCAT="I"&$G(ORIV):" or Rate: ",1:": ")
S $P(ORDIALOG(PROMPT,"?"),",",2)=$S($G(ORIV):" as either a dose amount or infusion rate.",1:" as a dose or amount.")
I FIRST,'$O(ORDIALOG(PROMPT,0)),$G(ORXFER) D SHOWSIG^ORCMED
S ORCOMPLX=$$COMPLEX,MULT=+ORCOMPLX I ORCOMPLX="^" S ORQUIT=1 Q
Q:$G(ORDIALOG(PROMPT,"LIST")) Q:'$D(ORDOSE)
D1 ; -- Entry from ORCMED,NF^ORCDPS to build list
N I,J,X,DD,DRUG,DOSE,CONJ,CNT,UD,COST,TEXT
S (I,CNT)=0,CONJ=$P($G(ORDOSE("MISC")),U,3) S:$L(CONJ) CONJ=" "_CONJ
F S I=$O(ORDOSE(I)) Q:I'>0 D
. S X=ORDOSE(I),DD=+$P(X,U,6),DRUG=ORDOSE("DD",DD)
. ; =TotalDose^Units^U/D^Noun^LocalDose^DispDrugIEN^Cost
. ;DD=Name^Cost^NF^DispUnit^Strength^Units^DoseForm^MaxRefills?
. S DOSE=$P(X,U,5),UD=$P(X,U,3),COST=$P(X,U,7) Q:'$L(DOSE)
. I '$P(X,U) S DOSE=DOSE_CONJ_" "_$S($L($P(DRUG,U,5)):$P(DRUG,U,5)_$P(DRUG,U,6),1:$P(DRUG,U))
. ;I UD S COST="$"_$J(UD*$P(DRUG,U,2),1,3) ;_" per "_UD_" "_$P(X,U,4)
. S TEXT=DOSE_$S($L(COST):" $"_COST,1:"")_$S($P(DRUG,U,3):" (non-formulary)",1:"")
. S CNT=CNT+1,ORDIALOG(PROMPT,"LIST",CNT)=DOSE_U_TEXT
. S ORDIALOG(PROMPT,"LIST","B",TEXT)=DOSE
. S ORDIALOG(PROMPT,"LIST","D",DOSE)=DD ;default DispDrug
. S ORDOSE("DD",DD,DOSE)=$P(ORDOSE(I),U,1,6)_U_$P(DRUG,U,5,6)
. S J=0 F S J=$O(ORDOSE(I,J)) Q:J'>0 D ;xref alt forms of dose
.. S DD=+$P(ORDOSE(I,J),U,6),DRUG=$G(ORDOSE("DD",DD))
.. S ORDOSE("DD",DD,DOSE)=$P(ORDOSE(I,J),U,1,6)_U_$P(DRUG,U,5,6)
S:CNT ORDIALOG(PROMPT,"LIST")=CNT
Q
;
CHDOSE ; -- Kill dependent values if inst ORI of dose changes
N X,PROMPTS,P,NAME,DOSE,DD S X=$G(ORDIALOG(PROMPT,ORI))
;IHS/MSC/MGH Removed forcing to uppercase for dispense drug
;S X=$$UP^XLFSTR(X),ORDIALOG(PROMPT,ORI)=X ;force uppercase
S ORDIALOG(PROMPT,ORI)=X
I X,X'?1.N.E1.A.E K DONE W $C(7),!,"Enter the amount of this drug that the patient is to receive as a dose,",!,"NOT as the number of units per dose." Q
I $L(X)>60,'$D(ORDIALOG(PROMPT,"LIST","B",X)) K DONE W $C(7),!,"Instructions may not be longer than 60 characters." Q
I $G(ORESET)'=X D ;kill dependent values if new/changed dose
. S PROMPTS="STRENGTH^DRUG NAME^DOSE^DISPENSE DRUG^DAYS SUPPLY^QUANTITY^REFILLS"
. F P=1:1:$L(PROMPTS,U) S NAME=$P(PROMPTS,U,P) K ORDIALOG($$PTR(NAME),ORI)
. K ORQTY,ORQTYUNT,ORDRUG,ORDIALOG($$PTR("DISPENSE DRUG"),1)
. K ^TMP("ORWORD",$J,$$PTR("SIG"))
S DOSE=$$PTR("DOSE") I $L(X),'$L($G(ORDIALOG(DOSE,ORI))) D ;set ID
. S DD=+$G(ORDIALOG(PROMPT,"LIST","D",X))
. S:DD ORDIALOG(DOSE,ORI)=$TR($G(ORDOSE("DD",DD,X)),"^","&")
S DD=+$P($G(ORDIALOG(DOSE,ORI)),"&",6)
I DD,$P($G(ORDOSE("DD",DD)),U,3) D NF^ORCDPS(DD) ;look for FormAlt
Q
;
EXDOSE ; -- Exit Action
Q:'$O(ORDIALOG(PROMPT,0)) N DRUG,MISC,QUIT,LAST
S ORDRUG=$$DISPDRUG^ORCDPS,DRUG=$G(ORDOSE("DD",+ORDRUG))
I ORDRUG D I $G(QUIT) S ORQUIT=1 Q
. ;I $P(DRUG,U,10),'$L($P($G(^VA(200,+$G(ORNP),"PS")),U,2)),'$L($P($G(^("PS")),U,3)) W $C(7),!,$P($G(^(0)),U)_" must have a DEA# or VA# to order this drug!" S QUIT=1 Q
. ;I $P(DRUG,U,10)=1 W $C(7),!,"This order will require a wet signature!"
. S ORDIALOG($$PTR("DISPENSE DRUG"),1)=ORDRUG
. D:$G(ORCAT)="O" RESETID^ORCDPS
. N STR,MED S STR=$P(DRUG,U,5)_$P(DRUG,U,6)
. I STR'>0 S:'$G(ORDOSE(1)) ORDIALOG($$PTR("DRUG NAME"),1)=$P(DRUG,U) Q
. S MED=$P($G(^ORD(101.43,+$G(OROI),0)),U)
. I MED'[STR,ORCAT="O"!'$G(ORDOSE(1)) S ORDIALOG($$PTR("STRENGTH"),1)=STR
I +ORDRUG'>0,ORCAT="O" W $C(7),!,"Cannot determine dispense drug - some defaults and order checks may not occur!"
EXD1 ; -- Kill dangling conjunction, [re]build Sig, get Qty info
S LAST=$O(ORDIALOG(PROMPT,"?"),-1) K ORDIALOG($$PTR("AND/THEN"),LAST)
D ADMIN^ORCDPS3 D:$G(ORTYPE)'="Z" SIG ;[re]build Sig/Text
I ORDRUG,ORCAT="O" D ;set Qty info
. S:$L($P(DRUG,U,4)) ORQTYUNT=$P(DRUG,U,4)
. S MISC=$$ENDCM^PSJORUTL(+ORDRUG),ORQTY=$P(MISC,U,4)
. W:$L($P(MISC,U,2)) !!,$P(MISC,U,2),!
Q
;
SIG ; -- Create ORDIALOG(SIG) from Instructions PROMPT,ORDOSE,ORDRUG,ORCAT
; Return text in ^TMP("ORWORD",$J,SIG,INST)
; [also called from PSJ^ORCSEND1 to build child orders]
;
N ORT,ORSCH,ORDUR,ORID,ORDD,ORCNJ,ORMISC,ORPREP,ORX,ORI,CNT,ORSIG,ORS,DOSE
S ORT=$$PTR("ROUTE"),ORSCH=$$PTR("SCHEDULE"),ORDUR=$$PTR("DURATION")
S ORID=$$PTR("DOSE"),ORCNJ=$$PTR("AND/THEN"),ORS=$$PTR("SIG")
S ORMISC=$G(ORDOSE("MISC")),ORPREP=$P(ORMISC,U,2)
S ORX=$S(ORCAT="I":"",ORCAT="O"&(+$G(ISIMO)=1):"",$L($P(ORMISC,U)):$P(ORMISC,U)_" ",1:"") ;"TAKE "
S (CNT,ORI)=0 F S ORI=$O(ORDIALOG(PROMPT,ORI)) Q:ORI'>0 D
. S DOSE=$G(ORDIALOG(PROMPT,ORI)) Q:'$L(DOSE)
. S ORX=ORX_$$DOSE_$$RTE_$$SCH_$$DUR_$$CONJ
. S CNT=CNT+1,ORSIG(CNT,0)=ORX,ORX=""
Q:CNT'>0 S ORSIG(0)="^^"_CNT_U_CNT_U_DT_U
K ^TMP("ORWORD",$J,ORS,1) M ^(1)=ORSIG S ORDIALOG(PROMPT,"FORMAT")="@"
S ORDIALOG(ORS,1)=$NA(^TMP("ORWORD",$J,ORS,1))
Q
;
PTR(X) ; -- Ptr to prompt OR GTX X
Q +$O(^ORD(101.41,"AB","OR GTX "_X,0))
;
DOSE() ; -- Dosage
N X0,Y S X0=$G(ORDIALOG(ORID,ORI)) ;ID string
S Y=DOSE I ORDRUG,$L(X0) D ;use local dose if common DispDrug
. S:$L($P(X0,"&",5)) Y=$P(X0,"&",5) ;unless Outpt w/total dose
. I ORCAT="O",X0 S Y=$$WORD($P(X0,"&",3))_" "_$P(X0,"&",4) ;u/d
Q Y
;
WORD(X) ; -- Words for number X
N X1,X2,Y S X1=$P(+X,"."),X2=$P(+X,".",2)
S Y="" I X1 S Y=$S(X1=1:"ONE",X1=2:"TWO",X1=3:"THREE",X1=4:"FOUR",X1=5:"FIVE",X1=6:"SIX",X1=7:"SEVEN",X1=8:"EIGHT",X1=9:"NINE",X1=10:"TEN",1:X1)
I X2 S Y=Y_$S($L(Y):" AND ",1:"")_$S(X2=5:"ONE-HALF",X2=33!(X2=34):"ONE-THIRD",X2=25:"ONE-FOURTH",X2=66!(X2=67):"TWO-THIRDS",X2=75:"THREE-FOURTHS",1:"."_X2)
Q Y
;
RTE() ; -- Expansion of route
N X,X0,Y S X=+$G(ORDIALOG(ORT,ORI)) Q:X'>0 ""
K ^TMP($J,"ORCDPS2 RTE")
D ALL^PSS51P2(+X,,,,"ORCDPS2 RTE")
;S X0=$G(^PS(51.2,+X,0))
S Y="" ;IHS/MSC/PLS - 02/15/2012
I ORCAT="I"!(+$G(ISIMO)=1) S Y=" "_$S($L(^TMP($J,"ORCDPS2 RTE",+X,1)):^TMP($J,"ORCDPS2 RTE",+X,1),1:^TMP($J,"ORCDPS2 RTE",+X,.01))
;I ORCAT="I" S Y=" "_$S($L($P(X0,U,3)):$P(X0,U,3),1:$P(X0,U))
I ORCAT="O",'+$G(ISIMO) S Y=" "_$S($L(ORPREP):ORPREP_" ",1:"")_$S($L(^TMP($J,"ORCDPS2 RTE",+X,4)):^TMP($J,"ORCDPS2 RTE",+X,4),1:^TMP($J,"ORCDPS2 RTE",+X,.01))
Q Y
;
SCH() ; -- [outpatient] expansion of schedule
N X,Y S X=$G(ORDIALOG(ORSCH,ORI))
I $L(X),ORCAT="O",'+$G(ISIMO) D SCH^PSSUTIL1(.X)
S Y=$S($L(X):" "_X,1:"")
Q Y
;
DUR() ; -- Duration
N X,Y S X=$G(ORDIALOG(ORDUR,ORI)),Y=""
I X S Y=" FOR "_$$UP^XLFSTR(X)_$S(+X=X:" DAYS",1:"")
Q Y
;
CONJ() ; -- Conjunction
N X,Y S X=$G(ORDIALOG(ORCNJ,ORI))
S:$L(X)>1 X=$E(X) S:X="E" S="X"
S Y=$S(X="T":", THEN",X="X":" EXCEPT",X="A":" AND",1:"")
Q Y
;
DOSETEXT ; -- Reset dose text in ORDIALOG(INSTR) for backdoor orders
; [Called from ORMPS1 - uses ORCAT,PSOI,ORVP,DRUG,INSTR,DOSE]
;
N ORTYPE,ORDOSE,CONJ,ORDRUG,DRUG0,STRG,ORI,LDOSE,X,PROMPT
S ORTYPE=$S($G(ORCAT)="I":"U",1:"O")
D DOSE^PSSORUTL(.ORDOSE,+PSOI,ORTYPE,+ORVP)
S CONJ=$P($G(ORDOSE("MISC")),U,3) S:$L(CONJ) CONJ=" "_CONJ
S ORDRUG=+$G(ORDIALOG(DRUG,1)),DRUG0=$G(ORDOSE("DD",ORDRUG))
S STRG=$P(DRUG0,U,5)_$P(DRUG0,U,6)
I '$G(ORDOSE(1)) S ORI=0 F S ORI=$O(ORDIALOG(INSTR,ORI)) Q:ORI'>0 D
. S LDOSE=$G(ORDIALOG(INSTR,ORI)),X=$G(ORDIALOG(DOSE,ORI)) Q:'$L(X)
. S:'X ORDIALOG(INSTR,ORI)=LDOSE_CONJ_" "_$S(STRG:STRG,1:$P(DRUG0,U))
; -build Sig/Text if not defined
I '$D(ORDIALOG(+$$PTR("SIG"),1)) S PROMPT=INSTR D SIG
Q
;
;IHS/MSC/MGH Broke this into 2 sections to get and put the patient instructions
PI ; -- Include Pt Instructions w/Sig in Outpt order?
N X,Y,DIR,DUOUT,DTOUT,DIRUT,ORTX,ORMAX,I,CNT
I $G(ORCAT)'="O" D CLEARWP Q ;!'$O(ORDOSE("PI",0))
Q:$G(ORENEW) S I=0,ORMAX=57
I $G(OREDIT)!$G(OREWRITE),$O(^TMP("ORWORD",$J,PROMPT,INST,0)) K ORDOSE("PI")
S I=0 F S I=$O(^TMP("ORWORD",$J,PROMPT,INST,I)) Q:I<1 S ORDOSE("PI",I)=$G(^(I,0))
;IHS/MSC/MGH Commented out patch 1011
;I '$O(ORDOSE("PI",0)) D CLEARWP Q
F S I=$O(ORDOSE("PI",I)) Q:I'>0 S X=ORDOSE("PI",I) D TXT^ORCHTAB
;IHS/MSC/MGH Lines here moved to PIOUT
;S DIR(0)="YA",DIR("A")="Save and include Patient Instructions in Sig? "
;S DIR("?")="Enter NO if you do not want these instructions included in the sig for this order",DIR("B")=$S($D(^TMP("ORWORD",$J,PROMPT)):"YES",1:"NO")
;W ! S I=0 F S I=$O(ORTX(I)) Q:I'>0 W !,$S(I=1:"Patient Instructions: ",1:" ")_ORTX(I)
;D ^DIR I $D(DUOUT)!$D(DTOUT) S ORQUIT=1 Q
;IHS/MSC/MGH Removed most of this since it was already there
;I Y D Q ;save text
;. K ^TMP("ORWORD",$J,PROMPT,INST) S CNT=0
;. S I=0 F S I=$O(ORTX(I)) Q:I'>0 S ^TMP("ORWORD",$J,PROMPT,INST,1,0)=ORTX(I),CNT=CNT+1
;. S ^TMP("ORWORD",$J,PROMPT,INST,0)="^^"_CNT_U_CNT_U_DT_U
;.S ORDIALOG(PROMPT,INST)="^TMP(""ORWORD"","_$J_","_PROMPT_","_INST_")"
S CNT=0
S I=0 F S I=$O(ORTX(I)) Q:'I D
.S ^TMP("ORWORD",$J,PROMPT,INST,I,0)=ORTX(I)
.S CNT=CNT+1
S ^TMP("ORWORD",$J,PROMPT,INST,0)="^^"_CNT_U_CNT_U_DT_U
I CNT>0 S ORDIALOG(PROMPT,INST)="^TMP(""ORWORD"","_$J_","_PROMPT_","_INST_")"
Q
;IHS/MSC/MGH Broke into 2 sections to edit pt instructions
PIOUT ; -- Store Pt instructions exit action
N TXT,DIR,Y,CNT
S DIR(0)="YA",DIR("A")="Save and include Patient Instructions in Sig? "
S DIR("?")="Enter NO if you do not want these instructions included in the sig for this order",DIR("B")=$S($D(^TMP("ORWORD",$J,PROMPT)):"YES",1:"NO")
D ^DIR I $D(DUOUT)!$D(DTOUT) S ORQUIT=1 Q
I Y'>0 K ORDIALOG(PROMPT,INST),^TMP("ORWORD",$J,PROMPT,INST)
E S ORDIALOG(PROMPT,INST)="^TMP(""ORWORD"","_$J_","_PROMPT_","_INST_")"
Q
;
CLEARWP ; -- Clear INST of wp field PROMPT
K ORDIALOG(PROMPT,INST),^TMP("ORWORD",$J,PROMPT,INST)
Q
ORCDPS2 ;SLC/MKB-Pharmacy dialog utilities ;25-Mar-2013 09:41;DU
+1 ;;3.0;ORDER ENTRY/RESULTS REPORTING;**94,116,125,131,243,1010,1011**;Dec 17, 1997;Build 2
+2 ;
+3 ; Modified - IHS/MSC/PLS - 02/15/2012 - Line RTE+5
+4 ; Modified - IHS/MSC/MGH - 02/25/2013 - Line CHDOSE+3
+5 ; Modified - IHS/MSC/MGH - 08/30/2012 - Patch 1011 to modified pt instructions
COMPLEX() ; -- Single or complex?
+1 NEW X,Y,DIR,DUOUT,DTOUT,COMPLX
+2 SET COMPLX=$SELECT($ORDER(ORDIALOG(PROMPT,"?"),-1)>1:1,$LENGTH($GET(ORDIALOG($$PTR("DURATION"),1))):1,1:0)
+3 IF $GET(ORTYPE)="Q"
IF $ORDER(ORDIALOG(PROMPT,0))
IF FIRST
QUIT COMPLX
+4 IF $DATA(ORENEW)!$DATA(OREWRITE)!$DATA(ORXFER)!COMPLX
QUIT COMPLX
+5 ;Q if complex or 'first, else ask
IF $DATA(OREDIT)
IF $DATA(ORCOMPLX)!COMPLX
QUIT COMPLX
GOTO CP1
+6 IF 'FIRST
SET Y=$SELECT($DATA(ORCOMPLX):ORCOMPLX,1:COMPLX)
QUIT Y
CP1 SET DIR(0)="YA"
SET DIR("A")="Complex dose? "
SET DIR("B")="NO"
+1 SET DIR("?")="Enter YES if you wish to enter multiple sets of dosage instructions, a tapering dose, or to limit the duration of a single dose."
+2 DO ^DIR
IF $DATA(DTOUT)
SET Y="^"
+3 QUIT Y
+4 ;
DOSES ; -- Available common doses
+1 ;S $P(ORDIALOG(PROMPT,0),U,2)=$S(ORCAT="I":"1:20",1:"1:80")
+2 SET ORDIALOG(PROMPT,"A")="Dose"_$SELECT(ORCAT="I"&$GET(ORIV):" or Rate: ",1:": ")
+3 SET $PIECE(ORDIALOG(PROMPT,"?"),",",2)=$SELECT($GET(ORIV):" as either a dose amount or infusion rate.",1:" as a dose or amount.")
+4 IF FIRST
IF '$ORDER(ORDIALOG(PROMPT,0))
IF $GET(ORXFER)
DO SHOWSIG^ORCMED
+5 SET ORCOMPLX=$$COMPLEX
SET MULT=+ORCOMPLX
IF ORCOMPLX="^"
SET ORQUIT=1
QUIT
+6 IF $GET(ORDIALOG(PROMPT,"LIST"))
QUIT
IF '$DATA(ORDOSE)
QUIT
D1 ; -- Entry from ORCMED,NF^ORCDPS to build list
+1 NEW I,J,X,DD,DRUG,DOSE,CONJ,CNT,UD,COST,TEXT
+2 SET (I,CNT)=0
SET CONJ=$PIECE($GET(ORDOSE("MISC")),U,3)
IF $LENGTH(CONJ)
SET CONJ=" "_CONJ
+3 FOR
SET I=$ORDER(ORDOSE(I))
IF I'>0
QUIT
Begin DoDot:1
+4 SET X=ORDOSE(I)
SET DD=+$PIECE(X,U,6)
SET DRUG=ORDOSE("DD",DD)
+5 ; =TotalDose^Units^U/D^Noun^LocalDose^DispDrugIEN^Cost
+6 ;DD=Name^Cost^NF^DispUnit^Strength^Units^DoseForm^MaxRefills?
+7 SET DOSE=$PIECE(X,U,5)
SET UD=$PIECE(X,U,3)
SET COST=$PIECE(X,U,7)
IF '$LENGTH(DOSE)
QUIT
+8 IF '$PIECE(X,U)
SET DOSE=DOSE_CONJ_" "_$SELECT($LENGTH($PIECE(DRUG,U,5)):$PIECE(DRUG,U,5)_$PIECE(DRUG,U,6),1:$PIECE(DRUG,U))
+9 ;I UD S COST="$"_$J(UD*$P(DRUG,U,2),1,3) ;_" per "_UD_" "_$P(X,U,4)
+10 SET TEXT=DOSE_$SELECT($LENGTH(COST):" $"_COST,1:"")_$SELECT($PIECE(DRUG,U,3):" (non-formulary)",1:"")
+11 SET CNT=CNT+1
SET ORDIALOG(PROMPT,"LIST",CNT)=DOSE_U_TEXT
+12 SET ORDIALOG(PROMPT,"LIST","B",TEXT)=DOSE
+13 ;default DispDrug
SET ORDIALOG(PROMPT,"LIST","D",DOSE)=DD
+14 SET ORDOSE("DD",DD,DOSE)=$PIECE(ORDOSE(I),U,1,6)_U_$PIECE(DRUG,U,5,6)
+15 ;xref alt forms of dose
SET J=0
FOR
SET J=$ORDER(ORDOSE(I,J))
IF J'>0
QUIT
Begin DoDot:2
+16 SET DD=+$PIECE(ORDOSE(I,J),U,6)
SET DRUG=$GET(ORDOSE("DD",DD))
+17 SET ORDOSE("DD",DD,DOSE)=$PIECE(ORDOSE(I,J),U,1,6)_U_$PIECE(DRUG,U,5,6)
End DoDot:2
End DoDot:1
+18 IF CNT
SET ORDIALOG(PROMPT,"LIST")=CNT
+19 QUIT
+20 ;
CHDOSE ; -- Kill dependent values if inst ORI of dose changes
+1 NEW X,PROMPTS,P,NAME,DOSE,DD
SET X=$GET(ORDIALOG(PROMPT,ORI))
+2 ;IHS/MSC/MGH Removed forcing to uppercase for dispense drug
+3 ;S X=$$UP^XLFSTR(X),ORDIALOG(PROMPT,ORI)=X ;force uppercase
+4 SET ORDIALOG(PROMPT,ORI)=X
+5 IF X
IF X'?1.N.E1.A.E
KILL DONE
WRITE $CHAR(7),!,"Enter the amount of this drug that the patient is to receive as a dose,",!,"NOT as the number of units per dose."
QUIT
+6 IF $LENGTH(X)>60
IF '$DATA(ORDIALOG(PROMPT,"LIST","B",X))
KILL DONE
WRITE $CHAR(7),!,"Instructions may not be longer than 60 characters."
QUIT
+7 ;kill dependent values if new/changed dose
IF $GET(ORESET)'=X
Begin DoDot:1
+8 SET PROMPTS="STRENGTH^DRUG NAME^DOSE^DISPENSE DRUG^DAYS SUPPLY^QUANTITY^REFILLS"
+9 FOR P=1:1:$LENGTH(PROMPTS,U)
SET NAME=$PIECE(PROMPTS,U,P)
KILL ORDIALOG($$PTR(NAME),ORI)
+10 KILL ORQTY,ORQTYUNT,ORDRUG,ORDIALOG($$PTR("DISPENSE DRUG"),1)
+11 KILL ^TMP("ORWORD",$JOB,$$PTR("SIG"))
End DoDot:1
+12 ;set ID
SET DOSE=$$PTR("DOSE")
IF $LENGTH(X)
IF '$LENGTH($GET(ORDIALOG(DOSE,ORI)))
Begin DoDot:1
+13 SET DD=+$GET(ORDIALOG(PROMPT,"LIST","D",X))
+14 IF DD
SET ORDIALOG(DOSE,ORI)=$TRANSLATE($GET(ORDOSE("DD",DD,X)),"^","&")
End DoDot:1
+15 SET DD=+$PIECE($GET(ORDIALOG(DOSE,ORI)),"&",6)
+16 ;look for FormAlt
IF DD
IF $PIECE($GET(ORDOSE("DD",DD)),U,3)
DO NF^ORCDPS(DD)
+17 QUIT
+18 ;
EXDOSE ; -- Exit Action
+1 IF '$ORDER(ORDIALOG(PROMPT,0))
QUIT
NEW DRUG,MISC,QUIT,LAST
+2 SET ORDRUG=$$DISPDRUG^ORCDPS
SET DRUG=$GET(ORDOSE("DD",+ORDRUG))
+3 IF ORDRUG
Begin DoDot:1
+4 ;I $P(DRUG,U,10),'$L($P($G(^VA(200,+$G(ORNP),"PS")),U,2)),'$L($P($G(^("PS")),U,3)) W $C(7),!,$P($G(^(0)),U)_" must have a DEA# or VA# to order this drug!" S QUIT=1 Q
+5 ;I $P(DRUG,U,10)=1 W $C(7),!,"This order will require a wet signature!"
+6 SET ORDIALOG($$PTR("DISPENSE DRUG"),1)=ORDRUG
+7 IF $GET(ORCAT)="O"
DO RESETID^ORCDPS
+8 NEW STR,MED
SET STR=$PIECE(DRUG,U,5)_$PIECE(DRUG,U,6)
+9 IF STR'>0
IF '$GET(ORDOSE(1))
SET ORDIALOG($$PTR("DRUG NAME"),1)=$PIECE(DRUG,U)
QUIT
+10 SET MED=$PIECE($GET(^ORD(101.43,+$GET(OROI),0)),U)
+11 IF MED'[STR
IF ORCAT="O"!'$GET(ORDOSE(1))
SET ORDIALOG($$PTR("STRENGTH"),1)=STR
End DoDot:1
IF $GET(QUIT)
SET ORQUIT=1
QUIT
+12 IF +ORDRUG'>0
IF ORCAT="O"
WRITE $CHAR(7),!,"Cannot determine dispense drug - some defaults and order checks may not occur!"
EXD1 ; -- Kill dangling conjunction, [re]build Sig, get Qty info
+1 SET LAST=$ORDER(ORDIALOG(PROMPT,"?"),-1)
KILL ORDIALOG($$PTR("AND/THEN"),LAST)
+2 ;[re]build Sig/Text
DO ADMIN^ORCDPS3
IF $GET(ORTYPE)'="Z"
DO SIG
+3 ;set Qty info
IF ORDRUG
IF ORCAT="O"
Begin DoDot:1
+4 IF $LENGTH($PIECE(DRUG,U,4))
SET ORQTYUNT=$PIECE(DRUG,U,4)
+5 SET MISC=$$ENDCM^PSJORUTL(+ORDRUG)
SET ORQTY=$PIECE(MISC,U,4)
+6 IF $LENGTH($PIECE(MISC,U,2))
WRITE !!,$PIECE(MISC,U,2),!
End DoDot:1
+7 QUIT
+8 ;
SIG ; -- Create ORDIALOG(SIG) from Instructions PROMPT,ORDOSE,ORDRUG,ORCAT
+1 ; Return text in ^TMP("ORWORD",$J,SIG,INST)
+2 ; [also called from PSJ^ORCSEND1 to build child orders]
+3 ;
+4 NEW ORT,ORSCH,ORDUR,ORID,ORDD,ORCNJ,ORMISC,ORPREP,ORX,ORI,CNT,ORSIG,ORS,DOSE
+5 SET ORT=$$PTR("ROUTE")
SET ORSCH=$$PTR("SCHEDULE")
SET ORDUR=$$PTR("DURATION")
+6 SET ORID=$$PTR("DOSE")
SET ORCNJ=$$PTR("AND/THEN")
SET ORS=$$PTR("SIG")
+7 SET ORMISC=$GET(ORDOSE("MISC"))
SET ORPREP=$PIECE(ORMISC,U,2)
+8 ;"TAKE "
SET ORX=$SELECT(ORCAT="I":"",ORCAT="O"&(+$GET(ISIMO)=1):"",$LENGTH($PIECE(ORMISC,U)):$PIECE(ORMISC,U)_" ",1:"")
+9 SET (CNT,ORI)=0
FOR
SET ORI=$ORDER(ORDIALOG(PROMPT,ORI))
IF ORI'>0
QUIT
Begin DoDot:1
+10 SET DOSE=$GET(ORDIALOG(PROMPT,ORI))
IF '$LENGTH(DOSE)
QUIT
+11 SET ORX=ORX_$$DOSE_$$RTE_$$SCH_$$DUR_$$CONJ
+12 SET CNT=CNT+1
SET ORSIG(CNT,0)=ORX
SET ORX=""
End DoDot:1
+13 IF CNT'>0
QUIT
SET ORSIG(0)="^^"_CNT_U_CNT_U_DT_U
+14 KILL ^TMP("ORWORD",$JOB,ORS,1)
MERGE ^(1)=ORSIG
SET ORDIALOG(PROMPT,"FORMAT")="@"
+15 SET ORDIALOG(ORS,1)=$NAME(^TMP("ORWORD",$JOB,ORS,1))
+16 QUIT
+17 ;
PTR(X) ; -- Ptr to prompt OR GTX X
+1 QUIT +$ORDER(^ORD(101.41,"AB","OR GTX "_X,0))
+2 ;
DOSE() ; -- Dosage
+1 ;ID string
NEW X0,Y
SET X0=$GET(ORDIALOG(ORID,ORI))
+2 ;use local dose if common DispDrug
SET Y=DOSE
IF ORDRUG
IF $LENGTH(X0)
Begin DoDot:1
+3 ;unless Outpt w/total dose
IF $LENGTH($PIECE(X0,"&",5))
SET Y=$PIECE(X0,"&",5)
+4 ;u/d
IF ORCAT="O"
IF X0
SET Y=$$WORD($PIECE(X0,"&",3))_" "_$PIECE(X0,"&",4)
End DoDot:1
+5 QUIT Y
+6 ;
WORD(X) ; -- Words for number X
+1 NEW X1,X2,Y
SET X1=$PIECE(+X,".")
SET X2=$PIECE(+X,".",2)
+2 SET Y=""
IF X1
SET Y=$SELECT(X1=1:"ONE",X1=2:"TWO",X1=3:"THREE",X1=4:"FOUR",X1=5:"FIVE",X1=6:"SIX",X1=7:"SEVEN",X1=8:"EIGHT",X1=9:"NINE",X1=10:"TEN",1:X1)
+3 IF X2
SET Y=Y_$SELECT($LENGTH(Y):" AND ",1:"")_$SELECT(X2=5:"ONE-HALF",X2=33!(X2=34):"ONE-THIRD",X2=25:"ONE-FOURTH",X2=66!(X2=67):"TWO-THIRDS",X2=75:"THREE-FOURTHS",1:"."_X2)
+4 QUIT Y
+5 ;
RTE() ; -- Expansion of route
+1 NEW X,X0,Y
SET X=+$GET(ORDIALOG(ORT,ORI))
IF X'>0
QUIT ""
+2 KILL ^TMP($JOB,"ORCDPS2 RTE")
+3 DO ALL^PSS51P2(+X,,,,"ORCDPS2 RTE")
+4 ;S X0=$G(^PS(51.2,+X,0))
+5 ;IHS/MSC/PLS - 02/15/2012
SET Y=""
+6 IF ORCAT="I"!(+$GET(ISIMO)=1)
SET Y=" "_$SELECT($LENGTH(^TMP($JOB,"ORCDPS2 RTE",+X,1)):^TMP($JOB,"ORCDPS2 RTE",+X,1),1:^TMP($JOB,"ORCDPS2 RTE",+X,.01))
+7 ;I ORCAT="I" S Y=" "_$S($L($P(X0,U,3)):$P(X0,U,3),1:$P(X0,U))
+8 IF ORCAT="O"
IF '+$GET(ISIMO)
SET Y=" "_$SELECT($LENGTH(ORPREP):ORPREP_" ",1:"")_$SELECT($LENGTH(^TMP($JOB,"ORCDPS2 RTE",+X,4)):^TMP($JOB,"ORCDPS2 RTE",+X,4),1:^TMP($JOB,"ORCDPS2 RTE",+X,.01))
+9 QUIT Y
+10 ;
SCH() ; -- [outpatient] expansion of schedule
+1 NEW X,Y
SET X=$GET(ORDIALOG(ORSCH,ORI))
+2 IF $LENGTH(X)
IF ORCAT="O"
IF '+$GET(ISIMO)
DO SCH^PSSUTIL1(.X)
+3 SET Y=$SELECT($LENGTH(X):" "_X,1:"")
+4 QUIT Y
+5 ;
DUR() ; -- Duration
+1 NEW X,Y
SET X=$GET(ORDIALOG(ORDUR,ORI))
SET Y=""
+2 IF X
SET Y=" FOR "_$$UP^XLFSTR(X)_$SELECT(+X=X:" DAYS",1:"")
+3 QUIT Y
+4 ;
CONJ() ; -- Conjunction
+1 NEW X,Y
SET X=$GET(ORDIALOG(ORCNJ,ORI))
+2 IF $LENGTH(X)>1
SET X=$EXTRACT(X)
IF X="E"
SET S="X"
+3 SET Y=$SELECT(X="T":", THEN",X="X":" EXCEPT",X="A":" AND",1:"")
+4 QUIT Y
+5 ;
DOSETEXT ; -- Reset dose text in ORDIALOG(INSTR) for backdoor orders
+1 ; [Called from ORMPS1 - uses ORCAT,PSOI,ORVP,DRUG,INSTR,DOSE]
+2 ;
+3 NEW ORTYPE,ORDOSE,CONJ,ORDRUG,DRUG0,STRG,ORI,LDOSE,X,PROMPT
+4 SET ORTYPE=$SELECT($GET(ORCAT)="I":"U",1:"O")
+5 DO DOSE^PSSORUTL(.ORDOSE,+PSOI,ORTYPE,+ORVP)
+6 SET CONJ=$PIECE($GET(ORDOSE("MISC")),U,3)
IF $LENGTH(CONJ)
SET CONJ=" "_CONJ
+7 SET ORDRUG=+$GET(ORDIALOG(DRUG,1))
SET DRUG0=$GET(ORDOSE("DD",ORDRUG))
+8 SET STRG=$PIECE(DRUG0,U,5)_$PIECE(DRUG0,U,6)
+9 IF '$GET(ORDOSE(1))
SET ORI=0
FOR
SET ORI=$ORDER(ORDIALOG(INSTR,ORI))
IF ORI'>0
QUIT
Begin DoDot:1
+10 SET LDOSE=$GET(ORDIALOG(INSTR,ORI))
SET X=$GET(ORDIALOG(DOSE,ORI))
IF '$LENGTH(X)
QUIT
+11 IF 'X
SET ORDIALOG(INSTR,ORI)=LDOSE_CONJ_" "_$SELECT(STRG:STRG,1:$PIECE(DRUG0,U))
End DoDot:1
+12 ; -build Sig/Text if not defined
+13 IF '$DATA(ORDIALOG(+$$PTR("SIG"),1))
SET PROMPT=INSTR
DO SIG
+14 QUIT
+15 ;
+16 ;IHS/MSC/MGH Broke this into 2 sections to get and put the patient instructions
PI ; -- Include Pt Instructions w/Sig in Outpt order?
+1 NEW X,Y,DIR,DUOUT,DTOUT,DIRUT,ORTX,ORMAX,I,CNT
+2 ;!'$O(ORDOSE("PI",0))
IF $GET(ORCAT)'="O"
DO CLEARWP
QUIT
+3 IF $GET(ORENEW)
QUIT
SET I=0
SET ORMAX=57
+4 IF $GET(OREDIT)!$GET(OREWRITE)
IF $ORDER(^TMP("ORWORD",$JOB,PROMPT,INST,0))
KILL ORDOSE("PI")
+5 SET I=0
FOR
SET I=$ORDER(^TMP("ORWORD",$JOB,PROMPT,INST,I))
IF I<1
QUIT
SET ORDOSE("PI",I)=$GET(^(I,0))
+6 ;IHS/MSC/MGH Commented out patch 1011
+7 ;I '$O(ORDOSE("PI",0)) D CLEARWP Q
+8 FOR
SET I=$ORDER(ORDOSE("PI",I))
IF I'>0
QUIT
SET X=ORDOSE("PI",I)
DO TXT^ORCHTAB
+9 ;IHS/MSC/MGH Lines here moved to PIOUT
+10 ;S DIR(0)="YA",DIR("A")="Save and include Patient Instructions in Sig? "
+11 ;S DIR("?")="Enter NO if you do not want these instructions included in the sig for this order",DIR("B")=$S($D(^TMP("ORWORD",$J,PROMPT)):"YES",1:"NO")
+12 ;W ! S I=0 F S I=$O(ORTX(I)) Q:I'>0 W !,$S(I=1:"Patient Instructions: ",1:" ")_ORTX(I)
+13 ;D ^DIR I $D(DUOUT)!$D(DTOUT) S ORQUIT=1 Q
+14 ;IHS/MSC/MGH Removed most of this since it was already there
+15 ;I Y D Q ;save text
+16 ;. K ^TMP("ORWORD",$J,PROMPT,INST) S CNT=0
+17 ;. S I=0 F S I=$O(ORTX(I)) Q:I'>0 S ^TMP("ORWORD",$J,PROMPT,INST,1,0)=ORTX(I),CNT=CNT+1
+18 ;. S ^TMP("ORWORD",$J,PROMPT,INST,0)="^^"_CNT_U_CNT_U_DT_U
+19 ;.S ORDIALOG(PROMPT,INST)="^TMP(""ORWORD"","_$J_","_PROMPT_","_INST_")"
+20 SET CNT=0
+21 SET I=0
FOR
SET I=$ORDER(ORTX(I))
IF 'I
QUIT
Begin DoDot:1
+22 SET ^TMP("ORWORD",$JOB,PROMPT,INST,I,0)=ORTX(I)
+23 SET CNT=CNT+1
End DoDot:1
+24 SET ^TMP("ORWORD",$JOB,PROMPT,INST,0)="^^"_CNT_U_CNT_U_DT_U
+25 IF CNT>0
SET ORDIALOG(PROMPT,INST)="^TMP(""ORWORD"","_$JOB_","_PROMPT_","_INST_")"
+26 QUIT
+27 ;IHS/MSC/MGH Broke into 2 sections to edit pt instructions
PIOUT ; -- Store Pt instructions exit action
+1 NEW TXT,DIR,Y,CNT
+2 SET DIR(0)="YA"
SET DIR("A")="Save and include Patient Instructions in Sig? "
+3 SET DIR("?")="Enter NO if you do not want these instructions included in the sig for this order"
SET DIR("B")=$SELECT($DATA(^TMP("ORWORD",$JOB,PROMPT)):"YES",1:"NO")
+4 DO ^DIR
IF $DATA(DUOUT)!$DATA(DTOUT)
SET ORQUIT=1
QUIT
+5 IF Y'>0
KILL ORDIALOG(PROMPT,INST),^TMP("ORWORD",$JOB,PROMPT,INST)
+6 IF '$TEST
SET ORDIALOG(PROMPT,INST)="^TMP(""ORWORD"","_$JOB_","_PROMPT_","_INST_")"
+7 QUIT
+8 ;
CLEARWP ; -- Clear INST of wp field PROMPT
+1 KILL ORDIALOG(PROMPT,INST),^TMP("ORWORD",$JOB,PROMPT,INST)
+2 QUIT
