ORCDPS ;SLC/MKB - Pharmacy dialog utilities ;Oct 19, 2022@13:32:56
;;3.0;ORDER ENTRY/RESULTS REPORTING;**4,38,62,86,94,129,350,440,594**;Dec 17, 1997;Build 1
;
; ** Keep for backwards compatibility, just in case:
;
CHANGED(TYPE) ; -- Kill dependent values when OI changes
N PROMPTS,NAME,PTR,P,I
Q:'$L($G(TYPE)) S PROMPTS=""
I TYPE="U" S PROMPTS="DISPENSE DRUG^INSTRUCTIONS^ROUTE" K ORSCHED,ORQTY
I TYPE="O" S PROMPTS="DISPENSE DRUG^INSTRUCTIONS^FREE TEXT^ROUTE^SCHEDULE^DURATION" K ORSCHED,ORQTY
S:TYPE="IVB" PROMPTS="VOLUME"
S:TYPE="IVA" PROMPTS="STRENGTH PSIV^UNITS"
I TYPE="ALL" S PROMPTS="ORDERABLE ITEM^DISPENSE DRUG^INSTRUCTIONS^FREE TEXT^ROUTE^SCHEDULE^DURATION^URGENCY^QUANTITY^REFILLS^ROUTING^SERVICE CONNECTED^VOLUME^STRENGTH PSIV^UNITS^ADDITIVE^INFUSION RATE^WORD PROCESSING 1" K ORSCHED,ORQTY
S:TYPE="XFR" PROMPTS="DISPENSE DRUG^INSTRUCTIONS^FREE TEXT^DURATION^QUANTITY^REFILLS^ROUTING^START DATE^SERVICE CONNECTED"
F P=1:1:$L(PROMPTS,U) S NAME=$P(PROMPTS,U,P) D
. S PTR=$O(^ORD(101.41,"AB","OR GTX "_NAME,0)) Q:'PTR
. S I=0 F S I=$O(ORDIALOG(PTR,I)) Q:I'>0 K ORDIALOG(PTR,I)
. K ORDIALOG(PTR,"LIST")
Q
;
ASKSC() ; -- Return 1 or 0, if SC prompt should be asked
I $L($T(SC^PSOCP)),$$SC^PSOCP(+ORVP,+$G(ORDRUG)) Q 0 ;exempt from copay
I $$RXST^IBARXEU(+ORVP)>0 Q 0 ;exempt from copay
Q 1
;
INSTR(OI) ; -- Get allowable instructions and routes
N PSOI,INSTR,NOUN,I,X,CNT
K ^TMP("PSJINS",$J),^TMP("PSJMR",$J),^TMP("PSJNOUN",$J),ORLEAD,ORNOUNS,ORSCHED
S PSOI=+$P($G(^ORD(101.43,+OI,0)),U,2) D START^PSSJORDF(PSOI)
S:$L($G(^TMP("PSJSCH",$J))) ORSCHED=^($J) ;default schedule
Q:$P($G(^ORD(100.98,+ORDG,0)),U,3)'="O RX" ; Don't need nouns for Inpt
S NOUN=$$PTR^ORCD("OR GTX FREE TEXT"),ORNOUNS="",(I,CNT)=0
F S I=$O(^TMP("PSJNOUN",$J,I)) Q:I'>0 S X=$P(^(I),U) I $L(X) S CNT=CNT+1,ORDIALOG(NOUN,"LIST",CNT)=X_U_X,ORDIALOG(NOUN,"LIST","B",X)=X,ORNOUNS=ORNOUNS_$S($L(ORNOUNS):" or ",1:"")_X
S ORDIALOG(NOUN,"LIST")=CNT_"^1",INSTR=$$PTR^ORCD("OR GTX INSTRUCTIONS")
S I=$O(^TMP("PSJINS",$J,0)),X=$P($G(^TMP("PSJINS",$J,+I)),U)
S:$L(X) ORLEAD=$$LOWER^VALM1(X),ORDIALOG(INSTR,"TTL")=ORLEAD_": "
S ORDIALOG(INSTR,"A")=$S($L($G(ORLEAD)):ORLEAD,1:"Amount")_$S($L(ORNOUNS):" (in "_ORNOUNS_")",1:"")_": "
Q
;
CHOICES(TYPE) ; -- Get list of allowable dispense drugs
Q:$D(ORDIALOG(PROMPT,"LIST")) N OI,PSJOI,I,X,Y,ORX,ORY
S OI=$$VAL^ORCD("MEDICATION"),PSJOI="^^^"_+$P($G(^ORD(101.43,+OI,0)),U,2)
S ORX=$T(ENDD^PSJORUTL),ORX=$L($P(ORX,";"),",")
I ORX>3 D ENDD^PSJORUTL(PSJOI,TYPE,.ORY,+ORVP) Q:ORY'>0
I ORX'>3 D ENDD^PSJORUTL(PSJOI,TYPE,.ORY) Q:ORY'>0
F I=1:1:ORY S X=$P(ORY(I),U,2),ORY("B",X)=ORY(I) K ORY(I) ; sort
S I=0,ORX="" W !
F S ORX=$O(ORY("B",ORX)) Q:ORX="" S X=ORY("B",ORX),I=I+1 D
. S Y=$P(X,U,1,2) I $L($P(X,U,5)),Y'[$P(X,U,5) S Y=Y_" "_$P(X,U,5)
. S:$P(X,U,4) Y=Y_" (non-formulary)"
. S:$P(X,U,3) Y=Y_" $"_$P(X,U,3)_$S($L($P(X,U,5)):" per "_$P(X,U,5),1:"")
. S ORDIALOG(PROMPT,"LIST",I)=Y,ORDIALOG(PROMPT,"LIST","B",$P(X,U,2))=+X,ORDIALOG(PROMPT,"LIST","D",+X)=I_U_$P(X,U,4)_U_$P(X,U,6)
S ORDIALOG(PROMPT,"LIST")=ORY_"^1" ; total^list only
Q
;
; ** End of old code
;
NF(DRUG) ; -- Get alternatives for non-formulary drugs
; [Called from P-S Action for Dose]
N TYPE,ORY,I,DD,PSOI,ORPSOI,X,Y,DUOUT,DTOUT
Q:'$G(DRUG) Q:$G(ORENEW)
S TYPE=$S($G(ORCAT)="I":"U",1:"O")
D ENRFA^PSJORUTL(DRUG,TYPE,.ORY)
S ORPSOI=+$P($G(^ORD(101.43,+$G(OROI),0)),U,2)
S (I,DD)=0 I ORY F S DD=$O(ORY(DD)) Q:DD'>0 D ;build list of choices
. S PSOI=$P(ORY(DD),U,4,5) Q:PSOI=ORPSOI Q:$G(ORY("PS",+PSOI))
. S I=I+1,ORY("B",I)=PSOI,ORY("PS",+PSOI)=I
I '$P($G(^ORD(101.43,+$G(OROI),"PS")),U,6) D ;skip if OI is NF
. W !!,"*** The dispense drug for this dose is not in the formulary! ***"
. W:'ORY!('I) !," There are no formulary alternatives entered for this item."
. W !," Please consult with your pharmacy before ordering this dose."
NF1 Q:'ORY!('I) D Q:$G(ORQUIT) ;Q if no different choices
. N DIR S DIR(0)="NAO^1:"_ORY
. S DIR("A")="Select alternative (or <return> to continue): "
. S I=0 F S I=$O(ORY("B",I)) Q:I'>0 S DIR("A",I)=$J(I,3)_" "_$P(ORY("B",I),U,2)
. S DIR("?")="The dispense drug for the selected dose is not in the formulary; you may select an alternative orderable item, or press <return> to continue processing this order."
. W !," Formulary alternative orderable items:"
. D ^DIR S:$D(DTOUT)!($D(DUOUT)) ORQUIT=1
I Y D ; reset OI, doses
. S PSOI=+ORY("B",Y),X=+$O(^ORD(101.43,"ID",PSOI_";99PSP",0))
. Q:'X Q:X=OROI ;error or same OI
. S ORDIALOG($$PTR^ORCD("OR GTX ORDERABLE ITEM"),1)=X
. D CHANGED^ORCDPS1("OI"),OI2^ORCDPS1,D1^ORCDPS2 ;get new doses
. D:$G(ORDIALOG(PROMPT,"LIST")) LIST^ORCD K DONE,ORESET
. S DIR("A")=ORDIALOG(PROMPT,"A"),(ORI,INST)=1 ;reset if complex
Q
;
DISPDRUG() ; -- Get Dispense Drug from dose selection(s) [from EXDOSE^ORCDPS2]
; Expects PROMPT, ORDIALOG(), ORDOSE()
;
N DD,FORM,I,DOSE,X,ORID,OK,STR,ORX,HALFOK
I $E($G(XQY0),1,17)'="ORCM QUICK ORDERS" S DD=$G(ORDIALOG($$PTR("DISPENSE DRUG"),1)) I DD Q DD ;already have - DJE/VM *440 recalc for quick orders
S DD="",FORM="1.N.""."".N."" ""1"""_$P($G(ORDOSE(1)),U,2)_""""
S I=0 F S I=$O(ORDIALOG(PROMPT,I)) Q:I'>0 D Q:DD="^"
. S DOSE=$G(ORDIALOG(PROMPT,I)),X=""
. S:$L(DOSE) X=$G(ORDIALOG(PROMPT,"LIST","D",DOSE))
. I X="" S DD=$S($G(ORCAT)="I":"^",'$G(ORDOSE(1)):"^",DOSE'?@FORM:"^",1:0) Q
. S:DD="" DD=X I X'=DD S DD=$S($G(ORCAT)="I":"^",1:0) Q
Q:DD DD Q:DD="^" "" ;all same, or not possible
S ORID=$$PTR("DOSE"),DD=0 F S DD=$O(ORDOSE("DD",DD)) Q:DD'>0 D
. S OK=1,STR=+$P($G(ORDOSE("DD",DD)),U,5),HALFOK=+$P($G(ORDOSE("DD",DD)),U,11)
. S I=0 F S I=$O(ORDIALOG(PROMPT,I)) Q:I'>0 D Q:'OK
.. S DOSE=$G(ORDIALOG(PROMPT,I))
.. I '$G(ORDOSE(1)) D Q ;local doses
... S X=$G(ORDOSE("DD",DD,DOSE)) I X="" S OK=0 K ORX(DD) Q
... S ORX(DD,I)=DOSE,ORX(DD)=""
.. S X=+$G(ORDIALOG(ORID,I)) S:X'>0 X=+DOSE S X=X/STR
.. I (X?1.N)!(HALFOK&(X?.N.1".5")) S ORX(DD,I)=X S:X>$G(ORX(DD)) ORX(DD)=X Q
.. K ORX(DD) S OK=0
I '$G(ORDOSE(1)) S DD=$O(ORX(0)) Q DD ;first one
S DD="",X=99999,I=0 F S I=$O(ORX(I)) Q:I'>0 I ORX(I)<X S X=ORX(I),DD=I
Q DD
;
ID() ; -- Return ID string for dose instance INST
N INSTR,DD,DOSE,ID
S INSTR=$$PTR("INSTRUCTIONS"),DOSE=$G(ORDIALOG(INSTR,INST)),(DD,ID)=""
S:$L(DOSE) DD=+$G(ORDIALOG(INSTR,"LIST","D",DOSE))
S:DD ID=$TR($G(ORDOSE("DD",DD,DOSE)),"^","&")
Q ID
;
RESETID ; -- Reset ORDIALOG(DOSE) nodes for new ORDRUG
; From EXDOSE^ORCDPS2: Expects PROMPT, DRUG
;
Q:$G(ORCAT)'="O" N I,ORID,STR,UNT,DOSE,X,FORM
S ORID=$$PTR("DOSE"),STR=+$P(DRUG,U,5),UNT=$P(DRUG,U,6)
S FORM="1.N.""."".N."" ""1"""_UNT_""""
S I=0 F S I=$O(ORDIALOG(PROMPT,I)) Q:I'>0 D
. S DOSE=$G(ORDIALOG(PROMPT,I))
. I DOSE="" Q
. S X=$G(ORDOSE("DD",+ORDRUG,DOSE))
. I '$L(X),STR,DOSE?@FORM D
.. N UD,NOUN S UD=+DOSE/STR,NOUN=$P($G(ORDOSE(1)),U,4)
.. I UD>1,$E(NOUN,$L(NOUN))'="S" S NOUN=NOUN_"S"
.. S X=+DOSE_"&"_UNT_"&"_UD_"&"_NOUN_"&"_DOSE_"&"_+ORDRUG_"&"_STR_"&"_UNT
. S:$L(X) ORDIALOG(ORID,I)=$TR(X,"^","&") Q
Q
PTR(X) ; -- Return ptr to prompt OR GTX X
Q +$O(^ORD(101.41,"AB","OR GTX "_X,0))
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HORCDPS 7265 printed Sep 23, 2025@20:04:25 Page 2
ORCDPS ;SLC/MKB - Pharmacy dialog utilities ;Oct 19, 2022@13:32:56
+1 ;;3.0;ORDER ENTRY/RESULTS REPORTING;**4,38,62,86,94,129,350,440,594**;Dec 17, 1997;Build 1
+2 ;
+3 ; ** Keep for backwards compatibility, just in case:
+4 ;
CHANGED(TYPE) ; -- Kill dependent values when OI changes
+1 NEW PROMPTS,NAME,PTR,P,I
+2 if '$LENGTH($GET(TYPE))
QUIT
SET PROMPTS=""
+3 IF TYPE="U"
SET PROMPTS="DISPENSE DRUG^INSTRUCTIONS^ROUTE"
KILL ORSCHED,ORQTY
+4 IF TYPE="O"
SET PROMPTS="DISPENSE DRUG^INSTRUCTIONS^FREE TEXT^ROUTE^SCHEDULE^DURATION"
KILL ORSCHED,ORQTY
+5 if TYPE="IVB"
SET PROMPTS="VOLUME"
+6 if TYPE="IVA"
SET PROMPTS="STRENGTH PSIV^UNITS"
+7 IF TYPE="ALL"
SET PROMPTS="ORDERABLE ITEM^DISPENSE DRUG^INSTRUCTIONS^FREE TEXT^ROUTE^SCHEDULE^DURATION^URGENCY^QUANTITY^REFILLS^ROUTING^SERVICE CONNECTED^VOLUME^STRENGTH PSIV^UNITS^ADDITIVE^INFUSION RATE^WORD PROCESSING 1"
KILL ORSCHED,ORQTY
+8 if TYPE="XFR"
SET PROMPTS="DISPENSE DRUG^INSTRUCTIONS^FREE TEXT^DURATION^QUANTITY^REFILLS^ROUTING^START DATE^SERVICE CONNECTED"
+9 FOR P=1:1:$LENGTH(PROMPTS,U)
SET NAME=$PIECE(PROMPTS,U,P)
Begin DoDot:1
+10 SET PTR=$ORDER(^ORD(101.41,"AB","OR GTX "_NAME,0))
if 'PTR
QUIT
+11 SET I=0
FOR
SET I=$ORDER(ORDIALOG(PTR,I))
if I'>0
QUIT
KILL ORDIALOG(PTR,I)
+12 KILL ORDIALOG(PTR,"LIST")
End DoDot:1
+13 QUIT
+14 ;
ASKSC() ; -- Return 1 or 0, if SC prompt should be asked
+1 ;exempt from copay
IF $LENGTH($TEXT(SC^PSOCP))
IF $$SC^PSOCP(+ORVP,+$GET(ORDRUG))
QUIT 0
+2 ;exempt from copay
IF $$RXST^IBARXEU(+ORVP)>0
QUIT 0
+3 QUIT 1
+4 ;
INSTR(OI) ; -- Get allowable instructions and routes
+1 NEW PSOI,INSTR,NOUN,I,X,CNT
+2 KILL ^TMP("PSJINS",$JOB),^TMP("PSJMR",$JOB),^TMP("PSJNOUN",$JOB),ORLEAD,ORNOUNS,ORSCHED
+3 SET PSOI=+$PIECE($GET(^ORD(101.43,+OI,0)),U,2)
DO START^PSSJORDF(PSOI)
+4 ;default schedule
if $LENGTH($GET(^TMP("PSJSCH",$JOB)))
SET ORSCHED=^($JOB)
+5 ; Don't need nouns for Inpt
if $PIECE($GET(^ORD(100.98,+ORDG,0)),U,3)'="O RX"
QUIT
+6 SET NOUN=$$PTR^ORCD("OR GTX FREE TEXT")
SET ORNOUNS=""
SET (I,CNT)=0
+7 FOR
SET I=$ORDER(^TMP("PSJNOUN",$JOB,I))
if I'>0
QUIT
SET X=$PIECE(^(I),U)
IF $LENGTH(X)
SET CNT=CNT+1
SET ORDIALOG(NOUN,"LIST",CNT)=X_U_X
SET ORDIALOG(NOUN,"LIST","B",X)=X
SET ORNOUNS=ORNOUNS_$SELECT($LENGTH(ORNOUNS):" or ",1:"")_X
+8 SET ORDIALOG(NOUN,"LIST")=CNT_"^1"
SET INSTR=$$PTR^ORCD("OR GTX INSTRUCTIONS")
+9 SET I=$ORDER(^TMP("PSJINS",$JOB,0))
SET X=$PIECE($GET(^TMP("PSJINS",$JOB,+I)),U)
+10 if $LENGTH(X)
SET ORLEAD=$$LOWER^VALM1(X)
SET ORDIALOG(INSTR,"TTL")=ORLEAD_": "
+11 SET ORDIALOG(INSTR,"A")=$SELECT($LENGTH($GET(ORLEAD)):ORLEAD,1:"Amount")_$SELECT($LENGTH(ORNOUNS):" (in "_ORNOUNS_")",1:"")_": "
+12 QUIT
+13 ;
CHOICES(TYPE) ; -- Get list of allowable dispense drugs
+1 if $DATA(ORDIALOG(PROMPT,"LIST"))
QUIT
NEW OI,PSJOI,I,X,Y,ORX,ORY
+2 SET OI=$$VAL^ORCD("MEDICATION")
SET PSJOI="^^^"_+$PIECE($GET(^ORD(101.43,+OI,0)),U,2)
+3 SET ORX=$TEXT(ENDD^PSJORUTL)
SET ORX=$LENGTH($PIECE(ORX,";"),",")
+4 IF ORX>3
DO ENDD^PSJORUTL(PSJOI,TYPE,.ORY,+ORVP)
if ORY'>0
QUIT
+5 IF ORX'>3
DO ENDD^PSJORUTL(PSJOI,TYPE,.ORY)
if ORY'>0
QUIT
+6 ; sort
FOR I=1:1:ORY
SET X=$PIECE(ORY(I),U,2)
SET ORY("B",X)=ORY(I)
KILL ORY(I)
+7 SET I=0
SET ORX=""
WRITE !
+8 FOR
SET ORX=$ORDER(ORY("B",ORX))
if ORX=""
QUIT
SET X=ORY("B",ORX)
SET I=I+1
Begin DoDot:1
+9 SET Y=$PIECE(X,U,1,2)
IF $LENGTH($PIECE(X,U,5))
IF Y'[$PIECE(X,U,5)
SET Y=Y_" "_$PIECE(X,U,5)
+10 if $PIECE(X,U,4)
SET Y=Y_" (non-formulary)"
+11 if $PIECE(X,U,3)
SET Y=Y_" $"_$PIECE(X,U,3)_$SELECT($LENGTH($PIECE(X,U,5)):" per "_$PIECE(X,U,5),1:"")
+12 SET ORDIALOG(PROMPT,"LIST",I)=Y
SET ORDIALOG(PROMPT,"LIST","B",$PIECE(X,U,2))=+X
SET ORDIALOG(PROMPT,"LIST","D",+X)=I_U_$PIECE(X,U,4)_U_$PIECE(X,U,6)
End DoDot:1
+13 ; total^list only
SET ORDIALOG(PROMPT,"LIST")=ORY_"^1"
+14 QUIT
+15 ;
+16 ; ** End of old code
+17 ;
NF(DRUG) ; -- Get alternatives for non-formulary drugs
+1 ; [Called from P-S Action for Dose]
+2 NEW TYPE,ORY,I,DD,PSOI,ORPSOI,X,Y,DUOUT,DTOUT
+3 if '$GET(DRUG)
QUIT
if $GET(ORENEW)
QUIT
+4 SET TYPE=$SELECT($GET(ORCAT)="I":"U",1:"O")
+5 DO ENRFA^PSJORUTL(DRUG,TYPE,.ORY)
+6 SET ORPSOI=+$PIECE($GET(^ORD(101.43,+$GET(OROI),0)),U,2)
+7 ;build list of choices
SET (I,DD)=0
IF ORY
FOR
SET DD=$ORDER(ORY(DD))
if DD'>0
QUIT
Begin DoDot:1
+8 SET PSOI=$PIECE(ORY(DD),U,4,5)
if PSOI=ORPSOI
QUIT
if $GET(ORY("PS",+PSOI))
QUIT
+9 SET I=I+1
SET ORY("B",I)=PSOI
SET ORY("PS",+PSOI)=I
End DoDot:1
+10 ;skip if OI is NF
IF '$PIECE($GET(^ORD(101.43,+$GET(OROI),"PS")),U,6)
Begin DoDot:1
+11 WRITE !!,"*** The dispense drug for this dose is not in the formulary! ***"
+12 if 'ORY!('I)
WRITE !," There are no formulary alternatives entered for this item."
+13 WRITE !," Please consult with your pharmacy before ordering this dose."
End DoDot:1
NF1 ;Q if no different choices
if 'ORY!('I)
QUIT
Begin DoDot:1
+1 NEW DIR
SET DIR(0)="NAO^1:"_ORY
+2 SET DIR("A")="Select alternative (or <return> to continue): "
+3 SET I=0
FOR
SET I=$ORDER(ORY("B",I))
if I'>0
QUIT
SET DIR("A",I)=$JUSTIFY(I,3)_" "_$PIECE(ORY("B",I),U,2)
+4 SET DIR("?")="The dispense drug for the selected dose is not in the formulary; you may select an alternative orderable item, or press <return> to continue processing this order."
+5 WRITE !," Formulary alternative orderable items:"
+6 DO ^DIR
if $DATA(DTOUT)!($DATA(DUOUT))
SET ORQUIT=1
End DoDot:1
if $GET(ORQUIT)
QUIT
+7 ; reset OI, doses
IF Y
Begin DoDot:1
+8 SET PSOI=+ORY("B",Y)
SET X=+$ORDER(^ORD(101.43,"ID",PSOI_";99PSP",0))
+9 ;error or same OI
if 'X
QUIT
if X=OROI
QUIT
+10 SET ORDIALOG($$PTR^ORCD("OR GTX ORDERABLE ITEM"),1)=X
+11 ;get new doses
DO CHANGED^ORCDPS1("OI")
DO OI2^ORCDPS1
DO D1^ORCDPS2
+12 if $GET(ORDIALOG(PROMPT,"LIST"))
DO LIST^ORCD
KILL DONE,ORESET
+13 ;reset if complex
SET DIR("A")=ORDIALOG(PROMPT,"A")
SET (ORI,INST)=1
End DoDot:1
+14 QUIT
+15 ;
DISPDRUG() ; -- Get Dispense Drug from dose selection(s) [from EXDOSE^ORCDPS2]
+1 ; Expects PROMPT, ORDIALOG(), ORDOSE()
+2 ;
+3 NEW DD,FORM,I,DOSE,X,ORID,OK,STR,ORX,HALFOK
+4 ;already have - DJE/VM *440 recalc for quick orders
IF $EXTRACT($GET(XQY0),1,17)'="ORCM QUICK ORDERS"
SET DD=$GET(ORDIALOG($$PTR("DISPENSE DRUG"),1))
IF DD
QUIT DD
+5 SET DD=""
SET FORM="1.N.""."".N."" ""1"""_$PIECE($GET(ORDOSE(1)),U,2)_""""
+6 SET I=0
FOR
SET I=$ORDER(ORDIALOG(PROMPT,I))
if I'>0
QUIT
Begin DoDot:1
+7 SET DOSE=$GET(ORDIALOG(PROMPT,I))
SET X=""
+8 if $LENGTH(DOSE)
SET X=$GET(ORDIALOG(PROMPT,"LIST","D",DOSE))
+9 IF X=""
SET DD=$SELECT($GET(ORCAT)="I":"^",'$GET(ORDOSE(1)):"^",DOSE'?@FORM:"^",1:0)
QUIT
+10 if DD=""
SET DD=X
IF X'=DD
SET DD=$SELECT($GET(ORCAT)="I":"^",1:0)
QUIT
End DoDot:1
if DD="^"
QUIT
+11 ;all same, or not possible
if DD
QUIT DD
if DD="^"
QUIT ""
+12 SET ORID=$$PTR("DOSE")
SET DD=0
FOR
SET DD=$ORDER(ORDOSE("DD",DD))
if DD'>0
QUIT
Begin DoDot:1
+13 SET OK=1
SET STR=+$PIECE($GET(ORDOSE("DD",DD)),U,5)
SET HALFOK=+$PIECE($GET(ORDOSE("DD",DD)),U,11)
+14 SET I=0
FOR
SET I=$ORDER(ORDIALOG(PROMPT,I))
if I'>0
QUIT
Begin DoDot:2
+15 SET DOSE=$GET(ORDIALOG(PROMPT,I))
+16 ;local doses
IF '$GET(ORDOSE(1))
Begin DoDot:3
+17 SET X=$GET(ORDOSE("DD",DD,DOSE))
IF X=""
SET OK=0
KILL ORX(DD)
QUIT
+18 SET ORX(DD,I)=DOSE
SET ORX(DD)=""
End DoDot:3
QUIT
+19 SET X=+$GET(ORDIALOG(ORID,I))
if X'>0
SET X=+DOSE
SET X=X/STR
+20 IF (X?1.N)!(HALFOK&(X?.N.1".5"))
SET ORX(DD,I)=X
if X>$GET(ORX(DD))
SET ORX(DD)=X
QUIT
+21 KILL ORX(DD)
SET OK=0
End DoDot:2
if 'OK
QUIT
End DoDot:1
+22 ;first one
IF '$GET(ORDOSE(1))
SET DD=$ORDER(ORX(0))
QUIT DD
+23 SET DD=""
SET X=99999
SET I=0
FOR
SET I=$ORDER(ORX(I))
if I'>0
QUIT
IF ORX(I)<X
SET X=ORX(I)
SET DD=I
+24 QUIT DD
+25 ;
ID() ; -- Return ID string for dose instance INST
+1 NEW INSTR,DD,DOSE,ID
+2 SET INSTR=$$PTR("INSTRUCTIONS")
SET DOSE=$GET(ORDIALOG(INSTR,INST))
SET (DD,ID)=""
+3 if $LENGTH(DOSE)
SET DD=+$GET(ORDIALOG(INSTR,"LIST","D",DOSE))
+4 if DD
SET ID=$TRANSLATE($GET(ORDOSE("DD",DD,DOSE)),"^","&")
+5 QUIT ID
+6 ;
RESETID ; -- Reset ORDIALOG(DOSE) nodes for new ORDRUG
+1 ; From EXDOSE^ORCDPS2: Expects PROMPT, DRUG
+2 ;
+3 if $GET(ORCAT)'="O"
QUIT
NEW I,ORID,STR,UNT,DOSE,X,FORM
+4 SET ORID=$$PTR("DOSE")
SET STR=+$PIECE(DRUG,U,5)
SET UNT=$PIECE(DRUG,U,6)
+5 SET FORM="1.N.""."".N."" ""1"""_UNT_""""
+6 SET I=0
FOR
SET I=$ORDER(ORDIALOG(PROMPT,I))
if I'>0
QUIT
Begin DoDot:1
+7 SET DOSE=$GET(ORDIALOG(PROMPT,I))
+8 IF DOSE=""
QUIT
+9 SET X=$GET(ORDOSE("DD",+ORDRUG,DOSE))
+10 IF '$LENGTH(X)
IF STR
IF DOSE?@FORM
Begin DoDot:2
+11 NEW UD,NOUN
SET UD=+DOSE/STR
SET NOUN=$PIECE($GET(ORDOSE(1)),U,4)
+12 IF UD>1
IF $EXTRACT(NOUN,$LENGTH(NOUN))'="S"
SET NOUN=NOUN_"S"
+13 SET X=+DOSE_"&"_UNT_"&"_UD_"&"_NOUN_"&"_DOSE_"&"_+ORDRUG_"&"_STR_"&"_UNT
End DoDot:2
+14 if $LENGTH(X)
SET ORDIALOG(ORID,I)=$TRANSLATE(X,"^","&")
QUIT
End DoDot:1
+15 QUIT
PTR(X) ; -- Return ptr to prompt OR GTX X
+1 QUIT +$ORDER(^ORD(101.41,"AB","OR GTX "_X,0))
