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

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

Updated version number on all routines to be 1.7T1.
Minor fixes here and there for XINDEX errors.
File size: 7.4 KB
Line 
1BSDX29 ; IHS/OIT/HMW - WINDOWS SCHEDULING RPCS ; 6/22/12 1:46pm
2 ;;1.7T1;BSDX;;Jul 06, 2012;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.