source: FOIAVistA/tag/r/MAILMAN-XM/XMC1A.m@ 1326

Last change on this file since 1326 was 628, checked in by George Lilly, 15 years ago

initial load of FOIAVistA 6/30/08 version

File size: 5.1 KB
Line 
1XMC1A ;(WASH ISC)/THM-Script Interpreter (Look) ;12/04/2002 15:04
2 ;;8.0;MailMan;**11**;Jun 28, 2002
3 ;LOOK For Text
4 ;
5 ; There can only be one 'B' in a LOOK command. It may be preceeded by
6 ; at least one 'A' and succeeded by as many 'C's as desired.
7 ; The 'B' parameter may be null. In this case two spaces would
8 ; separate the 'A' parameters for the 'C' parameters.
9 ;
10 ;X=SCRIPT COMMAND 'L:Timeout A A A ... B C C C ...'
11 ;
12 ;The string represented by 'x' must always have a length >0.
13 ;The string being looked for must always be surrounded by '|'s.
14 ;To use the new form, the looked for strings must be surrounded by '|'s.
15 ; If no '|'s are found, it is assumed to be of the old form
16 ; (see example 4 below).
17 ;There must not be any '|'s for the "OLD" form as the 1st character
18 ; after the 1st space in the string.
19 ;The 1st character after the 1st space in the string must be a '|'
20 ; in the "NEW" form.
21 ;Condition A is always checked first
22 ;
23 ;WHERE 'A' (mandatory) has form 'x' / QUIT on finding string 'x'
24 ; or 'x:y' / GOTO line 'y' on finding 'x'
25 ;
26 ;WHERE 'C' (optional) has form 'x' / QUIT setting ER=1 on finding 'x'
27 ;
28 ;WHERE 'B' (optional) has form 'y' / GOTO 'y' on timeout
29 ;
30 ;********************************************************************
31 ;
32 ;Examples:
33 ;
34 ; 1. Look for "LINE" or "CONNECTED" on a timeout just error out
35 ; (Where the command is on line 3)
36 ;
37 ; L |LINE|:3 |CONNECTED|:3
38 ; or
39 ; L |LINE| |CONNECTED|
40 ;
41 ; 2. Look for "LINE" and if found go to line 15 of this script
42 ; Look for "CONNECTED" and if found go to line 18 of this script.
43 ; Go to line 25 of this script on a time out.
44 ; If "DISCON" is found error out.
45 ;
46 ; L |LINE|:15 |CONNECTED|:18 25 |DISCON|
47 ;
48 ; 3. Same case as 2 except that on a timeout just error out.
49 ;
50 ; L |LINE|:15 |CONNECTED|:18 |DISCON|
51 ;
52 ; (Note that '18' is followed by 2 spaces [Timeout is null])
53 ;
54 ; 4. Look for 'ON LINE', then look for the string 'CONNECTED'
55 ;
56 ; L |ON LINE|:6 |CONNECTED|
57 ;
58 ; This is a little tricky. The old syntax for looking for a
59 ; string took $P(X," ",2,999) as the argument, where X is the
60 ; entire script command. To be backwards compatible, there must
61 ; be '|'s surrounding all of the strings being looked for.
62 ;
63 ;****************************************************************
64 ;
65 ; The old syntax still works:
66 ;
67 ; L ON LINE
68 ;
69 ; is interpreted in the old way as look for the phrase "ON LINE"
70 ;
71 ;*****************************************************************
72 ;
73 ; VARIABLES
74 ;
75 ;XMC1A(,,) === Array of checks XMC1A(1,,)=success checks
76 ; XMC1A(2,1,1)=timout (also XMC1A(2))
77 ; XMC1A(3,,)=failure checks
78 ;failure is type 'C', success is type 'A', time-out is Type 'B' above
79LOOK ;For Text (See documentation above)
80 ; X = command line from file 4.6
81 ; = 'L:180 220'
82 N XMC1A,XMK,XMTIME,C,I,J,Y,%
83 S XMC1A("TIMEOUT")=+$P($P(X," "),":",2)
84 I 'XMC1A("TIMEOUT") S XMC1A("TIMEOUT")=45
85 S XMTIME=$$TSTAMP^XMXUTIL1+XMC1A("TIMEOUT")
86 S XMK=1
87 S Y=1
88 ;Recode encoded control characters
89 S XMC1A("LOOK")=XMC1
90 I XMC1["~" S XMC1=$$RTRAN^XMCU1(XMC1)
91 ;Parse to separate time-outs/success/error conditions
92 ;'OLD' form
93 I $E(XMC1)'="|",XMC1'?1.N1" |".E S XMC1A(1,1,1)=XMC1,XMC1A(1,1,2)="" G G
94 ;'NEW' form
95 S I=0
96E ;
97 S I=I+1
98 I Y=1,XMC1?1.N1" |".E D TIMOUT G F
99 I Y=1,XMC1?1" " S Y=2,XMC1=$E(XMC1,3,999) G F
100 S %=Y
101 S Y=$S(Y=3:Y,Y=2:3,XMC1?1.N1" |".E:2,$E(XMC1,1,2)=" ":3,XMC1?1" "1.N1" ":2,XMC1?1" "1.N:2,Y=1&(I>1)&(XMC1?1.N):2,XMC1?1" |".E:3,1:Y)
102 I Y=2 S:$E(XMC1)=" " XMC1=$E(XMC1,2,999) D TIMOUT G F
103 S:Y>% I=1
104 S X=$P(XMC1,"|",2)
105 S XMC1=$E(XMC1,$L($P(XMC1,"|",1,2))+1,999)
106 S %=""
107 I $E(XMC1,1,2)="|:" S %=$P($P(XMC1," "),":",2),XMC1=$P(XMC1,"|:",2,99) I %,$E(XMC1,1,2)'=" " S XMC1=$P(XMC1," ",2,99) G E1
108 I $E(XMC1)="|" S XMC1=$E(XMC1,2,99)
109E1 ;
110 I $S($L(X):1,$L(%):1,1:0) S XMC1A(Y,I,1)=X,XMC1A(Y,I,2)=%
111F ;
112 G E:$L(XMC1)
113 ;Save Timeout for efficient access
114 I $D(XMC1A(2)) S XMC1A(2)=XMC1A(2,1,1)
115G ;
116 D DOTRAN^XMC1(42240,XMC1A("TIMEOUT"),XMC1A("LOOK")) ;Look: Timeout=|1|, Command String='|2|'
117 U IO
118 X ^%ZOSF("TRMON")
119 S ER=0,Y=^%ZOSF("TRMRD"),XMC1A("TRMRD")="N Y "_Y_" S C=Y Q"
120L1 ;
121 S Y=""
122 D L2
123 S XMK=XMK+1
124 I XMC("SHOW TRAN")["R" D DOTRAN^XMC1("R: "_Y)
125 G LQ:$D(XMC1A("OK"))
126 I ER=1 D ERTRAN^XMC1(37001) S J=$G(XMC1A(2)) G LQ:'J S ER=0 G GO ;Time out.
127 I XMK>199 D DOTRAN^XMC1(42241) S J=$G(XMC1A(2)) G GO:J S ER=1 Q ;200 Reads!
128 G L1
129L2 ;
130 N C,X
131L3 ;
132 X "R X#"_$S(XMC1A("LOOK")[220:3,220-$L(Y)>0:220-$L(Y),1:1)_$S($D(XMDECNET):"",1:":1")
133 S Y=Y_X
134 X XMC1A("TRMRD")
135 I C>0 S Y=Y_"~"_$S(C+64<255:$C(C+64),1:"~")
136 F I=1,3 F %=0:0 S %=$O(XMC1A(I,%)) Q:'% I Y[XMC1A(I,%,1) S J=XMC1A(I,%,2) G GO:J'="",OK:I=1 S ER=1 Q
137 I $S($L(Y)>220:1,C=13:1,1:0) Q
138 I $$TSTAMP^XMXUTIL1<XMTIME H 1 G L3 ; H 1 added to slow loop
139 S ER=1
140 Q
141LQ ;
142 K XMC1A
143 X ^%ZOSF("TRMOFF")
144 Q
145GO ;
146 S XMCI=J-.00001
147OK ;
148 S XMC1A("OK")=1
149 Q
150TIMOUT ;
151 S Y=2,XMC1A(2,1,1)=+XMC1,XMC1=$P(XMC1," ",2,99)
152 Q
Note: See TracBrowser for help on using the repository browser.