Return to DICA3.m CVS log

Up to [Coherent Logic Development] / freem_fileman / USER

Restructure repository

    1: DICA3	;SEA/TOAD-VA FileMan: Updater, Adder ;10/21/94  10:07 ;
    2: 	;;21.0;VA FileMan;;Dec 28, 1994
    3: 	;Per VHA Directive 10-93-142, this routine should not be modified.
    4: 	
    5: CREATE(DIFILE,DIEN,DIROOT,DIVALUE)	
    6: 	N DIENP S DIENP=","_$P(DIEN,",",2,999)
    7: 	S DIEN=$P(DIEN,",")
    8: 	L +@(DIROOT_"0)"):1 E  S DIEN="" D ERR(111,DIFILE) Q
    9: 	I $D(@(DIROOT_"0)"))[0 D  I $G(DIERR) S DIEN="" Q
   10: 	. N DIHEADER S DIHEADER=$$HEADER^DIDU2(.DIFILE,DIENP)
   11: 	. I '$G(DIERR) S @(DIROOT_"0)")=DIHEADER
   12: GETNUM	
   13: 	N DINUM S DINUM=DIEN'=""
   14: 	N DIFAIL,DIOUT S DIFAIL=0,DIOUT=0 F  D  I DIOUT!DIFAIL Q
   15: 	. I 'DINUM S DIEN=$$NXTNO^DICLIB(DIROOT)
   16: 	. L +@(DIROOT_"DIEN)"):1
   17: 	. I '$T S DIFAIL=DINUM Q:'DIFAIL  D ERR(110,DIFILE,DIEN_DIENP) Q
   18: 	. I $D(@(DIROOT_"DIEN)")) L -@(DIROOT_"DIEN)") D  Q
   19: 	. . S DIFAIL=DINUM I 'DIFAIL Q
   20: 	. . D ERR(302,DIFILE,DIEN_DIENP)
   21: 	. S DIOUT=1
   22: 	I DIFAIL L -@(DIROOT_"0)") S DIEN="" Q
   23: SETREC	
   24: 	S @(DIROOT_"DIEN,0)")=DIVALUE
   25: 	S $P(^(0),U,3,4)=DIEN_U_($P(@(DIROOT_"0)"),U,4)+1)
   26: 	L -@(DIROOT_"0)")
   27: 	S DIEN=DIEN_DIENP
   28: 	D XA^DIEFU(DIFILE,DIEN,.01,DIVALUE,"")
   29: 	Q
   30: 	
   31: PROOT(DIFILE,DIEN)	
   32: 	; ENTRY POINT--return the global root of a subfile's parent
   33: 	; extrinsic function, all passed by value
   34: 	N DIENP S DIENP=$P(DIEN,",",2,999)
   35: 	Q $NA(@$$ROOT^DILFD($$PARENT(DIFILE),DIENP,1)@(+DIENP))
   36: 	
   37: PARENT(DIFILE)	
   38: 	; ENTRY POINT--return the file number of a subfile's parent
   39: 	; extrinsic function, all passed by value
   40: 	Q $G(^DD(DIFILE,0,"UP"))
   41: 	
   42: SUBFILE(DIFILE)	
   43: 	; ENTRY POINT--return whether the file is a subfile
   44: 	; extrinsic function, passed by value
   45: 	Q $D(^DD(DIFILE,0,"UP"))#2
   46: 	
   47: ERR(DIERN,DIFILE,DIIENS,DIFIELD,DI1,DI2,DI3)	
   48: 	; error logging procedure
   49: 	N DIPE
   50: 	N DI F DI="FILE","IENS","FIELD",1:1:3 S DIPE(DI)=$G(@("DI"_DI))
   51: 	D BLD^DIALOG(DIERN,.DIPE,.DIPE)
   52: 	Q