source: WorldVistAEHR/trunk/r/ORDER_ENTRY_RESULTS_REPORTING-OR-OCX--ORRC--ORRJ/ORWDPS1.m@ 621

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

initial load of WorldVistAEHR
File size: 7.2 KB
RevLine 
[613]1ORWDPS1 ; SLC/KCM/JLI - Pharmacy Calls for Windows Dialog; 03/10/2008
2 ;;3.0;ORDER ENTRY/RESULTS REPORTING;**85,132,141,163,215,255,243**;Dec 17, 1997;Build 242
3 ;
4ODSLCT(LST,PSTYPE,DFN,LOC) ; return default lists for dialog
5 ; PSTYPE: pharmacy type (U=unit dose, F=IV fluids, O=outpatient)
6 N ILST S ILST=0
7 S ILST=ILST+1,LST(ILST)="~Priority" D PRIOR
8 S ILST=ILST+1,LST(ILST)="~DispMsg"
9 S ILST=ILST+1,LST(ILST)="d"_$$DISPMSG
10 ;
11 ; I PSTYPE="F" D Q ; IV Fluids
12 ; . S ILST=ILST+1,LST(ILST)="~ShortList" D SHORT
13 ;
14 I PSTYPE="O" D ; Outpatient
15 . S ILST=ILST+1,LST(ILST)="~Refills"
16 . S ILST=ILST+1,LST(ILST)="d0^0"
17 . S ILST=ILST+1,LST(ILST)="~Pickup"
18 . S ILST=ILST+1,LST(ILST)="d"_$$DEFPICK($G(LOC))
19 . ; S ILST=ILST+1,LST(ILST)="~Supply"
20 . ; S ILST=ILST+1,LST(ILST)="d^"_$$DEFSPLY(DFN)
21 Q
22PKI(ORY,OI,PSTYPE,ORVP,PKIACTIV) ; return DEA Schedule for drug
23 N ILST,ORDOSE,ORWPSOI,ORWDOSES,X1,X2,X
24 K ^TMP("PSJINS",$J),^TMP("PSJMR",$J),^TMP("PSJNOUN",$J),^TMP("PSJSCH",$J),^TMP("PSSDIN",$J)
25 S ILST=0
26 S ORWPSOI=0
27 S:+OI ORWPSOI=+$P($G(^ORD(101.43,+OI,0)),U,2)
28 D START^PSSJORDF(ORWPSOI,$S(PSTYPE="U":"I",1:"O")) ; dflt route, schedule, etc.
29 I '$L($T(DOSE^PSSOPKI1)) D DOSE^PSSORUTL(.ORDOSE,ORWPSOI,PSTYPE,ORVP) ; dflt doses
30 I $L($T(DOSE^PSSOPKI1)) D DOSE^PSSOPKI1(.ORDOSE,ORWPSOI,PSTYPE,ORVP) ; dflt doses NEW PKI CODE from pharmacy
31 D EN^PSSDIN(ORWPSOI) ; nfi text
32 S ORY="" ;PKI
33 I $D(ORDOSE("DEA")) S X="",X1=$P(ORDOSE("DEA"),";"),X2=$P(ORDOSE("DEA"),";",2) D
34 . I '$L(X2) Q
35 . I $G(PKIACTIV) S X=X2
36 S ORY=X
37 K ^TMP("PSJINS",$J),^TMP("PSJMR",$J),^TMP("PSJNOUN",$J),^TMP("PSJSCH",$J),^TMP("PSSDIN",$J)
38 Q
39PRIOR ; from DLGSLCT, get list of allowed priorities
40 N X,XREF
41 S XREF=$S(PSTYPE="O":"S.PSO",1:"S.PSJ")
42 S X="" F S X=$O(^ORD(101.42,XREF,X)) Q:'$L(X) D
43 . I XREF["PSJ",X'="ASAP",X'="ROUTINE",X'="STAT" Q
44 . S ILST=ILST+1,LST(ILST)="i"_$O(^ORD(101.42,XREF,X,0))_U_X
45 S ILST=ILST+1,LST(ILST)="d"_$O(^ORD(101.42,"B","ROUTINE",0))_U_"ROUTINE"
46 Q
47DEFPICK(LOC) ; return default routing
48 N X,DLG,PRMT
49 S DLG=$O(^ORD(101.41,"AB","PSO OERR",0)),X=""
50 S PRMT=$O(^ORD(101.41,"AB","OR GTX ROUTING",0))
51 I $D(^TMP("ORECALL",$J,+DLG,+PRMT,1)) S X=^(1)
52 I X'="" S EDITONLY=1 Q X ; EDITONLY used by default action
53 ;
54 ;S X=$$GET^XPAR("ALL^"_"LOC.`"_LOC,"ORWDPS ROUTING DEFAULT",1,"I")
55 S X=$$GET^XPAR("LOC.`"_LOC_"^SYS","ORWDPS ROUTING DEFAULT",1,"I")
56 I X="C" S X="C^in Clinic" G XPICK
57 I X="M" S X="M^by Mail" G XPICK
58 I X="W" S X="W^at Window" G XPICK
59 I X="N" S X="" G XPICK
60 I X="" S X=$S($D(^PSX(550,"C")):"M^by Mail",1:"W^at Window")
61XPICK Q X
62 ;
63DEFSPLY(DFN) ; return default days supply for this patient
64 N ORWX
65 S ORWX("PATIENT")=DFN
66 D DSUP^PSOSIGDS(.ORWX)
67 Q $G(ORWX("DAYS SUPPLY"))
68 ;
69DFLTSPLY(VAL,UPD,SCH,PAT,DRG) ; return days supply given quantity
70 ; VAL: default days supply
71 N ORWX,I
72 S ORWX("PATIENT")=PAT
73 I DRG S ORWX("DRUG")=DRG
74 F I=1:1:$L(UPD,U)-1 D
75 . S ORWX("DOSE ORDERED",I)=$P(UPD,U,I)
76 . S ORWX("SCHEDULE",I)=$P(SCH,U,I)
77 D DSUP^PSOSIGDS(.ORWX)
78 S VAL=$G(ORWX("DAYS SUPPLY"))
79 Q
80DISPMSG() ; return 1 to suppress dispense message
81 Q +$$GET^XPAR("ALL","ORWDPS SUPPRESS DISPENSE MSG",1,"I")
82 ;
83DOWSCH(LST,DFN,LOCIEN) ; return all schedules
84 N CNT,FREQ,ILST,ORARRAY,WIEN
85 S WIEN=$$WARDIEN^ORWDPS32(+$G(LOCIEN))
86 D SCHED^PSS51P1(WIEN,.ORARRAY)
87 S ILST=0
88 S CNT=0 F S CNT=$O(ORARRAY(CNT)) Q:CNT'>0 D
89 .S NODE=$G(ORARRAY(CNT))
90 .I $P(NODE,U,4)="C" D
91 ..K ^TMP($J,"ORWDPS1 DOWSCH")
92 ..D ZERO^PSS51P1($P(NODE,U),,,,"ORWDPS1 DOWSCH")
93 ..S FREQ=$G(^TMP($J,"ORWDPS1 DOWSCH",$P(NODE,U),2))
94 ..K ^TMP($J,"ORWDPS1 DOWSCH")
95 ..I +FREQ=0 Q
96 ..I +FREQ>1440 Q
97 ..S ILST=ILST+1,LST(ILST)=$P(ORARRAY(CNT),U,2,5)
98 Q
99 ;
100SCHALL(LST,DFN,LOCIEN) ; return all schedules
101 N CNT,ILST,ORARRAY,WIEN
102 S WIEN=$$WARDIEN^ORWDPS32(+$G(LOCIEN))
103 D SCHED^PSS51P1(WIEN,.ORARRAY)
104 S ILST=0
105 S CNT=0 F S CNT=$O(ORARRAY(CNT)) Q:CNT'>0 D
106 .S ILST=ILST+1,LST(ILST)=$P(ORARRAY(CNT),U,2,5)
107 Q
108 ;
109FORMALT(ORLST,ORIEN,PSTYPE) ; return a list of formulary alternatives
110 N PSID,I
111 S ORIEN=+$P(^ORD(101.43,ORIEN,0),U,2)
112 D EN1^PSSUTIL1(.ORIEN,PSTYPE)
113 S PSID=0,I=0
114 F S PSID=$O(ORIEN(PSID)) Q:'PSID D
115 . S OI=+$O(^ORD(101.43,"ID",PSID_";99PSP",0))
116 . I OI S I=I+1,ORLST(I)=OI,$P(ORLST(I),U,2)=$P(^ORD(101.43,OI,0),U)
117 Q
118DOSEALT(LST,DDRUG,CUROI,PSTYPE) ; return a list of formulary alternatives for dose
119 N I,OI,ORWLST,ILST S ILST=0
120 D ENRFA^PSJORUTL(DDRUG,PSTYPE,.ORWLST)
121 S I=0 F S I=$O(ORWLST(I)) Q:'I D
122 . S OI=+$O(^ORD(101.43,"ID",+$P(ORWLST(I),U,4)_";99PSP",0))
123 . I OI,OI'=CUROI S ILST=ILST+1,LST(ILST)=OI_U_$P(^ORD(101.43,OI,0),U)
124 Q
125QOMEDALT(ORY,ODIEN) ;
126 N ARRAY,IDIEN,ORDERID,PKG,PSTYPE,VALUE
127 S ORY=0,PKG=+$P(^ORD(101.41,ODIEN,0),U,7)
128 S PSTYPE=$S($$GET1^DIQ(9.4,PKG_",",1)="PSO":"O",1:"I")
129 S ORDERID=$O(^ORD(101.41,"B","OR GTX ORDERABLE ITEM","")) Q:ORDERID'>0
130 S IDIEN=$O(^ORD(101.41,ODIEN,6,"D",ORDERID,"")) Q:IDIEN'>0
131 S VALUE=$G(^ORD(101.41,ODIEN,6,IDIEN,1)) Q:VALUE'>0
132 I $P($G(^ORD(101.43,VALUE,"PS")),U,6)=1 S ORY=VALUE
133 ;D FORMALT(.ARRAY,VALUE,PSTYPE) I $D(ARRAY)>0 S ORY=VALUE
134 ;I ORY=0,$P($G(^ORD(101.43,VALUE,"PS")),U,6)=1 S ORY=VALUE
135 Q
136FAILDEA(FAIL,OI,ORNP,PSTYPE) ; return 1 if DEA check fails for this provider
137 N DEAFLG,PSOI,TPKG
138 S FAIL=0,TPKG=$P($G(^ORD(101.43,+$G(OI),0)),U,2)
139 Q:TPKG'["PS"
140 S PSOI=+TPKG Q:PSOI'>0
141 I '$L($T(OIDEA^PSSUTLA1)) Q
142 S DEAFLG=$$OIDEA^PSSUTLA1(PSOI,PSTYPE) Q:DEAFLG'>0
143 I '$L($$DEA^XUSER(,+$G(ORNP))) S FAIL=1
144 Q
145FDEA1(FAIL,OI,OITYPE,ORNP) ; only be called for an outpaitent and IV dialog
146 ;OI: IV Orderable Item
147 ;OITYPE: A:ADDITIVE S:SOLUTION
148 N DEAFLG,PSOI,TKPG
149 S FAIL=0,TPKG=$P($G(^ORD(101.43,+$G(OI),0)),U,2)
150 Q:TPKG'["PS"
151 S PSOI=+TPKG Q:PSOI'>0
152 I '$L($T(IVDEA^PSSUTIL1)) Q
153 S DEAFLG=$$IVDEA^PSSUTIL1(PSOI,OITYPE) Q:DEAFLG'>0
154 I '$L($P($G(^VA(200,+$G(ORNP),"PS")),U,2)),'$L($P($G(^("PS")),U,3)) S FAIL=1
155 Q
156 ;
157CHK94(VAL) ; return 1 if patch 94 has been installed
158 S VAL=0
159 I $O(^ORD(101.41,"B","PS MEDS",0)) S VAL=1
160 Q
161LOCPICK(Y,LOC) ; return default Location level routing
162 S Y=""
163 S Y=$$GET^XPAR("LOC.`"_LOC_"^SYS","ORWDPS ROUTING DEFAULT",1,"I")
164 I Y="C" S Y="C^in Clinic"
165 I Y="M" S Y="M^by Mail"
166 I Y="W" S Y="W^at Window"
167 I Y="N" S Y=""
168 Q
169HASOIPI(Y,QOID) ; Check if QO put orderable item's PI into Sig
170 N PIIEN,OIX
171 S Y=0
172 Q:'$D(^ORD(101.41,QOID,0))
173 S PIIEN=$O(^ORD(101.41,"B","OR GTX PATIENT INSTRUCTIONS",0))
174 Q:'PIIEN
175 S OIX=0
176 Q:'$D(^ORD(101.41,QOID,6,"D"))
177 F S OIX=$O(^ORD(101.41,+QOID,6,"D",OIX)) Q:'OIX D
178 . I OIX=PIIEN S Y=1 Q
179 Q
180HASROUTE(Y,QOID) ;Check if QO has a ROUTE defined
181 N ROUTID
182 S Y=0,ROUTID=0
183 S ROUTID=$O(^ORD(101.41,"B","OR GTX ROUTING",0))
184 Q:'ROUTID
185 Q:'$D(^ORD(101.41,+QOID))
186 I $D(^ORD(101.41,+QOID,6,"D",ROUTID)) S Y=1
187 Q
188QOCHECK(ORY,DIEN) ;
189 N ARY,DG,FORMIEN,NAME,OI,OIIEN,ORDIALOG,ORPKG,TYPE
190 S ORPKG=$$NMSP^ORCD($P($G(^ORD(101.41,DIEN,0)),U,7)) Q:ORPKG'["PS"
191 S DG=$P(^ORD(101.41,DIEN,0),U,5)
192 S NAME=$P(^ORD(100.98,DIEN,0),U)
193 S TYPE=$S(NAME="INPATIENT MEDICATIONS":"I",NAME="OUTPATIENT MEDICATIONS":"O",1:"")
194 I TYPE="" Q
195 S ORDIALOG=$$DEFDLG^ORCD(DIEN) Q:ORDIALOG
196 D GETDLG^ORCD(ORDIALOG),GETORDER^ORCD("^ORD(101.41,"_DIEN_",6)")
197 I $D(ORDIALOG)'>0 Q
198 S OI=$P($G(ORDIALOG("B","ORDERABLE")),U,2) Q:OI'>0
199 S OIIEN=$G(ORDIALOG(OI,1)) Q:OIIEN'>0
200 D FORMALT(.ARY,OIIEN,TYPE) I $D(ARY)'>0 Q
201 S ORY=OIIEN
202 Q
Note: See TracBrowser for help on using the repository browser.