Return to DIKZ.m CVS log

Up to [Coherent Logic Development] / freem_fileman

Annotation of freem_fileman/DIKZ.m, revision 1.1.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...'