source: WorldVistAEHR/trunk/r/SCHEDULING-SD-SC/SCMCCV6.m@ 1096

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

initial load of WorldVistAEHR

File size: 7.7 KB
Line 
1SCMCCV6 ;BP/CMF - PCMM HL7 Baseline Xmit to AAC ; March 26, 2000
2 ;;5.3;Scheduling;**212**;AUG 13, 1993
3 ;
4 ;Traverse PATIENT TEAM POSITION ASSIGNMENT file (#404.43)
5 ;and create events in file (#404.48) for all entries that meet
6 ;the following criteria:
7 ; 1. Field PC ROLE=1 ;..Primary Care
8 ; -- and one of the following --
9 ; 2a. assignment is active as of SD*5.3*212 run date (now!)
10 ; 2b. assignment was active as of SD*5.3*177 install date
11 ; 2c. assignment was active between 2a and 2b
12 ;
13 ;
14 W !,"This is not an interactive entry point."
15 W !,"This routine should only be executed by IRM staff"
16 W !," -- ONCE --"
17 W !,"using Taskman to Queue option 'PCMM BASELINE SEEDING'"
18 W !,"to run during a non-busy period."
19 Q
20 ;
21EN(SCTST,SCDFN) ;
22 ; entry point for option 'SCMC PCMM BASELINE SEEDING'
23 ; this option should not be on any users menu
24 ; this option should be queued to run once
25 ; it should not be run more than once without consulting NVS
26 ;
27 ; input
28 ; SCTST - 1 = test [default = 0]
29 ; SCDFN - Patient IEN used to seed for restarts only [default = 0]
30 ;
31 S SCTST=+$G(SCTST,0)
32 S SCDFN=+$G(SCDFN,0)
33 N SCP177 ; patch 177 install date
34 N SCP212 ; patch 212 run date
35 N SC1,SC2 ; message holders
36 N SCARRAY ; message text array
37 N SCSTIM ; process start time
38 S SCSTIM=$$HTE^XLFDT($H)
39 S SC1="PCMM PC Baseline Seed Process Aborted:"
40 ;
41 I $$VPATCH^SCUTBK3("SD*5.3*177")=0 D Q
42 . S SC2=" PCMM Patch 'SD*5.3*177' has not been loaded!"
43 . D MSG(SC1,SC2)
44 . Q
45 ;
46 I $$VPROGMR^SCUTBK3()=0 D Q
47 . S SC2=" User must have 'XUPROG' key!"
48 . D MSG(SC1,SC2)
49 . Q
50 ;
51 S SCP212=$$CHECK()
52 I SCP212'="" D Q
53 . I +SCP212 D Q
54 . . S SC2=" PCMM Baseline seeded on "_$$FMTE^XLFDT(SCP212)_"."
55 . . D MSG(SC1,SC2)
56 . . Q
57 . I SCP212=-1 D Q
58 . . S SC2=" Missing PCMM Parameter file entry."
59 . . D MSG(SC1,SC2)
60 . . Q
61 . I SCP212=-2 D Q
62 . . S SC2=" FM Error retrieving data from PCMM Parameter file."
63 . . D MSG(SC1,SC2)
64 . . Q
65 . S SC2=" Undefined Error."
66 . D MSG(SC1,SC2)
67 . Q
68 ;
69 S SCP177=$$PDAT^SCMCGU("SD*5.3*177")
70 I +SCP177=0 D Q
71 . S SC2=" Unable to obtain SD*5.3*177 Installation Date."
72 . D MSG(SC1,SC2)
73 . Q
74 ;
75 I $$BASELINE(SCP177,DT,SCDFN,SCTST)'=1 D Q
76 . S SC2=" PCMM PC Baseline failed"_$$FMTE^XLFDT($$NOW^XLFDT)_"."
77 . D MSG(SC1,SC2)
78 . Q
79 ;
80 Q
81 ;
82BASELINE(SCP177,SCP212,SCPDFN,SCPTST) ;
83 ; input
84 ; SCP177 = Patch 177 date (required)
85 ; SCP212 = Patch 212 date (optional, default = today)
86 ; SCPDFN = Patient ien (optional, default = 0)
87 ; SCPTST = 1 := test [default = 0]
88 ;
89 ; output
90 ; 1 = success
91 ; 0 = failure
92 ;
93 N SCFLAG,SC1,SC2
94 S SC1="PCMM PC Baseline Process Failure:"
95 S SC177=$G(SCP177,"")
96 I SC177="" D Q 0
97 . S SC2=" Invalid SD*5.3*177 Date Parameter"
98 . D MSG(SC1,SC2)
99 . Q
100 S SC212=$G(SCP212,DT)
101 I SC212="" D Q 0
102 . S SC2=" Invalid SD*5.3*212 Date (DT) Parameter"
103 . D MSG(SC1,SC2)
104 . Q
105 S SCDFN=$G(SCPDFN,0)
106 I SCDFN="" D Q 0
107 . S SC2=" Invalid DFN Parameter"
108 . D MSG(SC1,SC2)
109 . Q
110 I '$D(^SCPT(404.43,"APCPOS")) D Q 0
111 . S SC2=" Missing ""APCPOS"" x-ref in file 404.43!"
112 . D MSG(SC1,SC2)
113 . Q
114 ;
115 S SCTST=+$G(SCPTST,0)
116 S SCFLAG=$$EVENT(SC177,SC212,SCDFN,SCTST)
117 ;
118 I SCTST=1 D MSG("","",+SCFLAG) Q 1
119 N SCFDA,SCERR,SC1,SC2
120 S SC1="PCMM PC Baseline Seeding"
121 S SC2=+$P(SCFLAG,U,2)
122 S SCFLAG=+$P(SCFLAG,U)
123 S SC1=SC1_$S(+SC2:" stopped by TM stop request:",1:" completed:")
124 S SCFDA(1,404.44,"1,",17)=SC212
125 D FILE^DIE("","SCFDA(1)","SCERR")
126 I $D(SCERR) D
127 . S SC2=" Caution: Baseline Date NOT updated in PCMM Parameter file"
128 . D MSG(SC1,SC2)
129 . Q
130 S SC2=" "_SCFLAG_" assignments placed in HL7 transmission queue."
131 D MSG(SC1,SC2)
132 Q 1
133 ;
134CHECK() ;
135 ; Description: Determine whether or not the Baseline has run.
136 ;
137 ; Input: None
138 ;
139 ; Output:
140 ; Function Value: Return date Baseline was run
141 ;
142 N SCX
143 I '$D(^SCTM(404.44,1)) Q -1
144 K ^TMP($J,"SCMCCV6")
145 S SCX=$$GET1^DIQ(404.44,"1,",17,"I","","^TMP($J,""SCMCCV6"")")
146 I $D(^TMP($J,"SCMCCV6")) S SCX=-2
147 K ^TMP($J,"SCMCCV6")
148 Q SCX
149 ;
150 ;
151EVENT(SC177,SC212,SCDFN,SCTST) ;
152 ; Description: Create an Event in file (#404.48)
153 ;
154 ; Input:
155 ; SC177 - date patch SD*5.3*177 was installed. [required]
156 ; SC212 - date process runs [default = DT]
157 ; SCDFN - patient ien (ptr file 2) [default = 0]
158 ; SCTST - 1 = test [default = 0]
159 ;
160 ; Output:
161 ; p1 = number of entries created
162 ; p2 = stopped by Taskman
163 ;
164 N SCCNT ; counter
165 N SCPAI ; position assignment IEN (ptr file 404.43)
166 N SCTP ; team position IEN (ptr file 404.57)
167 N SCADT ; position assignment start date
168 N SCDDT ; position assignment end date
169 N SCNOW ; time process starts
170 N SCVAR ; variable pointer string for HL7
171 N SC1 ; shorthand for ' "APCPOS",SCDFN,1 ' node
172 N SCZ ; Taskman flag to stop process
173 ;
174 ; check for ZSTOP
175 S SCZ=$$S^%ZTLOAD
176 I +SCZ Q 0_U_1
177 S SCTST=+$G(SCTST,0)
178 K ^XTMP("SCMCCV6")
179 S ^XTMP("SCMCCV6",0)=DT_U_$$FMADD^XLFDT(""_DT_"",7)_U_"SCMC PCMM BASELINE SEEDING"
180 S SCNOW=$$NOW^XLFDT
181 S SCCNT=0
182 S SCDFN=+SCDFN
183 F S SCDFN=$O(^SCPT(404.43,"APCPOS",SCDFN)) Q:(SCDFN="")!(SCZ) D
184 . S SCZ=$$S^%ZTLOAD
185 . Q:+SCZ
186 . ;
187 . S ^XTMP("SCMCCV6","LASTDFN")=SCDFN
188 . S SC1="^SCPT(404.43,""APCPOS"",SCDFN,1)"
189 . ;
190 . ; quit if no PC assignments
191 . Q:'$D(@SC1)
192 . S SCADT=0
193 . F S SCADT=$O(@SC1@(SCADT)) Q:SCADT="" D
194 . . S SCTP=0
195 . . F S SCTP=$O(@SC1@(SCADT,SCTP)) Q:'SCTP D
196 . . . ;
197 . . . ; quit if team position does not exist
198 . . . Q:'$D(^SCTM(404.57,SCTP,0))
199 . . . S SCPAI=0
200 . . . F S SCPAI=$O(@SC1@(SCADT,SCTP,SCPAI)) Q:'SCPAI D
201 . . . . S SCDDT=$P($G(^SCPT(404.43,SCPAI,0)),U,4)
202 . . . . ;
203 . . . . ; quit if not active within date range
204 . . . . Q:$$DTCHK^SCAPU1(SC177,SC212,0,SCADT,SCDDT)<1
205 . . . . S SCVAR=SCPAI_";SCPT(404.43,"
206 . . . . ;
207 . . . . ; add to HL7 event file
208 . . . . Q:$$CHECK^SCMCHLB1(SCVAR)'=1
209 . . . . ;
210 . . . . ; queue for transmit or report
211 . . . . I SCTST=0 D ADD^SCMCHLE("NOW",SCVAR,SCDFN,SCTP)
212 . . . . I SCTST=1 S SCARRAY(SCCNT+3)=SCVAR_" ^ "_$$GET1^DIQ(2,SCDFN_",",.01)_" ^ "_$$GET1^DIQ(404.57,SCTP_",",.01)_" ^ "_$$FMTE^XLFDT(SCADT)_" ^ "_$$FMTE^XLFDT(SCDDT)
213 . . . . ;
214 . . . . ; increment counter
215 . . . . S SCCNT=SCCNT+1
216 . . . . Q
217 . . . Q
218 . . Q
219 . Q
220 ;
221 Q SCCNT_U_SCZ
222 ;
223MSG(SC1,SC2,SCTST) ;
224 N XMY,XMDUZ,XMSUB,XMTEXT
225 S SCTST=+$G(SCTST,0)
226 S XMDUZ="PCMM Module"
227 S (XMY(DUZ),XMY(XMDUZ))=""
228 I SCTST=0 D
229 . S XMSUB="PCMM PC Baseline Seeding Job"
230 . K SCARRAY
231 . S SCARRAY(1)=""
232 . S SCARRAY(2)=SC1
233 . S SCARRAY(3)=SC2
234 . S SCARRAY(4)=""
235 . S SCARRAY(5)="TaskMan Job Number: "_$G(ZTSK)
236 . S SCARRAY(6)="Baseline Start Date/Time: "_$G(SCSTIM)
237 . S SCARRAY(7)="Baseline End Date/Time: "_$$HTE^XLFDT($H)
238 . S SCARRAY(8)="HL7 Transmit Limit: "_$$GET1^DIQ(404.44,"1,",15)
239 . S SCARRAY(9)=""
240 . Q
241 E D
242 . S XMSUB="PCMM PC Baseline Trial Entries ("_$G(ZTSK)_")"
243 . S SCARRAY(1)=""
244 . S SCARRAY(2)=SCTST_" entries would have been placed in HL7 queue:"
245 . S SCARRAY(3)="==================================================="
246 S XMTEXT="SCARRAY("
247 D ^XMD
248 Q
249 ;
250RESTART(SCTST) ; alb/rpm
251 ; This undocumented entry point allows a user to clear the Baseline
252 ; date stored in file #404.44 field #17. Then the last patient IEN
253 ; that was processed from the last run is retrieved from ^XTMP("SCMCCV6"
254 ; and decremented to seed the restart point. If ^XTMP does not exist
255 ; the IEN is set to 0.
256 ;
257 ; Input:
258 ; SCTST - 1 = test [default = 0]
259 ;
260 S SCTST=+$G(SCTST,0)
261 ;
262 NEW SC1,SC2,SCDFA,SCDFN,SCERR
263 S SC1="PCMM PC Baseline Seeding"
264 S SCDFN=0
265 ; Retrieve the last IEN processed
266 I +$G(^XTMP("SCMCCV6","LASTDFN"))>0 D
267 . S SCDFN=+$G(^XTMP("SCMCCV6","LASTDFN"))-1
268 ; Delete the Baseline date from last run
269 S SCFDA(1,404.44,"1,",17)="@"
270 D FILE^DIE("","SCFDA(1)","SCERR")
271 I $D(SCERR) D Q
272 . S SC2=" Warning: Baseline Date NOT cleared in PCMM Parameter file"
273 . D MSG(SC1,SC2)
274 . Q
275 ; Call interactive entry point
276 D EN(SCTST,SCDFN)
277 Q
Note: See TracBrowser for help on using the repository browser.