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

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

Added LGPL license to routines
File size: 7.3 KB
Line 
1BSDX29 ; IHS/OIT/HMW - WINDOWS SCHEDULING RPCS ; 4/28/11 10:25am
2 ;;1.5;BSDX;;Apr 28, 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.