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

Last change on this file since 833 was 614, checked in by Sam Habiel, 15 years ago

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