Return to DIOZ.m CVS log

Up to [Coherent Logic Development] / freem_fileman

Annotation of freem_fileman/DIOZ.m, revision 1.1

1.1     ! snw         1: DIOZ   ;SFISC/TKW - COMPILED SORT TEMPLATE ;11/29/94  09:53
        !             2:        ;;21.0;VA FileMan;;Dec 28, 1994
        !             3:        ;Per VHA Directive 10-93-142, this routine should not be modified.
        !             4: ENCU   ;MARK A SORT TEMPLATE FOR ROUTINE COMPILATION
        !             5:        I $G(DUZ(0))'="@" W !,$C(7),$$EZBLD^DIALOG(101) Q
        !             6: EN1    N DDH,DIC,DIR,DIROUT,DIRUT,DUOUT,DTOUT,X,Y,DIOZ
        !             7:        D OS^DII:'$D(DISYS) I $G(^DD("OS",DISYS,"ZS"))="" W $C(7),!,$$EZBLD^DIALOG(820) Q
        !             8:        D DIC Q:Y<0  S DIOZ=+Y
        !             9:        S DIR(0)="Y"
        !            10:        I $G(^DIBT(+Y,"ROU"))="" D  Q
        !            11:        .D BLD^DIALOG(8029,$$EZBLD^DIALOG(8035),"","DIR(""A"")")
        !            12:        .S DIR("B")="YES" D BLD^DIALOG(9014,"","","DIR(""?"")"),^DIR Q:'Y
        !            13:        .S ^DIBT(DIOZ,"ROU")="^DISZ",^("ROUOLD")="DISZ"
        !            14:        .W !!,$C(7),DIR("?",2),!,DIR("?")
        !            15:        .Q
        !            16:        S X(1)=$$EZBLD^DIALOG(8035),X(2)="DISZ" D BLD^DIALOG(8028,.X,"","DIR(""A"")")
        !            17:        S DIR("B")="NO" D BLD^DIALOG(9019,"","","DIR(""?"")"),^DIR Q:'Y
        !            18:        K ^DIBT(DIOZ,"ROU")
        !            19:        W !!,$C(7),DIR("?",2),!,DIR("?")
        !            20:        Q
        !            21:        ;
        !            22: DIC    S DIC="^DIBT(",DIC(0)="AEIQ",DIC("W")="W ?40,""FILE #"",$P(^(0),U,4) W:$D(^(""ROU"")) ?60,""Compiled"""
        !            23:        S DIC("S")="I '$P(^(0),U,8),Y'<1,$O(^DIBT(+Y,2,0))"
        !            24:        D ^DIC Q
        !            25:        ;
        !            26: ENC    ;CREATE COMPILED SORT ROUTINE
        !            27:        D OS^DII:'$D(DISYS) I $G(^DD("OS",DISYS,"ZS"))="" D BLD^DIALOG(820) G QSV
        !            28:        I $O(^TMP("DIBTC",$J,""))="" D BLD^DIALOG(1501) G QSV
        !            29:        N %,%H,%I,DIROUT,DIRUT,DTOUT,DUOUT,DRN,I,J,K,X,Y,DIR
        !            30:        D NEW G:$D(DIERR) QSV
        !            31:        S K=2,I="" F  S I=$O(^TMP("DIBTC",$J,I)) Q:I=""  F J=0:0 S J=$O(^TMP("DIBTC",$J,I,J)) Q:'J  S X=^(J) I X]"" S K=K+1,^UTILITY($J,0,K)=X
        !            32:        F I=1:1 S X=$P($T(TXT+I),";",3) Q:X=""  S K=K+1,^UTILITY($J,0,K)=X
        !            33:        S X=$P(DIBTPGM,U,2) X ^DD("OS",DISYS,"ZS")
        !            34:        K ^TMP("DIBTC",$J)
        !            35:        Q
        !            36:        ;
        !            37: NEW    I DIBTPGM'?1"^"1.7U1.4N D NXTNO(.DRN) Q:$D(DIERR)  S DIBTPGM=DIBTPGM_$E("000",1,(4-$L(DRN)))_DRN
        !            38:        D NOW^%DTC,YX^%DTC
        !            39:        K ^UTILITY($J,0)
        !            40:        S ^UTILITY($J,0,1)=$P(DIBTPGM,U,2)_" ; GENERATED FROM '"_$P(^DIBT(DIBT1,0),U,1)_"' SORT TEMPLATE (#"_DIBT1_"), FILE:"_DP_",  USER:"_$S($G(^VA(200,+DUZ,0))]"":$P(^(0),U),1:$P($G(^DIC(3,+DUZ,0)),U))_" ; "_Y
        !            41:        S ^UTILITY($J,0,2)=$T(DIOZ+1)
        !            42:        Q
        !            43:        ;
        !            44: NXTNO(DRN)     ; GET NEXT AVAILABLE ROUTINE NUMBER
        !            45:        N DILOCK S DRN=0 D  Q:DRN
        !            46: N1     . S DILOCK=0,DRN=$O(^DI(.83,"C","n",DRN)) Q:'DRN  D N3 G:DILOCK N1
        !            47: N2     S DILOCK=0,DRN=$$NXTNO^DICLIB("^DI(.83,","","U") I DRN>9999 D BLD^DIALOG(1502) Q
        !            48:        D N3 G:DILOCK N2
        !            49:        Q
        !            50: N3     L +^DI(.83,DRN,0):10 I '$T S DILOCK=1 Q
        !            51:        S ^DI(.83,DRN,0)=DRN_"^y",^DI(.83,"B",DRN,DRN)="",^DI(.83,"C","y",DRN)="" K ^DI(.83,"C","n",DRN) L -^DI(.83,DRN,0) Q
        !            52:        Q
        !            53:        ;
        !            54: ENRLS(DRN)     ; MAKE ROUTINE NUMBER AVAILABLE FOR REUSE & DELETE ROUTINE
        !            55:        N DICLEAN,X S DRN=+$G(DRN),DICLEAN='DRN G:DRN R1
        !            56: R      S DRN=$O(^DI(.83,DRN)) Q:'DRN
        !            57: R1     I $G(^DI(.83,DRN,0))]"" S $P(^(0),U,2)="n",^DI(.83,"C","n",DRN)="" K ^DI(.83,"C","y",DRN)
        !            58:        I $G(^%ZOSF("DEL"))]"" S X="DISZ"_$E("000",1,(4-$L(DRN)))_DRN X ^%ZOSF("DEL")
        !            59:        G:DICLEAN R
        !            60:        Q
        !            61:        ;
        !            62: QSV    D:$G(DRN) ENRLS(DRN) K DIBTPGM
        !            63: QER    Q:$G(DIQUIET)
        !            64:        D MSG^DIALOG("W") S DIERR=1 Q
        !            65:        ;
        !            66:        ;DIALOG #101    'only those with programmer's access'                 
        !            67:        ;       #820    'no way to save routines on the system'               
        !            68:        ;       #1501   'There is no code to save for this compiled...'
        !            69:        ;       #1502   'All available routine numbers...are in use...'
        !            70:        ;       #8028   '...currently compiled under namespace...'
        !            71:        ;       #8029   '...not currently compiled.'
        !            72:        ;       #8035   'Sort template'
        !            73:        ;       #9014   (help) 'if YES...Sort logic will be compiled...'
        !            74:        ;       #9019   (help) 'if YES...Sort logic...will NOT be compiled...' 
        !            75:        ;
        !            76: TXT    ;;
        !            77:        ;;M X $S($D(DPQ):DX(DIXX),1:^UTILITY($J,99,DIXX))