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

Last change on this file since 1466 was 1455, checked in by Sam Habiel, 12 years ago

Refactored BSDX08 and BSDX29 routines; plus new UT routine BSDXUT1
File size: 7.4 KB
Line 
1BSDX29 ; IHS/OIT/HMW - WINDOWS SCHEDULING RPCS ; 6/22/12 1:46pm
2 ;;1.7T1;BSDX;;Aug 31, 2011;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 ;
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 S $EC="" ; Clear Error
105 QUIT
106 ;
107XFER(BSDXRES,BSDXBEG,BSDXPAT,BSDXLEN,BSDXCLRK,BSDXMADE,BSDXNOTE) ;EP
108 ;
109 ;Copy record to BSDX APPOINTMENT file
110 ;Return 1 if record copied, otherwise 0
111 ;
112 N REF
113 S REF=$NA(^BSDXLOCK(BSDXRES,BSDXBEG,BSDXPAT)) ; This combo is unique
114 L +@REF:0 E Q 0
115 ;
116 ;$O Thru ^BSDXAPPT to determine if this appt already added
117 N BSDXEND,BSDXIEN,BSDXFND,BSDXPAT2,BSDXNOD
118 S BSDXIEN=0,BSDXFND=0
119 F S BSDXIEN=$O(^BSDXAPPT("ARSRC",BSDXRES,BSDXBEG,BSDXIEN)) Q:'+BSDXIEN D Q:BSDXFND
120 . S BSDXNOD=$G(^BSDXAPPT(BSDXIEN,0))
121 . Q:'+BSDXNOD
122 . S BSDXPAT2=$P(BSDXNOD,U,5)
123 . S BSDXFND=0
124 . I BSDXPAT2=BSDXPAT S BSDXFND=1
125 . Q
126 I BSDXFND L -@REF Q 0
127 ;
128 ;Add to BSDX APPOINTMENT
129 S BSDXEND=BSDXBEG
130 ;Calculate ending time from beginning time and duration.
131 S BSDXEND=$$ADDMIN(BSDXBEG,BSDXLEN)
132 N BSDXFDA,BSDXIENS
133 S BSDXIENS="+1,"
134 S BSDXFDA(9002018.4,BSDXIENS,.01)=BSDXBEG
135 S BSDXFDA(9002018.4,BSDXIENS,.02)=BSDXEND
136 S BSDXFDA(9002018.4,BSDXIENS,.05)=BSDXPAT
137 S BSDXFDA(9002018.4,BSDXIENS,.07)=BSDXRES
138 S BSDXFDA(9002018.4,BSDXIENS,.08)=BSDXCLRK
139 S BSDXFDA(9002018.4,BSDXIENS,.09)=BSDXMADE
140 ;
141 K BSDXIEN
142 ;
143 D UPDATE^DIE("","BSDXFDA","BSDXIEN","BSDXMSG")
144 S BSDXIEN=+$G(BSDXIEN(1))
145 I '+BSDXIEN L -@REF Q 0
146 ;
147 ;Add WP field
148 I BSDXNOTE]"" S BSDXNOTE(.5)=BSDXNOTE,BSDXNOTE="" D
149 . D WP^DIE(9002018.4,BSDXIEN_",",1,"","BSDXNOTE","BSDXMSG")
150 L -@REF
151 ;
152 Q 1
153 ;
154ERR(BSDXI,BSDXCNT,BSDXERR) ;Error processing
155 S BSDXI=BSDXI+1
156 S BSDXERR=$TR(BSDXERR,"^","~")
157 S ^BSDXTMP($J,BSDXI)=BSDXCNT_"^"_BSDXERR_$C(30)
158 S BSDXI=BSDXI+1
159 S ^BSDXTMP($J,BSDXI)=$C(31)
160 Q
161 ;
162ETRAP ;EP Error trap entry
163 ; No Txn here. So don't rollback anything
164 N $ET S $ET="D ^%ZTER HALT" ; Emergency Error Trap
165 D ^%ZTER
166 S $EC="" ; Clear error
167 I '$D(BSDXI) N BSDXI S BSDXI=0
168 D ERR(BSDXI,$G(BSDXCNT),"~100~BSDX29, Error: "_$G(%ZTERZE))
169 Q
170 ;
171CPSTAT(BSDXY,BSDXTSK) ;EP - Note: As of Dec 6 2010: Inactive Code
172 ;Return status (copied record count) of tasked job having ZTSK=BSDXTSK
173 ;
174 S BSDXY="^BSDXTMP("_$J_")"
175 N BSDXI,BSDXCNT
176 S BSDXI=0
177 S X="ETRAP^BSDX29",@^%ZOSF("TRAP")
178 S ^BSDXTMP($J,0)="T00020RECORD_COUNT^T00020ERRORID"_$C(30)
179 S BSDXCNT=$G(^BSDXTMP("BSDXCOPY",BSDXTSK))
180 I BSDXCNT["Finished" K ^BSDXTMP("BSDXCOPY",BSDXTSK)
181 I BSDXCNT["Cancelled" K ^BSDXTMP("BSDXCOPY",BSDXTSK)
182 ;I $D(^BSDXTMP("BSDXCOPY",BSDXTSK,"CANCEL")) K ^BSDXTMP("BSDXCOPY",BSDXTSK)
183 S BSDXI=BSDXI+1
184 S ^BSDXTMP($J,BSDXI)=BSDXCNT_"^"_"OK"_$C(30)_$C(31)
185 Q
186 ;
187CPCANC(BSDXY,BSDXTSK) ;EP Note: As of Dec 6 2010: Inactive code.
188 ;Signal tasked job having ZTSK=BSDXTSK to cancel
189 ;Returns current record count of copy process
190 ;
191 S BSDXY="^BSDXTMP("_$J_")"
192 N BSDXI,BSDXCNT
193 S BSDXI=0
194 S X="ETRAP^BSDX29",@^%ZOSF("TRAP")
195 S ^BSDXTMP($J,0)="T00020RECORD_COUNT^T00020ERRORID"_$C(30)
196 S BSDXCNT=$G(^BSDXTMP("BSDXCOPY",BSDXTSK))
197 I BSDXCNT["FINISHED" K ^BSDXTMP("BSDXCOPY",BSDXTSK)
198 E S ^BSDXTMP("BSDXCOPY",BSDXTSK,"CANCEL")=""
199 S BSDXI=BSDXI+1
200 S ^BSDXTMP($J,BSDXI)=BSDXCNT_"^"_"OK"_$C(30)_$C(31)
201 Q
202 ;
203ADDMIN(BSDXSTRT,BSDXLEN) ;
204 ;
205 ;Add BSDXLEN minutes to time BSDXSTRT and return end time
206 N BSDXEND,BSDXH,BSDXM,BSDXSTIM,BSDXETIM
207 S BSDXEND=$P(BSDXSTRT,".")
208 ;
209 ;Convert start time to minutes past midnight
210 S BSDXSTIM=$P(BSDXSTRT,".",2)
211 S BSDXSTIM=BSDXSTIM_"0000"
212 S BSDXSTIM=$E(BSDXSTIM,1,4)
213 S BSDXH=$E(BSDXSTIM,1,2)
214 S BSDXH=BSDXH*60
215 S BSDXH=BSDXH+$E(BSDXSTIM,3,4)
216 ;
217 ;Add duration to find minutes past midnight of end time
218 S BSDXETIM=BSDXH+BSDXLEN
219 ;
220 ;Convert back to a time
221 S BSDXH=BSDXETIM\60
222 S BSDXH="00"_BSDXH
223 S BSDXH=$E(BSDXH,$L(BSDXH)-1,$L(BSDXH))
224 S BSDXM=BSDXETIM#60
225 S BSDXM="00"_BSDXM
226 S BSDXM=$E(BSDXM,$L(BSDXM)-1,$L(BSDXM))
227 S BSDXETIM=BSDXH_BSDXM
228 I BSDXETIM>2400 S BSDXETIM=2400
229 S $P(BSDXEND,".",2)=BSDXETIM
230 Q BSDXEND
Note: See TracBrowser for help on using the repository browser.