- 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 Feb 18, 2025@23:37:22 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
