source: WorldVistAEHR/trunk/r/ORDER_ENTRY_RESULTS_REPORTING-OR-OCX--ORRC--ORRJ/ORALWORD.m@ 1450

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

initial load of WorldVistAEHR

File size: 7.1 KB
RevLine 
[613]1ORALWORD ; SLC/JMH - Utilities for Checking if an order can be ordered ; 5/10/07 5:55am
2 ;;3.0;ORDER ENTRY/RESULTS REPORTING;**243**;Dec 17, 1997;Build 242
3 ;
4ALLWORD(ORY,DFN,ORX,ORTYPE,PROV) ;
5 N OROI,ORYS,QOIEN,QPIEN,ORCLOZ,QOAA
6 S OROI=0
7 ;
8 ;ORTYPE used to determine the type of data coming into the call
9 ;ORYTPE="E" existing order, ORX equal the IEN from file 100 (used with
10 ;copy,edit functionality)
11 ;ORTYPE="Q" Quick Order, ORX equal the IEN from file 101.43
12 ;ORTYPE="N" New order, ORX equal the IEN from file 101.41
13 ;
14 I ORTYPE="E" S OROI=$G(^OR(100,ORX,.1,1,0))
15 I ORTYPE="Q" D
16 .S QPIEN=$O(^ORD(101.41,"AB","OR GTX ORDERABLE ITEM","")) Q:QPIEN'>0
17 .S QOIEN=$O(^ORD(101.41,ORX,6,"D",QPIEN,"")) Q:QOIEN'>0
18 .S OROI=$G(^ORD(101.41,ORX,6,QOIEN,1))
19 .S QOAA=$P($G(^ORD(101.41,ORX,5)),U,8)
20 I ORTYPE="N" S OROI=ORX
21 Q:OROI'>0
22 S ORY=0
23 ;checks if the orderable item (OROI) is a clozapine med
24 ; if not returns ORY=0
25 S ORCLOZ=$$ISCLOZ(OROI),ORY=ORY_U_ORCLOZ,ORY(0)=U_ORCLOZ
26 Q:'ORCLOZ
27 N ORQUIT
28 S ORQUIT=0
29 I '$G(PROV) S PROV=DUZ
30 I $G(PROV) D
31 .I '$L($$DEA^XUSER(,PROV)) D
32 ..S ORQUIT=1,ORY=1
33 ..S ORQUIT=1,ORY=1
34 ..S ORY(1)="*** You are not authorized to place Clozapine orders."
35 ..S ORY(2)="You must have a DEA#. Please contact your"
36 ..S ORY(3)="CAC or IRM for more information. ***"
37 .Q:ORQUIT
38 .I '$D(^XUSEC("YSCL AUTHORIZED",PROV)) D
39 ..S ORQUIT=1,ORY=1
40 ..S ORY(1)="*** You are not authorized to place Clozapine orders."
41 ..S ORY(2)="You must hold key YSCL AUTHORIZED. Please contact your"
42 ..S ORY(3)="CAC or IRM for more information on this key. ***"
43 Q:ORQUIT
44 ; if is a cloz med , check if patient (DFN) can have a clozapine med
45 S ORYS=$$CL^YSCLTST2(DFN)
46 ; if yes returns ORY=0
47 I +ORYS>0 D BEFQUIT Q
48 ; if no
49 ; returns
50 ; ORY=1
51 ; ORY(0)=CAPTION FOR DIALOG BOX
52 ; ORY(1-N)=MESSAGE TO DISPLAY
53 S ORY=1_U_ORCLOZ,ORY(0)="Problem Ordering Clozapine Related Medication"_U_ORCLOZ
54 ;patient not in clozapine patient program
55 I +ORYS<0 D Q
56 .S ORY(1)="*** This patient is not registered in the clozapine treatment "
57 .S ORY(2)="program or has been discontinued from the program and must "
58 .S ORY(3)="have a new registration number assigned. Contact the NCCC to "
59 .S ORY(4)="get this patient registered in the program. ***"
60 ;problem with lab tests
61 I +ORYS=0 D Q
62 .I $$OVERRIDE^YSCLTST2(DFN) S ORY=0_U_ORCLOZ,ORY(0)=U_ORCLOZ D BEFQUIT Q ;override allowed
63 .N COUNT S COUNT=0
64 .S COUNT=COUNT+1,ORY(COUNT)="*** This clozapine drug may not be dispensed to the patient at this "
65 .S COUNT=COUNT+1,ORY(COUNT)="time based on the available lab tests related to the clozapine "
66 .S COUNT=COUNT+1,ORY(COUNT)="treatment program. Please contact the NCCC to request an override in"
67 .S COUNT=COUNT+1,ORY(COUNT)="order to proceed with dispensing this drug. ***"
68 .Q:'$L($P(ORYS,U,3))!('$L($P(ORYS,U,5)))
69 .S COUNT=COUNT+1,ORY(COUNT)="Related Lab Test(s)"
70 .S COUNT=COUNT+1,ORY(COUNT)="==================="
71 .;the lab values returned by Mental Health are given in 4 digit numbers to be standard with
72 .;reporting formats to the NCCC, we are dividing by 1000 to align it with the display of the
73 .;labs on the lab tab
74 .;S:$L($P(ORYS,U,3)) COUNT=COUNT+1,ORY(COUNT)=$P(ORYS,U,3)_": "_($P(ORYS,U,2)/1000)_" K/cmm"
75 .;S:$L($P(ORYS,U,5)) COUNT=COUNT+1,ORY(COUNT)=$P(ORYS,U,5)_": "_($P(ORYS,U,4)/1000)_" K/cmm"
76 .S:$L($P(ORYS,U,3)) COUNT=COUNT+1,ORY(COUNT)="WBC: "_($P(ORYS,U,2)/1000)_" K/cmm"
77 .S:$L($P(ORYS,U,5)) COUNT=COUNT+1,ORY(COUNT)="ANC: "_($P(ORYS,U,4)/1000)_" K/cmm"
78 .S COUNT=COUNT+1,ORY(COUNT)="Date/Time of last tests: "_$$DATE^ORU($P(ORYS,U,6))
79 Q
80BEFQUIT ;
81 Q:'$G(QOAA)
82 N QODS,QORF,ORMAX,ORCLPAT
83 S QODS=$O(^ORD(101.41,"AB","OR GTX DAYS SUPPLY","")) Q:QODS'>0
84 S QODS=$O(^ORD(101.41,ORX,6,"D",QODS,"")) Q:QOIEN'>0
85 S QODS=$G(^ORD(101.41,ORX,6,QODS,1))
86 S QORF=$O(^ORD(101.41,"AB","OR GTX REFILLS","")) Q:QORF'>0
87 S QORF=$O(^ORD(101.41,ORX,6,"D",QORF,"")) Q:QOIEN'>0
88 S QORF=$G(^ORD(101.41,ORX,6,QORF,1))
89 S QORF=QORF+1
90 S ORCLPAT=$P(ORYS,U,7)
91 S ORMAX=$S(ORYS="M":28,ORYS="B":14,ORYS="W":7,1:90)
92 I QORF*QODS>ORMAX D
93 .K ORY
94 .S ORY=1_U_ORCLOZ,ORY(0)="Problem Ordering Clozapine Related Medication"_U_ORCLOZ
95 .S ORY(1)="*** This patient is only allowed an order with a maximum Days Supply of "_ORMAX_"."
96 .S ORY(2)="This includes the amounts added by any refills entered in with the order also."
97 Q
98ISCLOZ(OROI) ;
99 N ORPSOI,ORPSDRUG
100 S ORPSOI=$P(^ORD(101.43,OROI,0),U,2)
101 I $P(ORPSOI,";",2)'="99PSP" Q 0
102 K ^TMP($J,"ORCLOZ")
103 D ASP^PSS50(+ORPSOI,,,"ORCLOZ")
104 S ORPSDRUG=$O(^TMP($J,"ORCLOZ",0))
105 I 'ORPSDRUG K ^TMP($J,"ORCLOZ") Q 0
106 K ^TMP($J,"ORCLOZ")
107 D CLOZ^PSS50(ORPSDRUG,,,,,"ORCLOZ")
108 I $G(^TMP($J,"ORCLOZ",ORPSDRUG,"CLOZ",0))>0 K ^TMP($J,"ORCLOZ") Q 1
109 K ^TMP($J,"ORCLOZ")
110 Q 0
111ALLWRN(ORY,ORN,REFILLS) ;allow order to be renewed
112 ;ORN is the order number
113 ;REFILLS is the number of refills to be included with the renewed order
114 N ORDS,ORQT,ORUPD,ORSCH,ORDUR,ORDFN,ORDRG,OROI,ORMAXDS,ORMAXQT,ORCLOZ,ORREF,ORMAXREF
115 ;default return 1 (ORY=1 means allow renew)
116 S ORY=1
117 ;get DFN (ORDFN)
118 S ORDFN=+$P(^OR(100,ORN,0),U,2)
119 Q:'ORDFN
120 ;get if order is a clozapine order (ORCLOZ)
121 S OROI=$G(^OR(100,ORN,.1,1,0)) Q:'OROI
122 S ORCLOZ=$$ISCLOZ(OROI)
123 ;quit if order is not clozapine
124 I 'ORCLOZ Q
125 ;get schedule from order (ORSCH)
126 S ORSCH=$G(^OR(100,ORN,4.5,$O(^OR(100,ORN,4.5,"ID","SCHEDULE",0)),1))
127 ;get units per dose from order (ORUPD)
128 S ORSCH=$G(^OR(100,ORN,4.5,$O(^OR(100,ORN,4.5,"ID","DOSE",0)),1))
129 S ORSCH=$P(ORSCH,"&",3)
130 ;get duration from order (ORDUR)
131 I '$O(^OR(100,ORN,4.5,"ID","DURATION",0)) S ORDUR="~^"
132 E S ORSCH=$G(^OR(100,ORN,4.5,$O(^OR(100,ORN,4.5,"ID","DURATION",0)),1))
133 ;get days supply from order (ORDS)
134 S ORSCH=$G(^OR(100,ORN,4.5,$O(^OR(100,ORN,4.5,"ID","SUPPLY",0)),1))
135 ;get drug (ptr50) from order (ORDRG)
136 S ORSCH=$G(^OR(100,ORN,4.5,$O(^OR(100,ORN,4.5,"ID","DRUG",0)),1))
137 ;get refills from order (ORREF)
138 S ORSCH=$G(^OR(100,ORN,4.5,$O(^OR(100,ORN,4.5,"ID","REFILLS",0)),1))
139 ;get quantity from order (ORQT)
140 S ORSCH=$G(^OR(100,ORN,4.5,$O(^OR(100,ORN,4.5,"ID","QTY",0)),1))
141 ;get max days supply for order (ORMAXDS)
142 S ORMAXDS=$$DEFSPLY^ORWDPS1(ORDFN)
143 ;if ds from order is > max ds return 0 (ORY=0)
144 I ORDS>ORMAXDS D Q
145 .S ORY=0
146 .S ORY(0)="Problem Renewing Clozapine Related Medication"_U_ORCLOZ
147 .S ORY(1)="The Days Supply set for this order is greater than the Max Days Supply"
148 .S ORY(2)=" allowed for this patient."
149 ;get max quantity for order (ORMAXQT)
150 D DAY2QTY^ORWDPS2(.ORMAXQT,ORDS,ORUPD,ORSCH,ORDUR,ORDFN,ORDRG)
151 ;if qt from order is > max qt return 0 (ORY=0)
152 I ORQT>ORMAXQT D Q
153 .S ORY=0
154 .S ORY(0)="Problem Renewing Clozapine Related Medication"_U_ORCLOZ
155 .S ORY(1)="The Quantity set for this order is greater than the Max Quantity"
156 .S ORY(2)=" allowed for this patient."
157 ;get max refills for order (ORMAXREF)
158 D MAXREF^ORWDPS2(.ORMAXREF,ORDFN,ORDRG,ORDS,OROI,1)
159 ;if refill from order is > max refills return 0 (ORY=0)
160 I ORREF>ORMAXREF D Q
161 .S ORY=0
162 .S ORY(0)="Problem Renewing Clozapine Related Medication"_U_ORCLOZ
163 .S ORY(1)="The Refills field set for this order is greater than the Refills"
164 .S ORY(2)=" allowed for this patient with the order having a Days Supply "
165 .S ORY(3)=" of "_ORDS_"."
166 Q
Note: See TracBrowser for help on using the repository browser.