DICA3 ;SEA/TOAD-VA FileMan: Updater, Adder ;10/21/94 10:07 ; ;;21.0;VA FileMan;;Dec 28, 1994 ;Per VHA Directive 10-93-142, this routine should not be modified. CREATE(DIFILE,DIEN,DIROOT,DIVALUE) N DIENP S DIENP=","_$P(DIEN,",",2,999) S DIEN=$P(DIEN,",") L +@(DIROOT_"0)"):1 E S DIEN="" D ERR(111,DIFILE) Q I $D(@(DIROOT_"0)"))[0 D I $G(DIERR) S DIEN="" Q . N DIHEADER S DIHEADER=$$HEADER^DIDU2(.DIFILE,DIENP) . I '$G(DIERR) S @(DIROOT_"0)")=DIHEADER GETNUM N DINUM S DINUM=DIEN'="" N DIFAIL,DIOUT S DIFAIL=0,DIOUT=0 F D I DIOUT!DIFAIL Q . I 'DINUM S DIEN=$$NXTNO^DICLIB(DIROOT) . L +@(DIROOT_"DIEN)"):1 . I '$T S DIFAIL=DINUM Q:'DIFAIL D ERR(110,DIFILE,DIEN_DIENP) Q . I $D(@(DIROOT_"DIEN)")) L -@(DIROOT_"DIEN)") D Q . . S DIFAIL=DINUM I 'DIFAIL Q . . D ERR(302,DIFILE,DIEN_DIENP) . S DIOUT=1 I DIFAIL L -@(DIROOT_"0)") S DIEN="" Q SETREC S @(DIROOT_"DIEN,0)")=DIVALUE S $P(^(0),U,3,4)=DIEN_U_($P(@(DIROOT_"0)"),U,4)+1) L -@(DIROOT_"0)") S DIEN=DIEN_DIENP D XA^DIEFU(DIFILE,DIEN,.01,DIVALUE,"") Q PROOT(DIFILE,DIEN) ; ENTRY POINT--return the global root of a subfile's parent ; extrinsic function, all passed by value N DIENP S DIENP=$P(DIEN,",",2,999) Q $NA(@$$ROOT^DILFD($$PARENT(DIFILE),DIENP,1)@(+DIENP)) PARENT(DIFILE) ; ENTRY POINT--return the file number of a subfile's parent ; extrinsic function, all passed by value Q $G(^DD(DIFILE,0,"UP")) SUBFILE(DIFILE) ; ENTRY POINT--return whether the file is a subfile ; extrinsic function, passed by value Q $D(^DD(DIFILE,0,"UP"))#2 ERR(DIERN,DIFILE,DIIENS,DIFIELD,DI1,DI2,DI3) ; error logging procedure N DIPE N DI F DI="FILE","IENS","FIELD",1:1:3 S DIPE(DI)=$G(@("DI"_DI)) D BLD^DIALOG(DIERN,.DIPE,.DIPE) Q