XMC1A ;(WASH ISC)/THM-Script Interpreter (Look) ;12/04/2002 15:04
;;8.0;MailMan;**11**;Jun 28, 2002
;LOOK For Text
;
; There can only be one 'B' in a LOOK command. It may be preceeded by
; at least one 'A' and succeeded by as many 'C's as desired.
; The 'B' parameter may be null. In this case two spaces would
; separate the 'A' parameters for the 'C' parameters.
;
;X=SCRIPT COMMAND 'L:Timeout A A A ... B C C C ...'
;
;The string represented by 'x' must always have a length >0.
;The string being looked for must always be surrounded by '|'s.
;To use the new form, the looked for strings must be surrounded by '|'s.
; If no '|'s are found, it is assumed to be of the old form
; (see example 4 below).
;There must not be any '|'s for the "OLD" form as the 1st character
; after the 1st space in the string.
;The 1st character after the 1st space in the string must be a '|'
; in the "NEW" form.
;Condition A is always checked first
;
;WHERE 'A' (mandatory) has form 'x' / QUIT on finding string 'x'
; or 'x:y' / GOTO line 'y' on finding 'x'
;
;WHERE 'C' (optional) has form 'x' / QUIT setting ER=1 on finding 'x'
;
;WHERE 'B' (optional) has form 'y' / GOTO 'y' on timeout
;
;********************************************************************
;
;Examples:
;
; 1. Look for "LINE" or "CONNECTED" on a timeout just error out
; (Where the command is on line 3)
;
; L |LINE|:3 |CONNECTED|:3
; or
; L |LINE| |CONNECTED|
;
; 2. Look for "LINE" and if found go to line 15 of this script
; Look for "CONNECTED" and if found go to line 18 of this script.
; Go to line 25 of this script on a time out.
; If "DISCON" is found error out.
;
; L |LINE|:15 |CONNECTED|:18 25 |DISCON|
;
; 3. Same case as 2 except that on a timeout just error out.
;
; L |LINE|:15 |CONNECTED|:18 |DISCON|
;
; (Note that '18' is followed by 2 spaces [Timeout is null])
;
; 4. Look for 'ON LINE', then look for the string 'CONNECTED'
;
; L |ON LINE|:6 |CONNECTED|
;
; This is a little tricky. The old syntax for looking for a
; string took $P(X," ",2,999) as the argument, where X is the
; entire script command. To be backwards compatible, there must
; be '|'s surrounding all of the strings being looked for.
;
;****************************************************************
;
; The old syntax still works:
;
; L ON LINE
;
; is interpreted in the old way as look for the phrase "ON LINE"
;
;*****************************************************************
;
; VARIABLES
;
;XMC1A(,,) === Array of checks XMC1A(1,,)=success checks
; XMC1A(2,1,1)=timout (also XMC1A(2))
; XMC1A(3,,)=failure checks
;failure is type 'C', success is type 'A', time-out is Type 'B' above
LOOK ;For Text (See documentation above)
; X = command line from file 4.6
; = 'L:180 220'
N XMC1A,XMK,XMTIME,C,I,J,Y,%
S XMC1A("TIMEOUT")=+$P($P(X," "),":",2)
I 'XMC1A("TIMEOUT") S XMC1A("TIMEOUT")=45
S XMTIME=$$TSTAMP^XMXUTIL1+XMC1A("TIMEOUT")
S XMK=1
S Y=1
;Recode encoded control characters
S XMC1A("LOOK")=XMC1
I XMC1["~" S XMC1=$$RTRAN^XMCU1(XMC1)
;Parse to separate time-outs/success/error conditions
;'OLD' form
I $E(XMC1)'="|",XMC1'?1.N1" |".E S XMC1A(1,1,1)=XMC1,XMC1A(1,1,2)="" G G
;'NEW' form
S I=0
E ;
S I=I+1
I Y=1,XMC1?1.N1" |".E D TIMOUT G F
I Y=1,XMC1?1" " S Y=2,XMC1=$E(XMC1,3,999) G F
S %=Y
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)
I Y=2 S:$E(XMC1)=" " XMC1=$E(XMC1,2,999) D TIMOUT G F
S:Y>% I=1
S X=$P(XMC1,"|",2)
S XMC1=$E(XMC1,$L($P(XMC1,"|",1,2))+1,999)
S %=""
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
I $E(XMC1)="|" S XMC1=$E(XMC1,2,99)
E1 ;
I $S($L(X):1,$L(%):1,1:0) S XMC1A(Y,I,1)=X,XMC1A(Y,I,2)=%
F ;
G E:$L(XMC1)
;Save Timeout for efficient access
I $D(XMC1A(2)) S XMC1A(2)=XMC1A(2,1,1)
G ;
D DOTRAN^XMC1(42240,XMC1A("TIMEOUT"),XMC1A("LOOK")) ;Look: Timeout=|1|, Command String='|2|'
U IO
X ^%ZOSF("TRMON")
S ER=0,Y=^%ZOSF("TRMRD"),XMC1A("TRMRD")="N Y "_Y_" S C=Y Q"
L1 ;
S Y=""
D L2
S XMK=XMK+1
I XMC("SHOW TRAN")["R" D DOTRAN^XMC1("R: "_Y)
G LQ:$D(XMC1A("OK"))
I ER=1 D ERTRAN^XMC1(37001) S J=$G(XMC1A(2)) G LQ:'J S ER=0 G GO ;Time out.
I XMK>199 D DOTRAN^XMC1(42241) S J=$G(XMC1A(2)) G GO:J S ER=1 Q ;200 Reads!
G L1
L2 ;
N C,X
L3 ;
X "R X#"_$S(XMC1A("LOOK")[220:3,220-$L(Y)>0:220-$L(Y),1:1)_$S($D(XMDECNET):"",1:":1")
S Y=Y_X
X XMC1A("TRMRD")
I C>0 S Y=Y_"~"_$S(C+64<255:$C(C+64),1:"~")
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
I $S($L(Y)>220:1,C=13:1,1:0) Q
I $$TSTAMP^XMXUTIL1<XMTIME H 1 G L3 ; H 1 added to slow loop
S ER=1
Q
LQ ;
K XMC1A
X ^%ZOSF("TRMOFF")
Q
GO ;
S XMCI=J-.00001
OK ;
S XMC1A("OK")=1
Q
TIMOUT ;
S Y=2,XMC1A(2,1,1)=+XMC1,XMC1=$P(XMC1," ",2,99)
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HXMC1A 5339 printed Oct 16, 2024@18:11:55 Page 2
XMC1A ;(WASH ISC)/THM-Script Interpreter (Look) ;12/04/2002 15:04
+1 ;;8.0;MailMan;**11**;Jun 28, 2002
+2 ;LOOK For Text
+3 ;
+4 ; There can only be one 'B' in a LOOK command. It may be preceeded by
+5 ; at least one 'A' and succeeded by as many 'C's as desired.
+6 ; The 'B' parameter may be null. In this case two spaces would
+7 ; separate the 'A' parameters for the 'C' parameters.
+8 ;
+9 ;X=SCRIPT COMMAND 'L:Timeout A A A ... B C C C ...'
+10 ;
+11 ;The string represented by 'x' must always have a length >0.
+12 ;The string being looked for must always be surrounded by '|'s.
+13 ;To use the new form, the looked for strings must be surrounded by '|'s.
+14 ; If no '|'s are found, it is assumed to be of the old form
+15 ; (see example 4 below).
+16 ;There must not be any '|'s for the "OLD" form as the 1st character
+17 ; after the 1st space in the string.
+18 ;The 1st character after the 1st space in the string must be a '|'
+19 ; in the "NEW" form.
+20 ;Condition A is always checked first
+21 ;
+22 ;WHERE 'A' (mandatory) has form 'x' / QUIT on finding string 'x'
+23 ; or 'x:y' / GOTO line 'y' on finding 'x'
+24 ;
+25 ;WHERE 'C' (optional) has form 'x' / QUIT setting ER=1 on finding 'x'
+26 ;
+27 ;WHERE 'B' (optional) has form 'y' / GOTO 'y' on timeout
+28 ;
+29 ;********************************************************************
+30 ;
+31 ;Examples:
+32 ;
+33 ; 1. Look for "LINE" or "CONNECTED" on a timeout just error out
+34 ; (Where the command is on line 3)
+35 ;
+36 ; L |LINE|:3 |CONNECTED|:3
+37 ; or
+38 ; L |LINE| |CONNECTED|
+39 ;
+40 ; 2. Look for "LINE" and if found go to line 15 of this script
+41 ; Look for "CONNECTED" and if found go to line 18 of this script.
+42 ; Go to line 25 of this script on a time out.
+43 ; If "DISCON" is found error out.
+44 ;
+45 ; L |LINE|:15 |CONNECTED|:18 25 |DISCON|
+46 ;
+47 ; 3. Same case as 2 except that on a timeout just error out.
+48 ;
+49 ; L |LINE|:15 |CONNECTED|:18 |DISCON|
+50 ;
+51 ; (Note that '18' is followed by 2 spaces [Timeout is null])
+52 ;
+53 ; 4. Look for 'ON LINE', then look for the string 'CONNECTED'
+54 ;
+55 ; L |ON LINE|:6 |CONNECTED|
+56 ;
+57 ; This is a little tricky. The old syntax for looking for a
+58 ; string took $P(X," ",2,999) as the argument, where X is the
+59 ; entire script command. To be backwards compatible, there must
+60 ; be '|'s surrounding all of the strings being looked for.
+61 ;
+62 ;****************************************************************
+63 ;
+64 ; The old syntax still works:
+65 ;
+66 ; L ON LINE
+67 ;
+68 ; is interpreted in the old way as look for the phrase "ON LINE"
+69 ;
+70 ;*****************************************************************
+71 ;
+72 ; VARIABLES
+73 ;
+74 ;XMC1A(,,) === Array of checks XMC1A(1,,)=success checks
+75 ; XMC1A(2,1,1)=timout (also XMC1A(2))
+76 ; XMC1A(3,,)=failure checks
+77 ;failure is type 'C', success is type 'A', time-out is Type 'B' above
LOOK ;For Text (See documentation above)
+1 ; X = command line from file 4.6
+2 ; = 'L:180 220'
+3 NEW XMC1A,XMK,XMTIME,C,I,J,Y,%
+4 SET XMC1A("TIMEOUT")=+$PIECE($PIECE(X," "),":",2)
+5 IF 'XMC1A("TIMEOUT")
SET XMC1A("TIMEOUT")=45
+6 SET XMTIME=$$TSTAMP^XMXUTIL1+XMC1A("TIMEOUT")
+7 SET XMK=1
+8 SET Y=1
+9 ;Recode encoded control characters
+10 SET XMC1A("LOOK")=XMC1
+11 IF XMC1["~"
SET XMC1=$$RTRAN^XMCU1(XMC1)
+12 ;Parse to separate time-outs/success/error conditions
+13 ;'OLD' form
+14 IF $EXTRACT(XMC1)'="|"
IF XMC1'?1.N1" |".E
SET XMC1A(1,1,1)=XMC1
SET XMC1A(1,1,2)=""
GOTO G
+15 ;'NEW' form
+16 SET I=0
E ;
+1 SET I=I+1
+2 IF Y=1
IF XMC1?1.N1" |".E
DO TIMOUT
GOTO F
+3 IF Y=1
IF XMC1?1" "
SET Y=2
SET XMC1=$EXTRACT(XMC1,3,999)
GOTO F
+4 SET %=Y
+5 SET Y=$SELECT(Y=3:Y,Y=2:3,XMC1?1.N1" |".E:2,$EXTRACT(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)
+6 IF Y=2
if $EXTRACT(XMC1)=" "
SET XMC1=$EXTRACT(XMC1,2,999)
DO TIMOUT
GOTO F
+7 if Y>%
SET I=1
+8 SET X=$PIECE(XMC1,"|",2)
+9 SET XMC1=$EXTRACT(XMC1,$LENGTH($PIECE(XMC1,"|",1,2))+1,999)
+10 SET %=""
+11 IF $EXTRACT(XMC1,1,2)="|:"
SET %=$PIECE($PIECE(XMC1," "),":",2)
SET XMC1=$PIECE(XMC1,"|:",2,99)
IF %
IF $EXTRACT(XMC1,1,2)'=" "
SET XMC1=$PIECE(XMC1," ",2,99)
GOTO E1
+12 IF $EXTRACT(XMC1)="|"
SET XMC1=$EXTRACT(XMC1,2,99)
E1 ;
+1 IF $SELECT($LENGTH(X):1,$LENGTH(%):1,1:0)
SET XMC1A(Y,I,1)=X
SET XMC1A(Y,I,2)=%
F ;
+1 if $LENGTH(XMC1)
GOTO E
+2 ;Save Timeout for efficient access
+3 IF $DATA(XMC1A(2))
SET XMC1A(2)=XMC1A(2,1,1)
G ;
+1 ;Look: Timeout=|1|, Command String='|2|'
DO DOTRAN^XMC1(42240,XMC1A("TIMEOUT"),XMC1A("LOOK"))
+2 USE IO
+3 XECUTE ^%ZOSF("TRMON")
+4 SET ER=0
SET Y=^%ZOSF("TRMRD")
SET XMC1A("TRMRD")="N Y "_Y_" S C=Y Q"
L1 ;
+1 SET Y=""
+2 DO L2
+3 SET XMK=XMK+1
+4 IF XMC("SHOW TRAN")["R"
DO DOTRAN^XMC1("R: "_Y)
+5 if $DATA(XMC1A("OK"))
GOTO LQ
+6 ;Time out.
IF ER=1
DO ERTRAN^XMC1(37001)
SET J=$GET(XMC1A(2))
if 'J
GOTO LQ
SET ER=0
GOTO GO
+7 ;200 Reads!
IF XMK>199
DO DOTRAN^XMC1(42241)
SET J=$GET(XMC1A(2))
if J
GOTO GO
SET ER=1
QUIT
+8 GOTO L1
L2 ;
+1 NEW C,X
L3 ;
+1 XECUTE "R X#"_$SELECT(XMC1A("LOOK")[220:3,220-$LENGTH(Y)>0:220-$LENGTH(Y),1:1)_$SELECT($DATA(XMDECNET):"",1:":1")
+2 SET Y=Y_X
+3 XECUTE XMC1A("TRMRD")
+4 IF C>0
SET Y=Y_"~"_$SELECT(C+64<255:$CHAR(C+64),1:"~")
+5 FOR I=1,3
FOR %=0:0
SET %=$ORDER(XMC1A(I,%))
if '%
QUIT
IF Y[XMC1A(I,%,1)
SET J=XMC1A(I,%,2)
if J'=""
GOTO GO
if I=1
GOTO OK
SET ER=1
QUIT
+6 IF $SELECT($LENGTH(Y)>220:1,C=13:1,1:0)
QUIT
+7 ; H 1 added to slow loop
IF $$TSTAMP^XMXUTIL1<XMTIME
HANG 1
GOTO L3
+8 SET ER=1
+9 QUIT
LQ ;
+1 KILL XMC1A
+2 XECUTE ^%ZOSF("TRMOFF")
+3 QUIT
GO ;
+1 SET XMCI=J-.00001
OK ;
+1 SET XMC1A("OK")=1
+2 QUIT
TIMOUT ;
+1 SET Y=2
SET XMC1A(2,1,1)=+XMC1
SET XMC1=$PIECE(XMC1," ",2,99)
+2 QUIT
