source: Scheduling/trunk/m/BSDX29.m@ 1383

Last change on this file since 1383 was 1187, checked in by Sam Habiel, 14 years ago

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