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
RevLine 
[1455]1BSDX29 ; IHS/OIT/HMW - WINDOWS SCHEDULING RPCS ; 6/22/12 1:46pm
[1472]2 ;;1.7T1;BSDX;;Jul 06, 2012;Build 18
[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 ; - Refactoring of major portions of routine
[1455]11 ; v1.7 by VEN/SMH on 3120622
12 ; - Removed transaction code; Locks added in update to prevent concurrent
13 ; update
[614]14 ;
15BSDXCPD(BSDXY,BSDXRES,BSDX44,BSDXBEG,BSDXEND) ;EP
16 ;Entry point for debugging
17 ;
[1455]18 ;D DEBUG^%Serenji("BSDXCP^BSDX29(.BSDXY,BSDXRES,BSDX44,BSDXBEG,BSDXEND)")
[614]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
[1041]24 ;Called by RPC: BSDX COPY APPOINTMENTS
[614]25 ;
[1455]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 ;
[1036]33 ;Returns ADO Recordset containing TASK_NUMBER and ERRORID
[614]34 ;
[1455]35 ; Return Array
[1036]36 S BSDXY=$NA(^BSDXTMP($J))
[1455]37 K ^BSDXTMP($J)
38 ; $ET
39 N $ET S $ET="G ETRAP^BSDX29"
[1036]40 ; Counter
[1455]41 N BSDXI S BSDXI=0
42 ; Header Node
[1041]43 S ^BSDXTMP($J,0)="T00010TASK_NUMBER^T00100ERRORID"_$C(30)
[614]44 ;
[1455]45 ; Make dates inclusive; add 1 to FM dates
46 S BSDXBEG=$$FMADD^XLFDT(BSDXBEG,-1)
47 S BSDXEND=$$FMADD^XLFDT(BSDXEND,+1)
[614]48 ;
[1455]49 ; Taskman variables
50 N ZTSK,ZTRTN,ZTDTH,ZTDESC,ZTSAVE,ZTIO
[1036]51 ; Task Load
[1455]52 S ZTRTN="ZTM^BSDX29",ZTDTH=$H,ZTDESC="COPY PATIENT APPTS",ZTIO=""
[614]53 S ZTSAVE("BSDXBEG")="",ZTSAVE("BSDXEND")="",ZTSAVE("BSDX44")="",ZTSAVE("BSDXRES")=""
54 D ^%ZTLOAD
[1036]55 ; Set up return ADO.net dataset
56 N BSDXST S BSDXST=$S($G(ZTSK)>0:"OK",1:"Unable to create task.")
[614]57 S BSDXI=BSDXI+1
58 S ^BSDXTMP($J,BSDXI)=$G(ZTSK)_"^"_BSDXST_$C(30)_$C(31)
[1036]59 QUIT
[614]60 ;
61ZTMD ;EP - Debug entry point
62 ;D DEBUG^%Serenji("ZTM^BSDX29")
63 Q
64 ;
[1036]65ZTM ;EP - Taskman entry point
[1455]66 ; Variables set up in ZTSAVE above
67 ;
[1036]68 Q:'$D(ZTSK)
[1455]69 ;
70 ; $ET
71 N $ET S $ET="G ZTMERR^BSDX29"
72 ;
[614]73 ;$O through ^SC(BSDX44,"S",
[1036]74 N BSDXCNT S BSDXCNT=0 ; Count of Copied Appointments
[1455]75 N BSDXQUIT S BSDXQUIT=0 ; Quit Flag to be retrieved from an external proc
[1036]76 ; Set Count
[1455]77 S ^BSDXTMP("BSDXCOPY",ZTSK)=BSDXCNT
[1036]78 ; Loop through dates here.
[1455]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
[1036]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
[1455]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
[1036]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
[614]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
[1455]95 . . I $D(^BSDXTMP("BSDXCOPY",ZTSK,"CANCEL")) S BSDXQUIT=1 ;Check for cancel flag ; smh - not used currently (v1.7)
96 ;
97 ;
[614]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
[614]103 D ^%ZTER
[1455]104 S $EC="" ; Clear Error
[1036]105 QUIT
[614]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 ;
[1455]112 N REF
113 S REF=$NA(^BSDXLOCK(BSDXRES,BSDXBEG,BSDXPAT)) ; This combo is unique
114 L +@REF:0 E Q 0
115 ;
[614]116 ;$O Thru ^BSDXAPPT to determine if this appt already added
[1455]117 N BSDXEND,BSDXIEN,BSDXFND,BSDXPAT2,BSDXNOD
[614]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
[1455]126 I BSDXFND L -@REF Q 0
[614]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)
[1455]132 N BSDXFDA,BSDXIENS
[614]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
[1455]142 ;
[614]143 D UPDATE^DIE("","BSDXFDA","BSDXIEN","BSDXMSG")
144 S BSDXIEN=+$G(BSDXIEN(1))
[1455]145 I '+BSDXIEN L -@REF Q 0
[614]146 ;
147 ;Add WP field
148 I BSDXNOTE]"" S BSDXNOTE(.5)=BSDXNOTE,BSDXNOTE="" D
149 . D WP^DIE(9002018.4,BSDXIEN_",",1,"","BSDXNOTE","BSDXMSG")
[1455]150 L -@REF
[614]151 ;
152 Q 1
153 ;
154ERR(BSDXI,BSDXCNT,BSDXERR) ;Error processing
155 S BSDXI=BSDXI+1
[1455]156 S BSDXERR=$TR(BSDXERR,"^","~")
[614]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
[1036]163 ; No Txn here. So don't rollback anything
[1455]164 N $ET S $ET="D ^%ZTER HALT" ; Emergency Error Trap
165 D ^%ZTER
166 S $EC="" ; Clear error
[1036]167 I '$D(BSDXI) N BSDXI S BSDXI=0
168 D ERR(BSDXI,$G(BSDXCNT),"~100~BSDX29, Error: "_$G(%ZTERZE))
[614]169 Q
170 ;
[1036]171CPSTAT(BSDXY,BSDXTSK) ;EP - Note: As of Dec 6 2010: Inactive Code
[614]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 ;
[1036]187CPCANC(BSDXY,BSDXTSK) ;EP Note: As of Dec 6 2010: Inactive code.
[614]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.