1 | BSDX29 ; IHS/OIT/HMW - WINDOWS SCHEDULING RPCS ; 7/9/12 11:50am
|
---|
2 | ;;1.7T2;BSDX;;Jul 11, 2012;Build 18
|
---|
3 | ; Licensed under LGPL
|
---|
4 | ;
|
---|
5 | ; Change Log:
|
---|
6 | ; v1.3 by WV/SMH on 3100713
|
---|
7 | ; - Beginning and Ending dates passed as FM Dates
|
---|
8 | ; v1.42 by WV/SMH on 3101023
|
---|
9 | ; - Transaction moved; now restartable too.
|
---|
10 | ; - Refactoring of major portions of routine
|
---|
11 | ; v1.7 by VEN/SMH on 3120622
|
---|
12 | ; - Removed transaction code; Locks added in update to prevent concurrent
|
---|
13 | ; update
|
---|
14 | ;
|
---|
15 | BSDXCPD(BSDXY,BSDXRES,BSDX44,BSDXBEG,BSDXEND) ;EP
|
---|
16 | ;Entry point for debugging
|
---|
17 | ;
|
---|
18 | ;D DEBUG^%Serenji("BSDXCP^BSDX29(.BSDXY,BSDXRES,BSDX44,BSDXBEG,BSDXEND)")
|
---|
19 | Q
|
---|
20 | ;
|
---|
21 | BSDXCP(BSDXY,BSDXRES,BSDX44,BSDXBEG,BSDXEND) ;EP
|
---|
22 | ;Copy appointments from HOSPITAL LOCATION entry BSDX44 to BSDX RESOURCE entry BSDXRES
|
---|
23 | ;Beginning with appointments on day BSDXBEG and ending on BSDXEND, inclusive
|
---|
24 | ;Called by RPC: BSDX COPY APPOINTMENTS
|
---|
25 | ;
|
---|
26 | ; Parameters:
|
---|
27 | ; - BSDXY: Global Return
|
---|
28 | ; - BSDXRES: BSDX RESOURCE to copy appointments to
|
---|
29 | ; - BSDX44: Hospital Location IEN to copy appointments from
|
---|
30 | ; - BSDXBEG: Beginning Date in FM Format
|
---|
31 | ; - BSDXEND: End Date in FM Format
|
---|
32 | ;
|
---|
33 | ;Returns ADO Recordset containing TASK_NUMBER and ERRORID
|
---|
34 | ;
|
---|
35 | ; Return Array
|
---|
36 | S BSDXY=$NA(^BSDXTMP($J))
|
---|
37 | K ^BSDXTMP($J)
|
---|
38 | ; $ET
|
---|
39 | N $ET S $ET="G ETRAP^BSDX29"
|
---|
40 | ; Counter
|
---|
41 | N BSDXI S BSDXI=0
|
---|
42 | ; Header Node
|
---|
43 | S ^BSDXTMP($J,0)="T00010TASK_NUMBER^T00100ERRORID"_$C(30)
|
---|
44 | ;
|
---|
45 | ; Make dates inclusive; add 1 to FM dates
|
---|
46 | S BSDXBEG=$$FMADD^XLFDT(BSDXBEG,-1)
|
---|
47 | S BSDXEND=$$FMADD^XLFDT(BSDXEND,+1)
|
---|
48 | ;
|
---|
49 | ; Taskman variables
|
---|
50 | N ZTSK,ZTRTN,ZTDTH,ZTDESC,ZTSAVE,ZTIO
|
---|
51 | ; Task Load
|
---|
52 | S ZTRTN="ZTM^BSDX29",ZTDTH=$H,ZTDESC="COPY PATIENT APPTS",ZTIO=""
|
---|
53 | S ZTSAVE("BSDXBEG")="",ZTSAVE("BSDXEND")="",ZTSAVE("BSDX44")="",ZTSAVE("BSDXRES")=""
|
---|
54 | D ^%ZTLOAD
|
---|
55 | ; Set up return ADO.net dataset
|
---|
56 | N BSDXST S BSDXST=$S($G(ZTSK)>0:"OK",1:"Unable to create task.")
|
---|
57 | S BSDXI=BSDXI+1
|
---|
58 | S ^BSDXTMP($J,BSDXI)=$G(ZTSK)_"^"_BSDXST_$C(30)_$C(31)
|
---|
59 | QUIT
|
---|
60 | ;
|
---|
61 | ZTMD ;EP - Debug entry point
|
---|
62 | ;D DEBUG^%Serenji("ZTM^BSDX29")
|
---|
63 | Q
|
---|
64 | ;
|
---|
65 | ZTM ;EP - Taskman entry point
|
---|
66 | ; Variables set up in ZTSAVE above
|
---|
67 | ;
|
---|
68 | Q:'$D(ZTSK)
|
---|
69 | ;
|
---|
70 | ; $ET
|
---|
71 | N $ET S $ET="G ZTMERR^BSDX29"
|
---|
72 | ;
|
---|
73 | ;$O through ^SC(BSDX44,"S",
|
---|
74 | N BSDXCNT S BSDXCNT=0 ; Count of Copied Appointments
|
---|
75 | N BSDXQUIT S BSDXQUIT=0 ; Quit Flag to be retrieved from an external proc
|
---|
76 | ; Set Count
|
---|
77 | S ^BSDXTMP("BSDXCOPY",ZTSK)=BSDXCNT
|
---|
78 | ; Loop through dates here.
|
---|
79 | F S BSDXBEG=$O(^SC(BSDX44,"S",BSDXBEG)) Q:'+BSDXBEG Q:BSDXBEG>BSDXEND Q:BSDXQUIT D
|
---|
80 | . ; Loop through Entries in each date in the subsubfile.
|
---|
81 | . ; Quit if we are at the end or if a remote process requests a quit.
|
---|
82 | . N BSDXIEN S BSDXIEN=0
|
---|
83 | . F S BSDXIEN=$O(^SC(BSDX44,"S",BSDXBEG,1,BSDXIEN)) Q:'+BSDXIEN Q:BSDXQUIT D
|
---|
84 | . . N BSDXNOD S BSDXNOD=$G(^SC(BSDX44,"S",BSDXBEG,1,BSDXIEN,0)) ; Node
|
---|
85 | . . Q:'+BSDXNOD ; Quit if no node
|
---|
86 | . . N BSDXCAN S BSDXCAN=$P(BSDXNOD,U,9) ; Cancel flag
|
---|
87 | . . Q:BSDXCAN="C" ; Quit if appt cancelled -- smh - this will never happen; cancelled appointments are normally removed from 44
|
---|
88 | . . N BSDXPAT S BSDXPAT=$P(BSDXNOD,U) ; Patient
|
---|
89 | . . N BSDXLEN S BSDXLEN=$P(BSDXNOD,U,2) ;duration in minutes
|
---|
90 | . . N BSDXCLRK S BSDXCLRK=$P(BSDXNOD,U,6) ;appt made by (clerk)
|
---|
91 | . . N BSDXMADE S BSDXMADE=$P(BSDXNOD,U,7) ;date appt made
|
---|
92 | . . N BSDXNOTE S BSDXNOTE=$P(BSDXNOD,U,4) ;'OTHER' field contains note
|
---|
93 | . . S BSDXCNT=BSDXCNT+$$XFER(BSDXRES,BSDXBEG,BSDXPAT,BSDXLEN,BSDXCLRK,BSDXMADE,BSDXNOTE)
|
---|
94 | . . I +BSDXCNT,BSDXCNT#10=0 S ^BSDXTMP("BSDXCOPY",ZTSK)=BSDXCNT_" records copied." ;every 10th record
|
---|
95 | . . I $D(^BSDXTMP("BSDXCOPY",ZTSK,"CANCEL")) S BSDXQUIT=1 ;Check for cancel flag ; smh - not used currently (v1.7)
|
---|
96 | ;
|
---|
97 | ;
|
---|
98 | S ^BSDXTMP("BSDXCOPY",ZTSK)=$S(BSDXQUIT:"Cancelled. No records copied.",1:"Finished. "_BSDXCNT_" records copied.")
|
---|
99 | Q
|
---|
100 | ;
|
---|
101 | ZTMERR ; For now, error from TM is only in trap; not returned to client.
|
---|
102 | N $ET S $ET="D ^%ZTER HALT" ; Emergency Error Trap
|
---|
103 | D ^%ZTER
|
---|
104 | QUIT
|
---|
105 | ;
|
---|
106 | XFER(BSDXRES,BSDXBEG,BSDXPAT,BSDXLEN,BSDXCLRK,BSDXMADE,BSDXNOTE) ;EP
|
---|
107 | ;
|
---|
108 | ;Copy record to BSDX APPOINTMENT file
|
---|
109 | ;Return 1 if record copied, otherwise 0
|
---|
110 | ;
|
---|
111 | N REF
|
---|
112 | S REF=$NA(^BSDXLOCK(BSDXRES,BSDXBEG,BSDXPAT)) ; This combo is unique
|
---|
113 | L +@REF:0 E Q 0
|
---|
114 | ;
|
---|
115 | ;$O Thru ^BSDXAPPT to determine if this appt already added
|
---|
116 | N BSDXEND,BSDXIEN,BSDXFND,BSDXPAT2,BSDXNOD
|
---|
117 | S BSDXIEN=0,BSDXFND=0
|
---|
118 | F S BSDXIEN=$O(^BSDXAPPT("ARSRC",BSDXRES,BSDXBEG,BSDXIEN)) Q:'+BSDXIEN D Q:BSDXFND
|
---|
119 | . S BSDXNOD=$G(^BSDXAPPT(BSDXIEN,0))
|
---|
120 | . Q:'+BSDXNOD
|
---|
121 | . S BSDXPAT2=$P(BSDXNOD,U,5)
|
---|
122 | . S BSDXFND=0
|
---|
123 | . I BSDXPAT2=BSDXPAT S BSDXFND=1
|
---|
124 | . Q
|
---|
125 | I BSDXFND L -@REF Q 0
|
---|
126 | ;
|
---|
127 | ;Add to BSDX APPOINTMENT
|
---|
128 | S BSDXEND=BSDXBEG
|
---|
129 | ;Calculate ending time from beginning time and duration.
|
---|
130 | S BSDXEND=$$ADDMIN(BSDXBEG,BSDXLEN)
|
---|
131 | N BSDXFDA,BSDXIENS
|
---|
132 | S BSDXIENS="+1,"
|
---|
133 | S BSDXFDA(9002018.4,BSDXIENS,.01)=BSDXBEG
|
---|
134 | S BSDXFDA(9002018.4,BSDXIENS,.02)=BSDXEND
|
---|
135 | S BSDXFDA(9002018.4,BSDXIENS,.05)=BSDXPAT
|
---|
136 | S BSDXFDA(9002018.4,BSDXIENS,.07)=BSDXRES
|
---|
137 | S BSDXFDA(9002018.4,BSDXIENS,.08)=BSDXCLRK
|
---|
138 | S BSDXFDA(9002018.4,BSDXIENS,.09)=BSDXMADE
|
---|
139 | ;
|
---|
140 | K BSDXIEN
|
---|
141 | ;
|
---|
142 | D UPDATE^DIE("","BSDXFDA","BSDXIEN","BSDXMSG")
|
---|
143 | S BSDXIEN=+$G(BSDXIEN(1))
|
---|
144 | I '+BSDXIEN L -@REF Q 0
|
---|
145 | ;
|
---|
146 | ;Add WP field
|
---|
147 | I BSDXNOTE]"" S BSDXNOTE(.5)=BSDXNOTE,BSDXNOTE="" D
|
---|
148 | . D WP^DIE(9002018.4,BSDXIEN_",",1,"","BSDXNOTE","BSDXMSG")
|
---|
149 | L -@REF
|
---|
150 | ;
|
---|
151 | Q 1
|
---|
152 | ;
|
---|
153 | ERR(BSDXI,BSDXCNT,BSDXERR) ;Error processing
|
---|
154 | ; If last line is $C(31), we are done. No more errors to send to client.
|
---|
155 | I ^BSDXTMP($J,$O(^BSDXTMP($J," "),-1))=$C(31) QUIT
|
---|
156 | S BSDXI=BSDXI+1
|
---|
157 | S BSDXERR=$TR(BSDXERR,"^","~")
|
---|
158 | S ^BSDXTMP($J,BSDXI)=BSDXCNT_"^"_BSDXERR_$C(30)
|
---|
159 | S BSDXI=BSDXI+1
|
---|
160 | S ^BSDXTMP($J,BSDXI)=$C(31)
|
---|
161 | Q
|
---|
162 | ;
|
---|
163 | ETRAP ;EP Error trap entry
|
---|
164 | ; No Txn here. So don't rollback anything
|
---|
165 | N $ET S $ET="D ^%ZTER HALT" ; Emergency Error Trap
|
---|
166 | D ^%ZTER
|
---|
167 | S $EC="" ; Clear error
|
---|
168 | I '$D(BSDXI) N BSDXI S BSDXI=0
|
---|
169 | D ERR(BSDXI,$G(BSDXCNT),"~100~BSDX29, Error: "_$G(%ZTERZE))
|
---|
170 | Q
|
---|
171 | ;
|
---|
172 | CPSTAT(BSDXY,BSDXTSK) ;EP - Note: As of Dec 6 2010: Inactive Code
|
---|
173 | ;Return status (copied record count) of tasked job having ZTSK=BSDXTSK
|
---|
174 | ;
|
---|
175 | S BSDXY="^BSDXTMP("_$J_")"
|
---|
176 | N BSDXI,BSDXCNT
|
---|
177 | S BSDXI=0
|
---|
178 | S X="ETRAP^BSDX29",@^%ZOSF("TRAP")
|
---|
179 | S ^BSDXTMP($J,0)="T00020RECORD_COUNT^T00020ERRORID"_$C(30)
|
---|
180 | S BSDXCNT=$G(^BSDXTMP("BSDXCOPY",BSDXTSK))
|
---|
181 | I BSDXCNT["Finished" K ^BSDXTMP("BSDXCOPY",BSDXTSK)
|
---|
182 | I BSDXCNT["Cancelled" K ^BSDXTMP("BSDXCOPY",BSDXTSK)
|
---|
183 | ;I $D(^BSDXTMP("BSDXCOPY",BSDXTSK,"CANCEL")) K ^BSDXTMP("BSDXCOPY",BSDXTSK)
|
---|
184 | S BSDXI=BSDXI+1
|
---|
185 | S ^BSDXTMP($J,BSDXI)=BSDXCNT_"^"_"OK"_$C(30)_$C(31)
|
---|
186 | Q
|
---|
187 | ;
|
---|
188 | CPCANC(BSDXY,BSDXTSK) ;EP Note: As of Dec 6 2010: Inactive code.
|
---|
189 | ;Signal tasked job having ZTSK=BSDXTSK to cancel
|
---|
190 | ;Returns current record count of copy process
|
---|
191 | ;
|
---|
192 | S BSDXY="^BSDXTMP("_$J_")"
|
---|
193 | N BSDXI,BSDXCNT
|
---|
194 | S BSDXI=0
|
---|
195 | S X="ETRAP^BSDX29",@^%ZOSF("TRAP")
|
---|
196 | S ^BSDXTMP($J,0)="T00020RECORD_COUNT^T00020ERRORID"_$C(30)
|
---|
197 | S BSDXCNT=$G(^BSDXTMP("BSDXCOPY",BSDXTSK))
|
---|
198 | I BSDXCNT["FINISHED" K ^BSDXTMP("BSDXCOPY",BSDXTSK)
|
---|
199 | E S ^BSDXTMP("BSDXCOPY",BSDXTSK,"CANCEL")=""
|
---|
200 | S BSDXI=BSDXI+1
|
---|
201 | S ^BSDXTMP($J,BSDXI)=BSDXCNT_"^"_"OK"_$C(30)_$C(31)
|
---|
202 | Q
|
---|
203 | ;
|
---|
204 | ADDMIN(BSDXSTRT,BSDXLEN) ;
|
---|
205 | ;
|
---|
206 | ;Add BSDXLEN minutes to time BSDXSTRT and return end time
|
---|
207 | N BSDXEND,BSDXH,BSDXM,BSDXSTIM,BSDXETIM
|
---|
208 | S BSDXEND=$P(BSDXSTRT,".")
|
---|
209 | ;
|
---|
210 | ;Convert start time to minutes past midnight
|
---|
211 | S BSDXSTIM=$P(BSDXSTRT,".",2)
|
---|
212 | S BSDXSTIM=BSDXSTIM_"0000"
|
---|
213 | S BSDXSTIM=$E(BSDXSTIM,1,4)
|
---|
214 | S BSDXH=$E(BSDXSTIM,1,2)
|
---|
215 | S BSDXH=BSDXH*60
|
---|
216 | S BSDXH=BSDXH+$E(BSDXSTIM,3,4)
|
---|
217 | ;
|
---|
218 | ;Add duration to find minutes past midnight of end time
|
---|
219 | S BSDXETIM=BSDXH+BSDXLEN
|
---|
220 | ;
|
---|
221 | ;Convert back to a time
|
---|
222 | S BSDXH=BSDXETIM\60
|
---|
223 | S BSDXH="00"_BSDXH
|
---|
224 | S BSDXH=$E(BSDXH,$L(BSDXH)-1,$L(BSDXH))
|
---|
225 | S BSDXM=BSDXETIM#60
|
---|
226 | S BSDXM="00"_BSDXM
|
---|
227 | S BSDXM=$E(BSDXM,$L(BSDXM)-1,$L(BSDXM))
|
---|
228 | S BSDXETIM=BSDXH_BSDXM
|
---|
229 | I BSDXETIM>2400 S BSDXETIM=2400
|
---|
230 | S $P(BSDXEND,".",2)=BSDXETIM
|
---|
231 | Q BSDXEND
|
---|