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

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

Change version to 1.4 on all routines
BSDX08 has fix for drag and drop because it referenced a non existent cancellation reason
File size: 6.0 KB
Line 
1BSDX29 ; IHS/OIT/HMW - WINDOWS SCHEDULING RPCS ; 7/18/10 2:03pm
2 ;;1.4;BSDX;;Sep 07, 2010
3 ;
4 ; Change Log:
5 ; v1.3 by WV/SMH on 3100713
6 ; - Beginning and Ending dates passed as FM Dates
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:
19 ;
20 ; July 13 2010: D dates (BEG and END) from US format to FM Dates for i18n
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
30 ;
31 ;TODO:Validate FM Dates coming through
32 ;
33 S BSDXBEG=BSDXBEG-1
34 S BSDXEND=BSDXEND+1
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.