Return to DICA3.m CVS log

Up to [Coherent Logic Development] / freem_fileman

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