AZHLSC24 ; IHS/ADC/GTH:KEU:JN - SAC CHAPTER 2: M LANGUAGE PROGRAMMING STANDARDS & CONVENTIONS ; [ 04/09/1999 7:40 AM ] [6/28/00 11:56am]
;;5.0;AZHLSC;;JUL 10, 1996
;CHANGED DIF="Z(" TO GLOBAL AND OTHER REFERENCES TO THE
;ARRAY TO THE GLOBAL REFERENCE TO ACCOMMODATE LARGE RTNS SIZES
;IHS/ABQ/KEU 4/7/95
;W !!!,$P($P($T(+1),";",2),"-",2)
NEW A,A3,A4,A5,ARG,B,CH,COM,DIF,G,I,J,LIN,NORTNS,NUL,R,Q,XCNP,Z
D END
S Q="""",A4="=""O ",A5="=""C ",NORTNS=$O(^UTILITY($J,""))=""
S AZHL=""
F S AZHL=$O(^UTILITY($J,AZHL)) Q:AZHL="" W:AZHLTERM "." K Z S (X,AZHL0)=AZHL,DIF="^TMP($J,""Z"",",XCNP=0 X "X ^%ZOSF(""LOAD""),AZHLGFCX" I S XCNP=XCNP-1 D
.F Z=3:1:XCNP S Z(Z)=^TMP($J,"Z",Z,0) D
..I Z(Z)["^%ZOSF(""BRK"")" D NBRK^AZHLSC48
..I Z(Z)[" B " S AZHLSC49=" B " D EN^AZHLSC46 Q:AZHLSC4I=1 D EN^AZHLSC47 Q:AZHLSC4I=1 D EN1^AZHLSC49 Q:AZHLSC4I=1 S ^TMP($J,"2421",AZHL,Z)=Z(Z)
..I $E(Z(Z),1,2)=" B" S AZHLSC49=" B" D EN^AZHLSC46 Q:AZHLSC4I=1 D EN^AZHLSC47 Q:AZHLSC4I=1 D EN1^AZHLSC49 Q:AZHLSC4I=1 S ^TMP($J,"2421",AZHL,Z)=Z(Z)
..I (Z(Z)[" C ") D EN^AZHLSC46 Q:AZHLSC4I=1 D EN^AZHLSC47 Q:AZHLSC4I=1 S AZHLSC49=" C " D FINDC Q:AZHLSC4I=1 D EN1^AZHLSC49 Q:AZHLSC4I=1 S ^TMP($J,"2431",AZHL,Z)=Z(Z)
..I (Z(Z)[" H ") S AZHLSC49=" H " D EN^AZHLSC46 Q:AZHLSC4I=1 D EN^AZHLSC47 Q:AZHLSC4I=1 D EN1^AZHLSC49 Q:AZHLSC4I=1 S ^TMP($J,"2441",AZHL,Z)=Z(Z)
..I (Z(Z)[" J ") S AZHLSC49=" J " D EN^AZHLSC46 Q:AZHLSC4I=1 D EN^AZHLSC47 Q:AZHLSC4I=1 D EN1^AZHLSC49 Q:AZHLSC4I=1 S ^TMP($J,"2451",AZHL,Z)=Z(Z)
..I (Z(Z)[" K ") S AZHLSC49=" K " D EN^AZHLSC46 Q:AZHLSC4I=1 D EN^AZHLSC47 Q:AZHLSC4I=1 D EN1^AZHLSC49 Q:AZHLSC4I=1 S ^TMP($J,"2461",AZHL,Z)=Z(Z)
..I (Z(Z)[" K (") S AZHLSC49=" K (" D EN^AZHLSC46 Q:AZHLSC4I=1 D EN^AZHLSC47 Q:AZHLSC4I=1 D EN1^AZHLSC49 Q:AZHLSC4I=1 S ^TMP($J,"2462",AZHL,Z)=Z(Z)
..I (Z(Z)[" L ") D EN^AZHLSC46 Q:AZHLSC4I=1 D EN^AZHLSC47 Q:AZHLSC4I=1 S AZHLSC49=" L " D EN1^AZHLSC49 Q:AZHLSC4I=1 S ^TMP($J,"2471",AZHL,Z)=Z(Z)
..F J(1)=" L "," L:",".L ",".L:" I Z(Z)[J(1) D EN^AZHLSC47 Q:AZHLSC4I=1 D EN^AZHLSC46 Q:AZHLSC4I=1 S LIN=$E(Z(Z),$F(Z(Z),J(1))-2,999),COM=$E(LIN) D SEP^%INDEX I $P(LIN," ")["+" D EN^AZHLSC48 Q:AZHLSC4I=1 S ^TMP($J,"2472",AZHL,Z)=Z(Z)
..I (Z(Z)[" N ") S AZHLSC49=" N " D EN^AZHLSC46 Q:AZHLSC4I=1 D EN^AZHLSC47 Q:AZHLSC4I=1 D EN1^AZHLSC49 Q:AZHLSC4I=1 S ^TMP($J,"2481",AZHL,Z)=Z(Z)
..I (Z(Z)[" O ") D EN^AZHLSC46 Q:AZHLSC4I=1 D EN^AZHLSC47 Q:AZHLSC4I=1 S AZHLSC49=" O " D FINDC Q:AZHLSC4I=1 D EN1^AZHLSC49 Q:AZHLSC4I=1 S ^TMP($J,"2491",AZHL,Z)=Z(Z)
..F J(1)=" U "," U:" I Z(Z)[J(1) S AZHLSC49=J(1) D FINDU Q:AZHLSC4I=1 D EN^AZHLSC47 Q:AZHLSC4I=1 D EN^AZHLSC46 Q:AZHLSC4I=1 D EN1^AZHLSC49 Q:AZHLSC4I=1 S ^TMP($J,"24111",AZHL,Z)=Z(Z)
..F J(1)=" R "," R:",".R " I Z(Z)[J(1) S AZHLSC49=J(1) D EN^AZHLSC47 Q:AZHLSC4I=1 D EN^AZHLSC46 Q:AZHLSC4I=1 S AZHLSC49=J(1) D EN1^AZHLSC49 Q:AZHLSC4I=1 D FINDCO I AZHLSC4I'=1 S ^TMP($J,"24102",AZHL,Z)=Z(Z)
..F J(1)=" V "," V:" I Z(Z)[J(1) S AZHLSC49=J(1) D EN^AZHLSC47 Q:AZHLSC4I=1 D EN^AZHLSC46 Q:AZHLSC4I=1 D EN1^AZHLSC49 Q:AZHLSC4I=1 D FINDC Q:AZHLSC4I=1 S ^TMP($J,"24121",AZHL,Z)=Z(Z)
..Q
.Q
621 D TTL^AZHLSC("2.4.2.1, Break Control")
I NORTNS D NRTN^AZHLSC G 2431
I $L($O(^TMP($J,"2421",""))) W !?10,"Check that ^%ZOSF(""BRK"") has corresponding ^%ZOSF(""NBRK"")." S %="" F S %=$O(^TMP($J,"2421",%)) Q:%="" S A=0 F S A=$O(^TMP($J,"2421",%,A)) Q:'A W !?10,"+",A,"^",%," : ",^(A)
2431 D TTL^AZHLSC("2.4.3.1 CLOSE, direct use prohibited")
I NORTNS D NRTN^AZHLSC G 2441
I $L($O(^TMP($J,"2431",""))) S %="" F S %=$O(^TMP($J,"2431",%)) Q:%="" S A=0 F S A=$O(^TMP($J,"2431",%,A)) Q:'A W !?10,"+",A,"^",%," : ",^(A)
2441 D TTL^AZHLSC("2.4.4.1 HALT, direct use prohibited")
I NORTNS D NRTN^AZHLSC G 2451
I $L($O(^TMP($J,"2441",""))) S %="" F S %=$O(^TMP($J,"2441",%)) Q:%="" S A=0 F S A=$O(^TMP($J,"2441",%,A)) Q:'A W !?10,"+",A,"^",%," : ",^(A)
2451 D TTL^AZHLSC("2.4.5.1 JOB, direct use prohibited")
I NORTNS D NRTN^AZHLSC G 2461
I $L($O(^TMP($J,"2451",""))) S %="" F S %=$O(^TMP($J,"2451",%)) Q:%="" S A=0 F S A=$O(^TMP($J,"2451",%,A)) Q:'A W !?10,"+",A,"^",%," : ",^(A)
2461 D TTL^AZHLSC("2.4.6.1 KILL,argumentless use prohibited")
I NORTNS D NRTN^AZHLSC G 2462
I $L($O(^TMP($J,"2461",""))) S %="" F S %=$O(^TMP($J,"2461",%)) Q:%="" S A=0 F S A=$O(^TMP($J,"2461",%,A)) Q:'A W !?10,"+",A,"^",%," : ",^(A)
2462 D TTL^AZHLSC("2.4.6.2 KILL,exclusive use prohibited")
I NORTNS D NRTN^AZHLSC G 2471
I $L($O(^TMP($J,"2462",""))) S %="" F S %=$O(^TMP($J,"2462",%)) Q:%="" S A=0 F S A=$O(^TMP($J,"2462",%,A)) Q:'A W !?10,"+",A,"^",%," : ",^(A)
2471 D TTL^AZHLSC("2.4.7.1 LOCK, should be incremental/decremental")
I NORTNS D NRTN^AZHLSC G 2472
I $L($O(^TMP($J,"2471",""))) S %="" F S %=$O(^TMP($J,"2471",%)) Q:%="" S A=0 F S A=$O(^TMP($J,"2471",%,A)) Q:'A W !?10,"+",A,"^",%," : ",^(A)
2472 D TTL^AZHLSC("2.4.7.2, Timeouts on Locks.")
I NORTNS D NRTN^AZHLSC G 2481
I $L($O(^TMP($J,"2472",""))) W !?10,"SUSPECT LOCK w/o timeout, or not +/-." S %="" F S %=$O(^TMP($J,"2472",%)) Q:%="" S A=0 F S A=$O(^TMP($J,"2472",%,A)) Q:'A W !?10,"+",A,"^",%," : ",^(A)
2481 D TTL^AZHLSC("2.4.8.1 NEW, argumentless prohibited")
I NORTNS D NRTN^AZHLSC G 2491
I $L($O(^TMP($J,"2481",""))) S %="" F S %=$O(^TMP($J,"2481",%)) Q:%="" S A=0 F S A=$O(^TMP($J,"2481",%,A)) Q:'A W !?10,"+",A,"^",%," : ",^(A)
2491 D TTL^AZHLSC("2.4.9.1 OPEN, is prohibited")
I NORTNS D NRTN^AZHLSC G 24102
I $L($O(^TMP($J,"2491",""))) S %="" F S %=$O(^TMP($J,"2491",%)) Q:%="" S A=0 F S A=$O(^TMP($J,"2491",%,A)) Q:'A W !?10,"+",A,"^",%," : ",^(A)
24102 D TTL^AZHLSC("2.4.10.2 TIMEOUT greater than 300 is prohibited")
I NORTNS D NRTN^AZHLSC G 24111
I $L($O(^TMP($J,"24102",""))) S %="" F S %=$O(^TMP($J,"24102",%)) Q:%="" S A=0 F S A=$O(^TMP($J,"24102",%,A)) Q:'A W !?10,"+",A,"^",%," : ",^(A)
24111 D TTL^AZHLSC("2.4.11.1 USE, with parameters is prohibited")
I NORTNS D NRTN^AZHLSC G 2412
I $L($O(^TMP($J,"24111",""))) S %="" F S %=$O(^TMP($J,"24111",%)) Q:%="" S A=0 F S A=$O(^TMP($J,"24111",%,A)) Q:'A W !?10,"+",A,"^",%," : ",^(A)
2412 D TTL^AZHLSC("2.4.12.1 VIEW, is prohibited")
I NORTNS D NRTN^AZHLSC Q
I $L($O(^TMP($J,"24121",""))) S %="" F S %=$O(^TMP($J,"24121",%)) Q:%="" S A=0 F S A=$O(^TMP($J,"24121",%,A)) Q:'A W !?10,"+",A,"^",%," : ",^(A)
Q
END K ^TMP($J,"2421"),^("2431"),^("2441"),^("2461"),^("2462"),^("2471"),^("2472"),^("2481"),^("2491"),^("24111"),^("24121"),^("Z"),Z Q
FINDC ; SEARCH FOR CLOSE COMMAND PASS AZHLSC49=" C " SECOND PIECE
S AZHLSCLN=$L(Z(Z)),AZHLSCLP=""
S AZHLSC4I=1 F I=2:2 Q:$P($G(Z(Z))," ",I)="" S AZHLSCF=$P($G(Z(Z))," ",I) D LENGTH I $E($G(AZHLSCF),1,1)=$P(AZHLSC49," ",2) S AZHLSC4I=0 Q Q:AZHLSCLN=AZHLSCLP Q:AZHLSCLN<AZHLSCLP Q
LENGTH ; SET LENGTH
S AZHLSCLP=AZHLSCLP+$P($L(Z(Z))," ",I),AZHLSCLP=AZHLSCLP+I Q
FINDU ;FIND ( U OR U:)OR ( V OR V:) COMMAND SEARCH FOR PARAMENTERS
S AZHLSC4I=0,AZHLSCF=""
S AZHLSCF=$F(Z(Z),AZHLSC49) I AZHLSCF=0 S AZHLSC4I=1 Q
S AZHLSCG=$E(Z(Z),AZHLSCF,245) G:AZHLSC49=" U:" FINDUP I $P(AZHLSCG," ",1)[":" S AZHLSC4I=0 Q
FINDEND S AZHLSC4I=1 Q
FINDUP I $P(AZHLSCG," ",2)[":" S AZHLSC4I=0 Q
G FINDEND
FINDCO ;FIND R R: .R SEARCH FOR COLON IN READ
S AZHLSC4I=0,AZHLSCF=""
S AZHLSCF=$F(Z(Z),AZHLSC49) I AZHLSCF=0 S AZHLSC4I=1 Q
S AZHLSCG=$F(Z(Z),""",",AZHLSCF) I AZHLSCG=0 S AZHLSC4I=1 Q
S AZHLSCF=$F(Z(Z),":",AZHLSCG) I AZHLSCF=0 S AZHLSC4I=1 Q
S AZHLSCG=$E(Z(Z),AZHLSCF,245) I AZHLSCG="DTIME" G FINDCEND
I AZHLSCG>300 S AZHLSC4I=0 Q
FINDCEND S AZHLSC4I=1 Q
AZHLSC24 ; IHS/ADC/GTH:KEU:JN - SAC CHAPTER 2: M LANGUAGE PROGRAMMING STANDARDS & CONVENTIONS ; [ 04/09/1999 7:40 AM ] [6/28/00 11:56am]
+1 ;;5.0;AZHLSC;;JUL 10, 1996
+2 ;CHANGED DIF="Z(" TO GLOBAL AND OTHER REFERENCES TO THE
+3 ;ARRAY TO THE GLOBAL REFERENCE TO ACCOMMODATE LARGE RTNS SIZES
+4 ;IHS/ABQ/KEU 4/7/95
+5 ;W !!!,$P($P($T(+1),";",2),"-",2)
+6 NEW A,A3,A4,A5,ARG,B,CH,COM,DIF,G,I,J,LIN,NORTNS,NUL,R,Q,XCNP,Z
+7 DO END
+8 SET Q=""""
SET A4="=""O "
SET A5="=""C "
SET NORTNS=$ORDER(^UTILITY($JOB,""))=""
+9 SET AZHL=""
+10 FOR
SET AZHL=$ORDER(^UTILITY($JOB,AZHL))
IF AZHL=""
QUIT
IF AZHLTERM
WRITE "."
KILL Z
SET (X,AZHL0)=AZHL
SET DIF="^TMP($J,""Z"","
SET XCNP=0
XECUTE "X ^%ZOSF(""LOAD""),AZHLGFCX"
IF $TEST
SET XCNP=XCNP-1
Begin DoDot:1
+11 FOR Z=3:1:XCNP
SET Z(Z)=^TMP($JOB,"Z",Z,0)
Begin DoDot:2
+12 IF Z(Z)["^%ZOSF(""BRK"")"
DO NBRK^AZHLSC48
+13 IF Z(Z)[" B "
SET AZHLSC49=" B "
DO EN^AZHLSC46
IF AZHLSC4I=1
QUIT
DO EN^AZHLSC47
IF AZHLSC4I=1
QUIT
DO EN1^AZHLSC49
IF AZHLSC4I=1
QUIT
SET ^TMP($JOB,"2421",AZHL,Z)=Z(Z)
+14 IF $EXTRACT(Z(Z),1,2)=" B"
SET AZHLSC49=" B"
DO EN^AZHLSC46
IF AZHLSC4I=1
QUIT
DO EN^AZHLSC47
IF AZHLSC4I=1
QUIT
DO EN1^AZHLSC49
IF AZHLSC4I=1
QUIT
SET ^TMP($JOB,"2421",AZHL,Z)=Z(Z)
+15 IF (Z(Z)[" C ")
DO EN^AZHLSC46
IF AZHLSC4I=1
QUIT
DO EN^AZHLSC47
IF AZHLSC4I=1
QUIT
SET AZHLSC49=" C "
DO FINDC
IF AZHLSC4I=1
QUIT
DO EN1^AZHLSC49
IF AZHLSC4I=1
QUIT
SET ^TMP($JOB,"2431",AZHL,Z)=Z(Z)
+16 IF (Z(Z)[" H ")
SET AZHLSC49=" H "
DO EN^AZHLSC46
IF AZHLSC4I=1
QUIT
DO EN^AZHLSC47
IF AZHLSC4I=1
QUIT
DO EN1^AZHLSC49
IF AZHLSC4I=1
QUIT
SET ^TMP($JOB,"2441",AZHL,Z)=Z(Z)
+17 IF (Z(Z)[" J ")
SET AZHLSC49=" J "
DO EN^AZHLSC46
IF AZHLSC4I=1
QUIT
DO EN^AZHLSC47
IF AZHLSC4I=1
QUIT
DO EN1^AZHLSC49
IF AZHLSC4I=1
QUIT
SET ^TMP($JOB,"2451",AZHL,Z)=Z(Z)
+18 IF (Z(Z)[" K ")
SET AZHLSC49=" K "
DO EN^AZHLSC46
IF AZHLSC4I=1
QUIT
DO EN^AZHLSC47
IF AZHLSC4I=1
QUIT
DO EN1^AZHLSC49
IF AZHLSC4I=1
QUIT
SET ^TMP($JOB,"2461",AZHL,Z)=Z(Z)
+19 IF (Z(Z)[" K (")
SET AZHLSC49=" K ("
DO EN^AZHLSC46
IF AZHLSC4I=1
QUIT
DO EN^AZHLSC47
IF AZHLSC4I=1
QUIT
DO EN1^AZHLSC49
IF AZHLSC4I=1
QUIT
SET ^TMP($JOB,"2462",AZHL,Z)=Z(Z)
+20 IF (Z(Z)[" L ")
DO EN^AZHLSC46
IF AZHLSC4I=1
QUIT
DO EN^AZHLSC47
IF AZHLSC4I=1
QUIT
SET AZHLSC49=" L "
DO EN1^AZHLSC49
IF AZHLSC4I=1
QUIT
SET ^TMP($JOB,"2471",AZHL,Z)=Z(Z)
+21 FOR J(1)=" L "," L:",".L ",".L:"
IF Z(Z)[J(1)
DO EN^AZHLSC47
IF AZHLSC4I=1
QUIT
DO EN^AZHLSC46
IF AZHLSC4I=1
QUIT
SET LIN=$EXTRACT(Z(Z),$FIND(Z(Z),J(1))-2,999)
SET COM=$EXTRACT(LIN)
DO SEP^%INDEX
IF $PIECE(LIN," ")["+"
DO EN^AZHLSC48
IF AZHLSC4I=1
QUIT
SET ^TMP($JOB,"2472",AZHL,Z)=Z(Z)
+22 IF (Z(Z)[" N ")
SET AZHLSC49=" N "
DO EN^AZHLSC46
IF AZHLSC4I=1
QUIT
DO EN^AZHLSC47
IF AZHLSC4I=1
QUIT
DO EN1^AZHLSC49
IF AZHLSC4I=1
QUIT
SET ^TMP($JOB,"2481",AZHL,Z)=Z(Z)
+23 IF (Z(Z)[" O ")
DO EN^AZHLSC46
IF AZHLSC4I=1
QUIT
DO EN^AZHLSC47
IF AZHLSC4I=1
QUIT
SET AZHLSC49=" O "
DO FINDC
IF AZHLSC4I=1
QUIT
DO EN1^AZHLSC49
IF AZHLSC4I=1
QUIT
SET ^TMP($JOB,"2491",AZHL,Z)=Z(Z)
+24 FOR J(1)=" U "," U:"
IF Z(Z)[J(1)
SET AZHLSC49=J(1)
DO FINDU
IF AZHLSC4I=1
QUIT
DO EN^AZHLSC47
IF AZHLSC4I=1
QUIT
DO EN^AZHLSC46
IF AZHLSC4I=1
QUIT
DO EN1^AZHLSC49
IF AZHLSC4I=1
QUIT
SET ^TMP($JOB,"24111",AZHL,Z)=Z(Z)
+25 FOR J(1)=" R "," R:",".R "
IF Z(Z)[J(1)
SET AZHLSC49=J(1)
DO EN^AZHLSC47
IF AZHLSC4I=1
QUIT
DO EN^AZHLSC46
IF AZHLSC4I=1
QUIT
SET AZHLSC49=J(1)
DO EN1^AZHLSC49
IF AZHLSC4I=1
QUIT
DO FINDCO
IF AZHLSC4I'=1
SET ^TMP($JOB,"24102",AZHL,Z)=Z(Z)
+26 FOR J(1)=" V "," V:"
IF Z(Z)[J(1)
SET AZHLSC49=J(1)
DO EN^AZHLSC47
IF AZHLSC4I=1
QUIT
DO EN^AZHLSC46
IF AZHLSC4I=1
QUIT
DO EN1^AZHLSC49
IF AZHLSC4I=1
QUIT
DO FINDC
IF AZHLSC4I=1
QUIT
SET ^TMP($JOB,"24121",AZHL,Z)=Z(Z)
+27 QUIT
End DoDot:2
+28 QUIT
End DoDot:1
621 DO TTL^AZHLSC("2.4.2.1, Break Control")
+1 IF NORTNS
DO NRTN^AZHLSC
GOTO 2431
+2 IF $LENGTH($ORDER(^TMP($JOB,"2421","")))
WRITE !?10,"Check that ^%ZOSF(""BRK"") has corresponding ^%ZOSF(""NBRK"")."
SET %=""
FOR
SET %=$ORDER(^TMP($JOB,"2421",%))
IF %=""
QUIT
SET A=0
FOR
SET A=$ORDER(^TMP($JOB,"2421",%,A))
IF 'A
QUIT
WRITE !?10,"+",A,"^",%," : ",^(A)
2431 DO TTL^AZHLSC("2.4.3.1 CLOSE, direct use prohibited")
+1 IF NORTNS
DO NRTN^AZHLSC
GOTO 2441
+2 IF $LENGTH($ORDER(^TMP($JOB,"2431","")))
SET %=""
FOR
SET %=$ORDER(^TMP($JOB,"2431",%))
IF %=""
QUIT
SET A=0
FOR
SET A=$ORDER(^TMP($JOB,"2431",%,A))
IF 'A
QUIT
WRITE !?10,"+",A,"^",%," : ",^(A)
2441 DO TTL^AZHLSC("2.4.4.1 HALT, direct use prohibited")
+1 IF NORTNS
DO NRTN^AZHLSC
GOTO 2451
+2 IF $LENGTH($ORDER(^TMP($JOB,"2441","")))
SET %=""
FOR
SET %=$ORDER(^TMP($JOB,"2441",%))
IF %=""
QUIT
SET A=0
FOR
SET A=$ORDER(^TMP($JOB,"2441",%,A))
IF 'A
QUIT
WRITE !?10,"+",A,"^",%," : ",^(A)
2451 DO TTL^AZHLSC("2.4.5.1 JOB, direct use prohibited")
+1 IF NORTNS
DO NRTN^AZHLSC
GOTO 2461
+2 IF $LENGTH($ORDER(^TMP($JOB,"2451","")))
SET %=""
FOR
SET %=$ORDER(^TMP($JOB,"2451",%))
IF %=""
QUIT
SET A=0
FOR
SET A=$ORDER(^TMP($JOB,"2451",%,A))
IF 'A
QUIT
WRITE !?10,"+",A,"^",%," : ",^(A)
2461 DO TTL^AZHLSC("2.4.6.1 KILL,argumentless use prohibited")
+1 IF NORTNS
DO NRTN^AZHLSC
GOTO 2462
+2 IF $LENGTH($ORDER(^TMP($JOB,"2461","")))
SET %=""
FOR
SET %=$ORDER(^TMP($JOB,"2461",%))
IF %=""
QUIT
SET A=0
FOR
SET A=$ORDER(^TMP($JOB,"2461",%,A))
IF 'A
QUIT
WRITE !?10,"+",A,"^",%," : ",^(A)
2462 DO TTL^AZHLSC("2.4.6.2 KILL,exclusive use prohibited")
+1 IF NORTNS
DO NRTN^AZHLSC
GOTO 2471
+2 IF $LENGTH($ORDER(^TMP($JOB,"2462","")))
SET %=""
FOR
SET %=$ORDER(^TMP($JOB,"2462",%))
IF %=""
QUIT
SET A=0
FOR
SET A=$ORDER(^TMP($JOB,"2462",%,A))
IF 'A
QUIT
WRITE !?10,"+",A,"^",%," : ",^(A)
2471 DO TTL^AZHLSC("2.4.7.1 LOCK, should be incremental/decremental")
+1 IF NORTNS
DO NRTN^AZHLSC
GOTO 2472
+2 IF $LENGTH($ORDER(^TMP($JOB,"2471","")))
SET %=""
FOR
SET %=$ORDER(^TMP($JOB,"2471",%))
IF %=""
QUIT
SET A=0
FOR
SET A=$ORDER(^TMP($JOB,"2471",%,A))
IF 'A
QUIT
WRITE !?10,"+",A,"^",%," : ",^(A)
2472 DO TTL^AZHLSC("2.4.7.2, Timeouts on Locks.")
+1 IF NORTNS
DO NRTN^AZHLSC
GOTO 2481
+2 IF $LENGTH($ORDER(^TMP($JOB,"2472","")))
WRITE !?10,"SUSPECT LOCK w/o timeout, or not +/-."
SET %=""
FOR
SET %=$ORDER(^TMP($JOB,"2472",%))
IF %=""
QUIT
SET A=0
FOR
SET A=$ORDER(^TMP($JOB,"2472",%,A))
IF 'A
QUIT
WRITE !?10,"+",A,"^",%," : ",^(A)
2481 DO TTL^AZHLSC("2.4.8.1 NEW, argumentless prohibited")
+1 IF NORTNS
DO NRTN^AZHLSC
GOTO 2491
+2 IF $LENGTH($ORDER(^TMP($JOB,"2481","")))
SET %=""
FOR
SET %=$ORDER(^TMP($JOB,"2481",%))
IF %=""
QUIT
SET A=0
FOR
SET A=$ORDER(^TMP($JOB,"2481",%,A))
IF 'A
QUIT
WRITE !?10,"+",A,"^",%," : ",^(A)
2491 DO TTL^AZHLSC("2.4.9.1 OPEN, is prohibited")
+1 IF NORTNS
DO NRTN^AZHLSC
GOTO 24102
+2 IF $LENGTH($ORDER(^TMP($JOB,"2491","")))
SET %=""
FOR
SET %=$ORDER(^TMP($JOB,"2491",%))
IF %=""
QUIT
SET A=0
FOR
SET A=$ORDER(^TMP($JOB,"2491",%,A))
IF 'A
QUIT
WRITE !?10,"+",A,"^",%," : ",^(A)
24102 DO TTL^AZHLSC("2.4.10.2 TIMEOUT greater than 300 is prohibited")
+1 IF NORTNS
DO NRTN^AZHLSC
GOTO 24111
+2 IF $LENGTH($ORDER(^TMP($JOB,"24102","")))
SET %=""
FOR
SET %=$ORDER(^TMP($JOB,"24102",%))
IF %=""
QUIT
SET A=0
FOR
SET A=$ORDER(^TMP($JOB,"24102",%,A))
IF 'A
QUIT
WRITE !?10,"+",A,"^",%," : ",^(A)
24111 DO TTL^AZHLSC("2.4.11.1 USE, with parameters is prohibited")
+1 IF NORTNS
DO NRTN^AZHLSC
GOTO 2412
+2 IF $LENGTH($ORDER(^TMP($JOB,"24111","")))
SET %=""
FOR
SET %=$ORDER(^TMP($JOB,"24111",%))
IF %=""
QUIT
SET A=0
FOR
SET A=$ORDER(^TMP($JOB,"24111",%,A))
IF 'A
QUIT
WRITE !?10,"+",A,"^",%," : ",^(A)
2412 DO TTL^AZHLSC("2.4.12.1 VIEW, is prohibited")
+1 IF NORTNS
DO NRTN^AZHLSC
QUIT
+2 IF $LENGTH($ORDER(^TMP($JOB,"24121","")))
SET %=""
FOR
SET %=$ORDER(^TMP($JOB,"24121",%))
IF %=""
QUIT
SET A=0
FOR
SET A=$ORDER(^TMP($JOB,"24121",%,A))
IF 'A
QUIT
WRITE !?10,"+",A,"^",%," : ",^(A)
+3 QUIT
END KILL ^TMP($JOB,"2421"),^("2431"),^("2441"),^("2461"),^("2462"),^("2471"),^("2472"),^("2481"),^("2491"),^("24111"),^("24121"),^("Z"),Z
QUIT
FINDC ; SEARCH FOR CLOSE COMMAND PASS AZHLSC49=" C " SECOND PIECE
+1 SET AZHLSCLN=$LENGTH(Z(Z))
SET AZHLSCLP=""
+2 SET AZHLSC4I=1
FOR I=2:2
IF $PIECE($GET(Z(Z))," ",I)=""
QUIT
SET AZHLSCF=$PIECE($GET(Z(Z))," ",I)
DO LENGTH
IF $EXTRACT($GET(AZHLSCF),1,1)=$PIECE(AZHLSC49," ",2)
SET AZHLSC4I=0
QUIT
IF AZHLSCLN=AZHLSCLP
QUIT
IF AZHLSCLN<AZHLSCLP
QUIT Q
LENGTH ; SET LENGTH
+1 SET AZHLSCLP=AZHLSCLP+$PIECE($LENGTH(Z(Z))," ",I)
SET AZHLSCLP=AZHLSCLP+I
QUIT
FINDU ;FIND ( U OR U:)OR ( V OR V:) COMMAND SEARCH FOR PARAMENTERS
+1 SET AZHLSC4I=0
SET AZHLSCF=""
+2 SET AZHLSCF=$FIND(Z(Z),AZHLSC49)
IF AZHLSCF=0
SET AZHLSC4I=1
QUIT
+3 SET AZHLSCG=$EXTRACT(Z(Z),AZHLSCF,245)
IF AZHLSC49=" U
GOTO FINDUP
IF $PIECE(AZHLSCG," ",1)[":"
SET AZHLSC4I=0
QUIT
FINDEND SET AZHLSC4I=1
QUIT
FINDUP IF $PIECE(AZHLSCG," ",2)[":"
SET AZHLSC4I=0
QUIT
+1 GOTO FINDEND
FINDCO ;FIND R R: .R SEARCH FOR COLON IN READ
+1 SET AZHLSC4I=0
SET AZHLSCF=""
+2 SET AZHLSCF=$FIND(Z(Z),AZHLSC49)
IF AZHLSCF=0
SET AZHLSC4I=1
QUIT
+3 SET AZHLSCG=$FIND(Z(Z),""",",AZHLSCF)
IF AZHLSCG=0
SET AZHLSC4I=1
QUIT
+4 SET AZHLSCF=$FIND(Z(Z),":",AZHLSCG)
IF AZHLSCF=0
SET AZHLSC4I=1
QUIT
+5 SET AZHLSCG=$EXTRACT(Z(Z),AZHLSCF,245)
IF AZHLSCG="DTIME"
GOTO FINDCEND
+6 IF AZHLSCG>300
SET AZHLSC4I=0
QUIT
FINDCEND SET AZHLSC4I=1
QUIT
