Return to DICA3.m CVS log

Up to [Coherent Logic Development] / freem_fileman

Annotation of freem_fileman/DICA3.m, revision 1.1

1.1     ! snw         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