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

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

Updated routine version numbers to 1.7T2.
Changes the Writes in the post-init to MESXPDUTL in BSDX2E.
Changed the check for BMX to be for BMX 4 rather than BMX 2.

File size: 7.5 KB
RevLine 
[1479]1BSDX29 ; IHS/OIT/HMW - WINDOWS SCHEDULING RPCS ; 7/9/12 11:50am
[1481]2 ;;1.7T2;BSDX;;Jul 11, 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
[1036]104 QUIT
[614]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 ;
[1455]111 N REF
112 S REF=$NA(^BSDXLOCK(BSDXRES,BSDXBEG,BSDXPAT)) ; This combo is unique
113 L +@REF:0 E Q 0
114 ;
[614]115 ;$O Thru ^BSDXAPPT to determine if this appt already added
[1455]116 N BSDXEND,BSDXIEN,BSDXFND,BSDXPAT2,BSDXNOD
[614]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
[1455]125 I BSDXFND L -@REF Q 0
[614]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)
[1455]131 N BSDXFDA,BSDXIENS
[614]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
[1455]141 ;
[614]142 D UPDATE^DIE("","BSDXFDA","BSDXIEN","BSDXMSG")
143 S BSDXIEN=+$G(BSDXIEN(1))
[1455]144 I '+BSDXIEN L -@REF Q 0
[614]145 ;
146 ;Add WP field
147 I BSDXNOTE]"" S BSDXNOTE(.5)=BSDXNOTE,BSDXNOTE="" D
148 . D WP^DIE(9002018.4,BSDXIEN_",",1,"","BSDXNOTE","BSDXMSG")
[1455]149 L -@REF
[614]150 ;
151 Q 1
152 ;
153ERR(BSDXI,BSDXCNT,BSDXERR) ;Error processing
[1479]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
[614]156 S BSDXI=BSDXI+1
[1455]157 S BSDXERR=$TR(BSDXERR,"^","~")
[614]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
[1036]164 ; No Txn here. So don't rollback anything
[1455]165 N $ET S $ET="D ^%ZTER HALT" ; Emergency Error Trap
166 D ^%ZTER
167 S $EC="" ; Clear error
[1036]168 I '$D(BSDXI) N BSDXI S BSDXI=0
169 D ERR(BSDXI,$G(BSDXCNT),"~100~BSDX29, Error: "_$G(%ZTERZE))
[614]170 Q
171 ;
[1036]172CPSTAT(BSDXY,BSDXTSK) ;EP - Note: As of Dec 6 2010: Inactive Code
[614]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 ;
[1036]188CPCANC(BSDXY,BSDXTSK) ;EP Note: As of Dec 6 2010: Inactive code.
[614]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.