- 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
