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

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

changes to BSDX29 for i18n

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