- 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 Jan 18, 2025@03:29:18 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))