source: FOIAVistA/trunk/r/ORDER_ENTRY_RESULTS_REPORTING-OR-OCX--ORRC--ORRJ/ORQPTQ11.m@ 1499

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

initial load of FOIAVistA 6/30/08 version
File size: 9.3 KB
Line 
1ORQPTQ11 ; SLC/CLA - Functs which return patient lists and sources pt 1B ;12/15/97 [ 08/04/97 3:32 PM ] [6/6/03 2:36pm]
2 ;;3.0;ORDER ENTRY/RESULTS REPORTING;**82,85,109,132,173,253**;Dec 17, 1997
3 ;
4 ; SLC/PKS - Modified to deal with "Combination" lists - 3/2000.
5 ; SLC/PKS - Additions for "Restricted Pt. Lists" - 11/2001.
6 ;
7DEFSRC(Y) ; return current user's default list source
8 Q:'$D(DUZ)
9 N FROM,API,ORSRV
10 S ORSRV=$G(^VA(200,DUZ,5)) I +ORSRV>0 S ORSRV=$P(ORSRV,U)
11 S FROM=$$GET^XPAR("USR^SRV.`"_+$G(ORSRV),"ORLP DEFAULT LIST SOURCE",1,"Q")
12 Q:'$L($G(FROM))
13 I FROM="T" S Y=$$GET^XPAR("USR^SRV.`"_+$G(ORSRV),"ORLP DEFAULT TEAM",1,"B")_"^Team"
14 I FROM="W" S Y=$$GET^XPAR("USR^SRV.`"_+$G(ORSRV),"ORLP DEFAULT WARD",1,"B")_"^Ward"
15 I FROM="P" S Y=$$GET^XPAR("USR^SRV.`"_+$G(ORSRV),"ORLP DEFAULT PROVIDER",1,"B")_"^Primary Provider"
16 I FROM="S" S Y=$$GET^XPAR("USR^SRV.`"_+$G(ORSRV),"ORLP DEFAULT SPECIALTY",1,"B")_"^Specialty"
17 I FROM="C" D
18 .S API="ORLP DEFAULT CLINIC "_$$UP^XLFSTR($$DOW^XLFDT(DT))
19 .S Y=$$GET^XPAR("USR^SRV.`"_+$G(ORSRV),API,1,"B")_"^"_$$DOW^XLFDT(DT)_" Clinic"
20 I FROM="M" S Y="^Combination"
21 Q
22FDEFSRC(ORDUZ) ; extrinsic function return user's (ORDUZ) default list source
23 Q:'$D(ORDUZ) "^^Error: No user identified"
24 N FROM,API,RESULT,ORSRV
25 S ORSRV=$G(^VA(200,ORDUZ,5)) I +ORSRV>0 S ORSRV=$P(ORSRV,U)
26 S FROM=$$GET^XPAR("USR.`"_ORDUZ_"^SRV.`"_+$G(ORSRV),"ORLP DEFAULT LIST SOURCE",1,"Q")
27 Q:'$L($G(FROM)) "^^No default list source specified"
28 I FROM="T" S RESULT=$$GET^XPAR("USR.`"_ORDUZ_"^SRV.`"_+$G(ORSRV),"ORLP DEFAULT TEAM",1,"B")_"^Team"
29 I FROM="W" S RESULT=$$GET^XPAR("USR.`"_ORDUZ_"^SRV.`"_+$G(ORSRV),"ORLP DEFAULT WARD",1,"B")_"^Ward"
30 I FROM="P" S RESULT=$$GET^XPAR("USR.`"_ORDUZ_"^SRV.`"_+$G(ORSRV),"ORLP DEFAULT PROVIDER",1,"B")_"^Primary Provider"
31 I FROM="S" S RESULT=$$GET^XPAR("USR.`"_ORDUZ_"^SRV.`"_+$G(ORSRV),"ORLP DEFAULT SPECIALTY",1,"B")_"^Specialty"
32 I FROM="C" D
33 .S API="ORLP DEFAULT CLINIC "_$$UP^XLFSTR($$DOW^XLFDT(DT))
34 .S RESULT=$$GET^XPAR("USR.`"_ORDUZ_"^SRV.`"_+$G(ORSRV),API,1,"B")_"^"_$$DOW^XLFDT(DT)_" Clinic"
35 I FROM="M" S RESULT="^Combination"
36 Q RESULT
37LISTSRC(ORDUZ,TYPE) ; extrinsic function return user's (ORDUZ) list source
38 ; for list type team, ward, primary provider, specialty, clinic, combination (TYPE)
39 Q:'$D(ORDUZ) "^^Error: No user identified"
40 Q:'$D(TYPE) "^^Error: No list type identified"
41 N API,RESULT,ORSRV
42 S ORSRV=$G(^VA(200,ORDUZ,5)) I +ORSRV>0 S ORSRV=$P(ORSRV,U)
43 I TYPE="T" S RESULT=$$GET^XPAR("USR.`"_ORDUZ_"^SRV.`"_+$G(ORSRV),"ORLP DEFAULT TEAM",1,"B")_"^Team"
44 I TYPE="W" S RESULT=$$GET^XPAR("USR.`"_ORDUZ_"^SRV.`"_+$G(ORSRV),"ORLP DEFAULT WARD",1,"B")_"^Ward"
45 I TYPE="P" S RESULT=$$GET^XPAR("USR.`"_ORDUZ_"^SRV.`"_+$G(ORSRV),"ORLP DEFAULT PROVIDER",1,"B")_"^Primary Provider"
46 I TYPE="S" S RESULT=$$GET^XPAR("USR.`"_ORDUZ_"^SRV.`"_+$G(ORSRV),"ORLP DEFAULT SPECIALTY",1,"B")_"^Specialty"
47 I TYPE="C" D
48 .S API="ORLP DEFAULT CLINIC "_$$UP^XLFSTR($$DOW^XLFDT(DT))
49 .S RESULT=$$GET^XPAR("USR.`"_ORDUZ_"^SRV.`"_+$G(ORSRV),API,1,"B")_"^"_$$DOW^XLFDT(DT)_" Clinic"
50 I TYPE="M" S RESULT="Combination"
51 I $P(RESULT,U)="" S RESULT=U_RESULT
52 Q RESULT
53DEFLIST(Y) ; return current user's default patient list
54 I $$BROKER^XWBLIB S Y=$NA(^TMP("OR",$J,"PATIENTS")) ; GUI = global.
55 I '$$BROKER^XWBLIB S ^TMP("OR",$J,"PATIENTS",0)=""
56 Q:'$D(DUZ)
57 N FROM,IEN,BEG,END,API,ORSRV,ORQDAT,ORQCNT,ORGUI
58 S ORSRV=$G(^VA(200,DUZ,5)) I +ORSRV>0 S ORSRV=$P(ORSRV,U) ; Get S/S.
59 S FROM=$$GET^XPAR("USR^SRV.`"_+$G(ORSRV),"ORLP DEFAULT LIST SOURCE",1,"Q")
60 Q:'$L($G(FROM))
61 I FROM="T" S IEN=$$GET^XPAR("USR^SRV.`"_+$G(ORSRV),"ORLP DEFAULT TEAM",1,"Q") D:+$G(IEN)>0 TEAMPTS^ORQPTQ1(.Y,IEN)
62 I FROM="W" S IEN=$$GET^XPAR("USR^SRV.`"_+$G(ORSRV),"ORLP DEFAULT WARD",1,"Q") D:+$G(IEN)>0 BYWARD^ORWPT(.Y,IEN)
63 I FROM="P" S IEN=$$GET^XPAR("USR^SRV.`"_+$G(ORSRV),"ORLP DEFAULT PROVIDER",1,"Q") D:+$G(IEN)>0 PROVPTS^ORQPTQ2(.Y,IEN)
64 I FROM="S" S IEN=$$GET^XPAR("USR^SRV.`"_+$G(ORSRV),"ORLP DEFAULT SPECIALTY",1,"Q") D:+$G(IEN)>0 SPECPTS^ORQPTQ2(.Y,IEN)
65 I FROM="C" D
66 .S API="ORLP DEFAULT CLINIC "_$$UP^XLFSTR($$DOW^XLFDT(DT)),IEN=$$GET^XPAR("USR^SRV.`"_+$G(ORSRV),API,1,"Q") I +$G(IEN)>0 D
67 ..S BEG=$$UP^XLFSTR($$GET^XPAR("USR^SRV.`"_+$G(ORSRV)_"^DIV^SYS^PKG","ORLP DEFAULT CLINIC START DATE",1,"E"))
68 ..I BEG="T+0" S BEG=$$FMTE^XLFDT(DT,BEG)
69 ..S END=$$UP^XLFSTR($$GET^XPAR("USR^SRV.`"_+$G(ORSRV)_"^DIV^SYS^PKG","ORLP DEFAULT CLINIC STOP DATE",1,"E"))
70 ..I END="T+0" S END=$$FMTE^XLFDT(DT,END)
71 ..D CLINPTS^ORQPTQ2(.Y,+$G(IEN),BEG,END)
72 I FROM="M" D
73 .S IEN=$D(^OR(100.24,DUZ,0)) I +$G(IEN)>0 S IEN=DUZ D
74 ..S BEG=$$UP^XLFSTR($$GET^XPAR("USR^SRV.`"_+$G(ORSRV)_"^DIV^SYS^PKG","ORLP DEFAULT CLINIC START DATE",1,"E"))
75 ..I BEG="T+0" S BEG=$$FMTE^XLFDT(DT,BEG)
76 ..S END=$$UP^XLFSTR($$GET^XPAR("USR^SRV.`"_+$G(ORSRV)_"^DIV^SYS^PKG","ORLP DEFAULT CLINIC STOP DATE",1,"E"))
77 ..I END="T+0" S END=$$FMTE^XLFDT(DT,END)
78 ..D COMBPTS^ORQPTQ6(0,+$G(IEN),BEG,END) ; "0"= GUI RPC call.
79 I ($$BROKER^XWBLIB)&(FROM'="M") D ; Combinations already written to global.
80 .S ORQDAT="",ORQCNT=1
81 .F S ORQDAT=$G(Y(ORQCNT)) Q:ORQDAT="" D
82 ..S ^TMP("OR",$J,"PATIENTS",ORQCNT,0)=ORQDAT
83 ..S ORQCNT=ORQCNT+1
84 I ('$$BROKER^XWBLIB) S Y=FROM_";"_+$G(IEN)_";"_$G(BEG)_";"_$G(END) ; MKB 10/13/95
85 Q
86DEFSORT(Y) ; Return user's default sort.
87 ; SLC/PKS - 4/6/2001
88 ;
89 N ORSORT,ORSECT,ORPARAM
90 ;
91 I ('$D(DUZ)) S Y="Unable to determine DUZ." Q
92 S ORSECT=$G(^VA(200,DUZ,5))
93 I +ORSECT>0 S ORSECT=$P(ORSECT,U)
94 S Y="A" ; Default of "Alpha" sort.
95 S ORPARAM="ORLP DEFAULT LIST ORDER"
96 S ORSORT=$$GET^XPAR("USR^SRV.`"_$G(ORSECT)_"^DIV^SYS^PKG",ORPARAM,1,"I")
97 I (ORSORT'="") S Y=ORSORT
98 ;
99 Q
100 ;
101PNAMWRIT(ORROOT,ORDFN) ; Write patient name to ^TMP global.
102 ;
103 ; Variables used:
104 ;
105 ; ORDFN = Passed patient DFN.
106 ; ORNAME = Patient name.
107 ; ORROOT = ^TMP root passed by calling code.
108 ; ORWRITE = Holder for ^TMP node for writing.
109 ;
110 N ORNAME,ORWRITE
111 S ORROOT=ORROOT_"," ; Add necessary comma.
112 ;
113 S ORNAME="" ; Initializae.
114 S ORNAME=$G(^DPT(ORDFN,0)) ; Get zero node pt. data.
115 S ORNAME=$P(ORNAME,U) ; Extract pt. name only.
116 I ORNAME="" Q 0 ; Problem - punt.
117 ;
118 ; Create naked reference string for writing to ^TMP:
119 S ORWRITE=ORROOT_""""_ORNAME_""""_","_ORDFN_")"
120 S @ORWRITE=ORDFN_U_ORNAME ; Write to ^TMP.
121 ;
122 Q 1
123 ;
124RPLMAKE(Y,ORTL) ; Make global restricted pt. array from Team List.
125 ;
126 ; Variables used:
127 ;
128 ; ORDFN = Holder for patient DFN.
129 ; ORJ = Holds $J value.
130 ; ORREAD = Holder for ^TMP root to kill.
131 ; ORRET = Returned value from function call.
132 ; ORROOT = ^TMP root to pass.
133 ; ORTL = Team List IEN.
134 ; ORX = Working variable used in $ORDER statement.
135 ; Y = Returned value (same as ORJ).
136 ;
137 N ORDFN,ORJ,ORREAD,ORRET,ORROOT,ORX
138 ;
139 I ORTL="" S Y="" Q ; No Team List IEN passed.
140 I $G(^OR(100.21,ORTL,0))="" S Y="" Q ; No such Team List.
141 ;
142 S (ORJ,Y)=$J ; Assign returned value.
143 S ORROOT="^TMP("_"""ORRPL"""_"," ; Initial setting.
144 S ORROOT=ORROOT_ORJ_","_"""B""" ; Add job number, "B."
145 S ORREAD=ORROOT_")" ; Assign "kill" root.
146 K @ORREAD ; Kill old, if any.
147 ;
148 ; From Team List B x-ref, obtain patients, create new ^TMP entries:
149 S ORX="" ; Initialize.
150 F S ORX=$O(^OR(100.21,ORTL,10,"B",ORX)) Q:ORX="" D
151 .S ORDFN=$P(ORX,";") ; Extract patient DFN.
152 .S ORRET=$$PNAMWRIT(ORROOT,ORDFN) ; Call that writes to ^TMP.
153 ;
154 Q
155 ;
156RPLREAD(Y,ORJ,ORFROM,ORDIR) ; Read disk-based patient array from TMP.
157 ;
158 ; Variables used:
159 ;
160 ; ORCNT = Counter variable.
161 ; ORDIR = Direction to move through list.
162 ; ORFROM = Starting point from which to move through list.
163 ; ORI = Counter variable.
164 ; ORIEN = Record IEN holder.
165 ; ORJ = Job number to use in ^TMP global root.
166 ; ORROOT = ^TMP global file root.
167 ; ORZ = Temporary value holder.
168 ; Y = Returned array.
169 ;
170 N ORCNT,ORI,ORIEN,ORROOT,ORZ
171 ;
172 I $P(ORFROM,U,2)'="" S ORFROM=$P(ORFROM,U,2)
173 ;
174 S ORROOT="^TMP("_"""ORRPL"""_","_ORJ ; Initial setting.
175 S ORROOT=ORROOT_","_"""B""" ; Add final text.
176 ;
177 ; Check for existence of data:
178 I '$D(@(ORROOT_")")) S Y(0)="No data available." Q
179 ;
180 S ORROOT=ORROOT_"," ; Add comma.
181 S ORCNT=44 ; Initialize to maximum.
182 S ORI=0 ; Initialize.
183 ;
184 ; Loop through ^TMP entries for data to return:
185 F S ORFROM=$O(@(ORROOT_""""_ORFROM_""""_")"),ORDIR) Q:ORFROM="" D Q:ORI=ORCNT
186 .;
187 .; Sub-loop for entries up to ORCNT maximum:
188 .S ORIEN=0 ; Initialize.
189 .F S ORIEN=$O(@(ORROOT_""""_ORFROM_""""_","_ORIEN_")")) Q:'ORIEN D Q:ORI=ORCNT
190 ..S ORI=ORI+1 ; Increment counter.
191 ..;
192 ..; Assign return array:
193 ..S Y(ORI)=@(ORROOT_""""_ORFROM_""""_","_ORIEN_")")
194 ;
195 Q
196 ;
197RPLCLEAN(Y,ORJ) ; Kill global data using passed global root value.
198 ;
199 ; Variables used:
200 ;
201 ; ORJ = Job number to use in ^TMP global root.
202 ; ORROOT = Root of ^TMP global to kill.
203 ; Y = Returned RPC value.
204 ;
205 N ORROOT
206 ;
207 S Y=1 ; Initialize.
208 S ORROOT="^TMP("_"""ORRPL"""_"," ; Initial setting.
209 S ORROOT=ORROOT_ORJ_","_"""B"""_")" ; Add rest.
210 K @ORROOT ; Kill global data.
211 ;
212 Q
213 ;
Note: See TracBrowser for help on using the repository browser.