| 1 | DICA3 ;SEA/TOAD-VA FileMan: Updater, Adder ;22MAR2006
|
|---|
| 2 | ;;22.0;VA FileMan;**147**;Mar 30, 1999
|
|---|
| 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 | N DINEXT S DINEXT=$P($G(@(DIROOT_"0)")),U,3)
|
|---|
| 9 | I DINEXT="" 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'="" I 'DINUM S DIEN=DINEXT\1
|
|---|
| 14 | N DIFAIL,DIOUT S DIFAIL=0,DIOUT=0 F D I DIOUT!DIFAIL Q
|
|---|
| 15 | . I 'DINUM S DIEN=DIEN+1
|
|---|
| 16 | . D LOCK^DILF(DIROOT_"DIEN)") ;**147
|
|---|
| 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 S DIEN="" Q
|
|---|
| 23 | SETREC ;
|
|---|
| 24 | N DICAFILE M DICAFILE=DIFILE N DIFILE
|
|---|
| 25 | S @(DIROOT_"DIEN,0)")=DIVALUE
|
|---|
| 26 | D LOCK^DILF(DIROOT_"0)") ;**147
|
|---|
| 27 | S $P(^(0),U,3,4)=DIEN_U_($P(@(DIROOT_"0)"),U,4)+1)
|
|---|
| 28 | I L -@(DIROOT_"0)")
|
|---|
| 29 | S DIEN=DIEN_DIENP
|
|---|
| 30 | D XA^DIEFU(DICAFILE,DIEN,.01,DIVALUE,"")
|
|---|
| 31 | D INDEX^DIKC(DICAFILE,DIEN,.01,"","SC")
|
|---|
| 32 | Q
|
|---|
| 33 | ;
|
|---|
| 34 | PROOT(DIFILE,DIEN) ;
|
|---|
| 35 | ; ENTRY POINT--return the global root of a subfile's parent
|
|---|
| 36 | ; extrinsic function, all passed by value
|
|---|
| 37 | N DIENP S DIENP=$P(DIEN,",",2,999)
|
|---|
| 38 | Q $NA(@$$ROOT^DILFD($$PARENT(DIFILE),DIENP,1)@(+DIENP))
|
|---|
| 39 | ;
|
|---|
| 40 | PARENT(DIFILE) ;
|
|---|
| 41 | ; ENTRY POINT--return the file number of a subfile's parent
|
|---|
| 42 | ; extrinsic function, all passed by value
|
|---|
| 43 | Q $G(^DD(DIFILE,0,"UP"))
|
|---|
| 44 | ;
|
|---|
| 45 | SUBFILE(DIFILE) ;
|
|---|
| 46 | ; ENTRY POINT--return whether the file is a subfile
|
|---|
| 47 | ; extrinsic function, passed by value
|
|---|
| 48 | Q $D(^DD(DIFILE,0,"UP"))#2
|
|---|
| 49 | ;
|
|---|
| 50 | ERR(DIERN,DIFILE,DIIENS,DIFIELD,DI1,DI2,DI3) ;
|
|---|
| 51 | ; error logging procedure
|
|---|
| 52 | N DIPE
|
|---|
| 53 | N DI F DI="FILE","IENS","FIELD",1:1:3 S DIPE(DI)=$G(@("DI"_DI))
|
|---|
| 54 | D BLD^DIALOG(DIERN,.DIPE,.DIPE)
|
|---|
| 55 | Q
|
|---|
