Return to DDS10.m CVS log

Up to [Coherent Logic Development] / freem_fileman

Annotation of freem_fileman/DDS10.m, revision 1.1

1.1     ! snw         1: DDS10  ;SFISC/MKO-BLOCK SETUP ;09:48 AM  18 Nov 1994
        !             2:        ;;21.0;VA FileMan;;Dec 28, 1994
        !             3:        ;Per VHA Directive 10-93-142, this routine should not be modified.
        !             4:        ;
        !             5: SET(DDS1B,DDS1E,DA,DDP,DIE,DL,DDSDA)   ;Get values for pointed-to block
        !             6:        ;In:
        !             7:        ;  DDS1B   = Block number or [Block name] (by ref)
        !             8:        ;  DDS1E   = 1, if we're loading a pointed-to block and we want
        !             9:        ;               interactive dialog (DIC(0)["E") in the lookup
        !            10:        ;  DA      = Record array
        !            11:        ;Returns:
        !            12:        ;  DDS1B = Block number
        !            13:        ;  DDP   = File number of block
        !            14:        ;  DIE   = Global root based on DDP and DA
        !            15:        ;  DL    = Level number (top=0)
        !            16:        ;  DDSDA = DA,DA(1),...,
        !            17:        ;
        !            18:        D BK(.DDS1B,.DDP) Q:$G(DIERR)
        !            19:        D GDA(DDS1B,DDS1E,.DA) Q:$G(DIERR)
        !            20:        D GL(DDP,.DA,.DIE,.DL,.DDSDA,1) Q:$G(DIERR)
        !            21:        Q
        !            22:        ;
        !            23: BK(DDSBK,DDP)  ;Lookup block, get file number
        !            24:        ;Input:
        !            25:        ;  DDSBK = Block number or [Block name] (by ref)
        !            26:        ;Returns:
        !            27:        ;  DDSBK = Block number
        !            28:        ;  DDP   = File number
        !            29:        ;  DIERR
        !            30:        ;
        !            31:        I DDSBK=+$P(DDSBK,"E")  D  Q
        !            32:        . I $D(^DIST(.404,DDSBK,0))[0 D BLD^DIALOG(3051,"#"_DDSBK) Q
        !            33:        . S DDP=+$P(^DIST(.404,DDSBK,0),U,2)
        !            34:        I DDSBK?1"["1.E1"]" D  Q
        !            35:        . N X,Y,DIC
        !            36:        . S X=$E(DDSBK,2,$L(DDSBK)-1),DIC="^DIST(.404,",DIC(0)="FZ"
        !            37:        . D ^DIC I Y<0 D BLD^DIALOG(3051,"named "_X) Q
        !            38:        . S DDSBK=+Y,DDP=+$P(Y(0),U,2)
        !            39:        D BLD^DIALOG(3051,"#"_DDSBK)
        !            40:        Q
        !            41:        ;
        !            42: GDA(DDS1B,DDS1E,DA)    ;Find new DA
        !            43:        ;Input:
        !            44:        ;  DDS1B    = Block number
        !            45:        ;  DDS1E    = 1:Interactive lookup
        !            46:        ;  DDSDAORG = Original DA array
        !            47:        ;  DDSDLORG = Original DL
        !            48:        ;  DDSPG
        !            49:        ;Returns:
        !            50:        ;  DA      = Record number
        !            51:        ;  DIERR
        !            52:        ;
        !            53:        N DDSDA,DDSI,X
        !            54:        ;
        !            55:        ;Set DA array to its original value
        !            56:        S DA=DDSDAORG
        !            57:        F DDSI=1:1:DDSDLORG S DA(DDSI)=DDSDAORG(DDSI)
        !            58:        D DDSDA(.DA,DDSDLORG,.DDSDA)
        !            59:        ;
        !            60:        ;Xecute each PTB node
        !            61:        F DDSI=1:1 Q:DA=""!'$D(@DDSREFS@(DDSPG,DDS1B,"PTB",DDSI))  X ^(DDSI) S:$G(X)'>0 DA=""
        !            62:        ;
        !            63:        ;Kill descendants of DA
        !            64:        I '$G(DIERR) S DDSI=DA K DA S DA=DDSI
        !            65:        S:DA'>0!$G(DIERR) DA=""
        !            66:        Q
        !            67:        ;
        !            68: GL(F,DA,DIE,DL,DDSDA,DDSL)     ;Get global root, level, and IEN
        !            69:        ;Input variables:
        !            70:        ;  F    = file #
        !            71:        ;  DA   = array
        !            72:        ;  DDSL = flag to lock record
        !            73:        ;Returns:
        !            74:        ;  DIE   = global root of file (null if error)
        !            75:        ;  DL    = level (top=0) (null if error)
        !            76:        ;  DDSDA = IEN
        !            77:        ;  DIERR = Error flag
        !            78:        ;
        !            79:        I '$D(^DD(F)) D BLD^DIALOG(401,F) S (DIE,DL)="" Q
        !            80:        I $D(^DIC(F,0,"GL"))#2 S DIE=^("GL"),DL=0
        !            81:        E  D SUBGL Q:$G(DIERR)
        !            82:        ;
        !            83:        Q:'$G(DA)
        !            84:        D DDSDA(.DA,DL,.DDSDA)
        !            85:        ;
        !            86:        N DDSP S DDSP("FILE")=F,DDSP("IEN")=DDSDA
        !            87:        ;
        !            88:        I $D(@(DIE_DA_",0)"))[0 D BLD^DIALOG(601,"",.DDSP)
        !            89:        I $D(@(DIE_DA_",-9)")) D BLD^DIALOG(602,"",.DDSP)
        !            90:        ;
        !            91:        I $G(DDSL),$D(^TMP("DDS",$J,"LOCK",DIE_DA_")"))[0 D  Q:$G(DIERR)
        !            92:        . L +@(DIE_DA_")"):0 E  D BLD^DIALOG(110,"",.DDSP) Q
        !            93:        . S ^TMP("DDS",$J,"LOCK",DIE_DA_")")=""
        !            94:        Q
        !            95:        ;
        !            96: SUBGL  ;Get root and level for subfile
        !            97:        N D,I,S,U1
        !            98:        S D=F
        !            99:        F DL=0:1 Q:$D(^DD(D,0,"UP"))[0  S U1=^("UP") G:'$D(^DD(U1,"SB",D)) SUBER G:$D(^DD(U1,$O(^(D,"")),0))[0 SUBER S S(DL+1)=""""_$P($P(^(0),U,4),";")_"""",D=U1
        !           100:        G:$D(^DIC(D,0,"GL"))[0 SUBER S DIE=^("GL")
        !           101:        F I=DL:-1:1 G:$D(DA(I))[0 SUBER S DIE=DIE_DA(I)_","_S(I)_","
        !           102:        Q
        !           103:        ;
        !           104: SUBER  ;Come here if an error is encountered in GL
        !           105:        S (DIE,DL)=""
        !           106:        D BLD^DIALOG(309)
        !           107:        Q
        !           108:        ;
        !           109: DDSDA(DA,DL,DDSDA)     ;Determine DDSDA
        !           110:        ;Input:
        !           111:        ;  DA    = Record array
        !           112:        ;  DL    = Level number (top=0)
        !           113:        ;Output:
        !           114:        ;  DDSDA = DA,DA(1),...,
        !           115:        ;
        !           116:        N I
        !           117:        I DA="" S DDSDA="" Q
        !           118:        S DDSDA=DA_"," F I=1:1:DL S DDSDA=DDSDA_DA(I)_","
        !           119:        Q