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

Last change on this file since 1449 was 1449, checked in by Sam Habiel, 12 years ago

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