source: ccr/trunk/p/C0CMAIL3.m@ 1779

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

Changed license to AGPL. Some clean-up for XINDEX

  • Property svn:mergeinfo set to (toggle deleted branches)
    /ccr/branches/ohum/o-old/p/C0CMAIL3.m1290
    /ccr/branches/ohum/p/C0CMAIL3.m1291-1543
    /ccr/branches/ohum/p/p/C0CMAIL3.m1287-1289
File size: 16.6 KB
Line 
1C0CMAIL3 ; Communications for MIME Documents and MultiMIME ; 3110420 ; rcr/rcr ; 5/10/12 2:51pm
2 ;;1.2;CCD/CCR GENERATION UTILITIES;;Oct 30, 2012;Build 50
3 ;Copyright 2011 Chris Richardson, Richardson Computer Research
4 ; Modified 3110619@2038
5 ; rcr@rcresearch.us
6 ;
7 ; This program is free software: you can redistribute it and/or modify
8 ; it under the terms of the GNU Affero General Public License as
9 ; published by the Free Software Foundation, either version 3 of the
10 ; License, or (at your option) any later version.
11 ;
12 ; This program is distributed in the hope that it will be useful,
13 ; but WITHOUT ANY WARRANTY; without even the implied warranty of
14 ; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
15 ; GNU Affero General Public License for more details.
16 ;
17 ; You should have received a copy of the GNU Affero General Public License
18 ; along with this program. If not, see <http://www.gnu.org/licenses/>.
19 ;
20 ; ------------------
21 ;Entry Points
22 ; DETAIL^C0CMAIL(.C0CDATA,IEN) --> Get details of the Mail Message and Attachments
23 ; GETMSG^C0CMAIL(.C0CDATA,.C0CINPUT)
24 ; Input:
25 ; C0CINPUT = "DUZ;MAILBOX_Name[or IEN for box (comma Separated);MALL
26 ; or "*" for all boxes, default is "IN" if missing]"
27 ; $P(C0CINPUT,";",3)=MALL, default=NUL means "New only",
28 ; "*" for All or 9,999 maximum
29 ; MALL?1.n = that number of the n most recent
30 ; Internally:
31 ; BNAM = Box Name
32 ; Output:
33 ; C0CDATA
34 ; = (BNAM,"NUMBER") = Number of NEW Emails in Basket
35 ; (BNAM,"MSG",C0CIEN,"FROM")=Name
36 ; (BNAM,"MSG",C0CIEN,"TO",n)=DUZ, or EMAIL Address
37 ; (BNAM,"MSG",C0CIEN,"TO NAME",n)=Names or EMAIL Address
38 ; (BNAM,"MSG",C0CIEN,"TITLE")=EMAIL Title
39 ; (BNAM,"MSG",C0CIEN[for File 3.9])=Number of Attachments
40 ; (BNAM,"MSG",C0CIEN,num,"CONT") = Free Text
41 ; (BNAM,"MSG",C0CIEN,num,"LINES") = Number of Lines of Text
42 ; (BNAM,"MSG",C0CIEN,num,"SIZE") = Size of the Message in Bytes
43 ; (BNAM,"MSG",C0CIEN,num,"TXT",LINE#) = Message Data (No Attachment)
44 ; (BNAM,"MSG",C0CIEN,"SEG",NUM) = First Line^Last Line
45 ; (BNAM,"MSG",C0CIEN,"SEG",NUM,"CONT",type) = Message Details
46 ; (BNAM,"MSG",C0CIEN,"SEG",NUM,LINE#) = Message Data
47 ;
48 ; DO DETAIL^C0CMAIL(.OUTBF,D0) ; For each Email Message and Attachments
49 ; Input;
50 ; D0 - The IEN for the message in file 3.9, MESSAGE global
51 ; Output
52 ; OUTBF - The array of your choice to save the expanded and decoded message.
53 ;
54GETMSG(C0CDATA,C0CINPUT) ; Common Entry Point for Mailbox Data
55 K:'$G(C0CDATA("KEEP")) C0CDATA
56 N U
57 S U="^"
58 D:$G(C0CINPUT)
59 . N BF,DUZ,I,INPUT,J,L,LST,MBLST,MALL
60 . S INPUT=C0CINPUT
61 . S DUZ=+INPUT
62 . I $D(^VA(200,DUZ))=0!('$D(^VA(200,DUZ,0))) D ERROR("ER06") Q
63 . ;
64 . D:$D(^XMB(3.7,DUZ,0))#2
65 . . S MBLST=$P(INPUT,";",2)
66 . . S MALL=$P(INPUT,";",3) ; New or All Mail Flag
67 . . S:MALL["*" MALL=99999
68 . . ; Only one of these can be correct
69 . . D
70 . . . ; If nul, make it "IN" only
71 . . . I MBLST="" D QUIT
72 . . . . S MBLST("IN")=0,I=0
73 . . . . D GATHER(DUZ,"IN",.LST)
74 . . . .QUIT
75 . . . ;
76 . . . ; If "*", Get all Mailboxes and look for New Messages
77 . . . I MBLST["*" D QUIT
78 . . . . N NAM,NUM
79 . . . . S NUM=0
80 . . . . F S NUM=$O(^XMB(3.7,DUZ,2,NUM)) Q:'NUM D
81 . . . . . S NAM=$P(^XMB(3.7,DUZ,2,NUM,0),U)
82 . . . . . D GATHER(DUZ,NAM,.LST)
83 . . . . .QUIT
84 . . . .QUIT
85 . . . ;
86 . . . ; If comma separated, look for mailboxes with new messages
87 . . . I $L(MBLST,",")>1 D QUIT
88 . . . . S NAM=""
89 . . . . N TN,V
90 . . . . F TN=1:1:$L(MBLST,",") S V=$P(MBLST,",",TN) D
91 . . . . . I $L(V) D QUIT
92 . . . . . . I V S NAM=$P($G(^XMB(3.7,DUZ,2,V,0)),U)
93 . . . . . . S:NAM="" NAM=V
94 . . . . . . D GATHER(DUZ,NAM,.LST)
95 . . . . . .QUIT
96 . . . . . ;
97 . . . . . D ERROR("ER08")
98 . . . . .QUIT
99 . . . .QUIT
100 . . . ;
101 . . . ; If only 1 mailbox named, go get it
102 . . . I $L(MBLST) D QUIT
103 . . . . I $D(^XMB(3.7,DUZ,2,"B",MBLST)) D GATHER(DUZ,MBLST,.LST) QUIT
104 . . . . ;
105 . . . . D ERROR("ER07")
106 . . .QUIT
107 . . MERGE C0CDATA=LST
108 . .QUIT
109 .QUIT
110 QUIT
111 ; ===================
112GATHER(DUZ,NAM,LST) ; Gather Data about the Baskets and their mail
113 N I,J,K,L
114 S (I,K)=0
115 S J=$O(^XMB(3.7,DUZ,2,"B",NAM,""))
116 F S I=$O(^XMB(3.7,DUZ,2,J,1,I)) Q:'I D
117 . S L=$P(^XMB(3.7,DUZ,2,J,1,I,0),U,3)
118 . D ; :L
119 . . S:L K=K+1,LST(NAM,"MSG",I,"NEW")="" ; Flag NEW emails
120 . . S LST(NAM,"MSG",I)=L
121 . . D GETTYP(I)
122 . .QUIT
123 .QUIT
124 S LST(NAM,"NUMBER")=K
125 QUIT
126 ; ===================
127 ; D0 is the IEN into the Message Global ^XMB(3.9,D0)
128 ; The products of these emails are scanned to identify
129 ; the number of documents stored in the MIME package.
130 ; The protocol runs like this;
131 ; Line 1 is the --separator
132 ; Line 2 thru n >Look for Content-[detail type:]Description ; Next CMD
133 ; Line n+2 thru t-1 where t does NOT have "Content-"
134 ; Line t is Next Section Terminator, or Message Terminator, --separator
135 ; Line t+1 should not exist in the data set if Message Terminator
136 ; CON = "Content-"
137 ; FLG = "--"
138 ; SEP = FLG+7 or more characters ; Separator
139 ; END = SEP+FLG
140 ; SGC = Segment Count
141 ; Note: separator is a string of specific characters of
142 ; indeterminate length
143 ; LST() the transfer array
144 ; LST(NAM,"MSG",C0CIEN,"SEG",SGN)=Starting Line^Ending Line
145 ; LST(NAM,"MSG",C0CIEN,"SEG",SGN,1:n)=Decoded Message Data
146 ;
147GETTYP(D0) ; Look for the goodies in the Mail
148 N I,J,N,BCN,CON,CNT,D1,END,FLG,SEP,SGC,XX,XXNM
149 S CON="Content-"
150 S FLG="--"
151 S SEP="" ; Start SEP as null, so we can use this to help identify the type
152 S (BCN,CNT,D1,END,SGC)=0
153 S XX=$G(^XMB(3.9,D0,0))
154 S LST(NAM,"MSG",D0,"TITLE")=$P($G(^XMB(3.9,D0,0)),U,1)
155 S LST(NAM,"MSG",D0,"CREATED")=$G(^XMB(3.9,D0,.6))
156 F I=4,2 S XXNM=$P(XX,U,I) Q:$L(XXNM)
157 S LST(NAM,"MSG",D0,"FROM")=$$NAME(XXNM)
158 S LST(NAM,"MSG",D0,"SENT")=$$TIME($P(XX,U,3))
159 ; Get the folks the email is sent to.
160 S D1=0
161 F S D1=$O(^XMB(3.9,D0,1,D1)) Q:'D1 D
162 . N T
163 . S T=+$G(^XMB(3.9,D0,1,D1,0))
164 . S:T T=$P($G(^VA(200,+T,0)),"^")
165 . S LST("TO",D1)=T
166 . S T=$G(^XMB(3.9,D0,6,D1,0))
167 . S:T T=$P($G(^VA(200,+T,0)),"^")
168 . S:T="" T="<Unknown>"
169 . S LST("TO NAME",D1)=T
170 .QUIT
171 ; Preload first Segment (0) with beginning on Line 1
172 ; if not a 64bit
173 S LST(NAM,"MSG",D0,"SEG",0)=1
174 S D1=.9999,SEP="@@"
175 F S D1=$O(^XMB(3.9,D0,2,D1)) Q:'D1 D
176 . ; Clear any control characters (cr/lf/ff) off
177 . S X=$TR($G(^XMB(3.9,D0,2,D1,0)),$C(10,12,13))
178 . ; Enter once to set the SEP to capture the separator
179 . I SEP=FLG&($E(X,1,2)=FLG)&($L(X,FLG)=2)&($L($P(X,FLG,2)>5)) D Q
180 . . S SEP=X,END=X_FLG
181 . . S (CNT,SGC)=1,BCN=0
182 . . S LST(NAM,"MSG",D0,"SEG",SGC)=D1
183 . .QUIT
184 . ;
185 . ; A new separator is set, process original
186 . I X=SEP D QUIT
187 . . S LST(NAM,"MSG",D0,SGC,"SIZE")=BCN+$L(BF)
188 . . S LST(NAM,"MSG",D0,"SEG",SGC)=$G(LST(NAM,"MSG",D0,"SEG",SGC))_"^"_(D1-1)
189 . . S SGC=SGC+1,BCN=0
190 . . S LST(NAM,"MSG",D0,"SEG",SGC)=D1
191 . .QUIT
192 . ;
193 . S BCN=BCN+$L(X)
194 . I X[CON D Q
195 . . S J=$P($P(X,";"),CON,2)
196 . . S LST(NAM,"MSG",D0,"SEG",SGC,"CONT",CNT,$P(J,":"))=$P(J,":",2)
197 . .QUIT
198 . ;
199 . ; S LST(NAM,"MSG",D0,"SEG",D1)=X
200 .QUIT
201 QUIT
202 ; ===================
203NAME(NM) ; Return the name of the Sender
204 N NAME
205 S NAME="<Unknown Sender>"
206 D
207 . ; Look first for a value to use with the NEW PERSON file
208 . ;
209 . I NM=+NM S NAME=$P(^VA(200,NM,0),U,1) Q
210 . ;
211 . I $L(NM) S NAME=NM Q
212 . ;
213 . ; Else, pull the data from the message and display the foreign source
214 . ; of the message.
215 . N T
216 . S VAL=$G(^XMB(3.9,D0,.7))
217 . S:VAL T=$P(^VA(200,VAL,0),U)
218 . I $L($G(T)) S NAME=T Q
219 . ;
220 .QUIT
221 QUIT NAME
222 ; ===================
223TIME(Y) ; The time and date of the sending
224 X ^DD("DD")
225 QUIT Y
226 ; ===================
227 ; Segments in Message need to be identified and decoded properly
228 ; D DETAIL^C0CMAIL(.ARRAY,D0) ; Call One for each message
229 ; ARRAY will have the details of this one call
230 ;
231 ; Inputs;
232 ; C0CINPUT - The IEN of the message to expand
233 ; Outputs;
234 ; C0CDATA - Carrier for the returned structure of the Message
235 ; C0CDATA(D0,"SEG")=number of SEGMENTS
236 ; C0CDATA(D0,"SEG",0:n)=SEGMENT n details; First;Last;Type
237 ; C0CDATA(D0,"SEG",0:n,"CONTENT",type)=Content details
238 ; C0CDATA(D0,"SEG",0:n,"MSG",D3)=Content details
239 ; C0CDATA(D0,"SEG",0:n,"HTML",D3)=Content details
240 ;
241DETAIL(C0CDATA,C0CINPUT) ; Message Detail Delivery
242 N LST,D0,D1,U
243 S U="^"
244 S D0=+$G(C0CINPUT)
245 I D0 D QUIT
246 . I $D(^XMB(3.9,D0))<10 D ERROR("ER01") QUIT
247 . ;
248 . D GETTYP2(D0)
249 . I $D(LST) M C0CDATA(D0)=LST Q
250 . ;
251 . D ERROR("ER02")
252 .QUIT
253 QUIT
254 ; ===================
255 ; End note if needed
256 ; MSK - Set of characters that do not exist in 64 bit encoding
257GETTYP2(D0) ; Try to get the types and MSK for the
258 N I,J,K,N,BCN,BF,CON,CNT,D1,END,FLG,MSK,SEP,SGC,U,XX,ZN,XXNM
259 S CON="Content-",U="^"
260 S FLG="--",MSK=" !""#$%&'()*,-.:;<>?@[\]^_`{|}~"
261 S (BF,SEP)="" ; Start SEP as null, so we can use this to help identify the type
262 S (BCN,CNT,D1,END,SGC)=0
263 S XX=$G(^XMB(3.9,D0,0))
264 ; S K=$P(^XMB(3.9,D0,2,0),U,3)
265 S LST("TITLE")=$P($G(^XMB(3.9,D0,0)),U,1)
266 S LST("CREATED")=$$TIME($P(XX,U,3))
267 F I=4,2 S XXNM=$P(XX,U,I) Q:$L(XXNM)
268 S LST("FROM")=$$NAME(XXNM)
269 ; Get the folks the email is sent to.
270 S D1=0
271 F S D1=$O(^XMB(3.9,D0,1,D1)) Q:'D1 D Q:D1=""
272 . N I,T
273 . S T=$P($G(^XMB(3.9,D0,1,D1,0)),U)
274 . S:T T=$P($G(^VA(200,T,0)),"^")
275 . S LST("TO",+D1)=T
276 . S T=$G(^XMB(3.9,D0,6,+D1,0))
277 . S:T="" T=$P($G(^VA(200,+T,0)),"^")
278 . S:T="" T="<Unknown>"
279 . S LST("TO NAME",D1)=T
280 .QUIT
281 ; Get the Header for the message and store as "HDR"
282 S D1=0,SGC=0
283 F I=1:1 S D1=$O(^XMB(3.9,D0,2,D1)) Q:D1="" Q:(D1>.99999) D
284 . S LST("HDR",I)=$G(^XMB(3.9,D0,2,D1,0))
285 .QUIT
286 N BNDRY,STKL,SEG
287 S STKL=0,SEG=0
288 ; Find boundaries and map them
289 S D1=0
290 F S D1=$O(^XMB(3.9,D0,2,D1)) Q:'D1 D
291 . ; Clear any control characters (cr/lf/ff) off
292 . S X=$TR($G(^XMB(3.9,D0,2,D1,0)),$C(10,12,13))
293 . ; Look for " boundary=" in the various parts. Map the establishment and the
294 . ; terminator markers and the actual boundary markers.
295 . I X[" boundary=" D Q
296 . . S SEP=$P(X," boundary=",2)
297 . . S:$E(SEP)="""" SEP=$TR(SEP,"""")
298 . . S STKL=STKL+1
299 . . S END=SEP_FLG
300 . . S BNDRY(STKL,SEP)=0
301 . . S BNDRX(SEP)=STKL,BNDRZ(END)=0
302 . .QUIT
303 . ;
304 . ; Look for information as to how amy boudaries are present and where
305 . ; they terminate
306 . D:X'=""&($E(X,1,2)="--")&($E(X,$L(X)-1,9999)'="--")
307 . . ; Boundary Found
308 . . I $D(BNDRX(X)) D Q
309 . . . S SEG=SEG+1
310 . . . S BNDRE(X)=$G(BNDRE(X))_D1_";"
311 . . . S BND1(D1)=STKL_";B;"_SEG_";"_X
312 . . . S BNDR(X,D1,"B")=STKL
313 . . . I BNDRX(X)=X D ERROR("ER13")
314 . . .QUIT
315 . . ;
316 . . ; Boundary Terminator
317 . . I $D(BNDRZ(X)) D Q
318 . . . S BNDR(X,D1,"E")=STKL
319 . . . S BNDRZ(X)=BNDRZ(X)+1
320 . . . S BND1(D1)=STKL_";E;"_SEG_";"_X
321 . . . S SEG=SEG+1
322 . . . I BNDRX(X)=X D ERROR("ER14")
323 . . . S STKL=STKL-1
324 . . .QUIT
325 . .QUIT
326 .QUIT
327 ; Start walking the TEXT/XML/64-BIT ENCODING sections of the message
328 N A,B,C,STACK,STYP,SEG,AX
329 S D1=.99999,SGC=0
330 F S D1=$O(^XMB(3.9,D0,2,D1)) Q:'D1 D
331 . ; Clear any control characters (cr/lf/ff) off
332 . S X=$TR($G(^XMB(3.9,D0,2,D1,0)),$C(10,12,13))
333 . ;
334 . D
335 . . I $D(BND1(D1)) D BOUNDARY(X) QUIT
336 . . ;
337 . . S DX=$O(BND1(D1))
338 . . I DX="" D ERROR("ER15") Q
339 . . ;
340 . . ; Good situation, extract the parts for the section
341 . . S A=$G(BND1(DX))
342 . . S STACK=+A,STYP=$P(A,";",2),SGC=$P(A,";",3),AX=$P(A,";",4,999)
343 . .QUIT
344 . ; Enter once to set the SEP to capture the separator
345 . ;
346 . ; A new SEGMENT separator is set, process original
347 . I $D(BND1(X)) D QUIT
348 . . ; Save Current Values
349 . . S LST("SEG",SGC,"SIZE")=BCN+$L(BF)
350 . . ; Close this Segment and prepare to start a New Segment
351 . . S $P(LST("SEG",SGC),"^",1,2)=$P($G(LST("SEG",SGC)),"^",1)_"^"_(D1-1)
352 . . ; Put the result in LST("SEG",SGC,"XML")
353 . . I $L(BF) D
354 . . . S ZN=1
355 . . . N I,T,TBF
356 . . . S TBF=BF
357 . . . F I=1:1:($L(TBF,"=")) D
358 . . . . S BF=$P(TBF,"=",I)_"="
359 . . . . I "="'[BF D DECODER(.BF,.TYP)
360 . . . .QUIT
361 . . . S BF=""
362 . . .QUIT
363 . . S SGC=SGC+1,BCN=0
364 . . ; Incriment SGC to start a new Segment
365 . . S LST("SEG",SGC)=D1
366 . .QUIT
367 . ;
368 . ; Accumulate the 64 bit encoding, no spaces, or other non-64bit characters
369 . I X=$TR(X,MSK)&$L(X) S BF=BF_X QUIT
370 . ;
371 . ; Ending Condition, close out the Segment
372 . I $D(BNDRZ(X)) D QUIT
373 . . S $P(LST("SEG",SGC),"^",2)=D1-1
374 . . I $L(BF) S ZN=1 D DECODER(.BF,.TYP) S BF="" Q
375 . .QUIT
376 . ;
377 . ; Accumulate the content lines of the message
378 . S BCN=BCN+$L(X)
379 . ; Split out the Content Info
380 . I X[CON D Q
381 . . S J=$P(X,CON,2)
382 . . S TYP="CONTENT"
383 . . S LST("SEG",SGC,TYP,$P(J,":"))=$P(J,":",2,9)
384 . . D CONTENT(D1)
385 . .QUIT
386 . ;
387 . ; Everything else is Text, Check for CCR/CCD.
388 . N KK,UBF
389 . D
390 . . S UBF=$$UPPER(X)
391 . . I UBF["<CONTINUITYOFCARERECORD" S $P(LST("SEG",SGC),U,3)="CCR" Q
392 . . ;
393 . . I UBF["<CLINICALDOCUMENT" S $P(LST("SEG",SGC),U,3)="CCD" Q
394 . .QUIT
395 . ; Look for directives in the text before it gets published
396 . ; Look for "=3D" and replace it with a single "=". I can do more parsing
397 . ; but there may be situations where the line has been wrapped.
398 . D:X["=3D"
399 . . F KK=1:1 S X=$P(X,"=3D",1)_"="_$P(X,"=3D",2,999) Q:X'["=3D"
400 . .QUIT
401 . S LST("SEG",SGC,TYP,D1)=X
402 .QUIT
403 QUIT
404 ; ===================
405CONTENT(D1) ; Try pulling Content Statements
406 N J,UP,X
407 S X=$G(^XMB(3.9,D0,2,D1,0))
408 S J=$P(X,CON,2)
409 S UP=$TR($$UPPER(X),"""")
410 S:$G(TYP)="" TYP="TXT"
411 D
412 . I UP["NAME=",($L(UP,".")>1) S TYP=$P(UP,".",2) Q
413 . I UP["XML" S TYP="XML" Q
414 . I UP["P7S" S TYP="P7S" Q
415 . I J[" boundary=" D BOUNDARY(J)
416 .QUIT
417 S LIS("CON",SGC,D1)=X
418 S LIS("CON",SGC,D1,"TYP")=TYP
419 ; If there is a follow-on, look for another line after this.
420 I $E($RE(X),1)=";" D CONTENT(D1+1)
421 QUIT
422 ; ===================
423BOUNDARY(X) ; Set an additional BOUNDARY, and activate another stack level
424 S SEP=$P($P(X," boundary=",2),"""",2),END=SEP_FLG
425 Q:SEP?2"-".ANP
426 ;
427 D ERROR("ER11")
428 Q:SEP'[" "
429 ;
430 D ERROR("ER12")
431 QUIT
432 ; ===================
433 ; Break down the Buffer Array so it can be saved.
434 ; BF is passed in.
435 ; TYP is the type of
436DECODER(BF,TYP) ;
437 N RCNT,TBF,UBF,ZBF,ZI,ZJ,ZK,ZSIZE
438 S:$G(TYP)="" TYP="XML"
439 S ZBF=BF
440 ; Full Buffer, BF, now check for Encryption and Unpack
441 F RCNT=1:1:$L(ZBF,"=") D
442 . N BF
443 . S BF=$P(ZBF,"=",RCNT)
444 . ; Unpacking the 64 bit encoding
445 . S TBF=$TR($$DECODE^RGUTUU(BF),$C(10,12,13))
446 . D:$L(TBF)
447 . . N C,OK,OKCNT,KK,XBF,UBF
448 . . D
449 . . . S UBF=$$UPPER(TBF)
450 . . . I UBF["<CONTINUITYOFCARERECORD XMLNS=" S $P(LST("SEG",SGC),U,3)="CCR" Q
451 . . . ;
452 . . . I UBF["<CLINICALDOCUMENT XMLNS=" S $P(LST("SEG",SGC),U,3)="CCD" Q
453 . . .QUIT
454 . . ; Check for Bad Signature Decoding, after 100 bad characters
455 . . S OK=1,OKCNT=0
456 . . F KK=1:1:$L(UBF) S C=$A(UBF,KK) S:C>126 OKCNT=OKCNT+1 I OKCNT>100 S OK=0 Q
457 . . ;
458 . . D
459 . . . I 'OK S (BF,UBF,TBF,XBF)="<Crypto-Signature redacted>" Q
460 . . . ;
461 . . . S BF=BF_"="
462 . . . D NORMAL(.XBF,.TBF)
463 . . .QUIT
464 . . M LST("SEG",SGC,TYP,RCNT)=XBF
465 . .QUIT
466 .QUIT
467 QUIT
468 ; ===================
469 ; OUTXML = OUTBF = OUT = OUTPUT ARRAY TO BE BUILT
470 ; BF = INXML = INPUT ARRAY TO PROVIDE INPUT
471 ; >D NORMAL^C0CMAIL(.OUT,BF)
472NORMAL(OUTXML,INXML) ;NORMALIZES AN XML STRING PASSED BY NAME IN INXML
473 ; INTO AN XML ARRAY RETURNED IN OUTXML, ALSO PASSED BY NAME
474 ;
475 N ZN,OUTBF,XX,ZSEP
476 S INXML=$TR(INXML,$C(10,12,13))
477 S ZN=1,ZSEP=">"
478 S OUTBF(1)=$P(INXML,"><",1)_ZSEP,XX="<"_$P(INXML,"><",2)_ZSEP,ZN=2,ZL=1
479 F ZN=ZN+1:1:$L(INXML,"><") D Q:XX=""
480 . S XX=$P(INXML,"><",ZN)
481 . S:$E($RE(XX))=">" ZSEP=""
482 . Q:XX=""
483 . ;
484 . S XX="<"_XX_ZSEP
485 . D
486 . . I $L(XX)<4000 S OUTBF(ZL)=XX,XX=$P(INXML,"><",ZN),ZL=ZL+1 Q
487 . . ;
488 . . D ERROR("ER05")
489 . . F ZL=ZL+1:1 D Q:XX=""
490 . . . N XL
491 . . . S XL=$E(XX,1,4000)
492 . . . S $E(XX,1,4000)="" ; S XX=$E(XX,4001,999999) ; Remove 4K characters
493 . . . S OUTBF(ZL)=XL
494 . . .QUIT
495 . .QUIT
496 .QUIT
497 M OUTXML=OUTBF
498 QUIT
499 ; ===================
500UPPER(X) ; Convert any lowercase letters to Uppercase letters
501 QUIT $TR(X,"abcdefghijklmnopqrstuvwxyz","ABCDEFGHIJKLMNOPQRSTUVWXYZ")
502 ; ===================
503 ; EN is a counter that remains between error events
504ERROR(ER) ; Error Handler
505 N TXXQ,XXXQ
506 S XXXQ="Unknown Error Encountered = "_ER
507 S TXXQ=$P($T(@(ER_"^"_$T(+0))),";;",2,99)
508 I TXXQ'="" D
509 . I TXXQ["_" X "S TXXQ="_TXXQ
510 . S XXXQ=TXXQ
511 .QUIT
512 S EN(ER)=$G(EN(ER))+1
513 S LST("ERR",ER,EN(ER))=XXXQ
514 QUIT
515 ; ===================
516ER01 ;;Message Missing
517ER02 ;;Message Text Missing
518ER03 ;;Message Not Identifiable
519ER04 ;;Segment is too large
520ER05 ;;Mailbox Missing
521ER06 ;;"User Missing = "_$G(DUZ)
522ER07 ;;"Bad DUZ = "_DUZ
523ER08 ;;"Bad Basket ID = "_MBLST_" >> "_$G(TN)
524ER10 ;;"Bad Separator found = "_X
525ER11 ;;"Non-Standard Separator Found:>"_$G(J)
526ER12 ;;"Spaces are not allowed in Separators:>"_$G(J)
527ER13 ;;"Bad Stack Level Detected >"_STKL_":"_BNDRY(X)_":"_X
528 ; vvvvvvvvvvvvvvv Not Needed vvvvvvvvvvvvvvvvvvvvvvvvvv
529 ; End note if needed
530 QUIT
531 ; ===================
Note: See TracBrowser for help on using the repository browser.