close Warning: Can't use blame annotator: 
svn blame failed on WorldVistAEHR/trunk/r/SCHEDULING-SD-SC/SCMCBK1.m: 'GenericSWIGWrapper' object has no attribute '_wrap'

source: WorldVistAEHR/trunk/r/SCHEDULING-SD-SC/SCMCBK1.m@ 861

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

initial load of WorldVistAEHR
File size: 7.8 KB
RevLine 
1SCMCBK1 ;LB/SCK - Broker Utilities for multiple patient assignments;
2 ;;5.3;Scheduling;**41,51,210,297**;AUG 13, 1993
3 ;;1T1;;
4 Q
5 ;
6PARSE(SC) ;
7 S SCTEAM=$G(SC("TEAM"),"")
8 S SCPOS=$G(SC("POSITION"),"")
9 S SCDTVAR=$G(SC("DATE"),DT)
10 S SCDTRNG("BEGIN")=$G(SC("BEGIN"),DT)
11 S SCDTRNG("END")=$G(SC("END"),DT)
12 S SCDTRNG("INCL")=$G(SC("INCL"),0)
13 S SCJOB=$G(SC("JOB"),"")
14 S SCSTART=$G(SC("BSTART"),0)
15 S SCEND=$G(SC("BEND"),0)
16 S SCLAST=$G(SC("BLAST"),0)
17 S SCFILE=$G(SC("FILE"),"")
18 S SCJOBID=$G(SC("JOBID"),"")
19 S SCNUM=$G(SC("MAX"),300)
20 S SCCLN=$G(SC("CLINIC"),"")
21 S SCSCDE=$G(SC("STOPCODE"),"")
22 S SCFRMTM=$G(SC("FROMTEAM"),"")
23 S SCFRMPOS=$G(SC("FROMPOS"),"")
24 S SCDFN=$G(SC("DFN"),"")
25 S SCMORE=$G(SC("MORE"),"")
26 Q
27 ;
28NEWVAR ;
29 ;bp/cmf 210t0 begin
30 D CLRVAR Q
31 ;bp/cmf 210t0 end
32 N SCCLN,SCSCDE,SCTEAM,SCDTRNG,SCLOC,SCERMSG,SCNUM,SCCOUNT,SCMORE,SCOK1,SCER2,SCOUT,BLOCK,SCBLOCK,SCFRMTM,SCFRMPOS,SCSRCE,SCSRCTYP
33 N SCADDFLD,SCNEW,SCOLD,SCBAD,SUBRTN,SCX,SCTMP
34 ;
35 K ^TMP($J,"SC PCMM IN")
36 K ^TMP($J,"PCMM TMP")
37 K ^TMP("SC TMP LIST",$J)
38 K ^TMP($J,"SC PATIENT LIST")
39 ;
40 Q
41 ;
42CLRVAR ; Clear all parsing variables
43 ;
44 K SCNUM,SCSCDE,SCCLN,SCJOBID,SCFILE,SCLAST,SCEND,SCSTART,SCJOB,SCDTRNG
45 K SCDTVAR,SCPOS,SCTEAM,SCFRMTM,SCFRMPOS,SCDFN,BLOCK,SCBLOCK,SCX,SUBRTN
46 K SCTMP,SCBAD,SCOLD,SCNEW,SCLOC,SCERMSG,SCCOUNT,SCMORE,SCOK1
47 K SCER2,SCOUT,SCSRCE,SCSRCTYP,SCADDFLD
48 ;
49 K ^TMP($J,"SC PCMM IN")
50 K ^TMP($J,"PCMM TMP")
51 K ^TMP("SC TMP LIST",$J)
52 K ^TMP($J,"SC PATIENT LIST")
53 Q
54 ;
55PTCLEN(SCOK,SC) ; Enroll patient in associated clinic for a position
56 ; ' SC PAT ENROLL CLN '
57 ;
58 N SCCLN,SCDFN,SCDTVAR,SCERMSG,SCADDFLD
59 ;
60 D CHK^SCUTBK
61 D TMP^SCUTBK
62 ;
63 D PARSE(.SC)
64 S SCADDFLD(1)=$G(SC("ADD1"),"O")
65 S SCOK=0
66 ;
67 ;Enroll Patient in all associated clincs not entrolled in
68 F SCCLN=0:0 S SCCLN=$O(^SCTM(404.57,SCPOS,5,SCCLN)) Q:'SCCLN D
69 .I $D(^DPT(SCDFN,"DE","B",SCCLN)) Q
70 .S SCOK=$$ACPTCL^SCAPMC18(SCDFN,SCCLN,"SCADDFLD",SCDTVAR,"SCERMSG")
71 ;
72 D CLRVAR
73 Q
74 ;
75CHKPOS(SCOK,SC) ; Check for primary care pratitioner and attending positions for patient
76 ; ' SC CHECK FOR PC POS '
77 ; Piece 1 of SCOK = 1 if ok for practitioner role
78 ; 0 if not ok
79 ; Piece 2 of SCOK = 1 if ok for ateending role
80 ; 0 if not ok
81 ;
82 N SCPOS,SCDTVAR,SCDFN
83 ;
84 D CHK^SCUTBK
85 D TMP^SCUTBK
86 ;
87 D PARSE(.SC)
88 ;
89 S SCOK=$$PCRLPTTP^SCMCTPU2(SCDFN,SCPOS,SCDTVAR)
90 ;
91 D CLRVAR
92 Q
93 ;
94NOPCTM(SCOK,SC) ; Build list of patients with a primary care assignment, but no primary care team;
95 ; ' SC BLD NOPC TM LIST '
96 ;
97 N I1
98 D NEWVAR
99 ;
100 D CHK^SCUTBK
101 D TMP^SCUTBK
102 ;
103 D PARSE(.SC)
104 ;
105 K ^TMP($J,"SCPCNO")
106 ; Build exclude list
107 S BLOCK=$S(SCPOS'="":"BLKPOS^SCMCBK",1:"BLKTM^SCMCBK")
108 S SCBLOCK=$S(SCPOS'="":SCPOS,1:SCTEAM)
109 D @BLOCK
110 ;
111 S SCOK=0
112 ;
113 S SCLOC="^TMP($J,""SC PCMM IN"")"
114 D PTPCNOTM^SCAPMC20(.SCLOC,SCDTVAR)
115 K ^TMP("SCMC",$J,"EXCLUDE PT")
116 ;
117 S I=""
118 F S I=$O(^TMP($J,"SC PCMM IN",I)) Q:'I D
119 . S ^TMP($J,"PCMM TMP",I)=^TMP($J,"SC PCMM IN",I)
120 ;
121 D ALPHA^SCAPMCU2("^TMP($J,""PCMM TMP"")","^TMP($J,""SCPCNO"")")
122 S I1="" F S I1=$O(^TMP($J,"SCPCNO",I1)) Q:'I1 S I=I1
123 ;
124 S SCOK=$J_U_+I_U_1
125 ;
126 D CLRVAR
127 Q
128 ;
129ASGNALL(SCOK,SC) ; Assign all entries for the selection source to the appropriate team.
130 ; ' SC FILE ALL PAT TM ASGN '
131 ;
132 D NEWVAR
133 ;
134 D CHK^SCUTBK
135 D TMP^SCUTBK
136 ;
137 D PARSE(.SC)
138 S SCSRCE=$G(SC("SOURCE"),"")
139 S SCADDFLD(.08)=$G(SC("TYPE"),99)
140 S SCADDFLD(.1)=$G(SC("RESTRICT"),0)
141 S SCADDFLD(.11)=DUZ
142 S SCADDFLD(.12)=DT
143 ;
144 S DTMP=$G(SCDTRNG("END"))
145 S SCDTTRNG("END")=3990101
146 S SCOK2=$$PTTM^SCAPMC(SCTEAM,"SCDTRNG","^TMP(""SCMC"",$J,""EXCLUDE PT"")","SCER2")
147 S SCDTRNG("END")=DTMP
148 ;
149 S SCSRCTYP=$P(SCSRCE,U,1)
150 D @SCSRCTYP
151 ;
152 K SCBAD,SCOLD,SCNEW
153 S SCX=$$ACPTATM^SCAPMC6("^TMP($J,""SC PATIENT LIST"")",SCTEAM,"SCADDFLD",SCDTVAR,"SCERMSG","SCNEW","SCOLD","SCBAD")
154 ;
155 K ^TMP("SCMC",$J,"EXCLUDE PT")
156 D BAD(.SCBAD,.SCOLD,.SCOK)
157 S SCOK(.1)=SCX
158 ;
159 D CLRVAR
160 Q
161 ;
162CLN ; File all patients in selected clinic.
163 ;
164 S SCOK1=$$PTCLBR^SCAPMC26($P($G(SCSRCE),U,2),.SCTEAM,"SCDTRNG")
165 S I=0 F S I=$O(^TMP($J,"SCCLPT",I)) Q:'I D
166 . S ^TMP($J,"SC PATIENT LIST",$P($G(^TMP($J,"SCCLPT",I)),U))=""
167 K ^TMP($J,"SCCLPT")
168 Q
169 ;
170STOPC ; File all patients in the selected stop code
171 ;
172 S SCOK1=$$PTST^SCAPMC27($P($G(SCSRCE),U,2),"SCDTRNG",SCNUM,.SCTMP,"ERRMSG",0)
173 M ^TMP($J,"PCMM TMP")=@SCTMP
174 S I=0 F S I=$O(^TMP($J,"PCMM TMP",I)) Q:'I D
175 . S ^TMP($J,"SC PATIENT LIST",$P($G(^TMP($J,"PCMM TMP",I)),U))=""
176 Q
177 ;
178APPT ; File all patients for the selected clinic appointment range
179 S SCOK1=$$PTAP^SCAPMC28($P($G(SCSRCE),U,2),"SCDTRNG",SCNUM,.SCTMP,"SCERMSG",0)
180 M ^TMP($J,"PCMM TMP")=@SCTMP
181 S I=0 F S I=$O(^TMP($J,"PCMM TMP",I)) Q:'I D
182 . S ^TMP($J,"SC PATIENT LIST",$P($G(^TMP($J,"PCMM TMP",I)),U))=""
183 Q
184 ;
185TEAM ; File all patients for the selected team
186 S SCOK1=$$PTTM^SCAPMC2($P($G(SCSRCE),U,2),"SCDTRNG",.SCTMP,"SCERMSG")
187 M ^TMP($J,"PCMM TMP")=@SCTMP
188 S I=0 F S I=$O(^TMP($J,"PCMM TMP",I)) Q:'I D
189 . S ^TMP($J,"SC PATIENT LIST",$P($G(^TMP($J,"PCMM TMP",I)),U))=""
190 Q
191 ;
192ASGALLP(SCOK,SC) ; Assign all entries in the selected source to the selected team and position
193 ;
194 N DTMP
195 D NEWVAR
196 D CHK^SCUTBK
197 D TMP^SCUTBK
198 ;
199 D PARSE(.SC)
200 S SCSRCE=$G(SC("SOURCE"),"")
201 S SCADDFLD(.05)=$G(SC("TYPE"),0)
202 S SCADDFLD(.06)=DUZ
203 S SCADDFLD(.07)=DT
204 ;
205 S DTMP=$G(SCDTRNG("END"))
206 S SCDTRNG("END")=3990101
207 S SCOK2=$$PTTP^SCAPMC(SCPOS,"SCDTRNG","^TMP(""SCMC"",$J,""EXCLUDE PT"")","SCER2")
208 S SCDTRNG("END")=DTMP
209 ;
210 S SCSRCTYP=$P(SCSRCE,U,1)
211 D @SCSRCTYP
212 ;
213 K SCBAD,SCOLD,SCNEW
214 S SCX=$$ACPTATP^SCAPMC21("^TMP($J,""SC PATIENT LIST"")",SCPOS,"SCADDFLD",SCDTVAR,"SCERRMSG",1,"","SCNEW","SCNEW1","SCOLD","SCBAD")
215 ;
216 K ^TMP("SCMC",$J,"EXCLUDE PT")
217 D BAD2(.SCBAD,.SCOLD,.SCOK)
218 S SCOK(.1)=SCX
219 ;
220 D CLRVAR
221 Q
222 ;
223PCLN ; File all patients in selected clinic to the new position and team
224 ;
225 S SCOK1=$$PTCLBR^SCAPMC26($P($G(SCSRCE),U,2),.SCTEAM,"SCDTRNG")
226 S I=0 F S I=$O(^TMP($J,"SCCLPT",I)) Q:'I D
227 . S ^TMP($J,"SC PATIENT LIST",$P($G(^TMP($J,"SCCLPT",I)),U))=""
228 ;
229 Q
230 ;
231PSTOPC ; File all patients in with the selected stop code to the new position and team
232 ;
233 S SCOK1=$$PTST^SCAPMC27($P($G(SCSRCE),U,2),"SCDTRNG",500,.SCTMP,"SCERMSG",0)
234 M ^TMP($J,"PCMM TMP")=@SCTMP
235 S I=0 F S I=$O(^TMP($J,"PCMM TMP",I)) Q:'I D
236 . S ^TMP($J,"SC PATIENT LIST",$P($G(^TMP($J,"PCMM TMP",I)),U))=""
237 Q
238 ;
239PAPPT ;
240 S SCOK1=$$PTAP^SCAPMC28($P($G(SCSRCE),U,2),"SCDTRNG",500,.SCTMP,"SCERMSG",0)
241 M ^TMP($J,"PCMM TMP")=@SCTMP
242 S I=0 F S I=$O(^TMP($J,"PCMM TMP",I)) Q:'I D
243 . S ^TMP($J,"SC PATIENT LIST",$P($G(^TMP($J,"PCMM TMP",I)),U))=""
244 Q
245 ;
246PTEAM ;
247 S SCOK1=$$PTTM^SCAPMC2($P($G(SCSRCE),U,2),"SCDTRNG",.SCTMP,"SCERMSG")
248 M ^TMP($J,"PCMM TMP")=@SCTMP
249 S I=0 F S I=$O(^TMP($J,"PCMM TMP",I)) Q:'I D
250 . S ^TMP($J,"SC PATIENT LIST",$P($G(^TMP($J,"PCMM TMP",I)),U))=""
251 Q
252 ;
253PPOS ;
254 S SCOK1=$$PTTP^SCAPMC11($P($G(SCSRCE),U,2),"SCDTRNG",.SCTMP,"SCERMSG")
255 M ^TMP($J,"PCMM TMP")=@SCTMP
256 S I=0 F S I=$O(^TMP($J,"PCMM TMP",I)) Q:'I D
257 . S ^TMP($J,"SC PATIENT LIST",$P($G(^TMP($J,"PCMM TMP",I)),U))=""
258 Q
259 ;
260BAD(SCBAD,SCOLD,SCOK) ;
261 N SCDFN,SCPARM,DIERR
262 S SCDFN=0
263 F S SCDFN=$O(SCBAD(SCDFN)) Q:'SCDFN D
264 . S SCPARM("PATIENT")=$P($G(^DPT(SCDFN,0)),U)_" "_$P($G(^DPT(SCDFN,.36)),U,4)
265 . D BLD^DIALOG(40442001.001,.SCPARM,"","SCOK","S")
266 ;
267 F S SCDFN=$O(SCOLD(SCDFN)) Q:'SCDFN D
268 . S SCPARM("PATIENT")=$P($G(^DPT(SCDFN,0)),U)_" "_$P($G(^DPT(SCDFN,.36)),U,4)
269 . D BLD^DIALOG(40442001.002,.SCPARM,"","SCOK","S")
270 D HDREC^SCUTBK3(.SCOK,$G(DIERR),"Patient Assignment to Teams")
271 Q
272 ;
273BAD2(SCBAD,SCOLD,SCOK) ;
274 N SCDFN,SCPARM,DIERR
275 S SCDFN=0
276 F S SCDFN=$O(SCBAD(SCDFN)) Q:'SCDFN D
277 . S SCPARM("PATIENT")=$P($G(^DPT(SCDFN,0)),U)_" "_$P($G(^DPT(SCDFN,.36)),U,4)
278 . D BLD^DIALOG(40443001.001,.SCPARM,"","SCOK","S")
279 ;
280 F S SCDFN=$O(SCOLD(SCDFN)) Q:'SCDFN D
281 . S SCPARM("PATIENT")=$P($G(^DPT(SCDFN,0)),U)_" "_$P($G(^DPT(SCDFN,.36)),U,4)
282 . D BLD^DIALOG(40443001.002,.SCPARM,"","SCOK","S")
283 D HDREC^SCUTBK3(.SCOK,$G(DIERR),"Patient Assignment to Positions")
284 Q
Note: See TracBrowser for help on using the repository browser.