Return to DIKZ.m CVS log

Up to [Coherent Logic Development] / freem_fileman

Annotation of freem_fileman/DIKZ.m, revision 1.1

1.1     ! snw         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...'