source: FOIAVistA/trunk/r/SCHEDULING-SD-SC/SCMCBK.m@ 677

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

initial load of FOIAVistA 6/30/08 version
File size: 6.6 KB
Line 
1SCMCBK ;ALB/SCK - Broker Utilities for multiple patient assignments; 4/8/96 [1/8/99 7:53am]
2 ;;5.3;Scheduling;**41,51,148,157,177,205**;AUG 13, 1993
3 ;
4 Q
5 ;
6PTCLBLD(SCOK,SC) ; Build patient list for a selected clinic
7 ; 'SC BLD PAT CLN LIST'
8 ;
9 D NEWVAR^SCMCBK1
10 D CHK^SCUTBK
11 D TMP^SCUTBK
12 ;
13 D PARSE^SCMCBK1(.SC)
14 ;
15 I SCPOS'="" S SCOK=$$PTCLBRTP^SCAPMC26(.SCCLN,.SCPOS,"SCDTRNG")
16 E S SCOK=$$PTCLBR^SCAPMC26(.SCCLN,.SCTEAM,"SCDTRNG")
17 K ^TMP("SCMC",$J,"EXCLUDE PT")
18 G:SCOK=0 PTCLNQ
19 ;
20 M ^TMP($J,"SC PCMM IN")=^TMP(SCOK,"SCCLPT")
21 K ^TMP(SCOK,"SCCLPT")
22 ;
23 D ALPHA^SCAPMCU2("^TMP($J,""SC PCMM IN"")","^TMP($J,""SCCLPT"")")
24 ;
25 S SCOK=$J_U_^TMP($J,"SC PCMM IN",0)
26 ;
27PTCLNQ D CLRVAR^SCMCBK1
28 Q
29 ;
30PTSCBLD(SCOK,SC) ; Build patient list for selected stop code
31 ; 'SC BLD PAT SCDE LIST'
32 ;
33 D NEWVAR^SCMCBK1
34 ;
35 D CHK^SCUTBK
36 D TMP^SCUTBK
37 ;
38 D PARSE^SCMCBK1(.SC)
39 ;
40 K ^TMP($J,"SCSCDE")
41 ;
42 ; Build exclude list
43 S BLOCK=$S(SCPOS'="":"BLKPOS",1:"BLKTM")
44 S SCBLOCK=$S(SCPOS'="":SCPOS,1:SCTEAM)
45 D @BLOCK
46 ;
47 IF 'SCOK1 S SCOK="0^0^0^0" G PTSCQ
48 ;
49 S SCOK=0
50 S SCOK=$$PTST^SCAPMC27(SCSCDE,"SCDTRNG",SCNUM,.SCLOC,"SCERMSG",SCMORE)
51 K ^TMP("SCMC",$J,"EXCLUDE PT")
52 ;
53 M ^TMP($J,"SC PCMM IN")=@SCLOC
54 S I1=$G(^TMP($J,"SC PCMM IN",0))
55 F I=1:1:I1 S ^TMP($J,"PCMM TMP",I)=$G(^TMP($J,"SC PCMM IN",I))
56 ;
57 D ALPHA^SCAPMCU2("^TMP($J,""PCMM TMP"")","^TMP($J,""SCSCDE"")")
58 S SCOK=$J_U_+I1_U_SCOK
59 ;
60PTSCQ D CLRVAR^SCMCBK1
61 Q
62 ;
63PTTMBLD(SCOK,SC) ; Build a list of patients for a selected team and return the $J of the TMP globall
64 ; where the list is stored.
65 ; ' SC BLD PAT TM LIST '
66 ;
67 D NEWVAR^SCMCBK1
68 D CHK^SCUTBK
69 D TMP^SCUTBK
70 ;
71 D PARSE^SCMCBK1(.SC)
72 K ^TMP($J,"SCTEAM")
73 ;
74 ; Build exclude list
75 S SCOK=0
76 S BLOCK=$S(SCPOS'="":"BLKPOS",1:"BLKTM")
77 S SCBLOCK=$S(SCPOS'="":SCPOS,1:SCTEAM)
78 D @BLOCK
79 ;
80 S SCOK=$$PTTM^SCAPMC2(SCFRMTM,"SCDTRNG",.SCLOC,"SCERMSG")
81 K ^TMP("SCMC",$J,"EXCLUDE PT")
82 M ^TMP($J,"SC PCMM IN")=@SCLOC
83 ;
84 S I="" F S I=$O(^TMP($J,"SC PCMM IN",I)) Q:'I D
85 . S ^TMP($J,"PCMM TMP",I)=^TMP($J,"SC PCMM IN",I)
86 ;
87 D ALPHA^SCAPMCU2("^TMP($J,""PCMM TMP"")","^TMP($J,""SCTEAM"")")
88 S I1="" F S I1=$O(^TMP($J,"SCTEAM",I1)) Q:'I1 S I=I1
89 ;
90 S SCOK=$J_U_+I_U_SCOK
91 ;
92 D CLRVAR^SCMCBK1
93 Q
94 ;
95PTPSBLD(SCOK,SC) ;
96 ; ' SC BLD PAT POS LIST '
97 ;
98 D NEWVAR^SCMCBK1
99 D CHK^SCUTBK
100 D TMP^SCUTBK
101 ;
102 D PARSE^SCMCBK1(.SC)
103 ;
104 K ^TMP($J,"SCPOS")
105 ;
106 ; Build exclude list
107 S BLOCK=$S(SCPOS'="":"BLKPOS",1:"BLKTM")
108 S SCBLOCK=$S(SCPOS'="":SCPOS,1:SCTEAM)
109 D @BLOCK
110 ;
111 S SCOK=0
112 ;
113 S SCOK=$$PTTP^SCAPMC11(SCFRMPOS,"SCDTRNG",.SCLOC,.SCERMSG)
114 K ^TMP("SCMC",$J,"EXCLUDE PT")
115 M ^TMP($J,"SC PCMM IN")=@SCLOC
116 ;
117 S I1=$G(^TMP($J,"SC PCMM IN",0))
118 F I=1:1:I1 S ^TMP($J,"PCMM TMP",I)=$G(^TMP($J,"SC PCMM IN",I))
119 D ALPHA^SCAPMCU2("^TMP($J,""PCMM TMP"")","^TMP($J,""SCPOS"")")
120 S SCOK=$J_U_+I1_U_SCOK
121 ;
122 ;IF '+$G(^TMP($J,"SCPOS",0)) D S SCOK=$J_U_SCOK
123 ;. S I="" F S I=$O(^TMP($J,"SCPOS",I)) Q:'I S SCOK=I
124 ;
125 D CLRVAR^SCMCBK1
126 Q
127 ;
128PTAPBLD(SCOK,SC) ; Build patient list for selected appointment range.
129 ; ' SC BLD PAT APT LIST '
130 ;
131 ;N SCCLN,SCTEAM,SCDTRNG,SCLOC,SCERMSG,SCNUM,SCCOUNT,SCMORE,SCOK1,SCER2,SCOUT,SCBLOCK
132 ;
133 D NEWVAR^SCMCBK1
134 D CHK^SCUTBK
135 D TMP^SCUTBK
136 ;
137 D PARSE^SCMCBK1(.SC)
138 ;
139 K ^TMP($J,"SCCLN")
140 ;
141 ; Build exclude list
142 S BLOCK=$S(SCPOS'="":"BLKPOS",1:"BLKTM")
143 S SCBLOCK=$S(SCPOS'="":SCPOS,1:SCTEAM)
144 D @BLOCK
145 ;
146 IF 'SCOK1 S SCOK="0^0^0^0" G PTAPQ
147 S SCOK=0
148 S SCOK=$$PTAP^SCAPMC28(SCCLN,"SCDTRNG",SCNUM,.SCLOC,"SCERMSG",SCMORE)
149 K ^TMP("SCMC",$J,"EXCLUDE PT")
150 ;
151 M ^TMP($J,"SC PCMM IN")=@SCLOC
152 ;
153 S I1=$G(^TMP($J,"SC PCMM IN",0))
154 F I=1:1:I1 S ^TMP($J,"PCMM TMP",I)=$G(^TMP($J,"SC PCMM IN",I))
155 ;
156 D ALPHA^SCAPMCU2("^TMP($J,""PCMM TMP"")","^TMP($J,""SCAPP"")")
157 S SCOK=$J_U_I1_U_SCOK
158 ;
159 D CLRVAR^SCMCBK1
160PTAPQ Q
161 ;
162PTGET(SCDATA,SC) ; Return a block of patients to the client
163 ; 'SC GET PAT BLOCK'
164 ;
165 ; SCJOB = $J for the ^TMP global
166 ; SCJOBID = The second subscript id for the ^TMP global
167 ; SCSTART = Beginning entry number for the block retrieval in the ^TMP global
168 ; SCEND = The ending entry number for the block retrieval
169 ; SCLAST = The last entry number in the ^TMP global
170 ;
171 N SCJOB,SCSTART,SCEND,I,SCLAST,SCJOBID
172 ;
173 D CHK^SCUTBK
174 D TMP^SCUTBK
175 ;
176 D PARSE^SCMCBK1(.SC)
177 ;
178 F I=SCSTART:1:SCEND Q:'$G(^TMP(SCJOB,SCJOBID,I),0) D
179 . S SCDATA(I)=^TMP(SCJOB,SCJOBID,I)
180 I SCEND>SCLAST K ^TMP(SCJOB,SCJOBID)
181 ;
182 D CLRVAR^SCMCBK1
183 Q
184 ;
185PTLSTBLD(SCOK,SCVAL) ; Build the list of patients to be assigned in the ^TMP($J,"SC PATIENT LIST",DFN) global
186 ; 'SC BLD PAT LIST'
187 ;
188 N SCJOB,SCDFN
189 ;
190 D CHK^SCUTBK
191 D TMP^SCUTBK
192 ;
193 S SCOK=0
194 I SCVAL["Start" D G PTBLDQ
195 .S SCOK=$J
196 .K ^TMP(SCOK,"SC PATIENT LIST")
197 ;
198 S SCJOB=$P(SCVAL,U,1)
199 S SCDFN=$P(SCVAL,U,2)
200 S ^TMP(SCJOB,"SC PATIENT LIST",SCDFN)=""
201 S SCOK=1
202PTBLDQ Q
203 ;
204PTFILE(SCOK,SC) ; File the patient assignments in the ^TMP($J,"SC TEAM ASSIGN",SCDFN) global
205 ; 'SC FILE PAT TM ASGN'
206 ;
207 ;205 remove;I XWBAPVER=177 D QUEUED^SCMCBK4(1) Q
208 ;205 remove;I $$VPROGMR^SCUTBK3()'=1 Q
209 ; pre 177 code follows....
210 I XWBAPVER=1 D QUEUED^SCMCBK4(1) Q
211 ;
212 N SCADDFLD,SCTEAM,SCFILE,SCJOB,SCNEW,SCOLD,SCBAD,SCERMSG,SCX,SCDTVAR
213 ;
214 D CHK^SCUTBK
215 D TMP^SCUTBK
216 ;
217 D PARSE^SCMCBK1(.SC)
218 G:+$G(SCJOB)=0 FILEQ
219 ;
220 ;
221 S SCADDFLD(.08)=$G(SC("TYPE"),99)
222 S SCADDFLD(.1)=$G(SC("RESTRICT"),0)
223 S SCADDFLD(.11)=DUZ
224 S SCADDFLD(.12)=DT
225 ;
226 S SCX=$$ACPTATM^SCAPMC6("^TMP(SCJOB,""SC PATIENT LIST"")",SCTEAM,"SCADDFLD",SCDTVAR,"SCERMSG","SCNEW","SCOLD","SCBAD")
227 D BAD^SCMCBK1(.SCBAD,.SCOLD,.SCOK)
228 S SCOK(.1)=SCX
229 ;
230 K ^TMP(SCJOB,"SC PATIENT LIST")
231 ;
232 D CLRVAR^SCMCBK1
233FILEQ Q
234 ;
235POSFILE(SCOK,SC) ; File the patient assignments in the ^TMP($J,"SC PATIENT LIST") global
236 ; ' SC FILE PAT POS ASGN '
237 ;
238 ;205 remove;I XWBAPVER=177 D QUEUED^SCMCBK4(2) Q
239 ;205 remove;I $$VPROGMR^SCUTBK3()'=1 Q
240 ; pre 177 code follows...
241 I XWBAPVER=1 D QUEUED^SCMCBK4(2) Q
242 ;
243 N SCADDFLD,SCTEAM,SCFILE,SCJOB,SCNEW,SCOLD,SCBAD,SCERMSG,SCX,SCPOS,SCDTVAR,SCMAFLD,SCADTM,SCNEW1
244 ;
245 D CHK^SCUTBK
246 D TMP^SCUTBK
247 ;
248 D PARSE^SCMCBK1(.SC)
249 G:+$G(SCJOB)=0 FILEQ
250 S SCADTM=1
251 ;
252 S SCADDFLD(.05)=$G(SC("TYPE"),0)
253 S SCADDFLD(.06)=DUZ
254 S SCADDFLD(.07)=DT
255 ;
256 S SCX=$$ACPTATP^SCAPMC21("^TMP(SCJOB,""SC PATIENT LIST"")",SCPOS,"SCADDFLD",SCDTVAR,"SCERMSG",SCADTM,"","SCNEW","SCNEW1","SCOLD","SCBAD")
257 ;
258 D BAD2^SCMCBK1(.SCBAD,.SCOLD,.SCOK)
259 S SCOK(.1)=SCX
260 K ^TMP(SCJOB,"SC PATIENT LIST")
261 ;
262 D CLRVAR^SCMCBK1
263 Q
264 ;
265BLKPOS ;
266 N SCX
267 S SCX=$G(SCDTRNG("END"))
268 S SCDTRNG("END")=3990101 ;check forever
269 S SCOK1=$$PTTP^SCAPMC(SCBLOCK,"SCDTRNG","^TMP(""SCMC"",$J,""EXCLUDE PT"")","SCER2")
270 S SCDTRNG("END")=SCX
271 Q
272 ;
273BLKTM ;
274 N SCX
275 S SCX=$G(SCDTRNG("END"))
276 S SCDTRNG("END")=3990101 ;check forever
277 S SCOK1=$$PTTM^SCAPMC(SCBLOCK,"SCDTRNG","^TMP(""SCMC"",$J,""EXCLUDE PT"")","SCER2")
278 S SCDTRNG("END")=SCX
279 Q
280 ;
Note: See TracBrowser for help on using the repository browser.