Return to DDS10.m CVS log

Up to [Coherent Logic Development] / freem_fileman / USER

Restructure repository

    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