source: FOIAVistA/trunk/r/ORDER_ENTRY_RESULTS_REPORTING-OR-OCX--ORRC--ORRJ/ORCDPS2.m@ 995

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

initial load of FOIAVistA 6/30/08 version
File size: 8.8 KB
Line 
1ORCDPS2 ;SLC/MKB-Pharmacy dialog utilities ;07:24 AM 5 Apr 2001 [12/31/01 6:35pm]
2 ;;3.0;ORDER ENTRY/RESULTS REPORTING;**94,116,125,131**;Dec 17, 1997
3 ;
4COMPLEX() ; -- Single or complex dose?
5 N X,Y,DIR,DUOUT,DTOUT,COMPLX
6 S COMPLX=$S($O(ORDIALOG(PROMPT,"?"),-1)>1:1,$L($G(ORDIALOG($$PTR("DURATION"),1))):1,1:0)
7 I $G(ORTYPE)="Q",$O(ORDIALOG(PROMPT,0)),FIRST Q COMPLX
8 I $D(ORENEW)!$D(OREWRITE)!$D(ORXFER)!COMPLX Q COMPLX
9 I $D(OREDIT) Q:$D(ORCOMPLX)!COMPLX COMPLX G CP1 ;Q if complex or 'first, else ask
10 I 'FIRST S Y=$S($D(ORCOMPLX):ORCOMPLX,1:COMPLX) Q Y
11CP1 S DIR(0)="YA",DIR("A")="Complex dose? ",DIR("B")="NO"
12 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."
13 D ^DIR S:$D(DTOUT) Y="^"
14 Q Y
15 ;
16DOSES ; -- Get available common doses
17 ;S $P(ORDIALOG(PROMPT,0),U,2)=$S(ORCAT="I":"1:20",1:"1:80")
18 S ORDIALOG(PROMPT,"A")="Dose"_$S(ORCAT="I"&$G(ORIV):" or Rate: ",1:": ")
19 S $P(ORDIALOG(PROMPT,"?"),",",2)=$S($G(ORIV):" as either a dose amount or infusion rate.",1:" as a dose or amount.")
20 I FIRST,'$O(ORDIALOG(PROMPT,0)),$G(ORXFER) D SHOWSIG^ORCMED
21 S ORCOMPLX=$$COMPLEX,MULT=+ORCOMPLX I ORCOMPLX="^" S ORQUIT=1 Q
22 Q:$G(ORDIALOG(PROMPT,"LIST")) Q:'$D(ORDOSE)
23D1 ; -- enter here from ORCMED,NF^ORCDPS to build list
24 N I,J,X,DD,DRUG,DOSE,CONJ,CNT,UD,COST,TEXT
25 S (I,CNT)=0,CONJ=$P($G(ORDOSE("MISC")),U,3) S:$L(CONJ) CONJ=" "_CONJ
26 F S I=$O(ORDOSE(I)) Q:I'>0 D
27 . S X=ORDOSE(I),DD=+$P(X,U,6),DRUG=ORDOSE("DD",DD)
28 . ; =TotalDose^Units^U/D^Noun^LocalDose^DispDrugIEN^Cost
29 . ;DD=Name^Cost^NF^DispUnit^Strength^Units^DoseForm^MaxRefills?
30 . S DOSE=$P(X,U,5),UD=$P(X,U,3),COST=$P(X,U,7) Q:'$L(DOSE)
31 . 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))
32 . ;I UD S COST="$"_$J(UD*$P(DRUG,U,2),1,3) ;_" per "_UD_" "_$P(X,U,4)
33 . S TEXT=DOSE_$S($L(COST):" $"_COST,1:"")_$S($P(DRUG,U,3):" (non-formulary)",1:"")
34 . S CNT=CNT+1,ORDIALOG(PROMPT,"LIST",CNT)=DOSE_U_TEXT
35 . S ORDIALOG(PROMPT,"LIST","B",TEXT)=DOSE
36 . S ORDIALOG(PROMPT,"LIST","D",DOSE)=DD ;default DispDrug
37 . S ORDOSE("DD",DD,DOSE)=$P(ORDOSE(I),U,1,6)_U_$P(DRUG,U,5,6)
38 . S J=0 F S J=$O(ORDOSE(I,J)) Q:J'>0 D ;xref alt forms of dose
39 .. S DD=+$P(ORDOSE(I,J),U,6),DRUG=$G(ORDOSE("DD",DD))
40 .. S ORDOSE("DD",DD,DOSE)=$P(ORDOSE(I,J),U,1,6)_U_$P(DRUG,U,5,6)
41 S:CNT ORDIALOG(PROMPT,"LIST")=CNT
42 Q
43 ;
44CHDOSE ; -- kill dependent values if inst ORI of dose changes
45 N X,PROMPTS,P,NAME,DOSE,DD S X=$G(ORDIALOG(PROMPT,ORI))
46 S X=$$UP^XLFSTR(X),ORDIALOG(PROMPT,ORI)=X ;force uppercase
47 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
48 I $L(X)>60,'$D(ORDIALOG(PROMPT,"LIST","B",X)) K DONE W $C(7),!,"Instructions may not be longer than 60 characters." Q
49 I $G(ORESET)'=X D ;kill dependent values if new/changed dose
50 . S PROMPTS="STRENGTH^DRUG NAME^DOSE^DISPENSE DRUG^DAYS SUPPLY^QUANTITY^REFILLS"
51 . F P=1:1:$L(PROMPTS,U) S NAME=$P(PROMPTS,U,P) K ORDIALOG($$PTR(NAME),ORI)
52 . K ORQTY,ORQTYUNT,ORDRUG,ORDIALOG($$PTR("DISPENSE DRUG"),1)
53 . K ^TMP("ORWORD",$J,$$PTR("SIG"))
54 S DOSE=$$PTR("DOSE") I $L(X),'$L($G(ORDIALOG(DOSE,ORI))) D ;set ID
55 . S DD=+$G(ORDIALOG(PROMPT,"LIST","D",X))
56 . S:DD ORDIALOG(DOSE,ORI)=$TR($G(ORDOSE("DD",DD,X)),"^","&")
57 S DD=+$P($G(ORDIALOG(DOSE,ORI)),"&",6)
58 I DD,$P($G(ORDOSE("DD",DD)),U,3) D NF^ORCDPS(DD) ;look for FormAlt
59 Q
60 ;
61EXDOSE ; -- Dose Exit Action
62 Q:'$O(ORDIALOG(PROMPT,0)) N DRUG,MISC,QUIT,LAST
63 S ORDRUG=$$DISPDRUG^ORCDPS,DRUG=$G(ORDOSE("DD",+ORDRUG))
64 I ORDRUG D I $G(QUIT) S ORQUIT=1 Q
65 . ;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
66 . ;I $P(DRUG,U,10)=1 W $C(7),!,"This order will require a wet signature!"
67 . S ORDIALOG($$PTR("DISPENSE DRUG"),1)=ORDRUG
68 . D:$G(ORCAT)="O" RESETID^ORCDPS
69 . N STR,MED S STR=$P(DRUG,U,5)_$P(DRUG,U,6)
70 . I STR'>0 S:'$G(ORDOSE(1)) ORDIALOG($$PTR("DRUG NAME"),1)=$P(DRUG,U) Q
71 . S MED=$P($G(^ORD(101.43,+$G(OROI),0)),U)
72 . I MED'[STR,ORCAT="O"!'$G(ORDOSE(1)) S ORDIALOG($$PTR("STRENGTH"),1)=STR
73 I +ORDRUG'>0,ORCAT="O" W $C(7),!,"Cannot determine dispense drug - some defaults and order checks may not occur!"
74EXD1 ; -kill dangling conjunction, [re]build Sig, get Qty info
75 S LAST=$O(ORDIALOG(PROMPT,"?"),-1) K ORDIALOG($$PTR("AND/THEN"),LAST)
76 D ADMIN^ORCDPS3 D:$G(ORTYPE)'="Z" SIG ;[re]build Sig/Text
77 I ORDRUG,ORCAT="O" D ;set Qty info
78 . S:$L($P(DRUG,U,4)) ORQTYUNT=$P(DRUG,U,4)
79 . S MISC=$$ENDCM^PSJORUTL(+ORDRUG),ORQTY=$P(MISC,U,4)
80 . W:$L($P(MISC,U,2)) !!,$P(MISC,U,2),!
81 Q
82 ;
83SIG ; -- Create ORDIALOG(SIG) from Instructions PROMPT,ORDOSE,ORDRUG,ORCAT
84 ; Return text in ^TMP("ORWORD",$J,SIG,INST)
85 ; [also called from PSJ^ORCSEND1 to build child orders]
86 ;
87 N ORT,ORSCH,ORDUR,ORID,ORDD,ORCNJ,ORMISC,ORPREP,ORX,ORI,CNT,ORSIG,ORS,DOSE
88 S ORT=$$PTR("ROUTE"),ORSCH=$$PTR("SCHEDULE"),ORDUR=$$PTR("DURATION")
89 S ORID=$$PTR("DOSE"),ORCNJ=$$PTR("AND/THEN"),ORS=$$PTR("SIG")
90 S ORMISC=$G(ORDOSE("MISC")),ORPREP=$P(ORMISC,U,2)
91 S ORX=$S(ORCAT="I":"",$L($P(ORMISC,U)):$P(ORMISC,U)_" ",1:"") ;"TAKE "
92 S (CNT,ORI)=0 F S ORI=$O(ORDIALOG(PROMPT,ORI)) Q:ORI'>0 D
93 . S DOSE=$G(ORDIALOG(PROMPT,ORI)) Q:'$L(DOSE)
94 . S ORX=ORX_$$DOSE_$$RTE_$$SCH_$$DUR_$$CONJ
95 . S CNT=CNT+1,ORSIG(CNT,0)=ORX,ORX=""
96 Q:CNT'>0 S ORSIG(0)="^^"_CNT_U_CNT_U_DT_U
97 K ^TMP("ORWORD",$J,ORS,1) M ^(1)=ORSIG S ORDIALOG(PROMPT,"FORMAT")="@"
98 S ORDIALOG(ORS,1)=$NA(^TMP("ORWORD",$J,ORS,1))
99 Q
100 ;
101PTR(X) ; -- Return ptr to prompt OR GTX X
102 Q +$O(^ORD(101.41,"AB","OR GTX "_X,0))
103 ;
104DOSE() ; -- Return dosage
105 N X0,Y S X0=$G(ORDIALOG(ORID,ORI)) ;ID string
106 S Y=DOSE I ORDRUG,$L(X0) D ;use local dose if common DispDrug
107 . S:$L($P(X0,"&",5)) Y=$P(X0,"&",5) ;unless Outpt w/total dose
108 . I ORCAT="O",X0 S Y=$$WORD($P(X0,"&",3))_" "_$P(X0,"&",4) ;u/d
109 Q Y
110 ;
111WORD(X) ; -- Return words for number X
112 N X1,X2,Y S X1=$P(+X,"."),X2=$P(+X,".",2)
113 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)
114 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)
115 Q Y
116 ;
117RTE() ; -- Return expansion of route
118 N X,X0,Y S X=+$G(ORDIALOG(ORT,ORI)) Q:X'>0 ""
119 S X0=$G(^PS(51.2,+X,0)),Y=""
120 I ORCAT="I" S Y=" "_$S($L($P(X0,U,3)):$P(X0,U,3),1:$P(X0,U))
121 I ORCAT="O" S Y=" "_$S($L(ORPREP):ORPREP_" ",1:"")_$S($L($P(X0,U,2)):$P(X0,U,2),1:$P(X0,U))
122 Q Y
123 ;
124SCH() ; -- Return [outpatient] expansion of schedule
125 N X,Y S X=$G(ORDIALOG(ORSCH,ORI))
126 I $L(X),ORCAT="O" D SCH^PSSUTIL1(.X)
127 S Y=$S($L(X):" "_X,1:"")
128 Q Y
129 ;
130DUR() ; -- Return duration
131 N X,Y S X=$G(ORDIALOG(ORDUR,ORI)),Y=""
132 I X S Y=" FOR "_$$UP^XLFSTR(X)_$S(+X=X:" DAYS",1:"")
133 Q Y
134 ;
135CONJ() ; -- Return conjuction
136 N X,Y S X=$G(ORDIALOG(ORCNJ,ORI))
137 S:$L(X)>1 X=$E(X) S:X="E" S="X"
138 S Y=$S(X="T":", THEN",X="X":" EXCEPT",X="A":" AND",1:"")
139 Q Y
140 ;
141DOSETEXT ; -- Reset dose text in ORDIALOG(INSTR) for backdoor orders
142 ; [Called from ORMPS1 - uses ORCAT,PSOI,ORVP,DRUG,INSTR,DOSE]
143 ;
144 N ORTYPE,ORDOSE,CONJ,ORDRUG,DRUG0,STRG,ORI,LDOSE,X,PROMPT
145 S ORTYPE=$S($G(ORCAT)="I":"U",1:"O")
146 D DOSE^PSSORUTL(.ORDOSE,+PSOI,ORTYPE,+ORVP)
147 S CONJ=$P($G(ORDOSE("MISC")),U,3) S:$L(CONJ) CONJ=" "_CONJ
148 S ORDRUG=+$G(ORDIALOG(DRUG,1)),DRUG0=$G(ORDOSE("DD",ORDRUG))
149 S STRG=$P(DRUG0,U,5)_$P(DRUG0,U,6)
150 I '$G(ORDOSE(1)) S ORI=0 F S ORI=$O(ORDIALOG(INSTR,ORI)) Q:ORI'>0 D
151 . S LDOSE=$G(ORDIALOG(INSTR,ORI)),X=$G(ORDIALOG(DOSE,ORI)) Q:'$L(X)
152 . S:'X ORDIALOG(INSTR,ORI)=LDOSE_CONJ_" "_$S(STRG:STRG,1:$P(DRUG0,U))
153 ; -build Sig/Text if not defined
154 I '$D(ORDIALOG(+$$PTR("SIG"),1)) S PROMPT=INSTR D SIG
155 Q
156 ;
157PI ; -- Include Patient Instructions w/Sig in Outpt order?
158 N X,Y,DIR,DUOUT,DTOUT,DIRUT,ORTX,ORMAX,I,CNT
159 I $G(ORCAT)'="O" D CLEARWP Q ;!'$O(ORDOSE("PI",0))
160 Q:$G(ORENEW) S I=0,ORMAX=57
161 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))
162 I '$O(ORDOSE("PI",0)) D CLEARWP Q
163 F S I=$O(ORDOSE("PI",I)) Q:I'>0 S X=ORDOSE("PI",I) D TXT^ORCHTAB
164 S DIR(0)="YA",DIR("A")="Include Patient Instructions in Sig? "
165 S DIR("?")="Enter NO if you do not want these instructions included in the sig for this order",DIR("B")="YES"
166 W ! S I=0 F S I=$O(ORTX(I)) Q:I'>0 W !,$S(I=1:"Patient Instructions: ",1:" ")_ORTX(I)
167 D ^DIR I $D(DUOUT)!$D(DTOUT) S ORQUIT=1 Q
168 I Y D Q ;save text
169 . K ^TMP("ORWORD",$J,PROMPT,INST) S CNT=0
170 . S I=0 F S I=$O(ORDOSE("PI",I)) Q:I'>0 S ^TMP("ORWORD",$J,PROMPT,INST,I,0)=ORDOSE("PI",I),CNT=CNT+1
171 . S ^TMP("ORWORD",$J,PROMPT,INST,0)="^^"_CNT_U_CNT_U_DT_U
172 . S ORDIALOG(PROMPT,INST)="^TMP(""ORWORD"","_$J_","_PROMPT_","_INST_")"
173 I Y'>0 K ORDIALOG(PROMPT,INST),^TMP("ORWORD",$J,PROMPT,INST)
174 Q
175 ;
176CLEARWP ; -- Clear INST of wp field PROMPT
177 K ORDIALOG(PROMPT,INST),^TMP("ORWORD",$J,PROMPT,INST)
178 Q
Note: See TracBrowser for help on using the repository browser.