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

Last change on this file since 1187 was 1187, checked in by Sam Habiel, 13 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
RevLine 
[1161]1BSDX29 ; IHS/OIT/HMW - WINDOWS SCHEDULING RPCS ; 4/28/11 10:25am
[1187]2 ;;1.6T2;BSDX;;May 16, 2011
[1161]3 ; Licensed under LGPL
[1036]4 ;
5 ; Change Log:
6 ; v1.3 by WV/SMH on 3100713
[883]7 ; - Beginning and Ending dates passed as FM Dates
[1161]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
[614]12 ;
13BSDXCPD(BSDXY,BSDXRES,BSDX44,BSDXBEG,BSDXEND) ;EP
14 ;Entry point for debugging
15 ;
[1036]16 D DEBUG^%Serenji("BSDXCP^BSDX29(.BSDXY,BSDXRES,BSDX44,BSDXBEG,BSDXEND)")
[614]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
[1041]22 ;Called by RPC: BSDX COPY APPOINTMENTS
[614]23 ;
[1041]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 ;
[1036]31 ;Returns ADO Recordset containing TASK_NUMBER and ERRORID
[614]32 ;
[1041]33 ; Return Array
[1036]34 S BSDXY=$NA(^BSDXTMP($J))
[1041]35 K ^BSDXTMP($J)
36 ; $ET
37 N $ET S $ET="G ETRAP^BSDX29"
[1036]38 ; Counter
[1041]39 N BSDXI S BSDXI=0
40 ; Header Node
41 S ^BSDXTMP($J,0)="T00010TASK_NUMBER^T00100ERRORID"_$C(30)
[614]42 ;
[1041]43 ; Make dates inclusive; add 1 to FM dates
44 S BSDXBEG=BSDXBEG-1
[858]45 S BSDXEND=BSDXEND+1
[614]46 ;
[1041]47 ; Taskman variables
48 N ZTSK,ZTRTN,ZTDTH,ZTDESC,ZTSAVE
[1036]49 ; Task Load
[614]50 S ZTRTN="ZTM^BSDX29",ZTDTH=$H,ZTDESC="COPY PATIENT APPTS"
51 S ZTSAVE("BSDXBEG")="",ZTSAVE("BSDXEND")="",ZTSAVE("BSDX44")="",ZTSAVE("BSDXRES")=""
52 D ^%ZTLOAD
[1036]53 ; Set up return ADO.net dataset
54 N BSDXST S BSDXST=$S($G(ZTSK)>0:"OK",1:"Unable to create task.")
[614]55 S BSDXI=BSDXI+1
56 S ^BSDXTMP($J,BSDXI)=$G(ZTSK)_"^"_BSDXST_$C(30)_$C(31)
[1036]57 QUIT
[614]58 ;
59ZTMD ;EP - Debug entry point
60 ;D DEBUG^%Serenji("ZTM^BSDX29")
61 Q
62 ;
[1036]63ZTM ;EP - Taskman entry point
[1041]64 ; Variables set up in ZTSAVE above
65 ;
[1036]66 Q:'$D(ZTSK)
[1041]67 ; $ET
68 N $ET S $ET="G ZTMERR^BSDX29"
[1036]69 ; Txn
[1041]70 TSTART (BSDXBEG,BSDXEND,BSDX44,BSDXRES):T="BSDX COPY APPOINTMENT^BSDX29"
[614]71 ;$O through ^SC(BSDX44,"S",
[1036]72 N BSDXCNT S BSDXCNT=0 ; Count of Copied Appointments
[1041]73 N BSDXQUIT S BSDXQUIT=0 ; Quit Flag to be retrieved from an external proc
[1036]74 ; Set Count
[1041]75 S ^BSDXTMP("BSDXCOPY",ZTSK)=BSDXCNT
[1036]76 ; Loop through dates here.
[1041]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
[1036]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
[1041]86 . . N BSDXPAT S BSDXPAT=$P(BSDXNOD,U) ; Patient
87 . . N BSDXLEN S BSDXLEN=$P(BSDXNOD,U,2) ;duration in minutes
[1036]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
[614]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 ;
[1036]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
[1041]103 ; Rollback before logging the error
104 I $TL>0 TROLLBACK
[614]105 D ^%ZTER
[1041]106 S $EC="" ; Clear Error
[1036]107 QUIT
[614]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
[1041]151 S BSDXERR=$TR(BSDXERR,"^","~")
[614]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
[1036]158 ; No Txn here. So don't rollback anything
[1041]159 N $ET S $ET="D ^%ZTER HALT" ; Emergency Error Trap
160 D ^%ZTER
161 S $EC="" ; Clear error
[1036]162 I '$D(BSDXI) N BSDXI S BSDXI=0
163 D ERR(BSDXI,$G(BSDXCNT),"~100~BSDX29, Error: "_$G(%ZTERZE))
[614]164 Q
165 ;
[1036]166CPSTAT(BSDXY,BSDXTSK) ;EP - Note: As of Dec 6 2010: Inactive Code
[614]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 ;
[1036]182CPCANC(BSDXY,BSDXTSK) ;EP Note: As of Dec 6 2010: Inactive code.
[614]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.