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

Last change on this file since 1034 was 968, checked in by Sam Habiel, 14 years ago

Bumped version up to 1.41
File size: 6.0 KB
RevLine 
[883]1BSDX29 ; IHS/OIT/HMW - WINDOWS SCHEDULING RPCS ; 7/18/10 2:03pm
[968]2 ;;1.41;BSDX;;Sep 29, 2010
[888]3 ;
4 ; Change Log:
5 ; v1.3 by WV/SMH on 3100713
[883]6 ; - Beginning and Ending dates passed as FM Dates
[614]7 ;
8BSDXCPD(BSDXY,BSDXRES,BSDX44,BSDXBEG,BSDXEND) ;EP
9 ;Entry point for debugging
10 ;
11 ;D DEBUG^%Serenji("BSDXCP^BSDX29(.BSDXY,BSDXRES,BSDX44,BSDXBEG,BSDXEND)")
12 Q
13 ;
14BSDXCP(BSDXY,BSDXRES,BSDX44,BSDXBEG,BSDXEND) ;EP
15 ;Copy appointments from HOSPITAL LOCATION entry BSDX44 to BSDX RESOURCE entry BSDXRES
16 ;Beginning with appointments on day BSDXBEG and ending on BSDXEND, inclusive
17 ;
18 ;Returns ADO Recordset formatted fields containing count of records copied and error message:
[888]19 ;
20 ; July 13 2010: D dates (BEG and END) from US format to FM Dates for i18n
[614]21 ;
22 ;
23 S BSDXY="^BSDXTMP("_$J_")"
24 N BSDXI,BSDXST,ZTSK
25 S BSDXI=0
26 S X="ETRAP^BSDX29",@^%ZOSF("TRAP")
27 S ^BSDXTMP($J,0)="T00010TASK_NUMBER^T00020ERRORID"_$C(30)
28 ;
29 ;Convert beginning and ending dates
[888]30 ;
31 ;TODO:Validate FM Dates coming through
[614]32 ;
[858]33 S BSDXBEG=BSDXBEG-1
34 S BSDXEND=BSDXEND+1
[614]35 ;
36 S ZTRTN="ZTM^BSDX29",ZTDTH=$H,ZTDESC="COPY PATIENT APPTS"
37 S ZTSAVE("BSDXBEG")="",ZTSAVE("BSDXEND")="",ZTSAVE("BSDX44")="",ZTSAVE("BSDXRES")=""
38 D ^%ZTLOAD
39 ;
40 S BSDXI=BSDXI+1
41 S BSDXST=$S($G(ZTSK)>0:"OK",1:"Unable to create task.")
42 S ^BSDXTMP($J,BSDXI)=$G(ZTSK)_"^"_BSDXST_$C(30)_$C(31)
43 Q
44 ;
45ZTMTST ;
46 ;
47 S %DT="AE" D ^%DT S BSDXBEG=Y
48 S %DT="AE" D ^%DT S BSDXEND=Y
49 S BSDX44=3,BSDXSRES=1,ZTSK=3380
50 D ZTM
51 Q
52 ;
53ZTMD ;EP - Debug entry point
54 ;D DEBUG^%Serenji("ZTM^BSDX29")
55 Q
56 ;
57ZTM ;EP
58 ;Taskman entry point
59 S X="ZTMERR^BSDX29",@^%ZOSF("TRAP")
60 ;$O through ^SC(BSDX44,"S",
61 Q:'$D(ZTSK)
62 N BSDXCNT,BSDXIEN,BSDXNOD,BSDXNOTE,BSDXCAN,BSDXPAT,BSDXLEN,BSDXMADE,BSDXCLRK,BSDXPAT,BSDXQUIT
63 S BSDXCNT=0,BSDXQUIT=0
64 S ^BSDXTMP("BSDXCOPY",ZTSK)=BSDXCNT
65 TSTART
66 F S BSDXBEG=$O(^SC(BSDX44,"S",BSDXBEG)) Q:'+BSDXBEG Q:BSDXBEG>BSDXEND Q:BSDXQUIT D
67 . S BSDXIEN=0 F S BSDXIEN=$O(^SC(BSDX44,"S",BSDXBEG,1,BSDXIEN)) Q:'+BSDXIEN Q:BSDXQUIT D
68 . . S BSDXNOD=$G(^SC(BSDX44,"S",BSDXBEG,1,BSDXIEN,0))
69 . . Q:'+BSDXNOD
70 . . S BSDXCAN=$P(BSDXNOD,U,9)
71 . . Q:BSDXCAN="C"
72 . . S BSDXPAT=$P(BSDXNOD,U)
73 . . S BSDXLEN=$P(BSDXNOD,U,2) ;duration in minutes
74 . . S BSDXCLRK=$P(BSDXNOD,U,6) ;appt made by (clerk)
75 . . S BSDXMADE=$P(BSDXNOD,U,7) ;date appt made
76 . . S BSDXNOTE=$P(BSDXNOD,U,4) ;'OTHER' field contains note
77 . . S BSDXCNT=BSDXCNT+$$XFER(BSDXRES,BSDXBEG,BSDXPAT,BSDXLEN,BSDXCLRK,BSDXMADE,BSDXNOTE)
78 . . I +BSDXCNT,BSDXCNT#10=0 S ^BSDXTMP("BSDXCOPY",ZTSK)=BSDXCNT_" records copied." ;every 10th record
79 . . I $D(^BSDXTMP("BSDXCOPY",ZTSK,"CANCEL")) S BSDXQUIT=1 ;Check for cancel flag
80 . . Q
81 . Q
82 I 'BSDXQUIT TCOMMIT
83 E TROLLBACK
84 S ^BSDXTMP("BSDXCOPY",ZTSK)=$S(BSDXQUIT:"Cancelled. No records copied.",1:"Finished. "_BSDXCNT_" records copied.")
85 Q
86 ;
87ZTMERR ;
88 TROLLBACK
89 D ^%ZTER
90 Q
91 ;
92XFER(BSDXRES,BSDXBEG,BSDXPAT,BSDXLEN,BSDXCLRK,BSDXMADE,BSDXNOTE) ;EP
93 ;
94 ;Copy record to BSDX APPOINTMENT file
95 ;Return 1 if record copied, otherwise 0
96 ;
97 ;$O Thru ^BSDXAPPT to determine if this appt already added
98 N BSDXEND,BSDXIEN,BSDXFND,BSDXPAT2
99 S BSDXIEN=0,BSDXFND=0
100 F S BSDXIEN=$O(^BSDXAPPT("ARSRC",BSDXRES,BSDXBEG,BSDXIEN)) Q:'+BSDXIEN D Q:BSDXFND
101 . S BSDXNOD=$G(^BSDXAPPT(BSDXIEN,0))
102 . Q:'+BSDXNOD
103 . S BSDXPAT2=$P(BSDXNOD,U,5)
104 . S BSDXFND=0
105 . I BSDXPAT2=BSDXPAT S BSDXFND=1
106 . Q
107 Q:BSDXFND 0
108 ;
109 ;Add to BSDX APPOINTMENT
110 S BSDXEND=BSDXBEG
111 ;Calculate ending time from beginning time and duration.
112 S BSDXEND=$$ADDMIN(BSDXBEG,BSDXLEN)
113 S BSDXIENS="+1,"
114 S BSDXFDA(9002018.4,BSDXIENS,.01)=BSDXBEG
115 S BSDXFDA(9002018.4,BSDXIENS,.02)=BSDXEND
116 S BSDXFDA(9002018.4,BSDXIENS,.05)=BSDXPAT
117 S BSDXFDA(9002018.4,BSDXIENS,.07)=BSDXRES
118 S BSDXFDA(9002018.4,BSDXIENS,.08)=BSDXCLRK
119 S BSDXFDA(9002018.4,BSDXIENS,.09)=BSDXMADE
120 ;
121 K BSDXIEN
122 D UPDATE^DIE("","BSDXFDA","BSDXIEN","BSDXMSG")
123 S BSDXIEN=+$G(BSDXIEN(1))
124 I '+BSDXIEN Q 0
125 ;
126 ;Add WP field
127 I BSDXNOTE]"" S BSDXNOTE(.5)=BSDXNOTE,BSDXNOTE="" D
128 . D WP^DIE(9002018.4,BSDXIEN_",",1,"","BSDXNOTE","BSDXMSG")
129 ;
130 Q 1
131 ;
132ERR(BSDXI,BSDXCNT,BSDXERR) ;Error processing
133 S BSDXI=BSDXI+1
134 S ^BSDXTMP($J,BSDXI)=BSDXCNT_"^"_BSDXERR_$C(30)
135 S BSDXI=BSDXI+1
136 S ^BSDXTMP($J,BSDXI)=$C(31)
137 Q
138 ;
139ETRAP ;EP Error trap entry
140 D ^%ZTER
141 I '$D(BSDXI) N BSDXI S BSDXI=999
142 S BSDXI=BSDXI+1
143 D ERR(BSDXI,$G(BSDXCNT),"Routine: BSDX29, Error: "_$G(%ZTERROR))
144 Q
145 ;
146CPSTAT(BSDXY,BSDXTSK) ;EP
147 ;Return status (copied record count) of tasked job having ZTSK=BSDXTSK
148 ;
149 S BSDXY="^BSDXTMP("_$J_")"
150 N BSDXI,BSDXCNT
151 S BSDXI=0
152 S X="ETRAP^BSDX29",@^%ZOSF("TRAP")
153 S ^BSDXTMP($J,0)="T00020RECORD_COUNT^T00020ERRORID"_$C(30)
154 S BSDXCNT=$G(^BSDXTMP("BSDXCOPY",BSDXTSK))
155 I BSDXCNT["Finished" K ^BSDXTMP("BSDXCOPY",BSDXTSK)
156 I BSDXCNT["Cancelled" K ^BSDXTMP("BSDXCOPY",BSDXTSK)
157 ;I $D(^BSDXTMP("BSDXCOPY",BSDXTSK,"CANCEL")) K ^BSDXTMP("BSDXCOPY",BSDXTSK)
158 S BSDXI=BSDXI+1
159 S ^BSDXTMP($J,BSDXI)=BSDXCNT_"^"_"OK"_$C(30)_$C(31)
160 Q
161 ;
162CPCANC(BSDXY,BSDXTSK) ;EP
163 ;Signal tasked job having ZTSK=BSDXTSK to cancel
164 ;Returns current record count of copy process
165 ;
166 S BSDXY="^BSDXTMP("_$J_")"
167 N BSDXI,BSDXCNT
168 S BSDXI=0
169 S X="ETRAP^BSDX29",@^%ZOSF("TRAP")
170 S ^BSDXTMP($J,0)="T00020RECORD_COUNT^T00020ERRORID"_$C(30)
171 S BSDXCNT=$G(^BSDXTMP("BSDXCOPY",BSDXTSK))
172 I BSDXCNT["FINISHED" K ^BSDXTMP("BSDXCOPY",BSDXTSK)
173 E S ^BSDXTMP("BSDXCOPY",BSDXTSK,"CANCEL")=""
174 S BSDXI=BSDXI+1
175 S ^BSDXTMP($J,BSDXI)=BSDXCNT_"^"_"OK"_$C(30)_$C(31)
176 Q
177 ;
178ADDMIN(BSDXSTRT,BSDXLEN) ;
179 ;
180 ;Add BSDXLEN minutes to time BSDXSTRT and return end time
181 N BSDXEND,BSDXH,BSDXM,BSDXSTIM,BSDXETIM
182 S BSDXEND=$P(BSDXSTRT,".")
183 ;
184 ;Convert start time to minutes past midnight
185 S BSDXSTIM=$P(BSDXSTRT,".",2)
186 S BSDXSTIM=BSDXSTIM_"0000"
187 S BSDXSTIM=$E(BSDXSTIM,1,4)
188 S BSDXH=$E(BSDXSTIM,1,2)
189 S BSDXH=BSDXH*60
190 S BSDXH=BSDXH+$E(BSDXSTIM,3,4)
191 ;
192 ;Add duration to find minutes past midnight of end time
193 S BSDXETIM=BSDXH+BSDXLEN
194 ;
195 ;Convert back to a time
196 S BSDXH=BSDXETIM\60
197 S BSDXH="00"_BSDXH
198 S BSDXH=$E(BSDXH,$L(BSDXH)-1,$L(BSDXH))
199 S BSDXM=BSDXETIM#60
200 S BSDXM="00"_BSDXM
201 S BSDXM=$E(BSDXM,$L(BSDXM)-1,$L(BSDXM))
202 S BSDXETIM=BSDXH_BSDXM
203 I BSDXETIM>2400 S BSDXETIM=2400
204 S $P(BSDXEND,".",2)=BSDXETIM
205 Q BSDXEND
Note: See TracBrowser for help on using the repository browser.