source: Scheduling/trunk/m/BSDX07.m@ 1295

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

Changes to BSDX01 to prevent Scheduled,dc'ed,completed radiology appointments from being cancelled. Updated files to T2.
File size: 14.6 KB
RevLine 
[1161]1BSDX07 ; VW/UJO/SMH - WINDOWS SCHEDULING RPCS ; 4/28/11 10:17am
[1187]2 ;;1.6T2;BSDX;;May 16, 2011
[1161]3 ; Licensed under LGPL
[1041]4 ;
5 ; Change Log:
6 ; UJO/SMH
7 ; v1.3 July 13 2010 - Add support i18n - Dates input as FM dates, not US.
8 ; v1.42 Oct 22 2010 - Transaction now restartable by providing arguments
9 ; thanks to Rick Marshall and Zach Gonzalez at Oroville.
10 ; v1.42 Oct 30 2010 - Extensive refactoring.
[1105]11 ; v1.5 Mar 15 2011 - End time does not have to have time anymore.
12 ; It could be midnight of the next day
[1172]13 ; v1.6 Apr 11 2011 - Support for Scheduling Radiology Exams...
[1041]14 ;
15 ; Error Reference:
16 ; -1: Patient Record is locked. This means something is wrong!!!!
17 ; -2: Start Time is not a valid Fileman date
18 ; -3: End Time is not a valid Fileman date
[1105]19 ; v1.5:obsolete::-4: End Time does not have time inside of it.
[1041]20 ; -5: BSDXPATID is not numeric
21 ; -6: Patient Does not exist in ^DPT
22 ; -7: Resource Name does not exist in B index of BSDX RESOURCE
23 ; -8: Resouce doesn't exist in ^BSDXRES
24 ; -9: Couldn't add appointment to BSDX APPOINTMENT
25 ; -10: Couldn't add appointment to files 2 and/or 44
26 ; -100: Mumps Error
27
28APPADDD(BSDXY,BSDXSTART,BSDXEND,BSDXPATID,BSDXRES,BSDXLEN,BSDXNOTE,BSDXATID) ;EP
29 ;Entry point for debugging
30 D DEBUG^%Serenji("APPADD^BSDX07(.BSDXY,BSDXSTART,BSDXEND,BSDXPATID,BSDXRES,BSDXLEN,BSDXNOTE,BSDXATID)")
31 Q
32 ;
33UT ; Unit Tests
34 N ZZZ
35 ; Test for bad start date
36 D APPADD(.ZZZ,2100123,3100123.3,2,"Dr Office",30,"Sam's Note",1)
37 I +$P(^BSDXTMP($J,1),U,2)'=-2 W "Error in -2",!
38 ; Test for bad end date
39 D APPADD(.ZZZ,3100123,2100123.3,2,"Dr Office",30,"Sam's Note",1)
40 I +$P(^BSDXTMP($J,1),U,2)'=-3 W "Error in -3",!
41 ; Test for end date without time
42 D APPADD(.ZZZ,3100123.1,3100123,2,"Dr Office",30,"Sam's Note",1)
43 I +$P(^BSDXTMP($J,1),U,2)'=-4 W "Error in -4",!
44 ; Test for mumps error
45 S bsdxdie=1
46 D APPADD(.ZZZ,3100123.09,3100123.093,2,"Dr Office",30,"Sam's Note",1)
47 I +$P(^BSDXTMP($J,1),U,2)'=-100 W "Error in -100: M Error",!
48 K bsdxdie
49 ; Test for TRESTART
50 s bsdxrestart=1
51 D APPADD(.ZZZ,3100123.09,3100123.093,3,"Dr Office",30,"Sam's Note",1)
52 I +$P(^BSDXTMP($J,1),U,2)'=0&(+$P(^BSDXTMP($J,1),U,2)'=-10) W "Error in TRESTART",!
53 k bsdxrestart
54 ; Test for non-numeric patient
55 D APPADD(.ZZZ,3100123.09,3100123.093,"CAT,DOG","Dr Office",30,"Sam's Note",1)
56 I +$P(^BSDXTMP($J,1),U,2)'=-5 W "Error in -5",!
57 ; Test for a non-existent patient
58 D APPADD(.ZZZ,3100123.09,3100123.093,8989898989,"Dr Office",30,"Sam's Note",1)
59 I +$P(^BSDXTMP($J,1),U,2)'=-6 W "Error in -6",!
60 ; Test for a non-existent resource name
61 D APPADD(.ZZZ,3100123.09,3100123.093,3,"lkajsflkjsadf",30,"Sam's Note",1)
62 I +$P(^BSDXTMP($J,1),U,2)'=-7 W "Error in -7",!
63 ; Test for corrupted resource
64 ; Can't test for -8 since it requires DB corruption
65 ; Test for inability to add appointment to BSDX Appointment
66 ; Also requires something wrong in the DB
67 ; Test for inability to add appointment to 2,44
68 ; Test by creating a duplicate appointment
69 D APPADD(.ZZZ,3100123.09,3100123.093,3,"Dr Office",30,"Sam's Note",1)
70 D APPADD(.ZZZ,3100123.09,3100123.093,3,"Dr Office",30,"Sam's Note",1)
71 I +$P(^BSDXTMP($J,1),U,2)'=-10 W "Error in -10",!
72 ; Test for normality:
73 D APPADD(.ZZZ,3110123.09,3110123.093,3,"Dr Office",30,"Sam's Note",1)
74 ; Does Appt exist?
75 N APPID S APPID=+$P(^BSDXTMP($J,1),U)
76 I 'APPID W "Error Making Appt-1" QUIT
77 I +^BSDXAPPT(APPID,0)'=3110123.09 W "Error Making Appt-2"
78 I '$D(^DPT(3,"S",3110123.09)) W "Error Making Appt-3"
79 I '$D(^SC(2,"S",3110123.09)) W "Error Making Appt-4"
80 QUIT
81 ;
[1172]82APPADD(BSDXY,BSDXSTART,BSDXEND,BSDXPATID,BSDXRES,BSDXLEN,BSDXNOTE,BSDXATID,BSDXRADEXAM) ;EP
83 ;
[1041]84 ;Called by RPC: BSDX ADD NEW APPOINTMENT
85 ;
86 ;Add new appointment to 3 files
87 ; - BSDX APPOINTMENT
88 ; - Hosp Location Appointment SubSubfile if Resource is linked to clinic
89 ; - Patient Appointment Subfile if Resource is linked to clinic
90 ;
91 ;Paramters:
92 ;BSDXY: Global Return (RPC must be set to Global Array)
93 ;BSDXSTART: FM Start Date
94 ;BSDXEND: FM End Date
95 ;BSDXPATID: Patient DFN
96 ;BSDXRES is ResourceName in BSDX RESOURCE file (not IEN)
97 ;BSDXLEN is the appointment duration in minutes
98 ;BSDXNOTE is the Appiontment Note
99 ;BSDXATID is used for 2 purposes:
100 ; if BSDXATID = "WALKIN" then BSDAPI is called to create a walkin appt.
101 ; if BSDXATID = a number, then it is the access type id (used for rebooking)
[1172]102 ;BSDXRADEXAM is used to store the Radiology Exam to which this appointment is tied to (optional)
[1041]103 ;
104 ;Return:
105 ; ADO.net Recordset having fields:
106 ; AppointmentID and ErrorNumber
107 ;
108 ;Test lines:
109 ;BSDX ADD NEW APPOINTMENT^3091122.0930^3091122.1000^370^Dr Office^30^EXAM^WALKIN
110 ;
[1172]111 ; Deal with optional arguments
112 S BSDXRADEXAM=$G(BSDXRADEXAM)
[1041]113 ; Return Array; set Return and clear array
114 S BSDXY=$NA(^BSDXTMP($J))
115 K ^BSDXTMP($J)
116 ; $ET
117 N $ET S $ET="G ETRAP^BSDX07"
118 ; Counter
119 N BSDXI S BSDXI=0
120 ; Lock BSDX node, only to synchronize access to the globals.
121 ; It's not expected that the error will ever happen as no filing
122 ; is supposed to take 5 seconds.
123 L +^BSDXAPPT(BSDXPATID):5 I '$T D ERR(BSDXI,"-1~Patient record is locked. Please contact technical support.") Q
124 ; Header Node
125 S ^BSDXTMP($J,BSDXI)="I00020APPOINTMENTID^T00100ERRORID"_$C(30)
126 ;Restartable Transaction; restore paramters when starting.
127 ; (Params restored are what's passed here + BSDXI)
128 TSTART (BSDXY,BSDXSTART,BSDXEND,BSDXPATID,BSDXRES,BSDXLEN,BSDXNOTE,BSDXATID,BSDXI):T="BSDX ADD NEW APPOINTMENT^BSDX07"
129 ;
130 ; Turn off SDAM APPT PROTOCOL BSDX Entries
131 N BSDXNOEV
132 S BSDXNOEV=1 ;Don't execute BSDX ADD APPOINTMENT protocol
133 ;
134 ; Set Error Message to be empty
135 N BSDXERR S BSDXERR=0
136 ;
137 ;;;test for error inside transaction. See if %ZTER works
138 I $G(bsdxdie) S X=1/0
139 ;;;test
140 ;;;test for TRESTART
141 I $G(bsdxrestart) K bsdxrestart TRESTART
142 ;;;test
143 ;
144 ; -- Start and End Date Processing --
145 ; If C# sends the dates with extra zeros, remove them
146 S BSDXSTART=+BSDXSTART,BSDXEND=+BSDXEND
147 ; Are the dates valid? Must be FM Dates > than 2010
148 I BSDXSTART'>3100000 D ERR(BSDXI,"-2~BSDX07 Error: Invalid Start Time") Q
149 I BSDXEND'>3100000 D ERR(BSDXI,"-3~BSDX07 Error: Invalid End Time") Q
[1105]150 ;
151 ;; If Ending date doesn't have a time, this is an error --rm 1.5
152 ; I $L(BSDXEND,".")=1 D ERR(BSDXI,"-4~BSDX07 Error: Invalid End Time") Q
153 ;
[1041]154 ; If the Start Date is greater than the end date, swap dates
155 N BSDXTMP
156 I BSDXSTART>BSDXEND S BSDXTMP=BSDXEND,BSDXEND=BSDXSTART,BSDXSTART=BSDXTMP
157 ;
158 ; Check if the patient exists:
159 ; - DFN valid number?
160 ; - Valid Patient in file 2?
161 I '+BSDXPATID D ERR(BSDXI,"-5~BSDX07 Error: Invalid Patient ID") Q
162 I '$D(^DPT(BSDXPATID,0)) D ERR(BSDXI,"-6~BSDX07 Error: Invalid Patient ID") Q
163 ;
164 ;Validate Resource entry
165 I '$D(^BSDXRES("B",BSDXRES)) D ERR(BSDXI,"-7~BSDX07 Error: Invalid Resource ID") Q
166 N BSDXRESD ; Resource IEN
167 S BSDXRESD=$O(^BSDXRES("B",BSDXRES,0))
168 N BSDXRNOD ; Resouce zero node
169 S BSDXRNOD=$G(^BSDXRES(BSDXRESD,0))
170 I BSDXRNOD="" D ERR(BSDXI,"-8~BSDX07 Error: invalid Resource entry.") Q
171 ;
172 ; Walk-in (Unscheduled) Appointment?
173 N BSDXWKIN S BSDXWKIN=0
174 I BSDXATID="WALKIN" S BSDXWKIN=1
175 ; Reset Access Type ID if it doesn't say "WALKIN" and isn't a number
176 I BSDXATID'?.N&(BSDXATID'="WALKIN") S BSDXATID=""
177 ;
178 ; Done with all checks, let's make appointment in BSDX APPOINTMENT
179 N BSDXAPPTID
[1172]180 S BSDXAPPTID=$$BSDXADD(BSDXSTART,BSDXEND,BSDXPATID,BSDXRESD,BSDXATID,BSDXRADEXAM)
[1041]181 I 'BSDXAPPTID D ERR(BSDXI,"-9~BSDX07 Error: Unable to add appointment to BSDX APPOINTMENT file.") Q
182 I BSDXNOTE]"" D BSDXWP(BSDXAPPTID,BSDXNOTE)
183 ;
184 ; Then Create Subfiles in 2/44 Appointment
185 N BSDXSCD S BSDXSCD=$P(BSDXRNOD,U,4) ; Hosp Location IEN
186 ; Only if we have a valid Hosp Loc can we make an appointment
[1081]187 I +BSDXSCD,$D(^SC(BSDXSCD,0)) D I +BSDXERR D ERR(BSDXI,"-10~BSDX07 Error: MAKE^BSDXAPI returned error code: "_BSDXERR) Q
[1041]188 . N BSDXC
189 . S BSDXC("PAT")=BSDXPATID
190 . S BSDXC("CLN")=BSDXSCD
191 . S BSDXC("TYP")=3 ;3 for scheduled appts, 4 for walkins
192 . S:BSDXWKIN BSDXC("TYP")=4
193 . S BSDXC("ADT")=BSDXSTART
194 . S BSDXC("LEN")=BSDXLEN
195 . S BSDXC("OI")=$E($G(BSDXNOTE),1,150) ;File 44 has 150 character limit on OTHER field
196 . S BSDXC("OI")=$TR(BSDXC("OI"),";"," ") ;No semicolons allowed by MAKE^BSDXAPI
197 . S BSDXC("OI")=$$STRIP(BSDXC("OI")) ;Strip control characters from note
198 . S BSDXC("USR")=DUZ
199 . S BSDXERR=$$MAKE^BSDXAPI(.BSDXC)
200 . Q:BSDXERR
201 . ;Update RPMS Clinic availability
202 . D AVUPDT(BSDXSCD,BSDXSTART,BSDXLEN)
203 . Q
204 ;
205 ;Return Recordset
206 TCOMMIT
207 L -^BSDXAPPT(BSDXPATID)
208 S BSDXI=BSDXI+1
209 S ^BSDXTMP($J,BSDXI)=BSDXAPPTID_"^"_$C(30)
210 S BSDXI=BSDXI+1
211 S ^BSDXTMP($J,BSDXI)=$C(31)
212 Q
[614]213BSDXDEL(BSDXAPPTID) ;Deletes appointment BSDXAPPTID from BSDXAPPOINTMETN
[1041]214 N DA,DIK
215 S DIK="^BSDXAPPT(",DA=BSDXAPPTID
216 D ^DIK
217 Q
218 ;
219STRIP(BSDXZ) ;Replace control characters with spaces
220 N BSDXI
221 F BSDXI=1:1:$L(BSDXZ) I (32>$A($E(BSDXZ,BSDXI))) S BSDXZ=$E(BSDXZ,1,BSDXI-1)_" "_$E(BSDXZ,BSDXI+1,999)
222 Q BSDXZ
223 ;
[1172]224BSDXADD(BSDXSTART,BSDXEND,BSDXPATID,BSDXRESD,BSDXATID,BSDXRADEXAM) ;ADD BSDX APPOINTMENT ENTRY
[1041]225 ;Returns ien in BSDXAPPT or 0 if failed
226 ;Create entry in BSDX APPOINTMENT
227 N BSDXAPPTID
228 S BSDXFDA(9002018.4,"+1,",.01)=BSDXSTART
229 S BSDXFDA(9002018.4,"+1,",.02)=BSDXEND
230 S BSDXFDA(9002018.4,"+1,",.05)=BSDXPATID
231 S BSDXFDA(9002018.4,"+1,",.07)=BSDXRESD
232 S BSDXFDA(9002018.4,"+1,",.08)=$G(DUZ)
233 S BSDXFDA(9002018.4,"+1,",.09)=$$NOW^XLFDT
234 S:BSDXATID="WALKIN" BSDXFDA(9002018.4,"+1,",.13)="y"
235 S:BSDXATID?.N BSDXFDA(9002018.4,"+1,",.06)=BSDXATID
[1172]236 S BSDXFDA(9002018.4,"+1,",.14)=BSDXRADEXAM
[1041]237 N BSDXIEN,BSDXMSG
238 D UPDATE^DIE("","BSDXFDA","BSDXIEN","BSDXMSG")
239 S BSDXAPPTID=+$G(BSDXIEN(1))
240 Q BSDXAPPTID
241 ;
[614]242BSDXWP(BSDXAPPTID,BSDXNOTE) ;
[1041]243 ;Add WP field
244 I BSDXNOTE]"" S BSDXNOTE(.5)=BSDXNOTE,BSDXNOTE=""
245 I $D(BSDXNOTE(0)) S BSDXNOTE(.5)=BSDXNOTE(0) K BSDXNOTE(0)
246 I $D(BSDXNOTE(.5)) D
247 . D WP^DIE(9002018.4,BSDXAPPTID_",",1,"","BSDXNOTE","BSDXMSG")
248 Q
249 ;
[614]250ADDEVT(BSDXPATID,BSDXSTART,BSDXSC,BSDXSCDA) ;EP
[1041]251 ;Called by BSDX ADD APPOINTMENT protocol
252 ;BSDXSC=IEN of clinic in ^SC
253 ;BSDXSCDA=IEN for ^SC(BSDXSC,"S",BSDXSTART,1,BSDXSCDA). Use to get Length & Note
254 ;
255 N BSDXNOD,BSDXLEN,BSDXAPPTID,BSDXNODP,BSDXWKIN,BSDXRES
256 Q:+$G(BSDXNOEV)
257 I $D(^BSDXRES("ALOC",BSDXSC)) S BSDXRES=$O(^BSDXRES("ALOC",BSDXSC,0))
258 E I $D(^BSDXRES("ASSOC",BSDXSC)) S BSDXRES=$O(^BSDXRES("ASSOC",BSDXSC,0))
259 Q:'+$G(BSDXRES)
260 S BSDXNOD=$G(^SC(BSDXSC,"S",BSDXSTART,1,BSDXSCDA,0))
261 Q:BSDXNOD=""
262 S BSDXNODP=$G(^DPT(BSDXPATID,"S",BSDXSTART,0))
263 S BSDXWKIN=""
264 S:$P(BSDXNODP,U,7)=4 BSDXWKIN="WALKIN" ;Purpose of Visit field of DPT Appointment subfile
265 S BSDXLEN=$P(BSDXNOD,U,2)
266 Q:'+BSDXLEN
267 S BSDXEND=$$FMADD^XLFDT(BSDXSTART,0,0,BSDXLEN,0)
268 S BSDXAPPTID=$$BSDXADD(BSDXSTART,BSDXEND,BSDXPATID,BSDXRES,BSDXWKIN)
269 Q:'+BSDXAPPTID
270 S BSDXNOTE=$P(BSDXNOD,U,4)
271 I BSDXNOTE]"" D BSDXWP(BSDXAPPTID,BSDXNOTE)
272 D ADDEVT3(BSDXRES)
273 Q
274 ;
275ADDEVT3(BSDXRES) ;
276 ;Call RaiseEvent to notify GUI clients
277 N BSDXRESN
278 S BSDXRESN=$G(^BSDXRES(BSDXRES,0))
279 Q:BSDXRESN=""
280 S BSDXRESN=$P(BSDXRESN,"^")
281 ;D EVENT^BSDX23("SCHEDULE-"_BSDXRESN,"","","")
282 D EVENT^BMXMEVN("BSDX SCHEDULE",BSDXRESN)
283 Q
284 ;
285ERR(BSDXI,BSDXERR) ;Error processing
286 S BSDXI=BSDXI+1
287 S BSDXERR=$TR(BSDXERR,"^","~")
288 I $TL>0 TROLLBACK
289 S ^BSDXTMP($J,BSDXI)="0^"_BSDXERR_$C(30)
290 S BSDXI=BSDXI+1
291 S ^BSDXTMP($J,BSDXI)=$C(31)
292 L -^BSDXAPPT(BSDXPATID)
293 Q
294 ;
295ETRAP ;EP Error trap entry
296 N $ET S $ET="D ^%ZTER HALT" ; Emergency Error Trap
297 ; Rollback, otherwise ^XTER will be empty from future rollback
298 I $TL>0 TROLLBACK
299 D ^%ZTER
300 S $EC="" ; Clear Error
301 ; Log error message and send to client
302 I '$D(BSDXI) N BSDXI S BSDXI=0
303 D ERR(BSDXI,"-100~BSDX07 Error: "_$G(%ZTERZE))
304 Q
305 ;
[614]306DAY ;;^SUN^MON^TUES^WEDNES^THURS^FRI^SATUR
[1041]307 ;
[614]308DOW S %=$E(X,1,3),Y=$E(X,4,5),Y=Y>2&'(%#4)+$E("144025036146",Y)
[1041]309 F %=%:-1:281 S Y=%#4=1+1+Y
310 S Y=$E(X,6,7)+Y#7
311 Q
312 ;
313AVUPDT(BSDXSCD,BSDXSTART,BSDXLEN) ;Update RPMS Clinic availability
314 ;SEE SDM1
315 N Y,DFN
316 N SL,STARTDAY,X,SC,SB,HSI,SI,STR,SDDIF,SDMAX,SDDATE,SDDMAX,SDSDATE,CCXN,MXOK,COV,SDPROG
317 N X1,SDEDT,X2,SD,SM,SS,S,SDLOCK,ST,I
318 S Y=BSDXSCD,DFN=BSDXPATID
319 S SL=$G(^SC(+Y,"SL")),X=$P(SL,U,3),STARTDAY=$S($L(X):X,1:8),SC=Y,SB=STARTDAY-1/100,X=$P(SL,U,6),HSI=$S(X=1:X,X:X,1:4),SI=$S(X="":4,X<3:4,X:X,1:4),STR="#@!$* XXWVUTSRQPONMLKJIHGFEDCBA0123456789jklmnopqrstuvwxyz",SDDIF=$S(HSI<3:8/HSI,1:2) K Y
320 ;Determine maximum days for scheduling
321 S SDMAX(1)=$P($G(^SC(+SC,"SDP")),U,2) S:'SDMAX(1) SDMAX(1)=365
322 S (SDMAX,SDDMAX)=$$FMADD^XLFDT(DT,SDMAX(1))
323 S SDDATE=BSDXSTART
324 S SDSDATE=SDDATE,SDDATE=SDDATE\1
3251 ;L Q:$D(SDXXX) S CCXN=0 K MXOK,COV,SDPROT Q:DFN<0 S SC=+SC
326 Q:$D(SDXXX) S CCXN=0 K MXOK,COV,SDPROT Q:DFN<0 S SC=+SC
327 S X1=DT,SDEDT=365 S:$D(^SC(SC,"SDP")) SDEDT=$P(^SC(SC,"SDP"),"^",2)
328 S X2=SDEDT D C^%DTC S SDEDT=X
329 S Y=BSDXSTART
[614]330EN1 S (X,SD)=Y,SM=0 D DOW
[1041]331S I '$D(^SC(SC,"ST",$P(SD,"."),1)) S SS=+$O(^SC(+SC,"T"_Y,SD)) Q:SS'>0 Q:^(SS,1)="" S ^SC(+SC,"ST",$P(SD,"."),1)=$E($P($T(DAY),U,Y+2),1,2)_" "_$E(SD,6,7)_$J("",SI+SI-6)_^(1),^(0)=$P(SD,".")
332 S S=BSDXLEN
333 ;Check if BSDXLEN evenly divisible by appointment length
334 S RPMSL=$P(SL,U)
335 I BSDXLEN<RPMSL S BSDXLEN=RPMSL
336 I BSDXLEN#RPMSL'=0 D
337 . S BSDXINC=BSDXLEN\RPMSL
338 . S BSDXINC=BSDXINC+1
339 . S BSDXLEN=RPMSL*BSDXINC
340 S SL=S_U_$P(SL,U,2,99)
341SC S SDLOCK=$S('$D(SDLOCK):1,1:SDLOCK+1) Q:SDLOCK>9
342 L +^SC(SC,"ST",$P(SD,"."),1):5 G:'$T SC
343 S SDLOCK=0,S=^SC(SC,"ST",$P(SD,"."),1)
344 S I=SD#1-SB*100,ST=I#1*SI\.6+($P(I,".")*SI),SS=SL*HSI/60*SDDIF+ST+ST
345 I (I<1!'$F(S,"["))&(S'["CAN") L -^SC(SC,"ST",$P(SD,"."),1) Q
346 I SM<7 S %=$F(S,"[",SS-1) S:'%!($P(SL,"^",6)<3) %=999 I $F(S,"]",SS)'<%!(SDDIF=2&$E(S,ST+ST+1,SS-1)["[") S SM=7
347 ;
348SP I ST+ST>$L(S),$L(S)<80 S S=S_" " G SP
349 S SDNOT=1
350 S ABORT=0
351 F I=ST+ST:SDDIF:SS-SDDIF D Q:ABORT
352 . S ST=$E(S,I+1) S:ST="" ST=" "
353 . S Y=$E(STR,$F(STR,ST)-2)
354 . I S["CAN"!(ST="X"&($D(^SC(+SC,"ST",$P(SD,"."),"CAN")))) S ABORT=1 Q
355 . I Y="" S ABORT=1 Q
356 . S:Y'?1NL&(SM<6) SM=6 S ST=$E(S,I+2,999) S:ST="" ST=" " S S=$E(S,1,I)_Y_ST
357 . Q
358 S ^SC(SC,"ST",$P(SD,"."),1)=S
359 L -^SC(SC,"ST",$P(SD,"."),1)
360 Q
Note: See TracBrowser for help on using the repository browser.