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

Last change on this file since 1800 was 1625, checked in by Tariq Hamkari, 11 years ago

Ayman Ghaith : adding the correct routines which not has the transactions.
File size: 7.5 KB
Line 
1BSDX29 ; IHS/OIT/HMW - WINDOWS SCHEDULING RPCS ; 7/9/12 11:50am
2 ;;1.7;BSDX;;Jun 01, 2013;Build 24
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 ;
15BSDXCPD(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 ;
21BSDXCP(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 ;
61ZTMD ;EP - Debug entry point
62 ;D DEBUG^%Serenji("ZTM^BSDX29")
63 Q
64 ;
65ZTM ;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 ;
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 D ^%ZTER
104 QUIT
105 ;
106XFER(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 ;
153ERR(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 ;
163ETRAP ;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 ;
172CPSTAT(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 ;
188CPCANC(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 ;
204ADDMIN(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
Note: See TracBrowser for help on using the repository browser.