AZHLSC42 ; IHS/ADC/GTH:KEU:JN - SAC CHAPTER 2: M LANGUAGE PROGRAMMING STANDARDS & CONVENTIONS) ; [ 09/25/1998 12:01 PM ] [5/31/00 7:25am]
;;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
NEW A,A3,A4,A5,ARG,B,CH,COM,DIF,G,I,J,LIN,NORTNS,NUL,R,Q,VSS,XCNP,Z
D END
S Q="""",A4="=""O ",A5="=""C ",NORTNS=$O(^UTILITY($J,""))="",VSS=$P($T(VSS),";;",2)
S G="NEW I X ^%ZOSF(""SIZE"") S:Y>15000 ^TMP($J,""227"",AZHL)=Y"
S AZHL=""
F S AZHL=$O(^UTILITY($J,AZHL)) Q:AZHL="" W:AZHLTERM "." K Z S (AZHL0,X)=AZHL,DIF="^TMP($J,""Z"",",XCNP=0 X "X ^%ZOSF(""LOAD""),G,AZHLGFCX" I S XCNP=XCNP-1 D
.F Z=3:1:XCNP S Z(Z)=^TMP($J,"Z",Z,0) K ^TMP($J,"Z",Z,0) D
..F %=1:1 S X=U_$P(VSS,U,%) Q:X=U I Z(Z)[X,$E(Z(Z),$F(Z(Z),X))?1P S ^TMP($J,"228",AZHL,Z)=Z(Z)
..I $E(AZHL,1)="Z" S ^TMP($J,"22121",AZHL)=""
..I $L(AZHLNMSP),$E(AZHL,$L(AZHLNMSP)+1)="Z" S ^TMP($J,"22122",AZHL)=""
..I Z(Z)["%AU"!(Z(Z)["D ^AU") D EN^AZHLSC45
..D EN^AZHLSC47 Q:AZHLSC4I=1 D EN^AZHLSC46 Q:AZHLSC4I=1 D CHKBLNK Q:AZHLSC4I=1 S ^TMP($J,"2223",AZHL,Z)=Z(Z)
..Q
.Q
D TTL^AZHLSC("2.2.7, Routine size as determined by ^%ZOSF(""SIZE"")")
I NORTNS D NRTN^AZHLSC G 48
I $L($O(^TMP($J,"227",""))) S %="" F S %=$O(^TMP($J,"227",%)) Q:%="" W !?10,%," is ",^(%)," bytes."
;
48 D TTL^AZHLSC("2.2.8, Vendor Specific Subroutines")
I NORTNS D NRTN^AZHLSC G 410
I $L($O(^TMP($J,"228",""))) W !?10,"Possible use of Vendor Specific Subroutine." S %="" F S %=$O(^TMP($J,"228",%)) Q:%="" S A=0 F S A=$O(^TMP($J,"228",%,A)) Q:'A W !?10,"+",A,"^",%," : ",^(A)
410 D ^AZHLSC43
4121 D TTL^AZHLSC("2.2.12.1, Z first letter of namespace routines, export prohibited ")
I NORTNS D NRTN^AZHLSC G 4122
I $L($O(^TMP($J,"22121",""))) S %="" F S %=$O(^TMP($J,"22121",%)) Q:%="" W !?10,%," should not be included in the package."
4122 D TTL^AZHLSC("2.2.12.2, Creation of Local Routines")
I NORTNS D NRTN^AZHLSC G 418
I $L($O(^TMP($J,"22122",""))) S %="" F S %=$O(^TMP($J,"22122",%)) Q:%="" W !?10,%," should not be included in the package."
418 D TTL^AZHLSC("2.2.18, XB/ZIB Prefixed Routines")
I NORTNS D NRTN^AZHLSC G 2223
I $L($O(^TMP($J,"2218",""))) W !?10,"Possible call to old %AU/AU routine instead of XB/ZIB equivalent." S %="" F S %=$O(^TMP($J,"2218",%)) Q:%="" S A=0 F S A=$O(^TMP($J,"2218",%,A)) Q:'A W !?10,"+",A,"^",%," : ",^(A)
2223 D TTL^AZHLSC("2.2.23, BLANKS AT END OF LINE")
I NORTNS D NRTN^AZHLSC Q
I $L($O(^TMP($J,"2223",""))) W !?10," " S %="" F S %=$O(^TMP($J,"2223",%)) Q:%="" S A=0 F S A=$O(^TMP($J,"2223",%,A)) Q:'A W !?10,"+",A,"^",%," : ",^(A)
Q
END K ^TMP($J,"227"),^("228"),^("22121"),^("22122"),^("2218"),^("2223"),^("Z"),Z
Q
CHKBLNK ; CHECK FOR BLANKS AT END OF LINE
S AZHLSC4I=0,AZHLSCF=""
S AZHLSCG=$L(Z(Z)) I $E(Z(Z),AZHLSCG)=" " S AZHLSC4I=0 D CHKSEMI D CHKBHLK G CHKEND
S AZHLSC4I=1
CHKEND K AZHLSCF,AZHLSCG
Q
CHKBHLK ; CHECK FOR COMMAND BREADK,HALT,LOCK,KILL FOLLOWED BY BLANKS
F J(1)=" B "," H "," K "," L "," N " I $E(Z(Z),AZHLSCG-3,AZHLSCG)=J(1) S AZHLSC4I=1 Q
Q
CHKSEMI ; CHECK FOR SEMI COLON IN COMMAND LINE
S AZHLSCF=$F(Z(Z),";") Q:AZHLSCF=0 S AZHLSC4I=1 Q
Q
VSS ;;%ACTJOB^%D^%DEVUSE^%DI^%DO^%DOMAIN^%ECHO^%ET^%FGR^%FGS^%FLIST^%GCH^%GCHANGE^%GCOPY^%GD^%GDEL^%GUCI^%HL^%HOSTCMD^%MDMP^%MODESET^%MTCHK^%SDEV^%SRCHPAT^%T^%TI^%TO^%TRANS
AZHLSC42 ; IHS/ADC/GTH:KEU:JN - SAC CHAPTER 2: M LANGUAGE PROGRAMMING STANDARDS & CONVENTIONS) ; [ 09/25/1998 12:01 PM ] [5/31/00 7:25am]
+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 NEW A,A3,A4,A5,ARG,B,CH,COM,DIF,G,I,J,LIN,NORTNS,NUL,R,Q,VSS,XCNP,Z
+6 DO END
+7 SET Q=""""
SET A4="=""O "
SET A5="=""C "
SET NORTNS=$ORDER(^UTILITY($JOB,""))=""
SET VSS=$PIECE($TEXT(VSS),";;",2)
+8 SET G="NEW I X ^%ZOSF(""SIZE"") S:Y>15000 ^TMP($J,""227"",AZHL)=Y"
+9 SET AZHL=""
+10 FOR
SET AZHL=$ORDER(^UTILITY($JOB,AZHL))
IF AZHL=""
QUIT
IF AZHLTERM
WRITE "."
KILL Z
SET (AZHL0,X)=AZHL
SET DIF="^TMP($J,""Z"","
SET XCNP=0
XECUTE "X ^%ZOSF(""LOAD""),G,AZHLGFCX"
IF $TEST
SET XCNP=XCNP-1
Begin DoDot:1
+11 FOR Z=3:1:XCNP
SET Z(Z)=^TMP($JOB,"Z",Z,0)
KILL ^TMP($JOB,"Z",Z,0)
Begin DoDot:2
+12 FOR %=1:1
SET X=U_$PIECE(VSS,U,%)
IF X=U
QUIT
IF Z(Z)[X
IF $EXTRACT(Z(Z),$FIND(Z(Z),X))?1P
SET ^TMP($JOB,"228",AZHL,Z)=Z(Z)
+13 IF $EXTRACT(AZHL,1)="Z"
SET ^TMP($JOB,"22121",AZHL)=""
+14 IF $LENGTH(AZHLNMSP)
IF $EXTRACT(AZHL,$LENGTH(AZHLNMSP)+1)="Z"
SET ^TMP($JOB,"22122",AZHL)=""
+15 IF Z(Z)["%AU"!(Z(Z)["D ^AU")
DO EN^AZHLSC45
+16 DO EN^AZHLSC47
IF AZHLSC4I=1
QUIT
DO EN^AZHLSC46
IF AZHLSC4I=1
QUIT
DO CHKBLNK
IF AZHLSC4I=1
QUIT
SET ^TMP($JOB,"2223",AZHL,Z)=Z(Z)
+17 QUIT
End DoDot:2
+18 QUIT
End DoDot:1
+19 DO TTL^AZHLSC("2.2.7, Routine size as determined by ^%ZOSF(""SIZE"")")
+20 IF NORTNS
DO NRTN^AZHLSC
GOTO 48
+21 IF $LENGTH($ORDER(^TMP($JOB,"227","")))
SET %=""
FOR
SET %=$ORDER(^TMP($JOB,"227",%))
IF %=""
QUIT
WRITE !?10,%," is ",^(%)," bytes."
+22 ;
48 DO TTL^AZHLSC("2.2.8, Vendor Specific Subroutines")
+1 IF NORTNS
DO NRTN^AZHLSC
GOTO 410
+2 IF $LENGTH($ORDER(^TMP($JOB,"228","")))
WRITE !?10,"Possible use of Vendor Specific Subroutine."
SET %=""
FOR
SET %=$ORDER(^TMP($JOB,"228",%))
IF %=""
QUIT
SET A=0
FOR
SET A=$ORDER(^TMP($JOB,"228",%,A))
IF 'A
QUIT
WRITE !?10,"+",A,"^",%," : ",^(A)
410 DO ^AZHLSC43
4121 DO TTL^AZHLSC("2.2.12.1, Z first letter of namespace routines, export prohibited ")
+1 IF NORTNS
DO NRTN^AZHLSC
GOTO 4122
+2 IF $LENGTH($ORDER(^TMP($JOB,"22121","")))
SET %=""
FOR
SET %=$ORDER(^TMP($JOB,"22121",%))
IF %=""
QUIT
WRITE !?10,%," should not be included in the package."
4122 DO TTL^AZHLSC("2.2.12.2, Creation of Local Routines")
+1 IF NORTNS
DO NRTN^AZHLSC
GOTO 418
+2 IF $LENGTH($ORDER(^TMP($JOB,"22122","")))
SET %=""
FOR
SET %=$ORDER(^TMP($JOB,"22122",%))
IF %=""
QUIT
WRITE !?10,%," should not be included in the package."
418 DO TTL^AZHLSC("2.2.18, XB/ZIB Prefixed Routines")
+1 IF NORTNS
DO NRTN^AZHLSC
GOTO 2223
+2 IF $LENGTH($ORDER(^TMP($JOB,"2218","")))
WRITE !?10,"Possible call to old %AU/AU routine instead of XB/ZIB equivalent."
SET %=""
FOR
SET %=$ORDER(^TMP($JOB,"2218",%))
IF %=""
QUIT
SET A=0
FOR
SET A=$ORDER(^TMP($JOB,"2218",%,A))
IF 'A
QUIT
WRITE !?10,"+",A,"^",%," : ",^(A)
2223 DO TTL^AZHLSC("2.2.23, BLANKS AT END OF LINE")
+1 IF NORTNS
DO NRTN^AZHLSC
QUIT
+2 IF $LENGTH($ORDER(^TMP($JOB,"2223","")))
WRITE !?10," "
SET %=""
FOR
SET %=$ORDER(^TMP($JOB,"2223",%))
IF %=""
QUIT
SET A=0
FOR
SET A=$ORDER(^TMP($JOB,"2223",%,A))
IF 'A
QUIT
WRITE !?10,"+",A,"^",%," : ",^(A)
+3 QUIT
END KILL ^TMP($JOB,"227"),^("228"),^("22121"),^("22122"),^("2218"),^("2223"),^("Z"),Z
+1 QUIT
CHKBLNK ; CHECK FOR BLANKS AT END OF LINE
+1 SET AZHLSC4I=0
SET AZHLSCF=""
+2 SET AZHLSCG=$LENGTH(Z(Z))
IF $EXTRACT(Z(Z),AZHLSCG)=" "
SET AZHLSC4I=0
DO CHKSEMI
DO CHKBHLK
GOTO CHKEND
+3 SET AZHLSC4I=1
CHKEND KILL AZHLSCF,AZHLSCG
+1 QUIT
CHKBHLK ; CHECK FOR COMMAND BREADK,HALT,LOCK,KILL FOLLOWED BY BLANKS
+1 FOR J(1)=" B "," H "," K "," L "," N "
IF $EXTRACT(Z(Z),AZHLSCG-3,AZHLSCG)=J(1)
SET AZHLSC4I=1
QUIT
+2 QUIT
CHKSEMI ; CHECK FOR SEMI COLON IN COMMAND LINE
+1 SET AZHLSCF=$FIND(Z(Z),";")
IF AZHLSCF=0
QUIT
SET AZHLSC4I=1
QUIT
+2 QUIT
VSS ;;%ACTJOB^%D^%DEVUSE^%DI^%DO^%DOMAIN^%ECHO^%ET^%FGR^%FGS^%FLIST^%GCH^%GCHANGE^%GCOPY^%GD^%GDEL^%GUCI^%HL^%HOSTCMD^%MDMP^%MODESET^%MTCHK^%SDEV^%SRCHPAT^%T^%TI^%TO^%TRANS
