source: WorldVistAEHR/trunk/r/SCHEDULING-SD-SC/SCMCCV2.m@ 1147

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

initial load of WorldVistAEHR

File size: 8.2 KB
Line 
1SCMCCV2 ;ALB/JLU;PC Attending conversion;6/4/1999
2 ;;5.3;Scheduling;**195**;AUG 13, 1993
3 ;
4STRTQJOB ;this is the start of the queue job to convert PC Attending
5 ;Assignments.
6 ;The following variables are defined when the job starts
7 ;SCMCTM(X) the array of team IENs as subscripts
8 ;SCMCPOS(X) the array of positions as subscripts
9 ;SCMCFIX is set to either F for fix of C for Check
10 ;SCMCTYPE is set to A for ALL, T for team or P for position
11 ;
12 N STOP,ZSTOP,SCMCCNT
13 S SCMCCNT="0^0^0" ;total count^fixed count^err count
14 S (STOP,ZSTOP)=0
15 D INIT^SCMCCV1
16 D BLDLIST
17 D:$D(^TMP("SCMC",$J)) PROCLIST
18 D MAIL ;WATCH FOR ZSTOP
19 K ^TMP("SCMC",$J),^XTMP("SCMCATTCONV")
20 Q
21 ;
22 ;
23BLDLIST ;gathers all the PC Attending Assignments within PCMM database.
24 ;this will be placed in the following global for processing
25 ;^TMP("SCMC",$J,TM IEN,POS IEN,POS ASGN IEN 404.43)=DFN^ASGNDT
26 ;
27 N DFN,ASGNDT,TMPOS,POSASGN,TMASGN,TMASGNZ,TM
28 K ^TMP("SCMC",$J)
29 ;
30 F DFN=0:0 S DFN=$O(^SCPT(404.43,"APCPOS",DFN)) Q:DFN="" F ASGNDT=0:0 S ASGNDT=$O(^SCPT(404.43,"APCPOS",DFN,2,ASGNDT)) Q:ASGNDT="" DO
31 .F TMPOS=0:0 S TMPOS=$O(^SCPT(404.43,"APCPOS",DFN,2,ASGNDT,TMPOS)) Q:TMPOS="" F POSASGN=0:0 S POSASGN=$O(^SCPT(404.43,"APCPOS",DFN,2,ASGNDT,TMPOS,POSASGN)) Q:POSASGN="" DO
32 ..S TMASGN=+$G(^SCPT(404.43,POSASGN,0))
33 ..I 'TMASGN Q
34 ..I +$P(^SCPT(404.43,POSASGN,0),U,4),$P(^(0),U,4)<DT Q ;has a discharge date in the past.
35 ..S TMASGNZ=$G(^SCPT(404.42,TMASGN,0))
36 ..I 'TMASGNZ Q
37 ..S TM=$P(TMASGNZ,U,3)
38 ..I 'TM Q
39 ..S ^TMP("SCMC",$J,TM,TMPOS,POSASGN)=DFN_"^"_ASGNDT
40 ..Q
41 .Q
42 Q
43 ;
44 ;
45PROCLIST ;works through the list built by the builder via the SCMCTYPE
46 ;checks are done to ensure the convert can happen then it is converted.
47 ;
48 ;TMP GLOBAL ^TMP("SCMC",$J,TEAM IEN, POS IEN, POS ASSIGNMENT IEN)="DFN^
49 ;ASSIGNMENT DATE FM FORMAT"
50 ;
51 N TM,POS,POSASGNZ,POSASGN
52 ;
53 F TM=0:0 S TM=$O(^TMP("SCMC",$J,TM)) Q:+TM<1!(ZSTOP) F POS=0:0 S POS=$O(^TMP("SCMC",$J,TM,POS)) Q:POS=""!(ZSTOP) F POSASGN=0:0 S POSASGN=$O(^TMP("SCMC",$J,TM,POS,POSASGN)) Q:POSASGN="" DO Q:(ZSTOP)
54 .N PAT,TMPZ,SSN,ASGNDTI,ASGNDTE,DFN,Y
55 .S TMPZ=^TMP("SCMC",$J,TM,POS,POSASGN)
56 .S DFN=$P(TMPZ,U,1)
57 .S PAT=$P(^DPT($P(TMPZ,U,1),0),U,1)
58 .S SSN=$P(^(0),U,9) ;naked from line before
59 .S (ASGNDTI,Y)=$P(TMPZ,U,2)
60 .D DD^%DT
61 .S ASGNDTE=Y
62 .I SCMCTYPE="A" D CONVERT
63 .I SCMCTYPE="T",$D(SCMCTM(TM)) D CONVERT
64 .I SCMCTYPE="P",$D(SCMCPOS(POS)) D CONVERT
65 .I '($P(SCMCCNT,U,1)#50) S ZSTOP=$S($$S^%ZTLOAD:1,1:0)
66 .Q
67 Q
68 ;
69 ;
70BPERCNT ;bumps the error counter
71 S $P(SCMCCNT,U,3)=$P(SCMCCNT,U,3)+1
72 Q
73 ;
74BPTOTCNT ;bumps the total counter
75 S $P(SCMCCNT,U,1)=$P(SCMCCNT,U,1)+1
76 Q
77 ;
78BPFXCNT ;bumps the fixed counter
79 S $P(SCMCCNT,U,2)=$P(SCMCCNT,U,2)+1
80 Q
81 ;
82 ;
83SETERR(ERR) ;set the error into the error global array.
84 ;accepts ERR as the error message
85 ;
86 N EXTTM,EXTPOS,LAST
87 S EXTPOS=$P(^SCTM(404.57,POS,0),U,1)
88 S EXTTM=$P(^SCTM(404.51,TM,0),U,1)
89 ;
90 ;sets up the name of the provider for this position
91 I '$D(^TMP("SCMC",$J,"ERR",EXTTM,EXTPOS)) DO
92 .N VAR,SCDATES,SCMCPROV,SCMCERR
93 .S SCDATES("INCL")=1
94 .S VAR=$$PRTP^SCAPMC8(POS,"SCDATES","SCMCPROV","SCMCERR")
95 .I 'VAR Q
96 .;there should be only one provider for this day
97 .S ^TMP("SCMC",$J,"ERR",EXTTM,EXTPOS)=$S($D(SCMCPROV(1)):$P(SCMCPROV(1),U,2),1:"No active provider")
98 .Q
99 ;
100 ;
101 I '$D(^TMP("SCMC",$J,"ERR",EXTTM,EXTPOS,DFN)) S ^TMP("SCMC",$J,"ERR",EXTTM,EXTPOS,DFN,1)=PAT_"^"_SSN_"^"_ASGNDTE
102 ;
103 S LAST=$O(^TMP("SCMC",$J,"ERR",EXTTM,EXTPOS,DFN,9999999),-1)
104 S ^TMP("SCMC",$J,"ERR",EXTTM,EXTPOS,DFN,LAST+1)=ERR
105 Q
106 ;
107 ;
108CONVERT ;performs two checks then calls the tag to conver data.
109 ;
110 N ERR,VARONE,REASSIGN
111 D BPTOTCNT
112 ;
113 S VARONE=$$YSPTTPPC^SCMCTPU2(DFN,ASGNDTI,1)
114 I 'VARONE DO
115 .IF $P(VARONE,U,2)["future" D FUTURE^SCMCCV1 I 1
116 .E S ERR="-"_$P(VARONE,U,2) D SETERR(ERR)
117 .Q
118 ;
119 S VARONE='$$CHKTM(POSASGN,.ERR)
120 ;
121 I $D(ERR) D BPERCNT
122 I '$D(ERR) DO
123 .I SCMCFIX="F" D @$S($D(REASSIGN):"REASGN",1:"CHANGE^SCMCCV1("_POSASGN_")")
124 .D BPFXCNT ;also counts a fix if in check mode.
125 .Q
126 ;
127CONQ Q
128 ;
129 ;
130REASGN ;discharge old PC Attending and makes new PC Practitioner for today.
131 ;
132 N VARTHREE,RETURN,FIELDS,SCCONER
133 S SCCONER="^TMP(""SCMC"",$J,""JUNK"")"
134 S VARTHREE=$$INPTTP^SCAPMC(DFN,POSASGN,DT-1,SCCONER)
135 I 'VARTHREE S ERR="-Could not discharge old PC Attending Assignment "_POSASGN D SETERR(ERR) Q
136 S FIELDS(.05)=1,FIELDS(.06)=$G(DUZ,.5),FIELDS(.07)=DT
137 S RETURN=$$ACPTTP^SCAPMC21(DFN,POS,"FIELDS",DT,SCCONER)
138 K @SCCONER
139 I $P(RETURN,U,2)=1 Q
140 D REOPEN^SCMCCV1
141 S ERR="-Could not create a new position assignment. PC Attending reactivated." D SETERR(ERR)
142 Q
143 ;
144 ;
145CHKTM(ASGIEN,ERR) ;Performs checks on the team assignments
146 ;
147 N TMASGN,RES,POSASGNZ
148 S RES=1
149 ;
150 S POSASGNZ=$G(^SCPT(404.43,ASGIEN,0))
151 I POSASGNZ="" S ERR="-Missing Patient Team Position Assignment.",RES=0 D SETERR(ERR)
152 ;
153 S TMASGN=$P(POSASGNZ,U,1)
154 I +TMASGN'>0 S ERR="-Bad team assignment pointer.",RES=0 D SETERR(ERR)
155 ;
156 S TMASGN=$G(^SCPT(404.42,TMASGN,0))
157 I TMASGN="" S ERR="-Missing Team Assignment.",RES=0 D SETERR(ERR)
158 ;
159 I $P(TMASGN,U,9)>0 S ERR="-Patient Team Assignment status is discharged.",RES=0 D SETERR(ERR)
160 ;
161 I $P(TMASGN,U,8)'=1 S ERR="-PC Role only allowed if Patient Team Assignment is for Primary Care",RES=0 D SETERR(ERR)
162 ;
163CHKQ Q RES
164 ;
165 ;
166MAIL ;sets up message for conversion and delivers.
167 ;
168 N XMY,XMTEST,XMSUB,XMDUZ,CNTR
169 ;
170 D INIT^SCMCCV1
171 I '$D(^TMP("SCMC",$J)) D
172 . D SET("")
173 . D SET("No PC Attending Assignments to evaluate!")
174 . Q
175 E D
176 . D TEXT
177 . D TOTALS
178 . D ERRORS
179 . Q
180 D ^XMD
181 Q
182 ;
183 ;
184TEXT ;fills in the text of the message
185 ;
186 D HDR
187 I SCMCTYPE="A" D LISTA
188 I SCMCTYPE="T" D LISTT
189 I SCMCTYPE="P" D LISTP
190 I ZSTOP D STOPPED
191 Q
192 ;
193 ;
194HDR ;header for check mode.
195 ;
196 D SET("The conversion software was run in a "_$S(SCMCFIX="C":"'CHECK'",1:"'FIX'")_" mode.")
197 ;
198 I SCMCFIX="C" D SET("No actual conversion took place.")
199 E DO
200 .D SET("When possible the PC Attending assignment was changed to PC Practitioner.")
201 .D SET("If it could not be converted an error message is listed and the assignment was left in its original state.")
202 .Q
203 ;
204 D SET("")
205 Q
206 ;
207 ;
208LISTA ;
209 D SET("All PCMM Teams and Positions were reviewed.")
210 Q
211 ;
212 ;
213LISTT ;
214 N VAR
215 D SET("Team(s):")
216 S VAR=0
217 F S VAR=$O(SCMCTM(VAR)) Q:VAR="" D SET($P(^SCTM(404.51,VAR,0),U,1))
218 D SET(" ")
219 D SET("All positions for each team are included.")
220 Q
221 ;
222 ;
223LISTP ;
224 N VAR
225 D SET("Team:")
226 S VAR=$O(SCMCTM(0))
227 D SET($P(^SCTM(404.51,VAR,0),U,1))
228 D SET(" ")
229 D SET("Position(s):")
230 S VAR=0
231 F S VAR=$O(SCMCPOS(VAR)) Q:VAR="" D SET($P(^SCTM(404.57,VAR,0),U,1))
232 Q
233 ;
234 ;
235TOTALS ;fills the totals into the message.
236 ;
237 D SET(" ")
238 D SET(" ")
239 D SET("Assignments reviewed: "_$P(SCMCCNT,U,1))
240 D SET("Assignments "_$S(SCMCFIX="C":"that would have been ",1:"")_"converted: "_$P(SCMCCNT,U,2))
241 D SET("Assignments that could not be converted: "_$P(SCMCCNT,U,3))
242 D SET(" ")
243 Q
244 ;
245 ;
246ERRORS ;load in the error messages into the report.
247 ;
248 ;^TMP("SCMC",$J,"ERR",TEAM,POSITION,DFN,1) = PATIENT^SSN^ASSIGNMENT DATE
249 ;
250 N VAR
251 D SET(" ")
252 D SET(" ")
253 D SET("The following assignments could not be converted and why:")
254 D SET(" ")
255 D SET("Patient Name SSN Team Position Assignment Date")
256 D SET("------------------------------------------------------------------------------")
257 ;
258 N TM,POS,ASGNDT,DFN
259 S TM=""
260 F S TM=$O(^TMP("SCMC",$J,"ERR",TM)) Q:TM="" DO
261 .D SET(" ")
262 .D SET(" ")
263 .D SET("Team==> "_TM)
264 .S POS="" F S POS=$O(^TMP("SCMC",$J,"ERR",TM,POS)) Q:POS="" DO
265 ..D SET("Position==> "_POS_" ("_^TMP("SCMC",$J,"ERR",TM,POS)_")")
266 ..F DFN=0:0 S DFN=$O(^TMP("SCMC",$J,"ERR",TM,POS,DFN)) Q:DFN="" DO
267 ...N PAT,VAR1,LP,ERR,TITLE
268 ...S VAR1=^TMP("SCMC",$J,"ERR",TM,POS,DFN,1)
269 ...S TITLE=$P(VAR1,U,1)
270 ...D PADTO(25,.TITLE)
271 ...S TITLE=TITLE_$E($P(VAR1,U,2),6,9)
272 ...D PADTO(31,.TITLE)
273 ...S TITLE=TITLE_$E(TM,1,15)
274 ...D PADTO(48,.TITLE)
275 ...S TITLE=TITLE_$E(POS,1,15)
276 ...D PADTO(65,.TITLE)
277 ...S TITLE=TITLE_$P(VAR1,U,3)
278 ...D SET(TITLE)
279 ...F LP=2:1 S ERR=$G(^TMP("SCMC",$J,"ERR",TM,POS,DFN,LP)) Q:ERR="" D SET(" "_ERR)
280 ...Q
281 ..Q
282 .Q
283 Q
284 ;
285 ;
286PADTO(TOT,VAR) ;
287 S VAR=$$LJ^XLFSTR(VAR,TOT)
288 Q
289 ;
290 ;
291SET(X) ;sets data into the correct mail storage global
292 ;
293 S CNTR=CNTR+1
294 S ^TMP("SCMC",$J,"MSG",CNTR,0)=X
295 Q
296 ;
297 ;
298STOPPED ;
299 D SET(" ")
300 D SET("*** The conversion job was stopped by request.")
301 D SET("*** Some data was still processed.")
302 D SET("*** Contact your IRM for more information. ***")
303 Q
Note: See TracBrowser for help on using the repository browser.