source: WorldVistAEHR/trunk/r/ORDER_ENTRY_RESULTS_REPORTING-OR-OCX--ORRC--ORRJ/ORCDPS.m@ 1608

Last change on this file since 1608 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR
File size: 6.8 KB
RevLine 
[613]1ORCDPS ;SLC/MKB-Pharmacy dialog utilities ;02:36 PM 2 Apr 2001
2 ;;3.0;ORDER ENTRY/RESULTS REPORTING;**4,38,62,86,94,129**;Dec 17, 1997
3 ;
4 ; ** Keep for backwards compatibility, just in case:
5 ;
6CHANGED(TYPE) ; -- Kill dependent values when OI changes
7 N PROMPTS,NAME,PTR,P,I
8 Q:'$L($G(TYPE)) S PROMPTS=""
9 I TYPE="U" S PROMPTS="DISPENSE DRUG^INSTRUCTIONS^ROUTE" K ORSCHED,ORQTY
10 I TYPE="O" S PROMPTS="DISPENSE DRUG^INSTRUCTIONS^FREE TEXT^ROUTE^SCHEDULE^DURATION" K ORSCHED,ORQTY
11 S:TYPE="IVB" PROMPTS="VOLUME"
12 S:TYPE="IVA" PROMPTS="STRENGTH PSIV^UNITS"
13 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
14 S:TYPE="XFR" PROMPTS="DISPENSE DRUG^INSTRUCTIONS^FREE TEXT^DURATION^QUANTITY^REFILLS^ROUTING^START DATE^SERVICE CONNECTED"
15 F P=1:1:$L(PROMPTS,U) S NAME=$P(PROMPTS,U,P) D
16 . S PTR=$O(^ORD(101.41,"AB","OR GTX "_NAME,0)) Q:'PTR
17 . S I=0 F S I=$O(ORDIALOG(PTR,I)) Q:I'>0 K ORDIALOG(PTR,I)
18 . K ORDIALOG(PTR,"LIST")
19 Q
20 ;
21ASKSC() ; -- Return 1 or 0, if SC prompt should be asked
22 I $L($T(SC^PSOCP)),$$SC^PSOCP(+ORVP,+$G(ORDRUG)) Q 0 ;exempt from copay
23 I $$RXST^IBARXEU(+ORVP)>0 Q 0 ;exempt from copay
24 Q 1
25 ;
26INSTR(OI) ; -- Get allowable instructions and routes
27 N PSOI,INSTR,NOUN,I,X,CNT
28 K ^TMP("PSJINS",$J),^TMP("PSJMR",$J),^TMP("PSJNOUN",$J),ORLEAD,ORNOUNS,ORSCHED
29 S PSOI=+$P($G(^ORD(101.43,+OI,0)),U,2) D START^PSSJORDF(PSOI)
30 S:$L($G(^TMP("PSJSCH",$J))) ORSCHED=^($J) ;default schedule
31 Q:$P($G(^ORD(100.98,+ORDG,0)),U,3)'="O RX" ; Don't need nouns for Inpt
32 S NOUN=$$PTR^ORCD("OR GTX FREE TEXT"),ORNOUNS="",(I,CNT)=0
33 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
34 S ORDIALOG(NOUN,"LIST")=CNT_"^1",INSTR=$$PTR^ORCD("OR GTX INSTRUCTIONS")
35 S I=$O(^TMP("PSJINS",$J,0)),X=$P($G(^TMP("PSJINS",$J,+I)),U)
36 S:$L(X) ORLEAD=$$LOWER^VALM1(X),ORDIALOG(INSTR,"TTL")=ORLEAD_": "
37 S ORDIALOG(INSTR,"A")=$S($L($G(ORLEAD)):ORLEAD,1:"Amount")_$S($L(ORNOUNS):" (in "_ORNOUNS_")",1:"")_": "
38 Q
39 ;
40CHOICES(TYPE) ; -- Get list of allowable dispense drugs
41 Q:$D(ORDIALOG(PROMPT,"LIST")) N OI,PSJOI,I,X,Y,ORX,ORY
42 S OI=$$VAL^ORCD("MEDICATION"),PSJOI="^^^"_+$P($G(^ORD(101.43,+OI,0)),U,2)
43 S ORX=$T(ENDD^PSJORUTL),ORX=$L($P(ORX,";"),",")
44 I ORX>3 D ENDD^PSJORUTL(PSJOI,TYPE,.ORY,+ORVP) Q:ORY'>0
45 I ORX'>3 D ENDD^PSJORUTL(PSJOI,TYPE,.ORY) Q:ORY'>0
46 F I=1:1:ORY S X=$P(ORY(I),U,2),ORY("B",X)=ORY(I) K ORY(I) ; sort
47 S I=0,ORX="" W !
48 F S ORX=$O(ORY("B",ORX)) Q:ORX="" S X=ORY("B",ORX),I=I+1 D
49 . 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)
50 . S:$P(X,U,4) Y=Y_" (non-formulary)"
51 . S:$P(X,U,3) Y=Y_" $"_$P(X,U,3)_$S($L($P(X,U,5)):" per "_$P(X,U,5),1:"")
52 . 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)
53 S ORDIALOG(PROMPT,"LIST")=ORY_"^1" ; total^list only
54 Q
55 ;
56 ; ** End of old code
57 ;
58NF(DRUG) ; -- Get alternatives for non-formulary drugs
59 ; [Called from P-S Action for Dose]
60 N TYPE,ORY,I,DD,PSOI,ORPSOI,X,Y,DUOUT,DTOUT
61 Q:'$G(DRUG) Q:$G(ORENEW)
62 S TYPE=$S($G(ORCAT)="I":"U",1:"O")
63 D ENRFA^PSJORUTL(DRUG,TYPE,.ORY)
64 S ORPSOI=+$P($G(^ORD(101.43,+$G(OROI),0)),U,2)
65 S (I,DD)=0 I ORY F S DD=$O(ORY(DD)) Q:DD'>0 D ;build list of choices
66 . S PSOI=$P(ORY(DD),U,4,5) Q:PSOI=ORPSOI Q:$G(ORY("PS",+PSOI))
67 . S I=I+1,ORY("B",I)=PSOI,ORY("PS",+PSOI)=I
68 I '$P($G(^ORD(101.43,+$G(OROI),"PS")),U,6) D ;skip if OI is NF
69 . W !!,"*** The dispense drug for this dose is not in the formulary! ***"
70 . W:'ORY!('I) !," There are no formulary alternatives entered for this item."
71 . W !," Please consult with your pharmacy before ordering this dose."
72NF1 Q:'ORY!('I) D Q:$G(ORQUIT) ;Q if no different choices
73 . N DIR S DIR(0)="NAO^1:"_ORY
74 . S DIR("A")="Select alternative (or <return> to continue): "
75 . 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)
76 . 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."
77 . W !," Formulary alternative orderable items:"
78 . D ^DIR S:$D(DTOUT)!($D(DUOUT)) ORQUIT=1
79 I Y D ; reset OI, doses
80 . S PSOI=+ORY("B",Y),X=+$O(^ORD(101.43,"ID",PSOI_";99PSP",0))
81 . Q:'X Q:X=OROI ;error or same OI
82 . S ORDIALOG($$PTR^ORCD("OR GTX ORDERABLE ITEM"),1)=X
83 . D CHANGED^ORCDPS1("OI"),OI2^ORCDPS1,D1^ORCDPS2 ;get new doses
84 . D:$G(ORDIALOG(PROMPT,"LIST")) LIST^ORCD K DONE,ORESET
85 . S DIR("A")=ORDIALOG(PROMPT,"A"),(ORI,INST)=1 ;reset if complex
86 Q
87 ;
88DISPDRUG() ; -- Get Dispense Drug from dose selection(s) [from EXDOSE^ORCDPS2]
89 ; Expects PROMPT, ORDIALOG(), ORDOSE()
90 ;
91 N DD,FORM,I,DOSE,X,ORID,OK,STR,ORX,HALFOK
92 S DD=$G(ORDIALOG($$PTR("DISPENSE DRUG"),1)) I DD Q DD ;already have
93 S DD="",FORM="1.N.""."".N."" ""1"""_$P($G(ORDOSE(1)),U,2)_""""
94 S I=0 F S I=$O(ORDIALOG(PROMPT,I)) Q:I'>0 D Q:DD="^"
95 . S DOSE=$G(ORDIALOG(PROMPT,I)),X=""
96 . S:$L(DOSE) X=$G(ORDIALOG(PROMPT,"LIST","D",DOSE))
97 . I X="" S DD=$S($G(ORCAT)="I":"^",'$G(ORDOSE(1)):"^",DOSE'?@FORM:"^",1:0) Q
98 . S:DD="" DD=X I X'=DD S DD=$S($G(ORCAT)="I":"^",1:0) Q
99 Q:DD DD Q:DD="^" "" ;all same, or not possible
100 S ORID=$$PTR("DOSE"),DD=0 F S DD=$O(ORDOSE("DD",DD)) Q:DD'>0 D
101 . S OK=1,STR=+$P($G(ORDOSE("DD",DD)),U,5),HALFOK=+$P($G(ORDOSE("DD",DD)),U,11)
102 . S I=0 F S I=$O(ORDIALOG(PROMPT,I)) Q:I'>0 D Q:'OK
103 .. S DOSE=$G(ORDIALOG(PROMPT,I))
104 .. I '$G(ORDOSE(1)) D Q ;local doses
105 ... S X=$G(ORDOSE("DD",DD,DOSE)) I X="" S OK=0 K ORX(DD) Q
106 ... S ORX(DD,I)=DOSE,ORX(DD)=""
107 .. S X=+$G(ORDIALOG(ORID,I)) S:X'>0 X=+DOSE S X=X/STR
108 .. I (X?1.N)!(HALFOK&(X?.N.1".5")) S ORX(DD,I)=X S:X>$G(ORX(DD)) ORX(DD)=X Q
109 .. K ORX(DD) S OK=0
110 I '$G(ORDOSE(1)) S DD=$O(ORX(0)) Q DD ;first one
111 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
112 Q DD
113 ;
114ID() ; -- Return ID string for dose instance INST
115 N INSTR,DD,DOSE,ID
116 S INSTR=$$PTR("INSTRUCTIONS"),DOSE=$G(ORDIALOG(INSTR,INST)),(DD,ID)=""
117 S:$L(DOSE) DD=+$G(ORDIALOG(INSTR,"LIST","D",DOSE))
118 S:DD ID=$TR($G(ORDOSE("DD",DD,DOSE)),"^","&")
119 Q ID
120 ;
121RESETID ; -- Reset ORDIALOG(DOSE) nodes for new ORDRUG
122 ; From EXDOSE^ORCDPS2: Expects PROMPT, DRUG
123 ;
124 Q:$G(ORCAT)'="O" N I,ORID,STR,UNT,DOSE,X,FORM
125 S ORID=$$PTR("DOSE"),STR=+$P(DRUG,U,5),UNT=$P(DRUG,U,6)
126 S FORM="1.N.""."".N."" ""1"""_UNT_""""
127 S I=0 F S I=$O(ORDIALOG(PROMPT,I)) Q:I'>0 D
128 . S DOSE=$G(ORDIALOG(PROMPT,I)),X=$G(ORDOSE("DD",+ORDRUG,DOSE))
129 . I '$L(X),STR,DOSE?@FORM D
130 .. N UD,NOUN S UD=+DOSE/STR,NOUN=$P($G(ORDOSE(1)),U,4)
131 .. I UD>1,$E(NOUN,$L(NOUN))'="S" S NOUN=NOUN_"S"
132 .. S X=+DOSE_"&"_UNT_"&"_UD_"&"_NOUN_"&"_DOSE_"&"_+ORDRUG_"&"_STR_"&"_UNT
133 . S:$L(X) ORDIALOG(ORID,I)=$TR(X,"^","&") Q
134 Q
135PTR(X) ; -- Return ptr to prompt OR GTX X
136 Q +$O(^ORD(101.41,"AB","OR GTX "_X,0))
Note: See TracBrowser for help on using the repository browser.