Return to DDS10.m CVS log

Up to [Coherent Logic Development] / freem_fileman

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