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

Last change on this file since 1155 was 1155, checked in by Sam Habiel, 13 years ago

Updated version number to 1.5

File size: 7.3 KB
RevLine 
[1041]1BSDX29 ; IHS/OIT/HMW - WINDOWS SCHEDULING RPCS ; 12/6/10 12:39pm
[1155]2 ;;1.5;BSDX;;Apr 28, 2011
[1036]3 ;
4 ; Change Log:
5 ; v1.3 by WV/SMH on 3100713
[883]6 ; - Beginning and Ending dates passed as FM Dates
[1041]7 ; v1.42 by WV/SMH on 3101023
8 ; - Transaction moved; now restartable too.
9 ; --> Thanks to Zach Gonzalez and Rick Marshall.
10 ; - Refactoring of major portions of routine
[614]11 ;
12BSDXCPD(BSDXY,BSDXRES,BSDX44,BSDXBEG,BSDXEND) ;EP
13 ;Entry point for debugging
14 ;
[1036]15 D DEBUG^%Serenji("BSDXCP^BSDX29(.BSDXY,BSDXRES,BSDX44,BSDXBEG,BSDXEND)")
[614]16 Q
17 ;
18BSDXCP(BSDXY,BSDXRES,BSDX44,BSDXBEG,BSDXEND) ;EP
19 ;Copy appointments from HOSPITAL LOCATION entry BSDX44 to BSDX RESOURCE entry BSDXRES
20 ;Beginning with appointments on day BSDXBEG and ending on BSDXEND, inclusive
[1041]21 ;Called by RPC: BSDX COPY APPOINTMENTS
[614]22 ;
[1041]23 ; Parameters:
24 ; - BSDXY: Global Return
25 ; - BSDXRES: BSDX RESOURCE to copy appointments to
26 ; - BSDX44: Hospital Location IEN to copy appointments from
27 ; - BSDXBEG: Beginning Date in FM Format
28 ; - BSDXEND: End Date in FM Format
29 ;
[1036]30 ;Returns ADO Recordset containing TASK_NUMBER and ERRORID
[614]31 ;
[1041]32 ; Return Array
[1036]33 S BSDXY=$NA(^BSDXTMP($J))
[1041]34 K ^BSDXTMP($J)
35 ; $ET
36 N $ET S $ET="G ETRAP^BSDX29"
[1036]37 ; Counter
[1041]38 N BSDXI S BSDXI=0
39 ; Header Node
40 S ^BSDXTMP($J,0)="T00010TASK_NUMBER^T00100ERRORID"_$C(30)
[614]41 ;
[1041]42 ; Make dates inclusive; add 1 to FM dates
43 S BSDXBEG=BSDXBEG-1
[858]44 S BSDXEND=BSDXEND+1
[614]45 ;
[1041]46 ; Taskman variables
47 N ZTSK,ZTRTN,ZTDTH,ZTDESC,ZTSAVE
[1036]48 ; Task Load
[614]49 S ZTRTN="ZTM^BSDX29",ZTDTH=$H,ZTDESC="COPY PATIENT APPTS"
50 S ZTSAVE("BSDXBEG")="",ZTSAVE("BSDXEND")="",ZTSAVE("BSDX44")="",ZTSAVE("BSDXRES")=""
51 D ^%ZTLOAD
[1036]52 ; Set up return ADO.net dataset
53 N BSDXST S BSDXST=$S($G(ZTSK)>0:"OK",1:"Unable to create task.")
[614]54 S BSDXI=BSDXI+1
55 S ^BSDXTMP($J,BSDXI)=$G(ZTSK)_"^"_BSDXST_$C(30)_$C(31)
[1036]56 QUIT
[614]57 ;
58ZTMD ;EP - Debug entry point
59 ;D DEBUG^%Serenji("ZTM^BSDX29")
60 Q
61 ;
[1036]62ZTM ;EP - Taskman entry point
[1041]63 ; Variables set up in ZTSAVE above
64 ;
[1036]65 Q:'$D(ZTSK)
[1041]66 ; $ET
67 N $ET S $ET="G ZTMERR^BSDX29"
[1036]68 ; Txn
[1041]69 TSTART (BSDXBEG,BSDXEND,BSDX44,BSDXRES):T="BSDX COPY APPOINTMENT^BSDX29"
[614]70 ;$O through ^SC(BSDX44,"S",
[1036]71 N BSDXCNT S BSDXCNT=0 ; Count of Copied Appointments
[1041]72 N BSDXQUIT S BSDXQUIT=0 ; Quit Flag to be retrieved from an external proc
[1036]73 ; Set Count
[1041]74 S ^BSDXTMP("BSDXCOPY",ZTSK)=BSDXCNT
[1036]75 ; Loop through dates here.
[1041]76 F S BSDXBEG=$O(^SC(BSDX44,"S",BSDXBEG)) Q:'+BSDXBEG Q:BSDXBEG>BSDXEND Q:BSDXQUIT D
77 . ; Loop through Entries in each date in the subsubfile.
78 . ; Quit if we are at the end or if a remote process requests a quit.
79 . N BSDXIEN S BSDXIEN=0
[1036]80 . F S BSDXIEN=$O(^SC(BSDX44,"S",BSDXBEG,1,BSDXIEN)) Q:'+BSDXIEN Q:BSDXQUIT D
81 . . N BSDXNOD S BSDXNOD=$G(^SC(BSDX44,"S",BSDXBEG,1,BSDXIEN,0)) ; Node
82 . . Q:'+BSDXNOD ; Quit if no node
83 . . N BSDXCAN S BSDXCAN=$P(BSDXNOD,U,9) ; Cancel flag
84 . . Q:BSDXCAN="C" ; Quit if appt cancelled
[1041]85 . . N BSDXPAT S BSDXPAT=$P(BSDXNOD,U) ; Patient
86 . . N BSDXLEN S BSDXLEN=$P(BSDXNOD,U,2) ;duration in minutes
[1036]87 . . N BSDXCLRK S BSDXCLRK=$P(BSDXNOD,U,6) ;appt made by (clerk)
88 . . N BSDXMADE S BSDXMADE=$P(BSDXNOD,U,7) ;date appt made
89 . . N BSDXNOTE S BSDXNOTE=$P(BSDXNOD,U,4) ;'OTHER' field contains note
[614]90 . . S BSDXCNT=BSDXCNT+$$XFER(BSDXRES,BSDXBEG,BSDXPAT,BSDXLEN,BSDXCLRK,BSDXMADE,BSDXNOTE)
91 . . I +BSDXCNT,BSDXCNT#10=0 S ^BSDXTMP("BSDXCOPY",ZTSK)=BSDXCNT_" records copied." ;every 10th record
92 . . I $D(^BSDXTMP("BSDXCOPY",ZTSK,"CANCEL")) S BSDXQUIT=1 ;Check for cancel flag
93 . . Q
94 . Q
95 I 'BSDXQUIT TCOMMIT
96 E TROLLBACK
97 S ^BSDXTMP("BSDXCOPY",ZTSK)=$S(BSDXQUIT:"Cancelled. No records copied.",1:"Finished. "_BSDXCNT_" records copied.")
98 Q
99 ;
[1036]100ZTMERR ; For now, error from TM is only in trap; not returned to client.
101 N $ET S $ET="D ^%ZTER HALT" ; Emergency Error Trap
[1041]102 ; Rollback before logging the error
103 I $TL>0 TROLLBACK
[614]104 D ^%ZTER
[1041]105 S $EC="" ; Clear Error
[1036]106 QUIT
[614]107 ;
108XFER(BSDXRES,BSDXBEG,BSDXPAT,BSDXLEN,BSDXCLRK,BSDXMADE,BSDXNOTE) ;EP
109 ;
110 ;Copy record to BSDX APPOINTMENT file
111 ;Return 1 if record copied, otherwise 0
112 ;
113 ;$O Thru ^BSDXAPPT to determine if this appt already added
114 N BSDXEND,BSDXIEN,BSDXFND,BSDXPAT2
115 S BSDXIEN=0,BSDXFND=0
116 F S BSDXIEN=$O(^BSDXAPPT("ARSRC",BSDXRES,BSDXBEG,BSDXIEN)) Q:'+BSDXIEN D Q:BSDXFND
117 . S BSDXNOD=$G(^BSDXAPPT(BSDXIEN,0))
118 . Q:'+BSDXNOD
119 . S BSDXPAT2=$P(BSDXNOD,U,5)
120 . S BSDXFND=0
121 . I BSDXPAT2=BSDXPAT S BSDXFND=1
122 . Q
123 Q:BSDXFND 0
124 ;
125 ;Add to BSDX APPOINTMENT
126 S BSDXEND=BSDXBEG
127 ;Calculate ending time from beginning time and duration.
128 S BSDXEND=$$ADDMIN(BSDXBEG,BSDXLEN)
129 S BSDXIENS="+1,"
130 S BSDXFDA(9002018.4,BSDXIENS,.01)=BSDXBEG
131 S BSDXFDA(9002018.4,BSDXIENS,.02)=BSDXEND
132 S BSDXFDA(9002018.4,BSDXIENS,.05)=BSDXPAT
133 S BSDXFDA(9002018.4,BSDXIENS,.07)=BSDXRES
134 S BSDXFDA(9002018.4,BSDXIENS,.08)=BSDXCLRK
135 S BSDXFDA(9002018.4,BSDXIENS,.09)=BSDXMADE
136 ;
137 K BSDXIEN
138 D UPDATE^DIE("","BSDXFDA","BSDXIEN","BSDXMSG")
139 S BSDXIEN=+$G(BSDXIEN(1))
140 I '+BSDXIEN Q 0
141 ;
142 ;Add WP field
143 I BSDXNOTE]"" S BSDXNOTE(.5)=BSDXNOTE,BSDXNOTE="" D
144 . D WP^DIE(9002018.4,BSDXIEN_",",1,"","BSDXNOTE","BSDXMSG")
145 ;
146 Q 1
147 ;
148ERR(BSDXI,BSDXCNT,BSDXERR) ;Error processing
149 S BSDXI=BSDXI+1
[1041]150 S BSDXERR=$TR(BSDXERR,"^","~")
[614]151 S ^BSDXTMP($J,BSDXI)=BSDXCNT_"^"_BSDXERR_$C(30)
152 S BSDXI=BSDXI+1
153 S ^BSDXTMP($J,BSDXI)=$C(31)
154 Q
155 ;
156ETRAP ;EP Error trap entry
[1036]157 ; No Txn here. So don't rollback anything
[1041]158 N $ET S $ET="D ^%ZTER HALT" ; Emergency Error Trap
159 D ^%ZTER
160 S $EC="" ; Clear error
[1036]161 I '$D(BSDXI) N BSDXI S BSDXI=0
162 D ERR(BSDXI,$G(BSDXCNT),"~100~BSDX29, Error: "_$G(%ZTERZE))
[614]163 Q
164 ;
[1036]165CPSTAT(BSDXY,BSDXTSK) ;EP - Note: As of Dec 6 2010: Inactive Code
[614]166 ;Return status (copied record count) of tasked job having ZTSK=BSDXTSK
167 ;
168 S BSDXY="^BSDXTMP("_$J_")"
169 N BSDXI,BSDXCNT
170 S BSDXI=0
171 S X="ETRAP^BSDX29",@^%ZOSF("TRAP")
172 S ^BSDXTMP($J,0)="T00020RECORD_COUNT^T00020ERRORID"_$C(30)
173 S BSDXCNT=$G(^BSDXTMP("BSDXCOPY",BSDXTSK))
174 I BSDXCNT["Finished" K ^BSDXTMP("BSDXCOPY",BSDXTSK)
175 I BSDXCNT["Cancelled" K ^BSDXTMP("BSDXCOPY",BSDXTSK)
176 ;I $D(^BSDXTMP("BSDXCOPY",BSDXTSK,"CANCEL")) K ^BSDXTMP("BSDXCOPY",BSDXTSK)
177 S BSDXI=BSDXI+1
178 S ^BSDXTMP($J,BSDXI)=BSDXCNT_"^"_"OK"_$C(30)_$C(31)
179 Q
180 ;
[1036]181CPCANC(BSDXY,BSDXTSK) ;EP Note: As of Dec 6 2010: Inactive code.
[614]182 ;Signal tasked job having ZTSK=BSDXTSK to cancel
183 ;Returns current record count of copy process
184 ;
185 S BSDXY="^BSDXTMP("_$J_")"
186 N BSDXI,BSDXCNT
187 S BSDXI=0
188 S X="ETRAP^BSDX29",@^%ZOSF("TRAP")
189 S ^BSDXTMP($J,0)="T00020RECORD_COUNT^T00020ERRORID"_$C(30)
190 S BSDXCNT=$G(^BSDXTMP("BSDXCOPY",BSDXTSK))
191 I BSDXCNT["FINISHED" K ^BSDXTMP("BSDXCOPY",BSDXTSK)
192 E S ^BSDXTMP("BSDXCOPY",BSDXTSK,"CANCEL")=""
193 S BSDXI=BSDXI+1
194 S ^BSDXTMP($J,BSDXI)=BSDXCNT_"^"_"OK"_$C(30)_$C(31)
195 Q
196 ;
197ADDMIN(BSDXSTRT,BSDXLEN) ;
198 ;
199 ;Add BSDXLEN minutes to time BSDXSTRT and return end time
200 N BSDXEND,BSDXH,BSDXM,BSDXSTIM,BSDXETIM
201 S BSDXEND=$P(BSDXSTRT,".")
202 ;
203 ;Convert start time to minutes past midnight
204 S BSDXSTIM=$P(BSDXSTRT,".",2)
205 S BSDXSTIM=BSDXSTIM_"0000"
206 S BSDXSTIM=$E(BSDXSTIM,1,4)
207 S BSDXH=$E(BSDXSTIM,1,2)
208 S BSDXH=BSDXH*60
209 S BSDXH=BSDXH+$E(BSDXSTIM,3,4)
210 ;
211 ;Add duration to find minutes past midnight of end time
212 S BSDXETIM=BSDXH+BSDXLEN
213 ;
214 ;Convert back to a time
215 S BSDXH=BSDXETIM\60
216 S BSDXH="00"_BSDXH
217 S BSDXH=$E(BSDXH,$L(BSDXH)-1,$L(BSDXH))
218 S BSDXM=BSDXETIM#60
219 S BSDXM="00"_BSDXM
220 S BSDXM=$E(BSDXM,$L(BSDXM)-1,$L(BSDXM))
221 S BSDXETIM=BSDXH_BSDXM
222 I BSDXETIM>2400 S BSDXETIM=2400
223 S $P(BSDXEND,".",2)=BSDXETIM
224 Q BSDXEND
Note: See TracBrowser for help on using the repository browser.