Return to DIKZ.m CVS log

Up to [Coherent Logic Development] / freem_fileman / USER

Restructure repository

    1: DIKZ	;SFISC/XAK-XREF COMPILER ;01:39 PM  25 Aug 1994
    2: 	;;21.0;VA FileMan;;Dec 28, 1994
    3: 	;Per VHA Directive 10-93-142, this routine should not be modified.
    4: 	I $G(DUZ(0))'="@" W $C(7),$$EZBLD^DIALOG(101) Q
    5: EN1	N DIKJ,%X D:'$D(DISYS) OS^DII
    6: 	I '$D(^DD("OS",DISYS,"ZS")) W $C(7),$$EZBLD^DIALOG(820) Q
    7: 	S U="^" S:'$G(DTIME) DTIME=300
    8: 	D SIZ^DIPZ0(8036) G:$D(DTOUT)!($D(DUOUT))!('X) Q1 S DMAX=X
    9: FILE	K DIC S DMAX=X,DIC="^DIC(",DIC(0)="AEQ" D ^DIC G Q1:Y'>0 N DIPZ S DIPZ=+Y
   10: 	D RNM^DIPZ0(8036) G:$D(DTOUT)!($D(DUOUT))!(X="") Q1 S DNM=X
   11: 	W ! S DIR(0)="Y",DIR("A")=$$EZBLD^DIALOG(8020) D ^DIR K DIR G:'Y!($D(DIRUT)) Q1
   12: 	S X=DNM,Y=DIPZ K DIPZ
   13: EN	;
   14: 	S Y(1)=$$EZBLD^DIALOG(8036),Y(3)=Y D BLD^DIALOG(8024,.Y,"","DIR") W:'$G(DIKZS) !!,DIR,! K Y(1),Y(3)
   15: 	K ^UTILITY($J),^UTILITY("DIK",$J) N DIK,DIFILENO
   16: 	S DNM=X,(DH,DIFILENO)=+Y I $D(^DIC(+Y,0,"GL")) S DIK2=^("GL")
   17: 	I '$D(DIK2)!(DMAX<2400) G Q
   18: 	S X=DH D A^DIU21,WAIT^DICD:'$G(DIKZS),DT^DICRW,OS^DII:'$D(DISYS) S (DIKA,A)=1,(DRN,DIKZQ,T)=0
   19: 	S DIKGO="^"_DNM_1,DMAX=DMAX-100,DIK=DIK2,X=2,DIKVR="DIKILL"
   20: 	D NEWR S ^UTILITY($J,0,3)=" S DIKZK=2" D ^DIKZ0 G:DIKZQ Q D RTE
   21: 	S (X,DIKA,A)=1,DIKVR="DISET",DIK=DIK2
   22: 	D Q2,NEWR S ^UTILITY($J,0,3)=" S DIKZK=1",DIKGO=DIKGO_",^"_DNM_DRN
   23: 	D ^DIKZ0 G:DIKZQ Q D RTE,Q2,^DIKZ1
   24: 	S:'DIKZQ ^DD(DIFILENO,0,"DIKOLD")=DNM
   25: Q	I DIKZQ S X=DH(1) D A^DIU21
   26: 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
   27: 	K DIKVR,DIK6,DIKA,DIKR,DMAX,DIK2,DIKCT,DIK1,DIK0,^UTILITY($J),^("DIK"),DIK,DIKZQ,DIKZZ,DIKZZ1,DIKZOVFL
   28: Q2	K DIKRT,DIKLW,DIKL2
   29: 	Q
   30: SV	S DNM(1)=DNM_DRN
   31: 	F DIKR=0:0 S DIKR=$O(^UTILITY($J,DIKR)) Q:DIKR'>0  S %=^(DIKR) K ^(DIKR) D SAVE:T+$L(%)>DMAX S ^UTILITY($J,0,DIKR)=%,T=T+$L(%)+2
   32: SAVE	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_")"
   33: 	I $D(DIKLW),DIKR S ^UTILITY($J,0,998)=" G ^"_DNM_(DRN+1)
   34: 	S ^UTILITY($J,0,999)="END "_$S($D(DIKRT)&'DIKR:"Q",1:"G "_$S(DIKR&($D(DIKLW)):"END",1:"")_U_DNM_(DRN+1))
   35: 	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
   36: 	D NEWR:'$D(DIKRT)!(T+$L(%)>DMAX) Q:DIKZQ  S ^DD(DH,0,"DIK")=DNM K DIKL2
   37: 	Q
   38: NEWR	;
   39: 	I '$D(DIKRT)&(T+$L(%)>DMAX) S DIKZDH=+$P(^UTILITY($J,0,1),"#",2)
   40: 	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
   41: 	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)=" ; "
   42: 	K DIKZDH Q
   43: RTE	;
   44: 	F DIK4=0:0 S DIK4=$O(DIK(X,DIK4)) Q:DIK4'>0  S DIKQ=DIK4,DH=2 F DIK6=0:0 S DIK6=^DD(DIKQ,0,"UP") Q:DIK6'>0!(^("UP")=DH(1))  D RTE1
   45: 	S DIKRT=1,A=A-1,DH=DH(1) G SV
   46: 	;
   47: RTE1	;
   48: 	I DIK(X,DIK6)[$P(DIK(X,DIKQ),",") S DIK(X,DIK6)=DIK(X,DIK6)_","_$P(DIK(X,DIKQ),",",DH,999),DIKQ=DIK6,DH=DH+1 Q
   49: 	S DIK(X,DIK6)=DIK(X,DIK6)_","_DIK(X,DIKQ),DIKQ=DIK6
   50: 	Q
   51: 	;
   52: EN2(Y,DIKZFLGS,X,DMAX,DIKZRLA,DIKZZMSG)	;Silent or Talking with parameter passing
   53: 	;and optionally return list of routines built and if successful
   54: 	;FILE#,FLAGS,ROUTINE,RTNMAXSIZE,RTNLISTARRAY,MSGARRAY
   55: 	;Y=FILE NUMBER (required)
   56: 	;FLAGS="T"alk (optional)
   57: 	;X=ROUTINE NAME (required)
   58: 	;DMAX=ROUTINE SIZE (optional)
   59: 	;DIKZRLA=ROUTINE LIST ARRAY, by value (optional)
   60: 	;DIKZZMSG=MESSAGE ARRAY (optional) (default ^TMP)
   61: 	;*
   62: 	;DIKZS will be used to indicate "silent" if set to 1
   63: 	;Write statements are made conditional, if not "silent"
   64: 	;*
   65: 	N DIKZS,DNM,DIQUIET,DIKZRIEN,DIKZRLAZ,%X,DIKJ,DIR,DIKZRLAF,DK1
   66: 	N DIK,DIC,%I,DICS
   67: 	S DIKZS=$G(DIKZFLGS)'["T"
   68: 	S:DIKZS DIQUIET=1
   69: 	I '$D(DIFM) N DIFM S DIFM=1 D
   70: 	.N Y,DIKZFLGS,X,DMAX,DIKZRLA,DIKZS
   71: 	.D INIZE^DIEFU
   72: 	I $G(Y)'>0 D BLD^DIALOG(1700,"File Number missing or invalid") G EN2E
   73: 	I '$D(^DD(Y,0)) D BLD^DIALOG(1700,"File Number: "_Y_" Invalid") G EN2E
   74: 	I $G(X)']"" D BLD^DIALOG(1700,"Routine name missing") G EN2E
   75: 	I X'?1U.NU&(X'?1"%"1U.NU) D BLD^DIALOG(1700,"Routine name invalid") G EN2E
   76: 	I $L(X)>6 D BLD^DIALOG(1700,"Routine name too long") G EN2E
   77: 	S DIKZRLA=$G(DIKZRLA,"DIKZRLAZ"),DIKZRIEN=Y
   78: 	S:DIKZRLA="" DIKZRLA="DIKZRLAZ" S:$G(DMAX)<2500!($G(DMAX)>^DD("ROU")) DMAX=^DD("ROU")
   79: 	S DIKZRLAF=""
   80: 	K @DIKZRLA
   81: 	D EN
   82: 	G:'DIKZS!(DIKZRLAF) EN2E
   83: 	D BLD^DIALOG(1700,"Compiling Cross-references (FILE#:"_DIKZRIEN_")"_$S(DIKZRLAF=0:", routine name too long",1:""))
   84: EN2E	I 'DIKZS D MSG^DIALOG() Q
   85: 	I $G(DIKZZMSG)]"" D CALLOUT^DIEFU(DIKZZMSG)
   86: 	Q
   87: 	;
   88: 	;DIALOG #101    'only those with programmer's access'
   89: 	;       #820    'no way to save routines on the system'
   90: 	;       #8020   'Should the compilation run now?'
   91: 	;       #8024   'Compiling template name Input template of file n'
   92: 	;       #8036   'Cross-References'
   93: 	;       #8025   'Routine filed'
   94: 	;       #1503   'routine name is too long...'