DIKZ ;SFISC/XAK-XREF COMPILER ;1JUN2010
;;22.2;VA FileMan;**19**;Jan 05, 2016;Build 2
;;Per VA Directive 6402, this routine should not be modified.
;;Submitted to OSEHRA 5 January 2015 by the VISTA Expertise Network.
;;Based on Medsphere Systems Corporation's MSC FileMan 1051.
;;Licensed under the terms of the Apache License, Version 2.0.
;
I $G(DUZ(0))'="@" W:$D(^DI(.84,0)) $C(7),$$EZBLD^DIALOG(101) Q
EN1 N DIKJ,%X D:'$D(DISYS) OS^DII
I '$D(^DD("OS",DISYS,"ZS")) W $C(7),$$EZBLD^DIALOG(820) Q
S U="^" S:'$G(DTIME) DTIME=300
D SIZ^DIPZ0(8036) G:$D(DTOUT)!($D(DUOUT))!('X) Q1 S DMAX=X
FILE K DIC S DMAX=X,DIC="^DIC(",DIC(0)="AEQ" D ^DIC G Q1:Y'>0 N DIPZ S DIPZ=+Y
D RNM^DIPZ0(8036) G:$D(DTOUT)!($D(DUOUT))!(X="") Q1 S DNM=X
W ! S DIR(0)="Y",DIR("A")=$$EZBLD^DIALOG(8020) D ^DIR K DIR G:'Y!($D(DIRUT)) Q1
S X=DNM,Y=DIPZ K DIPZ
EN ;
S Y(1)=$$EZBLD^DIALOG(8036),Y(3)=Y D BLD^DIALOG(8024,.Y,"","DIR") W:'$G(DIKZS) !!,DIR,! K Y(1),Y(3)
K ^UTILITY($J),^UTILITY("DIK",$J) N DIK,DIFILENO
S DNM=X,(DH,DIFILENO)=+Y,DIKZQ=0 I $D(^DIC(+Y,0,"GL")) S DIK2=^("GL") ;p19 set DIKZQ
I '$D(DIK2)!(DMAX<2400) G Q
S X=DH D DELETROU^DIEZ(DNM),A^DIU21,WAIT^DICD:'$G(DIKZS),DT^DICRW ;DELETE OLD ROUTINES, DELETE "DIK" NODES
S (DRN,T)=0,DMAX=DMAX-100
;
;Load indexes defined in Index file
N DIXRLIST,DIKMF
K ^TMP("DIKC",$J)
D LOADALL^DIKC1(DIFILENO,"KS","R","",$NA(^TMP("DIKC",$J)),"",.DIKMF)
;
; compile kill logic
S (DIKA,A)=1,X=2,DIKVR="DIKILL",DIK=DIK2
D Q2,NEWR S ^UTILITY($J,0,3)=" S DIKZK="_X
S DIKGO="^"_DNM_1 ;starting ROUTINE name
D ^DIKZ0 G:DIKZQ Q D RTE
;
; compile set logic
S (DIKA,A)=1,X=1,DIKVR="DISET",DIK=DIK2
D Q2,NEWR S ^UTILITY($J,0,3)=" S DIKZK="_X
S DIKGO=DIKGO_",^"_DNM_DRN
D ^DIKZ0 G:DIKZQ Q D RTE
;
; compile driver code
D Q2,^DIKZ1
;
; finish up
S:'DIKZQ ^DD(DIFILENO,0,"DIKOLD")=DNM
Q I DIKZQ S X=DH(1) D A^DIU21
Q1 K DH,X,Y,DIK4,DIKQ,DIKC,T,DV,DIK8,DU,DW,DW1,DIKGO,DRN,DNM,DTOUT,DIRUT,DIROUT,DUOUT,DIC,A,%,%H,%Y
K DIKVR,DIK6,DIKA,DIKR,DMAX,DIK2,DIKCT,DIK1,DIK0,^UTILITY($J),^("DIK"),DIK,DIKZQ,DIKZZ,DIKZZ1,DIKZOVFL
K ^TMP("DIKC",$J)
Q2 K DIKRT,DIKLW,DIKL2
Q
SV ; transfer the accumulated code in ^UTILITY($J,#) to ^UTILITY($J,0,#)
; (the routine buffer) and call SAVE to flush the buffer into a routine
; whenever it's full. Flush the buffer one more time when done.
S DNM(1)=DNM_DRN
F DIKR=0:0 S DIKR=$O(^UTILITY($J,DIKR)) Q:DIKR'>0 S %=^(DIKR) K ^(DIKR) D:T+$L(%)>DMAX S ^UTILITY($J,0,DIKR)=%,T=T+$L(%)+2
. N DIKZMORE S DIKZMORE=1 D SAVE
D SAVE
Q
SAVE ; save the accumulated code in ^UTILITY($J,0,#) as a routine
I DIKR,$E($P(%," ",2))="." F D Q:$E($P(%," ",2))'="."
. S ^UTILITY($J,DIKR)=%
. S DIKR=$O(^UTILITY($J,0,DIKR),-1),%=^(DIKR) K ^(DIKR)
I $D(DIKLW),'DIKR S ^UTILITY($J,0,997)=" G:'$D(DIKLM) "_$C(64+DIKCT)_$S(DNM_DRN'=DNM(1):"^"_DNM(1),1:"")_" Q:$D("_DIKVR_")"
I $D(DIKLW),DIKR S ^UTILITY($J,0,998)=" G ^"_DNM_(DRN+1)
S ^UTILITY($J,0,999)="END "_$S($D(DIKRT)&'DIKR:"Q",1:"G "_$S(DIKR&($D(DIKLW)):"END",1:"")_U_DNM_(DRN+1))
N X,DIR S X=DNM_DRN X ^DD("OS",DISYS,"ZS") S X(1)=X D BLD^DIALOG(8025,.X,"","DIR") W:'$G(DIKZS) !,DIR S:$G(DIKZRLA)]"" @DIKZRLA@(DNM_DRN)="",DIKZRLAF=1
D NEWR:'$D(DIKRT)!$G(DIKZMORE) Q:DIKZQ S ^DD(DH,0,"DIK")=DNM K DIKL2
Q
NEWR ;
I '$D(DIKRT),T,$D(%),T+$L(%)>DMAX S DIKZDH=+$P(^UTILITY($J,0,1),"#",2)
K ^UTILITY($J,0) S DIKR=4,T=0,DRN=DRN+1 I $L(DNM_DRN)>8 W:'$G(DIKZS) $C(7),!,DNM_DRN_$$EZBLD^DIALOG(1503) S:$G(DIKZRLA)]"" DIKZRLAF=0 S DIKZQ=1 Q
S ^UTILITY($J,0,1)=DNM_DRN_" ; COMPILED XREF FOR FILE #"_$S($D(DIKZDH):DIKZDH,1:DH)_" ; "_$E(DT,4,5)_"/"_$E(DT,6,7)_"/"_$E(DT,2,3),^(2)=" ; "
K DIKZDH Q
RTE ;
N DIKFIL,DIKSUB,DIKLIST,DIKP
;Build DIKSUB(file)=subfile1,subfile2,... list
S DIKFIL=0 F S DIKFIL=$O(DIK(X,DIKFIL)) Q:'DIKFIL D
. S DIKSUB=0 F S DIKSUB=$O(^DD(DIKFIL,"SB",DIKSUB)) Q:'DIKSUB D
.. S:$D(DIK(X,DIKSUB))#2 DIKSUB(DIKFIL)=$G(DIKSUB(DIKFIL))_DIKSUB_","
;
;Build DIKLIST(file)=subfile1,subfile2,...
M DIKLIST=DIKSUB
S DIKFIL=0 F S DIKFIL=$O(DIKSUB(DIKFIL)) Q:'DIKFIL D
. S DIKP=0
. F D Q:DIKP'<($L(DIKLIST(DIKFIL),",")-1)
.. F DIKP=DIKP+1:1:$L(DIKLIST(DIKFIL),",")-1 D
... S DIKSUB=$P(DIKLIST(DIKFIL),",",DIKP)
... S DIKLIST(DIKFIL)=DIKLIST(DIKFIL)_$G(DIKSUB(DIKSUB))
K DIKSUB
;
;Convert file numbers in DIKLIST to routine list
S DIKFIL=0 F S DIKFIL=$O(DIKLIST(DIKFIL)) Q:'DIKFIL D
. S $E(DIKLIST(DIKFIL),$L(DIKLIST(DIKFIL)))=""
. S DIKLIST(DIKFIL)=DIKFIL_","_DIKLIST(DIKFIL)
. F DIKP=1:1:$L(DIKLIST(DIKFIL),",") D
.. S DIKSUB=$P(DIKLIST(DIKFIL),",",DIKP)
.. S $P(DIKLIST(DIKFIL),",",DIKP)=DIK(X,DIKSUB)
;
;Move list to DIK
M DIK(X)=DIKLIST
K DIKFIL,DIKLIST,DIKP
S DIKRT=1,A=A-1,DH=DH(1) G SV
;
EN2(Y,DIKZFLGS,X,DMAX,DIKZRLA,DIKZZMSG) ;Silent or Talking with parameter passing
;and optionally return list of routines built and if successful
;FILE#,FLAGS,ROUTINE,RTNMAXSIZE,RTNLISTARRAY,MSGARRAY
;Y=FILE NUMBER (required)
;FLAGS="T"alk (optional)
;X=ROUTINE NAME (required)
;DMAX=ROUTINE SIZE (optional)
;DIKZRLA=ROUTINE LIST ARRAY, by value (optional)
;DIKZZMSG=MESSAGE ARRAY (optional) (default ^TMP)
;*
;DIKZS will be used to indicate "silent" if set to 1
;Write statements are made conditional, if not "silent"
;*
N DIKZS,DNM,DIQUIET,DIKZRIEN,DIKZRLAZ,%X,DIKJ,DIR,DIKZRLAF,DK1
N DIK,DIC,%I,DICS
S DIKZS=$G(DIKZFLGS)'["T"
S:DIKZS DIQUIET=1
I '$D(DIFM) N DIFM S DIFM=1 D
.N Y,DIKZFLGS,X,DMAX,DIKZRLA,DIKZS
.D INIZE^DIEFU
I $G(Y)'>0 D BLD^DIALOG(1700,"File Number missing or invalid") G EN2E
I '$D(^DD(Y,0)) D BLD^DIALOG(1700,"File Number: "_Y_" Invalid") G EN2E
I $G(X)']"" D BLD^DIALOG(1700,"Routine name missing") G EN2E
I X'?1U.NU&(X'?1"%"1U.NU) D BLD^DIALOG(1700,"Routine name invalid") G EN2E
I $L(X)>7 D BLD^DIALOG(1700,"Routine name too long") G EN2E
S DIKZRLA=$G(DIKZRLA,"DIKZRLAZ"),DIKZRIEN=Y
S:DIKZRLA="" DIKZRLA="DIKZRLAZ" S:$G(DMAX)<2500!($G(DMAX)>^DD("ROU")) DMAX=^DD("ROU")
S DIKZRLAF=""
K @DIKZRLA
D EN
G:'DIKZS!(DIKZRLAF) EN2E
D BLD^DIALOG(1700,"Compiling Cross-references (FILE#:"_DIKZRIEN_")"_$S(DIKZRLAF=0:", routine name too long",1:""))
EN2E I 'DIKZS D MSG^DIALOG() Q
I $G(DIKZZMSG)]"" D CALLOUT^DIEFU(DIKZZMSG)
Q
;
;DIALOG #101 'only those with programmer's access'
; #820 'no way to save routines on the system'
; #8020 'Should the compilation run now?'
; #8024 'Compiling template name Input template of file n'
; #8036 'Cross-References'
; #8025 'Routine filed'
; #1503 'routine name is too long...'
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HDIKZ 6632 printed Apr 09, 2024@21:56:32 Page 2
DIKZ ;SFISC/XAK-XREF COMPILER ;1JUN2010
+1 ;;22.2;VA FileMan;**19**;Jan 05, 2016;Build 2
+2 ;;Per VA Directive 6402, this routine should not be modified.
+3 ;;Submitted to OSEHRA 5 January 2015 by the VISTA Expertise Network.
+4 ;;Based on Medsphere Systems Corporation's MSC FileMan 1051.
+5 ;;Licensed under the terms of the Apache License, Version 2.0.
+6 ;
+7 IF $GET(DUZ(0))'="@"
if $DATA(^DI(.84,0))
WRITE $CHAR(7),$$EZBLD^DIALOG(101)
QUIT
EN1 NEW DIKJ,%X
if '$DATA(DISYS)
DO OS^DII
+1 IF '$DATA(^DD("OS",DISYS,"ZS"))
WRITE $CHAR(7),$$EZBLD^DIALOG(820)
QUIT
+2 SET U="^"
if '$GET(DTIME)
SET DTIME=300
+3 DO SIZ^DIPZ0(8036)
if $DATA(DTOUT)!($DATA(DUOUT))!('X)
GOTO Q1
SET DMAX=X
FILE KILL DIC
SET DMAX=X
SET DIC="^DIC("
SET DIC(0)="AEQ"
DO ^DIC
if Y'>0
GOTO Q1
NEW DIPZ
SET DIPZ=+Y
+1 DO RNM^DIPZ0(8036)
if $DATA(DTOUT)!($DATA(DUOUT))!(X="")
GOTO Q1
SET DNM=X
+2 WRITE !
SET DIR(0)="Y"
SET DIR("A")=$$EZBLD^DIALOG(8020)
DO ^DIR
KILL DIR
if 'Y!($DATA(DIRUT))
GOTO Q1
+3 SET X=DNM
SET Y=DIPZ
KILL DIPZ
EN ;
+1 SET Y(1)=$$EZBLD^DIALOG(8036)
SET Y(3)=Y
DO BLD^DIALOG(8024,.Y,"","DIR")
if '$GET(DIKZS)
WRITE !!,DIR,!
KILL Y(1),Y(3)
+2 KILL ^UTILITY($JOB),^UTILITY("DIK",$JOB)
NEW DIK,DIFILENO
+3 ;p19 set DIKZQ
SET DNM=X
SET (DH,DIFILENO)=+Y
SET DIKZQ=0
IF $DATA(^DIC(+Y,0,"GL"))
SET DIK2=^("GL")
+4 IF '$DATA(DIK2)!(DMAX<2400)
GOTO Q
+5 ;DELETE OLD ROUTINES, DELETE "DIK" NODES
SET X=DH
DO DELETROU^DIEZ(DNM)
DO A^DIU21
if '$GET(DIKZS)
DO WAIT^DICD
DO DT^DICRW
+6 SET (DRN,T)=0
SET DMAX=DMAX-100
+7 ;
+8 ;Load indexes defined in Index file
+9 NEW DIXRLIST,DIKMF
+10 KILL ^TMP("DIKC",$JOB)
+11 DO LOADALL^DIKC1(DIFILENO,"KS","R","",$NAME(^TMP("DIKC",$JOB)),"",.DIKMF)
+12 ;
+13 ; compile kill logic
+14 SET (DIKA,A)=1
SET X=2
SET DIKVR="DIKILL"
SET DIK=DIK2
+15 DO Q2
DO NEWR
SET ^UTILITY($JOB,0,3)=" S DIKZK="_X
+16 ;starting ROUTINE name
SET DIKGO="^"_DNM_1
+17 DO ^DIKZ0
if DIKZQ
GOTO Q
DO RTE
+18 ;
+19 ; compile set logic
+20 SET (DIKA,A)=1
SET X=1
SET DIKVR="DISET"
SET DIK=DIK2
+21 DO Q2
DO NEWR
SET ^UTILITY($JOB,0,3)=" S DIKZK="_X
+22 SET DIKGO=DIKGO_",^"_DNM_DRN
+23 DO ^DIKZ0
if DIKZQ
GOTO Q
DO RTE
+24 ;
+25 ; compile driver code
+26 DO Q2
DO ^DIKZ1
+27 ;
+28 ; finish up
+29 if 'DIKZQ
SET ^DD(DIFILENO,0,"DIKOLD")=DNM
Q IF DIKZQ
SET X=DH(1)
DO A^DIU21
Q1 KILL DH,X,Y,DIK4,DIKQ,DIKC,T,DV,DIK8,DU,DW,DW1,DIKGO,DRN,DNM,DTOUT,DIRUT,DIROUT,DUOUT,DIC,A,%,%H,%Y
+1 KILL DIKVR,DIK6,DIKA,DIKR,DMAX,DIK2,DIKCT,DIK1,DIK0,^UTILITY($JOB),^("DIK"),DIK,DIKZQ,DIKZZ,DIKZZ1,DIKZOVFL
+2 KILL ^TMP("DIKC",$JOB)
Q2 KILL DIKRT,DIKLW,DIKL2
+1 QUIT
SV ; transfer the accumulated code in ^UTILITY($J,#) to ^UTILITY($J,0,#)
+1 ; (the routine buffer) and call SAVE to flush the buffer into a routine
+2 ; whenever it's full. Flush the buffer one more time when done.
+3 SET DNM(1)=DNM_DRN
+4 FOR DIKR=0:0
SET DIKR=$ORDER(^UTILITY($JOB,DIKR))
if DIKR'>0
QUIT
SET %=^(DIKR)
KILL ^(DIKR)
if T+$LENGTH(%)>DMAX
Begin DoDot:1
+5 NEW DIKZMORE
SET DIKZMORE=1
DO SAVE
End DoDot:1
SET ^UTILITY($JOB,0,DIKR)=%
SET T=T+$LENGTH(%)+2
+6 DO SAVE
+7 QUIT
SAVE ; save the accumulated code in ^UTILITY($J,0,#) as a routine
+1 IF DIKR
IF $EXTRACT($PIECE(%," ",2))="."
FOR
Begin DoDot:1
+2 SET ^UTILITY($JOB,DIKR)=%
+3 SET DIKR=$ORDER(^UTILITY($JOB,0,DIKR),-1)
SET %=^(DIKR)
KILL ^(DIKR)
End DoDot:1
if $EXTRACT($PIECE(%," ",2))'="."
QUIT
+4 IF $DATA(DIKLW)
IF 'DIKR
SET ^UTILITY($JOB,0,997)=" G:'$D(DIKLM) "_$CHAR(64+DIKCT)_$SELECT(DNM_DRN'=DNM(1):"^"_DNM(1),1:"")_" Q:$D("_DIKVR_")"
+5 IF $DATA(DIKLW)
IF DIKR
SET ^UTILITY($JOB,0,998)=" G ^"_DNM_(DRN+1)
+6 SET ^UTILITY($JOB,0,999)="END "_$SELECT($DATA(DIKRT)&'DIKR:"Q",1:"G "_$SELECT(DIKR&($DATA(DIKLW)):"END",1:"")_U_DNM_(DRN+1))
+7 NEW X,DIR
SET X=DNM_DRN
XECUTE ^DD("OS",DISYS,"ZS")
SET X(1)=X
DO BLD^DIALOG(8025,.X,"","DIR")
if '$GET(DIKZS)
WRITE !,DIR
if $GET(DIKZRLA)]""
SET @DIKZRLA@(DNM_DRN)=""
SET DIKZRLAF=1
+8 if '$DATA(DIKRT)!$GET(DIKZMORE)
DO NEWR
if DIKZQ
QUIT
SET ^DD(DH,0,"DIK")=DNM
KILL DIKL2
+9 QUIT
NEWR ;
+1 IF '$DATA(DIKRT)
IF T
IF $DATA(%)
IF T+$LENGTH(%)>DMAX
SET DIKZDH=+$PIECE(^UTILITY($JOB,0,1),"#",2)
+2 KILL ^UTILITY($JOB,0)
SET DIKR=4
SET T=0
SET DRN=DRN+1
IF $LENGTH(DNM_DRN)>8
if '$GET(DIKZS)
WRITE $CHAR(7),!,DNM_DRN_$$EZBLD^DIALOG(1503)
if $GET(DIKZRLA)]""
SET DIKZRLAF=0
SET DIKZQ=1
QUIT
+3 SET ^UTILITY($JOB,0,1)=DNM_DRN_" ; COMPILED XREF FOR FILE #"_$SELECT($DATA(DIKZDH):DIKZDH,1:DH)_" ; "_$EXTRACT(DT,4,5)_"/"_$EXTRACT(DT,6,7)_"/"_$EXTRACT(DT,2,3)
SET ^(2)=" ; "
+4 KILL DIKZDH
QUIT
RTE ;
+1 NEW DIKFIL,DIKSUB,DIKLIST,DIKP
+2 ;Build DIKSUB(file)=subfile1,subfile2,... list
+3 SET DIKFIL=0
FOR
SET DIKFIL=$ORDER(DIK(X,DIKFIL))
if 'DIKFIL
QUIT
Begin DoDot:1
+4 SET DIKSUB=0
FOR
SET DIKSUB=$ORDER(^DD(DIKFIL,"SB",DIKSUB))
if 'DIKSUB
QUIT
Begin DoDot:2
+5 if $DATA(DIK(X,DIKSUB))#2
SET DIKSUB(DIKFIL)=$GET(DIKSUB(DIKFIL))_DIKSUB_","
End DoDot:2
End DoDot:1
+6 ;
+7 ;Build DIKLIST(file)=subfile1,subfile2,...
+8 MERGE DIKLIST=DIKSUB
+9 SET DIKFIL=0
FOR
SET DIKFIL=$ORDER(DIKSUB(DIKFIL))
if 'DIKFIL
QUIT
Begin DoDot:1
+10 SET DIKP=0
+11 FOR
Begin DoDot:2
+12 FOR DIKP=DIKP+1:1:$LENGTH(DIKLIST(DIKFIL),",")-1
Begin DoDot:3
+13 SET DIKSUB=$PIECE(DIKLIST(DIKFIL),",",DIKP)
+14 SET DIKLIST(DIKFIL)=DIKLIST(DIKFIL)_$GET(DIKSUB(DIKSUB))
End DoDot:3
End DoDot:2
if DIKP'<($LENGTH(DIKLIST(DIKFIL),",")-1)
QUIT
End DoDot:1
+15 KILL DIKSUB
+16 ;
+17 ;Convert file numbers in DIKLIST to routine list
+18 SET DIKFIL=0
FOR
SET DIKFIL=$ORDER(DIKLIST(DIKFIL))
if 'DIKFIL
QUIT
Begin DoDot:1
+19 SET $EXTRACT(DIKLIST(DIKFIL),$LENGTH(DIKLIST(DIKFIL)))=""
+20 SET DIKLIST(DIKFIL)=DIKFIL_","_DIKLIST(DIKFIL)
+21 FOR DIKP=1:1:$LENGTH(DIKLIST(DIKFIL),",")
Begin DoDot:2
+22 SET DIKSUB=$PIECE(DIKLIST(DIKFIL),",",DIKP)
+23 SET $PIECE(DIKLIST(DIKFIL),",",DIKP)=DIK(X,DIKSUB)
End DoDot:2
End DoDot:1
+24 ;
+25 ;Move list to DIK
+26 MERGE DIK(X)=DIKLIST
+27 KILL DIKFIL,DIKLIST,DIKP
+28 SET DIKRT=1
SET A=A-1
SET DH=DH(1)
GOTO SV
+29 ;
EN2(Y,DIKZFLGS,X,DMAX,DIKZRLA,DIKZZMSG) ;Silent or Talking with parameter passing
+1 ;and optionally return list of routines built and if successful
+2 ;FILE#,FLAGS,ROUTINE,RTNMAXSIZE,RTNLISTARRAY,MSGARRAY
+3 ;Y=FILE NUMBER (required)
+4 ;FLAGS="T"alk (optional)
+5 ;X=ROUTINE NAME (required)
+6 ;DMAX=ROUTINE SIZE (optional)
+7 ;DIKZRLA=ROUTINE LIST ARRAY, by value (optional)
+8 ;DIKZZMSG=MESSAGE ARRAY (optional) (default ^TMP)
+9 ;*
+10 ;DIKZS will be used to indicate "silent" if set to 1
+11 ;Write statements are made conditional, if not "silent"
+12 ;*
+13 NEW DIKZS,DNM,DIQUIET,DIKZRIEN,DIKZRLAZ,%X,DIKJ,DIR,DIKZRLAF,DK1
+14 NEW DIK,DIC,%I,DICS
+15 SET DIKZS=$GET(DIKZFLGS)'["T"
+16 if DIKZS
SET DIQUIET=1
+17 IF '$DATA(DIFM)
NEW DIFM
SET DIFM=1
Begin DoDot:1
+18 NEW Y,DIKZFLGS,X,DMAX,DIKZRLA,DIKZS
+19 DO INIZE^DIEFU
End DoDot:1
+20 IF $GET(Y)'>0
DO BLD^DIALOG(1700,"File Number missing or invalid")
GOTO EN2E
+21 IF '$DATA(^DD(Y,0))
DO BLD^DIALOG(1700,"File Number: "_Y_" Invalid")
GOTO EN2E
+22 IF $GET(X)']""
DO BLD^DIALOG(1700,"Routine name missing")
GOTO EN2E
+23 IF X'?1U.NU&(X'?1"%"1U.NU)
DO BLD^DIALOG(1700,"Routine name invalid")
GOTO EN2E
+24 IF $LENGTH(X)>7
DO BLD^DIALOG(1700,"Routine name too long")
GOTO EN2E
+25 SET DIKZRLA=$GET(DIKZRLA,"DIKZRLAZ")
SET DIKZRIEN=Y
+26 if DIKZRLA=""
SET DIKZRLA="DIKZRLAZ"
if $GET(DMAX)<2500!($GET(DMAX)>^DD("ROU"))
SET DMAX=^DD("ROU")
+27 SET DIKZRLAF=""
+28 KILL @DIKZRLA
+29 DO EN
+30 if 'DIKZS!(DIKZRLAF)
GOTO EN2E
+31 DO BLD^DIALOG(1700,"Compiling Cross-references (FILE#:"_DIKZRIEN_")"_$SELECT(DIKZRLAF=0:", routine name too long",1:""))
EN2E IF 'DIKZS
DO MSG^DIALOG()
QUIT
+1 IF $GET(DIKZZMSG)]""
DO CALLOUT^DIEFU(DIKZZMSG)
+2 QUIT
+3 ;
+4 ;DIALOG #101 'only those with programmer's access'
+5 ; #820 'no way to save routines on the system'
+6 ; #8020 'Should the compilation run now?'
+7 ; #8024 'Compiling template name Input template of file n'
+8 ; #8036 'Cross-References'
+9 ; #8025 'Routine filed'
+10 ; #1503 'routine name is too long...'
