Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: ORCDPS

ORCDPS.m

Go to the documentation of this file.
  1. 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
  1. ;
  1. ; ** Keep for backwards compatibility, just in case:
  1. ;
  1. CHANGED(TYPE) ; -- Kill dependent values when OI changes
  1. N PROMPTS,NAME,PTR,P,I
  1. Q:'$L($G(TYPE)) S PROMPTS=""
  1. I TYPE="U" S PROMPTS="DISPENSE DRUG^INSTRUCTIONS^ROUTE" K ORSCHED,ORQTY
  1. I TYPE="O" S PROMPTS="DISPENSE DRUG^INSTRUCTIONS^FREE TEXT^ROUTE^SCHEDULE^DURATION" K ORSCHED,ORQTY
  1. S:TYPE="IVB" PROMPTS="VOLUME"
  1. S:TYPE="IVA" PROMPTS="STRENGTH PSIV^UNITS"
  1. 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
  1. S:TYPE="XFR" PROMPTS="DISPENSE DRUG^INSTRUCTIONS^FREE TEXT^DURATION^QUANTITY^REFILLS^ROUTING^START DATE^SERVICE CONNECTED"
  1. F P=1:1:$L(PROMPTS,U) S NAME=$P(PROMPTS,U,P) D
  1. . S PTR=$O(^ORD(101.41,"AB","OR GTX "_NAME,0)) Q:'PTR
  1. . S I=0 F S I=$O(ORDIALOG(PTR,I)) Q:I'>0 K ORDIALOG(PTR,I)
  1. . K ORDIALOG(PTR,"LIST")
  1. Q
  1. ;
  1. ASKSC() ; -- Return 1 or 0, if SC prompt should be asked
  1. I $L($T(SC^PSOCP)),$$SC^PSOCP(+ORVP,+$G(ORDRUG)) Q 0 ;exempt from copay
  1. I $$RXST^IBARXEU(+ORVP)>0 Q 0 ;exempt from copay
  1. Q 1
  1. ;
  1. INSTR(OI) ; -- Get allowable instructions and routes
  1. N PSOI,INSTR,NOUN,I,X,CNT
  1. K ^TMP("PSJINS",$J),^TMP("PSJMR",$J),^TMP("PSJNOUN",$J),ORLEAD,ORNOUNS,ORSCHED
  1. S PSOI=+$P($G(^ORD(101.43,+OI,0)),U,2) D START^PSSJORDF(PSOI)
  1. S:$L($G(^TMP("PSJSCH",$J))) ORSCHED=^($J) ;default schedule
  1. Q:$P($G(^ORD(100.98,+ORDG,0)),U,3)'="O RX" ; Don't need nouns for Inpt
  1. S NOUN=$$PTR^ORCD("OR GTX FREE TEXT"),ORNOUNS="",(I,CNT)=0
  1. 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
  1. S ORDIALOG(NOUN,"LIST")=CNT_"^1",INSTR=$$PTR^ORCD("OR GTX INSTRUCTIONS")
  1. S I=$O(^TMP("PSJINS",$J,0)),X=$P($G(^TMP("PSJINS",$J,+I)),U)
  1. S:$L(X) ORLEAD=$$LOWER^VALM1(X),ORDIALOG(INSTR,"TTL")=ORLEAD_": "
  1. S ORDIALOG(INSTR,"A")=$S($L($G(ORLEAD)):ORLEAD,1:"Amount")_$S($L(ORNOUNS):" (in "_ORNOUNS_")",1:"")_": "
  1. Q
  1. ;
  1. CHOICES(TYPE) ; -- Get list of allowable dispense drugs
  1. Q:$D(ORDIALOG(PROMPT,"LIST")) N OI,PSJOI,I,X,Y,ORX,ORY
  1. S OI=$$VAL^ORCD("MEDICATION"),PSJOI="^^^"_+$P($G(^ORD(101.43,+OI,0)),U,2)
  1. S ORX=$T(ENDD^PSJORUTL),ORX=$L($P(ORX,";"),",")
  1. I ORX>3 D ENDD^PSJORUTL(PSJOI,TYPE,.ORY,+ORVP) Q:ORY'>0
  1. I ORX'>3 D ENDD^PSJORUTL(PSJOI,TYPE,.ORY) Q:ORY'>0
  1. F I=1:1:ORY S X=$P(ORY(I),U,2),ORY("B",X)=ORY(I) K ORY(I) ; sort
  1. S I=0,ORX="" W !
  1. F S ORX=$O(ORY("B",ORX)) Q:ORX="" S X=ORY("B",ORX),I=I+1 D
  1. . 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)
  1. . S:$P(X,U,4) Y=Y_" (non-formulary)"
  1. . S:$P(X,U,3) Y=Y_" $"_$P(X,U,3)_$S($L($P(X,U,5)):" per "_$P(X,U,5),1:"")
  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)
  1. S ORDIALOG(PROMPT,"LIST")=ORY_"^1" ; total^list only
  1. Q
  1. ;
  1. ; ** End of old code
  1. ;
  1. NF(DRUG) ; -- Get alternatives for non-formulary drugs
  1. ; [Called from P-S Action for Dose]
  1. N TYPE,ORY,I,DD,PSOI,ORPSOI,X,Y,DUOUT,DTOUT
  1. Q:'$G(DRUG) Q:$G(ORENEW)
  1. S TYPE=$S($G(ORCAT)="I":"U",1:"O")
  1. D ENRFA^PSJORUTL(DRUG,TYPE,.ORY)
  1. S ORPSOI=+$P($G(^ORD(101.43,+$G(OROI),0)),U,2)
  1. S (I,DD)=0 I ORY F S DD=$O(ORY(DD)) Q:DD'>0 D ;build list of choices
  1. . S PSOI=$P(ORY(DD),U,4,5) Q:PSOI=ORPSOI Q:$G(ORY("PS",+PSOI))
  1. . S I=I+1,ORY("B",I)=PSOI,ORY("PS",+PSOI)=I
  1. I '$P($G(^ORD(101.43,+$G(OROI),"PS")),U,6) D ;skip if OI is NF
  1. . W !!,"*** The dispense drug for this dose is not in the formulary! ***"
  1. . W:'ORY!('I) !," There are no formulary alternatives entered for this item."
  1. . W !," Please consult with your pharmacy before ordering this dose."
  1. NF1 Q:'ORY!('I) D Q:$G(ORQUIT) ;Q if no different choices
  1. . N DIR S DIR(0)="NAO^1:"_ORY
  1. . S DIR("A")="Select alternative (or <return> to continue): "
  1. . 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)
  1. . 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."
  1. . W !," Formulary alternative orderable items:"
  1. . D ^DIR S:$D(DTOUT)!($D(DUOUT)) ORQUIT=1
  1. I Y D ; reset OI, doses
  1. . S PSOI=+ORY("B",Y),X=+$O(^ORD(101.43,"ID",PSOI_";99PSP",0))
  1. . Q:'X Q:X=OROI ;error or same OI
  1. . S ORDIALOG($$PTR^ORCD("OR GTX ORDERABLE ITEM"),1)=X
  1. . D CHANGED^ORCDPS1("OI"),OI2^ORCDPS1,D1^ORCDPS2 ;get new doses
  1. . D:$G(ORDIALOG(PROMPT,"LIST")) LIST^ORCD K DONE,ORESET
  1. . S DIR("A")=ORDIALOG(PROMPT,"A"),(ORI,INST)=1 ;reset if complex
  1. Q
  1. ;
  1. DISPDRUG() ; -- Get Dispense Drug from dose selection(s) [from EXDOSE^ORCDPS2]
  1. ; Expects PROMPT, ORDIALOG(), ORDOSE()
  1. ;
  1. N DD,FORM,I,DOSE,X,ORID,OK,STR,ORX,HALFOK
  1. 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
  1. S DD="",FORM="1.N.""."".N."" ""1"""_$P($G(ORDOSE(1)),U,2)_""""
  1. S I=0 F S I=$O(ORDIALOG(PROMPT,I)) Q:I'>0 D Q:DD="^"
  1. . S DOSE=$G(ORDIALOG(PROMPT,I)),X=""
  1. . S:$L(DOSE) X=$G(ORDIALOG(PROMPT,"LIST","D",DOSE))
  1. . I X="" S DD=$S($G(ORCAT)="I":"^",'$G(ORDOSE(1)):"^",DOSE'?@FORM:"^",1:0) Q
  1. . S:DD="" DD=X I X'=DD S DD=$S($G(ORCAT)="I":"^",1:0) Q
  1. Q:DD DD Q:DD="^" "" ;all same, or not possible
  1. S ORID=$$PTR("DOSE"),DD=0 F S DD=$O(ORDOSE("DD",DD)) Q:DD'>0 D
  1. . S OK=1,STR=+$P($G(ORDOSE("DD",DD)),U,5),HALFOK=+$P($G(ORDOSE("DD",DD)),U,11)
  1. . S I=0 F S I=$O(ORDIALOG(PROMPT,I)) Q:I'>0 D Q:'OK
  1. .. S DOSE=$G(ORDIALOG(PROMPT,I))
  1. .. I '$G(ORDOSE(1)) D Q ;local doses
  1. ... S X=$G(ORDOSE("DD",DD,DOSE)) I X="" S OK=0 K ORX(DD) Q
  1. ... S ORX(DD,I)=DOSE,ORX(DD)=""
  1. .. S X=+$G(ORDIALOG(ORID,I)) S:X'>0 X=+DOSE S X=X/STR
  1. .. I (X?1.N)!(HALFOK&(X?.N.1".5")) S ORX(DD,I)=X S:X>$G(ORX(DD)) ORX(DD)=X Q
  1. .. K ORX(DD) S OK=0
  1. I '$G(ORDOSE(1)) S DD=$O(ORX(0)) Q DD ;first one
  1. 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
  1. Q DD
  1. ;
  1. ID() ; -- Return ID string for dose instance INST
  1. N INSTR,DD,DOSE,ID
  1. S INSTR=$$PTR("INSTRUCTIONS"),DOSE=$G(ORDIALOG(INSTR,INST)),(DD,ID)=""
  1. S:$L(DOSE) DD=+$G(ORDIALOG(INSTR,"LIST","D",DOSE))
  1. S:DD ID=$TR($G(ORDOSE("DD",DD,DOSE)),"^","&")
  1. Q ID
  1. ;
  1. RESETID ; -- Reset ORDIALOG(DOSE) nodes for new ORDRUG
  1. ; From EXDOSE^ORCDPS2: Expects PROMPT, DRUG
  1. ;
  1. Q:$G(ORCAT)'="O" N I,ORID,STR,UNT,DOSE,X,FORM
  1. S ORID=$$PTR("DOSE"),STR=+$P(DRUG,U,5),UNT=$P(DRUG,U,6)
  1. S FORM="1.N.""."".N."" ""1"""_UNT_""""
  1. S I=0 F S I=$O(ORDIALOG(PROMPT,I)) Q:I'>0 D
  1. . S DOSE=$G(ORDIALOG(PROMPT,I))
  1. . I DOSE="" Q
  1. . S X=$G(ORDOSE("DD",+ORDRUG,DOSE))
  1. . I '$L(X),STR,DOSE?@FORM D
  1. .. N UD,NOUN S UD=+DOSE/STR,NOUN=$P($G(ORDOSE(1)),U,4)
  1. .. I UD>1,$E(NOUN,$L(NOUN))'="S" S NOUN=NOUN_"S"
  1. .. S X=+DOSE_"&"_UNT_"&"_UD_"&"_NOUN_"&"_DOSE_"&"_+ORDRUG_"&"_STR_"&"_UNT
  1. . S:$L(X) ORDIALOG(ORID,I)=$TR(X,"^","&") Q
  1. Q
  1. PTR(X) ; -- Return ptr to prompt OR GTX X
  1. Q +$O(^ORD(101.41,"AB","OR GTX "_X,0))