source: FOIAVistA/trunk/r/ORDER_ENTRY_RESULTS_REPORTING-OR-OCX--ORRC--ORRJ/ORWDPS2.m

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

initial load of FOIAVistA 6/30/08 version
File size: 9.2 KB
Line 
1ORWDPS2 ; SLC/KCM/JLI - Pharmacy Calls for Windows Dialog
2 ;;3.0;ORDER ENTRY/RESULTS REPORTING;**85,116,125,131,132,148,141,195,215,258**;Dec 17, 1997;Build 7
3 ;
4OISLCT(LST,OI,PSTYPE,ORVP,NEEDPI,PKIACTIV) ; return for defaults for pharmacy orderable item
5 N ILST,ORDOSE,ORWPSOI,ORWDOSES,X1,X2
6 K ^TMP("PSJINS",$J),^TMP("PSJMR",$J),^TMP("PSJNOUN",$J),^TMP("PSJSCH",$J),^TMP("PSSDIN",$J)
7 S ILST=0
8 S ORWPSOI=0
9 S:+OI ORWPSOI=+$P($G(^ORD(101.43,+OI,0)),U,2)
10 D START^PSSJORDF(ORWPSOI,$S(PSTYPE="U":"I",1:"O")) ; dflt route, schedule, etc.
11 I '$L($T(DOSE^PSSOPKI1)) D DOSE^PSSORUTL(.ORDOSE,ORWPSOI,PSTYPE,ORVP) ; dflt doses
12 I $L($T(DOSE^PSSOPKI1)) D DOSE^PSSOPKI1(.ORDOSE,ORWPSOI,PSTYPE,ORVP) ; dflt doses NEW PKI CODE from pharmacy
13 D EN^PSSDIN(ORWPSOI) ; nfi text
14 S ILST=ILST+1,LST(ILST)="~Medication"
15 S ILST=ILST+1,LST(ILST)="d"_OI_U_$S(+OI:$P(^ORD(101.43,OI,0),U),1:"")
16 S ILST=ILST+1,LST(ILST)="~Verb"
17 S ILST=ILST+1,LST(ILST)="d"_$P($G(ORDOSE("MISC")),U)
18 S ILST=ILST+1,LST(ILST)="~Preposition"
19 S ILST=ILST+1,LST(ILST)="d"_$P($G(ORDOSE("MISC")),U,2)
20 I $D(NEEDPI),(NEEDPI="Y") S ILST=ILST+1,LST(ILST)="~PtInstr" D PTINSTR
21 ;S:NEEDPI="Y" ILST=ILST+1,LST(ILST)="~PtInstr" D PTINSTR
22 S ILST=ILST+1,LST(ILST)="~AllDoses" D ALLDOSE ; must do before DOSAGE
23 S ILST=ILST+1,LST(ILST)="~Dosage" D DOSAGE
24 S ILST=ILST+1,LST(ILST)="~Dispense" D DISPLST
25 S ILST=ILST+1,LST(ILST)="~Route" D ROUTE
26 S ILST=ILST+1,LST(ILST)="~Schedule" D SCHED
27 S ILST=ILST+1,LST(ILST)="~Guideline" D GUIDE
28 S ILST=ILST+1,LST(ILST)="~Message" D OIMSG
29 S ILST=ILST+1,LST(ILST)="~DEASchedule" ;PKI
30 ;S ILST=ILST+1,LST(ILST)="d"_$P($G(ORDOSE("DEA")),U) ;PKI
31 S ILST=ILST+1,LST(ILST)="d" ;PKI
32 I $D(ORDOSE("DEA")) S X="",X1=$P(ORDOSE("DEA"),";"),X2=$P(ORDOSE("DEA"),";",2) D
33 . I '$L(X2) Q
34 . I $G(PKIACTIV)="Y" S X=X2
35 S LST(ILST)=LST(ILST)_X
36 I PSTYPE="U" D
37 . ; start, expires, next admin
38 I PSTYPE="O" D
39 . ; days supply, quantity, refills
40 K ^TMP("PSJINS",$J),^TMP("PSJMR",$J),^TMP("PSJNOUN",$J),^TMP("PSJSCH",$J),^TMP("PSSDIN",$J)
41 Q
42 ;
43PTINSTR ; from OISLCT, set up patient instructions
44 N I
45 S I=0 F S I=$O(ORDOSE("PI",I)) Q:I'>0 S ILST=ILST+1,LST(ILST)="t"_ORDOSE("PI",I)
46 Q
47DOSAGE ; from OISLCT, set up the list of dosages
48 ; LST(n)=iDrugName^Strength^NF^... (see BLDDOSE)
49 ; must be called after ALLDOSE so ORWDOSES is set up
50 N I
51 S I=0 F S I=$O(ORWDOSES(I)) Q:I'>0 S ILST=ILST+1,LST(ILST)=ORWDOSES(I)
52 Q
53DISPLST ; from OISLCT, set up list of dispense drugs
54 ; DrugIEN^Strength^Units^Name^Split
55 N DD
56 S DD=0 F S DD=$O(ORDOSE("DD",DD)) Q:'DD D
57 . S ILST=ILST+1
58 . S LST(ILST)="i"_DD_U_$P(ORDOSE("DD",DD),U,5,6)_U_$P(ORDOSE("DD",DD),U)_U_$P(ORDOSE("DD",DD),U,11)
59 Q
60ALLDOSE ; from OISLCT, set up a list of all possible doses
61 ; LST(n)=iDrugName^Strength^NF^... (see BLDDOSE)
62 N I,J,CONJ,DD,DRUG,DDNM,LDOSE,TEXT,STREN,UD,COST,NF,ID,X
63 S CONJ=$P($G(ORDOSE("MISC")),U,3),ORWDOSES=0
64 S:$L(CONJ) CONJ=" "_CONJ_" " S:'$L(CONJ) CONJ=" "
65 S I=0 F S I=$O(ORDOSE(I)) Q:I'>0 D
66 . S X=$$BLDDOSE(ORDOSE(I))
67 . S ORWDOSES=ORWDOSES+1,ORWDOSES(ORWDOSES)=X
68 . S ILST=ILST+1
69 . S LST(ILST)="i"_$P(X,U,5)_U_$P($P(X,U,4),"&",6)_U_$P(X,U,4)
70 . S J=0 F S J=$O(ORDOSE(I,J)) Q:J'>0 D
71 . . S X=$$BLDDOSE(ORDOSE(I,J))
72 . . S ILST=ILST+1
73 . . S LST(ILST)="i"_$P(X,U,5)_U_$P($P(X,U,4),"&",6)_U_$P(X,U,4)
74 Q
75BLDDOSE(X) ; build dose info where X is ORDOSE node
76 ; from ALLDOSE
77 ; X=TotalDose^Units^U/D^Noun^LocalDose^DispDrugIEN
78 ; Y=iDrugName^Strength^NF^TDose&Units&U/D&Noun&LDose&Drug&Stren&Units^
79 ; DoseText^CostText^MaxRefills^DispUnits^CanSplit
80 ; DRUG=Name^Cost^NF^DispUnit^Strength^Units^DoseForm^MaxRefills^
81 ; No TotalDose, use LocalDose
82 ; TotalDose & Strength, use LocalDose+Conjunction+Strength+Units
83 ; TotalDose, No Strength, use LocalDose+Conjunction+DispenseName
84 S DD=+$P(X,U,6),DRUG=ORDOSE("DD",DD),DDNM=$P(DRUG,U),ID=$P(X,U,1,6)
85 S LDOSE=$P(X,U,5),TEXT=LDOSE,STREN=$P(DRUG,U,5)_$P(DRUG,U,6)
86 S $P(ID,U,7)=$P(DRUG,U,5) S $P(ID,U,8)=$P(DRUG,U,6) ; add strength
87 I '$L($P(X,U)),$L($P(DRUG,U,5)) S TEXT=TEXT_CONJ_STREN
88 I '$L($P(X,U)),'$L($P(DRUG,U,5)) S TEXT=TEXT_CONJ_$P(DRUG,U)
89 S UD=$P(X,U,3),COST=$P(X,U,7),NF=$S($P(DRUG,U,3):"NF",1:"")
90 ;I UD S COST="$"_$J(UD*$P(DRUG,U,2),1,3) ;_" per "_UD_" "_$P(X,U,4)
91 S Y="i"_DDNM_U_STREN_U_NF_U_$TR(ID,U,"&")_U_TEXT_U_COST_U_$P(DRUG,U,8)_U_$P(DRUG,U,4)
92 Q Y
93ROUTE ; from OISLCT, get list of routes for the drug form
94 ; ** NEED BOTH ABBREVIATION & NAME IN LIST BOX
95 N I,CNT,ABBR,IEN,ROUT,EXP,X
96 S I="" F S I=$O(^TMP("PSJMR",$J,I)) Q:I="" D
97 . S X=^TMP("PSJMR",$J,I)
98 . S ROUT=$P(X,U),ABBR=$P(X,U,2),IEN=$P(X,U,3),EXP=$P(X,U,4)
99 . S ILST=ILST+1,LST(ILST)="i"_IEN_U_ROUT_U_ABBR_U_EXP_U_$P(X,U,5)
100 . I $P(X,U,6)="D",IEN S ILST=ILST+1,LST(ILST)="d"_IEN_U_ROUT ;_U_ABBR ; assume first always default
101 ; add abbreviations to list of routes, commented out for 15.5 on
102 ; S I="" F S I=$O(^TMP("PSJMR",$J,I)) Q:I="" D
103 ; . S X=^TMP("PSJMR",$J,I)
104 ; . S ROUT=$P(X,U),ABBR=$P(X,U,2),IEN=$P(X,U,3),EXP=$P(X,U,4)
105 ; . I $L(ABBR),(ABBR'=ROUT) S ILST=ILST+1,LST(ILST)="i"_IEN_U_ABBR_" ("_ROUT_")"_U_ABBR_U_EXP
106 Q
107SCHED ; from OISLCT, get default schedule for this medication
108 I $L($G(^TMP("PSJSCH",$J))) S ILST=ILST+1,LST(ILST)="d"_^($J)
109 Q
110GUIDE ; from OISLCT, get guidelines associated with this medication
111 N IEN,I
112 S IEN=0 F S IEN=$O(^TMP("PSSDIN",$J,"OI",ORWPSOI,IEN)) Q:'IEN D
113 . S I=0 F S I=$O(^TMP("PSSDIN",$J,"OI",ORWPSOI,IEN,I)) Q:'I D
114 . . S ILST=ILST+1,LST(ILST)="t"_^TMP("PSSDIN",$J,"OI",ORWPSOI,IEN,I)
115 Q
116OIMSG ; from OISLCT, get the orderable item message for this medication
117 S I=0 F S I=$O(^ORD(101.43,OI,8,I)) Q:I'>0 S ILST=ILST+1,LST(ILST)="t"_^(I,0)
118 Q
119ADMIN(REC,DFN,SCH,OI,LOC) ; return administration time info
120 ; REC: StartText^StartTime^Duration^FirstAdmin
121 S OI=+$P($G(^ORD(101.43,+OI,0)),U,2)
122 S LOC=+$G(^SC(LOC,42)),REC=""
123 I $L($G(^DPT(DFN,.1))) S REC=$$FIRST^ORCDPS3(DFN,LOC,OI,SCH)
124 Q
125REQST(VAL,DFN,SCH,OI,LOC,TXT) ; return requested start time
126 ; VAL: FirstAdmin time
127 S VAL=""
128 Q:'$L($G(SCH)) Q:'$G(OI)
129 S OI=+$P($G(^ORD(101.43,+OI,0)),U,2)
130 S LOC=+$G(^SC(LOC,42))
131 S VAL=$P($$RESOLVE^PSJORPOE(DFN,SCH,OI,TXT,LOC),U,2)
132 Q
133DAY2QTY(VAL,DAY,UPD,SCH,DUR,PAT,DRG) ; return qty for days supply
134 ; VAL: quantity
135 N ORWX,I,X,ADUR,ADURNM
136 S ORWX("DAYS SUPPLY")=DAY
137 S ORWX("PATIENT")=PAT
138 I DRG S ORWX("DRUG")=DRG
139 F I=1:1:$L(UPD,U)-1 D
140 . S ORWX("DOSE ORDERED",I)=$P(UPD,U,I)
141 . S ORWX("SCHEDULE",I)=$P(SCH,U,I)
142 . S ADUR=$P(DUR,U,I),ADURNM=$P($P(ADUR," ",2),"~")
143 . S:ADURNM="MONTHS" X=+ADUR_"L"
144 . S:ADURNM'="MONTHS" X=+ADUR_$E($P(ADUR," ",2))
145 . I $L(X) S ORWX("DURATION",I)=X
146 . S X=$E($P(ADUR,"~",2))
147 . I $L(X) S ORWX("CONJUNCTION",I)=X
148 D QTYX^PSOSIG(.ORWX)
149 S VAL=$G(ORWX("QTY"))
150 Q
151QTY2DAY(VAL,QTY,UPD,SCH,DUR,PAT,DRG) ; return days supply given quantity
152 ; VAL: days supply
153 N ORWX,I,X,ADUR
154 S ORWX("QTY")=QTY
155 S ORWX("PATIENT")=PAT
156 I DRG S ORWX("DRUG")=DRG
157 F I=1:1:$L(UPD,U)-1 D
158 . S ORWX("DOSE ORDERED",I)=$P(UPD,U,I)
159 . S ORWX("SCHEDULE",I)=$P(SCH,U,I)
160 . S ADUR=$P(DUR,U,I),X=+ADUR_$E($P(ADUR," ",2))
161 . I $L(X) S ORWX("DURATION",I)=X
162 . S X=$E($P(ADUR,"~",2))
163 . I $L(X) S ORWX("CONJUNCTION",I)=X
164 D QTYX^PSOSIG(.ORWX)
165 S VAL=$G(ORWX("DAYS SUPPLY"))
166 Q
167MAXREF(VAL,PAT,DRG,SUP,OI,OUT) ; return the maximum number of refills
168 ; PAT=Patient DFN, DRG=ptr50, SUP=days supply, OI=orderable item
169 ; VAL: maximum refills allowed
170 N ORWX
171 S ORWX("PATIENT")=PAT
172 I $G(DRG) S ORWX("DRUG")=+DRG
173 I $G(SUP) S ORWX("DAYS SUPPLY")=SUP
174 I $G(OI) S ORWX("ITEM")=+$P(^ORD(101.43,+OI,0),U,2)
175 I $G(OUT) S ORWX("DISCHARGE")=1
176 D MAX^PSOSIGDS(.ORWX)
177 S VAL=$G(ORWX("MAX"))
178 Q
179SCHREQ(VAL,OI,RTE,DRG) ; return 1 if schedule is required
180 ; OI=orderable item, RTE=ptr route, DRG=ptr dispense drug
181 S VAL=1
182 Q:'$G(OI) Q:'$G(RTE)
183 S VAL=$$SCHREQ^PSJORPOE(RTE,OI,+$G(DRG))
184 Q
185CHKPI(VAL,ODIFN) ; return pre-existing patient instruct
186 N IDNUM,IDPI
187 S (IDNUM,IDPI)=0,VAL=""
188 I '$D(^OR(100,ODIFN,4.5,"ID","PI")) S VAL="" Q
189 F S IDNUM=$O(^OR(100,ODIFN,4.5,"ID","PI",IDNUM)) Q:'IDNUM D
190 . F S IDPI=$O(^OR(100,ODIFN,4.5,IDNUM,2,IDPI)) Q:'IDPI D
191 .. S VAL=VAL_^OR(100,ODIFN,4.5,IDNUM,2,IDPI,0)
192 K IDNUM,IDPI
193 Q
194CHKGRP(VAL,ORIFN) ;
195 ;Inpatient Med Order Group or Clin Meds Group: return 1
196 ;If order belong to Outpatient Med Order Grpoup: return 2
197 ;Otherwise, return 0
198 S VAL=0
199 I '$L(ORIFN) Q
200 N UDGRP,IPGRP,OPGRP,ODGRP,ODID,CLMED
201 S ODID=+ORIFN
202 Q:ODID<1
203 S (UDGRP,IPGRP,OPGRP,ODGRP,CLMED)=0
204 S UDGRP=$O(^ORD(100.98,"B","UD RX",UDGRP))
205 S OPGRP=$O(^ORD(100.98,"B","OUTPATIENT MEDICATIONS",OPGRP))
206 S IPGRP=$O(^ORD(100.98,"B","INPATIENT MEDICATIONS",IPGRP))
207 S CLMED=$O(^ORD(100.98,"B","CLINIC ORDERS",CLMED))
208 S:IPGRP=0 IPGRP=$O(^ORD(100.98,"B","I RX",IPGRP))
209 I $L($G(^OR(100,ODID,0)))<1 Q
210 S ODGRP=$P(^OR(100,ODID,0),U,11)
211 I (UDGRP=ODGRP)!(CLMED=ODGRP) S VAL=1
212 I IPGRP=ODGRP S VAL=1
213 I OPGRP=ODGRP S VAL=2
214 K UDGRP,ODGRP,OPGRP,IPGRP,ODID,CLMED
215 Q
216QOGRP(VAL,QOIFN) ;
217 ;If quick order belong to Inpatient Med Order Group: return 1
218 ;Otherwise, return 0
219 S VAL=0
220 I '$L(QOIFN) Q
221 N UDGRP,IPGRP,QOGRP,QOID,CLMED
222 S QOID=+QOIFN
223 Q:QOID<1
224 S (UDGRP,IPGRP,QOGRP,CLMED)=0
225 S UDGRP=$O(^ORD(100.98,"B","UD RX",UDGRP))
226 S IPGRP=$O(^ORD(100.98,"B","INPATIENT MEDICATIONS",IPGRP))
227 S CLMED=$O(^ORD(100.98,"B","CLINIC ORDERS",CLMED))
228 S:IPGRP=0 IPGRP=$O(^ORD(100.98,"B","I RX",IPGRP))
229 I $L($G(^ORD(101.41,QOID,0)))<1 Q
230 S QOGRP=$P(^ORD(101.41,QOID,0),U,5)
231 I UDGRP=QOGRP S VAL=1
232 I (IPGRP=QOGRP)!(CLMED=QOGRP) S VAL=1
233 K UDGRP,QOGRP,QOID,IPGRP,CLMED
234 Q
Note: See TracBrowser for help on using the repository browser.